From 274311c9f8f2a056e57f9c89e83a4aa46a774c92 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sun, 14 Jun 2015 15:40:13 +0200 Subject: Eliminate dialyzer warnings for unmatched_returns While at it, do a minor cleanup using is_boolean/1 --- lib/eldap/src/eldap.erl | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index ae47c815c9..df87ddde08 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -242,7 +242,7 @@ modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) %%% Sanity checks ! -bool_p(Bool) when Bool==true;Bool==false -> Bool. +bool_p(Bool) when is_boolean(Bool) -> Bool. optional([]) -> asn1_NOVALUE; optional(Value) -> Value. @@ -1022,10 +1022,13 @@ log(_, _, _, _) -> %%% Misc. routines %%% -------------------------------------------------------------------- -send(To,Msg) -> To ! {self(),Msg}. +send(To,Msg) -> + To ! {self(), Msg}, + ok. + recv(From) -> receive - {From,Msg} -> Msg; + {From, Msg} -> Msg; {'EXIT', From, Reason} -> {error, {internal_error, Reason}} end. -- cgit v1.2.3 From cb67108e19d02e41a3cffde0eabfce3614657f3f Mon Sep 17 00:00:00 2001 From: Henrik Nord Date: Wed, 24 Jun 2015 10:55:38 +0200 Subject: Update OTP Version --- OTP_VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index 0034b6527f..0b602e3cc8 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.0 +19.0-rc0 -- cgit v1.2.3 From 1c86a620d74f4f9383c4956dafd3e2486300dc0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 17 Jun 2015 17:33:29 +0200 Subject: erts: Remove HALFWORD_HEAP definition --- erts/emulator/beam/beam_emu.c | 13 +- erts/emulator/beam/beam_load.c | 17 +- erts/emulator/beam/bif.c | 11 +- erts/emulator/beam/big.c | 20 +-- erts/emulator/beam/big.h | 9 +- erts/emulator/beam/copy.c | 32 ---- erts/emulator/beam/dist.c | 14 +- erts/emulator/beam/erl_alloc.c | 142 +-------------- erts/emulator/beam/erl_alloc_util.c | 38 +--- erts/emulator/beam/erl_alloc_util.h | 3 - erts/emulator/beam/erl_bif_binary.c | 3 +- erts/emulator/beam/erl_bif_info.c | 6 +- erts/emulator/beam/erl_bif_re.c | 4 +- erts/emulator/beam/erl_bif_unique.c | 6 +- erts/emulator/beam/erl_bits.c | 4 +- erts/emulator/beam/erl_db.c | 11 +- erts/emulator/beam/erl_db_hash.c | 3 - erts/emulator/beam/erl_db_tree.c | 3 - erts/emulator/beam/erl_db_util.c | 245 +------------------------- erts/emulator/beam/erl_db_util.h | 3 - erts/emulator/beam/erl_gc.c | 29 +-- erts/emulator/beam/erl_init.c | 5 - erts/emulator/beam/erl_lock_check.c | 3 - erts/emulator/beam/erl_map.c | 8 - erts/emulator/beam/erl_map.h | 14 +- erts/emulator/beam/erl_message.h | 3 - erts/emulator/beam/erl_node_container_utils.h | 2 +- erts/emulator/beam/erl_node_tables.c | 16 -- erts/emulator/beam/erl_node_tables.h | 2 +- erts/emulator/beam/erl_printf_term.c | 6 +- erts/emulator/beam/erl_process.c | 27 +-- erts/emulator/beam/erl_term.h | 82 ++------- erts/emulator/beam/erl_utils.h | 16 +- erts/emulator/beam/erl_vm.h | 6 +- erts/emulator/beam/external.c | 50 +----- erts/emulator/beam/global.h | 25 +-- erts/emulator/beam/io.c | 20 +-- erts/emulator/beam/sys.h | 53 ------ erts/emulator/beam/utils.c | 41 +---- erts/emulator/drivers/common/efile_drv.c | 4 +- erts/emulator/sys/common/erl_mmap.c | 3 +- erts/emulator/sys/common/erl_mseg.c | 46 ----- erts/emulator/sys/common/erl_mseg.h | 3 - erts/emulator/utils/beam_makeops | 4 - 44 files changed, 97 insertions(+), 958 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 8b409e139b..0c6181077c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -756,7 +756,7 @@ void** beam_ops; #define IsBitstring(Src, Fail) \ if (is_not_binary(Src)) { Fail; } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define BsSafeMul(A, B, Fail, Target) \ do { Uint64 _res = (A) * (B); \ if (_res / B != A) { Fail; } \ @@ -1247,9 +1247,6 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); -#if HALFWORD_HEAP - ASSERT(erts_get_scheduler_data()->num_tmp_heap_used == 0); -#endif ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2131,8 +2128,6 @@ void process_main(void) * c_p->def_arg_reg[0]. Note that it is safe to use this * location because there are no living x registers in * a receive statement. - * Note that for the halfword emulator, the two first elements - * of the array are used. */ BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; *pi = I+3; @@ -4535,11 +4530,11 @@ do { \ _integer = get_int32(_mb->base + _mb->offset/8); } _mb->offset += 32; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) if (IS_USMALL(0, _integer)) { #endif _result = make_small(_integer); -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else { TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); _result = uint_to_big((Uint) _integer, HTOP); @@ -5129,7 +5124,7 @@ do { \ neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; - switch( c_p->def_arg_reg[3] ) { /* Halfword wont work with hipe yet! */ + switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); MoveReturn(reg[0], r(0)); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index b70e5b9a2d..10baab506a 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1894,15 +1894,14 @@ load_code(LoaderState* stp) */ { Eterm* hp; -/* XXX:PaN - Halfword should use ARCH_64 variant instead */ -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) Uint high, low; # endif last_op->a[arg].val = new_literal(stp, &hp, FLOAT_SIZE_OBJECT); hp[0] = HEADER_FLONUM; last_op->a[arg].type = TAG_q; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) GetInt(stp, 8, hp[1]); # else GetInt(stp, 4, high); @@ -3272,14 +3271,14 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) op->a[1].type = TAG_u; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) (timeout >> 32) == 0 #else 1 #endif ) { op->a[1].val = timeout; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3296,7 +3295,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } #endif } else { -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) error: #endif op->op = genop_i_wait_error_0; @@ -3319,14 +3318,14 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) op->a[1].type = TAG_u; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) (timeout >> 32) == 0 #else 1 #endif ) { op->a[1].val = timeout; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3343,7 +3342,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } #endif } else { -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) error: #endif op->op = genop_i_wait_error_locked_0; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 4e3a1cef69..5ec1840c7b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -4117,16 +4117,9 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3) if (arity < 0) { goto error; } -#if HALFWORD_HEAP - hp = HAlloc(BIF_P, 3); - hp[0] = HEADER_EXPORT; - /* Yes, May be misaligned, but X86_64 will fix it... */ - *((Export **) (hp+1)) = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity); -#else hp = HAlloc(BIF_P, 2); hp[0] = HEADER_EXPORT; hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity); -#endif BIF_RET(make_export(hp)); } @@ -4631,7 +4624,7 @@ BIF_RETTYPE hash_2(BIF_ALIST_2) if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */ BIF_ERROR(BIF_P, BADARG); } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (range > ((1L << 27) - 1)) BIF_ERROR(BIF_P, BADARG); #endif @@ -4703,7 +4696,7 @@ BIF_RETTYPE phash2_2(BIF_ALIST_2) /* * Return either a small or a big. Use the heap for bigs if there is room. */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) BIF_RET(make_small(final_hash)); #else if (IS_USMALL(0, final_hash)) { diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 044bf6a34e..1e6582a7ca 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1487,20 +1487,8 @@ Eterm uint_to_big(Uint x, Eterm *y) Eterm uword_to_big(UWord x, Eterm *y) { -#if HALFWORD_HEAP - Uint upper = x >> 32; - Uint lower = x & 0xFFFFFFFFUL; - if (upper == 0) { - *y = make_pos_bignum_header(1); - } else { - *y = make_pos_bignum_header(2); - BIG_DIGIT(y, 1) = upper; - } - BIG_DIGIT(y, 0) = lower; -#else *y = make_pos_bignum_header(1); BIG_DIGIT(y, 0) = x; -#endif return make_big(y); } @@ -1525,7 +1513,7 @@ Eterm small_to_big(Sint x, Eterm *y) Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp) { Eterm *hp = *hpp; -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) if (x >= (((Uint64) 1) << 32)) { *hp = make_pos_bignum_header(2); BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); @@ -1555,7 +1543,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) neg = 1; ux = -(Uint64)x; } -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) if (ux >= (((Uint64) 1) << 32)) { if (neg) *hp = make_neg_bignum_header(2); @@ -1588,7 +1576,7 @@ erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array) pot_digits = digits = 0; for (i = 0; i < len; i++) { -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) Uint low_val = array[i] & ((Uint) 0xffffffff); Uint high_val = (array[i] >> 32) & ((Uint) 0xffffffff); BIG_DIGIT(headerp, pot_digits) = low_val; @@ -1651,8 +1639,6 @@ big_to_double(Wterm x, double* resp) /* * Logic has been copied from erl_bif_guard.c and slightly * modified to use a static instead of dynamic heap - * - * HALFWORD: Return relative term with 'heap' as base. */ Eterm double_to_big(double x, Eterm *heap, Uint hsz) diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 4aa9724ae3..94f9bce10e 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -35,7 +35,7 @@ typedef Uint ErtsDigit; -#if ((SIZEOF_VOID_P == 4) || HALFWORD_HEAP) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8) +#if (SIZEOF_VOID_P == 4) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8) /* Assume 32-bit machine with long long support */ typedef Uint64 ErtsDoubleDigit; typedef Uint16 ErtsHalfDigit; @@ -90,13 +90,9 @@ typedef Uint dsize_t; /* Vector size type */ #define BIG_UINT_HEAP_SIZE (1 + 1) /* always, since sizeof(Uint) <= sizeof(Eterm) */ -#if HALFWORD_HEAP -#define BIG_UWORD_HEAP_SIZE(UW) (((UW) >> (sizeof(Uint) * 8)) ? 3 : 2) -#else #define BIG_UWORD_HEAP_SIZE(UW) BIG_UINT_HEAP_SIZE -#endif -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) #define ERTS_UINT64_BIG_HEAP_SIZE__(X) \ ((X) >= (((Uint64) 1) << 32) ? (1 + 2) : (1 + 1)) @@ -178,4 +174,3 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); #endif - diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 8849dadd00..94048f4c59 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -69,11 +69,7 @@ copy_object(Eterm obj, Process* to) * Return the "flat" size of the object. */ -#if HALFWORD_HEAP -Uint size_object_rel(Eterm obj, Eterm* base) -#else Uint size_object(Eterm obj) -#endif { Uint sum = 0; Eterm* ptr; @@ -227,12 +223,7 @@ Uint size_object(Eterm obj) /* * Copy a structure to a heap. */ -#if HALFWORD_HEAP -Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, - Eterm* src_base, Eterm* dst_base) -#else Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) -#endif { char* hstart; Uint hsize; @@ -287,13 +278,10 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) break; case TAG_PRIMARY_LIST: objp = list_val_rel(obj,src_base); - #if !HALFWORD_HEAP || defined(DEBUG) if (in_area(objp,hstart,hsize)) { - ASSERT(!HALFWORD_HEAP); hp++; break; } - #endif argp = hp++; /* Fall through */ @@ -309,17 +297,9 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } else { CAR(htop) = elem; - #if HALFWORD_HEAP - CDR(htop) = CDR(objp); - *tailp = make_list_rel(htop,dst_base); - htop += 2; - goto L_copy; - #else tailp = &CDR(htop); htop += 2; - #endif } - ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot); *tp = make_list_rel(tailp - 1, dst_base); obj = CDR(objp); if (!is_list(obj)) { @@ -337,13 +317,10 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - #if !HALFWORD_HEAP || defined(DEBUG) if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) { - ASSERT(!HALFWORD_HEAP); hp++; break; } - #endif argp = hp++; L_copy_boxed: @@ -563,21 +540,12 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) * * NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr). */ -#if HALFWORD_HEAP -Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, - Eterm* src_base) -#else Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) -#endif { Eterm* tp = ptr; Eterm* hp = *hpp; const Eterm res = make_tuple(hp); -#if HALFWORD_HEAP - const Sint offs = COMPRESS_POINTER(hp - (tp - src_base)); -#else const Sint offs = (hp - tp) * sizeof(Eterm); -#endif while (sz--) { Eterm val = *tp++; diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 23897a49ae..efd5109269 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -732,19 +732,11 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), erts_dsend_context_dtor); struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); - Uint ctl_size = !HALFWORD_HEAP ? 0 : (arityval(ctx->ctl_heap[0]) + 1); - Eterm* hp = HAlloc(p, ctl_size + PROC_BIN_SIZE); + Eterm* hp = HAlloc(p, PROC_BIN_SIZE); sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext)); ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap)); -#if !HALFWORD_HEAP dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap); -#else - /* Must put control tuple in low mem */ - sys_memcpy(hp, ctx->ctl_heap, ctl_size*sizeof(Eterm)); - dst->ctx.dss.ctl = make_tuple(hp); - hp += ctl_size; -#endif if (ctx->dss.acmp) { sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); dst->ctx.dss.acmp = &dst->acm; @@ -2061,9 +2053,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define ERTS_PORT_REDS_MASK__ 0x003fffffffffffffL -#elif defined(ARCH_32) || HALFWORD_HEAP +#elif defined(ARCH_32) #define ERTS_PORT_REDS_MASK__ 0x003fffff #else # error "Ohh come on ... !?!" diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 55c164bf11..d68f22d573 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -123,10 +123,6 @@ typedef union { static ErtsAllocatorState_t std_alloc_state; static ErtsAllocatorState_t ll_alloc_state; -#if HALFWORD_HEAP -static ErtsAllocatorState_t std_low_alloc_state; -static ErtsAllocatorState_t ll_low_alloc_state; -#endif static ErtsAllocatorState_t sl_alloc_state; static ErtsAllocatorState_t temp_alloc_state; static ErtsAllocatorState_t eheap_alloc_state; @@ -150,24 +146,10 @@ typedef struct { #define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2) #define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC -#if !HALFWORD_HEAP ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq, - ErtsAllocInfoReq, - 5, - ERTS_ALC_T_AINFO_REQ) -#else -static ERTS_INLINE ErtsAllocInfoReq * -aireq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq)); -} - -static ERTS_INLINE void -aireq_free(ErtsAllocInfoReq *ptr) -{ - erts_free(ERTS_ALC_T_AINFO_REQ, ptr); -} -#endif + ErtsAllocInfoReq, + 5, + ERTS_ALC_T_AINFO_REQ) ErtsAlcType_t erts_fix_core_allocator_ix; @@ -229,10 +211,6 @@ typedef struct { struct au_init ets_alloc; struct au_init driver_alloc; struct au_init fix_alloc; -#if HALFWORD_HEAP - struct au_init std_low_alloc; - struct au_init ll_low_alloc; -#endif } erts_alc_hndl_args_init_t; #define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} @@ -259,10 +237,6 @@ set_default_sl_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_SHORT_LIVED; ip->init.util.rsbcst = 80; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } @@ -328,10 +302,6 @@ set_default_temp_alloc_opts(struct au_init *ip) ip->init.util.ts = ERTS_ALC_MTA_TEMPORARY; ip->init.util.rsbcst = 90; ip->init.util.rmbcmt = 100; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif } static void @@ -350,10 +320,6 @@ set_default_eheap_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_EHEAP; ip->init.util.rsbcst = 50; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC; } @@ -560,12 +526,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)] = sizeof(Process); -#if !HALFWORD_HEAP fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)] = ERTS_MONITOR_SH_SIZE * sizeof(Uint); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)] = ERTS_LINK_SH_SIZE * sizeof(Uint); -#endif fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)] = sizeof(ErtsDrvEventDataState); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)] @@ -745,24 +709,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free; erts_allctrs_info[ERTS_ALC_A_SYSTEM].enabled = 1; -#if HALFWORD_HEAP - /* Init low memory variants by cloning */ - init.std_low_alloc = init.std_alloc; - init.std_low_alloc.init.util.name_prefix = "std_low_"; - init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW; - init.std_low_alloc.init.util.force = 1; - init.std_low_alloc.init.util.low_mem = 1; - - init.ll_low_alloc = init.ll_alloc; - init.ll_low_alloc.init.util.name_prefix = "ll_low_"; - init.ll_low_alloc.init.util.alloc_no = ERTS_ALC_A_LONG_LIVED_LOW; - init.ll_low_alloc.init.util.force = 1; - init.ll_low_alloc.init.util.low_mem = 1; - - set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu); - set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu); -#endif /* HALFWORD */ - set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu); set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu); set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu); @@ -805,14 +751,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) start_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, &ll_alloc_state); -#if HALFWORD_HEAP - start_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, - &init.ll_low_alloc, - &ll_low_alloc_state); - start_au_allocator(ERTS_ALC_A_STANDARD_LOW, - &init.std_low_alloc, - &std_low_alloc_state); -#endif start_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc, &eheap_alloc_state); @@ -836,9 +774,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_mtrace_install_wrapper_functions(); extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); -#if !HALFWORD_HEAP init_aireq_alloc(); -#endif #ifdef DEBUG extra_block_size += install_debug_functions(); @@ -1238,9 +1174,6 @@ get_acul_value(struct au_init *auip, char *param_end, char** argv, int* ip) if (sys_strcmp(value, "de") == 0) { switch (auip->init.util.alloc_no) { case ERTS_ALC_A_LONG_LIVED: -#if HALFWORD_HEAP - case ERTS_ALC_A_LONG_LIVED_LOW: -#endif return ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC; case ERTS_ALC_A_EHEAP: return ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC; @@ -1957,48 +1890,6 @@ alcu_size(ErtsAlcType_t ai, ErtsAlcUFixInfo_t *fi, int fisz) return res; } -#if HALFWORD_HEAP -static ERTS_INLINE int -alcu_is_low(ErtsAlcType_t ai) -{ - int is_low = 0; - ASSERT(erts_allctrs_info[ai].enabled); - ASSERT(erts_allctrs_info[ai].alloc_util); - - if (!erts_allctrs_info[ai].thr_spec) { - Allctr_t *allctr = erts_allctrs_info[ai].extra; - is_low = allctr->mseg_opt.low_mem; - } - else { - ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai]; - int i; -# ifdef DEBUG - int found_one = 0; -# endif - - ASSERT(tspec->enabled); - - for (i = tspec->size - 1; i >= 0; i--) { - Allctr_t *allctr = tspec->allctr[i]; - if (allctr) { -# ifdef DEBUG - if (!found_one) { - is_low = allctr->mseg_opt.low_mem; - found_one = 1; - } - else ASSERT(is_low == allctr->mseg_opt.low_mem); -# else - is_low = allctr->mseg_opt.low_mem; - break; -# endif - } - } - ASSERT(found_one); - } - return is_low; -} -#endif /* HALFWORD */ - static ERTS_INLINE void add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type) { @@ -2028,9 +1919,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) int code; int ets; int maximum; -#if HALFWORD_HEAP - int low; -#endif } want = {0}; struct { UWord total; @@ -2043,9 +1931,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) UWord code; UWord ets; UWord maximum; -#if HALFWORD_HEAP - UWord low; -#endif } size = {0}; Eterm atoms[sizeof(size)/sizeof(UWord)]; UWord *uintps[sizeof(size)/sizeof(UWord)]; @@ -2104,11 +1989,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) atoms[length] = am_maximum; uintps[length++] = &size.maximum; } -#if HALFWORD_HEAP - want.low = 1; - atoms[length] = am_low; - uintps[length++] = &size.low; -#endif } else { DeclareTmpHeapNoproc(tmp_heap,2); @@ -2202,15 +2082,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) return am_badarg; } break; -#if HALFWORD_HEAP - case am_low: - if (!want.low) { - want.low = 1; - atoms[length] = am_low; - uintps[length++] = &size.low; - } - break; -#endif default: UnUseTmpHeapNoproc(2); return am_badarg; @@ -2288,11 +2159,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) if (save) *save = asz; size.total += asz; -#if HALFWORD_HEAP - if (alcu_is_low(ai)) { - size.low += asz; - } -#endif } } } @@ -2319,7 +2185,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_PROC); -#if !HALFWORD_HEAP add_fix_values(&size.processes, &size.processes_used, fi, @@ -2329,7 +2194,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_NLINK_SH); -#endif add_fix_values(&size.processes, &size.processes_used, fi, diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 236ee35d18..db4c30b9eb 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -2074,7 +2074,7 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp) if (!blk) { blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); -#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY +#if !ERTS_SUPER_ALIGNED_MSEG_ONLY if (!blk) { /* Emergency! We couldn't create the carrier as we wanted. Try to place it in a sys_alloced sbc. */ @@ -3511,8 +3511,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) int is_mseg = 0; #endif - if (HALFWORD_HEAP - || (ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC)) + if ((ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC)) || !allow_sys_alloc_carriers) { flags |= CFLG_FORCE_MSEG; flags &= ~CFLG_FORCE_SYS_ALLOC; @@ -3749,11 +3748,6 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) DEBUG_SAVE_ALIGNMENT(new_crr); return new_blk; } -#if HALFWORD_HEAP - /* Old carrier unchanged; restore stat */ - STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz); - return NULL; -#endif create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc() failed */ } @@ -3942,9 +3936,6 @@ static struct { Eterm e; Eterm t; Eterm ramv; -#if HALFWORD_HEAP - Eterm low; -#endif Eterm sbct; #if HAVE_ERTS_MSEG Eterm asbcst; @@ -4035,9 +4026,6 @@ init_atoms(Allctr_t *allctr) AM_INIT(e); AM_INIT(t); AM_INIT(ramv); -#if HALFWORD_HEAP - AM_INIT(low); -#endif AM_INIT(sbct); #if HAVE_ERTS_MSEG AM_INIT(asbcst); @@ -4643,9 +4631,6 @@ info_options(Allctr_t *allctr, "option e: true\n" "option t: %s\n" "option ramv: %s\n" -#if HALFWORD_HEAP - "option low: %s\n" -#endif "option sbct: %beu\n" #if HAVE_ERTS_MSEG "option asbcst: %bpu\n" @@ -4664,9 +4649,6 @@ info_options(Allctr_t *allctr, "option acul: %d\n", topt, allctr->ramv ? "true" : "false", -#if HALFWORD_HEAP - allctr->mseg_opt.low_mem ? "true" : "false", -#endif allctr->sbc_threshold, #if HAVE_ERTS_MSEG allctr->mseg_opt.abs_shrink_th, @@ -4729,9 +4711,6 @@ info_options(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.sbct, bld_uint(hpp, szp, allctr->sbc_threshold)); -#if HALFWORD_HEAP - add_2tup(hpp, szp, &res, am.low, allctr->mseg_opt.low_mem ? am_true : am_false); -#endif add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false); add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false)); add_2tup(hpp, szp, &res, am.e, am_true); @@ -5416,11 +5395,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, Block_t *new_blk; if(IS_SBC_BLK(blk)) { do_carrier_resize: -#if HALFWORD_HEAP - new_blk = resize_carrier(allctr, blk, size, CFLG_SBC | CFLG_FORCE_MSEG); -#else new_blk = resize_carrier(allctr, blk, size, CFLG_SBC); -#endif res = new_blk ? BLK2UMEM(new_blk) : NULL; } else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) @@ -5714,11 +5689,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #ifdef ERTS_SMP if (init->tspec || init->tpref) allctr->mseg_opt.sched_spec = 1; -#endif -# if HALFWORD_HEAP - allctr->mseg_opt.low_mem = init->low_mem; -# endif -#endif +#endif /* ERTS_SMP */ +#endif /* HAVE_ERTS_MSEG */ allctr->name_prefix = init->name_prefix; if (!allctr->name_prefix) @@ -5875,7 +5847,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) CFLG_MBC | CFLG_FORCE_SIZE | CFLG_NO_CPOOL -#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY +#if !ERTS_SUPER_ALIGNED_MSEG_ONLY | CFLG_FORCE_SYS_ALLOC #endif | CFLG_MAIN_CARRIER); diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index df1f0aa65a..792f8c63ac 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -45,7 +45,6 @@ typedef struct { int tspec; int tpref; int ramv; - int low_mem; /* HALFWORD only */ UWord sbct; UWord asbcst; UWord rsbcst; @@ -90,7 +89,6 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ - 0, /* (bool) low_mem: HALFWORD only */\ 512*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ @@ -125,7 +123,6 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ - 0, /* (bool) low_mem: HALFWORD only */\ 64*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 134aa2d396..f834802764 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -2550,7 +2550,6 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) } pb = (ProcBin *) binary_val(bin); if (pb->thing_word == HEADER_PROC_BIN) { - /* XXX:PaN - Halfword - orig_size is a long, we should handle that */ res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); } else { /* heap binary */ res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P); @@ -2568,7 +2567,7 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) #endif static int get_need(Uint u) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (u > 0xFFFFFFFFUL) { if (u > 0xFFFFFFFFFFFFUL) { if (u > 0xFFFFFFFFFFFFFFUL) { diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index b44382cde8..a3ff537aa1 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -73,7 +73,7 @@ static char otp_version[] = ERLANG_OTP_VERSION; static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE "%s" " [erts-" ERLANG_VERSION "]" -#if !HEAP_ON_C_STACK && !HALFWORD_HEAP +#if !HEAP_ON_C_STACK " [no-c-stack-objects]" #endif #ifndef OTP_RELEASE @@ -84,12 +84,8 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #endif #endif #ifdef ARCH_64 -#if HALFWORD_HEAP - " [64-bit halfword]" -#else " [64-bit]" #endif -#endif #ifdef ERTS_SMP " [smp:%beu:%beu]" #endif diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index 86951f32b0..7f7cd376ac 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -100,7 +100,7 @@ Sint erts_re_set_loop_limit(Sint limit) static int term_to_int(Eterm term, int *sp) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (is_small(term)) { Uint x = signed_val(term); @@ -151,7 +151,7 @@ static int term_to_int(Eterm term, int *sp) static Eterm make_signed_integer(int x, Process *p) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) return make_small(x); #else Eterm* hp; diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c index 5eca09c5a6..c4a39b8897 100644 --- a/erts/emulator/beam/erl_bif_unique.c +++ b/erts/emulator/beam/erl_bif_unique.c @@ -338,7 +338,7 @@ static struct { } w; } raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE); -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) # define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN #else # define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL @@ -368,7 +368,7 @@ get_unique_monotonic_integer_heap_size(Uint64 raw, int positive) Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET; if (IS_SSMALL(value)) return 0; -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) return ERTS_SINT64_HEAP_SIZE(value); #else return ERTS_UINT64_HEAP_SIZE((Uint64) value); @@ -393,7 +393,7 @@ make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positiv if (hsz == 0) res = make_small(value); else { -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) res = erts_sint64_to_big(value, &hp); #else res = erts_uint64_to_big((Uint64) value, &hp); diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 01734c55d7..11d83686a3 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -282,7 +282,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff * Simply shift whole bytes into the result. */ switch (BYTE_OFFSET(n)) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) case 7: w = (w << 8) | *bp++; case 6: w = (w << 8) | *bp++; case 5: w = (w << 8) | *bp++; @@ -387,7 +387,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff case 3: v32 = LSB[0] + (LSB[1]<<8) + (LSB[2]<<16); goto big_small; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) case 4: v32 = (LSB[0] + (LSB[1]<<8) + (LSB[2]<<16) + (LSB[3]<<24)); if (!IS_USMALL(sgn, v32)) { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 878ee32b47..f3da28b65a 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1774,15 +1774,9 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) * (it looks like an continuation pointer), but that is will crash the * emulator if this BIF is call traced. */ -#if HALFWORD_HEAP - Eterm *hp = HAlloc(BIF_P, 3); - hp[0] = make_pos_bignum_header(2); - *((UWord *) (UWord) (hp+1)) = (UWord) tb; -#else Eterm *hp = HAlloc(BIF_P, 2); hp[0] = make_pos_bignum_header(1); hp[1] = (Eterm) tb; -#endif BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp)); } else { @@ -3652,11 +3646,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1) Eterm* ptr = big_val(cont); DbTable *tb = *((DbTable **) (UWord) (ptr + 1)); -#if HALFWORD_HEAP - ASSERT(*ptr == make_pos_bignum_header(2)); -#else ASSERT(*ptr == make_pos_bignum_header(1)); -#endif + db_lock(tb, LCK_WRITE); trap = free_table_cont(p, tb, 0, 1); db_unlock(tb, LCK_WRITE); diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 81b0c4465c..fc1aa05ed2 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -2885,9 +2885,6 @@ Ldone: handle->dbterm = &b->dbterm; handle->flags = flags; handle->new_size = b->dbterm.size; -#if HALFWORD_HEAP - handle->abs_vec = NULL; -#endif handle->lck = lck; return 1; } diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 465aa566ad..c21eac6f25 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -2589,9 +2589,6 @@ db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj, handle->flags = flags; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; -#if HALFWORD_HEAP - handle->abs_vec = NULL; -#endif return 1; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index dab357a079..0086aa8121 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -239,11 +239,7 @@ typedef enum { matchCall2, matchCall3, matchPushV, -#if HALFWORD_HEAP - matchPushVGuard, /* First guard-only variable reference */ -#endif - matchPushVResult, /* First variable reference in result, or (if HALFWORD) - in guard if also referenced in result */ + matchPushVResult, /* First variable reference in result */ matchPushExpr, /* Push the whole expression we're matching ('$_') */ matchPushArrayAsList, /* Only when parameter is an Array and not an erlang term (DCOMP_TRACE) */ @@ -310,9 +306,6 @@ DMC_DECLARE_STACK_TYPE(unsigned); typedef struct DMCVariable { int is_bound; int is_in_body; -#if HALFWORD_HEAP - int first_guard_label; /* to maybe change from PushVGuard to PushVResult */ -#endif } DMCVariable; typedef struct DMCHeap { @@ -415,7 +408,7 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap) else { int i; for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef; #else mpsp->default_heap[i] = (Eterm) 0xdeadbeef; @@ -1755,60 +1748,6 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) return ret; } - -#if HALFWORD_HEAP -struct heap_checkpoint_t -{ - Process *p; - Eterm* htop; - ErlHeapFragment* mbuf; - unsigned used_size; - ErlOffHeap off_heap; -}; - -static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp) -{ - hcp->p = p; - hcp->htop = HEAP_TOP(p); - hcp->mbuf = MBUF(p); - hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0; - hcp->off_heap = MSO(p); -} - -static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp) -{ - struct erl_off_heap_header* oh = MSO(hcp->p).first; - - if (oh != hcp->off_heap.first) { - ASSERT(oh != NULL); - if (hcp->off_heap.first) { - while (oh->next != hcp->off_heap.first) { - oh = oh->next; - } - oh->next = NULL; - } - erts_cleanup_offheap(&MSO(hcp->p)); - MSO(hcp->p) = hcp->off_heap; - } - if (MBUF(hcp->p) != hcp->mbuf) { - ErlHeapFragment* hf = MBUF(hcp->p); - ASSERT(hf != NULL); - if (hcp->mbuf) { - while (hf->next != hcp->mbuf) { - hf = hf->next; - } - hf->next = NULL; - } - free_message_buffer(MBUF(hcp->p)); - MBUF(hcp->p) = hcp->mbuf; - } - if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) { - hcp->mbuf->used_size = hcp->used_size; - } - HEAP_TOP(hcp->p) = hcp->htop; -} -#endif /* HALFWORD_HEAP */ - static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) { if (!is_immed(term)) { @@ -1855,17 +1794,12 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm bif_args[3]; int fail_label; int atomic_trace; -#if HALFWORD_HEAP - struct heap_checkpoint_t c_p_checkpoint = {}; -#endif #ifdef DMC_DEBUG Uint *heap_fence; Uint *stack_fence; Uint save_op; #endif /* DMC_DEBUG */ - ASSERT(base==NULL || HALFWORD_HEAP); - mpsp = get_match_pseudo_process(c_p, prog->heap_size); psp = &mpsp->process; @@ -1916,11 +1850,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, do_catch != 0 */ *return_flags = 0U; - variables = mpsp->u.variables; -#if HALFWORD_HEAP - c_p_checkpoint.p = NULL; -#endif restart: ep = &term; @@ -1931,7 +1861,6 @@ restart: fail_label = -1; build_proc = psp; esdp->current_process = psp; - ASSERT_HALFWORD(!c_p_checkpoint.p); #ifdef DEBUG ASSERT(variables == mpsp->u.variables); @@ -2236,31 +2165,10 @@ restart: esp -= 2; esp[-1] = t; break; - - #if HALFWORD_HEAP - case matchPushVGuard: - if (!base) goto case_matchPushV; - /* Build NULL-based copy on pseudo heap for easy disposal */ - n = *pc++; - ASSERT(is_value(variables[n].term)); - ASSERT(!variables[n].proc); - variables[n].term = copy_object_rel(psp, variables[n].term, base); - *esp++ = variables[n].term; - #ifdef DEBUG - variables[n].proc = psp; - variables[n].base = NULL; - #endif - break; - #endif case matchPushVResult: if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; /* Build (NULL-based) copy on callers heap */ - #if HALFWORD_HEAP - if (!do_catch && !c_p_checkpoint.p) { - heap_checkpoint_init(c_p, &c_p_checkpoint); - } - #endif n = *pc++; ASSERT(is_value(variables[n].term)); ASSERT(!variables[n].proc); @@ -2299,7 +2207,6 @@ restart: } break; case matchPushArrayAsList: - ASSERT_HALFWORD(base == NULL); n = arity; /* Only happens when 'term' is an array */ tp = termp; ehp = HAllocX(build_proc, n*2, HEAP_XTRA); @@ -2315,7 +2222,6 @@ restart: break; case matchPushArrayAsListU: /* This instruction is NOT efficient. */ - ASSERT_HALFWORD(base == NULL); *esp++ = dpm_array_to_list(build_proc, termp, arity); break; case matchTrue: @@ -2619,13 +2525,6 @@ restart: } } fail: -#if HALFWORD_HEAP - if (c_p_checkpoint.p) { - /* Dispose garbage built by guards on caller heap */ - heap_checkpoint_revert(&c_p_checkpoint); - c_p_checkpoint.p = NULL; - } -#endif *return_flags = 0U; if (fail_label >= 0) { /* We failed during a "TryMeElse", lets restart, with the next match @@ -2788,13 +2687,6 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) { Eterm elem = handle->dbterm->tpl[position]; if (!is_header(elem)) { -#if HALFWORD_HEAP - if (!is_immed(elem) - && !handle->tb->common.compress - && !(handle->abs_vec && handle->abs_vec[position])) { - return rterm2wterm(elem, handle->dbterm->tpl); - } -#endif return elem; } @@ -2822,9 +2714,6 @@ void db_do_update_element(DbUpdateHandle* handle, Eterm* oldp; Uint newval_sz; Uint oldval_sz; -#if HALFWORD_HEAP - Eterm* old_base; -#endif if (is_both_immed(newval,oldval)) { handle->dbterm->tpl[position] = newval; @@ -2841,15 +2730,8 @@ void db_do_update_element(DbUpdateHandle* handle, handle->dbterm); handle->flags |= DB_MUST_RESIZE; oldval = handle->dbterm->tpl[position]; - #if HALFWORD_HEAP - old_base = NULL; - #endif } else { - #if HALFWORD_HEAP - ASSERT(!handle->abs_vec); - old_base = handle->dbterm->tpl; - #endif if (is_boxed(newval)) { newp = boxed_val(newval); switch (*newp & _TAG_HEADER_MASK) { @@ -2879,13 +2761,6 @@ void db_do_update_element(DbUpdateHandle* handle, } } } -#if HALFWORD_HEAP - else { - old_base = (handle->tb->common.compress - || (handle->abs_vec && handle->abs_vec[position])) ? - NULL : handle->dbterm->tpl; - } -#endif /* Not possible for simple memcpy or dbterm is already non-contiguous, */ /* need to realloc... */ @@ -2900,19 +2775,6 @@ both_size_set: /* write new value in old dbterm, finalize will make a flat copy */ handle->dbterm->tpl[position] = newval; handle->flags |= DB_MUST_RESIZE; - -#if HALFWORD_HEAP - if (old_base && newval_sz > 0) { - ASSERT(!handle->tb->common.compress); - if (!handle->abs_vec) { - int i = header_arity(handle->dbterm->tpl[0]); - handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char)); - sys_memset(handle->abs_vec, 0, i+1); - /* abs_vec[0] not used */ - } - handle->abs_vec[position] = 1; - } -#endif } static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old, @@ -3160,26 +3022,6 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) tmp_offheap.first = NULL; - #if HALFWORD_HEAP - if (handle->abs_vec) { - int i, arity = header_arity(handle->dbterm->tpl[0]); - - top[0] = tpl[0]; - top += arity + 1; - for (i=1; i<=arity; i++) { - Eterm* src_base = handle->abs_vec[i] ? NULL : tpl; - - newDbTerm->tpl[i] = copy_struct_rel(tpl[i], - size_object_rel(tpl[i],src_base), - &top, &tmp_offheap, src_base, - newDbTerm->tpl); - } - newDbTerm->first_oh = tmp_offheap.first; - ASSERT((byte*)top <= (newp + alloc_sz)); - erts_free(ERTS_ALC_T_TMP, handle->abs_vec); - } - else - #endif /* HALFWORD_HEAP */ { copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top, &tmp_offheap, tpl, top); @@ -3599,26 +3441,10 @@ static DMCRet dmc_one_term(DMCContext *context, { Eterm* ref_val = internal_ref_val(c); DMC_PUSH(*text, matchEqRef); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - ASSERT(thing_arityval(ref_val[0]) == 3); - fiddle.t[0] = ref_val[0]; - fiddle.t[1] = ref_val[1]; - DMC_PUSH(*text, fiddle.u); - fiddle.t[0] = ref_val[2]; - fiddle.t[1] = ref_val[3]; - DMC_PUSH(*text, fiddle.u); - } -#else n = thing_arityval(ref_val[0]); for (i = 0; i <= n; ++i) { DMC_PUSH(*text, ref_val[i]); } -#endif break; } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): @@ -3627,52 +3453,18 @@ static DMCRet dmc_one_term(DMCContext *context, Eterm* bval = big_val(c); n = thing_arityval(bval[0]); DMC_PUSH(*text, matchEqBig); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - ASSERT(n >= 1); - fiddle.t[0] = bval[0]; - fiddle.t[1] = bval[1]; - DMC_PUSH(*text, fiddle.u); - for (i = 2; i <= n; ++i) { - fiddle.t[0] = bval[i]; - if (++i <= n) { - fiddle.t[1] = bval[i]; - } else { - fiddle.t[1] = (Uint) 0; - } - DMC_PUSH(*text, fiddle.u); - } - } -#else for (i = 0; i <= n; ++i) { DMC_PUSH(*text, (Uint) bval[i]); } -#endif break; } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): DMC_PUSH(*text,matchEqFloat); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - fiddle.t[0] = float_val(c)[1]; - fiddle.t[1] = float_val(c)[2]; - DMC_PUSH(*text, fiddle.u); - } -#else DMC_PUSH(*text, (Uint) float_val(c)[1]); #ifdef ARCH_64 DMC_PUSH(*text, (Uint) 0); #else DMC_PUSH(*text, (Uint) float_val(c)[2]); -#endif #endif break; default: /* BINARY, FUN, VECTOR, or EXTERNAL */ @@ -3997,24 +3789,8 @@ static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap, MatchOps instr = matchPushV; ASSERT(n < heap->vars_used && v->is_bound); - if (context->is_guard) { - #if HALFWORD_HEAP - if (!v->first_guard_label) { - v->first_guard_label = DMC_STACK_NUM(*text); - ASSERT(v->first_guard_label); - instr = matchPushVGuard; /* may be changed to PushVResult below */ - } - #endif - } - else { /* body */ - #if HALFWORD_HEAP - if (v->first_guard_label) { - /* Avoid double-copy, copy to result heap at first encounter in guard */ - DMC_POKE(*text, v->first_guard_label, matchPushVResult); - v->is_in_body = 1; - } - #endif - if (!v->is_in_body) { + if (!context->is_guard) { + if(!v->is_in_body) { instr = matchPushVResult; v->is_in_body = 1; } @@ -5450,7 +5226,7 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, obj = db_alloc_tmp_uncompressed(tb, obj); base = NULL; } - else base = HALFWORD_HEAP ? obj->tpl : NULL; + else base = NULL; res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0, ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); @@ -5573,7 +5349,7 @@ void db_match_dis(Binary *bp) first = 0; else erts_printf(", "); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) erts_printf("0x%016bex", rt->data.ui[ri]); #else erts_printf("0x%08bex", rt->data.ui[ri]); @@ -5597,7 +5373,7 @@ void db_match_dis(Binary *bp) first = 0; else erts_printf(", "); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) erts_printf("0x%016bex", *et); #else erts_printf("0x%08bex", *et); @@ -5720,13 +5496,6 @@ void db_match_dis(Binary *bp) ++t; erts_printf("PushV\t%beu\n", n); break; - #if HALFWORD_HEAP - case matchPushVGuard: - n = (Uint) *++t; - ++t; - erts_printf("PushVGuard\t%beu\n", n); - break; - #endif case matchPushVResult: n = (Uint) *++t; ++t; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 1ccdc0305b..c2128888c5 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -90,9 +90,6 @@ typedef struct { Uint new_size; int flags; void* lck; -#if HALFWORD_HEAP - unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */ -#endif } DbUpdateHandle; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index d2604f1595..6c335a9fe6 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -128,7 +128,7 @@ static void disallow_heap_frag_ref_in_old_heap(Process* p); static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj); #endif -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) # define MAX_HEAP_SIZES 154 #else # define MAX_HEAP_SIZES 59 @@ -147,26 +147,10 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; -#if !HALFWORD_HEAP ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, - ErtsGCInfoReq, - 5, - ERTS_ALC_T_GC_INFO_REQ) -#else -static ERTS_INLINE ErtsGCInfoReq * -gcireq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_GC_INFO_REQ, - sizeof(ErtsGCInfoReq)); -} - -static ERTS_INLINE void -gcireq_free(ErtsGCInfoReq *ptr) -{ - erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr); -} -#endif - + ErtsGCInfoReq, + 5, + ERTS_ALC_T_GC_INFO_REQ) /* * Initialize GC global data. */ @@ -208,7 +192,7 @@ erts_init_gc(void) } - /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] (and halfword) + /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] * for 64 bit we want max_heap_size to be MAX(52bit) / 8 [words] */ @@ -232,10 +216,7 @@ erts_init_gc(void) init_gc_info(&esdp->gc_info); } -#if !HALFWORD_HEAP init_gcireq_alloc(); -#endif - } /* diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index d9c3b0dcf4..5c209a4af2 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -91,11 +91,6 @@ const int etp_arch_bits = 32; #else # error "Not 64-bit, nor 32-bit arch" #endif -#if HALFWORD_HEAP -const int etp_halfword = 1; -#else -const int etp_halfword = 0; -#endif #ifdef HIPE const int etp_hipe = 1; #else diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 3b3b247020..84bee976ff 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -156,9 +156,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "instr", NULL }, { "alcu_allocator", "index" }, { "mseg", NULL }, -#if HALFWORD_HEAP - { "pmmap", NULL }, -#endif #ifdef ERTS_SMP { "port_task_pre_alloc_lock", "address" }, { "proclist_pre_alloc_lock", "address" }, diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index a91e36e3c5..6d496ea5ee 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -170,11 +170,7 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { */ const Eterm * -#if HALFWORD_HEAP -erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base) -#else erts_maps_get(Eterm key, Eterm map) -#endif { Uint32 hx; if (is_flatmap_rel(map, map_base)) { @@ -1993,11 +1989,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) { } const Eterm * -#if HALFWORD_HEAP -erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base) -#else erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) -#endif { Eterm *ptr, hdr, *res; Uint ix, lvl = 0; diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index c391de3f11..2f7c55829f 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -105,22 +105,12 @@ Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint Eterm k, Eterm v); const Eterm * -#if HALFWORD_HEAP -erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base); -# define erts_maps_get(A, B) erts_maps_get_rel(A, B, NULL) -#else erts_maps_get(Eterm key, Eterm map); -# define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B) -#endif +#define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B) const Eterm * -#if HALFWORD_HEAP -erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base); -# define erts_hashmap_get(Hx, K, M) erts_hashmap_get_rel(Hx, K, M, NULL) -#else erts_hashmap_get(Uint32 hx, Eterm key, Eterm map); -# define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M) -#endif +#define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M) /* hamt nodes v2.0 * diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index fbdf3fb0e2..f37b430d27 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -32,9 +32,6 @@ struct external_thing_; struct erl_off_heap_header { Eterm thing_word; Uint size; -#if HALFWORD_HEAP - void* dummy_ptr_padding__; -#endif struct erl_off_heap_header* next; }; diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 211b1a0090..0a4b18b748 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -255,7 +255,7 @@ extern ErtsPTab erts_port; * Refs * \* */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define internal_ref_no_of_numbers(x) \ (internal_ref_data((x))[0]) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 2fb790b953..62a44f7129 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1207,23 +1207,11 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) break; } if (insert_bin) { -#if HALFWORD_HEAP - UWord val = (UWord) u.pb->val; - DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE*2); /* extra place allocated */ -#else DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE); -#endif Uint *hp = &id_heap[0]; InsertedBin *nib; -#if HALFWORD_HEAP - int actual_need = BIG_UWORD_HEAP_SIZE(val); - ASSERT(actual_need <= (BIG_UINT_HEAP_SIZE*2)); - UseTmpHeapNoproc(actual_need); - a.id = erts_bld_uword(&hp, NULL, (UWord) val); -#else UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val); -#endif erts_match_prog_foreach_offheap(u.pb->val, insert_offheap2, (void *) &a); @@ -1231,11 +1219,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) nib->bin_val = u.pb->val; nib->next = inserted_bins; inserted_bins = nib; -#if HALFWORD_HEAP - UnUseTmpHeapNoproc(actual_need); -#else UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); -#endif } } break; diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 694ac84232..64278d2ea0 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -66,7 +66,7 @@ #define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \ | ERTS_DE_QFLG_EXIT) -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL) #else #define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713) diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 267c0b3ff4..95b3572372 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -261,7 +261,7 @@ static char *format_binary(Uint16 x, char *b) { static int print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, - Eterm* obj_base) /* ignored if !HALFWORD_HEAP */ + Eterm* obj_base) { DECLARE_WSTACK(s); int res; @@ -344,11 +344,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_CHAR(res, fn, arg, '>'); goto L_done; } -#if HALFWORD_HEAP - wobj = is_immed(obj) ? (Wterm)obj : rterm2wterm(obj, obj_base); -#else wobj = (Wterm)obj; -#endif switch (tag_val_def(wobj)) { case NIL_DEF: PRINT_STRING(res, fn, arg, "[]"); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 7b3d12ce09..a21c1e5582 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -119,7 +119,7 @@ #define RUNQ_SET_RQ(X, RQ) erts_smp_atomic_set_nob((X), (erts_aint_t) (RQ)) #ifdef DEBUG -# if defined(ARCH_64) && !HALFWORD_HEAP +# if defined(ARCH_64) # define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \ (RUNQ_SET_RQ((RQP), (0xdeadbeefdead0003LL | ((N) << 4))) # define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \ @@ -971,25 +971,10 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsSchedWallTimeReq; -#if !HALFWORD_HEAP ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq, - ErtsSchedWallTimeReq, - 5, - ERTS_ALC_T_SCHED_WTIME_REQ) -#else -static ERTS_INLINE ErtsSchedWallTimeReq * -swtreq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_SCHED_WTIME_REQ, - sizeof(ErtsSchedWallTimeReq)); -} - -static ERTS_INLINE void -swtreq_free(ErtsSchedWallTimeReq *ptr) -{ - erts_free(ERTS_ALC_T_SCHED_WTIME_REQ, ptr); -} -#endif + ErtsSchedWallTimeReq, + 5, + ERTS_ALC_T_SCHED_WTIME_REQ) static void reply_sched_wall_time(void *vswtrp) @@ -5797,9 +5782,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online #endif init_misc_aux_work(); -#if !HALFWORD_HEAP init_swtreq_alloc(); -#endif erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */ debug_wait_completed_flags = 0; @@ -8286,7 +8269,7 @@ add_pend_suspend(Process *suspendee, sizeof(ErtsPendingSuspend)); psp->next = NULL; #ifdef DEBUG -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead; #else psp->end = (ErtsPendingSuspend *) 0xdeaddead; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 90e35151b0..46900edfc7 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -21,33 +21,12 @@ #ifndef __ERL_TERM_H #define __ERL_TERM_H -#include "sys.h" /* defines HALFWORD_HEAP */ - typedef UWord Wterm; /* Full word terms */ -#if HALFWORD_HEAP -# define HEAP_ON_C_STACK 0 -# if HALFWORD_ASSERT -# ifdef ET_DEBUG -# undef ET_DEBUG -# endif -# define ET_DEBUG 1 -# endif -# if 1 -# define CHECK_POINTER_MASK 0xFFFFFFFF00000000UL -# define COMPRESS_POINTER(APointer) ((Eterm) (UWord) (APointer)) -# define EXPAND_POINTER(AnEterm) ((UWord) (AnEterm)) -# else -# define CHECK_POINTER_MASK 0x0UL -# define COMPRESS_POINTER(AnUint) (AnUint) -# define EXPAND_POINTER(APointer) (APointer) -# endif -#else -# define HEAP_ON_C_STACK 1 -# define CHECK_POINTER_MASK 0x0UL -# define COMPRESS_POINTER(AnUint) (AnUint) -# define EXPAND_POINTER(APointer) (APointer) -#endif +#define HEAP_ON_C_STACK 1 +#define CHECK_POINTER_MASK 0x0UL +#define COMPRESS_POINTER(AnUint) (AnUint) +#define EXPAND_POINTER(APointer) (APointer) struct erl_node_; /* Declared in erl_node_tables.h */ @@ -190,13 +169,10 @@ struct erl_node_; /* Declared in erl_node_tables.h */ /* boxed object access methods */ -#if HALFWORD_HEAP -#define _is_taggable_pointer(x) (((UWord)(x) & (CHECK_POINTER_MASK | 0x3)) == 0) -#define _boxed_precond(x) (is_boxed(x)) -#else + #define _is_taggable_pointer(x) (((Uint)(x) & 0x3) == 0) #define _boxed_precond(x) (is_boxed(x)) -#endif + #define _is_aligned(x) (((Uint)(x) & 0x3) == 0) #define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED) _ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*) @@ -226,11 +202,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define is_list(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_LIST) #define is_not_list(x) (!is_list((x))) #endif -#if HALFWORD_HEAP #define _list_precond(x) (is_list(x)) -#else -#define _list_precond(x) (is_list(x)) -#endif #define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define list_val(x) _ET_APPLY(list_val,(x)) @@ -250,7 +222,7 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/ /* fixnum ("small") access methods */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define SMALL_BITS (64-4) #define SMALL_DIGITS (17) #else @@ -396,11 +368,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm) _ET_DECLARE_CHECKED(Eterm*,export_val,Wterm) #define export_val(x) _ET_APPLY(export_val,(x)) #define is_export_header(x) ((x) == HEADER_EXPORT) -#if HALFWORD_HEAP -#define HEADER_EXPORT _make_header(2,_TAG_HEADER_EXPORT) -#else #define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT) -#endif /* bignum access methods */ #define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG) @@ -424,7 +392,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Wterm) #define big_val(x) _ET_APPLY(big_val,(x)) /* flonum ("float") access methods */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define HEADER_FLONUM _make_header(1,_TAG_HEADER_FLOAT) #else #define HEADER_FLONUM _make_header(2,_TAG_HEADER_FLOAT) @@ -445,12 +413,12 @@ typedef union float_def byte fb[sizeof(ieee754_8)]; Uint16 fs[sizeof(ieee754_8) / sizeof(Uint16)]; Uint32 fw[sizeof(ieee754_8) / sizeof(Uint32)]; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) Uint fdw; #endif } FloatDef; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1) @@ -727,7 +695,7 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm) #define ERTS_MAX_REF_NUMBERS 3 #define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) # define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1) # define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1) #else @@ -749,7 +717,7 @@ typedef struct { #define make_ref_thing_header(DW) \ _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF) -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) /* * Ref layout on a 64-bit little endian machine: @@ -1159,17 +1127,9 @@ extern unsigned tag_val_def(Wterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) -#if HALFWORD_HEAP -#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE))) -#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE)) - -#else /* HALFWORD_HEAP */ - #define ptr2rel(PTR,BASE) (PTR) #define rterm2wterm(REL,BASE) (REL) -#endif /* !HALFWORD_HEAP */ - #define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE)) #define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE)) #define make_fun_rel make_boxed_rel @@ -1216,25 +1176,7 @@ extern unsigned tag_val_def(Wterm); #define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE)) - -#if HALFWORD_HEAP -ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) -{ - /* If bases differ, assume a and b are on different "heaps", - ie can only be same if immed */ - ASSERT(a_base == b_base || is_immed(a) || is_immed(b) - || rterm2wterm(a,a_base) != rterm2wterm(b,b_base)); - - return a == b && (a_base == b_base || is_immed(a)); -} -#endif - -#else /* !HALFWORD_HEAP */ #define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) -#endif #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 6dab3bf297..1732579d04 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -157,24 +157,11 @@ void erts_init_utils_mem(void); erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); -#if HALFWORD_HEAP -int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); -# define eq(A,B) eq_rel(A,NULL,B,NULL) -#else int eq(Eterm, Eterm); -# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) -#endif +#define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) -#if HALFWORD_HEAP -Sint erts_cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int, int); -#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0,0) -#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1,0) -#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,0) -#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1,0) -#define CMP_EQ_ONLY(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,1) -#else Sint erts_cmp(Eterm, Eterm, int, int); Sint cmp(Eterm a, Eterm b); #define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0,0) @@ -182,7 +169,6 @@ Sint cmp(Eterm a, Eterm b); #define CMP(A,B) erts_cmp(A,B,0,0) #define CMP_TERM(A,B) erts_cmp(A,B,1,0) #define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1) -#endif #define cmp_lt(a,b) (CMP((a),(b)) < 0) #define cmp_le(a,b) (CMP((a),(b)) <= 0) diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 8948ca2ea9..2d4141ac8d 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -117,12 +117,8 @@ #define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) #if defined(DEBUG) || defined(CHECK_FOR_HOLES) -#if HALFWORD_HEAP -# define ERTS_HOLE_MARKER (0xdeadbeef) -#else # define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef) -#endif -#endif +#endif /* egil: 32-bit ? */ /* * Allocate heap memory on the ordinary heap, NEVER in a heap diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index c6d7e3fcc5..f7b372d294 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2339,10 +2339,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm val; FloatDef f; Sint r = 0; -#if HALFWORD_HEAP - UWord wobj; -#endif - if (ctx) { WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); @@ -2362,11 +2358,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, outer_loop: while (!WSTACK_ISEMPTY(s)) { -#if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); -#else obj = WSTACK_POP(s); -#endif + switch (val = WSTACK_POP(s)) { case ENC_TERM: break; @@ -2384,11 +2377,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; case ENC_PATCH_FUN_SIZE: { -#if HALFWORD_HEAP - byte* size_p = (byte *) wobj; -#else byte* size_p = (byte *) obj; -#endif put_int32(ep - size_p, size_p); } goto outer_loop; @@ -2435,21 +2424,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case ENC_LAST_ARRAY_ELEMENT: /* obj is the tuple */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else Eterm* ptr = (Eterm *) obj; -#endif obj = *ptr; } break; default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else Eterm* ptr = (Eterm *) obj; -#endif obj = *ptr++; WSTACK_PUSH2(s, val-1, (UWord)ptr); } @@ -3049,7 +3030,7 @@ dec_term(ErtsDistExternal *edep, Sint sn = get_int32(ep); ep += 4; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) *objp = make_small(sn); #else if (MY_IS_SSMALL(sn)) { @@ -3371,7 +3352,7 @@ dec_term_atom_common: RefThing *rtp = (RefThing *) hp; ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) hp += REF_THING_HEAD_SIZE + ref_words/2 + 1; rtp->header = make_ref_thing_header(ref_words/2 + 1); #else @@ -3382,13 +3363,13 @@ dec_term_atom_common: } else { ExternalThing *etp = (ExternalThing *) hp; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1; #else hp += EXTERNAL_THING_HEAD_SIZE + ref_words; #endif -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) etp->header = make_external_ref_header(ref_words/2 + 1); #else etp->header = make_external_ref_header(ref_words); @@ -3401,7 +3382,7 @@ dec_term_atom_common: ref_num = &(etp->data.ui32[0]); } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) *(ref_num++) = ref_words /* 32-bit arity */; #endif ref_num[0] = r0; @@ -3409,7 +3390,7 @@ dec_term_atom_common: ref_num[i] = get_int32(ep); ep += 4; } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if ((1 + ref_words) % 2) ref_num[ref_words] = 0; #endif @@ -3561,12 +3542,7 @@ dec_term_atom_common: } *objp = make_export(hp); *hp++ = HEADER_EXPORT; -#if HALFWORD_HEAP - *((UWord *) (UWord) hp) = (UWord) erts_export_get_or_make_stub(mod, name, arity); - hp += 2; -#else *hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity); -#endif break; } break; @@ -4192,11 +4168,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, case EXPORT_DEF: { Export* ep = *((Export **) (export_val(obj) + 1)); -#if HALFWORD_HEAP - result += 2; -#else result += 1; -#endif result += encode_size_struct2(acmp, ep->code[0], dflags); result += encode_size_struct2(acmp, ep->code[1], dflags); result += encode_size_struct2(acmp, make_small(ep->code[2]), dflags); @@ -4311,7 +4283,7 @@ init_done: switch (tag) { case INTEGER_EXT: SKIP(4); -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) heap_size += BIG_UINT_HEAP_SIZE; #endif break; @@ -4400,7 +4372,7 @@ init_done: ep += 2; atom_extra_skip = 1 + 4*id_words; /* In case it is an external ref */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1; #else heap_size += EXTERNAL_THING_HEAD_SIZE + id_words; @@ -4486,11 +4458,7 @@ init_done: break; case EXPORT_EXT: terms += 3; -#if HALFWORD_HEAP - heap_size += 3; -#else heap_size += 2; -#endif break; case NEW_FUN_EXT: { diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index ec9296d034..1d2d75bc1e 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -310,9 +310,6 @@ typedef union { typedef struct proc_bin { Eterm thing_word; /* Subtag REFC_BINARY_SUBTAG. */ Uint size; /* Binary size in bytes. */ -#if HALFWORD_HEAP - void* dummy_ptr_padding__; -#endif struct erl_off_heap_header *next; Binary *val; /* Pointer to Binary structure. */ byte *bytes; /* Pointer to the actual data bytes. */ @@ -959,28 +956,14 @@ void erl_error(char*, va_list); /* copy.c */ Eterm copy_object(Eterm, Process*); -#if HALFWORD_HEAP -Uint size_object_rel(Eterm, Eterm*); -# define size_object(A) size_object_rel(A,NULL) - -Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base); -# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL) - -Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base); -# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL) - -#else /* !HALFWORD_HEAP */ - Uint size_object(Eterm); -# define size_object_rel(A,B) size_object(A) +#define size_object_rel(A,B) size_object(A) Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); -# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) +#define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); -# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) - -#endif +#define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, @@ -1180,7 +1163,7 @@ void bin_write(int, void*, byte*, size_t); int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */ struct Sint_buf { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) char s[22]; #else char s[12]; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 900616c981..c365b8859b 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1105,7 +1105,7 @@ io_list_vec_len(Eterm obj, int* vsize, Uint* csize, Uint p_v_size = 0; Uint p_c_size = 0; Uint p_in_clist = 0; - Uint total; /* Uint due to halfword emulator */ + Uint total; goto L_jump_start; /* avoid a push */ @@ -5248,25 +5248,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) break; case ERL_DRV_INT: /* signed int argument */ ERTS_DDT_CHK_ENOUGH_ARGS(1); -#if HALFWORD_HEAP - erts_bld_sint64(NULL, &need, (Sint64)ptr[0]); -#else /* check for bignum */ if (!IS_SSMALL((Sint)ptr[0])) need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ -#endif ptr++; depth++; break; case ERL_DRV_UINT: /* unsigned int argument */ ERTS_DDT_CHK_ENOUGH_ARGS(1); -#if HALFWORD_HEAP - erts_bld_uint64(NULL, &need, (Uint64)ptr[0]); -#else /* check for bignum */ if (!IS_USMALL(0, (Uint)ptr[0])) need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ -#endif ptr++; depth++; break; @@ -5465,10 +5457,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) break; case ERL_DRV_INT: /* signed int argument */ -#if HALFWORD_HEAP - erts_reserve_heap(&factory, BIG_NEED_SIZE(2)); - mess = erts_bld_sint64(&factory.hp, NULL, (Sint64)ptr[0]); -#else erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE); if (IS_SSMALL((Sint)ptr[0])) mess = make_small((Sint)ptr[0]); @@ -5476,15 +5464,10 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) mess = small_to_big((Sint)ptr[0], factory.hp); factory.hp += BIG_UINT_HEAP_SIZE; } -#endif ptr++; break; case ERL_DRV_UINT: /* unsigned int argument */ -#if HALFWORD_HEAP - erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64)); - mess = erts_bld_uint64(&factory.hp, NULL, (Uint64)ptr[0]); -#else erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE); if (IS_USMALL(0, (Uint)ptr[0])) mess = make_small((Uint)ptr[0]); @@ -5492,7 +5475,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) mess = uint_to_big((Uint)ptr[0], factory.hp); factory.hp += BIG_UINT_HEAP_SIZE; } -#endif ptr++; break; diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index bb871b05ba..14eeb0ee8f 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -285,62 +285,11 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f #else #error Neither 32 nor 64 bit architecture #endif -#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR) -# define HALFWORD_HEAP 1 -# define HALFWORD_ASSERT 0 -# define ASSERT_HALFWORD(COND) ASSERT(COND) -# undef ERTS_SIZEOF_TERM -# define ERTS_SIZEOF_TERM 4 -#else -# define HALFWORD_HEAP 0 -# define HALFWORD_ASSERT 0 -# define ASSERT_HALFWORD(COND) -#endif #if SIZEOF_VOID_P != SIZEOF_SIZE_T #error sizeof(void*) != sizeof(size_t) #endif -#if HALFWORD_HEAP - -#if SIZEOF_INT == 4 -typedef unsigned int Eterm; -typedef unsigned int Uint; -typedef int Sint; -#define ERTS_UINT_MAX UINT_MAX -#define ERTS_SIZEOF_ETERM SIZEOF_INT -#define ErtsStrToSint strtol -#else -#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' -#endif - -#if SIZEOF_VOID_P == SIZEOF_LONG -typedef unsigned long UWord; -typedef long SWord; -#define SWORD_CONSTANT(Const) Const##L -#define UWORD_CONSTANT(Const) Const##UL -#define ERTS_UWORD_MAX ULONG_MAX -#define ERTS_SWORD_MAX LONG_MAX -#elif SIZEOF_VOID_P == SIZEOF_INT -typedef unsigned int UWord; -typedef int SWord; -#define SWORD_CONSTANT(Const) Const -#define UWORD_CONSTANT(Const) Const##U -#define ERTS_UWORD_MAX UINT_MAX -#define ERTS_SWORD_MAX INT_MAX -#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG -typedef unsigned long long UWord; -typedef long long SWord; -#define SWORD_CONSTANT(Const) Const##LL -#define UWORD_CONSTANT(Const) Const##ULL -#define ERTS_UWORD_MAX ULLONG_MAX -#define ERTS_SWORD_MAX LLONG_MAX -#else -#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' -#endif - -#else /* !HALFWORD_HEAP */ - #if SIZEOF_VOID_P == SIZEOF_LONG typedef unsigned long Eterm; typedef unsigned long Uint; @@ -383,8 +332,6 @@ typedef Uint UWord; typedef Sint SWord; #define ERTS_UINT_MAX ERTS_UWORD_MAX -#endif /* HALFWORD_HEAP */ - typedef UWord BeamInstr; #ifndef HAVE_INT64 diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 342e91e983..28d1b38f75 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -898,7 +898,7 @@ tail_recur: Uint y2 = y1 < 0 ? -(Uint)y1 : y1; UINT32_HASH_STEP(y2, FUNNY_NUMBER2); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (y2 >> 32) UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2); #endif @@ -1019,7 +1019,7 @@ tail_recur: } d = BIG_DIGIT(ptr, k); k = sizeof(ErtsDigit); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (!(d >> 32)) k /= 2; #endif @@ -1989,7 +1989,7 @@ tail_recur: (atom_tab(atom_val(term))->slot.bucket.hvalue); break; case SMALL_DEF: -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) { Sint y1 = signed_val(term); Uint y2 = y1 < 0 ? -(Uint)y1 : y1; @@ -2598,11 +2598,7 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp) * Test for equality of two terms. * Returns 0 if not equal, or a non-zero value otherwise. */ -#if HALFWORD_HEAP -int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) -#else int eq(Eterm a, Eterm b) -#endif { DECLARE_WSTACK(stack); Sint sz; @@ -2992,7 +2988,6 @@ static int cmp_atoms(Eterm a, Eterm b) bb->name+3, bb->len-3); } -#if !HALFWORD_HEAP /* cmp(Eterm a, Eterm b) * For compatibility with HiPE - arith-based compare. */ @@ -3000,23 +2995,10 @@ Sint cmp(Eterm a, Eterm b) { return erts_cmp(a, b, 0, 0); } -#endif -#if HALFWORD_HEAP -static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base, - Eterm b, Eterm* b_base, - int exact, int eq_only); -#else static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only); -#endif -#if HALFWORD_HEAP -Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base, - Eterm b, Eterm* b_base, - int exact, int eq_only) -#else Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) -#endif { if (is_atom(a) && is_atom(b)) { return cmp_atoms(a, b); @@ -3028,11 +3010,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) GET_DOUBLE_REL(b, bf, b_base); return float_comp(af.fd, bf.fd); } -#if HALFWORD_HEAP - return erts_cmp_compound_rel_opt(a,a_base,b,b_base,exact,eq_only); -#else return erts_cmp_compound(a,b,exact,eq_only); -#endif } @@ -3040,13 +3018,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) * exact = 1 -> term-based compare * exact = 0 -> arith-based compare */ -#if HALFWORD_HEAP -static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base, - Eterm b, Eterm* b_base, - int exact, int eq_only) -#else static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) -#endif { #define PSTACK_TYPE struct erts_cmp_hashmap_state struct erts_cmp_hashmap_state { @@ -3551,13 +3523,8 @@ tailrecur_ne: { FloatDef f1, f2; Eterm big; -#if HALFWORD_HEAP - Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base); - Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base); -#else Eterm aw = a; Eterm bw = b; -#endif #define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) #define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) #define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */ @@ -4369,7 +4336,7 @@ iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSi { int res, init_yield_count, yield_count; Eterm* objp; - Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */ + Uint size = (Uint) *sizep; DECLARE_ESTACK(s); if (!yield_support) diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 8aff6c1865..0317a95e8b 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -895,7 +895,7 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num, TRACE_C('N'); response[0] = FILE_RESP_NUMERR; -#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP +#if SIZEOF_VOID_P == 4 put_int32(0, response+1); #else put_int32(num>>32, response+1); @@ -964,7 +964,7 @@ static int reply_Uint(file_descriptor *desc, Uint result) { TRACE_C('R'); tmp[0] = FILE_RESP_NUMBER; -#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP +#if SIZEOF_VOID_P == 4 put_int32(0, tmp+1); #else put_int32(result>>32, tmp+1); diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 754047829f..e6d0e1e281 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -2453,7 +2453,6 @@ Eterm erts_mmap_debug_info(Process* p) UWord values[4]; Eterm *hp, *hp_end; Uint may_need; - const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2; erts_smp_mtx_lock(&mmap_state.mtx); values[0] = (UWord)mmap_state.sa.bot; @@ -2464,7 +2463,7 @@ Eterm erts_mmap_debug_info(Process* p) sua_list = build_free_seg_list(p, &mmap_state.sua.map); erts_smp_mtx_unlock(&mmap_state.mtx); - may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3); + may_need = 4*(2+3+2) + 2*(2+3); hp = HAlloc(p, may_need); hp_end = hp + may_need; diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 0d51aad863..8073d5b908 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -107,9 +107,6 @@ const ErtsMsegOpt_t erts_mseg_default_opt = { 0, /* Absolute shrink threshold */ 0, /* Relative shrink threshold */ 0 /* Scheduler specific */ -#if HALFWORD_HEAP - ,0 /* need low memory */ -#endif }; @@ -184,12 +181,7 @@ struct ErtsMsegAllctr_t_ { MemKind* mk_list; -#if HALFWORD_HEAP - MemKind low_mem; - MemKind hi_mem; -#else MemKind the_mem; -#endif Uint max_cache_size; Uint abs_max_cache_bad_fit; @@ -309,11 +301,6 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) #endif void *seg; Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; @@ -334,11 +321,6 @@ static ERTS_INLINE void mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) { Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; @@ -360,11 +342,6 @@ mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWor #endif void *new_seg; Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; @@ -768,11 +745,7 @@ void erts_mseg_clear_cache(void) { static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, const ErtsMsegOpt_t *opt) { -#if HALFWORD_HEAP - return opt->low_mem ? &ma->low_mem : &ma->hi_mem; -#else return &ma->the_mem; -#endif } static void * @@ -1326,12 +1299,7 @@ erts_mseg_info(int ix, ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); -#if HALFWORD_HEAP - values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); -#else values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); -#endif if (hpp || szp) res = bld_2tup_list(hpp, szp, n, atoms, values); @@ -1488,15 +1456,6 @@ erts_mseg_init(ErtsMsegInit_t *init) erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); -#if HALFWORD_HEAP - if (sizeof(void *) != 8) - erl_exit(-1,"Halfword emulator cannot be run in 32bit mode"); - - init->mmap.virtual_range.start = (char *) sbrk(0); - init->mmap.virtual_range.end = (char *) 0x100000000UL; - init->mmap.sco = 0; -#endif - erts_mmap_init(&init->mmap); if (!IS_2POW(GET_PAGE_SIZE)) @@ -1531,12 +1490,7 @@ erts_mseg_init(ErtsMsegInit_t *init) ma->mk_list = NULL; -#if HALFWORD_HEAP - mem_kind_init(ma, &ma->low_mem, "low memory"); - mem_kind_init(ma, &ma->hi_mem, "high memory"); -#else mem_kind_init(ma, &ma->the_mem, "all memory"); -#endif sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls)); } diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index ba04e919fc..656484702d 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -87,9 +87,6 @@ typedef struct { UWord abs_shrink_th; UWord rel_shrink_th; int sched_spec; -#if HALFWORD_HEAP - int low_mem; -#endif } ErtsMsegOpt_t; extern const ErtsMsegOpt_t erts_mseg_default_opt; diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 9a8c3585e6..e90ed94187 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -605,11 +605,7 @@ sub emulator_output { print "#ifdef ARCH_64\n"; print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; print "# define BEAM_LOOSE_MASK 0x1FFFUL\n"; - print "#if HALFWORD_HEAP\n"; - print "# define BEAM_TIGHT_MASK 0x1FFCUL\n"; - print "#else\n"; print "# define BEAM_TIGHT_MASK 0x1FF8UL\n"; - print "#endif\n"; print "# define BEAM_WIDE_SHIFT 32\n"; print "# define BEAM_LOOSE_SHIFT 16\n"; print "# define BEAM_TIGHT_SHIFT 16\n"; -- cgit v1.2.3 From 49e744df7a31e329c03567f3bd7cfb72e4a555d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 17 Jun 2015 21:03:53 +0200 Subject: erts: Remove halfword in erl_driver.h --- erts/emulator/beam/erl_driver.h | 9 --------- 1 file changed, 9 deletions(-) diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 6b406d069c..ef2d41e7a2 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -57,10 +57,6 @@ # define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG # undef SIZEOF_LONG_LONG #endif -#ifdef HALFWORD_HEAP_EMULATOR -# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR -# undef HALFWORD_HEAP_EMULATOR -#endif #include "erl_int_sizes_config.h" #if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR # error SIZEOF_CHAR mismatch @@ -78,11 +74,6 @@ # error SIZEOF_LONG_LONG mismatch #endif -/* This is OK to override by the NIF/driver implementor */ -#if defined(HALFWORD_HEAP_EMULATOR_SAVED__) && !defined(HALFWORD_HEAP_EMULATOR) -#define HALFWORD_HEAP_EMULATOR HALFWORD_HEAP_EMULATOR_SAVED__ -#endif - #include "erl_drv_nif.h" #include -- cgit v1.2.3 From 16b83562b0d2e9f9892744dcbf7894ef7d18a82a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 17 Jun 2015 21:08:52 +0200 Subject: erts: Remove halfword in erl_nif.h --- erts/emulator/beam/erl_nif.h | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 7d880126f8..5da6bb877a 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -86,10 +86,6 @@ # define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG # undef SIZEOF_LONG_LONG #endif -#ifdef HALFWORD_HEAP_EMULATOR -# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR -# undef HALFWORD_HEAP_EMULATOR -#endif #include "erl_int_sizes_config.h" #ifdef __cplusplus @@ -109,16 +105,11 @@ typedef long long ErlNifSInt64; #error No 64-bit integer type #endif -#ifdef HALFWORD_HEAP_EMULATOR -# define ERL_NIF_VM_VARIANT "beam.halfword" -typedef unsigned int ERL_NIF_TERM; -#else -# define ERL_NIF_VM_VARIANT "beam.vanilla" -# if SIZEOF_LONG == SIZEOF_VOID_P +#define ERL_NIF_VM_VARIANT "beam.vanilla" +#if SIZEOF_LONG == SIZEOF_VOID_P typedef unsigned long ERL_NIF_TERM; -# elif SIZEOF_LONG_LONG == SIZEOF_VOID_P +#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P typedef unsigned long long ERL_NIF_TERM; -# endif #endif typedef ERL_NIF_TERM ERL_NIF_UINT; -- cgit v1.2.3 From f3a0dc2a3b2ef161b83994a374ef2a447328098e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 11:20:53 +0200 Subject: erts: Remove halfword in lib_src --- erts/include/erl_int_sizes_config.h.in | 3 --- erts/include/internal/erl_printf_format.h | 9 --------- erts/lib_src/common/erl_printf_format.c | 12 ++---------- 3 files changed, 2 insertions(+), 22 deletions(-) diff --git a/erts/include/erl_int_sizes_config.h.in b/erts/include/erl_int_sizes_config.h.in index b18f5ebc00..88c74cdeff 100644 --- a/erts/include/erl_int_sizes_config.h.in +++ b/erts/include/erl_int_sizes_config.h.in @@ -35,6 +35,3 @@ /* The size of a pointer. */ #undef SIZEOF_VOID_P - -/* Define if building a halfword-heap 64bit emulator (needed for NIF's) */ -#undef HALFWORD_HEAP_EMULATOR diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h index efd926be99..c41c5ba820 100644 --- a/erts/include/internal/erl_printf_format.h +++ b/erts/include/internal/erl_printf_format.h @@ -44,7 +44,6 @@ typedef long long ErlPfSWord; #error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' #endif - typedef int (*fmtfn_t)(void*, char*, size_t); extern int erts_printf_format(fmtfn_t, void*, char*, va_list); @@ -57,17 +56,9 @@ extern int erts_printf_uword(fmtfn_t, void*, char, int, int, ErlPfUWord); extern int erts_printf_sword(fmtfn_t, void*, char, int, int, ErlPfSWord); extern int erts_printf_double(fmtfn_t, void *, char, int, int, double); -#ifdef HALFWORD_HEAP_EMULATOR -# if SIZEOF_INT != 4 -# error Unsupported integer size for HALFWORD_HEAP_EMULATOR -# endif -typedef unsigned int ErlPfEterm; -#else typedef ErlPfUWord ErlPfEterm; -#endif extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*); - #endif /* ERL_PRINTF_FORMAT_H__ */ diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 307680505c..9e70f4e882 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -78,15 +78,7 @@ #endif #ifndef ERTS_SIZEOF_ETERM -# ifdef HALFWORD_HEAP_EMULATOR -# if SIZEOF_VOID_P == 8 -# define ERTS_SIZEOF_ETERM 4 -# else -# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture" -# endif -# else -# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P -# endif +#define ERTS_SIZEOF_ETERM SIZEOF_VOID_P #endif #if defined(__GNUC__) @@ -821,7 +813,7 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) } break; case FMTC_T: /* Eterm */ - case FMTC_R: { /* Eterm, Eterm* base (base ignored if !HALFWORD_HEAP) */ + case FMTC_R: { /* Eterm, Eterm* base */ long prec; ErlPfEterm eterm; ErlPfEterm* eterm_base; -- cgit v1.2.3 From c5ee304b5e73a5e5a9ac38c1180971baa051824b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 11:28:09 +0200 Subject: erts: Remove halfword from configure --- configure.in | 4 ---- erts/configure.in | 44 -------------------------------------------- 2 files changed, 48 deletions(-) diff --git a/configure.in b/configure.in index 64b0bdac6d..e8c8680e19 100644 --- a/configure.in +++ b/configure.in @@ -208,10 +208,6 @@ AS_HELP_STRING([--disable-threads], [disable async thread support])) AC_ARG_ENABLE(dirty-schedulers, 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). 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]) AS_HELP_STRING([--disable-smp-support], [disable smp support])) diff --git a/erts/configure.in b/erts/configure.in index 22ca7ec17d..293ff825f8 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -143,14 +143,6 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), *) enable_dirty_schedulers=yes ;; esac ], enable_dirty_schedulers=no) -AC_ARG_ENABLE(halfword-emulator, -AS_HELP_STRING([--enable-halfword-emulator], - [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 ;; - esac ], enable_halfword_emulator=unknown) - AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) AS_HELP_STRING([--disable-smp-support], [disable smp support]), @@ -787,36 +779,6 @@ esac AC_SUBST(LIBCARBON) -dnl Check if we should/can build a halfword emulator - -AC_MSG_CHECKING(if we are building a halfword emulator (32bit heap on 64bit machine)) -if test "$enable_halfword_emulator" = "yes"; then - if test "$ARCH" = "amd64"; then - AC_DEFINE(HALFWORD_HEAP_EMULATOR, [1], - [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 < Date: Thu, 18 Jun 2015 14:30:28 +0200 Subject: erts: Remove halfword basic relative heap operations --- erts/emulator/beam/big.c | 2 +- erts/emulator/beam/copy.c | 48 +++--- erts/emulator/beam/erl_binary.h | 7 +- erts/emulator/beam/erl_db_hash.c | 2 +- erts/emulator/beam/erl_db_tree.c | 10 +- erts/emulator/beam/erl_db_util.c | 60 ++++---- erts/emulator/beam/erl_db_util.h | 2 +- erts/emulator/beam/erl_map.c | 16 +- erts/emulator/beam/erl_map.h | 9 +- erts/emulator/beam/erl_node_container_utils.h | 2 - erts/emulator/beam/erl_printf_term.c | 10 +- erts/emulator/beam/erl_term.h | 56 ------- erts/emulator/beam/io.c | 4 +- erts/emulator/beam/utils.c | 213 +++++++++++++------------- 14 files changed, 188 insertions(+), 253 deletions(-) diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 1e6582a7ca..8662398dcf 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1669,7 +1669,7 @@ double_to_big(double x, Eterm *heap, Uint hsz) sz = BIG_NEED_SIZE(ds); /* number of words including arity */ hp = heap; - res = make_big_rel(hp, heap); + res = make_big(hp); xp = (ErtsDigit*) (hp + 1); ASSERT(ds < hsz); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 94048f4c59..38c40f4e7d 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -80,7 +80,7 @@ Uint size_object(Eterm obj) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: sum += 2; - ptr = list_val_rel(obj,base); + ptr = list_val(obj); obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); @@ -89,11 +89,11 @@ Uint size_object(Eterm obj) break; case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val_rel(obj,base); + Eterm hdr = *boxed_val(obj); ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: - ptr = tuple_val_rel(obj,base); + ptr = tuple_val(obj); arity = header_arity(hdr); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ @@ -109,7 +109,7 @@ Uint size_object(Eterm obj) break; case FUN_SUBTAG: { - Eterm* bptr = fun_val_rel(obj,base); + Eterm* bptr = fun_val(obj); ErlFunThing* funp = (ErlFunThing *) bptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); @@ -130,7 +130,7 @@ Uint size_object(Eterm obj) { Uint n; flatmap_t *mp; - mp = (flatmap_t*)flatmap_val_rel(obj,base); + mp = (flatmap_t*)flatmap_val(obj); ptr = (Eterm *)mp; n = flatmap_get_size(mp) + 1; sum += n + 2; @@ -149,7 +149,7 @@ Uint size_object(Eterm obj) { Eterm *head; Uint sz; - head = hashmap_val_rel(obj, base); + head = hashmap_val(obj); sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); sum += 1 + sz + header_arity(hdr); head += 1 + header_arity(hdr); @@ -188,11 +188,11 @@ Uint size_object(Eterm obj) } else { extra_bytes = 0; } - hdr = *binary_val_rel(real_bin,base); + hdr = *binary_val(real_bin); if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { - sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes); + sum += heap_bin_size(binary_size(obj)+extra_bytes); } goto pop_next; } @@ -259,7 +259,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: argp = &res; - objp = list_val_rel(obj,src_base); + objp = list_val(obj); goto L_copy_list; case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; default: @@ -277,7 +277,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) hp++; break; case TAG_PRIMARY_LIST: - objp = list_val_rel(obj,src_base); + objp = list_val(obj); if (in_area(objp,hstart,hsize)) { hp++; break; @@ -300,12 +300,12 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) tailp = &CDR(htop); htop += 2; } - *tp = make_list_rel(tailp - 1, dst_base); + *tp = make_list(tailp - 1); obj = CDR(objp); if (!is_list(obj)) { break; } - objp = list_val_rel(obj,src_base); + objp = list_val(obj); } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; @@ -317,21 +317,21 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) { + if (in_area(boxed_val(obj),hstart,hsize)) { hp++; break; } argp = hp++; L_copy_boxed: - objp = boxed_val_rel(obj, src_base); + objp = boxed_val(obj); hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int const_flag = 1; /* assume constant tuple */ i = arityval(hdr); - *argp = make_tuple_rel(htop, dst_base); + *argp = make_tuple(htop); tp = htop; /* tp is pointer to new arity value */ *htop++ = *objp++; /* copy arity value */ while (i--) { @@ -360,7 +360,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) while (i--) { *tp++ = *objp++; } - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); pb = (ProcBin*) hbot; erts_refc_inc(&pb->val->refc, 2); pb->next = off_heap->first; @@ -387,7 +387,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) extra_bytes = 0; } real_size = size+extra_bytes; - objp = binary_val_rel(real_bin,src_base); + objp = binary_val(real_bin); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) objp; ErlHeapBin* to; @@ -417,7 +417,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) to; OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); } - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); if (extra_bytes != 0) { ErlSubBin* res; hbot -= ERL_SUB_BIN_SIZE; @@ -429,7 +429,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) res->offs = 0; res->is_writable = 0; res->orig = *argp; - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); } break; } @@ -447,7 +447,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; erts_refc_inc(&funp->fe->refc, 2); - *argp = make_fun_rel(tp, dst_base); + *argp = make_fun(tp); } break; case EXTERNAL_PID_SUBTAG: @@ -467,7 +467,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*)etp; erts_refc_inc(&etp->node->refc, 2); - *argp = make_external_rel(tp, dst_base); + *argp = make_external(tp); } break; case MAP_SUBTAG: @@ -475,7 +475,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) switch (MAP_HEADER_TYPE(hdr)) { case MAP_HEADER_TAG_FLATMAP_HEAD : i = flatmap_get_size(objp) + 3; - *argp = make_flatmap_rel(htop, dst_base); + *argp = make_flatmap(htop); while (i--) { *htop++ = *objp++; } @@ -486,7 +486,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) case MAP_HEADER_TAG_HAMT_NODE_BITMAP : i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr)); while (i--) { *htop++ = *objp++; } - *argp = make_hashmap_rel(tp, dst_base); + *argp = make_hashmap(tp); break; default: erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); @@ -499,7 +499,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) i = thing_arityval(hdr)+1; hbot -= i; tp = hbot; - *argp = make_boxed_rel(hbot, dst_base); + *argp = make_boxed(hbot); while (i--) { *tp++ = *objp++; } diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index ea01bf08f0..d24d041530 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -72,7 +72,6 @@ typedef struct erl_heap_bin { */ #define binary_size(Bin) (binary_val(Bin)[1]) -#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1]) #define binary_bitsize(Bin) \ ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ @@ -100,7 +99,7 @@ typedef struct erl_heap_bin { #define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \ do { \ - Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \ + Eterm* _real_bin = binary_val(Bin); \ Uint _offs = 0; \ Bitoffs = Bitsize = 0; \ if (*_real_bin == HEADER_SUB_BIN) { \ @@ -108,7 +107,7 @@ do { \ _offs = _sb->offs; \ Bitoffs = _sb->bitoffs; \ Bitsize = _sb->bitsize; \ - _real_bin = binary_val_rel(_sb->orig,BasePtr); \ + _real_bin = binary_val(_sb->orig); \ } \ if (*_real_bin == HEADER_PROC_BIN) { \ Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \ @@ -135,7 +134,7 @@ do { \ #define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \ do { \ - ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \ + ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ if (_sb->thing_word == HEADER_SUB_BIN) { \ RealBin = _sb->orig; \ ByteOffset = _sb->offs; \ diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index fc1aa05ed2..80563e1f02 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -2193,7 +2193,7 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl) erts_print(to, to_arg, "key=%R", key, list->dbterm.tpl); } else { - Eterm obj = make_tuple_rel(list->dbterm.tpl,list->dbterm.tpl); + Eterm obj = make_tuple(list->dbterm.tpl); erts_print(to, to_arg, "%R", obj, list->dbterm.tpl); } if (list->next != 0) diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index c21eac6f25..3b698a6adf 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -2745,7 +2745,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) return cmp_rel(a,NULL,b,b_base); } aa = list_val(a); - bb = list_val_rel(b,b_base); + bb = list_val(b); while (1) { if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) return j; @@ -2754,20 +2754,20 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) if (is_not_list(*aa) || is_not_list(*bb)) return do_cmp_partly_bound(*aa, *bb, b_base, done); aa = list_val(*aa); - bb = list_val_rel(*bb,b_base); + bb = list_val(*bb); } case TAG_PRIMARY_BOXED: if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { return cmp_rel(a,NULL,b,b_base); } a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; - b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; if (a_hdr != b_hdr) { return cmp_rel(a, NULL, b, b_base); } if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { aa = tuple_val(a); - bb = tuple_val_rel(b, b_base); + bb = tuple_val(b); /* compare the arities */ i = arityval(*aa); /* get the arity*/ if (i < arityval(*bb)) return(-1); @@ -3154,7 +3154,7 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show, } else { prefix = ""; - term = make_tuple_rel(t->dbterm.tpl,t->dbterm.tpl); + term = make_tuple(t->dbterm.tpl); } erts_print(to, to_arg, "%*s%s%R (addr = %p, bal = %d)\n", offset, "", prefix, term, t->dbterm.tpl, diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 0086aa8121..432ca297e9 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1903,9 +1903,9 @@ restart: variables[n].term = dpm_array_to_list(psp, termp, arity); break; case matchTuple: /* *ep is a tuple of arity n */ - if (!is_tuple_rel(*ep,base)) + if (!is_tuple(*ep)) FAIL(); - ep = tuple_val_rel(*ep,base); + ep = tuple_val(*ep); n = *pc++; if (arityval(*ep) != n) FAIL(); @@ -1913,9 +1913,9 @@ restart: break; case matchPushT: /* *ep is a tuple of arity n, push ptr to first element */ - if (!is_tuple_rel(*ep,base)) + if (!is_tuple(*ep)) FAIL(); - tp = tuple_val_rel(*ep,base); + tp = tuple_val(*ep); n = *pc++; if (arityval(*tp) != n) FAIL(); @@ -1925,51 +1925,51 @@ restart: case matchList: if (!is_list(*ep)) FAIL(); - ep = list_val_rel(*ep,base); + ep = list_val(*ep); break; case matchPushL: if (!is_list(*ep)) FAIL(); - *sp++ = list_val_rel(*ep,base); + *sp++ = list_val(*ep); ++ep; break; case matchMap: - if (!is_map_rel(*ep, base)) { + if (!is_map(*ep)) { FAIL(); } n = *pc++; - if (is_flatmap_rel(*ep,base)) { - if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + if (is_flatmap(*ep)) { + if (flatmap_get_size(flatmap_val(*ep)) < n) { FAIL(); } } else { - ASSERT(is_hashmap_rel(*ep,base)); - if (hashmap_size_rel(*ep, base) < n) { + ASSERT(is_hashmap(*ep)); + if (hashmap_size(*ep) < n) { FAIL(); } } - ep = flatmap_val_rel(*ep, base); + ep = flatmap_val(*ep); break; case matchPushM: - if (!is_map_rel(*ep, base)) { + if (!is_map(*ep)) { FAIL(); } n = *pc++; - if (is_flatmap_rel(*ep,base)) { - if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + if (is_flatmap(*ep)) { + if (flatmap_get_size(flatmap_val(*ep)) < n) { FAIL(); } } else { - ASSERT(is_hashmap_rel(*ep,base)); - if (hashmap_size_rel(*ep, base) < n) { + ASSERT(is_hashmap(*ep)); + if (hashmap_size(*ep) < n) { FAIL(); } } - *sp++ = flatmap_val_rel(*ep++, base); + *sp++ = flatmap_val(*ep++); break; case matchKey: t = (Eterm) *pc++; - tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base); + tp = erts_maps_get(t, make_boxed(ep)); if (!tp) { FAIL(); } @@ -2001,18 +2001,18 @@ restart: ++ep; break; case matchEqFloat: - if (!is_float_rel(*ep,base)) + if (!is_float(*ep)) FAIL(); - if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double))) + if (memcmp(float_val(*ep) + 1, pc, sizeof(double))) FAIL(); pc += TermWords(2); ++ep; break; case matchEqRef: { Eterm* epc = (Eterm*)pc; - if (!is_ref_rel(*ep,base)) + if (!is_ref(*ep)) FAIL(); - if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) { + if (!eq_rel(make_internal_ref(epc), epc, *ep, base)) { FAIL(); } i = thing_arityval(*epc); @@ -2021,9 +2021,9 @@ restart: break; } case matchEqBig: - if (!is_big_rel(*ep,base)) + if (!is_big(*ep)) FAIL(); - tp = big_val_rel(*ep,base); + tp = big_val(*ep); { Eterm *epc = (Eterm *) pc; if (*tp != *epc) @@ -2193,8 +2193,8 @@ restart: sz = size_object_rel(term, base); top = HAllocX(build_proc, sz, HEAP_XTRA); if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) { - ASSERT(is_tuple_rel(term,base)); - *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz, + ASSERT(is_tuple(term)); + *esp++ = copy_shallow_rel(tuple_val(term), sz, &top, &MSO(build_proc), base); } else { @@ -2741,7 +2741,7 @@ void db_do_update_element(DbUpdateHandle* handle, case _TAG_HEADER_HEAP_BIN: newval_sz = header_arity(*newp) + 1; if (is_boxed(oldval)) { - oldp = boxed_val_rel(oldval,old_base); + oldp = boxed_val(oldval); switch (*oldp & _TAG_HEADER_MASK) { case _TAG_HEADER_POS_BIG: case _TAG_HEADER_NEG_BIG: @@ -3023,7 +3023,7 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) tmp_offheap.first = NULL; { - copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top, + copy_struct_rel(make_tuple(tpl), handle->new_size, &top, &tmp_offheap, tpl, top); newDbTerm->first_oh = tmp_offheap.first; ASSERT((byte*)top == (newp + alloc_sz)); @@ -5228,7 +5228,7 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, } else base = NULL; - res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0, + res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), base, NULL, 0, ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); if (is_value(res) && hpp!=NULL) { diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index c2128888c5..d07e61e599 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -306,7 +306,7 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) { if (!tb->compress) { - return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl); + return eq_rel(a, NULL, make_tuple(b->tpl), b->tpl); } else { return db_eq_comp(tb, a, b); diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 6d496ea5ee..500234c436 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -173,19 +173,19 @@ const Eterm * erts_maps_get(Eterm key, Eterm map) { Uint32 hx; - if (is_flatmap_rel(map, map_base)) { + if (is_flatmap(map)) { Eterm *ks, *vs; flatmap_t *mp; Uint n, i; - mp = (flatmap_t *)flatmap_val_rel(map, map_base); + mp = (flatmap_t *)flatmap_val(map); n = flatmap_get_size(mp); if (n == 0) { return NULL; } - ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; + ks = (Eterm *)tuple_val(mp->keys) + 1; vs = flatmap_get_values(mp); if (is_immed(key)) { @@ -203,10 +203,10 @@ erts_maps_get(Eterm key, Eterm map) } return NULL; } - ASSERT(is_hashmap_rel(map, map_base)); + ASSERT(is_hashmap(map)); hx = hashmap_make_hash(key); - return erts_hashmap_get_rel(hx, key, map, map_base); + return erts_hashmap_get(hx, key, map); } BIF_RETTYPE maps_find_2(BIF_ALIST_2) { @@ -1998,7 +1998,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) UseTmpHeapNoproc(2); ASSERT(is_boxed(node)); - ptr = boxed_val_rel(node, map_base); + ptr = boxed_val(node); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(is_hashmap_header_head(hdr)); @@ -2019,7 +2019,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) node = ptr[ix+1]; if (is_list(node)) { /* LEAF NODE [K|V] */ - ptr = list_val_rel(node,map_base); + ptr = list_val(node); res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL; break; } @@ -2027,7 +2027,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) hx = hashmap_shift_hash(th,hx,lvl,key); ASSERT(is_boxed(node)); - ptr = boxed_val_rel(node, map_base); + ptr = boxed_val(node); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(!is_hashmap_header_head(hdr)); diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index 2f7c55829f..be6f791a4e 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -57,7 +57,6 @@ typedef struct flatmap_s { #define hashmap_size(x) (((hashmap_head_t*) hashmap_val(x))->size) -#define hashmap_size_rel(RTERM, BASE) hashmap_size(rterm2wterm(RTERM, BASE)) #define hashmap_make_hash(Key) make_internal_hash(Key) #define hashmap_restore_hash(Heap,Lvl,Key) \ @@ -104,13 +103,9 @@ Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int rejec Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint n, Eterm k, Eterm v); -const Eterm * -erts_maps_get(Eterm key, Eterm map); -#define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B) +const Eterm *erts_maps_get(Eterm key, Eterm map); -const Eterm * -erts_hashmap_get(Uint32 hx, Eterm key, Eterm map); -#define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M) +const Eterm *erts_hashmap_get(Uint32 hx, Eterm key, Eterm map); /* hamt nodes v2.0 * diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 0a4b18b748..b6a3531e28 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -328,8 +328,6 @@ extern ErtsPTab erts_port; : external_ref_channel_no((x))) #define is_ref(x) (is_internal_ref((x)) \ || is_external_ref((x))) -#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \ - || is_external_ref_rel((x),Base)) #define is_not_ref(x) (!is_ref(x)) #endif diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 95b3572372..7a40f775f2 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -123,7 +123,7 @@ is_printable_string(Eterm list, Eterm* base) int c; while(is_list(list)) { - Eterm* consp = list_val_rel(list, base); + Eterm* consp = list_val(list); Eterm hd = CAR(consp); if (!is_byte(hd)) @@ -308,7 +308,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, obj = (Eterm) popped.word; L_print_one_cons: { - Eterm* cons = list_val_rel(obj, obj_base); + Eterm* cons = list_val(obj); Eterm tl; obj = CAR(cons); @@ -423,7 +423,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, if (is_printable_string(obj, obj_base)) { int c; PRINT_CHAR(res, fn, arg, '"'); - nobj = list_val_rel(obj, obj_base); + nobj = list_val(obj); while (1) { if ((*dcount)-- <= 0) goto L_done; @@ -437,7 +437,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } if (is_not_list(*nobj)) break; - nobj = list_val_rel(*nobj, obj_base); + nobj = list_val(*nobj); } PRINT_CHAR(res, fn, arg, '"'); } else { @@ -468,7 +468,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } else { byte* bytep; - Uint bytesize = binary_size_rel(obj,obj_base); + Uint bytesize = binary_size(obj); Uint bitoffs; Uint bitsize; byte octet; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 46900edfc7..ad4ef3c01a 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -977,27 +977,20 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #define MAP_HEADER_VAL(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ + MAP_HEADER_ARITY_SZ)) & (0xffff)) #define make_hashmap(x) make_boxed((Eterm*)(x)) -#define make_hashmap_rel make_boxed_rel #define is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x)))) #define is_not_hashmap(x) (!is_hashmap(x)) -#define is_hashmap_rel(RTERM,BASE) is_hashmap(rterm2wterm(RTERM,BASE)) #define is_hashmap_header(x) (((x) & (_HEADER_MAP_HASHMAP_HEAD_MASK)) == HAMT_SUBTAG_HEAD_ARRAY) #define hashmap_val(x) _unchecked_boxed_val((x)) -#define hashmap_val_rel(RTERM, BASE) hashmap_val(rterm2wterm(RTERM, BASE)) #define make_flatmap(x) make_boxed((Eterm*)(x)) -#define make_flatmap_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE)) #define is_flatmap(x) (is_boxed((x)) && is_flatmap_header(*boxed_val((x)))) -#define is_flatmap_rel(RTERM,BASE) is_flatmap(rterm2wterm(RTERM,BASE)) #define is_not_flatmap(x) (!is_flatmap((x))) #define is_flatmap_header(x) (((x) & (_HEADER_MAP_SUBTAG_MASK)) == HAMT_SUBTAG_HEAD_FLATMAP) #define flatmap_val(x) (_unchecked_boxed_val((x))) -#define flatmap_val_rel(RTERM, BASE) flatmap_val(rterm2wterm(RTERM, BASE)) #define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP) #define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val(x))) #define is_not_map(x) (!is_map(x)) -#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE)) /* number tests */ @@ -1127,55 +1120,6 @@ extern unsigned tag_val_def(Wterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) -#define ptr2rel(PTR,BASE) (PTR) -#define rterm2wterm(REL,BASE) (REL) - -#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE)) -#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE)) -#define make_fun_rel make_boxed_rel -#define make_binary_rel make_boxed_rel -#define make_tuple_rel make_boxed_rel -#define make_external_rel make_boxed_rel -#define make_internal_ref_rel make_boxed_rel -#define make_big_rel make_boxed_rel - -#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE)) -#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE)) -#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE)) -#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE)) -#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE)) -#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE)) -#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE)) -#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE)) -#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE)) - -#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE)) -#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE)) - -#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE)) -#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE)) - -#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE)) -#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE)) -#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE)) - -#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE)) -#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE)) -#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE)) -#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE)) -#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE)) -#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE)) - -#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f) - -#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE)) -#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE)) -#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE)) -#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE)) -#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE)) - -#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE)) - #define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index c365b8859b..6b4b90cb06 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -4091,10 +4091,10 @@ erts_port_control(Process* c_p, binp = NULL; if (is_binary(data) && binary_bitoffset(data) == 0) { - Eterm *ebinp = binary_val_rel(data, NULL); + Eterm *ebinp = binary_val(data); ASSERT(!tmp_alloced); if (*ebinp == HEADER_SUB_BIN) - ebinp = binary_val_rel(((ErlSubBin *) ebinp)->orig, NULL); + ebinp = binary_val(((ErlSubBin *) ebinp)->orig); if (*ebinp != HEADER_PROC_BIN) copy = 1; else { diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 28d1b38f75..9f919fa2ab 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2612,8 +2612,8 @@ tailrecur_ne: switch (primary_tag(a)) { case TAG_PRIMARY_LIST: if (is_list(b)) { - Eterm* aval = list_val_rel(a, a_base); - Eterm* bval = list_val_rel(b, b_base); + Eterm* aval = list_val(a); + Eterm* bval = list_val(b); while (1) { Eterm atmp = CAR(aval); Eterm btmp = CAR(bval); @@ -2633,22 +2633,22 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aval = list_val_rel(atmp, a_base); - bval = list_val_rel(btmp, b_base); + aval = list_val(atmp); + bval = list_val(btmp); } } break; /* not equal */ case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val_rel(a,a_base); + Eterm hdr = *boxed_val(a); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { - aa = tuple_val_rel(a, a_base); - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) + aa = tuple_val(a); + if (!is_boxed(b) || *boxed_val(b) != *aa) goto not_equal; - bb = tuple_val_rel(b,b_base); + bb = tuple_val(b); if ((sz = arityval(*aa)) == 0) goto pop_next; ++aa; ++bb; @@ -2667,11 +2667,11 @@ tailrecur_ne: Uint a_bitoffs; Uint b_bitoffs; - if (!is_binary_rel(b,b_base)) { + if (!is_binary(b)) { goto not_equal; } - a_size = binary_size_rel(a,a_base); - b_size = binary_size_rel(b,b_base); + a_size = binary_size(a); + b_size = binary_size(b); if (a_size != b_size) { goto not_equal; } @@ -2687,9 +2687,9 @@ tailrecur_ne: } case EXPORT_SUBTAG: { - if (is_export_rel(b,b_base)) { - Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); - Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); + if (is_export(b)) { + Export* a_exp = *((Export **) (export_val(a) + 1)); + Export* b_exp = *((Export **) (export_val(b) + 1)); if (a_exp == b_exp) goto pop_next; } break; /* not equal */ @@ -2699,10 +2699,10 @@ tailrecur_ne: ErlFunThing* f1; ErlFunThing* f2; - if (!is_fun_rel(b,b_base)) + if (!is_fun(b)) goto not_equal; - f1 = (ErlFunThing *) fun_val_rel(a,a_base); - f2 = (ErlFunThing *) fun_val_rel(b,b_base); + f1 = (ErlFunThing *) fun_val(a); + f2 = (ErlFunThing *) fun_val(b); if (f1->fe->module != f2->fe->module || f1->fe->old_index != f2->fe->old_index || f1->fe->old_uniq != f2->fe->old_uniq || @@ -2720,15 +2720,15 @@ tailrecur_ne: ExternalThing *ap; ExternalThing *bp; - if(!is_external_rel(b,b_base)) + if(!is_external(b)) goto not_equal; - ap = external_thing_ptr_rel(a,a_base); - bp = external_thing_ptr_rel(b,b_base); + ap = external_thing_ptr(a); + bp = external_thing_ptr(b); if(ap->header == bp->header && ap->node == bp->node) { - ASSERT(1 == external_data_words_rel(a,a_base)); - ASSERT(1 == external_data_words_rel(b,b_base)); + ASSERT(1 == external_data_words(a)); + ASSERT(1 == external_data_words(b)); if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next; } @@ -2749,11 +2749,11 @@ tailrecur_ne: ExternalThing* athing; ExternalThing* bthing; - if(!is_external_ref_rel(b,b_base)) + if(!is_external_ref(b)) goto not_equal; - athing = external_thing_ptr_rel(a,a_base); - bthing = external_thing_ptr_rel(b,b_base); + athing = external_thing_ptr(a); + bthing = external_thing_ptr(b); if(athing->node != bthing->node) goto not_equal; @@ -2765,12 +2765,12 @@ tailrecur_ne: goto ref_common; case REF_SUBTAG: - if (!is_internal_ref_rel(b,b_base)) + if (!is_internal_ref(b)) goto not_equal; { - RefThing* athing = ref_thing_ptr_rel(a,a_base); - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + RefThing* athing = ref_thing_ptr(a); + RefThing* bthing = ref_thing_ptr(b); alen = internal_thing_ref_no_of_numbers(athing); blen = internal_thing_ref_no_of_numbers(bthing); anum = internal_thing_ref_numbers(athing); @@ -2820,10 +2820,10 @@ tailrecur_ne: { int i; - if (!is_big_rel(b,b_base)) + if (!is_big(b)) goto not_equal; - aa = big_val_rel(a,a_base); - bb = big_val_rel(b,b_base); + aa = big_val(a); + bb = big_val(b); if (*aa != *bb) goto not_equal; i = BIG_ARITY(aa); @@ -2838,19 +2838,19 @@ tailrecur_ne: FloatDef af; FloatDef bf; - if (is_float_rel(b,b_base)) { - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + if (is_float(b)) { + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); if (af.fd == bf.fd) goto pop_next; } break; /* not equal */ } case MAP_SUBTAG: - if (is_flatmap_rel(a, a_base)) { - aa = flatmap_val_rel(a, a_base); - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) + if (is_flatmap(a)) { + aa = flatmap_val(a); + if (!is_boxed(b) || *boxed_val(b) != *aa) goto not_equal; - bb = flatmap_val_rel(b,b_base); + bb = flatmap_val(b); sz = flatmap_get_size((flatmap_t*)aa); if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal; @@ -2862,11 +2862,11 @@ tailrecur_ne: goto term_array; } else { - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != hdr) + if (!is_boxed(b) || *boxed_val(b) != hdr) goto not_equal; - aa = hashmap_val_rel(a, a_base) + 1; - bb = hashmap_val_rel(b, b_base) + 1; + aa = hashmap_val(a) + 1; + bb = hashmap_val(b) + 1; switch (hdr & _HEADER_MAP_SUBTAG_MASK) { case HAMT_SUBTAG_HEAD_ARRAY: aa++; bb++; @@ -3004,10 +3004,10 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) return cmp_atoms(a, b); } else if (is_both_small(a, b)) { return (signed_val(a) - signed_val(b)); - } else if (is_float_rel(a, a_base) && is_float_rel(b, b_base)) { + } else if (is_float(a) && is_float(b)) { FloatDef af, bf; - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); return float_comp(af.fd, bf.fd); } return erts_cmp_compound(a,b,exact,eq_only); @@ -3111,9 +3111,9 @@ tailrecur_ne: if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port_rel(b,b_base)) { - bnode = external_port_node_rel(b,b_base); - bdata = external_port_data_rel(b,b_base); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); } else { a_tag = PORT_DEF; goto mixed_types; @@ -3129,9 +3129,9 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid_rel(b,b_base)) { - bnode = external_pid_node_rel(b,b_base); - bdata = external_pid_data_rel(b,b_base); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); } else { a_tag = PID_DEF; goto mixed_types; @@ -3164,8 +3164,8 @@ tailrecur_ne: a_tag = LIST_DEF; goto mixed_types; } - aa = list_val_rel(a,a_base); - bb = list_val_rel(b,b_base); + aa = list_val(a); + bb = list_val(b); while (1) { Eterm atmp = CAR(aa); Eterm btmp = CAR(bb); @@ -3185,20 +3185,20 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aa = list_val_rel(atmp,a_base); - bb = list_val_rel(btmp,b_base); + aa = list_val(atmp); + bb = list_val(btmp); } case TAG_PRIMARY_BOXED: { - Eterm ahdr = *boxed_val_rel(a,a_base); + Eterm ahdr = *boxed_val(a); switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): - if (!is_tuple_rel(b,b_base)) { + if (!is_tuple(b)) { a_tag = TUPLE_DEF; goto mixed_types; } - aa = tuple_val_rel(a,a_base); - bb = tuple_val_rel(b,b_base); + aa = tuple_val(a); + bb = tuple_val(b); /* compare the arities */ i = arityval(ahdr); /* get the arity*/ if (i != arityval(*bb)) { @@ -3214,18 +3214,18 @@ tailrecur_ne: { struct erts_cmp_hashmap_state* sp; if (is_flatmap_header(ahdr)) { - if (!is_flatmap_rel(b,b_base)) { - if (is_hashmap_rel(b,b_base)) { - aa = (Eterm *)flatmap_val_rel(a,a_base); - i = flatmap_get_size((flatmap_t*)aa) - hashmap_size_rel(b,b_base); + if (!is_flatmap(b)) { + if (is_hashmap(b)) { + aa = (Eterm *)flatmap_val(a); + i = flatmap_get_size((flatmap_t*)aa) - hashmap_size(b); ASSERT(i != 0); RETURN_NEQ(i); } a_tag = MAP_DEF; goto mixed_types; } - aa = (Eterm *)flatmap_val_rel(a,a_base); - bb = (Eterm *)flatmap_val_rel(b,b_base); + aa = (Eterm *)flatmap_val(a); + bb = (Eterm *)flatmap_val(b); i = flatmap_get_size((flatmap_t*)aa); if (i != flatmap_get_size((flatmap_t*)bb)) { @@ -3252,21 +3252,21 @@ tailrecur_ne: goto bodyrecur; } } - if (!is_hashmap_rel(b,b_base)) { - if (is_flatmap_rel(b,b_base)) { - bb = (Eterm *)flatmap_val_rel(b,b_base); - i = hashmap_size_rel(a,a_base) - flatmap_get_size((flatmap_t*)bb); + if (!is_hashmap(b)) { + if (is_flatmap(b)) { + bb = (Eterm *)flatmap_val(b); + i = hashmap_size(a) - flatmap_get_size((flatmap_t*)bb); ASSERT(i != 0); RETURN_NEQ(i); } a_tag = MAP_DEF; goto mixed_types; } - i = hashmap_size_rel(a,a_base) - hashmap_size_rel(b,b_base); + i = hashmap_size(a) - hashmap_size(b); if (i) { RETURN_NEQ(i); } - if (hashmap_size_rel(a,a_base) == 0) { + if (hashmap_size(a) == 0) { goto pop_next; } @@ -3301,31 +3301,31 @@ tailrecur_ne: goto bodyrecur; } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): - if (!is_float_rel(b,b_base)) { + if (!is_float(b)) { a_tag = FLOAT_DEF; goto mixed_types; } else { FloatDef af; FloatDef bf; - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); ON_CMP_GOTO(float_comp(af.fd, bf.fd)); } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - if (!is_big_rel(b,b_base)) { + if (!is_big(b)) { a_tag = BIG_DEF; goto mixed_types; } - ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base))); + ON_CMP_GOTO(big_comp(a, b)); case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): - if (!is_export_rel(b,b_base)) { + if (!is_export(b)) { a_tag = EXPORT_DEF; goto mixed_types; } else { - Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); - Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); + Export* a_exp = *((Export **) (export_val(a) + 1)); + Export* b_exp = *((Export **) (export_val(b) + 1)); if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { RETURN_NEQ(j); @@ -3337,12 +3337,12 @@ tailrecur_ne: } break; case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): - if (!is_fun_rel(b,b_base)) { + if (!is_fun(b)) { a_tag = FUN_DEF; goto mixed_types; } else { - ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base); - ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base); + ErlFunThing* f1 = (ErlFunThing *) fun_val(a); + ErlFunThing* f2 = (ErlFunThing *) fun_val(b); Sint diff; diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name, @@ -3374,29 +3374,29 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid_rel(b,b_base)) { - bnode = external_pid_node_rel(b,b_base); - bdata = external_pid_data_rel(b,b_base); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); } else { a_tag = EXTERNAL_PID_DEF; goto mixed_types; } - anode = external_pid_node_rel(a,a_base); - adata = external_pid_data_rel(a,a_base); + anode = external_pid_node(a); + adata = external_pid_data(a); goto pid_common; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port_rel(b,b_base)) { - bnode = external_port_node_rel(b,b_base); - bdata = external_port_data_rel(b,b_base); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); } else { a_tag = EXTERNAL_PORT_DEF; goto mixed_types; } - anode = external_port_node_rel(a,a_base); - adata = external_port_data_rel(a,a_base); + anode = external_port_node(a); + adata = external_port_data(a); goto port_common; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): /* @@ -3404,14 +3404,13 @@ tailrecur_ne: * (32-bit words), *not* ref data words. */ - - if (is_internal_ref_rel(b,b_base)) { - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + if (is_internal_ref(b)) { + RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; bnum = internal_thing_ref_numbers(bthing); blen = internal_thing_ref_no_of_numbers(bthing); - } else if(is_external_ref_rel(b,b_base)) { - ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + } else if(is_external_ref(b)) { + ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); blen = external_thing_ref_no_of_numbers(bthing); @@ -3420,7 +3419,7 @@ tailrecur_ne: goto mixed_types; } { - RefThing* athing = ref_thing_ptr_rel(a,a_base); + RefThing* athing = ref_thing_ptr(a); anode = erts_this_node; anum = internal_thing_ref_numbers(athing); alen = internal_thing_ref_no_of_numbers(athing); @@ -3453,13 +3452,13 @@ tailrecur_ne: RETURN_NEQ((Sint32) (anum[i] - bnum[i])); goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): - if (is_internal_ref_rel(b,b_base)) { - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + if (is_internal_ref(b)) { + RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; bnum = internal_thing_ref_numbers(bthing); blen = internal_thing_ref_no_of_numbers(bthing); - } else if (is_external_ref_rel(b,b_base)) { - ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + } else if (is_external_ref(b)) { + ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); blen = external_thing_ref_no_of_numbers(bthing); @@ -3468,7 +3467,7 @@ tailrecur_ne: goto mixed_types; } { - ExternalThing* athing = external_thing_ptr_rel(a,a_base); + ExternalThing* athing = external_thing_ptr(a); anode = athing->node; anum = external_thing_ref_numbers(athing); alen = external_thing_ref_no_of_numbers(athing); @@ -3476,13 +3475,13 @@ tailrecur_ne: goto ref_common; default: /* Must be a binary */ - ASSERT(is_binary_rel(a,a_base)); - if (!is_binary_rel(b,b_base)) { + ASSERT(is_binary(a)); + if (!is_binary(b)) { a_tag = BINARY_DEF; goto mixed_types; } else { - Uint a_size = binary_size_rel(a,a_base); - Uint b_size = binary_size_rel(b,b_base); + Uint a_size = binary_size(a); + Uint b_size = binary_size(b); Uint a_bitsize; Uint b_bitsize; Uint a_bitoffs; @@ -3596,7 +3595,7 @@ tailrecur_ne: } } else { big = double_to_big(f2.fd, big_buf, sizeof(big_buf)/sizeof(Eterm)); - j = big_comp(aw, rterm2wterm(big,big_buf)); + j = big_comp(aw, big); } if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) { j = -j; -- cgit v1.2.3 From 17bcc73e511eee06ca64d51edb401f8340fe9abc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 14:59:28 +0200 Subject: erts: Remove halfword pointer compression * Removed COMPRESS_POINTER and EXPAND_POINTER --- erts/emulator/beam/beam_bif_load.c | 6 ++--- erts/emulator/beam/beam_emu.c | 41 ++++++++++++++++------------------- erts/emulator/beam/erl_bif_op.c | 2 +- erts/emulator/beam/erl_gc.c | 4 ++-- erts/emulator/beam/erl_process.c | 2 +- erts/emulator/beam/erl_process_dump.c | 6 ++--- erts/emulator/beam/erl_term.h | 16 ++++++-------- erts/emulator/beam/external.c | 36 +++++++++++++++--------------- 8 files changed, 54 insertions(+), 59 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 0e192b1ebd..11508a1b39 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -913,7 +913,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (in_area(val, mod_start, mod_size)) { return 1; } break; @@ -933,7 +933,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (in_area(val, mod_start, mod_size)) { return 1; } break; @@ -943,7 +943,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) if (header_is_bin_matchstate(val)) { ErlBinMatchState *ms = (ErlBinMatchState*) p; ErlBinMatchBuffer *mb = &(ms->mb); - if (in_area(EXPAND_POINTER(mb->orig), mod_start, mod_size)) { + if (in_area(mb->orig, mod_start, mod_size)) { return 1; } } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 0c6181077c..f4111c19f1 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -620,46 +620,45 @@ void** beam_ops; #define GetTupleElement(Src, Element, Dest) \ do { \ - tmp_arg1 = (Eterm) COMPRESS_POINTER(((unsigned char *) tuple_val(Src)) + \ - (Element)); \ - (Dest) = (*(Eterm *) EXPAND_POINTER(tmp_arg1)); \ + tmp_arg1 = (Eterm) (((unsigned char *) tuple_val(Src)) + (Element));\ + (Dest) = (*(Eterm *) tmp_arg1); \ } while (0) #define ExtractNextElement(Dest) \ tmp_arg1 += sizeof(Eterm); \ - (Dest) = (* (Eterm *) (((unsigned char *) EXPAND_POINTER(tmp_arg1)))) + (Dest) = (* (Eterm *) (((unsigned char *) tmp_arg1))) #define ExtractNextElement2(Dest) \ do { \ Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \ } while (0) #define ExtractNextElement3(Dest) \ do { \ Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ - ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ + ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ tmp_arg1 += 3*sizeof(Eterm); \ } while (0) #define ExtractNextElement4(Dest) \ do { \ Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ - ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \ - ene_dstp[3] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[4]; \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ + ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ + ene_dstp[3] = ((Eterm *) tmp_arg1)[4]; \ tmp_arg1 += 4*sizeof(Eterm); \ } while (0) #define ExtractElement(Element, Dest) \ do { \ tmp_arg1 += (Element); \ - (Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \ + (Dest) = (* (Eterm *) tmp_arg1); \ } while (0) #define EqualImmed(X, Y, Action) if (X != Y) { Action; } @@ -698,8 +697,7 @@ void** beam_ops; #define IsArity(Pointer, Arity, Fail) \ if (*(Eterm *) \ - EXPAND_POINTER(tmp_arg1 = (Eterm) \ - COMPRESS_POINTER(tuple_val(Pointer))) != (Arity)) \ + (tmp_arg1 = (Eterm) (tuple_val(Pointer))) != (Arity)) \ { \ Fail; \ } @@ -742,8 +740,7 @@ void** beam_ops; do { \ if (is_not_tuple(Src) || \ *(Eterm *) \ - EXPAND_POINTER(tmp_arg1 = \ - (Eterm) COMPRESS_POINTER(tuple_val(Src))) != Arity) { \ + (tmp_arg1 = (Eterm) (tuple_val(Src))) != Arity) { \ Fail; \ } \ } while (0) @@ -3218,7 +3215,7 @@ do { \ SWAPIN; if (next != NULL) { r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); Dispatch(); @@ -3267,7 +3264,7 @@ do { \ SWAPIN; if (next != NULL) { r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); Dispatch(); @@ -3299,7 +3296,7 @@ do { \ SWAPIN; if (next != NULL) { r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); Dispatchfun(); @@ -3347,7 +3344,7 @@ do { \ SWAPIN; if (next != NULL) { r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); Dispatchfun(); diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index c9192fc420..d53a9e11ca 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -258,7 +258,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2) BIF_RET(am_true); } } else if (is_export(arg1)) { - Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]); + Export* exp = (Export *) (export_val(arg1)[1]); if (exp->code[2] == (Uint) arity) { BIF_RET(am_true); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6c335a9fe6..734f120e09 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1662,7 +1662,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p) val = *hp++; switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: - ptr = (Eterm *) EXPAND_POINTER(val); + ptr = (Eterm *) val; if (!in_area(ptr, old_heap, old_heap_size)) { if (in_area(ptr, new_heap, new_heap_size)) { abort(); @@ -1675,7 +1675,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p) } break; case TAG_PRIMARY_LIST: - ptr = (Eterm *) EXPAND_POINTER(val); + ptr = (Eterm *) val; if (!in_area(ptr, old_heap, old_heap_size)) { if (in_area(ptr, new_heap, new_heap_size)) { abort(); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index a21c1e5582..135f09c04d 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -12501,7 +12501,7 @@ stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg) } if (is_CP(x)) { - erts_print(to, to_arg, "Return addr %p (", (Eterm *) EXPAND_POINTER(x)); + erts_print(to, to_arg, "Return addr %p (", (Eterm *) x); print_function_from_pc(to, to_arg, cp_val(x)); erts_print(to, to_arg, ")\n"); yreg = 0; diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 25f0b1ed38..3b8ae11e94 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -365,7 +365,7 @@ heap_dump(int to, void *to_arg, Eterm x) while (x != OUR_NIL) { if (is_CP(x)) { - next = (Eterm *) EXPAND_POINTER(x); + next = (Eterm *) x; } else if (is_list(x)) { ptr = list_val(x); if (ptr[0] != OUR_NIL) { @@ -378,7 +378,7 @@ heap_dump(int to, void *to_arg, Eterm x) ptr[1] = make_small(0); } x = ptr[0]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); + ptr[0] = (Eterm) next; next = ptr + 1; continue; } @@ -408,7 +408,7 @@ heap_dump(int to, void *to_arg, Eterm x) ptr[0] = OUR_NIL; } else { x = ptr[arity]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); + ptr[0] = (Eterm) next; next = ptr + arity - 1; continue; } diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index ad4ef3c01a..cc0b187240 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -25,8 +25,6 @@ typedef UWord Wterm; /* Full word terms */ #define HEAP_ON_C_STACK 1 #define CHECK_POINTER_MASK 0x0UL -#define COMPRESS_POINTER(AnUint) (AnUint) -#define EXPAND_POINTER(APointer) (APointer) struct erl_node_; /* Declared in erl_node_tables.h */ @@ -174,7 +172,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #define _boxed_precond(x) (is_boxed(x)) #define _is_aligned(x) (((Uint)(x) & 0x3) == 0) -#define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED) +#define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED) _ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*) #define make_boxed(x) _ET_APPLY(make_boxed,(x)) #if 1 @@ -185,12 +183,12 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm) #else #define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) #endif -#define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED))) +#define _unchecked_boxed_val(x) ((Eterm*) ((x) - TAG_PRIMARY_BOXED)) _ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm) #define boxed_val(x) _ET_APPLY(boxed_val,(x)) /* cons cell ("list") access methods */ -#define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST) +#define _unchecked_make_list(x) ((Uint)(x) + TAG_PRIMARY_LIST) _ET_DECLARE_CHECKED(Eterm,make_list,const Eterm*) #define make_list(x) _ET_APPLY(make_list,(x)) #if 1 @@ -203,7 +201,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define is_not_list(x) (!is_list((x))) #endif #define _list_precond(x) (is_list(x)) -#define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) +#define _unchecked_list_val(x) ((Eterm*) ((x) - TAG_PRIMARY_LIST)) _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define list_val(x) _ET_APPLY(list_val,(x)) @@ -214,7 +212,7 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define CDR(x) ((x)[1]) /* generic tagged pointer (boxed or list) access methods */ -#define _unchecked_ptr_val(x) ((Eterm*) EXPAND_POINTER((x) & ~((Uint) 0x3))) +#define _unchecked_ptr_val(x) ((Eterm*) ((x) & ~((Uint) 0x3))) #define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/ #define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm))) #define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/ @@ -1009,14 +1007,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #error "fix yer arch, like" #endif -#define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x)) +#define _unchecked_make_cp(x) ((Eterm)(x)) _ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*) #define make_cp(x) _ET_APPLY(make_cp,(x)) #define is_not_CP(x) ((x) & _CPMASK) #define is_CP(x) (!is_not_CP(x)) -#define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x)) +#define _unchecked_cp_val(x) ((BeamInstr*) (x)) _ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm) #define cp_val(x) _ET_APPLY(cp_val,(x)) diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index f7b372d294..c3e93d1ad2 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2958,7 +2958,7 @@ dec_term(ErtsDistExternal *edep, case B2TDecodeList: objp = next - 2; while (n > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; objp[1] = make_list(next); next = objp; objp -= 2; @@ -2969,7 +2969,7 @@ dec_term(ErtsDistExternal *edep, case B2TDecodeTuple: objp = next - 1; while (n-- > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; next = objp; objp--; } @@ -3022,7 +3022,7 @@ dec_term(ErtsDistExternal *edep, while (next != NULL) { objp = next; - next = (Eterm *) EXPAND_POINTER(*objp); + next = (Eterm *) *objp; switch (*ep++) { case INTEGER_EXT: @@ -3153,7 +3153,7 @@ dec_term_atom_common: reds -= n; } while (n-- > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; next = objp; objp--; } @@ -3171,8 +3171,8 @@ dec_term_atom_common: *objp = make_list(hp); hp += 2 * n; objp = hp - 2; - objp[0] = (Eterm) COMPRESS_POINTER((objp+1)); - objp[1] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) (objp+1); + objp[1] = (Eterm) next; next = objp; objp -= 2; n--; @@ -3185,7 +3185,7 @@ dec_term_atom_common: reds -= n; } while (n > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; objp[1] = make_list(next); next = objp; objp -= 2; @@ -3576,7 +3576,7 @@ dec_term_atom_common: * The list of maps is for later validation. */ - mp->thing_word = (Eterm) COMPRESS_POINTER(maps_list); + mp->thing_word = (Eterm) maps_list; maps_list = (Eterm *) mp; mp->size = size; @@ -3584,8 +3584,8 @@ dec_term_atom_common: *objp = make_flatmap(mp); for (n = size; n; n--) { - *vptr = (Eterm) COMPRESS_POINTER(next); - *kptr = (Eterm) COMPRESS_POINTER(vptr); + *vptr = (Eterm) next; + *kptr = (Eterm) vptr; next = kptr; vptr--; kptr--; @@ -3599,8 +3599,8 @@ dec_term_atom_common: hamt->leaf_array = hp; for (n = size; n; n--) { - CDR(hp) = (Eterm) COMPRESS_POINTER(next); - CAR(hp) = (Eterm) COMPRESS_POINTER(&CDR(hp)); + CDR(hp) = (Eterm) next; + CAR(hp) = (Eterm) &CDR(hp); next = &CAR(hp); hp += 2; } @@ -3677,11 +3677,11 @@ dec_term_atom_common: /* Environment */ for (i = num_free-1; i >= 0; i--) { - funp->env[i] = (Eterm) COMPRESS_POINTER(next); + funp->env[i] = (Eterm) next; next = funp->env + i; } /* Creator */ - funp->creator = (Eterm) COMPRESS_POINTER(next); + funp->creator = (Eterm) next; next = &(funp->creator); break; } @@ -3750,7 +3750,7 @@ dec_term_atom_common: /* Environment */ for (i = num_free-1; i >= 0; i--) { - funp->env[i] = (Eterm) COMPRESS_POINTER(next); + funp->env[i] = (Eterm) next; next = funp->env + i; } break; @@ -3846,11 +3846,11 @@ dec_term_atom_common: */ while (maps_list) { - next = (Eterm *)(EXPAND_POINTER(*maps_list)); + next = (Eterm *) *maps_list; *maps_list = MAP_HEADER_FLATMAP; if (!erts_validate_and_sort_flatmap((flatmap_t*)maps_list)) goto error; - maps_list = next; + maps_list = next; } ASSERT(hp <= factory->hp_end @@ -3876,7 +3876,7 @@ dec_term_atom_common: PSTACK_DESTROY(hamt_array); } - ASSERT((Eterm*)EXPAND_POINTER(*dbg_resultp) != NULL); + ASSERT((Eterm*)*dbg_resultp != NULL); if (ctx) { ctx->state = B2TDone; -- cgit v1.2.3 From 287db3cf7ecb1bb23664cf872508675461a4be56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 15:19:20 +0200 Subject: erts: Remove halfword heap relative comparisions * Removed cmp_rel, cmp_rel_term and eq_rel --- erts/emulator/beam/erl_db_hash.c | 7 ++----- erts/emulator/beam/erl_db_tree.c | 13 ++++++------- erts/emulator/beam/erl_db_util.c | 10 +++++----- erts/emulator/beam/erl_db_util.h | 4 ++-- erts/emulator/beam/erl_map.c | 4 ++-- erts/emulator/beam/erl_utils.h | 3 --- 6 files changed, 17 insertions(+), 24 deletions(-) diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 80563e1f02..e4f4a7beb0 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -460,9 +460,6 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb) } } -#define EQ_REL(x,y,y_base) \ - (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base))) - /* Is this a live object (not pseodo-deleted) with the specified key? */ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, @@ -472,7 +469,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ_REL(key, itemKey, b->dbterm.tpl); + return EQ(key, itemKey); } } @@ -485,7 +482,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ_REL(key, itemKey, b->dbterm.tpl); + return EQ(key, itemKey); } } diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 3b698a6adf..d9eac550af 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -576,8 +576,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, TreeDbTerm* obj) { - return cmp_rel(key, key_base, - GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl); + return CMP(key, GETKEY(tb,obj->dbterm.tpl)); } static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, @@ -585,7 +584,7 @@ static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, { Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); return is_same(key, key_base, obj_key, obj->dbterm.tpl) - || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0; + || CMP(key, obj_key) == 0; } static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) @@ -2742,7 +2741,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) switch (a & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_LIST: if (!is_list(b)) { - return cmp_rel(a,NULL,b,b_base); + return CMP(a,b); } aa = list_val(a); bb = list_val(b); @@ -2758,12 +2757,12 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) } case TAG_PRIMARY_BOXED: if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { - return cmp_rel(a,NULL,b,b_base); + return CMP(a,b); } a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; if (a_hdr != b_hdr) { - return cmp_rel(a, NULL, b, b_base); + return CMP(a,b); } if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { aa = tuple_val(a); @@ -2781,7 +2780,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) } /* Drop through */ default: - return cmp_rel(a, NULL, b, b_base); + return CMP(a,b); } } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 432ca297e9..7bf45bd586 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1990,13 +1990,13 @@ restart: break; case matchCmp: n = *pc++; - if (!eq_rel(variables[n].term, base, *ep, base)) + if (!EQ(variables[n].term, *ep)) FAIL(); ++ep; break; case matchEqBin: t = (Eterm) *pc++; - if (!eq_rel(t,NULL,*ep,base)) + if (!EQ(t,*ep)) FAIL(); ++ep; break; @@ -2012,7 +2012,7 @@ restart: Eterm* epc = (Eterm*)pc; if (!is_ref(*ep)) FAIL(); - if (!eq_rel(make_internal_ref(epc), epc, *ep, base)) { + if (!EQ(make_internal_ref(epc), *ep)) { FAIL(); } i = thing_arityval(*epc); @@ -3063,7 +3063,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ASSERT((*hpp - hp) <= bp->size); #ifdef DEBUG_CLONE - ASSERT(eq_rel(make_tuple(hp),NULL,make_tuple(bp->debug_clone),bp->debug_clone)); + ASSERT(EQ(make_tuple(hp),make_tuple(bp->debug_clone))); #endif return make_tuple(hp); } @@ -3087,7 +3087,7 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, *hpp = erts_produce_heap(&factory, extra, 0); erts_factory_close(&factory); #ifdef DEBUG_CLONE - ASSERT(eq_rel(copy, NULL, obj->debug_clone[pos], obj->debug_clone)); + ASSERT(EQ(copy, obj->debug_clone[pos])); #endif return copy; } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index d07e61e599..36c15496b9 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -287,7 +287,7 @@ ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) Uint size = size_object_rel(key, obj->tpl); Eterm* hp = HAlloc(p, size); Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL); - ASSERT(eq_rel(res,NULL,key,obj->tpl)); + ASSERT(EQ(res,key)); return res; } } @@ -306,7 +306,7 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) { if (!tb->compress) { - return eq_rel(a, NULL, make_tuple(b->tpl), b->tpl); + return EQ(a, make_tuple(b->tpl)); } else { return db_eq_comp(tb, a, b); diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 500234c436..8f376fe595 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -197,7 +197,7 @@ erts_maps_get(Eterm key, Eterm map) } for (i = 0; i < n; i++) { - if (eq_rel(ks[i], map_base, key, NULL)) { + if (EQ(ks[i], key)) { return &vs[i]; } } @@ -2020,7 +2020,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) if (is_list(node)) { /* LEAF NODE [K|V] */ ptr = list_val(node); - res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL; + res = EQ(CAR(ptr), key) ? &(CDR(ptr)) : NULL; break; } diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 1732579d04..4058d63eaf 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -158,14 +158,11 @@ erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); int eq(Eterm, Eterm); -#define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) Sint erts_cmp(Eterm, Eterm, int, int); Sint cmp(Eterm a, Eterm b); -#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0,0) -#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1,0) #define CMP(A,B) erts_cmp(A,B,0,0) #define CMP_TERM(A,B) erts_cmp(A,B,1,0) #define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1) -- cgit v1.2.3 From 256c60d885b6fe0e8a715fa9bfdd371ad14c8857 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 16:01:10 +0200 Subject: erts: Remove halfword object manipulation * Remove macros size_object_rel, copy_struct_rel and copy_shallow_rel --- erts/emulator/beam/erl_db_tree.c | 36 ++++++++++++++++++------------------ erts/emulator/beam/erl_db_util.c | 33 +++++++++++++++------------------ erts/emulator/beam/erl_db_util.h | 6 +++--- erts/emulator/beam/global.h | 7 ------- 4 files changed, 36 insertions(+), 46 deletions(-) diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index d9eac550af..0c0218f5f9 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1002,9 +1002,9 @@ static int db_select_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key,sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE8 (hp, tptr[1], @@ -1045,9 +1045,9 @@ static int db_select_continue_tree(Process *p, } } /* Not done yet, let's trap. */ - sz = size_object_rel(key,sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE8 (hp, tptr[1], @@ -1152,9 +1152,9 @@ static int db_select_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb=db_make_mp_binary(p,mpi.mp,&hp); @@ -1250,7 +1250,7 @@ static int db_select_count_continue_tree(Process *p, RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + 6); egot = make_small(sc.got); @@ -1260,7 +1260,7 @@ static int db_select_count_continue_tree(Process *p, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE5 (hp, tptr[1], @@ -1346,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); egot = make_small(sc.got); @@ -1356,7 +1356,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1482,9 +1482,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1507,9 +1507,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; @@ -1598,7 +1598,7 @@ static int db_select_delete_continue_tree(Process *p, RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object_rel(key, sc.lastterm->dbterm.tpl); + sz = size_object(key); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + 6); eaccsum = make_small(sc.accum); @@ -1608,7 +1608,7 @@ static int db_select_delete_continue_tree(Process *p, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE5 (hp, tptr[1], @@ -1695,7 +1695,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); - sz = size_object_rel(key, sc.lastterm->dbterm.tpl); + sz = size_object(key); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); eaccsum = make_small(sc.accum); @@ -1705,7 +1705,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); mpb = db_make_mp_binary(p,mpi.mp,&hp); continuation = TUPLE5 diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 7bf45bd586..41b32fc0e7 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1751,9 +1751,9 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) { if (!is_immed(term)) { - Uint sz = size_object_rel(term, base); + Uint sz = size_object(term); Eterm* top = HAllocX(p, sz, HEAP_XTRA); - return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL); + return copy_struct(term, sz, &top, &MSO(p)); } return term; } @@ -2190,16 +2190,14 @@ restart: if (in_flags & ERTS_PAM_COPY_RESULT) { Uint sz; Eterm* top; - sz = size_object_rel(term, base); + sz = size_object(term); top = HAllocX(build_proc, sz, HEAP_XTRA); if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) { ASSERT(is_tuple(term)); - *esp++ = copy_shallow_rel(tuple_val(term), sz, - &top, &MSO(build_proc), base); + *esp++ = copy_shallow(tuple_val(term), sz, &top, &MSO(build_proc)); } else { - *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc), - base, NULL); + *esp++ = copy_struct(term, sz, &top, &MSO(build_proc)); } } else { @@ -2767,7 +2765,7 @@ void db_do_update_element(DbUpdateHandle* handle, newval_sz = is_immed(newval) ? 0 : size_object(newval); new_size_set: - oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base); + oldval_sz = is_immed(oldval) ? 0 : size_object(oldval); both_size_set: handle->new_size = handle->new_size - oldval_sz + newval_sz; @@ -2873,7 +2871,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, tpl[arity + 1] = alloc_size; tmp_offheap.first = NULL; - tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl); + tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap); dest->first_oh = tmp_offheap.first; for (i=1; i<=arity; i++) { if (i != tb->keypos) { @@ -2892,7 +2890,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm)); dest->debug_clone = dbg_top; tmp_offheap.first = dest->first_oh; - copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top); + copy_struct(obj, dest->size, &dbg_top, &tmp_offheap); dest->first_oh = tmp_offheap.first; ASSERT(dbg_top == dest->debug_clone + dest->size); } @@ -2939,7 +2937,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) newp->size = size; top = newp->tpl; tmp_offheap.first = NULL; - copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top); + copy_struct(obj, size, &top, &tmp_offheap); newp->first_oh = tmp_offheap.first; #ifdef DEBUG_CLONE newp->debug_clone = NULL; @@ -3023,8 +3021,7 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) tmp_offheap.first = NULL; { - copy_struct_rel(make_tuple(tpl), handle->new_size, &top, - &tmp_offheap, tpl, top); + copy_struct(make_tuple(tpl), handle->new_size, &top, &tmp_offheap); newDbTerm->first_oh = tmp_offheap.first; ASSERT((byte*)top == (newp + alloc_sz)); } @@ -3041,9 +3038,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, hp[0] = bp->tpl[0]; *hpp += arity + 1; - hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos], - size_object_rel(bp->tpl[tb->keypos], bp->tpl), - hpp, off_heap, bp->tpl, NULL); + hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos], + size_object(bp->tpl[tb->keypos]), + hpp, off_heap); erts_factory_static_init(&factory, *hpp, bp->size - (arity+1), off_heap); @@ -3092,9 +3089,9 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, return copy; } else { - Uint sz = size_object_rel(obj->tpl[pos], obj->tpl); + Uint sz = size_object(obj->tpl[pos]); *hpp = HAlloc(p, sz + extra); - return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL); + return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p)); } } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 36c15496b9..10899bb3e7 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -284,9 +284,9 @@ ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) Eterm key = GETKEY(tb, obj->tpl); if IS_CONST(key) return key; else { - Uint size = size_object_rel(key, obj->tpl); + Uint size = size_object(key); Eterm* hp = HAlloc(p, size); - Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL); + Eterm res = copy_struct(key, size, &hp, &MSO(p)); ASSERT(EQ(res,key)); return res; } @@ -299,7 +299,7 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, return db_copy_from_comp(tb, bp, hpp, off_heap); } else { - return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl); + return copy_shallow(bp->tpl, bp->size, hpp, off_heap); } } diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 1d2d75bc1e..3559f0cd13 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -955,16 +955,9 @@ void erl_error(char*, va_list); /* copy.c */ Eterm copy_object(Eterm, Process*); - Uint size_object(Eterm); -#define size_object_rel(A,B) size_object(A) - Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); -#define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) - Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); -#define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) - void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, Eterm* refs, unsigned nrefs); -- cgit v1.2.3 From ba020bd06c34eaf5b450495a852f31357ef042b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 16:53:49 +0200 Subject: erts: Remove halfword copy_object_rel Near duplication of copy_object but with base ptr that is no longer used. --- erts/emulator/beam/erl_db_util.c | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 41b32fc0e7..ae9a853411 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1748,17 +1748,6 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) return ret; } -static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) -{ - if (!is_immed(term)) { - Uint sz = size_object(term); - Eterm* top = HAllocX(p, sz, HEAP_XTRA); - return copy_struct(term, sz, &top, &MSO(p)); - } - return term; -} - - /* ** Execution of the match program, this is Pam. ** May return THE_NON_VALUE, which is a bailout. @@ -2167,12 +2156,11 @@ restart: break; case matchPushVResult: if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; - /* Build (NULL-based) copy on callers heap */ n = *pc++; ASSERT(is_value(variables[n].term)); ASSERT(!variables[n].proc); - variables[n].term = copy_object_rel(c_p, variables[n].term, base); + variables[n].term = copy_object(variables[n].term, c_p); *esp++ = variables[n].term; #ifdef DEBUG variables[n].proc = c_p; -- cgit v1.2.3 From d6712b1c54de471beb1784bb329ea217767f70ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 17:03:48 +0200 Subject: erts: Reinstate copy_object over-allocation optimization --- erts/emulator/beam/copy.c | 35 ++++++++++++++++++----------------- erts/emulator/beam/erl_db_util.c | 2 +- erts/emulator/beam/global.h | 4 +++- 3 files changed, 22 insertions(+), 19 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 38c40f4e7d..3de2c10203 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -40,29 +40,30 @@ static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*); /* * Copy object "obj" to process p. */ -Eterm -copy_object(Eterm obj, Process* to) -{ - Uint size = size_object(obj); - Eterm* hp = HAlloc(to, size); - Eterm res; +Eterm copy_object_x(Eterm obj, Process* to, Uint extra) { + if (!is_immed(obj)) { + Uint size = size_object(obj); + Eterm* hp = HAllocX(to, size, extra); + Eterm res; #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(copy_object)) { - DTRACE_CHARBUF(proc_name, 64); + if (DTRACE_ENABLED(copy_object)) { + DTRACE_CHARBUF(proc_name, 64); - erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)), - "%T", to->common.id); - DTRACE2(copy_object, proc_name, size); - } + erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)), + "%T", to->common.id); + DTRACE2(copy_object, proc_name, size); + } #endif - res = copy_struct(obj, size, &hp, &to->off_heap); + res = copy_struct(obj, size, &hp, &to->off_heap); #ifdef DEBUG - if (eq(obj, res) == 0) { - erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n"); - } + if (eq(obj, res) == 0) { + erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n"); + } #endif - return res; + return res; + } + return obj; } /* diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index ae9a853411..8047711e6f 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2160,7 +2160,7 @@ restart: n = *pc++; ASSERT(is_value(variables[n].term)); ASSERT(!variables[n].proc); - variables[n].term = copy_object(variables[n].term, c_p); + variables[n].term = copy_object_x(variables[n].term, c_p, HEAP_XTRA); *esp++ = variables[n].term; #ifdef DEBUG variables[n].proc = c_p; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3559f0cd13..870afb414f 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -954,7 +954,9 @@ __decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...); void erl_error(char*, va_list); /* copy.c */ -Eterm copy_object(Eterm, Process*); +Eterm copy_object_x(Eterm, Process*, Uint); +#define copy_object(Term, Proc) copy_object_x(Term,Proc,0) + Uint size_object(Eterm); Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); -- cgit v1.2.3 From 64aa348700cc380f3525be01d3c815f6ecb398cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 17:33:14 +0200 Subject: erts: Remove halfword is_same bases macro Keep is_same macro for readability but remove base pointers. --- erts/emulator/beam/erl_db_tree.c | 6 +++--- erts/emulator/beam/erl_term.h | 2 +- erts/emulator/beam/utils.c | 16 ++++++++-------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 0c0218f5f9..d7c4e7e5ba 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -583,7 +583,7 @@ static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, TreeDbTerm* obj) { Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); - return is_same(key, key_base, obj_key, obj->dbterm.tpl) + return is_same(key, obj_key) || CMP(key, obj_key) == 0; } @@ -2735,7 +2735,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) *done = 1; return 0; } - if (is_same(a,NULL,b,b_base)) + if (is_same(a,b)) return 0; switch (a & _TAG_PRIMARY_MASK) { @@ -2748,7 +2748,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) while (1) { if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) return j; - if (is_same(*aa, NULL, *bb, b_base)) + if (is_same(*aa, *bb)) return 0; if (is_not_list(*aa) || is_not_list(*bb)) return do_cmp_partly_bound(*aa, *bb, b_base, done); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index cc0b187240..95ced40af7 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1118,7 +1118,7 @@ extern unsigned tag_val_def(Wterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) -#define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) +#define is_same(A,B) ((A)==(B)) #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 9f919fa2ab..acd6cf1072 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2606,7 +2606,7 @@ int eq(Eterm a, Eterm b) Eterm* bb; tailrecur: - if (is_same(a, a_base, b, b_base)) goto pop_next; + if (is_same(a, b)) goto pop_next; tailrecur_ne: switch (primary_tag(a)) { @@ -2617,7 +2617,7 @@ tailrecur_ne: while (1) { Eterm atmp = CAR(aval); Eterm btmp = CAR(bval); - if (!is_same(atmp,a_base,btmp,b_base)) { + if (!is_same(atmp,btmp)) { WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval)); a = atmp; b = btmp; @@ -2625,7 +2625,7 @@ tailrecur_ne: } atmp = CDR(aval); btmp = CDR(bval); - if (is_same(atmp,a_base,btmp,b_base)) { + if (is_same(atmp,btmp)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -2899,7 +2899,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */ Eterm* bp = bb; Sint i = sz; for (;;) { - if (!is_same(*ap,a_base,*bp,b_base)) break; + if (!is_same(*ap,*bp)) break; if (--i == 0) goto pop_next; ++ap; ++bp; @@ -3085,7 +3085,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) bodyrecur: j = 0; tailrecur: - if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */ + if (is_same(a,b)) { /* Equal values or pointers. */ goto pop_next; } tailrecur_ne: @@ -3169,7 +3169,7 @@ tailrecur_ne: while (1) { Eterm atmp = CAR(aa); Eterm btmp = CAR(bb); - if (!is_same(atmp,a_base,btmp,b_base)) { + if (!is_same(atmp,btmp)) { WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa)); a = atmp; b = btmp; @@ -3177,7 +3177,7 @@ tailrecur_ne: } atmp = CDR(aa); btmp = CDR(bb); - if (is_same(atmp,a_base,btmp,b_base)) { + if (is_same(atmp,btmp)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -3643,7 +3643,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ while (--i) { a = *aa++; b = *bb++; - if (!is_same(a,a_base, b,b_base)) { + if (!is_same(a, b)) { if (is_atom(a) && is_atom(b)) { if ((j = cmp_atoms(a, b)) != 0) { goto not_equal; -- cgit v1.2.3 From af8bb5e30b021b7b8e80ed96f3f3e16c18b865e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 17:43:59 +0200 Subject: erts: Remove halfword BINARY RELs * ERTS_GET_BINARY_BYTES_REL * ERTS_GET_REAL_BIN_REL --- erts/emulator/beam/copy.c | 2 +- erts/emulator/beam/erl_binary.h | 8 +------- erts/emulator/beam/erl_printf_term.c | 2 +- erts/emulator/beam/utils.c | 8 ++++---- 4 files changed, 7 insertions(+), 13 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 3de2c10203..ec769c3b49 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -179,7 +179,7 @@ Uint size_object(Eterm obj) Uint bitoffs; Uint extra_bytes; Eterm hdr; - ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); if ((bitsize + bitoffs) > 8) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 2; diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index d24d041530..e181b5555d 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -94,10 +94,7 @@ typedef struct erl_heap_bin { * Bitsize: output variable (Uint) */ -#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ - ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL) - -#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \ +#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ do { \ Eterm* _real_bin = binary_val(Bin); \ Uint _offs = 0; \ @@ -130,9 +127,6 @@ do { \ */ #define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ - ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL) - -#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \ do { \ ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ if (_sb->thing_word == HEADER_SUB_BIN) { \ diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 7a40f775f2..5aef2c76a4 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -472,7 +472,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, Uint bitoffs; Uint bitsize; byte octet; - ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base); + ERTS_GET_BINARY_BYTES(obj, bytep, bitoffs, bitsize); if (bitsize || !bytesize || !is_printable_ascii(bytep, bytesize, bitoffs)) { diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index acd6cf1072..a741e2e2e6 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2675,8 +2675,8 @@ tailrecur_ne: if (a_size != b_size) { goto not_equal; } - ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); - ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next; } else if (a_bitsize == b_bitsize) { @@ -3490,8 +3490,8 @@ tailrecur_ne: int cmp; byte* a_ptr; byte* b_ptr; - ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); - ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { min_size = (a_size < b_size) ? a_size : b_size; if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) { -- cgit v1.2.3 From 0cec9781bc01c7e51ecfcb2fc4f356f2cc59b03c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 17:50:53 +0200 Subject: erts: Remove halfword specific allocator types --- erts/emulator/beam/erl_alloc.types | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index b1d511ab78..1d5dec4807 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -87,11 +87,6 @@ allocator EHEAP true eheap_alloc allocator ETS true ets_alloc allocator FIXED_SIZE true fix_alloc -+if halfword -allocator LONG_LIVED_LOW true ll_low_alloc -allocator STANDARD_LOW true std_low_alloc -+endif - +else # Non smp build allocator TEMPORARY false temp_alloc @@ -102,11 +97,6 @@ allocator EHEAP false eheap_alloc allocator ETS false ets_alloc allocator FIXED_SIZE false fix_alloc -+if halfword -allocator LONG_LIVED_LOW false ll_low_alloc -allocator STANDARD_LOW false std_low_alloc -+endif - +endif allocator BINARY true binary_alloc @@ -349,29 +339,6 @@ type SSB SHORT_LIVED PROCESSES ssb +endif - -+if halfword - -type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes -type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh -type NLINK_LH STANDARD_LOW PROCESSES nlink_lh -type CODE LONG_LIVED_LOW CODE code -type DB_HEIR_DATA STANDARD_LOW ETS db_heir_data -type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc -type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data -type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term - -type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry -type EXPORT LONG_LIVED_LOW CODE export_entry -type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh -type NLINK_SH STANDARD_LOW PROCESSES nlink_sh -type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request -type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request -type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request -type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap - -+else # "fullword" - type DDLL_PROCESS STANDARD SYSTEM ddll_processes type MONITOR_LH STANDARD PROCESSES monitor_lh type NLINK_LH STANDARD PROCESSES nlink_lh @@ -390,9 +357,6 @@ type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap -+endif - - # # Types used by system specific code # -- cgit v1.2.3 From a5c3feee7bfa77eb385334272505ed562c7ef0f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 17:56:58 +0200 Subject: erts: Remove halfword specific tests --- erts/emulator/test/alloc_SUITE.erl | 14 ++------------ erts/emulator/test/driver_SUITE.erl | 12 +----------- erts/emulator/test/system_info_SUITE.erl | 2 -- lib/ssh/test/ssh_upgrade_SUITE.erl | 23 ++++++++++------------- lib/ssl/test/ssl_upgrade_SUITE.erl | 25 ++++++++++++------------- lib/stdlib/test/ets_SUITE.erl | 18 +----------------- 6 files changed, 26 insertions(+), 68 deletions(-) diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 7c7ddde5d4..3ad1b88b2d 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -113,13 +113,10 @@ cpool(doc) -> []; cpool(Cfg) -> ?line drv_case(Cfg). erts_mmap(Config) when is_list(Config) -> - case {?t:os_type(), is_halfword_vm()} of - {{unix, _}, false} -> + case ?t:os_type() of + {unix, _} -> [erts_mmap_do(Config, SCO, SCRPM, SCRFSD) || SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]]; - - {_,true} -> - {skipped, "No supercarrier support on halfword vm"}; {SkipOs,_} -> ?line {skipped, lists:flatten(["Not run on " @@ -254,10 +251,3 @@ start_node(Config, Opts) when is_list(Config), is_list(Opts) -> stop_node(Node) -> ?t:stop_node(Node). - -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false - end. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 4211c49848..b72d6cbe52 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1877,10 +1877,7 @@ mseg_alloc_cached_segments() -> mseg_alloc_cached_segments(mseg_inst_info(0)). mseg_alloc_cached_segments(MsegAllocInfo) -> - MemName = case is_halfword_vm() of - true -> "high memory"; - false -> "all memory" - end, + MemName = "all memory", ?line [{memkind,DrvMem}] = lists:filter(fun(E) -> case E of {memkind, [{name, MemName} | _]} -> true; @@ -1899,13 +1896,6 @@ mseg_inst_info(I) -> erlang:system_info({allocator,mseg_alloc})), Value. -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false - end. - driver_alloc_sbct() -> {_, _, _, As} = erlang:system_info(allocator), case lists:keysearch(driver_alloc, 1, As) of diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index bee42c07d9..51122e5d55 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -185,8 +185,6 @@ wordsize(Config) when is_list(Config) -> {comment, "True 32-bit emulator"}; {8,8} -> {comment, "True 64-bit emulator"}; - {8,4} -> - {comment, "Halfword 64-bit emulator"}; Other -> exit({unexpected_wordsizes,Other}) end. diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index c0645f3b01..eca8b3663d 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -46,20 +46,17 @@ all() -> init_per_suite(Config0) -> catch crypto:stop(), - try {crypto:start(), erlang:system_info({wordsize, internal}) == - erlang:system_info({wordsize, external})} of - {ok, true} -> - case ct_release_test:init(Config0) of - {skip, Reason} -> - {skip, Reason}; - Config -> - ssh:start(), - Config - end; - {ok, false} -> - {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} + try crypto:start() of + ok -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + ssh:start(), + Config + end catch _:_ -> - {skip, "Crypto did not start"} + {skip, "Crypto did not start"} end. end_per_suite(Config) -> diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl index 17b0240fe8..fa9593b5dd 100644 --- a/lib/ssl/test/ssl_upgrade_SUITE.erl +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -39,20 +39,19 @@ all() -> init_per_suite(Config0) -> catch crypto:stop(), - try {crypto:start(), erlang:system_info({wordsize, internal}) == erlang:system_info({wordsize, external})} of - {ok, true} -> - case ct_release_test:init(Config0) of - {skip, Reason} -> - {skip, Reason}; - Config -> - {ok, _} = make_certs:all(?config(data_dir, Config), - ?config(priv_dir, Config)), - ssl_test_lib:cert_options(Config) - end; - {ok, false} -> - {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} + try crypto:start() of + ok -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + Result = + {ok, _} = make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config)), + ssl_test_lib:cert_options(Config) + end catch _:_ -> - {skip, "Crypto did not start"} + {skip, "Crypto did not start"} end. end_per_suite(Config) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index ae431d66d9..1b80f555d7 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -731,10 +731,6 @@ chk_normal_tab_struct_size() -> % ?line ok % end. --define(DB_TREE_STACK_NEED,50). % The static stack for a tree, in halfword pointers are two internal words - % so the stack gets twice as big --define(DB_HASH_SIZEOF_EXTSEG,260). % The segment size in words, in halfword this will be twice as large. - adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> %% Adjust for 64-bit, smp, and os: %% Table struct size may differ. @@ -748,19 +744,7 @@ adjust_xmem([T1,T2,T3,T4], {A0,B0,C0,D0} = _Mem0) -> % end, TabDiff = ?TAB_STRUCT_SZ, - Mem1 = {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}, - - case {erlang:system_info({wordsize,internal}),erlang:system_info({wordsize,external})} of - %% Halfword, corrections for regular pointers occupying two internal words. - {4,8} -> - {A1,B1,C1,D1} = Mem1, - {A1+4*ets:info(T1, size)+?DB_TREE_STACK_NEED, - B1+3*ets:info(T2, size)+?DB_HASH_SIZEOF_EXTSEG, - C1+3*ets:info(T3, size)+?DB_HASH_SIZEOF_EXTSEG, - D1+3*ets:info(T4, size)+?DB_HASH_SIZEOF_EXTSEG}; - _ -> - Mem1 - end. + {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}. t_whitebox(doc) -> ["Diverse whitebox testes"]; -- cgit v1.2.3 From 1d76e08836a0ccd9ebc15bfcff41d5e52ccd4073 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 18 Jun 2015 18:15:29 +0200 Subject: erts: Remove halfword valgrind suppress file --- erts/emulator/valgrind/suppress.halfword | 56 -------------------------------- 1 file changed, 56 deletions(-) delete mode 100644 erts/emulator/valgrind/suppress.halfword diff --git a/erts/emulator/valgrind/suppress.halfword b/erts/emulator/valgrind/suppress.halfword deleted file mode 100644 index 8fe448d897..0000000000 --- a/erts/emulator/valgrind/suppress.halfword +++ /dev/null @@ -1,56 +0,0 @@ -# Extra suppressions specific for the halfword emulator. - -# --- Suppress all offheap binaries --- -# Valgrinds leak check does not recognize pointers that are stored -# at unaligned addresses. In halfword emulator we store 64-bit pointers -# to offheap data on 32-bit aligned heaps. -# We solve this by suppressing allocation of all offheap structures -# that are not referenced by other tables (ie binaries). - -{ -Halfword erts_bin_nrml_alloc -Memcheck:Leak -... -fun:erts_bin_nrml_alloc -... -} - -{ -Halfword erts_bin_realloc -Memcheck:Leak -... -fun:erts_bin_realloc -... -} - -{ -Halfword erts_bin_realloc_fnf -Memcheck:Leak -... -fun:erts_bin_realloc_fnf -... -} - -{ -Halfword erts_bin_drv_alloc -Memcheck:Leak -... -fun:erts_bin_drv_alloc -... -} - -{ -Halfword erts_bin_drv_alloc_fnf -Memcheck:Leak -... -fun:erts_bin_drv_alloc_fnf -... -} - -{ -Halfword erts_create_magic_binary -Memcheck:Leak -... -fun:erts_create_magic_binary -... -} -- cgit v1.2.3 From 9c2f061abe085733824d6e2a659d500813c296ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 22 Jun 2015 09:43:56 +0200 Subject: erts: Remove halfword relative printf --- erts/emulator/beam/erl_db_hash.c | 4 ++-- erts/emulator/beam/erl_db_tree.c | 7 +++---- erts/emulator/beam/erl_printf_term.c | 15 +++++---------- erts/emulator/beam/erl_printf_term.h | 3 +-- erts/include/internal/erl_printf_format.h | 2 +- erts/lib_src/common/erl_printf_format.c | 15 +++++---------- 6 files changed, 17 insertions(+), 29 deletions(-) diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index e4f4a7beb0..616d9557c2 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -2187,11 +2187,11 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl) erts_print(to, to_arg, "*"); if (tb->common.compress) { Eterm key = GETKEY(tb, list->dbterm.tpl); - erts_print(to, to_arg, "key=%R", key, list->dbterm.tpl); + erts_print(to, to_arg, "key=%T", key); } else { Eterm obj = make_tuple(list->dbterm.tpl); - erts_print(to, to_arg, "%R", obj, list->dbterm.tpl); + erts_print(to, to_arg, "%T", obj); } if (list->next != 0) erts_print(to, to_arg, ","); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index d7c4e7e5ba..b8791d9f8e 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -2796,7 +2796,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_ erts_fprintf(stderr," > "); else erts_fprintf(stderr," == "); - erts_fprintf(stderr,"%R\n", bound_key, bk_base); + erts_fprintf(stderr,"%T\n", bound_key); #endif return ret; } @@ -3155,9 +3155,8 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show, prefix = ""; term = make_tuple(t->dbterm.tpl); } - erts_print(to, to_arg, "%*s%s%R (addr = %p, bal = %d)\n", - offset, "", prefix, term, t->dbterm.tpl, - t, t->balance); + erts_print(to, to_arg, "%*s%s%T (addr = %p, bal = %d)\n", + offset, "", prefix, term, t, t->balance); } do_dump_tree2(tb, to, to_arg, show, t->left, offset + 4); } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 5aef2c76a4..bbb868b76a 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -117,8 +117,7 @@ do { \ /* return 0 if list is not a non-empty flat list of printable characters */ static int -is_printable_string(Eterm list, Eterm* base) -{ +is_printable_string(Eterm list) { int len = 0; int c; @@ -260,9 +259,7 @@ static char *format_binary(Uint16 x, char *b) { #endif static int -print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, - Eterm* obj_base) -{ +print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { DECLARE_WSTACK(s); int res; int i; @@ -420,7 +417,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_CHAR(res, fn, arg, '>'); break; case LIST_DEF: - if (is_printable_string(obj, obj_base)) { + if (is_printable_string(obj)) { int c; PRINT_CHAR(res, fn, arg, '"'); nobj = list_val(obj); @@ -644,13 +641,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, int -erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision, - ErlPfEterm* term_base) -{ +erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision) { int res; ERTS_CT_ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm)); - res = print_term(fn, arg, (Eterm)term, &precision, (Eterm*)term_base); + res = print_term(fn, arg, (Eterm)term, &precision); if (res < 0) return res; if (precision <= 0) diff --git a/erts/emulator/beam/erl_printf_term.h b/erts/emulator/beam/erl_printf_term.h index 87618a36d7..4618457f27 100644 --- a/erts/emulator/beam/erl_printf_term.h +++ b/erts/emulator/beam/erl_printf_term.h @@ -22,6 +22,5 @@ #define ERL_PRINTF_TERM_H__ #include "erl_printf_format.h" -int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision, - ErlPfEterm* term_base); +int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision); #endif diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h index c41c5ba820..953022017a 100644 --- a/erts/include/internal/erl_printf_format.h +++ b/erts/include/internal/erl_printf_format.h @@ -58,7 +58,7 @@ extern int erts_printf_double(fmtfn_t, void *, char, int, int, double); typedef ErlPfUWord ErlPfEterm; -extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*); +extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long); #endif /* ERL_PRINTF_FORMAT_H__ */ diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 9e70f4e882..e7d5d4413e 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -94,7 +94,7 @@ #endif #define FMTC_d 0x0000 -#define FMTC_R 0x0001 +/*empty 0x0001 was RELATIVE */ #define FMTC_o 0x0002 #define FMTC_u 0x0003 #define FMTC_x 0x0004 @@ -158,7 +158,7 @@ static char heX[] = "0123456789ABCDEF"; #define SIGN(X) ((X) > 0 ? 1 : ((X) < 0 ? -1 : 0)) #define USIGN(X) ((X) == 0 ? 0 : 1) -int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*) = NULL; +int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long) = NULL; static int noop_fn(void *vfp, char* buf, size_t len) @@ -637,7 +637,6 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) case 'p': ptr++; fmt |= FMTC_p; break; case 'n': ptr++; fmt |= FMTC_n; break; case 'T': ptr++; fmt |= FMTC_T; break; - case 'R': ptr++; fmt |= FMTC_R; break; case '%': FMT(fn,arg,ptr,1,count); ptr++; @@ -812,11 +811,9 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) default: *va_arg(ap,int*) = count; break; } break; - case FMTC_T: /* Eterm */ - case FMTC_R: { /* Eterm, Eterm* base */ + case FMTC_T: { /* Eterm */ long prec; ErlPfEterm eterm; - ErlPfEterm* eterm_base; if (!erts_printf_eterm_func) return -EINVAL; @@ -827,16 +824,14 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) else prec = (long) precision; eterm = va_arg(ap, ErlPfEterm); - eterm_base = ((fmt & FMTC_MASK) == FMTC_R) ? - va_arg(ap, ErlPfEterm*) : NULL; if (width > 0 && !(fmt & FMTF_adj)) { - res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec, eterm_base); + res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec); if (res < 0) return res; if (width > res) BLANKS(fn, arg, width - res, count); } - res = (*erts_printf_eterm_func)(fn, arg, eterm, prec, eterm_base); + res = (*erts_printf_eterm_func)(fn, arg, eterm, prec); if (res < 0) return res; count += res; -- cgit v1.2.3 From 109f5a0e23de7174f34fddcfaac855d35125e70b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 22 Jun 2015 11:52:48 +0200 Subject: erts: Remove halfword CHECK_POINTER_MASK --- erts/emulator/beam/erl_term.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 95ced40af7..0d8e981da4 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -24,8 +24,6 @@ typedef UWord Wterm; /* Full word terms */ #define HEAP_ON_C_STACK 1 -#define CHECK_POINTER_MASK 0x0UL - struct erl_node_; /* Declared in erl_node_tables.h */ /* -- cgit v1.2.3 From 437dd11b324e17e3c7cf83c8e4f70fd19b51d05f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 22 Jun 2015 14:51:04 +0200 Subject: erts: Remove halfword bases in ETS --- erts/emulator/beam/erl_db.c | 2 +- erts/emulator/beam/erl_db_tree.c | 167 ++++++++++++++++----------------------- erts/emulator/beam/erl_db_util.c | 17 ++-- erts/emulator/beam/erl_db_util.h | 2 +- 4 files changed, 75 insertions(+), 113 deletions(-) diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index f3da28b65a..9ec14ab5ae 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -2834,7 +2834,7 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3], BIF_P,lst,BIF_ARG_2,ret); } - res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0, + res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, ERTS_PAM_COPY_RESULT, &dummy); if (is_value(res)) { hp = HAlloc(BIF_P, 2); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index b8791d9f8e..311b69d114 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -280,7 +280,7 @@ struct select_delete_context { /* ** Forward declarations */ -static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base); +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); static TreeDbTerm *linkout_object_tree(DbTableTree *tb, Eterm object); static int do_free_tree_cont(DbTableTree *tb, int num_left); @@ -291,15 +291,15 @@ static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static void traverse_backwards(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -307,7 +307,7 @@ static void traverse_backwards(DbTableTree *tb, void *context); static void traverse_forward(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -315,8 +315,8 @@ static void traverse_forward(DbTableTree *tb, void *context); static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, Eterm *partly_bound_key); -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base); -static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done); +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); static int analyze_pattern(DbTableTree *tb, Eterm pattern, struct mp_info *mpi); @@ -517,7 +517,7 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_next(tb, stack, key, NULL); + this = find_next(tb, stack, key); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; @@ -563,7 +563,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_prev(tb, stack, key, NULL); + this = find_prev(tb, stack, key); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; @@ -573,18 +573,13 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) return DB_ERROR_NONE; } -static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, - TreeDbTerm* obj) -{ +static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, TreeDbTerm* obj) { return CMP(key, GETKEY(tb,obj->dbterm.tpl)); } -static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, - TreeDbTerm* obj) -{ +static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, TreeDbTerm* obj) { Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); - return is_same(key, obj_key) - || CMP(key, obj_key) == 0; + return is_same(key, obj_key) || CMP(key, obj_key) == 0; } static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) @@ -618,7 +613,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; - } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) { + } else if ((c = cmp_key(tb, key, *this)) < 0) { /* go lefts */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -773,7 +768,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret) *ret = am_true; - if ((res = linkout_tree(tb, key, NULL)) != NULL) { + if ((res = linkout_tree(tb, key)) != NULL) { free_term(tb, res); } return DB_ERROR_NONE; @@ -969,15 +964,15 @@ static int db_select_continue_tree(Process *p, stack = get_any_stack(tb); if (chunk_size) { if (reverse) { - traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); } else { - traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); } } else { if (reverse) { - traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, &doit_select, &sc); } else { - traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); } } release_stack(tb,stack); @@ -1025,8 +1020,8 @@ static int db_select_continue_tree(Process *p, key = GETKEY(tb, sc.lastobj); if (chunk_size) { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) || - (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) { + ((!reverse && cmp_partly_bound(end_condition,key) < 0) || + (reverse && cmp_partly_bound(end_condition,key) > 0))) { /* done anyway */ if (!sc.got) { RET_TO_BIF(am_EOT, DB_ERROR_NONE); @@ -1038,8 +1033,8 @@ static int db_select_continue_tree(Process *p, } } else { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) || - (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) { + ((!reverse && cmp_partly_bound(end_condition,key) > 0) || + (reverse && cmp_partly_bound(end_condition,key) < 0))) { /* done anyway */ RET_TO_BIF(sc.accum,DB_ERROR_NONE); } @@ -1074,7 +1069,6 @@ static int db_select_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1126,20 +1120,18 @@ static int db_select_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, &doit_select, &sc); } else { if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); } release_stack(tb,stack); #ifdef HARDDEBUG @@ -1235,7 +1227,7 @@ static int db_select_count_continue_tree(Process *p, } stack = get_any_stack(tb); - traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); @@ -1245,7 +1237,7 @@ static int db_select_count_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); if (end_condition != NIL && - (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) { + (cmp_partly_bound(end_condition,key) > 0)) { /* done anyway */ RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); } @@ -1283,7 +1275,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, struct select_count_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1333,12 +1324,11 @@ static int db_select_count_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1387,7 +1377,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1444,20 +1433,18 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); } else { if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); } release_stack(tb,stack); @@ -1585,7 +1572,7 @@ static int db_select_delete_continue_tree(Process *p, sc.keypos = tb->common.keypos; ASSERT(!erts_smp_atomic_read_nob(&tb->is_stack_busy)); - traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); @@ -1594,7 +1581,7 @@ static int db_select_delete_continue_tree(Process *p, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); if (end_condition != NIL && - cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */ + cmp_partly_bound(end_condition,key) > 0) { /* done anyway */ RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } /* Not done yet, let's trap. */ @@ -1629,7 +1616,6 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, struct select_delete_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1682,12 +1668,11 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1733,7 +1718,7 @@ static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) TreeDbTerm *this; *ret = NIL; - this = linkout_tree(tb, key, NULL); + this = linkout_tree(tb, key); if (this) { Eterm copy, *hp, *hend; @@ -1844,9 +1829,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt, do_db_tree_foreach_offheap(tdbt->right, func, arg); } -static TreeDbTerm *linkout_tree(DbTableTree *tb, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key) { TreeDbTerm **tstack[STACK_NEED]; int tpos = 0; int dstack[STACK_NEED+1]; @@ -1868,7 +1851,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) { + } else if ((c = cmp_key(tb, key, *this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -1932,7 +1915,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) { + } else if ((c = cmp_key(tb,key,*this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -2318,15 +2301,13 @@ done: * Find next and previous in sort order */ -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!cmp_key_eq(tb,key,key_base,this)) { + if (!cmp_key_eq(tb,key,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2336,7 +2317,7 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_key(tb,key,key_base,this) ) > 0) { + if (( c = cmp_key(tb,key,this) ) > 0) { if (this->right == NULL) /* We are at the previos and the element does not exist */ @@ -2376,15 +2357,13 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, return this; } -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!cmp_key_eq(tb,key,key_base,this)) { + if (!cmp_key_eq(tb,key,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2394,7 +2373,7 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_key(tb,key,key_base,this) ) < 0) { + if (( c = cmp_key(tb,key,this) ) < 0) { if (this->left == NULL) /* We are at the next and the element does not exist */ @@ -2447,8 +2426,7 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl) ) >= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) >= 0) { if (this->right == NULL) { do { tmp = POP_NODE(stack); @@ -2481,8 +2459,7 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl) ) <= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) <= 0) { if (this->left == NULL) { do { tmp = POP_NODE(stack); @@ -2513,10 +2490,10 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key) DbTreeStack* stack = get_static_stack(tb); if(!stack || EMPTY_NODE(stack) - || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) { + || !cmp_key_eq(tb, key, (this=TOP_NODE(stack)))) { this = tb->root; - while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) { + while (this != NULL && (res = cmp_key(tb,key,this)) != 0) { if (res < 0) this = this->left; else @@ -2538,7 +2515,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) Sint res; this = &tb->root; - while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) { + while ((*this) != NULL && (res = cmp_key(tb, key, *this)) != 0) { if (res < 0) this = &((*this)->left); else @@ -2618,7 +2595,7 @@ db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle) */ static void traverse_backwards(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2637,16 +2614,15 @@ static void traverse_backwards(DbTableTree *tb, this = this->right; } this = TOP_NODE(stack); - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 0))) return; } else { - next = find_prev(tb, stack, lastkey, lk_base); + next = find_prev(tb, stack, lastkey); } while ((this = next) != NULL) { - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 0))) return; } @@ -2657,7 +2633,7 @@ static void traverse_backwards(DbTableTree *tb, */ static void traverse_forward(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2676,15 +2652,15 @@ static void traverse_forward(DbTableTree *tb, this = this->left; } this = TOP_NODE(stack); - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 1))) return; } else { - next = find_next(tb, stack, lastkey, lk_base); + next = find_next(tb, stack, lastkey); } while ((this = next) != NULL) { - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 1))) return; } @@ -2721,7 +2697,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, -static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) { Eterm* aa; Eterm* bb; @@ -2746,12 +2722,12 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) aa = list_val(a); bb = list_val(b); while (1) { - if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) + if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done) return j; if (is_same(*aa, *bb)) return 0; if (is_not_list(*aa) || is_not_list(*bb)) - return do_cmp_partly_bound(*aa, *bb, b_base, done); + return do_cmp_partly_bound(*aa, *bb, done); aa = list_val(*aa); bb = list_val(*bb); } @@ -2772,7 +2748,7 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) if (i < arityval(*bb)) return(-1); if (i > arityval(*bb)) return(1); while (i--) { - if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0 + if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0 || *done) return j; } @@ -2784,10 +2760,9 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) } } -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base) -{ +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) { int done = 0; - Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done); + Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done); #ifdef HARDDEBUG erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key); if (ret < 0) @@ -3013,12 +2988,10 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) { return 0; } ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects, @@ -3050,8 +3023,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, /* Always backwards traversing */ if (sc->end_condition != NIL && (cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0)) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)) { return 0; } ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, @@ -3077,12 +3049,10 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) { return 0; } @@ -3120,14 +3090,13 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0) + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0) return 0; ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); - linkout_tree(sc->tb, key, this->dbterm.tpl); + linkout_tree(sc->tb, key); sc->erase_lastterm = 1; ++sc->accum; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 8047711e6f..0bf9558ac9 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -367,7 +367,6 @@ typedef struct MatchVariable { Eterm term; #ifdef DEBUG Process* proc; - Eterm* base; #endif } MatchVariable; @@ -1233,7 +1232,7 @@ Eterm erts_match_set_run(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args, + ret = db_prog_match(p, mpsp, NIL, args, num_args, in_flags, return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { @@ -1258,7 +1257,7 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args, + ret = db_prog_match(p, mpsp, args, NULL, num_args, ERTS_PAM_COPY_RESULT, return_flags); #if defined(HARDDEBUG) @@ -1755,7 +1754,7 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) ** i.e. 'DCOMP_TRACE' was specified */ Eterm db_prog_match(Process *c_p, Binary *bprog, - Eterm term, Eterm* base, + Eterm term, Eterm *termp, int arity, enum erts_pam_run_flags in_flags, @@ -1856,7 +1855,6 @@ restart: for (i=0; inum_bindings; i++) { variables[i].term = THE_NON_VALUE; variables[i].proc = NULL; - variables[i].base = base; } #endif @@ -2156,7 +2154,7 @@ restart: break; case matchPushVResult: if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; - /* Build (NULL-based) copy on callers heap */ + /* Build copy on callers heap */ n = *pc++; ASSERT(is_value(variables[n].term)); ASSERT(!variables[n].proc); @@ -2164,14 +2162,12 @@ restart: *esp++ = variables[n].term; #ifdef DEBUG variables[n].proc = c_p; - variables[n].base = NULL; #endif break; case matchPushV: case_matchPushV: n = *pc++; ASSERT(is_value(variables[n].term)); - ASSERT(!variables[n].base); *esp++ = variables[n].term; break; case matchPushExpr: @@ -5204,16 +5200,13 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra) { Uint32 dummy; - Eterm* base; Eterm res; if (tb->compress) { obj = db_alloc_tmp_uncompressed(tb, obj); - base = NULL; } - else base = NULL; - res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), base, NULL, 0, + res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); if (is_value(res) && hpp!=NULL) { diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 10899bb3e7..c0966655cd 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -432,7 +432,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra); -Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base, +Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity, enum erts_pam_run_flags in_flags, Uint32 *return_flags /* Zeroed on enter */); -- cgit v1.2.3 From 298210017aedaf01b2eb477f4375af4d30822c71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 22 Jun 2015 16:53:23 +0200 Subject: erts: Remove halfword MemKind mseg --- erts/emulator/sys/common/erl_mseg.c | 332 +++++++++++++++--------------------- 1 file changed, 135 insertions(+), 197 deletions(-) diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 8073d5b908..7eb8a4a460 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -99,8 +99,6 @@ static const int debruijn[32] = { static int atoms_initialized; -typedef struct mem_kind_t MemKind; - const ErtsMsegOpt_t erts_mseg_default_opt = { 1, /* Use cache */ 1, /* Preserv data */ @@ -139,7 +137,14 @@ struct cache_t_ { typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t; -struct mem_kind_t { +struct ErtsMsegAllctr_t_ { + int ix; + + int is_init_done; + int is_thread_safe; + erts_mtx_t mtx; + + int is_cache_check_scheduled; cache_t cache[MAX_CACHE_SIZE]; cache_t cache_unpowered_node; @@ -165,24 +170,6 @@ struct mem_kind_t { } max_ever; } segments; - ErtsMsegAllctr_t *ma; - const char* name; - MemKind* next; -};/*MemKind*/ - -struct ErtsMsegAllctr_t_ { - int ix; - - int is_init_done; - int is_thread_safe; - erts_mtx_t mtx; - - int is_cache_check_scheduled; - - MemKind* mk_list; - - MemKind the_mem; - Uint max_cache_size; Uint abs_max_cache_bad_fit; Uint rel_max_cache_bad_fit; @@ -294,7 +281,7 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) { /* #define ERTS_PRINT_ERTS_MMAP */ static ERTS_INLINE void * -mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) +mseg_create(ErtsMsegAllctr_t *ma, Uint flags, UWord *sizep) { #ifdef ERTS_PRINT_ERTS_MMAP UWord req_size = *sizep; @@ -318,7 +305,7 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) } static ERTS_INLINE void -mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) { +mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, void *seg_p, UWord size) { Uint32 mmap_flags = 0; if (MSEG_FLG_IS_2POW(flags)) @@ -335,7 +322,7 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord s } static ERTS_INLINE void * -mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep) +mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, UWord *sizep) { #ifdef ERTS_PRINT_ERTS_MMAP UWord req_size = *sizep; @@ -369,11 +356,8 @@ do { \ || erts_smp_thr_progress_is_blocking() \ || ERTS_IS_CRASH_DUMPING); \ } while (0) -#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \ - ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma) #else #define ERTS_DBG_MA_CHK_THR_ACCESS(MA) -#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) #endif /* Cache interface */ @@ -386,10 +370,10 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) { c->prev = c; } -static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) { +static ERTS_INLINE int cache_bless_segment(ErtsMsegAllctr_t *ma, void *seg, UWord size, Uint flags) { cache_t *c; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); ASSERT(!MSEG_FLG_IS_2POW(flags) || (MSEG_FLG_IS_2POW(flags) && MAP_IS_ALIGNED(seg) && IS_2POW(size))); @@ -398,11 +382,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U * Large blocks has no such cache and it is up to mseg to cache them to speed things up. */ - if (!erts_circleq_is_empty(&(mk->cache_free))) { + if (!erts_circleq_is_empty(&(ma->cache_free))) { /* We have free slots, use one to cache the segment */ - c = erts_circleq_head(&(mk->cache_free)); + c = erts_circleq_head(&(ma->cache_free)); erts_circleq_remove(c); c->seg = seg; @@ -414,29 +398,28 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U ASSERT(ix < CACHE_AREAS); ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size); - erts_circleq_push_head(&(mk->cache_powered_node[ix]), c); + erts_circleq_push_head(&(ma->cache_powered_node[ix]), c); } else - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); - mk->cache_size++; - ASSERT(mk->cache_size <= mk->ma->max_cache_size); + ma->cache_size++; return 1; - } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) { + } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(ma->cache_unpowered_node))) { /* No free slots. * Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */ - c = erts_circleq_tail(&(mk->cache_unpowered_node)); + c = erts_circleq_tail(&(ma->cache_unpowered_node)); erts_circleq_remove(c); - mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size); + mseg_destroy(ma, ERTS_MSEG_FLG_NONE, c->seg, c->size); mseg_cache_clear_node(c); c->seg = seg; c->size = size; - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); return 1; } else if (!MSEG_FLG_IS_2POW(flags)) { @@ -450,20 +433,20 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U int i; for( i = 0; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - c = erts_circleq_tail(&(mk->cache_powered_node[i])); + c = erts_circleq_tail(&(ma->cache_powered_node[i])); erts_circleq_remove(c); - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size); + mseg_destroy(ma, ERTS_MSEG_FLG_2POW, c->seg, c->size); mseg_cache_clear_node(c); c->seg = seg; c->size = size; - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); return 1; } @@ -472,11 +455,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U return 0; } -static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) { +static ERTS_INLINE void *cache_get_segment(ErtsMsegAllctr_t *ma, UWord *size_p, Uint flags) { UWord size = *size_p; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); if (MSEG_FLG_IS_2POW(flags)) { @@ -489,10 +472,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag for( i = ix; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - c = erts_circleq_head(&(mk->cache_powered_node[i])); + c = erts_circleq_head(&(ma->cache_powered_node[i])); erts_circleq_remove(c); ASSERT(IS_2POW(c->size)); @@ -501,31 +484,31 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag csize = c->size; seg = (char*) c->seg; - mk->cache_size--; - mk->cache_hits++; + ma->cache_size--; + ma->cache_hits++; /* link to free cache list */ mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); - ASSERT(!(mk->cache_size < 0)); + ASSERT(!(ma->cache_size < 0)); if (csize != size) - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size); + mseg_destroy(ma, ERTS_MSEG_FLG_2POW, seg + size, csize - size); return seg; } } - else if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) { + else if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) { void *seg; cache_t *c; cache_t *best = NULL; UWord bdiff = 0; UWord csize; - UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit; - UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit; + UWord bad_max_abs = ma->abs_max_cache_bad_fit; + UWord bad_max_rel = ma->rel_max_cache_bad_fit; - erts_circleq_foreach(c, &(mk->cache_unpowered_node)) { + erts_circleq_foreach(c, &(ma->cache_unpowered_node)) { csize = c->size; if (csize >= size) { if (((csize - size)*100 < bad_max_rel*size) && (csize - size) < bad_max_abs ) { @@ -534,11 +517,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag erts_circleq_remove(c); - mk->cache_size--; - mk->cache_hits++; + ma->cache_size--; + ma->cache_hits++; mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); *size_p = csize; @@ -561,7 +544,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT(best->seg); ASSERT(best->size > 0); - mk->cache_hits++; + ma->cache_hits++; /* Use current cache placement for remaining segment space */ @@ -585,7 +568,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag * using callbacks from aux-work in the scheduler. */ -static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_one_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) { cache_t *c = NULL; c = erts_circleq_tail(head); @@ -594,19 +577,19 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, flags, mk, c->seg, c->size); + mseg_destroy(ma, flags, c->seg, c->size); mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); - mk->segments.current.watermark--; - mk->cache_size--; + ma->segments.current.watermark--; + ma->cache_size--; - ASSERT( mk->cache_size >= 0 ); + ASSERT(ma->cache_size >= 0); - return mk->cache_size; + return ma->cache_size; } -static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) { cache_t *c = NULL; while (!erts_circleq_is_empty(head)) { @@ -617,58 +600,52 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, flags, mk, c->seg, c->size); + mseg_destroy(ma, flags, c->seg, c->size); mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); - - mk->segments.current.watermark--; - mk->cache_size--; + erts_circleq_push_head(&(ma->cache_free), c); + ma->segments.current.watermark--; + ma->cache_size--; } - ASSERT( mk->cache_size >= 0 ); + ASSERT(ma->cache_size >= 0); - return mk->cache_size; + return ma->cache_size; } -/* mseg_check_memkind_cache - * - Check if we can empty some cached segments in this - * MemKind. +/* mseg_check_cache + * - Check if we can empty some cached segments in this allocator */ -static Uint mseg_check_memkind_cache(MemKind *mk) { +static Uint mseg_check_cache(ErtsMsegAllctr_t *ma) { int i; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); for (i = 0; i < CACHE_AREAS; i++) { - if (!erts_circleq_is_empty(&(mk->cache_powered_node[i]))) - return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); + if (!erts_circleq_is_empty(&(ma->cache_powered_node[i]))) + return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i])); } - if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); + if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) + return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node)); return 0; } /* mseg_cache_check * - Check if we have some cache we can purge - * in any of the memkinds. */ static void mseg_cache_check(ErtsMsegAllctr_t *ma) { - MemKind* mk; Uint empty_cache = 1; ERTS_MSEG_LOCK(ma); - for (mk = ma->mk_list; mk; mk = mk->next) { - if (mseg_check_memkind_cache(mk)) - empty_cache = 0; - } + if (mseg_check_cache(ma)) + empty_cache = 0; /* If all MemKinds caches are empty, * remove aux-work callback @@ -686,7 +663,7 @@ static void mseg_cache_check(ErtsMsegAllctr_t *ma) { /* erts_mseg_cache_check * - This is a callback that is scheduled as aux-work from * schedulers and is called at some interval if we have a cache - * on this mseg-allocator and memkind. + * on this mseg-allocator. * - Purpose: Empty cache slowly so we don't collect mapped areas * and bloat memory. */ @@ -696,42 +673,32 @@ void erts_mseg_cache_check(void) { } -/* *_mseg_clear_*_cache +/* mseg_clear_cache * Remove cached segments from the allocator completely */ -static void mseg_clear_memkind_cache(MemKind *mk) { + +static void mseg_clear_cache(ErtsMsegAllctr_t *ma) { int i; + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); /* drop pow2 caches */ for (i = 0; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); - ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i]))); + mseg_drop_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i])); + ASSERT(erts_circleq_is_empty(&(ma->cache_powered_node[i]))); } /* drop varied caches */ - if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); + if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) + mseg_drop_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node)); - ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node))); - ASSERT(mk->cache_size == 0); -} - -static void mseg_clear_cache(ErtsMsegAllctr_t *ma) { - MemKind* mk; - - ERTS_MSEG_LOCK(ma); - ERTS_DBG_MA_CHK_THR_ACCESS(ma); - - - for (mk = ma->mk_list; mk; mk = mk->next) { - mseg_clear_memkind_cache(mk); - } + ASSERT(erts_circleq_is_empty(&(ma->cache_unpowered_node))); + ASSERT(ma->cache_size == 0); INC_CC(ma, clear_cache); - ERTS_MSEG_UNLOCK(ma); } @@ -740,21 +707,12 @@ void erts_mseg_clear_cache(void) { mseg_clear_cache(ERTS_MSEG_ALLCTR_IX(0)); } - - -static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, - const ErtsMsegOpt_t *opt) -{ - return &ma->the_mem; -} - static void * mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMsegOpt_t *opt) { UWord size; void *seg; - MemKind* mk = memkind(ma, opt); INC_CC(ma, alloc); @@ -768,10 +726,10 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, } } - if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL) + if (opt->cache && ma->cache_size > 0 && (seg = cache_get_segment(ma, &size, flags)) != NULL) goto done; - seg = mseg_create(ma, flags, mk, &size); + seg = mseg_create(ma, flags, &size); if (!seg) *size_p = 0; @@ -781,7 +739,7 @@ done: if (erts_mtrace_enabled) erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - ERTS_MSEG_ALLOC_STAT(mk,size); + ERTS_MSEG_ALLOC_STAT(ma,size); } return seg; @@ -792,11 +750,9 @@ static void mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, Uint flags, const ErtsMsegOpt_t *opt) { - MemKind* mk = memkind(ma, opt); - - ERTS_MSEG_DEALLOC_STAT(mk,size); + ERTS_MSEG_DEALLOC_STAT(ma,size); - if (opt->cache && cache_bless_segment(mk, seg, size, flags)) { + if (opt->cache && cache_bless_segment(ma, seg, size, flags)) { schedule_cache_check(ma); goto done; } @@ -804,7 +760,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(ma, flags, mk, seg, size); + mseg_destroy(ma, flags, seg, size); done: @@ -815,7 +771,6 @@ static void * mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) { - MemKind* mk; void *new_seg; UWord new_size; @@ -834,7 +789,6 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, return NULL; } - mk = memkind(ma, opt); new_seg = seg; if (!MSEG_FLG_IS_2POW(flags)) @@ -849,7 +803,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, if (new_size > old_size) { if (opt->preserv) { - new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); + new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size); if (!new_seg) new_size = old_size; } @@ -869,7 +823,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, new_size = old_size; } else { - new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); + new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size); if (!new_seg) new_size = old_size; } @@ -883,7 +837,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size)); *new_size_p = new_size; - ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size); + ERTS_MSEG_REALLOC_STAT(ma, old_size, new_size); return new_seg; } @@ -1153,63 +1107,63 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp } static Eterm -info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, +info_status(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, int begin_new_max_period, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; - if (mk->segments.max_ever.no < mk->segments.max.no) - mk->segments.max_ever.no = mk->segments.max.no; - if (mk->segments.max_ever.sz < mk->segments.max.sz) - mk->segments.max_ever.sz = mk->segments.max.sz; + if (ma->segments.max_ever.no < ma->segments.max.no) + ma->segments.max_ever.no = ma->segments.max.no; + if (ma->segments.max_ever.sz < ma->segments.max.sz) + ma->segments.max_ever.sz = ma->segments.max.sz; if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size); - erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits); + erts_print(to, arg, "cached_segments: %beu\n", ma->cache_size); + erts_print(to, arg, "cache_hits: %beu\n", ma->cache_hits); erts_print(to, arg, "segments: %beu %beu %beu\n", - mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no); + ma->segments.current.no, ma->segments.max.no, ma->segments.max_ever.no); erts_print(to, arg, "segments_size: %beu %beu %beu\n", - mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz); + ma->segments.current.sz, ma->segments.max.sz, ma->segments.max_ever.sz); erts_print(to, arg, "segments_watermark: %beu\n", - mk->segments.current.watermark); + ma->segments.current.watermark); } if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.segments_watermark, - bld_unstable_uint(hpp, szp, mk->segments.current.watermark)); + bld_unstable_uint(hpp, szp, ma->segments.current.watermark)); add_4tup(hpp, szp, &res, am.segments_size, - bld_unstable_uint(hpp, szp, mk->segments.current.sz), - bld_unstable_uint(hpp, szp, mk->segments.max.sz), - bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz)); + bld_unstable_uint(hpp, szp, ma->segments.current.sz), + bld_unstable_uint(hpp, szp, ma->segments.max.sz), + bld_unstable_uint(hpp, szp, ma->segments.max_ever.sz)); add_4tup(hpp, szp, &res, am.segments, - bld_unstable_uint(hpp, szp, mk->segments.current.no), - bld_unstable_uint(hpp, szp, mk->segments.max.no), - bld_unstable_uint(hpp, szp, mk->segments.max_ever.no)); + bld_unstable_uint(hpp, szp, ma->segments.current.no), + bld_unstable_uint(hpp, szp, ma->segments.max.no), + bld_unstable_uint(hpp, szp, ma->segments.max_ever.no)); add_2tup(hpp, szp, &res, am.cache_hits, - bld_unstable_uint(hpp, szp, mk->cache_hits)); + bld_unstable_uint(hpp, szp, ma->cache_hits)); add_2tup(hpp, szp, &res, am.cached_segments, - bld_unstable_uint(hpp, szp, mk->cache_size)); + bld_unstable_uint(hpp, szp, ma->cache_size)); } if (begin_new_max_period) { - mk->segments.max.no = mk->segments.current.no; - mk->segments.max.sz = mk->segments.current.sz; + ma->segments.max.no = ma->segments.current.no; + ma->segments.max.sz = ma->segments.current.sz; } return res; } -static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, +static Eterm info_memkind(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, int begin_max_per, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; @@ -1217,15 +1171,15 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo Eterm values[3]; if (print_to_p) { - erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name); + erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", "all memory"); } if (hpp || szp) { atoms[0] = am.name; atoms[1] = am.status; atoms[2] = am.calls; - values[0] = erts_bld_string(hpp, szp, mk->name); + values[0] = erts_bld_string(hpp, szp, "all memory"); } - values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[1] = info_status(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp); values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp); if (hpp || szp) @@ -1234,7 +1188,6 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo return res; } - static Eterm info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { @@ -1299,7 +1252,7 @@ erts_mseg_info(int ix, ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp); if (hpp || szp) res = bld_2tup_list(hpp, szp, n, atoms, values); @@ -1376,13 +1329,10 @@ Uint erts_mseg_no(const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); - MemKind* mk; - Uint n = 0; + Uint n; ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - n += mk->segments.current.no; - } + n = ma->segments.current.no; ERTS_MSEG_UNLOCK(ma); return n; } @@ -1394,16 +1344,16 @@ erts_mseg_unit_size(void) } -static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) +static void mem_cache_init(ErtsMsegAllctr_t *ma) { int i; /* Clear all cache headers */ - mseg_cache_clear_node(&(mk->cache_free)); - mseg_cache_clear_node(&(mk->cache_unpowered_node)); + mseg_cache_clear_node(&(ma->cache_free)); + mseg_cache_clear_node(&(ma->cache_unpowered_node)); for (i = 0; i < CACHE_AREAS; i++) { - mseg_cache_clear_node(&(mk->cache_powered_node[i])); + mseg_cache_clear_node(&(ma->cache_powered_node[i])); } /* Populate cache free list */ @@ -1411,25 +1361,20 @@ static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE); for (i = 0; i < ma->max_cache_size; i++) { - mseg_cache_clear_node(&(mk->cache[i])); - erts_circleq_push_head(&(mk->cache_free), &(mk->cache[i])); + mseg_cache_clear_node(&(ma->cache[i])); + erts_circleq_push_head(&(ma->cache_free), &(ma->cache[i])); } - mk->cache_size = 0; - mk->cache_hits = 0; - - mk->segments.current.watermark = 0; - mk->segments.current.no = 0; - mk->segments.current.sz = 0; - mk->segments.max.no = 0; - mk->segments.max.sz = 0; - mk->segments.max_ever.no = 0; - mk->segments.max_ever.sz = 0; - - mk->ma = ma; - mk->name = name; - mk->next = ma->mk_list; - ma->mk_list = mk; + ma->cache_size = 0; + ma->cache_hits = 0; + + ma->segments.current.watermark = 0; + ma->segments.current.no = 0; + ma->segments.current.sz = 0; + ma->segments.max.no = 0; + ma->segments.max.sz = 0; + ma->segments.max_ever.no = 0; + ma->segments.max_ever.sz = 0; } void @@ -1488,9 +1433,7 @@ erts_mseg_init(ErtsMsegInit_t *init) if (ma->max_cache_size > MAX_CACHE_SIZE) ma->max_cache_size = MAX_CACHE_SIZE; - ma->mk_list = NULL; - - mem_kind_init(ma, &ma->the_mem, "all memory"); + mem_cache_init(ma); sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls)); } @@ -1499,13 +1442,8 @@ erts_mseg_init(ErtsMsegInit_t *init) static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma) { - MemKind* mk; - Uint sz = 0; ERTS_DBG_MA_CHK_THR_ACCESS(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - sz += mk->cache_size; - } - return sz; + return ma->cache_size; } /* -- cgit v1.2.3 From 5c994d828c05744919144e2977bf13ec37e450f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 22 Jun 2015 17:55:54 +0200 Subject: erts: Remove halfword etp-commands --- erts/etc/unix/etp-commands.in | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 19d67de92f..7b554e71f2 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -774,7 +774,7 @@ define etp-pid-1 # set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) else @@ -834,7 +834,7 @@ define etp-port-1 # set $etp_port_1 = (Eterm)($arg0) if ($etp_port_1 & 0xF) == 0x7 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff) else @@ -1577,7 +1577,7 @@ define etp-term-dump-pid # set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) else @@ -1622,7 +1622,7 @@ end define etp-pid2pix-1 # Args: Eterm # - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) else @@ -1965,7 +1965,7 @@ end define etp-port-id2pix-1 # Args: Eterm # - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) elser @@ -2493,12 +2493,6 @@ define etp-system-info printf "Little\n" end printf "Word size: %d-bit\n", etp_arch_bits - printf "Halfword: " - if (etp_halfword) - printf "yes\n" - else - printf "no\n" - end printf "HiPE support: " if (etp_hipe) printf "yes\n" -- cgit v1.2.3 From 3bda47f2f26dd417fbd65d5f46b2ab8411a2a41f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 1 Jul 2015 15:09:58 +0200 Subject: erts: Remove halfword !HEAP_ON_C_STACK --- erts/emulator/beam/beam_emu.c | 9 +----- erts/emulator/beam/erl_arith.c | 11 ++----- erts/emulator/beam/erl_bif_info.c | 9 ------ erts/emulator/beam/erl_debug.c | 25 --------------- erts/emulator/beam/erl_debug.h | 6 ---- erts/emulator/beam/erl_process.c | 3 -- erts/emulator/beam/erl_process.h | 6 ---- erts/emulator/beam/erl_term.h | 1 - erts/emulator/beam/erl_trace.c | 24 -------------- erts/emulator/beam/erl_vm.h | 8 ----- erts/emulator/beam/global.h | 67 ++++----------------------------------- erts/emulator/beam/io.c | 35 ++------------------ 12 files changed, 13 insertions(+), 191 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index f4111c19f1..806b31654c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1165,11 +1165,7 @@ void process_main(void) */ register Eterm tmp_arg1 REG_tmp_arg1 = NIL; register Eterm tmp_arg2 REG_tmp_arg2 = NIL; -#if HEAP_ON_C_STACK - Eterm tmp_big[2]; /* Temporary buffer for small bignums if HEAP_ON_C_STACK. */ -#else - Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */ -#endif + Eterm tmp_big[2]; /* * X registers and floating point registers are located in @@ -1261,9 +1257,6 @@ void process_main(void) reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; -#if !HEAP_ON_C_STACK - tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap; -#endif ERL_BITS_RELOAD_STATEP(c_p); { int reds; diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index b8c5ef9b09..3671025d22 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -42,15 +42,8 @@ # define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif -#if !HEAP_ON_C_STACK -# define DECLARE_TMP(VariableName,N,P) \ - Eterm *VariableName = ((ERTS_PROC_GET_SCHDATA(P)->erl_arith_tmp_heap) + (2 * N)) -#else -# define DECLARE_TMP(VariableName,N,P) \ - Eterm VariableName[2] -#endif -# define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp))) - +#define DECLARE_TMP(VariableName,N,P) Eterm VariableName[2] +#define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp))) static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index a3ff537aa1..9a132ee007 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -73,9 +73,6 @@ static char otp_version[] = ERLANG_OTP_VERSION; static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE "%s" " [erts-" ERLANG_VERSION "]" -#if !HEAP_ON_C_STACK - " [no-c-stack-objects]" -#endif #ifndef OTP_RELEASE #ifdef ERLANG_GIT_VERSION " [source-" ERLANG_GIT_VERSION "]" @@ -667,18 +664,12 @@ static Eterm pi_1_keys[] = { #define ERTS_PI_1_NO_OF_KEYS (sizeof(pi_1_keys)/sizeof(Eterm)) static Eterm pi_1_keys_list; -#if HEAP_ON_C_STACK static Eterm pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS]; -#endif static void process_info_init(void) { -#if HEAP_ON_C_STACK Eterm *hp = &pi_1_keys_list_heap[0]; -#else - Eterm *hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM,sizeof(Eterm)*2*ERTS_PI_1_NO_OF_KEYS); -#endif int i; pi_1_keys_list = NIL; diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 77a1e3d7cb..434b6c6d7a 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -628,29 +628,4 @@ void print_memory_info(Process *p) } erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes); } -#if !HEAP_ON_C_STACK && defined(DEBUG) -Eterm *erts_debug_allocate_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - int offset = sd->num_tmp_heap_used; - - ASSERT(offset+size <= TMP_HEAP_SIZE); - return (sd->tmp_heap)+offset; -} -void erts_debug_use_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - - sd->num_tmp_heap_used += size; - ASSERT(sd->num_tmp_heap_used <= TMP_HEAP_SIZE); -} -void erts_debug_unuse_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - - sd->num_tmp_heap_used -= size; - ASSERT(sd->num_tmp_heap_used >= 0); -} #endif -#endif - diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h index 4905e64f07..f4259e7dae 100644 --- a/erts/emulator/beam/erl_debug.h +++ b/erts/emulator/beam/erl_debug.h @@ -92,10 +92,4 @@ extern void print_tagged_memory(Eterm *start, Eterm *end); extern void print_untagged_memory(Eterm *start, Eterm *end); extern void print_memory(Process *p); extern void print_memory_info(Process *p); -#if defined(DEBUG) && !HEAP_ON_C_STACK -extern Eterm *erts_debug_allocate_tmp_heap(int, Process *); -extern void erts_debug_use_tmp_heap(int, Process *); -extern void erts_debug_unuse_tmp_heap(int, Process *); -#endif - #endif /* _ERL_DEBUG_H_ */ diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 135f09c04d..338be6d8e1 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -5495,9 +5495,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->f_reg_array = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, MAX_REG * sizeof(FloatDef)); -#if !HEAP_ON_C_STACK - esdp->num_tmp_heap_used = 0; -#endif #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) { esdp->no = 0; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 20ffe7ea7c..ffbf3e2bff 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -631,12 +631,6 @@ struct ErtsSchedulerData_ { void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */ Process *free_process; ErtsThrPrgrData thr_progress_data; -#endif -#if !HEAP_ON_C_STACK - Eterm tmp_heap[TMP_HEAP_SIZE]; - int num_tmp_heap_used; - Eterm beam_emu_tmp_heap[BEAM_EMU_TMP_HEAP_SIZE]; - Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE]; #endif ErtsSchedulerSleepInfo *ssi; Process *current_process; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 0d8e981da4..b928e4ca1e 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -23,7 +23,6 @@ typedef UWord Wterm; /* Full word terms */ -#define HEAP_ON_C_STACK 1 struct erl_node_; /* Declared in erl_node_tables.h */ /* diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index e1b03a057f..7baa3b1a54 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1677,12 +1677,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, args = transformed_args; if (is_internal_port(*tracer_pid)) { -#if HEAP_ON_C_STACK Eterm local_heap[64+MAX_ARG]; -#else - Eterm *local_heap = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*(64+MAX_ARG)); -#endif hp = local_heap; if (!erts_is_valid_tracer_port(*tracer_pid)) { @@ -1696,9 +1691,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, #ifdef ERTS_SMP if (is_not_nil(tracee)) erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); #endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return 0; @@ -1727,9 +1719,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, ERTS_PAM_TMP_RESULT, &return_flags); if (is_non_value(pam_result)) { erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return 0; } @@ -1738,9 +1727,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, /* Meta trace */ if (pam_result == am_false) { erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return return_flags; } @@ -1748,17 +1734,11 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, /* Non-meta trace */ if (*tracee_flags & F_TRACE_SILENT) { erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return 0; } if (pam_result == am_false) { erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return return_flags; } @@ -1802,9 +1782,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, send_to_port(p, mess, tracer_pid, tracee_flags); erts_smp_mtx_unlock(&smq_mtx); erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); return *tracer_pid == NIL ? 0 : return_flags; @@ -1823,7 +1800,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, #ifdef DEBUG Eterm* limit; #endif - ASSERT(is_internal_pid(*tracer_pid)); tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 2d4141ac8d..cfc978b5a5 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -40,14 +40,6 @@ #define MAX_ARG 255 /* Max number of arguments allowed */ #define MAX_REG 1024 /* Max number of x(N) registers used */ -/* Scheduler stores data for temporary heaps if - !HEAP_ON_C_STACK. Macros (*TmpHeap*) in global.h selects if we put temporary - heap data on the C stack or if we use the buffers in the scheduler data. */ -#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers - small heap for transient heap data */ -#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ -#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ - /* * The new arithmetic operations need some extra X registers in the register array. * so does the gc_bif's (i_gc_bif3 need 3 extra). diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 870afb414f..b4d02dd1dd 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1444,69 +1444,16 @@ erts_alloc_message_heap(Uint size, #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#if !HEAP_ON_C_STACK -# if defined(DEBUG) -# define DeclareTmpHeap(VariableName,Size,Process) \ - Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,Process) -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ - Type *VariableName = (Type *) erts_debug_allocate_tmp_heap(sizeof(Type)/sizeof(Eterm),Process) -# define DeclareTmpHeapNoproc(VariableName,Size) \ - Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,NULL) -# define UseTmpHeap(Size,Proc) \ - do { \ - erts_debug_use_tmp_heap((Size),(Proc)); \ - } while (0) -# define UnUseTmpHeap(Size,Proc) \ - do { \ - erts_debug_unuse_tmp_heap((Size),(Proc)); \ - } while (0) -# define UseTmpHeapNoproc(Size) \ - do { \ - erts_debug_use_tmp_heap(Size,NULL); \ - } while (0) -# define UnUseTmpHeapNoproc(Size) \ - do { \ - erts_debug_unuse_tmp_heap(Size,NULL); \ - } while (0) -# else -# define DeclareTmpHeap(VariableName,Size,Process) \ - Eterm *VariableName = (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used) -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ - Type *VariableName = (Type *) (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used) -# define DeclareTmpHeapNoproc(VariableName,Size) \ - Eterm *VariableName = (erts_get_scheduler_data()->tmp_heap)+(erts_get_scheduler_data()->num_tmp_heap_used) -# define UseTmpHeap(Size,Proc) \ - do { \ - ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used += (Size); \ - } while (0) -# define UnUseTmpHeap(Size,Proc) \ - do { \ - ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used -= (Size); \ - } while (0) -# define UseTmpHeapNoproc(Size) \ - do { \ - erts_get_scheduler_data()->num_tmp_heap_used += (Size); \ - } while (0) -# define UnUseTmpHeapNoproc(Size) \ - do { \ - erts_get_scheduler_data()->num_tmp_heap_used -= (Size); \ - } while (0) - - -# endif - -#else -# define DeclareTmpHeap(VariableName,Size,Process) \ +#define DeclareTmpHeap(VariableName,Size,Process) \ Eterm VariableName[Size] -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ +#define DeclareTypedTmpHeap(Type,VariableName,Process) \ Type VariableName[1] -# define DeclareTmpHeapNoproc(VariableName,Size) \ +#define DeclareTmpHeapNoproc(VariableName,Size) \ Eterm VariableName[Size] -# define UseTmpHeap(Size,Proc) /* Nothing */ -# define UnUseTmpHeap(Size,Proc) /* Nothing */ -# define UseTmpHeapNoproc(Size) /* Nothing */ -# define UnUseTmpHeapNoproc(Size) /* Nothing */ -#endif /* HEAP_ON_C_STACK */ +#define UseTmpHeap(Size,Proc) /* Nothing */ +#define UnUseTmpHeap(Size,Proc) /* Nothing */ +#define UseTmpHeapNoproc(Size) /* Nothing */ +#define UnUseTmpHeapNoproc(Size) /* Nothing */ ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf); ERTS_GLB_INLINE void dtrace_proc_str(Process *process, char *process_buf); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 6b4b90cb06..915d0f4328 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -6791,7 +6791,7 @@ int driver_monitor_process(ErlDrvPort drvport, { Port *prt; int ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6802,16 +6802,6 @@ int driver_monitor_process(ErlDrvPort drvport, /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_monitor_process(prt,buf,process,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); @@ -6864,7 +6854,7 @@ int driver_demonitor_process(ErlDrvPort drvport, { Port *prt; int ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6875,15 +6865,6 @@ int driver_demonitor_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_demonitor_process(prt,buf,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); @@ -6919,7 +6900,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, { Port *prt; ErlDrvTermData ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6930,16 +6911,6 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_get_monitored_process(prt,buf,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); -- cgit v1.2.3 From dfe1c58c504531361fa3f8ed874238a9ff552640 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 29 Jun 2015 13:24:31 +0200 Subject: beam_makeops: Eliminate crash because of unsafe packing Consider an hypothetical instruction: do_something x x c The loader would crash if we tried to load an instance of the instruction with the last operand referencing a literal: {do_something,{x,0},{x,1},{literal,{a,b,c}}} Teach beam_makeops to turn off packing for such unsafe instructions. --- erts/emulator/utils/beam_makeops | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index e90ed94187..7c94546ea4 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1057,6 +1057,7 @@ sub do_pack { my($packable_args) = 0; my @is_packable; # Packability (boolean) for each argument. my $wide_packing = 0; + my(@orig_args) = @args; # # Count the number of packable arguments. If we encounter any 's' or 'd' @@ -1077,6 +1078,18 @@ sub do_pack { } } elsif ($arg =~ /^[sd]/) { return ('', '', @args); + } elsif ($arg =~ /^[scq]/ and $packable_args > 0) { + # When packing, this operand will be picked up from the + # code array, put onto the packing stack, and later put + # back into a different location in the code. The problem + # is that if this operand is a literal, the original + # location in the code would have been remembered in a + # literal patch. For packing to work, we would have to + # adjust the position in the literal patch. For the + # moment, adding additional instructions to the packing + # engine to handle this does not seem worth it, so we will + # just turn off packing. + return ('', '', @args); } else { push @is_packable, 0; } -- cgit v1.2.3 From 54189af4a519b72883dde3263135baf6aba0f81f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 1 Jul 2015 12:18:54 +0200 Subject: beam_emu.c: Remove unused MoveGenDest macro --- erts/emulator/beam/beam_emu.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 806b31654c..0f9bfa1871 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -566,9 +566,6 @@ void** beam_ops; #define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2) #define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) -#define MoveGenDest(src, dstp) \ - if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; } - #define MoveReturn(Src, Dest) \ (Dest) = (Src); \ I = c_p->cp; \ -- cgit v1.2.3 From 45f469ca089096c8a59ca53d948d05d1a998386e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 30 Mar 2012 11:05:16 +0200 Subject: Change the meaning of 'x' in a transformation The purpose of this series of commits is to improve code generation for the Clang compiler. As a first step we want to change the meaning of 'x' in a transformation such as: operation Literal=q => move Literal x | operation x Currently, a plain 'x' means reg[0] or x(0), which is the first element in the X register array. That element is distinct from r(0) which is a variable in process_main(). Therefore, since r(0) and x(0) are currently distinct it is fine to use x(0) as a scratch register. However, in the next commit we will eliminate the separate variable for storing the contents of X register zero (thus, x(0) and r(0) will point to the same location in the X register array). Therefore, we must use another scratch register in transformation. Redefine a plain 'x' in a transformation to mean x(1023). Also define SCRATCH_X_REG so that we can refer to the register by name from C code. --- erts/emulator/beam/beam_load.c | 2 +- erts/emulator/utils/beam_makeops | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 10baab506a..f5f1147261 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4322,7 +4322,7 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, for (i = 0; i < n; i++) { op->a[3+2*i] = Rest[i]; op->a[3+2*i+1].type = TAG_x; - op->a[3+2*i+1].val = 0; /* x(0); normally not used */ + op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */ } return op; } diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 7c94546ea4..6e1741af85 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -601,6 +601,7 @@ sub emulator_output { print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n"; print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n"; print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n"; + print "#define SCRATCH_X_REG 1023\n"; print "\n"; print "#ifdef ARCH_64\n"; print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; @@ -1341,7 +1342,10 @@ sub tr_parse_op { } # Get an optional value. (In destination.) + $type_val = $type eq 'x' ? 1023 : 0; if (/^=(.*)/) { + error("value not allowed in source: $op") + if $src; $type_val = $1; $_ = ''; } @@ -1360,11 +1364,6 @@ sub tr_parse_op { if $var && $type; } - # Test that source has no values. - if ($src) { - error("value not allowed in source: $op") - if $type_val; - } ($var,$type,$type_val,$cond,$cond_val); } -- cgit v1.2.3 From 1f996cc46a8c935b8f4e33a4a96804f9fb852da3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 30 Mar 2012 11:38:37 +0200 Subject: Store r(0) and x(0) in the same location As part of improving code generation for clang, we want to eliminate the special variable that stores the content of X register zero most of the time. In a future, that will allow us to eliminate the special case of handling r(0) for most instructions, thus reducing the code size and allow other simplifcations. Therefore, in this commit, eliminate the variable that is used to store r(0) and make r(0) as synonym for x(0). I have chosen to keep the r(0) define to keep the size of the diff managable. --- erts/emulator/beam/beam_emu.c | 100 +++--------------------------------------- 1 file changed, 7 insertions(+), 93 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 0f9bfa1871..9a34d5f11a 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -99,10 +99,7 @@ do { \ do { \ int i_; \ int Arity_ = PC[-1]; \ - if (Arity_ > 0) { \ - CHECK_TERM(r(0)); \ - } \ - for (i_ = 1; i_ < Arity_; i_++) { \ + for (i_ = 0; i_ < Arity_; i_++) { \ CHECK_TERM(x(i_)); \ } \ } while (0) @@ -293,7 +290,7 @@ void** beam_ops; #define Ib(N) (N) #define x(N) reg[N] #define y(N) E[N] -#define r(N) x##N +#define r(N) x(N) /* * Makes sure that there are StackNeed + HeapNeed + 1 words available @@ -309,12 +306,10 @@ void** beam_ops; needed = (StackNeed) + 1; \ if (E - HTOP < (needed + (HeapNeed))) { \ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ E -= needed; \ @@ -363,12 +358,10 @@ void** beam_ops; unsigned need = (Nh); \ if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ HEAP_SPACE_VERIFIED(need); \ @@ -386,12 +379,10 @@ void** beam_ops; unsigned need = (Nh); \ if (E - HTOP < need) { \ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ HEAP_SPACE_VERIFIED(need); \ @@ -408,15 +399,11 @@ void** beam_ops; unsigned need = (Nh); \ if (E - HTOP < need) { \ SWAPOUT; \ - reg[0] = r(0); \ reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - if (Live > 0) { \ - r(0) = reg[0]; \ - } \ Extra = reg[Live]; \ SWAPIN; \ } \ @@ -439,7 +426,6 @@ void** beam_ops; #define MakeFun(FunP, NumFree) \ do { \ SWAPOUT; \ - reg[0] = r(0); \ r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \ SWAPIN; \ } while (0) @@ -992,7 +978,6 @@ init_emulator(void) */ #if defined(__GNUC__) && defined(sparc) && !defined(DEBUG) -# define REG_x0 asm("%l0") # define REG_xregs asm("%l1") # define REG_htop asm("%l2") # define REG_stop asm("%l3") @@ -1001,7 +986,6 @@ init_emulator(void) # define REG_tmp_arg1 asm("%l6") # define REG_tmp_arg2 asm("%l7") #else -# define REG_x0 # define REG_xregs # define REG_htop # define REG_stop @@ -1126,11 +1110,6 @@ void process_main(void) ERTS_DECLARE_DUMMY(Eterm pid); #endif - /* - * X register zero; also called r(0) - */ - register Eterm x0 REG_x0 = NIL; - /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC, * in all other cases x0 is used. */ @@ -1262,7 +1241,7 @@ void process_main(void) int i; argp = c_p->arg_reg; - for (i = c_p->arity - 1; i > 0; i--) { + for (i = c_p->arity - 1; i >= 0; i--) { reg[i] = argp[i]; CHECK_TERM(reg[i]); } @@ -1286,12 +1265,6 @@ void process_main(void) } next = (BeamInstr *) *I; - r(0) = c_p->arg_reg[0]; -#ifdef HARDDEBUG - if (c_p->arity > 0) { - CHECK_TERM(r(0)); - } -#endif SWAPIN; ASSERT(VALID_INSTR(next)); @@ -1365,11 +1338,9 @@ void process_main(void) live = Arg(2); SWAPOUT; - reg[0] = r(0); reg[live] = increment_reg_val; reg[live+1] = make_small(increment_val); result = erts_gc_mixed_plus(c_p, reg, live); - r(0) = reg[0]; SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_value(result)) { @@ -1383,11 +1354,9 @@ void process_main(void) do { \ Uint live = Arg(1); \ SWAPOUT; \ - reg[0] = r(0); \ reg[live] = (Arg1); \ reg[live+1] = (Arg2); \ result = (Func)(c_p, reg, live); \ - r(0) = reg[0]; \ SWAPIN; \ ERTS_HOLE_CHECK(c_p); \ if (is_value(result)) { \ @@ -1706,7 +1675,6 @@ void process_main(void) PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; - reg[0] = r(0); result = erl_send(c_p, r(0), x(1)); PreFetch(0, next); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -1714,7 +1682,6 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { result = erts_gc_after_bif_call(c_p, result, reg, 2); - r(0) = reg[0]; E = c_p->stop; } HTOP = HEAP_TOP(c_p); @@ -1727,7 +1694,6 @@ void process_main(void) SET_CP(c_p, I+1); SET_I(c_p->i); SWAPIN; - r(0) = reg[0]; Dispatch(); } goto find_func_info; @@ -1935,13 +1901,11 @@ void process_main(void) ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS, { SWAPOUT; - reg[0] = r(0); PROCESS_MAIN_CHK_LOCKS(c_p); }, { ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); - r(0) = reg[0]; SWAPIN; }); if (is_non_value(ERL_MESSAGE_TERM(msgp))) { @@ -2448,11 +2412,9 @@ void process_main(void) OpCase(new_map_dII): { Eterm res; - x(0) = r(0); SWAPOUT; res = new_map(c_p, reg, I-1); SWAPIN; - r(0) = x(0); StoreResult(res, Arg(0)); Next(3+Arg(2)); } @@ -2543,12 +2505,10 @@ do { \ Eterm map; GetArg1(1, map); - x(0) = r(0); SWAPOUT; res = update_map_assoc(c_p, reg, map, I); SWAPIN; if (is_value(res)) { - r(0) = x(0); StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { @@ -2567,12 +2527,10 @@ do { \ Eterm map; GetArg1(1, map); - x(0) = r(0); SWAPOUT; res = update_map_exact(c_p, reg, map, I); SWAPIN; if (is_value(res)) { - r(0) = x(0); StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { @@ -2659,7 +2617,6 @@ do { \ Uint live = (Uint) Arg(3); GetArg1(2, arg); - reg[0] = r(0); reg[live] = arg; bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; @@ -2671,7 +2628,6 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -2694,7 +2650,6 @@ do { \ Eterm result; Uint live = (Uint) Arg(2); - reg[0] = r(0); reg[live++] = tmp_arg1; reg[live] = tmp_arg2; bf = (GcBifFunction) Arg(1); @@ -2707,7 +2662,6 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -2732,7 +2686,6 @@ do { \ Uint live = (Uint) Arg(3); GetArg1(2, arg); - reg[0] = r(0); reg[live++] = arg; reg[live++] = tmp_arg1; reg[live] = tmp_arg2; @@ -2746,7 +2699,6 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -2835,7 +2787,6 @@ do { \ PreFetch(1, next); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - reg[0] = r(0); result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -2857,7 +2808,6 @@ do { \ SET_CP(c_p, I+2); SET_I(c_p->i); SWAPIN; - r(0) = reg[0]; Dispatch(); } @@ -2967,11 +2917,9 @@ do { \ Uint live = Arg(1); SWAPOUT; - reg[0] = r(0); reg[live] = tmp_arg1; reg[live+1] = tmp_arg2; result = arith_func(c_p, reg, live); - r(0) = reg[0]; SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_value(result)) { @@ -3166,10 +3114,8 @@ do { \ } else { Uint live = Arg(2); SWAPOUT; - reg[0] = r(0); reg[live] = bnot_val; bnot_val = erts_gc_bnot(c_p, reg, live); - r(0) = reg[0]; SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_nil(bnot_val)) { @@ -3189,7 +3135,6 @@ do { \ next = apply(c_p, r(0), x(1), x(2), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+1); SET_I(next); Dispatch(); @@ -3204,7 +3149,6 @@ do { \ next = apply(c_p, r(0), x(1), x(2), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); @@ -3220,7 +3164,6 @@ do { \ next = apply(c_p, r(0), x(1), x(2), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatch(); } @@ -3231,12 +3174,10 @@ do { \ OpCase(apply_I): { BeamInstr *next; - reg[0] = r(0); SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+2); SET_I(next); Dispatch(); @@ -3248,12 +3189,10 @@ do { \ OpCase(apply_last_IP): { BeamInstr *next; - reg[0] = r(0); SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); @@ -3270,7 +3209,6 @@ do { \ next = apply_fun(c_p, r(0), x(1), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+1); SET_I(next); Dispatchfun(); @@ -3285,7 +3223,6 @@ do { \ next = apply_fun(c_p, r(0), x(1), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); @@ -3301,7 +3238,6 @@ do { \ next = apply_fun(c_p, r(0), x(1), reg); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatchfun(); } @@ -3312,12 +3248,9 @@ do { \ BeamInstr *next; SWAPOUT; - reg[0] = r(0); - next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+2); SET_I(next); Dispatchfun(); @@ -3329,11 +3262,9 @@ do { \ BeamInstr *next; SWAPOUT; - reg[0] = r(0); next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); @@ -3418,10 +3349,9 @@ do { \ */ argp = c_p->arg_reg; - for (i = c_p->arity - 1; i > 0; i--) { + for (i = c_p->arity - 1; i >= 0; i--) { argp[i] = reg[i]; } - c_p->arg_reg[0] = r(0); SWAPOUT; c_p->i = I; goto do_schedule1; @@ -3531,7 +3461,6 @@ do { \ /* Fall through here */ find_func_info: { - reg[0] = r(0); SWAPOUT; I = handle_error(c_p, I, reg, NULL); goto post_error_handling; @@ -3549,9 +3478,7 @@ do { \ * code[4]: Not used */ SWAPOUT; - reg[0] = r(0); I = call_error_handler(c_p, I-3, reg, am_undefined_function); - r(0) = reg[0]; SWAPIN; if (I) { Goto(*I); @@ -3560,14 +3487,12 @@ do { \ /* Fall through */ OpCase(error_action_code): { handle_error: - reg[0] = r(0); SWAPOUT; I = handle_error(c_p, NULL, reg, NULL); post_error_handling: if (I == 0) { goto do_schedule; } else { - r(0) = reg[0]; ASSERT(!is_value(r(0))); if (c_p->mbuf) { erts_garbage_collect(c_p, 0, reg+1, 3); @@ -3610,7 +3535,6 @@ do { \ NifF* fp = vbf = (NifF*) I[1]; struct enif_environment_t env; erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); - reg[0] = r(0); nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) nif_bif_result = THE_NON_VALUE; @@ -3649,7 +3573,7 @@ do { \ bif_nif_arity = I[-1]; ASSERT(bif_nif_arity <= 4); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - reg[0] = r(0); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); { Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -3679,7 +3603,6 @@ do { \ Goto(*I); } else if (c_p->freason == TRAP) { SET_I(c_p->i); - r(0) = reg[0]; if (c_p->flags & F_HIBERNATE_SCHED) { c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; @@ -4126,10 +4049,8 @@ do { \ Uint res; SWAPOUT; - reg[0] = r(0); reg[live] = tmp_arg2; res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3)); - r(0) = reg[0]; SWAPIN; if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ @@ -4706,7 +4627,7 @@ do { \ Uint hole_size; OpCase(bs_context_to_binary_r): { - context_to_binary_context = x0; + context_to_binary_context = r(0); I -= 2; goto do_context_to_binary; } @@ -4737,7 +4658,7 @@ do { \ Next(2); OpCase(i_bs_get_binary_all_reuse_rfI): { - context_to_binary_context = x0; + context_to_binary_context = r(0); goto do_bs_get_binary_all_reuse; } @@ -4883,9 +4804,7 @@ do { \ BeamInstr real_I; ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); SWAPOUT; - reg[0] = r(0); real_I = erts_generic_breakpoint(c_p, I, reg); - r(0) = reg[0]; SWAPIN; ASSERT(VALID_INSTR(real_I)); Goto(real_I); @@ -5103,7 +5022,6 @@ do { \ SWAPOUT; c_p->fcalls = FCALLS; c_p->def_arg_reg[4] = -neg_o_reds; - reg[0] = r(0); c_p = hipe_mode_switch(c_p, cmd, reg); reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; @@ -5120,7 +5038,6 @@ do { \ /*fall through*/ case HIPE_MODE_SWITCH_RES_CALL_BEAM: SET_I(c_p->i); - r(0) = reg[0]; Dispatch(); case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: /* This can be used to call any function value, but currently it's @@ -5131,7 +5048,6 @@ do { \ next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatchfun(); } @@ -5191,9 +5107,7 @@ do { \ OpCase(i_debug_breakpoint): { SWAPOUT; - reg[0] = r(0); I = call_error_handler(c_p, I-3, reg, am_breakpoint); - r(0) = reg[0]; SWAPIN; if (I) { Goto(*I); -- cgit v1.2.3 From e1019cbba7a66788a068b6df1a1caf2d643ef65b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 30 Mar 2012 11:54:04 +0200 Subject: Eliminate R_REG_DEF --- erts/emulator/beam/beam_debug.c | 22 ++-------------------- erts/emulator/beam/beam_emu.c | 14 -------------- erts/emulator/beam/beam_load.c | 8 ++------ erts/emulator/beam/erl_term.h | 2 -- 4 files changed, 4 insertions(+), 42 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 8a35ad17c6..00d0b27178 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -452,21 +452,13 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case 's': /* Any source (tagged constant or register) */ tag = beam_reg_tag(*ap); if (tag == X_REG_DEF) { - if (reg_index(*ap) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); - } + erts_print(to, to_arg, "x(%d)", reg_index(*ap)); ap++; break; } else if (tag == Y_REG_DEF) { erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); ap++; break; - } else if (tag == R_REG_DEF) { - erts_print(to, to_arg, "x(0)"); - ap++; - break; } /*FALLTHROUGH*/ case 'a': /* Tagged atom */ @@ -483,18 +475,11 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case 'd': /* Destination (x(0), x(N), y(N)) */ switch (beam_reg_tag(*ap)) { case X_REG_DEF: - if (reg_index(*ap) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); - } + erts_print(to, to_arg, "x(%d)", reg_index(*ap)); break; case Y_REG_DEF: erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); break; - case R_REG_DEF: - erts_print(to, to_arg, "x(0)"); - break; } ap++; break; @@ -677,9 +662,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " %T", (Eterm) ap[0]); } else { switch ((ap[0] >> 2) & 0x03) { - case R_REG_DEF: - erts_print(to, to_arg, " x(0)"); - break; case X_REG_DEF: erts_print(to, to_arg, " x(%d)", ap[0] >> 4); break; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 9a34d5f11a..059c443450 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -160,8 +160,6 @@ do { \ stb_reg = (DestDesc); \ CHECK_TERM(Result); \ switch (beam_reg_tag(stb_reg)) { \ - case R_REG_DEF: \ - r(0) = (Result); break; \ case X_REG_DEF: \ xb(x_reg_offset(stb_reg)) = (Result); break; \ default: \ @@ -186,8 +184,6 @@ do { \ stb_next = (BeamInstr *) *I; \ CHECK_TERM(Result); \ switch (beam_reg_tag(stb_reg)) { \ - case R_REG_DEF: \ - r(0) = (Result); Goto(stb_next); \ case X_REG_DEF: \ xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ default: \ @@ -521,7 +517,6 @@ void** beam_ops; do { \ tr = Arg(pos); \ switch (beam_reg_tag(tr)) { \ - case R_REG_DEF: tr = r(0); break; \ case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \ case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \ } \ @@ -2391,9 +2386,6 @@ void process_main(void) do { Eterm term = *I++; switch (term & _TAG_IMMED1_MASK) { - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = r(0); - break; case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: *hp++ = x(term >> _TAG_IMMED1_SIZE); break; @@ -2422,9 +2414,6 @@ void process_main(void) #define PUT_TERM_REG(term, desc) \ do { \ switch ((desc) & _TAG_IMMED1_MASK) { \ - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - r(0) = (term); \ - break; \ case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ x((desc) >> _TAG_IMMED1_SIZE) = (term); \ break; \ @@ -6502,9 +6491,6 @@ static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx) do { \ Eterm src = (Eterm)(term); \ switch (src & _TAG_IMMED1_MASK) { \ - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = x(0); \ - break; \ case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ dest = x(src >> _TAG_IMMED1_SIZE); \ break; \ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index f5f1147261..495e92d600 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2167,7 +2167,7 @@ load_code(LoaderState* stp) case 's': /* Any source (tagged constant or register) */ switch (tag) { case TAG_r: - code[ci++] = make_rreg(); + code[ci++] = make_xreg(0); break; case TAG_x: code[ci++] = make_xreg(tmp_op->a[arg].val); @@ -2193,7 +2193,7 @@ load_code(LoaderState* stp) case 'd': /* Destination (x(0), x(N), y(N) */ switch (tag) { case TAG_r: - code[ci++] = make_rreg(); + code[ci++] = make_xreg(0); break; case TAG_x: code[ci++] = make_xreg(tmp_op->a[arg].val); @@ -2357,10 +2357,6 @@ load_code(LoaderState* stp) ci++; break; case TAG_r: - CodeNeed(1); - code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) | - TAG_PRIMARY_HEADER; - break; case TAG_x: CodeNeed(1); code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index b928e4ca1e..cff2430547 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1037,11 +1037,9 @@ _ET_DECLARE_CHECKED(Uint,catch_val,Eterm) #define X_REG_DEF 0 #define Y_REG_DEF 1 -#define R_REG_DEF 2 #define beam_reg_tag(x) ((x) & 3) -#define make_rreg() R_REG_DEF #define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF) #define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF) -- cgit v1.2.3 From f0923b143ecfdacfe4873fc1e96c8ec69726a4d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Jun 2015 06:39:25 +0200 Subject: Allow X and Y registers to be overloaded with any literal Consider the try_case_end instruction: try_case_end s The 's' operand type means that the operand can either be a literal of one of the types atom, integer, or empty list, or a register. That worked well before R12. In R12 additional types of literals where introduced. Because of way the overloading was done, an 's' operand cannot handle the new types of literals. Therefore, code such as the following is necessary in ops.tab to avoid giving an 's' operand a literal: try_case_end Literal=q => move Literal x | try_case_end x While this work, it is error-prone in that it is easy to forget to add that kind of rule. It would also be complicated in case we wanted to introduce a new kind of addition operator such as: i_plus jssd Since there are two 's' operands, two scratch registers and two 'move' instructions would be needed. Therefore, we'll need to find a smarter way to find tag register operands. We will overload the pid and port tags for X and Y register, respectively. That works because pids and port are immediate values (fit in one word), and there are no literals for pids and ports. --- erts/emulator/beam/beam_debug.c | 77 +++++++++++----------- erts/emulator/beam/beam_emu.c | 139 +++++++++++++++++++++------------------ erts/emulator/beam/beam_load.c | 22 ++++--- erts/emulator/beam/erl_term.c | 6 +- erts/emulator/beam/erl_term.h | 50 +++++++------- erts/emulator/beam/ops.tab | 29 +------- erts/emulator/utils/beam_makeops | 3 +- 7 files changed, 155 insertions(+), 171 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 00d0b27178..243ccb9afd 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -432,31 +432,33 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) while (*sign) { switch (*sign) { case 'r': /* x(0) */ - erts_print(to, to_arg, "x(0)"); + erts_print(to, to_arg, "r(0)"); break; case 'x': /* x(N) */ - if (reg_index(ap[0]) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(ap[0])); + { + Uint n = ap[0] / sizeof(Eterm); + erts_print(to, to_arg, "x(%d)", n); + ap++; } - ap++; break; case 'y': /* y(N) */ - erts_print(to, to_arg, "y(%d)", reg_index(ap[0]) - CP_SIZE); - ap++; + { + Uint n = ap[0] / sizeof(Eterm) - CP_SIZE; + erts_print(to, to_arg, "y(%d)", n); + ap++; + } break; case 'n': /* Nil */ erts_print(to, to_arg, "[]"); break; case 's': /* Any source (tagged constant or register) */ - tag = beam_reg_tag(*ap); - if (tag == X_REG_DEF) { - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); + tag = loader_tag(*ap); + if (tag == LOADER_X_REG) { + erts_print(to, to_arg, "x(%d)", loader_x_reg_index(*ap)); ap++; break; - } else if (tag == Y_REG_DEF) { - erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); + } else if (tag == LOADER_Y_REG) { + erts_print(to, to_arg, "y(%d)", loader_y_reg_index(*ap) - CP_SIZE); ap++; break; } @@ -473,12 +475,14 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'd': /* Destination (x(0), x(N), y(N)) */ - switch (beam_reg_tag(*ap)) { - case X_REG_DEF: - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); + switch (loader_tag(*ap)) { + case LOADER_X_REG: + erts_print(to, to_arg, "x(%d)", + loader_x_reg_index(*ap)); break; - case Y_REG_DEF: - erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); + case LOADER_Y_REG: + erts_print(to, to_arg, "y(%d)", + loader_y_reg_index(*ap) - CP_SIZE); break; } ap++; @@ -546,7 +550,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'l': /* fr(N) */ - erts_print(to, to_arg, "fr(%d)", reg_index(ap[0])); + erts_print(to, to_arg, "fr(%d)", loader_reg_index(ap[0])); ap++; break; default: @@ -658,17 +662,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) int n = unpacked[-1]; while (n > 0) { - if (!is_header(ap[0])) { + switch (loader_tag(ap[0])) { + case LOADER_X_REG: + erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); + break; + case LOADER_Y_REG: + erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + break; + default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); - } else { - switch ((ap[0] >> 2) & 0x03) { - case X_REG_DEF: - erts_print(to, to_arg, " x(%d)", ap[0] >> 4); - break; - case Y_REG_DEF: - erts_print(to, to_arg, " y(%d)", ap[0] >> 4); - break; - } + break; } ap++, size++, n--; } @@ -681,18 +684,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) while (n > 0) { if (n % 3 == 1) { erts_print(to, to_arg, " %X", ap[0]); - } else if (!is_header(ap[0])) { - erts_print(to, to_arg, " %T", (Eterm) ap[0]); } else { - switch ((ap[0] >> 2) & 0x03) { - case R_REG_DEF: - erts_print(to, to_arg, " x(0)"); + switch (loader_tag(ap[0])) { + case LOADER_X_REG: + erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; - case X_REG_DEF: - erts_print(to, to_arg, " x(%d)", ap[0] >> 4); + case LOADER_Y_REG: + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0])); break; - case Y_REG_DEF: - erts_print(to, to_arg, " y(%d)", ap[0] >> 4); + default: + erts_print(to, to_arg, " %T", (Eterm) ap[0]); break; } } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 059c443450..a74da2d872 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -154,17 +154,19 @@ do { \ * Store a result into a register given a destination descriptor. */ -#define StoreResult(Result, DestDesc) \ - do { \ - Eterm stb_reg; \ - stb_reg = (DestDesc); \ - CHECK_TERM(Result); \ - switch (beam_reg_tag(stb_reg)) { \ - case X_REG_DEF: \ - xb(x_reg_offset(stb_reg)) = (Result); break; \ - default: \ - yb(y_reg_offset(stb_reg)) = (Result); break; \ - } \ +#define StoreResult(Result, DestDesc) \ + do { \ + Eterm stb_reg; \ + stb_reg = (DestDesc); \ + CHECK_TERM(Result); \ + switch (loader_tag(stb_reg)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(stb_reg)) = (Result); \ + break; \ + default: \ + y(loader_y_reg_index(stb_reg)) = (Result); \ + break; \ + } \ } while (0) #define StoreSimpleDest(Src, Dest) Dest = (Src) @@ -175,20 +177,22 @@ do { \ * be just before the next instruction. */ -#define StoreBifResult(Dst, Result) \ - do { \ - BeamInstr* stb_next; \ - Eterm stb_reg; \ - stb_reg = Arg(Dst); \ - I += (Dst) + 2; \ - stb_next = (BeamInstr *) *I; \ - CHECK_TERM(Result); \ - switch (beam_reg_tag(stb_reg)) { \ - case X_REG_DEF: \ - xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ - default: \ - yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ - } \ +#define StoreBifResult(Dst, Result) \ + do { \ + BeamInstr* stb_next; \ + Eterm stb_reg; \ + stb_reg = Arg(Dst); \ + I += (Dst) + 2; \ + stb_next = (BeamInstr *) *I; \ + CHECK_TERM(Result); \ + switch (loader_tag(stb_reg)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(stb_reg)) = (Result); \ + Goto(stb_next); \ + default: \ + y(loader_y_reg_index(stb_reg)) = (Result); \ + Goto(stb_next); \ + } \ } while (0) #define ClauseFail() goto jump_f @@ -513,14 +517,19 @@ void** beam_ops; ASSERT(VALID_INSTR(Dst)); \ Goto(Dst) -#define GetR(pos, tr) \ - do { \ - tr = Arg(pos); \ - switch (beam_reg_tag(tr)) { \ - case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \ - case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \ - } \ - CHECK_TERM(tr); \ +#define GetR(pos, tr) \ + do { \ + tr = Arg(pos); \ + switch (loader_tag(tr)) { \ + case LOADER_X_REG: \ + tr = x(loader_x_reg_index(tr)); \ + break; \ + case LOADER_Y_REG: \ + ASSERT(loader_y_reg_index(tr) >= 1); \ + tr = y(loader_y_reg_index(tr)); \ + break; \ + } \ + CHECK_TERM(tr); \ } while (0) #define GetArg1(N, Dst) GetR((N), Dst) @@ -2385,12 +2394,12 @@ void process_main(void) do { Eterm term = *I++; - switch (term & _TAG_IMMED1_MASK) { - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = x(term >> _TAG_IMMED1_SIZE); + switch (loader_tag(term)) { + case LOADER_X_REG: + *hp++ = x(loader_x_reg_index(term)); break; - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = y(term >> _TAG_IMMED1_SIZE); + case LOADER_Y_REG: + *hp++ = y(loader_y_reg_index(term)); break; default: *hp++ = term; @@ -2411,19 +2420,19 @@ void process_main(void) Next(3+Arg(2)); } -#define PUT_TERM_REG(term, desc) \ -do { \ - switch ((desc) & _TAG_IMMED1_MASK) { \ - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - x((desc) >> _TAG_IMMED1_SIZE) = (term); \ - break; \ - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - y((desc) >> _TAG_IMMED1_SIZE) = (term); \ - break; \ - default: \ - ASSERT(0); \ - break; \ - } \ +#define PUT_TERM_REG(term, desc) \ +do { \ + switch (loader_tag(desc)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(desc)) = (term); \ + break; \ + case LOADER_Y_REG: \ + y(loader_y_reg_index(desc)) = (term); \ + break; \ + default: \ + ASSERT(0); \ + break; \ + } \ } while(0) OpCase(i_get_map_elements_fsI): { @@ -6487,20 +6496,20 @@ static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx) return vs ? *vs : THE_NON_VALUE; } -#define GET_TERM(term, dest) \ -do { \ - Eterm src = (Eterm)(term); \ - switch (src & _TAG_IMMED1_MASK) { \ - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = x(src >> _TAG_IMMED1_SIZE); \ - break; \ - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = y(src >> _TAG_IMMED1_SIZE); \ - break; \ - default: \ - dest = src; \ - break; \ - } \ +#define GET_TERM(term, dest) \ +do { \ + Eterm src = (Eterm)(term); \ + switch (loader_tag(src)) { \ + case LOADER_X_REG: \ + dest = x(loader_x_reg_index(src)); \ + break; \ + case LOADER_Y_REG: \ + dest = y(loader_y_reg_index(src)); \ + break; \ + default: \ + dest = src; \ + break; \ + } \ } while(0) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 495e92d600..3cd80c4ec2 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2167,13 +2167,13 @@ load_code(LoaderState* stp) case 's': /* Any source (tagged constant or register) */ switch (tag) { case TAG_r: - code[ci++] = make_xreg(0); + code[ci++] = make_loader_x_reg(0); break; case TAG_x: - code[ci++] = make_xreg(tmp_op->a[arg].val); + code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; case TAG_y: - code[ci++] = make_yreg(tmp_op->a[arg].val); + code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); break; case TAG_i: code[ci++] = (BeamInstr) make_small((Uint)tmp_op->a[arg].val); @@ -2184,6 +2184,10 @@ load_code(LoaderState* stp) case TAG_n: code[ci++] = NIL; break; + case TAG_q: + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; default: LoadError1(stp, "bad tag %d for general source", tmp_op->a[arg].type); @@ -2193,13 +2197,13 @@ load_code(LoaderState* stp) case 'd': /* Destination (x(0), x(N), y(N) */ switch (tag) { case TAG_r: - code[ci++] = make_xreg(0); + code[ci++] = make_loader_x_reg(0); break; case TAG_x: - code[ci++] = make_xreg(tmp_op->a[arg].val); + code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; case TAG_y: - code[ci++] = make_yreg(tmp_op->a[arg].val); + code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); break; default: LoadError1(stp, "bad tag %d for destination", @@ -2359,13 +2363,11 @@ load_code(LoaderState* stp) case TAG_r: case TAG_x: CodeNeed(1); - code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | - (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; case TAG_y: CodeNeed(1); - code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | - (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); break; case TAG_n: CodeNeed(1); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 89459fb278..3a5fbcc284 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -173,9 +173,7 @@ ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr); ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer); ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP); ET_DEFINE_CHECKED(Uint,catch_val,Eterm,is_catch); -ET_DEFINE_CHECKED(Uint,x_reg_offset,Uint,_is_xreg); -ET_DEFINE_CHECKED(Uint,y_reg_offset,Uint,_is_yreg); -ET_DEFINE_CHECKED(Uint,x_reg_index,Uint,_is_xreg); -ET_DEFINE_CHECKED(Uint,y_reg_index,Uint,_is_yreg); +ET_DEFINE_CHECKED(Uint,loader_x_reg_index,Uint,_is_loader_x_reg); +ET_DEFINE_CHECKED(Uint,loader_y_reg_index,Uint,_is_loader_y_reg); #endif /* ET_DEBUG */ diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index cff2430547..089eecf024 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1027,42 +1027,40 @@ _ET_DECLARE_CHECKED(Uint,catch_val,Eterm) /* * Overloaded tags. * - * SMALL = 15 - * ATOM/NIL=7 + * In the loader, we want to tag a term in a way so that it can + * be any literal (atom/integer/float/tuple/list/binary) or a + * register. * - * Note that the two least significant bits in SMALL/ATOM/NIL always are 3; - * thus, we can distinguish register from literals by looking at only these - * two bits. + * We can achive that by overloading the PID and PORT tags to + * mean X and Y registers. That works because there are no + * pid or port literals. */ -#define X_REG_DEF 0 -#define Y_REG_DEF 1 +#define _LOADER_TAG_XREG _TAG_IMMED1_PID +#define _LOADER_TAG_YREG _TAG_IMMED1_PORT +#define _LOADER_TAG_SIZE _TAG_IMMED1_SIZE +#define _LOADER_MASK _TAG_IMMED1_MASK -#define beam_reg_tag(x) ((x) & 3) +#define LOADER_X_REG _LOADER_TAG_XREG +#define LOADER_Y_REG _LOADER_TAG_YREG -#define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF) -#define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF) +#define make_loader_x_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_XREG) +#define make_loader_y_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_YREG) -#define _is_xreg(x) (beam_reg_tag(x) == X_REG_DEF) -#define _is_yreg(x) (beam_reg_tag(x) == Y_REG_DEF) +#define loader_reg_index(R) ((R) >> _LOADER_TAG_SIZE) -#define _unchecked_x_reg_offset(R) ((R) - X_REG_DEF) -_ET_DECLARE_CHECKED(Uint,x_reg_offset,Uint) -#define x_reg_offset(R) _ET_APPLY(x_reg_offset,(R)) +#define loader_tag(T) ((T) & _LOADER_MASK) -#define _unchecked_y_reg_offset(R) ((R) - Y_REG_DEF) -_ET_DECLARE_CHECKED(Uint,y_reg_offset,Uint) -#define y_reg_offset(R) _ET_APPLY(y_reg_offset,(R)) +#define _is_loader_x_reg(x) (loader_tag(x) == _LOADER_TAG_XREG) +#define _is_loader_y_reg(x) (loader_tag(x) == _LOADER_TAG_YREG) -#define reg_index(R) ((R) / sizeof(Eterm)) +#define _unchecked_loader_x_reg_index(R) ((R) >> _LOADER_TAG_SIZE) +_ET_DECLARE_CHECKED(Uint,loader_x_reg_index,Uint) +#define loader_x_reg_index(R) _ET_APPLY(loader_x_reg_index,(R)) -#define _unchecked_x_reg_index(R) ((R) >> 2) -_ET_DECLARE_CHECKED(Uint,x_reg_index,Uint) -#define x_reg_index(R) _ET_APPLY(x_reg_index,(R)) - -#define _unchecked_y_reg_index(R) ((R) >> 2) -_ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) -#define y_reg_index(R) _ET_APPLY(y_reg_index,(R)) +#define _unchecked_loader_y_reg_index(R) ((R) >> _LOADER_TAG_SIZE) +_ET_DECLARE_CHECKED(Uint,loader_y_reg_index,Uint) +#define loader_y_reg_index(R) _ET_APPLY(loader_y_reg_index,(R)) /* * Backwards compatibility definitions: diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 1d32e72247..4fa6a087e2 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -237,12 +237,10 @@ try Y F => catch Y F try_case Y => try_end Y try_end y -try_case_end Literal=q => move Literal x | try_case_end x try_case_end s # Destructive set tuple element -set_tuple_element Lit=q Tuple Pos => move Lit x | set_tuple_element x Tuple Pos set_tuple_element s d P # Get tuple element @@ -273,8 +271,8 @@ is_number Fail Literal=q => move Literal x | is_number Fail x jump f -case_end Literal=cq => move Literal x | case_end x -badmatch Literal=cq => move Literal x | badmatch x +case_end Literal=c => move Literal x | case_end x +badmatch Literal=c => move Literal x | badmatch x case_end r case_end x @@ -849,7 +847,6 @@ is_boolean f y is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail -is_function2 Fail Fun Literal=q => move Literal x | is_function2 Fail Fun x is_function2 f s s %macro: is_function2 IsFunction2 -fail_action @@ -1122,11 +1119,8 @@ bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst) -bif1 Fail Bif Literal=q Dst => move Literal x | bif1 Fail Bif x Dst bif1 p Bif S1 Dst => bif1_body Bif S1 Dst -bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst - bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst @@ -1439,8 +1433,6 @@ i_bs_private_append j I d # Storing integers into binaries. # -bs_put_integer Fail=j Sz=s Unit=u Flags=u Literal=q => \ - move Literal x | bs_put_integer Fail Sz Unit Flags x bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ gen_put_integer(Fail, Sz, Unit, Flags, Src) @@ -1454,32 +1446,22 @@ i_new_bs_put_integer_imm j I I s # Utf8/utf16/utf32 support. (R12B-5) # -bs_utf8_size Fail Literal=q Dst=d => \ - move Literal x | bs_utf8_size Fail x Dst bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst i_bs_utf8_size s d -bs_utf16_size Fail Literal=q Dst=d => \ - move Literal x | bs_utf16_size Fail x Dst bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst i_bs_utf16_size s d -bs_put_utf8 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf8 Fail Flags x bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf16 Fail Flags x bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src i_bs_put_utf16 j I s -bs_put_utf32 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf32 Fail Flags x bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1490,9 +1472,6 @@ i_bs_validate_unicode j s # bs_put_float Fail Sz=q Unit Flags Val => badarg Fail -bs_put_float Fail=j Sz Unit=u Flags=u Literal=q => \ - move Literal x | bs_put_float Fail Sz Unit Flags x - bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_float(Fail, Sz, Unit, Flags, Src) @@ -1506,8 +1485,6 @@ i_new_bs_put_float_imm j I I s # Storing binaries into binaries. # -bs_put_binary Fail Sz Unit Flags Literal=q => \ - move Literal x | bs_put_binary Fail Sz Unit Flags x bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_binary(Fail, Sz, Unit, Flags, Src) @@ -1731,8 +1708,6 @@ gc_bif2 Fail I Bif S1 S2 Dst => \ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) -i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D - i_gc_bif1 j I s I d ii_gc_bif2/6 diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 6e1741af85..00b0df5b73 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -180,7 +180,8 @@ sub define_type_bit { define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}); define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} | - $type_bit{'a'} | $type_bit{'n'}); + $type_bit{'a'} | $type_bit{'n'} | + $type_bit{'q'}); define_type_bit('j', $type_bit{'f'} | $type_bit{'p'}); # Aliases (for matching purposes). -- cgit v1.2.3 From 135c9821e8806defa455a47208fb897fff1a3ff8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 23 Jun 2015 08:53:50 +0200 Subject: Make the 'r' operand type optional The 'r' type is now mandatory. That means in order to handle both of the following instructions: move x(0) y(7) move x(1) y(7) we would need to define two specific operations in ops.tab: move r y move x y We want to make 'r' operands optional. That is, if we have only this specific instruction: move x y it will match both of the following instructions: move x(0) y(7) move x(1) y(7) Make 'r' optional allows us to save code space when we don't want to make handling of x(0) a special case, but we can still use 'r' to optimize commonly used instructions. --- erts/emulator/beam/beam_debug.c | 6 - erts/emulator/beam/beam_emu.c | 355 ++++++------------------------ erts/emulator/beam/beam_load.c | 66 ++++-- erts/emulator/beam/erl_vm.h | 1 + erts/emulator/beam/ops.tab | 456 +++++++++++++-------------------------- erts/emulator/utils/beam_makeops | 16 +- 6 files changed, 282 insertions(+), 618 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 243ccb9afd..30e3765502 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -569,7 +569,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) unpacked = ap; ap = addr + size; switch (op) { - case op_i_select_val_lins_rfI: case op_i_select_val_lins_xfI: case op_i_select_val_lins_yfI: { @@ -589,7 +588,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_select_val_bins_rfI: case op_i_select_val_bins_xfI: case op_i_select_val_bins_yfI: { @@ -603,7 +601,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_select_tuple_arity_rfI: case op_i_select_tuple_arity_xfI: case op_i_select_tuple_arity_yfI: { @@ -628,7 +625,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_rfII: case op_i_jump_on_val_xfII: case op_i_jump_on_val_yfII: { @@ -640,7 +636,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_zero_rfI: case op_i_jump_on_val_zero_xfI: case op_i_jump_on_val_zero_yfI: { @@ -652,7 +647,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_put_tuple_rI: case op_i_put_tuple_xI: case op_i_put_tuple_yI: case op_new_map_dII: diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a74da2d872..e5179830de 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -556,12 +556,12 @@ void** beam_ops; #define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2) #define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) -#define MoveReturn(Src, Dest) \ - (Dest) = (Src); \ - I = c_p->cp; \ - ASSERT(VALID_INSTR(*c_p->cp)); \ - c_p->cp = 0; \ - CHECK_TERM(r(0)); \ +#define MoveReturn(Src) \ + x(0) = (Src); \ + I = c_p->cp; \ + ASSERT(VALID_INSTR(*c_p->cp)); \ + c_p->cp = 0; \ + CHECK_TERM(r(0)); \ Goto(*I) #define DeallocateReturn(Deallocate) \ @@ -573,26 +573,26 @@ void** beam_ops; Goto(*I); \ } while (0) -#define MoveDeallocateReturn(Src, Dest, Deallocate) \ - (Dest) = (Src); \ +#define MoveDeallocateReturn(Src, Deallocate) \ + x(0) = (Src); \ DeallocateReturn(Deallocate) -#define MoveCall(Src, Dest, CallDest, Size) \ - (Dest) = (Src); \ +#define MoveCall(Src, CallDest, Size) \ + x(0) = (Src); \ SET_CP(c_p, I+Size+1); \ - SET_I((BeamInstr *) CallDest); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); -#define MoveCallLast(Src, Dest, CallDest, Deallocate) \ - (Dest) = (Src); \ - RESTORE_CP(E); \ - E = ADD_BYTE_OFFSET(E, (Deallocate)); \ - SET_I((BeamInstr *) CallDest); \ +#define MoveCallLast(Src, CallDest, Deallocate) \ + x(0) = (Src); \ + RESTORE_CP(E); \ + E = ADD_BYTE_OFFSET(E, (Deallocate)); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); -#define MoveCallOnly(Src, Dest, CallDest) \ - (Dest) = (Src); \ - SET_I((BeamInstr *) CallDest); \ +#define MoveCallOnly(Src, CallDest) \ + x(0) = (Src); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); #define MoveJump(Src) \ @@ -676,8 +676,8 @@ void** beam_ops; if (is_not_list(Src)) { Fail; } \ A(Need, Alive) -#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \ - if (is_not_list(Src)) { Fail; } \ +#define IsNonemptyListTestHeap(Need, Alive, Fail) \ + if (is_not_list(x(0))) { Fail; } \ TestHeap(Need, Alive) #define IsTuple(X, Action) if (is_not_tuple(X)) Action @@ -1316,17 +1316,13 @@ void process_main(void) Uint live; Eterm result; - OpCase(i_increment_yIId): - increment_reg_val = yb(Arg(0)); - goto do_increment; - OpCase(i_increment_xIId): increment_reg_val = xb(Arg(0)); goto do_increment; - OpCase(i_increment_rIId): - increment_reg_val = r(0); - I--; + OpCase(i_increment_yIId): + increment_reg_val = yb(Arg(0)); + goto do_increment; do_increment: increment_val = Arg(1); @@ -1335,7 +1331,6 @@ void process_main(void) ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); if (MY_IS_SSMALL(i)) { result = make_small(i); - store_result: StoreBifResult(3, result); } } @@ -1348,7 +1343,7 @@ void process_main(void) SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_value(result)) { - goto store_result; + StoreBifResult(3, result); } ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); goto find_func_info; @@ -1464,47 +1459,37 @@ void process_main(void) { Eterm is_eq_exact_lit_val; - OpCase(i_is_eq_exact_literal_xfc): - is_eq_exact_lit_val = xb(Arg(0)); - I++; + OpCase(i_is_eq_exact_literal_fxc): + is_eq_exact_lit_val = xb(Arg(1)); goto do_is_eq_exact_literal; - OpCase(i_is_eq_exact_literal_yfc): - is_eq_exact_lit_val = yb(Arg(0)); - I++; + OpCase(i_is_eq_exact_literal_fyc): + is_eq_exact_lit_val = yb(Arg(1)); goto do_is_eq_exact_literal; - OpCase(i_is_eq_exact_literal_rfc): - is_eq_exact_lit_val = r(0); - do_is_eq_exact_literal: - if (!eq(Arg(1), is_eq_exact_lit_val)) { + if (!eq(Arg(2), is_eq_exact_lit_val)) { ClauseFail(); } - Next(2); + Next(3); } { Eterm is_ne_exact_lit_val; - OpCase(i_is_ne_exact_literal_xfc): - is_ne_exact_lit_val = xb(Arg(0)); - I++; + OpCase(i_is_ne_exact_literal_fxc): + is_ne_exact_lit_val = xb(Arg(1)); goto do_is_ne_exact_literal; - OpCase(i_is_ne_exact_literal_yfc): - is_ne_exact_lit_val = yb(Arg(0)); - I++; + OpCase(i_is_ne_exact_literal_fyc): + is_ne_exact_lit_val = yb(Arg(1)); goto do_is_ne_exact_literal; - OpCase(i_is_ne_exact_literal_rfc): - is_ne_exact_lit_val = r(0); - do_is_ne_exact_literal: - if (eq(Arg(1), is_ne_exact_lit_val)) { + if (eq(Arg(2), is_ne_exact_lit_val)) { ClauseFail(); } - Next(2); + Next(3); } OpCase(move_window3_xxxy): { @@ -1553,7 +1538,7 @@ void process_main(void) NextPF(6, next); } - OpCase(i_move_call_only_fcr): { + OpCase(i_move_call_only_fc): { r(0) = Arg(1); } /* FALL THROUGH */ @@ -1563,7 +1548,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_last_fPcr): { + OpCase(i_move_call_last_fPc): { r(0) = Arg(2); } /* FALL THROUGH */ @@ -1575,7 +1560,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_crf): { + OpCase(i_move_call_cf): { r(0) = Arg(0); I++; } @@ -1587,7 +1572,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_ext_last_ePcr): { + OpCase(i_move_call_ext_last_ePc): { r(0) = Arg(2); } /* FALL THROUGH */ @@ -1603,7 +1588,7 @@ void process_main(void) DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); - OpCase(i_move_call_ext_cre): { + OpCase(i_move_call_ext_ce): { r(0) = Arg(0); I++; } @@ -1613,7 +1598,7 @@ void process_main(void) DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); - OpCase(i_move_call_ext_only_ecr): { + OpCase(i_move_call_ext_only_ec): { r(0) = Arg(1); } /* FALL THROUGH */ @@ -1707,29 +1692,23 @@ void process_main(void) Eterm element_index; Eterm element_tuple; - OpCase(i_element_xjsd): - element_tuple = xb(Arg(0)); - I++; + OpCase(i_element_jxsd): + element_tuple = xb(Arg(1)); goto do_element; - OpCase(i_element_yjsd): - element_tuple = yb(Arg(0)); - I++; + OpCase(i_element_jysd): + element_tuple = yb(Arg(1)); goto do_element; - OpCase(i_element_rjsd): - element_tuple = r(0); - /* Fall through */ - do_element: - GetArg1(1, element_index); + GetArg1(2, element_index); if (is_small(element_index) && is_tuple(element_tuple)) { Eterm* tp = tuple_val(element_tuple); if ((signed_val(element_index) >= 1) && (signed_val(element_index) <= arityval(*tp))) { Eterm result = tp[signed_val(element_index)]; - StoreBifResult(2, result); + StoreBifResult(3, result); } } } @@ -1743,29 +1722,24 @@ void process_main(void) { Eterm fast_element_tuple; - OpCase(i_fast_element_rjId): - fast_element_tuple = r(0); + OpCase(i_fast_element_jxId): + fast_element_tuple = xb(Arg(1)); + goto do_fast_element; + + OpCase(i_fast_element_jyId): + fast_element_tuple = yb(Arg(1)); + goto do_fast_element; do_fast_element: if (is_tuple(fast_element_tuple)) { Eterm* tp = tuple_val(fast_element_tuple); - Eterm pos = Arg(1); /* Untagged integer >= 1 */ + Eterm pos = Arg(2); /* Untagged integer >= 1 */ if (pos <= arityval(*tp)) { Eterm result = tp[pos]; - StoreBifResult(2, result); + StoreBifResult(3, result); } } goto badarg; - - OpCase(i_fast_element_xjId): - fast_element_tuple = xb(Arg(0)); - I++; - goto do_fast_element; - - OpCase(i_fast_element_yjId): - fast_element_tuple = yb(Arg(0)); - I++; - goto do_fast_element; } OpCase(catch_yf): @@ -1871,7 +1845,7 @@ void process_main(void) * Pick up the next message and place it in x(0). * If no message, jump to a wait or wait_timeout instruction. */ - OpCase(i_loop_rec_fr): + OpCase(i_loop_rec_f): { BeamInstr *next; ErlMessage* msgp; @@ -2183,10 +2157,6 @@ void process_main(void) select_val2 = xb(Arg(0)); goto do_select_tuple_arity2; - OpCase(i_select_tuple_arity2_rfAAff): - select_val2 = r(0); - I--; - do_select_tuple_arity2: if (is_not_tuple(select_val2)) { goto select_val2_fail; @@ -2202,10 +2172,6 @@ void process_main(void) select_val2 = xb(Arg(0)); goto do_select_val2; - OpCase(i_select_val2_rfccff): - select_val2 = r(0); - I--; - do_select_val2: if (select_val2 == Arg(2)) { I += 3; @@ -2229,10 +2195,6 @@ void process_main(void) select_val = yb(Arg(0)); goto do_select_tuple_arity; - OpCase(i_select_tuple_arity_rfI): - select_val = r(0); - I--; - do_select_tuple_arity: if (is_tuple(select_val)) { select_val = *tuple_val(select_val); @@ -2249,10 +2211,6 @@ void process_main(void) select_val = yb(Arg(0)); goto do_linear_search; - OpCase(i_select_val_lins_rfI): - select_val = r(0); - I--; - do_linear_search: { BeamInstr *vs = &Arg(3); int ix = 0; @@ -2279,10 +2237,6 @@ void process_main(void) select_val = yb(Arg(0)); goto do_binary_search; - OpCase(i_select_val_bins_rfI): - select_val = r(0); - I--; - do_binary_search: { struct Pairs { @@ -2343,10 +2297,6 @@ void process_main(void) jump_on_val_zero_index = xb(Arg(0)); goto do_jump_on_val_zero_index; - OpCase(i_jump_on_val_zero_rfI): - jump_on_val_zero_index = r(0); - I--; - do_jump_on_val_zero_index: if (is_small(jump_on_val_zero_index)) { jump_on_val_zero_index = signed_val(jump_on_val_zero_index); @@ -2371,10 +2321,6 @@ void process_main(void) jump_on_val_index = xb(Arg(0)); goto do_jump_on_val_index; - OpCase(i_jump_on_val_rfII): - jump_on_val_index = r(0); - I--; - do_jump_on_val_index: if (is_small(jump_on_val_index)) { jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3)); @@ -3441,18 +3387,8 @@ do { \ { Eterm badmatch_val; - OpCase(badmatch_y): - badmatch_val = yb(Arg(0)); - goto do_badmatch; - OpCase(badmatch_x): badmatch_val = xb(Arg(0)); - goto do_badmatch; - - OpCase(badmatch_r): - badmatch_val = r(0); - - do_badmatch: c_p->fvalue = badmatch_val; c_p->freason = BADMATCH; } @@ -3627,16 +3563,6 @@ do { \ OpCase(case_end_x): case_end_val = xb(Arg(0)); - goto do_case_end; - - OpCase(case_end_y): - case_end_val = yb(Arg(0)); - goto do_case_end; - - OpCase(case_end_r): - case_end_val = r(0); - - do_case_end: c_p->fvalue = case_end_val; c_p->freason = EXC_CASE_CLAUSE; goto find_func_info; @@ -3692,11 +3618,6 @@ do { \ goto do_bs_init_bits; } - OpCase(i_bs_init_bits_fail_rjId): { - num_bits_term = r(0); - alloc = 0; - goto do_bs_init_bits; - } OpCase(i_bs_init_bits_fail_yjId): { num_bits_term = yb(Arg(0)); I++; @@ -3823,12 +3744,6 @@ do { \ goto do_bs_init; } - OpCase(i_bs_init_fail_rjId): { - tmp_arg1 = r(0); - tmp_arg2 = 0; - goto do_bs_init; - } - OpCase(i_bs_init_fail_yjId): { tmp_arg1 = yb(Arg(0)); tmp_arg2 = 0; @@ -4202,9 +4117,6 @@ do { \ Uint slots; Eterm context; - OpCase(i_bs_start_match2_rfIId): { - context = r(0); - do_start_match: slots = Arg(2); if (!is_boxed(context)) { @@ -4251,7 +4163,7 @@ do { \ ClauseFail(); } NextPF(4, next); - } + OpCase(i_bs_start_match2_xfIId): { context = xb(Arg(0)); I++; @@ -4264,18 +4176,6 @@ do { \ } } - OpCase(bs_test_zero_tail2_fr): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - - PreFetch(1, next); - _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0)); - if (_mb->size != _mb->offset) { - ClauseFail(); - } - NextPF(1, next); - } - OpCase(bs_test_zero_tail2_fx): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4288,16 +4188,6 @@ do { \ NextPF(2, next); } - OpCase(bs_test_tail_imm2_frI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(r(0)); - if (_mb->size - _mb->offset != Arg(1)) { - ClauseFail(); - } - NextPF(2, next); - } OpCase(bs_test_tail_imm2_fxI): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4309,16 +4199,6 @@ do { \ NextPF(3, next); } - OpCase(bs_test_unit_frI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(r(0)); - if ((_mb->size - _mb->offset) % Arg(1)) { - ClauseFail(); - } - NextPF(2, next); - } OpCase(bs_test_unit_fxI): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4330,16 +4210,6 @@ do { \ NextPF(3, next); } - OpCase(bs_test_unit8_fr): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(1, next); - _mb = ms_matchbuffer(r(0)); - if ((_mb->size - _mb->offset) & 7) { - ClauseFail(); - } - NextPF(1, next); - } OpCase(bs_test_unit8_fx): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4354,19 +4224,11 @@ do { \ { Eterm bs_get_integer8_context; - OpCase(i_bs_get_integer_8_rfd): { - bs_get_integer8_context = r(0); - goto do_bs_get_integer_8; - } - OpCase(i_bs_get_integer_8_xfd): { - bs_get_integer8_context = xb(Arg(0)); - I++; - } - - do_bs_get_integer_8: { ErlBinMatchBuffer *_mb; Eterm _result; + bs_get_integer8_context = xb(Arg(0)); + I++; _mb = ms_matchbuffer(bs_get_integer8_context); if (_mb->size - _mb->offset < 8) { ClauseFail(); @@ -4384,15 +4246,10 @@ do { \ { Eterm bs_get_integer_16_context; - OpCase(i_bs_get_integer_16_rfd): - bs_get_integer_16_context = r(0); - goto do_bs_get_integer_16; - OpCase(i_bs_get_integer_16_xfd): bs_get_integer_16_context = xb(Arg(0)); I++; - do_bs_get_integer_16: { ErlBinMatchBuffer *_mb; Eterm _result; @@ -4413,17 +4270,10 @@ do { \ { Eterm bs_get_integer_32_context; - OpCase(i_bs_get_integer_32_rfId): - bs_get_integer_32_context = r(0); - goto do_bs_get_integer_32; - - OpCase(i_bs_get_integer_32_xfId): bs_get_integer_32_context = xb(Arg(0)); I++; - - do_bs_get_integer_32: { ErlBinMatchBuffer *_mb; Uint32 _integer; @@ -4452,13 +4302,6 @@ do { \ } } - /* Operands: Size Live Fail Flags Dst */ - OpCase(i_bs_get_integer_imm_rIIfId): { - tmp_arg1 = r(0); - /* Operands: Size Live Fail Flags Dst */ - goto do_bs_get_integer_imm_test_heap; - } - /* Operands: x(Reg) Size Live Fail Flags Dst */ OpCase(i_bs_get_integer_imm_xIIfId): { tmp_arg1 = xb(Arg(0)); @@ -4481,15 +4324,6 @@ do { \ goto do_bs_get_integer_imm; } - /* Operands: Size Fail Flags Dst */ - OpCase(i_bs_get_integer_small_imm_rIfId): { - tmp_arg1 = r(0); - tmp_arg2 = Arg(0); - I++; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - /* Operands: x(Reg) Size Fail Flags Dst */ OpCase(i_bs_get_integer_small_imm_xIfId): { tmp_arg1 = xb(Arg(0)); @@ -4563,11 +4397,6 @@ do { \ Eterm get_utf8_context; /* Operands: MatchContext Fail Dst */ - OpCase(i_bs_get_utf8_rfd): { - get_utf8_context = r(0); - goto do_bs_get_utf8; - } - OpCase(i_bs_get_utf8_xfd): { get_utf8_context = xb(Arg(0)); I++; @@ -4578,7 +4407,7 @@ do { \ * Operands: Fail Dst */ - do_bs_get_utf8: { + { Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context)); if (is_non_value(result)) { ClauseFail(); @@ -4591,12 +4420,7 @@ do { \ Eterm get_utf16_context; /* Operands: MatchContext Fail Flags Dst */ - OpCase(i_bs_get_utf16_rfId): { - get_utf16_context = r(0); - goto do_bs_get_utf16; - } - - OpCase(i_bs_get_utf16_xfId): { + OpCase(i_bs_get_utf16_xfId): { get_utf16_context = xb(Arg(0)); I++; } @@ -4605,7 +4429,7 @@ do { \ * get_utf16_context = match_context * Operands: Fail Flags Dst */ - do_bs_get_utf16: { + { Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context), Arg(1)); if (is_non_value(result)) { @@ -4624,26 +4448,10 @@ do { \ Uint orig; Uint hole_size; - OpCase(bs_context_to_binary_r): { - context_to_binary_context = r(0); - I -= 2; - goto do_context_to_binary; - } - - /* Unfortunately, inlining can generate this instruction. */ - OpCase(bs_context_to_binary_y): { - context_to_binary_context = yb(Arg(0)); - goto do_context_to_binary0; - } - - OpCase(bs_context_to_binary_x): { + OpCase(bs_context_to_binary_x): context_to_binary_context = xb(Arg(0)); - - do_context_to_binary0: I--; - } - do_context_to_binary: if (is_boxed(context_to_binary_context) && header_is_bin_matchstate(*boxed_val(context_to_binary_context))) { ErlBinMatchState* ms; @@ -4655,17 +4463,11 @@ do { \ } Next(2); - OpCase(i_bs_get_binary_all_reuse_rfI): { - context_to_binary_context = r(0); - goto do_bs_get_binary_all_reuse; - } - OpCase(i_bs_get_binary_all_reuse_xfI): { context_to_binary_context = xb(Arg(0)); I++; } - do_bs_get_binary_all_reuse: mb = ms_matchbuffer(context_to_binary_context); size = mb->size - mb->offset; if (size % Arg(1) != 0) { @@ -4693,16 +4495,11 @@ do { \ { Eterm match_string_context; - OpCase(i_bs_match_string_rfII): { - match_string_context = r(0); - goto do_bs_match_string; - } OpCase(i_bs_match_string_xfII): { match_string_context = xb(Arg(0)); I++; } - do_bs_match_string: { BeamInstr *next; byte* bytes; @@ -4730,14 +4527,6 @@ do { \ } } - OpCase(i_bs_save2_rI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(1, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); - _ms->save_offset[Arg(0)] = _ms->mb.offset; - NextPF(1, next); - } OpCase(i_bs_save2_xI): { BeamInstr *next; ErlBinMatchState *_ms; @@ -4747,14 +4536,6 @@ do { \ NextPF(2, next); } - OpCase(i_bs_restore2_rI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(1, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); - _ms->mb.offset = _ms->save_offset[Arg(0)]; - NextPF(1, next); - } OpCase(i_bs_restore2_xI): { BeamInstr *next; ErlBinMatchState *_ms; @@ -5030,7 +4811,9 @@ do { \ switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); - MoveReturn(reg[0], r(0)); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; /*fall through*/ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 3cd80c4ec2..3671baa552 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1847,9 +1847,7 @@ load_code(LoaderState* stp) case TAG_o: break; case TAG_x: - if (last_op->a[arg].val == 0) { - last_op->a[arg].type = TAG_r; - } else if (last_op->a[arg].val >= MAX_REG) { + if (last_op->a[arg].val >= MAX_REG) { LoadError1(stp, "invalid x register number: %u", last_op->a[arg].val); } @@ -2055,7 +2053,42 @@ load_code(LoaderState* stp) if (((opc[specific].mask[0] & mask[0]) == mask[0]) && ((opc[specific].mask[1] & mask[1]) == mask[1]) && ((opc[specific].mask[2] & mask[2]) == mask[2])) { - break; + + if (!opc[specific].involves_r) { + break; /* No complications - match */ + } + + /* + * The specific operation uses the 'r' operand, + * which is shorthand for x(0). Now things + * get complicated. First we must check whether + * all operands that should be of type 'r' use + * x(0) (as opposed to some other X register). + */ + for (arg = 0; arg < arity; arg++) { + if (opc[specific].involves_r & (1 << arg) && + tmp_op->a[arg].type == TAG_x) { + if (tmp_op->a[arg].val != 0) { + break; /* Other X register than 0 */ + } + } + } + + if (arg == arity) { + /* + * All 'r' operands use x(0) in the generic + * operation. That means a match. Now we + * will need to rewrite the generic instruction + * to actually use 'r' instead of 'x(0)'. + */ + for (arg = 0; arg < arity; arg++) { + if (opc[specific].involves_r & (1 << arg) && + tmp_op->a[arg].type == TAG_x) { + tmp_op->a[arg].type = TAG_r; + } + } + break; /* Match */ + } } specific++; } @@ -2166,9 +2199,6 @@ load_code(LoaderState* stp) break; case 's': /* Any source (tagged constant or register) */ switch (tag) { - case TAG_r: - code[ci++] = make_loader_x_reg(0); - break; case TAG_x: code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; @@ -2196,9 +2226,6 @@ load_code(LoaderState* stp) break; case 'd': /* Destination (x(0), x(N), y(N) */ switch (tag) { - case TAG_r: - code[ci++] = make_loader_x_reg(0); - break; case TAG_x: code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; @@ -2360,7 +2387,6 @@ load_code(LoaderState* stp) stp->labels[tmp_op->a[arg].val].patches = ci; ci++; break; - case TAG_r: case TAG_x: CodeNeed(1); code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); @@ -2455,7 +2481,6 @@ load_code(LoaderState* stp) stp->on_load = ci; break; case op_bs_put_string_II: - case op_i_bs_match_string_rfII: case op_i_bs_match_string_xfII: new_string_patch(stp, ci-1); break; @@ -2693,17 +2718,17 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, op->next = NULL; if (Index.type == TAG_i && Index.val > 0 && - (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) { + (Tuple.type == TAG_x || Tuple.type == TAG_y)) { op->op = genop_i_fast_element_4; - op->a[0] = Tuple; - op->a[1] = Fail; + op->a[0] = Fail; + op->a[1] = Tuple; op->a[2].type = TAG_u; op->a[2].val = Index.val; op->a[3] = Dst; } else { op->op = genop_i_element_4; - op->a[0] = Tuple; - op->a[1] = Fail; + op->a[0] = Fail; + op->a[1] = Tuple; op->a[2] = Index; op->a[3] = Dst; } @@ -4798,7 +4823,8 @@ transform_engine(LoaderState* st) if (var[i].type != instr->a[ap].type) goto restart; switch (var[i].type) { - case TAG_r: case TAG_n: break; + case TAG_n: + break; default: if (var[i].val != instr->a[ap].val) goto restart; @@ -5865,7 +5891,7 @@ make_stub(BeamInstr* fp, Eterm mod, Eterm func, Uint arity, Uint native, BeamIns fp[4] = arity; #ifdef HIPE if (native) { - fp[5] = BeamOpCode(op_move_return_nr); + fp[5] = BeamOpCode(op_move_return_n); hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5); } #endif @@ -6301,7 +6327,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) #ifdef HIPE op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */ #else - op = (Eterm) BeamOpCode(op_move_return_nr); + op = (Eterm) BeamOpCode(op_move_return_n); #endif fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op); } diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index cfc978b5a5..98f27a1725 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -141,6 +141,7 @@ typedef struct op_entry { char* name; /* Name of instruction. */ Uint32 mask[3]; /* Signature mask. */ + unsigned involves_r; /* Needs special attention when matching. */ int sz; /* Number of loaded words. */ char* pack; /* Instructions for packing engine. */ char* sign; /* Signature string. */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 4fa6a087e2..335f8e2db5 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -39,8 +39,8 @@ too_old_compiler | never() => # necessary.) Since the instructions don't work correctly in R12B, simply # refuse to load the module. -func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler -func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler +func_info M=a a==am_module_info A=u==0 | label L | move n x==0 => too_old_compiler +func_info M=a a==am_module_info A=u==1 | label L | move n x==0 => too_old_compiler # The undocumented and unsupported guard BIF is_constant/1 was removed # in R13. The is_constant/2 operation is marked as obsolete in genop.tab, @@ -77,14 +77,14 @@ return # there is no line/1 instruction between the move and the call. # -move S r | line Loc | call_ext Ar Func => \ - line Loc | move S r | call_ext Ar Func -move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \ - line Loc | move S r | call_ext_last Ar Func D -move S r | line Loc | call_ext_only Ar Func=u$is_bif => \ - line Loc | move S r | call_ext_only Ar Func -move S r | line Loc | call Ar Func => \ - line Loc | move S r | call Ar Func +move S X0=x==0 | line Loc | call_ext Ar Func => \ + line Loc | move S X0 | call_ext Ar Func +move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_bif D => \ + line Loc | move S X0 | call_ext_last Ar Func D +move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_bif => \ + line Loc | move S X0 | call_ext_only Ar Func +move S X0=x==0 | line Loc | call Ar Func => \ + line Loc | move S X0 | call Ar Func # # A tail-recursive call to an external function (non-BIF) will @@ -167,31 +167,24 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -i_select_val_bins r f I i_select_val_bins x f I i_select_val_bins y f I -i_select_val_lins r f I i_select_val_lins x f I i_select_val_lins y f I -i_select_val2 r f c c f f i_select_val2 x f c c f f i_select_val2 y f c c f f -i_select_tuple_arity r f I i_select_tuple_arity x f I i_select_tuple_arity y f I -i_select_tuple_arity2 r f A A f f i_select_tuple_arity2 x f A A f f i_select_tuple_arity2 y f A A f f -i_jump_on_val_zero r f I i_jump_on_val_zero x f I i_jump_on_val_zero y f I -i_jump_on_val r f I I i_jump_on_val x f I I i_jump_on_val y f I I @@ -203,30 +196,13 @@ is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ %macro: get_list GetList -pack get_list x x x get_list x x y -get_list x x r get_list x y x get_list x y y -get_list x y r -get_list x r x -get_list x r y get_list y x x get_list y x y -get_list y x r get_list y y x get_list y y y -get_list y y r -get_list y r x -get_list y r y - -get_list r x x -get_list r x y -get_list r x r -get_list r y x -get_list r y y -get_list r y r -get_list r r x -get_list r r y # Old-style catch. catch y f @@ -247,21 +223,15 @@ set_tuple_element s d P %macro: i_get_tuple_element GetTupleElement -pack i_get_tuple_element x P x -i_get_tuple_element r P x i_get_tuple_element y P x -i_get_tuple_element x P r -i_get_tuple_element y P r %cold -i_get_tuple_element r P r i_get_tuple_element x P y -i_get_tuple_element r P y i_get_tuple_element y P y %hot %macro: is_number IsNumber -fail_action %cold -is_number f r is_number f x is_number f y %hot @@ -271,16 +241,12 @@ is_number Fail Literal=q => move Literal x | is_number Fail x jump f -case_end Literal=c => move Literal x | case_end x -badmatch Literal=c => move Literal x | badmatch x +case_end NotInX=cy => move NotInX x | case_end x +badmatch NotInX=cy => move NotInX x | badmatch x -case_end r case_end x -case_end y -badmatch r badmatch x -badmatch y if_end raise s s @@ -289,7 +255,7 @@ raise s s badarg j system_limit j -move C=cxy r | jump Lbl => move_jump Lbl C +move C=cxy x==0 | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext move_jump f n @@ -307,8 +273,6 @@ move_window/6 # x -> y -move S1=r S2=y | move X1=x Y1=y => move2 S1 S2 X1 Y1 - move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y | succ(Y1,Y2) | succ(Y2,Y3) => \ move_window X1 X2 X3 Y1 Y3 @@ -329,12 +293,13 @@ move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2 move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4 -move S1=x S2=r | move S3=x S4=x => move2 S1 S2 S3 S4 -move S1=x S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1 -move S1=y S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1 +move X1=x X2=x | move X3=x Y1=y => move2 X1 X2 X3 Y1 + +move S1=x S2=x | move X1=x Y1=y => move2 S1 S2 X1 Y1 +move S1=y S2=x | move X1=x Y1=y => move2 S1 S2 X1 Y1 -move Y1=y X1=x | move S1=r D1=x => move2 Y1 X1 S1 D1 -move S1=r D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1 +move Y1=y X1=x | move S1=x D1=x => move2 Y1 X1 S1 D1 +move S1=x D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1 move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3 move2 Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3 @@ -351,14 +316,13 @@ move2 x y x y move2 y x y x move2 x x x x -move2 x r x x +move2 x x x y -move2 x r x y -move2 r y x y -move2 y r x y +move2 x y x y +move2 y x x y -move2 r x y x -move2 y x r x +move2 x x y x +move2 y x x x %macro: move3 Move3 move3 x y x y x y @@ -373,20 +337,14 @@ move S=c D=y => move S x | move x D %macro:move Move -pack -gen_dest move x x move x y -move x r move y x -move y r -move r x -move r y -move c r move c x move n x -move n r move y y # Receive operations. -loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src +loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src wait_timeout Fail Src => i_wait_timeout Fail Src @@ -401,7 +359,7 @@ label L | timeout | smp_already_locked(L) => label L | timeout_locked remove_message timeout timeout_locked -i_loop_rec f r +i_loop_rec f loop_rec_end f wait f wait_locked f @@ -419,29 +377,25 @@ send # Optimized comparisons with one immediate/literal operand. # -is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C -is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C +is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C +is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C -is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C -is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C +is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C +is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C %macro: i_is_eq_exact_immed EqualImmed -fail_action -i_is_eq_exact_immed f r c i_is_eq_exact_immed f x c i_is_eq_exact_immed f y c -i_is_eq_exact_literal r f c -i_is_eq_exact_literal x f c -i_is_eq_exact_literal y f c +i_is_eq_exact_literal f x c +i_is_eq_exact_literal f y c %macro: i_is_ne_exact_immed NotEqualImmed -fail_action -i_is_ne_exact_immed f r c i_is_ne_exact_immed f x c i_is_ne_exact_immed f y c -i_is_ne_exact_literal r f c -i_is_ne_exact_literal x f c -i_is_ne_exact_literal y f c +i_is_ne_exact_literal f x c +i_is_ne_exact_literal f y c # # Common Compare Specializations @@ -449,31 +403,21 @@ i_is_ne_exact_literal y f c # to keep the instruction set small-ish # -is_eq_exact Lbl S1=xy S2=r => is_eq_exact Lbl S2 S1 -is_eq_exact Lbl S1=rx S2=xy => i_is_eq_exact_spec Lbl S1 S2 +is_eq_exact Lbl S1=y S2=x => is_eq_exact Lbl S2 S1 +is_eq_exact Lbl S1=x S2=xy => i_is_eq_exact_spec Lbl S1 S2 %macro: i_is_eq_exact_spec EqualExact -fail_action i_is_eq_exact_spec f x x i_is_eq_exact_spec f x y -i_is_eq_exact_spec f r x -i_is_eq_exact_spec f r y -%cold -i_is_eq_exact_spec f r r -%hot -is_lt Lbl S1=rxc S2=rxc => i_is_lt_spec Lbl S1 S2 +is_lt Lbl S1=xc S2=xc => i_is_lt_spec Lbl S1 S2 %macro: i_is_lt_spec IsLessThan -fail_action i_is_lt_spec f x x -i_is_lt_spec f x r i_is_lt_spec f x c -i_is_lt_spec f r x -i_is_lt_spec f r c i_is_lt_spec f c x -i_is_lt_spec f c r %cold -i_is_lt_spec f r r i_is_lt_spec f c c %hot @@ -523,7 +467,6 @@ i_put_tuple Dst Arity Puts=* | put S => \ i_put_tuple/2 %macro:i_put_tuple PutTuple -pack -goto:do_put_tuple -i_put_tuple r I i_put_tuple x I i_put_tuple y I @@ -540,48 +483,25 @@ put_list x n x put_list y n x put_list x x x put_list y x x -put_list x x r -put_list y r r put_list y y x put_list x y x -put_list r x x -put_list r y x -put_list r x r -put_list y y r -put_list y r x -put_list r n x - -put_list x r x -put_list x y r -put_list y x r -put_list y x x -put_list x r r +put_list y x x # put_list SrcReg Constant Dst -put_list r c r -put_list r c x -put_list r c y -put_list x c r put_list x c x put_list x c y -put_list y c r put_list y c x put_list y c y # put_list Constant SrcReg Dst -put_list c r r -put_list c r x -put_list c r y -put_list c x r put_list c x x put_list c x y -put_list c y r put_list c y x put_list c y y @@ -590,18 +510,12 @@ put_list s s d %hot %macro: i_fetch FetchArgs -pack -i_fetch c r i_fetch c x i_fetch c y -i_fetch r c -i_fetch r x -i_fetch r y i_fetch x c -i_fetch x r i_fetch x x i_fetch x y i_fetch y c -i_fetch y r i_fetch y x i_fetch y y @@ -629,27 +543,27 @@ return_trace # Note: There is no 'move_return y r', since there never are any y registers # when we do move_return (if we have y registers, we must do move_deallocate_return). -move S r | return => move_return S r +move S x==0 | return => move_return S %macro: move_return MoveReturn -nonext -move_return x r -move_return c r -move_return n r +move_return x +move_return c +move_return n -move S r | deallocate D | return => move_deallocate_return S r D +move S x==0 | deallocate D | return => move_deallocate_return S D %macro: move_deallocate_return MoveDeallocateReturn -pack -nonext -move_deallocate_return x r Q -move_deallocate_return y r Q -move_deallocate_return c r Q -move_deallocate_return n r Q +move_deallocate_return x Q +move_deallocate_return y Q +move_deallocate_return c Q +move_deallocate_return n Q deallocate D | return => deallocate_return D %macro: deallocate_return DeallocateReturn -nonext deallocate_return Q -test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y +test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y %macro: test_heap_1_put_list TestHeapPutList -pack test_heap_1_put_list I y @@ -658,18 +572,16 @@ test_heap_1_put_list I y is_tuple Fail Literal=q => move Literal x | is_tuple Fail x is_tuple Fail=f c => jump Fail -is_tuple Fail=f S=rxy | test_arity Fail=f S=rxy Arity => is_tuple_of_arity Fail S Arity +is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity %macro:is_tuple_of_arity IsTupleOfArity -fail_action is_tuple_of_arity f x A is_tuple_of_arity f y A -is_tuple_of_arity f r A %macro: is_tuple IsTuple -fail_action is_tuple f x is_tuple f y -is_tuple f r test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity test_arity Fail=f c Arity => jump Fail @@ -677,7 +589,6 @@ test_arity Fail=f c Arity => jump Fail %macro: test_arity IsArity -fail_action test_arity f x A test_arity f y A -test_arity f r A is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P @@ -726,46 +637,40 @@ is_integer Fail=f i => is_integer Fail=f an => jump Fail is_integer Fail Literal=q => move Literal x | is_integer Fail x -is_integer Fail=f S=rx | allocate Need Regs => is_integer_allocate Fail S Need Regs +is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs %macro: is_integer_allocate IsIntegerAllocate -fail_action is_integer_allocate f x I I -is_integer_allocate f r I I %macro: is_integer IsInteger -fail_action is_integer f x is_integer f y -is_integer f r is_list Fail=f n => is_list Fail Literal=q => move Literal x | is_list Fail x is_list Fail=f c => jump Fail %macro: is_list IsList -fail_action -is_list f r is_list f x %cold is_list f y %hot -is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs +is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs %macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack is_nonempty_list_allocate f x I t -is_nonempty_list_allocate f r I t -is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2 +is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2 %macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack -is_non_empty_list_test_heap f r I t +is_non_empty_list_test_heap f I t %macro: is_nonempty_list IsNonemptyList -fail_action is_nonempty_list f x is_nonempty_list f y -is_nonempty_list f r %macro: is_atom IsAtom -fail_action is_atom f x -is_atom f r %cold is_atom f y %hot @@ -773,7 +678,6 @@ is_atom Fail=f a => is_atom Fail=f niq => jump Fail %macro: is_float IsFloat -fail_action -is_float f r is_float f x %cold is_float f y @@ -787,12 +691,10 @@ is_nil Fail=f qia => jump Fail %macro: is_nil IsNil -fail_action is_nil f x is_nil f y -is_nil f r is_binary Fail Literal=q => move Literal x | is_binary Fail x is_binary Fail=f c => jump Fail %macro: is_binary IsBinary -fail_action -is_binary f r is_binary f x %cold is_binary f y @@ -804,7 +706,6 @@ is_bitstr Fail Term => is_bitstring Fail Term is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x is_bitstring Fail=f c => jump Fail %macro: is_bitstring IsBitstring -fail_action -is_bitstring f r is_bitstring f x %cold is_bitstring f y @@ -812,7 +713,6 @@ is_bitstring f y is_reference Fail=f cq => jump Fail %macro: is_reference IsRef -fail_action -is_reference f r is_reference f x %cold is_reference f y @@ -820,7 +720,6 @@ is_reference f y is_pid Fail=f cq => jump Fail %macro: is_pid IsPid -fail_action -is_pid f r is_pid f x %cold is_pid f y @@ -828,7 +727,6 @@ is_pid f y is_port Fail=f cq => jump Fail %macro: is_port IsPort -fail_action -is_port f r is_port f x %cold is_port f y @@ -840,7 +738,6 @@ is_boolean Fail=f ac => jump Fail %cold %macro: is_boolean IsBoolean -fail_action -is_boolean f r is_boolean f x is_boolean f y %hot @@ -986,76 +883,76 @@ call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate %unless USE_VM_PROBES call_ext Arity u$func:erlang:dt_get_tag/0 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_get_tag/0 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_get_tag/0 => \ - move a=am_undefined r | return - -move Any r | call_ext Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r -move Any r | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ - move a=am_undefined r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r | return + move a=am_undefined x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_put_tag/1 => \ + move a=am_undefined x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ + move a=am_undefined x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ + move a=am_undefined x=0 | return call_ext Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r | return + move a=am_undefined x=0 | return call_ext Arity u$func:erlang:dt_get_tag_data/0 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_get_tag_data/0 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_get_tag_data/0 => \ - move a=am_undefined r | return - -move Any r | call_ext Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r -move Any r | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ - move a=am_true r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r | return + move a=am_undefined x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_spread_tag/1 => \ + move a=am_true x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ + move a=am_true x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ + move a=am_true x=0 | return call_ext Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r + move a=am_true x=0 call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ - move a=am_true r | deallocate D | return + move a=am_true x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r | return - -move Any r | call_ext Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r -move Any r | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ - move a=am_true r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r | return + move a=am_true x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_restore_tag/1 => \ + move a=am_true x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ + move a=am_true x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ + move a=am_true x=0 | return call_ext Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r + move a=am_true x=0 call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ - move a=am_true r | deallocate D | return + move a=am_true x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r | return - -move Any r | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ - move Any r -move Any r | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ - move Any r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ - move Any r | return + move a=am_true x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ + move Any x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ + move Any x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ + move Any x=0 | return call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ deallocate D | return call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ return -move Any r | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \ - move Any r -move Any r | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ - move Any r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ - move Any r | return +move Any x==0 | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \ + move Any x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ + move Any x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ + move Any x=0 | return call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ deallocate D | return @@ -1063,7 +960,7 @@ call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ return # Can happen after one of the transformations above. -move Discarded r | move Something r => move Something r +move Discarded x==0 | move Something x==0 => move Something x=0 %endif @@ -1088,9 +985,9 @@ call_ext_only Ar=u Bif=u$is_bif => \ # with call instructions. # -move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func -move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r -move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r +move S=c x==0 | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S Func +move S=c x==0 | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S +move S=c x==0 | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S call_ext Ar Func => i_call_ext Func call_ext_last Ar Func D => i_call_ext_last Func D @@ -1117,7 +1014,7 @@ bif0 u$bif:erlang:node/0 Dst=d => node Dst bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst -bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst) +bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst) bif1 p Bif S1 Dst => bif1_body Bif S1 Dst @@ -1127,24 +1024,20 @@ bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst i_get s d %macro: self Self -self r self x self y %macro: node Node -node r node x %cold node y %hot -i_fast_element r j I d -i_fast_element x j I d -i_fast_element y j I d +i_fast_element j x I d +i_fast_element j y I d -i_element r j s d -i_element x j s d -i_element y j s d +i_element j x s d +i_element j y s d bif1 f b s d bif1_body b s d @@ -1155,37 +1048,37 @@ i_bif2_body b d # Internal calls. # -move S=c r | call Ar P=f => i_move_call S r P -move S=s r | call Ar P=f => move_call S r P +move S=c x==0 | call Ar P=f => i_move_call S P +move S=s x==0 | call Ar P=f => move_call S P -i_move_call c r f +i_move_call c f %macro:move_call MoveCall -arg_f -size -nonext -move_call/3 +move_call/2 -move_call x r f -move_call y r f +move_call x f +move_call y f -move S=c r | call_last Ar P=f D => i_move_call_last P D S r -move S r | call_last Ar P=f D => move_call_last S r P D +move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S +move S x==0 | call_last Ar P=f D => move_call_last S P D -i_move_call_last f P c r +i_move_call_last f P c %macro:move_call_last MoveCallLast -arg_f -nonext -pack -move_call_last/4 -move_call_last x r f Q -move_call_last y r f Q +move_call_last/3 +move_call_last x f Q +move_call_last y f Q -move S=c r | call_only Ar P=f => i_move_call_only P S r -move S=x r | call_only Ar P=f => move_call_only S r P +move S=c x==0 | call_only Ar P=f => i_move_call_only P S +move S=x x==0 | call_only Ar P=f => move_call_only S P -i_move_call_only f c r +i_move_call_only f c %macro:move_call_only MoveCallOnly -arg_f -nonext -move_call_only/3 +move_call_only/2 -move_call_only x r f +move_call_only x f call Ar Func => i_call Func call_last Ar Func D => i_call_last Func D @@ -1199,9 +1092,9 @@ i_call_ext e i_call_ext_last e P i_call_ext_only e -i_move_call_ext c r e -i_move_call_ext_last e P c r -i_move_call_ext_only e c r +i_move_call_ext c e +i_move_call_ext_last e P c +i_move_call_ext_only e c # Fun calls. @@ -1221,7 +1114,6 @@ i_make_fun I t %macro: is_function IsFunction -fail_action is_function f x is_function f y -is_function f r is_function Fail=f c => jump Fail func_info M F A => i_func_info u M F A @@ -1233,126 +1125,102 @@ func_info M F A => i_func_info u M F A %cold bs_start_match2 Fail=f ica X Y D => jump Fail bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D -i_bs_start_match2 r f I I d i_bs_start_match2 x f I I d i_bs_start_match2 y f I I d bs_save2 Reg Index => gen_bs_save(Reg, Index) -i_bs_save2 r I i_bs_save2 x I bs_restore2 Reg Index => gen_bs_restore(Reg, Index) -i_bs_restore2 r I i_bs_restore2 x I # Matching integers bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val -i_bs_match_string r f I I i_bs_match_string x f I I # Fetching integers from binaries. -bs_get_integer2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ +bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_integer_small_imm r I f I d i_bs_get_integer_small_imm x I f I d -i_bs_get_integer_imm r I I f I d i_bs_get_integer_imm x I I f I d i_bs_get_integer f I I d -i_bs_get_integer_8 r f d i_bs_get_integer_8 x f d -i_bs_get_integer_16 r f d i_bs_get_integer_16 x f d -i_bs_get_integer_32 r f I d i_bs_get_integer_32 x f I d # Fetching binaries from binaries. -bs_get_binary2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ +bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) %macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -gen_dest %macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -gen_dest %macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action -gen_dest -i_bs_get_binary_imm2 f r I I I d i_bs_get_binary_imm2 f x I I I d -i_bs_get_binary2 f r I s I d i_bs_get_binary2 f x I s I d -i_bs_get_binary_all2 f r I I d i_bs_get_binary_all2 f x I I d -i_bs_get_binary_all_reuse r f I i_bs_get_binary_all_reuse x f I # Fetching float from binaries. -bs_get_float2 Fail=f Ms=rx Live=u Sz=s Unit=u Flags=u Dst=d => \ +bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -bs_get_float2 Fail=f Ms=rx Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail +bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail %macro: i_bs_get_float2 BsGetFloat2 -fail_action -gen_dest -i_bs_get_float2 f r I s I d i_bs_get_float2 f x I s I d # Miscellanous -bs_skip_bits2 Fail=f Ms=rx Sz=s Unit=u Flags=u => \ - gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) -bs_skip_bits2 Fail=f Ms=rx Sz=q Unit=u Flags=u => \ +bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) %macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action -i_bs_skip_bits_imm2 f r I i_bs_skip_bits_imm2 f x I %macro: i_bs_skip_bits2 BsSkipBits2 -fail_action -i_bs_skip_bits2 f r x I -i_bs_skip_bits2 f r y I i_bs_skip_bits2 f x x I -i_bs_skip_bits2 f x r I i_bs_skip_bits2 f x y I %macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action -i_bs_skip_bits_all2 f r I i_bs_skip_bits_all2 f x I -bs_test_tail2 Fail=f Ms=rx Bits=u==0 => bs_test_zero_tail2 Fail Ms -bs_test_tail2 Fail=f Ms=rx Bits=u => bs_test_tail_imm2 Fail Ms Bits -bs_test_zero_tail2 f r +bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms +bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits bs_test_zero_tail2 f x -bs_test_tail_imm2 f r I bs_test_tail_imm2 f x I bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms -bs_test_unit f r I bs_test_unit f x I -bs_test_unit8 f r bs_test_unit8 f x -bs_context_to_binary r +# An y register operand for bs_context_to_binary is rare, +# but can happen because of inlining. + +bs_context_to_binary Y=y => move Y x | bs_context_to_binary x + bs_context_to_binary x -bs_context_to_binary y # # Utf8/utf16/utf32 support. (R12B-5) # -bs_get_utf8 Fail=f Ms=rx u u Dst=d => i_bs_get_utf8 Ms Fail Dst -i_bs_get_utf8 r f d +bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst i_bs_get_utf8 x f d -bs_skip_utf8 Fail=f Ms=rx u u => i_bs_get_utf8 Ms Fail x +bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x -bs_get_utf16 Fail=f Ms=rx u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst -bs_skip_utf16 Fail=f Ms=rx u Flags=u => i_bs_get_utf16 Ms Fail Flags x +bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst +bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 r f I d i_bs_get_utf16 x f I d -bs_get_utf32 Fail=f Ms=rx Live=u Flags=u Dst=d => \ +bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ i_fetch Dst Ms | \ i_bs_validate_unicode_retract Fail -bs_skip_utf32 Fail=f Ms=rx Live=u Flags=u => \ +bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \ i_fetch x Ms | \ i_bs_validate_unicode_retract Fail @@ -1379,9 +1247,8 @@ bs_init2 Fail Sz=u Words Regs Flags Dst => \ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_fail Sz Fail Regs Dst bs_init2 Fail Sz Words Regs Flags Dst => \ - i_fetch Sz r | i_bs_init_fail_heap Words Fail Regs Dst + i_fetch Sz x=0 | i_bs_init_fail_heap Words Fail Regs Dst -i_bs_init_fail r j I d i_bs_init_fail x j I d i_bs_init_fail y j I d @@ -1402,9 +1269,8 @@ bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Reg bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_bits_fail Sz Fail Regs Dst bs_init_bits Fail Sz Words Regs Flags Dst => \ - i_fetch Sz r | i_bs_init_bits_fail_heap Words Fail Regs Dst + i_fetch Sz x=0 | i_bs_init_bits_fail_heap Words Fail Regs Dst -i_bs_init_bits_fail r j I d i_bs_init_bits_fail x j I d i_bs_init_bits_fail y j I d @@ -1577,7 +1443,6 @@ is_map Fail Lit=q | literal_is_map(Lit) => is_map Fail cq => jump Fail %macro: is_map IsMap -fail_action -is_map f r is_map f x is_map f y @@ -1588,35 +1453,25 @@ has_map_fields Fail Src Size Rest=* => \ ## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 } -get_map_elements Fail Src=rxy Size=u==2 Rest=* => \ +get_map_elements Fail Src=xy Size=u==2 Rest=* => \ gen_get_map_element(Fail, Src, Size, Rest) get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ gen_get_map_elements(Fail, Src, Size, Rest) i_get_map_elements f s I -i_get_map_element Fail Src=rxy Key=ry Dst => \ +i_get_map_element Fail Src=xy Key=y Dst => \ move Key x | i_get_map_element Fail Src x Dst %macro: i_get_map_element_hash GetMapElementHash -fail_action -i_get_map_element_hash f r c I r -i_get_map_element_hash f x c I r -i_get_map_element_hash f y c I r -i_get_map_element_hash f r c I x i_get_map_element_hash f x c I x i_get_map_element_hash f y c I x -i_get_map_element_hash f r c I y i_get_map_element_hash f x c I y i_get_map_element_hash f y c I y %macro: i_get_map_element GetMapElement -fail_action -i_get_map_element f r x r -i_get_map_element f x x r -i_get_map_element f y x r -i_get_map_element f r x x i_get_map_element f x x x i_get_map_element f y x x -i_get_map_element f r x y i_get_map_element f x x y i_get_map_element f y x y @@ -1625,9 +1480,9 @@ i_get_map_element f y x y # the i_increment/4 instruction (in bodies, not in guards). # -gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \ +gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=x Dst => \ gen_increment(Reg, Int, Live, Dst) -gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \ +gc_bif2 p Live u$bif:erlang:splus/2 Reg=x Int=i Dst => \ gen_increment(Reg, Int, Live, Dst) gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \ @@ -1662,7 +1517,6 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst -i_increment r I I d i_increment x I I d i_increment y I I d diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 00b0df5b73..e61096355c 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -176,7 +176,7 @@ sub define_type_bit { } # Composed types. - define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'}); + define_type_bit('d', $type_bit{'x'} | $type_bit{'y'}); define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}); define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} | @@ -528,12 +528,16 @@ sub emulator_output { my(@bits) = (0) x ($max_spec_operands/2); my($i); + my $involves_r = 0; for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) { my $t = $args[$i]; - if (defined $type_bit{$t}) { - my $shift = $max_genop_types * ($i % 2); - $bits[int($i/2)] |= $type_bit{$t} << $shift; + my $bits = $type_bit{$t}; + if ($t eq 'r') { + $bits |= $type_bit{'x'}; + $involves_r |= 1 << $i; } + my $shift = $max_genop_types * ($i % 2); + $bits[int($i/2)] |= $bits << $shift; } printf "/* %3d */ ", $spec_opnum; @@ -545,7 +549,7 @@ sub emulator_output { $sep = ","; } $init .= "}"; - &init_item($print_name, $init, $size, $pack, $sign, 0); + init_item($print_name, $init, $involves_r, $size, $pack, $sign, 0); $op_to_name[$spec_opnum] = $instr; $spec_opnum++; } @@ -1310,6 +1314,8 @@ sub tr_parse_op { foreach (split('', $type)) { &error("bad type in $op") unless defined $type_bit{$_} or $type eq '*'; + $_ eq 'r' and + error("$op: 'r' is not allowed in transformations") } } -- cgit v1.2.3 From c76b297463feee133adad510128d312536150392 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Jun 2015 10:06:20 +0200 Subject: Eliminate the use of i_fetch in arithmetic instructions The i_fetch instruction fetches two operands and places them in the tmp_arg1 and tmp_arg2 variables. The next instruction (such as i_plus) does not have to handle different types of operands, but can get get them simply from the tmp_arg* variables. Thus, i_fetch was introduced as a way to temper a potentail combinatorial explosion. Unfortunately, clang will generate terrible code because of the tmp_arg1 and tmp_arg2 variables being live across multiple instructions. Note that Clang has no way to predict the control flow from one instruction to another. Clang must assume that any instruction can jump to any other instruction. Somehow GCC manages to cope with this situation much better. Therefore, to improve the quality of the code generated by clang, we must eliminate all uses of the tmp_arg1 and tmp_arg2 variables. This commit eliminates the use of i_fetch in combination with the arithmetic and logical instructions. While we are touching the code for the bsr and bsl instructions, also move the tmp_big[] array from top scope of process main into the block that encloses the bsr and bsl instructions. --- erts/emulator/beam/beam_emu.c | 319 ++++++++++++++++++------------------------ erts/emulator/beam/ops.tab | 93 +++++++----- 2 files changed, 200 insertions(+), 212 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index e5179830de..82cc030878 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1145,7 +1145,6 @@ void process_main(void) */ register Eterm tmp_arg1 REG_tmp_arg1 = NIL; register Eterm tmp_arg2 REG_tmp_arg2 = NIL; - Eterm tmp_big[2]; /* * X registers and floating point registers are located in @@ -1158,8 +1157,6 @@ void process_main(void) */ int neg_o_reds = 0; - Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); - #ifdef ERTS_OPCODE_COUNTER_SUPPORT static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; #else @@ -1307,9 +1304,6 @@ void process_main(void) #endif #include "beam_hot.h" -#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res)); -#define ARITH_FUNC(name) erts_gc_##name - { Eterm increment_reg_val; Eterm increment_val; @@ -1349,81 +1343,71 @@ void process_main(void) goto find_func_info; } -#define DO_BIG_ARITH(Func,Arg1,Arg2) \ - do { \ - Uint live = Arg(1); \ - SWAPOUT; \ - reg[live] = (Arg1); \ - reg[live+1] = (Arg2); \ - result = (Func)(c_p, reg, live); \ - SWAPIN; \ - ERTS_HOLE_CHECK(c_p); \ - if (is_value(result)) { \ - StoreBifResult(4,result); \ - } \ - goto lb_Cl_error; \ - } while(0) +#define DO_OUTLINED_ARITH_2(name, Op1, Op2) \ + do { \ + Eterm result; \ + Uint live = Arg(1); \ + \ + SWAPOUT; \ + reg[live] = Op1; \ + reg[live+1] = Op2; \ + result = erts_gc_##name(c_p, reg, live); \ + SWAPIN; \ + ERTS_HOLE_CHECK(c_p); \ + if (is_value(result)) { \ + StoreBifResult(4, result); \ + } \ + goto lb_Cl_error; \ + } while (0) - OpCase(i_plus_jIxxd): { + Eterm PlusOp1, PlusOp2; Eterm result; - if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { - Sint i = signed_val(xb(Arg(2))) + signed_val(xb(Arg(3))); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_BIG_ARITH(ARITH_FUNC(mixed_plus), xb(Arg(2)), xb(Arg(3))); - } + OpCase(i_plus_jIxxd): + PlusOp1 = xb(Arg(2)); + PlusOp2 = xb(Arg(3)); + goto do_plus; - OpCase(i_plus_jId): - { - Eterm result; + OpCase(i_plus_jIssd): + GetArg2(2, PlusOp1, PlusOp2); + goto do_plus; - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2); + do_plus: + if (is_both_small(PlusOp1, PlusOp2)) { + Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); if (MY_IS_SSMALL(i)) { result = make_small(i); - STORE_ARITH_RESULT(result); + StoreBifResult(4, result); } } - arith_func = ARITH_FUNC(mixed_plus); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2); } - OpCase(i_minus_jIxxd): { + Eterm MinusOp1, MinusOp2; Eterm result; - if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { - Sint i = signed_val(xb(Arg(2))) - signed_val(xb(Arg(3))); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_BIG_ARITH(ARITH_FUNC(mixed_minus), xb(Arg(2)), xb(Arg(3))); - } + OpCase(i_minus_jIxxd): + MinusOp1 = xb(Arg(2)); + MinusOp2 = xb(Arg(3)); + goto do_minus; - OpCase(i_minus_jId): - { - Eterm result; + OpCase(i_minus_jIssd): + GetArg2(2, MinusOp1, MinusOp2); + goto do_minus; - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2); + do_minus: + if (is_both_small(MinusOp1, MinusOp2)) { + Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); if (MY_IS_SSMALL(i)) { result = make_small(i); - STORE_ARITH_RESULT(result); + StoreBifResult(4, result); } } - arith_func = ARITH_FUNC(mixed_minus); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2); } OpCase(i_is_lt_f): @@ -2767,109 +2751,81 @@ do { \ * Arithmetic operations. */ - OpCase(i_times_jId): + OpCase(i_times_jIssd): { - arith_func = ARITH_FUNC(mixed_times); - goto do_big_arith2; + Eterm Op1, Op2; + GetArg2(2, Op1, Op2); + DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2); } - OpCase(i_m_div_jId): + OpCase(i_m_div_jIssd): { - arith_func = ARITH_FUNC(mixed_div); - goto do_big_arith2; + Eterm Op1, Op2; + GetArg2(2, Op1, Op2); + DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2); } - OpCase(i_int_div_jId): + OpCase(i_int_div_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (tmp_arg2 == SMALL_ZERO) { + GetArg2(2, Op1, Op2); + if (Op2 == SMALL_ZERO) { goto badarith; - } else if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2); + } else if (is_both_small(Op1, Op2)) { + Sint ires = signed_val(Op1) / signed_val(Op2); if (MY_IS_SSMALL(ires)) { - result = make_small(ires); - STORE_ARITH_RESULT(result); + Eterm result = make_small(ires); + StoreBifResult(4, result); } } - arith_func = ARITH_FUNC(int_div); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(int_div, Op1, Op2); } - OpCase(i_rem_jIxxd): { - Eterm result; + Eterm RemOp1, RemOp2; - if (xb(Arg(3)) == SMALL_ZERO) { - goto badarith; - } else if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { - result = make_small(signed_val(xb(Arg(2))) % signed_val(xb(Arg(3)))); + OpCase(i_rem_jIxxd): + RemOp1 = xb(Arg(2)); + RemOp2 = xb(Arg(3)); + goto do_rem; + + OpCase(i_rem_jIssd): + GetArg2(2, RemOp1, RemOp2); + goto do_rem; + + do_rem: + if (RemOp2 == SMALL_ZERO) { + goto badarith; + } else if (is_both_small(RemOp1, RemOp2)) { + Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2)); StoreBifResult(4, result); + } else { + DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2); } - DO_BIG_ARITH(ARITH_FUNC(int_rem),xb(Arg(2)),xb(Arg(3))); } - OpCase(i_rem_jId): { - Eterm result; - - if (tmp_arg2 == SMALL_ZERO) { - goto badarith; - } else if (is_both_small(tmp_arg1, tmp_arg2)) { - result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2)); - STORE_ARITH_RESULT(result); - } else { - arith_func = ARITH_FUNC(int_rem); - goto do_big_arith2; - } - } + Eterm BandOp1, BandOp2; OpCase(i_band_jIxcd): - { - Eterm result; + BandOp1 = xb(Arg(2)); + BandOp2 = Arg(3); + goto do_band; + + OpCase(i_band_jIssd): + GetArg2(2, BandOp1, BandOp2); + goto do_band; - if (is_both_small(xb(Arg(2)), Arg(3))) { + do_band: + if (is_both_small(BandOp1, BandOp2)) { /* * No need to untag -- TAG & TAG == TAG. */ - result = xb(Arg(2)) & Arg(3); + Eterm result = BandOp1 & BandOp2; StoreBifResult(4, result); } - DO_BIG_ARITH(ARITH_FUNC(band),xb(Arg(2)),Arg(3)); - } - - OpCase(i_band_jId): - { - Eterm result; - - if (is_both_small(tmp_arg1, tmp_arg2)) { - /* - * No need to untag -- TAG & TAG == TAG. - */ - result = tmp_arg1 & tmp_arg2; - STORE_ARITH_RESULT(result); - } - arith_func = ARITH_FUNC(band); - goto do_big_arith2; - } - -#undef DO_BIG_ARITH - - do_big_arith2: - { - Eterm result; - Uint live = Arg(1); - - SWAPOUT; - reg[live] = tmp_arg1; - reg[live+1] = tmp_arg2; - result = arith_func(c_p, reg, live); - SWAPIN; - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - STORE_ARITH_RESULT(result); - } - goto lb_Cl_error; + DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2); } /* @@ -2890,97 +2846,102 @@ do { \ goto find_func_info; } - OpCase(i_bor_jId): + OpCase(i_bor_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (is_both_small(tmp_arg1, tmp_arg2)) { + GetArg2(2, Op1, Op2); + if (is_both_small(Op1, Op2)) { /* * No need to untag -- TAG | TAG == TAG. */ - result = tmp_arg1 | tmp_arg2; - STORE_ARITH_RESULT(result); + Eterm result = Op1 | Op2; + StoreBifResult(4, result); } - arith_func = ARITH_FUNC(bor); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(bor, Op1, Op2); } - OpCase(i_bxor_jId): + OpCase(i_bxor_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (is_both_small(tmp_arg1, tmp_arg2)) { + GetArg2(2, Op1, Op2); + if (is_both_small(Op1, Op2)) { /* * We could extract the tag from one argument, but a tag extraction * could mean a shift. Therefore, play it safe here. */ - result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2)); - STORE_ARITH_RESULT(result); + Eterm result = make_small(signed_val(Op1) ^ signed_val(Op2)); + StoreBifResult(4, result); } - arith_func = ARITH_FUNC(bxor); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(bxor, Op1, Op2); } { + Eterm Op1, Op2; Sint i; Sint ires; Eterm* bigp; + Eterm tmp_big[2]; - OpCase(i_bsr_jId): - if (is_small(tmp_arg2)) { - i = -signed_val(tmp_arg2); - if (is_small(tmp_arg1)) { + OpCase(i_bsr_jIssd): + GetArg2(2, Op1, Op2); + if (is_small(Op2)) { + i = -signed_val(Op2); + if (is_small(Op1)) { goto small_shift; - } else if (is_big(tmp_arg1)) { + } else if (is_big(Op1)) { if (i == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto big_shift; } - } else if (is_big(tmp_arg2)) { + } else if (is_big(Op2)) { /* * N bsr NegativeBigNum == N bsl MAX_SMALL * N bsr PositiveBigNum == N bsl MIN_SMALL */ - tmp_arg2 = make_small(bignum_header_is_neg(*big_val(tmp_arg2)) ? + Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ? MAX_SMALL : MIN_SMALL); goto do_bsl; } goto badarith; - OpCase(i_bsl_jId): + OpCase(i_bsl_jIssd): + GetArg2(2, Op1, Op2); + do_bsl: - if (is_small(tmp_arg2)) { - i = signed_val(tmp_arg2); + if (is_small(Op2)) { + i = signed_val(Op2); - if (is_small(tmp_arg1)) { + if (is_small(Op1)) { small_shift: - ires = signed_val(tmp_arg1); + ires = signed_val(Op1); if (i == 0 || ires == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } else if (i < 0) { /* Right shift */ i = -i; if (i >= SMALL_BITS-1) { - tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; } else { - tmp_arg1 = make_small(ires >> i); + Op1 = make_small(ires >> i); } - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } else if (i < SMALL_BITS-1) { /* Left shift */ if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { - tmp_arg1 = make_small(ires << i); - StoreBifResult(2, tmp_arg1); + Op1 = make_small(ires << i); + StoreBifResult(4, Op1); } } - tmp_arg1 = small_to_big(ires, tmp_big); + Op1 = small_to_big(ires, tmp_big); big_shift: if (i > 0) { /* Left shift. */ - ires = big_size(tmp_arg1) + (i / D_EXP); + ires = big_size(Op1) + (i / D_EXP); } else { /* Right shift. */ - ires = big_size(tmp_arg1); + ires = big_size(Op1); if (ires <= (-i / D_EXP)) ires = 3; /* ??? */ else @@ -2998,14 +2959,14 @@ do { \ c_p->freason = SYSTEM_LIMIT; goto lb_Cl_error; } - TestHeapPreserve(ires+1, Arg(1), tmp_arg1); + TestHeapPreserve(ires+1, Arg(1), Op1); bigp = HTOP; - tmp_arg1 = big_lshift(tmp_arg1, i, bigp); - if (is_big(tmp_arg1)) { + Op1 = big_lshift(Op1, i, bigp); + if (is_big(Op1)) { HTOP += bignum_header_arity(*HTOP) + 1; } HEAP_SPACE_VERIFIED(0); - if (is_nil(tmp_arg1)) { + if (is_nil(Op1)) { /* * This result must have been only slight larger * than allowed since it wasn't caught by the @@ -3015,25 +2976,25 @@ do { \ goto lb_Cl_error; } ERTS_HOLE_CHECK(c_p); - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } - } else if (is_big(tmp_arg1)) { + } else if (is_big(Op1)) { if (i == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto big_shift; } - } else if (is_big(tmp_arg2)) { - if (bignum_header_is_neg(*big_val(tmp_arg2))) { + } else if (is_big(Op2)) { + if (bignum_header_is_neg(*big_val(Op2))) { /* * N bsl NegativeBigNum is either 0 or -1, depending on * the sign of N. Since we don't believe this case * is common, do the calculation with the minimum * amount of code. */ - tmp_arg2 = make_small(MIN_SMALL); + Op2 = make_small(MIN_SMALL); goto do_bsl; - } else if (is_small(tmp_arg1) || is_big(tmp_arg1)) { + } else if (is_small(Op1) || is_big(Op1)) { /* * N bsl PositiveBigNum is too large to represent. */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 335f8e2db5..e4a757ec8b 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1475,68 +1475,95 @@ i_get_map_element f y x x i_get_map_element f x x y i_get_map_element f y x y +# +# Convert the plus operations to a generic plus instruction. +# +gen_plus/5 +gen_minus/5 + +gc_bif1 Fail Live u$bif:erlang:splus/1 Src Dst => \ + gen_plus Fail Live Src i Dst +gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \ + gen_plus Fail Live S1 S2 Dst + +gc_bif1 Fail Live u$bif:erlang:sminus/1 Src Dst => \ + gen_minus Fail Live i Src Dst +gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \ + gen_minus Fail Live S1 S2 Dst + # # Optimize addition and subtraction of small literals using # the i_increment/4 instruction (in bodies, not in guards). # -gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=x Dst => \ +gen_plus p Live Int=i Reg=d Dst => \ gen_increment(Reg, Int, Live, Dst) -gc_bif2 p Live u$bif:erlang:splus/2 Reg=x Int=i Dst => \ +gen_plus p Live Reg=d Int=i Dst => \ gen_increment(Reg, Int, Live, Dst) -gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \ - negation_is_small(Int) => \ +gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ gen_increment_from_minus(Reg, Int, Live, Dst) # # GCing arithmetic instructions. # -gc_bif2 Fail I u$bif:erlang:splus/2 S1=x S2=x Dst=d => i_plus Fail I S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst -gc_bif2 Fail I u$bif:erlang:sminus/2 S1=x S2=x Dst=d => i_minus Fail I S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:sminus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_minus Fail I Dst -gc_bif2 Fail I u$bif:erlang:stimes/2 S1 S2 Dst=d => i_fetch S1 S2 | i_times Fail I Dst -gc_bif2 Fail I u$bif:erlang:div/2 S1 S2 Dst=d => i_fetch S1 S2 | i_m_div Fail I Dst +gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:intdiv/2 S1 S2 Dst=d => i_fetch S1 S2 | i_int_div Fail I Dst -gc_bif2 Fail I u$bif:erlang:rem/2 S1=x S2=x Dst=d => i_rem Fail I S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:rem/2 S1 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I Dst +gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:bsl/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsl Fail I Dst -gc_bif2 Fail I u$bif:erlang:bsr/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsr Fail I Dst +gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \ + i_times Fail Live S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:band/2 S1=x S2=c Dst=d => i_band Fail I S1 S2 Dst -gc_bif2 Fail I u$bif:erlang:band/2 S1 S2 Dst=d => i_fetch S1 S2 | i_band Fail I Dst -gc_bif2 Fail I u$bif:erlang:bor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bor Fail I Dst -gc_bif2 Fail I u$bif:erlang:bxor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bxor Fail I Dst +gc_bif2 Fail Live u$bif:erlang:div/2 S1 S2 Dst => \ + i_m_div Fail Live S1 S2 Dst +gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \ + i_int_div Fail Live S1 S2 Dst -gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst +gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \ + i_rem Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \ + i_bsl Fail Live S1 S2 Dst +gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \ + i_bsr Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \ + i_band Fail Live S1 S2 Dst -gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst -gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst +gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \ + i_bor Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \ + i_bxor Fail Live S1 S2 Dst + +gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst i_increment x I I d i_increment y I I d i_plus j I x x d -i_plus j I d +i_plus j I s s d + i_minus j I x x d -i_minus j I d -i_times j I d -i_m_div j I d -i_int_div j I d +i_minus j I s s d + +i_times j I s s d + +i_m_div j I s s d +i_int_div j I s s d + i_rem j I x x d -i_rem j I d +i_rem j I s s d -i_bsl j I d -i_bsr j I d +i_bsl j I s s d +i_bsr j I s s d i_band j I x c d -i_band j I d -i_bor j I d -i_bxor j I d +i_band j I s s d + +i_bor j I s s d +i_bxor j I s s d i_int_bnot j s I d -- cgit v1.2.3 From 3c583d590589b64ab543102f2542bda0337ce2f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 17 Jun 2015 06:52:50 +0200 Subject: Eliminate the use of i_fetch for relational operators --- erts/emulator/beam/beam_emu.c | 39 ++----------------------- erts/emulator/beam/ops.tab | 67 ++++++++++++++----------------------------- 2 files changed, 25 insertions(+), 81 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 82cc030878..b63fa038d2 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -651,6 +651,9 @@ void** beam_ops; #define EqualImmed(X, Y, Action) if (X != Y) { Action; } #define NotEqualImmed(X, Y, Action) if (X == Y) { Action; } #define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; } +#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; } +#define Equal(X, Y, Action) if (!CMP_EQ(X,Y)) { Action; } +#define NotEqual(X, Y, Action) if (!CMP_NE(X,Y)) { Action; } #define IsLessThan(X, Y, Action) if (CMP_GE(X, Y)) { Action; } #define IsGreaterEqual(X, Y, Action) if (CMP_LT(X, Y)) { Action; } @@ -1410,36 +1413,6 @@ void process_main(void) DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2); } - OpCase(i_is_lt_f): - if (CMP_GE(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_ge_f): - if (CMP_LT(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_eq_f): - if (CMP_NE(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_ne_f): - if (CMP_EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_eq_exact_f): - if (!EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - { Eterm is_eq_exact_lit_val; @@ -3276,12 +3249,6 @@ do { \ NextPF(3, next); } - OpCase(i_is_ne_exact_f): - if (EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - OpCase(normal_exit): { SWAPOUT; c_p->freason = EXC_NORMAL; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index e4a757ec8b..57fb1ea026 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -397,59 +397,36 @@ i_is_ne_exact_immed f y c i_is_ne_exact_literal f x c i_is_ne_exact_literal f y c -# -# Common Compare Specializations -# We don't do all of them since we want -# to keep the instruction set small-ish -# - -is_eq_exact Lbl S1=y S2=x => is_eq_exact Lbl S2 S1 -is_eq_exact Lbl S1=x S2=xy => i_is_eq_exact_spec Lbl S1 S2 -%macro: i_is_eq_exact_spec EqualExact -fail_action - -i_is_eq_exact_spec f x x -i_is_eq_exact_spec f x y - -is_lt Lbl S1=xc S2=xc => i_is_lt_spec Lbl S1 S2 - -%macro: i_is_lt_spec IsLessThan -fail_action - -i_is_lt_spec f x x -i_is_lt_spec f x c -i_is_lt_spec f c x +is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y +%macro: is_eq_exact EqualExact -fail_action +is_eq_exact f x x +is_eq_exact f x y +is_eq_exact f s s + +%macro: is_lt IsLessThan -fail_action +is_lt f x x +is_lt f x c +is_lt f c x %cold -i_is_lt_spec f c c +is_lt f s s %hot -is_ge Lbl S1=xc S2=xc => i_is_ge_spec Lbl S1 S2 - -%macro: i_is_ge_spec IsGreaterEqual -fail_action - -i_is_ge_spec f x x -i_is_ge_spec f x c -i_is_ge_spec f c x +%macro: is_ge IsGreaterEqual -fail_action +is_ge f x x +is_ge f x c +is_ge f c x %cold -i_is_ge_spec f c c +is_ge f s s %hot -# -# All other comparisons. -# - -is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl -is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl +%macro: is_ne_exact NotEqualExact -fail_action +is_ne_exact f s s -is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl -is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl -is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl -is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl +%macro: is_eq Equal -fail_action +is_eq f s s -i_is_eq_exact f -i_is_ne_exact f -i_is_lt f -i_is_ge f -i_is_eq f -i_is_ne f +%macro: is_ne NotEqual -fail_action +is_ne f s s # # Putting things. -- cgit v1.2.3 From 30204739a047ab96d2b7d59ae461d4cbb2131509 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 17 Jun 2015 10:34:39 +0200 Subject: Eliminate the use of i_fetch for BIF instructions --- erts/emulator/beam/beam_emu.c | 68 ++++++++++++++++++++++++------------------ erts/emulator/beam/beam_load.c | 28 ++++++----------- erts/emulator/beam/ops.tab | 21 +++++++------ 3 files changed, 58 insertions(+), 59 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index b63fa038d2..d260c74255 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -2513,12 +2513,10 @@ do { \ { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); GcBifFunction bf; - Eterm arg; Eterm result; Uint live = (Uint) Arg(3); - GetArg1(2, arg); - reg[live] = arg; + GetArg1(2, x(live)); bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2538,12 +2536,12 @@ do { \ SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = arg; + x(0) = x(live); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } - OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1 + OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1 and i_gc_bif3 */ { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); @@ -2551,8 +2549,13 @@ do { \ Eterm result; Uint live = (Uint) Arg(2); - reg[live++] = tmp_arg1; - reg[live] = tmp_arg2; + GetArg2(3, x(live), x(live+1)); + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the second + * (i.e. 'live' should not be incremented below). + */ + live++; bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2566,30 +2569,34 @@ do { \ ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(3, result); + StoreBifResult(5, result); } if (Arg(0) != 0) { SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = tmp_arg1; - reg[1] = tmp_arg2; + live--; + x(0) = x(live); + x(1) = x(live+1); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } - OpCase(i_gc_bif3_jIsId): + OpCase(i_gc_bif3_jIIssd): { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); GcBifFunction bf; - Eterm arg; Eterm result; - Uint live = (Uint) Arg(3); + Uint live = (Uint) Arg(2); - GetArg1(2, arg); - reg[live++] = arg; - reg[live++] = tmp_arg1; - reg[live] = tmp_arg2; + x(live) = x(SCRATCH_X_REG); + GetArg2(3, x(live+1), x(live+2)); + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the third + * (i.e. 'live' should not be incremented below). + */ + live += 2; bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2603,15 +2610,16 @@ do { \ ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(4, result); + StoreBifResult(5, result); } if (Arg(0) != 0) { SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = arg; - reg[1] = tmp_arg1; - reg[2] = tmp_arg2; + live -= 2; + x(0) = x(live); + x(1) = x(live+1); + x(2) = x(live+2); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } @@ -2619,12 +2627,13 @@ do { \ /* * Guards bifs and, or, xor in guards. */ - OpCase(i_bif2_fbd): + OpCase(i_bif2_fbssd): { - Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm tmp_reg[2]; Eterm (*bf)(Process*, Eterm*); Eterm result; + GetArg2(2, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2636,7 +2645,7 @@ do { \ ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(2, result); + StoreBifResult(4, result); } SET_I((BeamInstr *) Arg(0)); Goto(*I); @@ -2645,12 +2654,13 @@ do { \ /* * Guards bifs and, or, xor, relational operators in body. */ - OpCase(i_bif2_body_bd): + OpCase(i_bif2_body_bssd): { - Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm tmp_reg[2]; Eterm (*bf)(Process*, Eterm*); Eterm result; + GetArg2(1, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2661,10 +2671,10 @@ do { \ ERTS_HOLE_CHECK(c_p); if (is_value(result)) { ASSERT(!is_CP(result)); - StoreBifResult(1, result); + StoreBifResult(3, result); } - reg[0] = tmp_arg1; - reg[1] = tmp_arg2; + reg[0] = tmp_reg[0]; + reg[1] = tmp_reg[1]; SWAPOUT; I = handle_error(c_p, I, reg, bf); goto post_error_handling; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 3671baa552..c90576333a 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -3921,9 +3921,7 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) /* * Rewrite gc_bifs with one parameter (the common case). Utilized * in ops.tab to rewrite instructions calling bif's in guards - * to use a garbage collecting implementation. The instructions - * are sometimes once again rewritten to handle literals (putting the - * parameter in the mostly unused r[0] before the instruction is executed). + * to use a garbage collecting implementation. */ static GenOp* gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -3978,10 +3976,6 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, /* * This is used by the ops.tab rule that rewrites gc_bifs with two parameters. - * The instruction returned is then again rewritten to an i_load instruction - * followed by i_gc_bif2_jIId, to handle literals properly. - * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is - * always rewritten, regardless of if there actually are any literals. */ static GenOp* gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -4008,23 +4002,19 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->a[2].val = stp->import[Bif.val].arity; return op; } - op->op = genop_ii_gc_bif2_6; + op->op = genop_i_gc_bif2_6; op->arity = 6; op->a[0] = Fail; op->a[1].type = TAG_u; - op->a[2] = S1; - op->a[3] = S2; - op->a[4] = Live; + op->a[2] = Live; + op->a[3] = S1; + op->a[4] = S2; op->a[5] = Dst; return op; } /* * This is used by the ops.tab rule that rewrites gc_bifs with three parameters. - * The instruction returned is then again rewritten to a move instruction that - * uses r[0] for temp storage, followed by an i_load instruction, - * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting - * always occur, as with the gc_bif2 counterpart. */ static GenOp* gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -4055,10 +4045,10 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->arity = 7; op->a[0] = Fail; op->a[1].type = TAG_u; - op->a[2] = S1; - op->a[3] = S2; - op->a[4] = S3; - op->a[5] = Live; + op->a[2] = Live; + op->a[3] = S1; + op->a[4] = S2; + op->a[5] = S3; op->a[6] = Dst; op->next = NULL; return op; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 57fb1ea026..492d4d240a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -995,8 +995,8 @@ bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, bif1 p Bif S1 Dst => bif1_body Bif S1 Dst -bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst +bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst i_get s d @@ -1018,8 +1018,8 @@ i_element j y s d bif1 f b s d bif1_body b s d -i_bif2 f b d -i_bif2_body b d +i_bif2 f b s s d +i_bif2_body b s s d # # Internal calls. @@ -1568,17 +1568,16 @@ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ i_gc_bif1 j I s I d -ii_gc_bif2/6 - -ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D - -i_gc_bif2 j I I d +i_gc_bif2 j I I s s d ii_gc_bif3/7 -ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D +# A specific instruction can only have 6 operands, so we must +# pass one of the arguments in an x register. +ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \ + move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst -i_gc_bif3 j I s I d +i_gc_bif3 j I I s s d # # The following instruction is specially handled in beam_load.c -- cgit v1.2.3 From bede3941be8629efa4d91755c085a91b1416d432 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 17 Jun 2015 15:31:36 +0200 Subject: Eliminate use of i_fetch for bit syntax instructions --- erts/emulator/beam/beam_emu.c | 207 +++++++++++++++++++++-------------------- erts/emulator/beam/beam_load.c | 27 ++---- erts/emulator/beam/ops.tab | 29 +++--- 3 files changed, 129 insertions(+), 134 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index d260c74255..26e28832cf 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3548,11 +3548,10 @@ do { \ goto do_bs_init_bits_known; } - OpCase(i_bs_init_bits_fail_heap_IjId): { - /* tmp_arg1 was fetched by an i_fetch instruction */ - num_bits_term = tmp_arg1; - alloc = Arg(0); - I++; + OpCase(i_bs_init_bits_fail_heap_sIjId): { + GetArg1(0, num_bits_term); + alloc = Arg(1); + I += 2; goto do_bs_init_bits; } @@ -3675,46 +3674,48 @@ do { \ } { - OpCase(i_bs_init_fail_heap_IjId): { - /* tmp_arg1 was fetched by an i_fetch instruction */ - tmp_arg2 = Arg(0); - I++; + Eterm BsOp1, BsOp2; + + OpCase(i_bs_init_fail_heap_sIjId): { + GetArg1(0, BsOp1); + BsOp2 = Arg(1); + I += 2; goto do_bs_init; } OpCase(i_bs_init_fail_yjId): { - tmp_arg1 = yb(Arg(0)); - tmp_arg2 = 0; + BsOp1 = yb(Arg(0)); + BsOp2 = 0; I++; goto do_bs_init; } OpCase(i_bs_init_fail_xjId): { - tmp_arg1 = xb(Arg(0)); - tmp_arg2 = 0; + BsOp1 = xb(Arg(0)); + BsOp2 = 0; I++; } /* FALL THROUGH */ do_bs_init: - if (is_small(tmp_arg1)) { - Sint size = signed_val(tmp_arg1); + if (is_small(BsOp1)) { + Sint size = signed_val(BsOp1); if (size < 0) { goto badarg; } - tmp_arg1 = (Eterm) size; + BsOp1 = (Eterm) size; } else { Uint bytes; - if (!term_to_Uint(tmp_arg1, &bytes)) { + if (!term_to_Uint(BsOp1, &bytes)) { c_p->freason = bytes; goto lb_Cl_error; } if ((bytes >> (8*sizeof(Uint)-3)) != 0) { goto system_limit; } - tmp_arg1 = (Eterm) bytes; + BsOp1 = (Eterm) bytes; } - if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) { + if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { goto do_heap_bin_alloc; } else { goto do_proc_bin_alloc; @@ -3722,15 +3723,15 @@ do { \ OpCase(i_bs_init_heap_IIId): { - tmp_arg1 = Arg(0); - tmp_arg2 = Arg(1); + BsOp1 = Arg(0); + BsOp2 = Arg(1); I++; goto do_proc_bin_alloc; } OpCase(i_bs_init_IId): { - tmp_arg1 = Arg(0); - tmp_arg2 = 0; + BsOp1 = Arg(0); + BsOp2 = 0; } /* FALL THROUGH */ do_proc_bin_alloc: { @@ -3739,13 +3740,13 @@ do { \ erts_bin_offset = 0; erts_writable_bin = 0; - TestBinVHeap(tmp_arg1 / sizeof(Eterm), - tmp_arg2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); + TestBinVHeap(BsOp1 / sizeof(Eterm), + BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); /* * Allocate the binary struct itself. */ - bptr = erts_bin_nrml_alloc(tmp_arg1); + bptr = erts_bin_nrml_alloc(BsOp1); erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -3755,28 +3756,28 @@ do { \ pb = (ProcBin *) HTOP; HTOP += PROC_BIN_SIZE; pb->thing_word = HEADER_PROC_BIN; - pb->size = tmp_arg1; + pb->size = BsOp1; pb->next = MSO(c_p).first; MSO(c_p).first = (struct erl_off_heap_header*) pb; pb->val = bptr; pb->bytes = (byte*) bptr->orig_bytes; pb->flags = 0; - OH_OVERHEAD(&(MSO(c_p)), tmp_arg1 / sizeof(Eterm)); + OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); StoreBifResult(2, make_binary(pb)); } OpCase(i_bs_init_heap_bin_heap_IIId): { - tmp_arg1 = Arg(0); - tmp_arg2 = Arg(1); + BsOp1 = Arg(0); + BsOp2 = Arg(1); I++; goto do_heap_bin_alloc; } OpCase(i_bs_init_heap_bin_IId): { - tmp_arg1 = Arg(0); - tmp_arg2 = 0; + BsOp1 = Arg(0); + BsOp2 = 0; } /* Fall through */ do_heap_bin_alloc: @@ -3784,33 +3785,36 @@ do { \ ErlHeapBin* hb; Uint bin_need; - bin_need = heap_bin_size(tmp_arg1); + bin_need = heap_bin_size(BsOp1); erts_bin_offset = 0; erts_writable_bin = 0; - TestHeap(bin_need+tmp_arg2+ERL_SUB_BIN_SIZE, Arg(1)); + TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1)); hb = (ErlHeapBin *) HTOP; HTOP += bin_need; - hb->thing_word = header_heap_bin(tmp_arg1); - hb->size = tmp_arg1; + hb->thing_word = header_heap_bin(BsOp1); + hb->size = BsOp1; erts_current_bin = (byte *) hb->data; - tmp_arg1 = make_binary(hb); - StoreBifResult(2, tmp_arg1); + BsOp1 = make_binary(hb); + StoreBifResult(2, BsOp1); } } - OpCase(i_bs_add_jId): { - Uint Unit = Arg(1); - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint Arg1 = signed_val(tmp_arg1); - Sint Arg2 = signed_val(tmp_arg2); + OpCase(bs_add_jssId): { + Eterm Op1, Op2; + Uint Unit = Arg(3); + + GetArg2(1, Op1, Op2); + if (is_both_small(Op1, Op2)) { + Sint Arg1 = signed_val(Op1); + Sint Arg2 = signed_val(Op2); if (Arg1 >= 0 && Arg2 >= 0) { - BsSafeMul(Arg2, Unit, goto system_limit, tmp_arg1); - tmp_arg1 += Arg1; + BsSafeMul(Arg2, Unit, goto system_limit, Op1); + Op1 += Arg1; store_bs_add_result: - if (MY_IS_SSMALL((Sint) tmp_arg1)) { - tmp_arg1 = make_small(tmp_arg1); + if (MY_IS_SSMALL((Sint) Op1)) { + Op1 = make_small(Op1); } else { /* * May generate a heap fragment, but in this @@ -3822,10 +3826,10 @@ do { \ * references (such as the heap). */ SWAPOUT; - tmp_arg1 = erts_make_integer(tmp_arg1, c_p); + Op1 = erts_make_integer(Op1, c_p); HTOP = HEAP_TOP(c_p); } - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto badarg; } else { @@ -3848,16 +3852,16 @@ do { \ * an Uint, the reason is SYSTEM_LIMIT. */ - if (!term_to_Uint(tmp_arg1, &a)) { + if (!term_to_Uint(Op1, &a)) { if (a == BADARG) { goto badarg; } - if (!term_to_Uint(tmp_arg2, &b)) { + if (!term_to_Uint(Op2, &b)) { c_p->freason = b; goto lb_Cl_error; } goto system_limit; - } else if (!term_to_Uint(tmp_arg2, &b)) { + } else if (!term_to_Uint(Op2, &b)) { c_p->freason = b; goto lb_Cl_error; } @@ -3867,8 +3871,8 @@ do { \ */ BsSafeMul(b, Unit, goto system_limit, c); - tmp_arg1 = a + c; - if (tmp_arg1 < a) { + Op1 = a + c; + if (Op1 < a) { /* * If the result is less than one of the * arguments, there must have been an overflow. @@ -3890,46 +3894,43 @@ do { \ } /* - * tmp_arg1 = Number of bytes to build - * tmp_arg2 = Source binary - * Operands: Fail ExtraHeap Live Unit Dst + * x(SCRATCH_X_REG); + * Operands: Fail ExtraHeap Live Unit Size Dst */ - OpCase(i_bs_append_jIIId): { + OpCase(i_bs_append_jIIIsd): { Uint live = Arg(2); Uint res; + Eterm Size; + GetArg1(4, Size); SWAPOUT; - reg[live] = tmp_arg2; - res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3)); + reg[live] = x(SCRATCH_X_REG); + res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3)); SWAPIN; if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ goto lb_Cl_error; } - StoreBifResult(4, res); + StoreBifResult(5, res); } /* - * tmp_arg1 = Number of bytes to build - * tmp_arg2 = Source binary - * Operands: Fail Unit Dst + * Operands: Fail Size Src Unit Dst */ - OpCase(i_bs_private_append_jId): { + OpCase(i_bs_private_append_jIssd): { Eterm res; + Eterm Size, Src; - res = erts_bs_private_append(c_p, tmp_arg2, tmp_arg1, Arg(1)); + GetArg2(2, Size, Src); + res = erts_bs_private_append(c_p, Src, Size, Arg(1)); if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ goto lb_Cl_error; } - StoreBifResult(2, res); + StoreBifResult(4, res); } - /* - * tmp_arg1 = Initial size of writable binary - * Operands: Live Dst - */ OpCase(bs_init_writable): { SWAPOUT; r(0) = erts_bs_init_writable(c_p, r(0)); @@ -4024,26 +4025,29 @@ do { \ /* * Only used for validating a value matched out. - * - * tmp_arg1 = Integer to validate - * tmp_arg2 = Match context */ - OpCase(i_bs_validate_unicode_retract_j): { - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (a bignum pointer could fall in - * the valid range). - */ - if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= tmp_arg1 && - tmp_arg1 <= make_small(0xDFFFUL))) { - ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); + OpCase(i_bs_validate_unicode_retract_jss): { + Eterm i; /* Integer to validate */ - mb->offset -= 32; - goto badarg; - } - Next(1); - } + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (a bignum pointer could fall in + * the valid range). + */ + + GetArg1(1, i); + if (is_not_small(i) || i > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { + Eterm ms; /* Match context */ + ErlBinMatchBuffer* mb; + + GetArg1(2, ms); + mb = ms_matchbuffer(ms); + mb->offset -= 32; + goto badarg; + } + Next(3); + } /* * Matching of binaries. @@ -4292,35 +4296,36 @@ do { \ } /* - * tmp_arg1 = Match context - * tmp_arg2 = Size field - * Operands: Fail Live FlagsAndUnit Dst + * Operands: Fail Live FlagsAndUnit Ms Sz Dst */ - OpCase(i_bs_get_integer_fIId): { + OpCase(i_bs_get_integer_fIIssd): { Uint flags; Uint size; + Eterm Ms; + Eterm Sz; ErlBinMatchBuffer* mb; Eterm result; flags = Arg(2); - BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size); + GetArg2(3, Ms, Sz); + BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size); if (size >= SMALL_BITS) { Uint wordsneeded; - /* check bits size before potential gc. + /* Check bits size before potential gc. * We do not want a gc and then realize we don't need - * the allocated space (i.e. if the op fails) + * the allocated space (i.e. if the op fails). * - * remember to reacquire the matchbuffer after gc. + * Remember to re-acquire the matchbuffer after gc. */ - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(Ms); if (mb->size - mb->offset < size) { ClauseFail(); } wordsneeded = 1+WSIZE(NBYTES((Uint) size)); - TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); + TestHeapPreserve(wordsneeded, Arg(1), Ms); } - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(Ms); LIGHT_SWAPOUT; result = erts_bs_get_integer_2(c_p, size, flags, mb); LIGHT_SWAPIN; @@ -4328,7 +4333,7 @@ do { \ if (is_non_value(result)) { ClauseFail(); } - StoreBifResult(3, result); + StoreBifResult(5, result); } { diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index c90576333a..871c2b1f55 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2854,23 +2854,16 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, goto generic; } } else { - GenOp* op2; - NEW_GENOP(stp, op2); - - op->op = genop_i_fetch_2; - op->arity = 2; - op->a[0] = Ms; - op->a[1] = Size; - op->next = op2; - - op2->op = genop_i_bs_get_integer_4; - op2->arity = 4; - op2->a[0] = Fail; - op2->a[1] = Live; - op2->a[2].type = TAG_u; - op2->a[2].val = (Unit.val << 3) | Flags.val; - op2->a[3] = Dst; - op2->next = NULL; + op->op = genop_i_bs_get_integer_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Live; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | Flags.val; + op->a[3] = Ms; + op->a[4] = Size; + op->a[5] = Dst; + op->next = NULL; return op; } op->next = NULL; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 492d4d240a..637cef0a22 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1122,7 +1122,7 @@ bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ i_bs_get_integer_small_imm x I f I d i_bs_get_integer_imm x I I f I d -i_bs_get_integer f I I d +i_bs_get_integer f I I s s d i_bs_get_integer_8 x f d i_bs_get_integer_16 x f d i_bs_get_integer_32 x f I d @@ -1195,14 +1195,12 @@ i_bs_get_utf16 x f I d bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ - i_fetch Dst Ms | \ - i_bs_validate_unicode_retract Fail + i_bs_validate_unicode_retract Fail Dst Ms bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \ - i_fetch x Ms | \ - i_bs_validate_unicode_retract Fail + i_bs_validate_unicode_retract Fail x Ms -i_bs_validate_unicode_retract j +i_bs_validate_unicode_retract j s s %hot # @@ -1224,12 +1222,12 @@ bs_init2 Fail Sz=u Words Regs Flags Dst => \ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_fail Sz Fail Regs Dst bs_init2 Fail Sz Words Regs Flags Dst => \ - i_fetch Sz x=0 | i_bs_init_fail_heap Words Fail Regs Dst + i_bs_init_fail_heap Sz Words Fail Regs Dst i_bs_init_fail x j I d i_bs_init_fail y j I d -i_bs_init_fail_heap I j I d +i_bs_init_fail_heap s I j I d i_bs_init I I d i_bs_init_heap_bin I I d @@ -1246,31 +1244,30 @@ bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Reg bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_bits_fail Sz Fail Regs Dst bs_init_bits Fail Sz Words Regs Flags Dst => \ - i_fetch Sz x=0 | i_bs_init_bits_fail_heap Words Fail Regs Dst + i_bs_init_bits_fail_heap Sz Words Fail Regs Dst i_bs_init_bits_fail x j I d i_bs_init_bits_fail y j I d -i_bs_init_bits_fail_heap I j I d +i_bs_init_bits_fail_heap s I j I d i_bs_init_bits I I d i_bs_init_bits_heap I I I d bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D -bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D -i_bs_add j I d +bs_add j s s I d bs_append Fail Size Extra Live Unit Bin Flags Dst => \ - i_fetch Size Bin | i_bs_append Fail Extra Live Unit Dst + move Bin x | i_bs_append Fail Extra Live Unit Size Dst bs_private_append Fail Size Unit Bin Flags Dst => \ - i_fetch Size Bin | i_bs_private_append Fail Unit Dst + i_bs_private_append Fail Unit Size Bin Dst bs_init_writable -i_bs_append j I I I d -i_bs_private_append j I d +i_bs_append j I I I s d +i_bs_private_append j I s s d # # Storing integers into binaries. -- cgit v1.2.3 From bf2b06d3edd2c855071529be17c0c35e778a88fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 17 Jun 2015 16:33:19 +0200 Subject: Remove the i_fetch instruction --- erts/emulator/beam/beam_emu.c | 2 -- erts/emulator/beam/ops.tab | 15 --------------- 2 files changed, 17 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 26e28832cf..fe3d8aea28 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -148,8 +148,6 @@ do { \ ASSERT(VALID_INSTR(* (Eterm *)(ip))); \ I = (ip) -#define FetchArgs(S1, S2) tmp_arg1 = (S1); tmp_arg2 = (S2) - /* * Store a result into a register given a destination descriptor. */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 637cef0a22..631e10215c 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -486,21 +486,6 @@ put_list c y y put_list s s d %hot -%macro: i_fetch FetchArgs -pack -i_fetch c x -i_fetch c y -i_fetch x c -i_fetch x x -i_fetch x y -i_fetch y c -i_fetch y x -i_fetch y y - -%cold -i_fetch c c -i_fetch s s -%hot - # # Some more only used by the emulator # -- cgit v1.2.3 From 227269c6b37b88fe106d27a5c0ba148c31472822 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 17 Jun 2015 19:30:20 +0200 Subject: Eliminate use of tmp_arg1 and tmp_arg2 in bit syntax --- erts/emulator/beam/beam_emu.c | 81 +++++++++++++++++++------------------------ 1 file changed, 36 insertions(+), 45 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index fe3d8aea28..89234a9a80 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -989,7 +989,6 @@ init_emulator(void) # define REG_I asm("%l4") # define REG_fcalls asm("%l5") # define REG_tmp_arg1 asm("%l6") -# define REG_tmp_arg2 asm("%l7") #else # define REG_xregs # define REG_htop @@ -997,7 +996,6 @@ init_emulator(void) # define REG_I # define REG_fcalls # define REG_tmp_arg1 -# define REG_tmp_arg2 #endif #ifdef USE_VM_PROBES @@ -1145,7 +1143,6 @@ void process_main(void) * Temporaries used for picking up arguments for instructions. */ register Eterm tmp_arg1 REG_tmp_arg1 = NIL; - register Eterm tmp_arg2 REG_tmp_arg2 = NIL; /* * X registers and floating point registers are located in @@ -4242,55 +4239,49 @@ do { \ } } - /* Operands: x(Reg) Size Live Fail Flags Dst */ - OpCase(i_bs_get_integer_imm_xIIfId): { - tmp_arg1 = xb(Arg(0)); - I++; - /* Operands: Size Live Fail Flags Dst */ - goto do_bs_get_integer_imm_test_heap; - } + { + Eterm Ms, Sz; - /* - * tmp_arg1 = match context - * Operands: Size Live Fail Flags Dst - */ - do_bs_get_integer_imm_test_heap: { - Uint wordsneeded; - tmp_arg2 = Arg(0); - wordsneeded = 1+WSIZE(NBYTES(tmp_arg2)); - TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } + /* Operands: x(Reg) Size Live Fail Flags Dst */ + OpCase(i_bs_get_integer_imm_xIIfId): { + Uint wordsneeded; + Ms = xb(Arg(0)); + Sz = Arg(1); + wordsneeded = 1+WSIZE(NBYTES(Sz)); + TestHeapPreserve(wordsneeded, Arg(2), Ms); + I += 3; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } - /* Operands: x(Reg) Size Fail Flags Dst */ + /* Operands: x(Reg) Size Fail Flags Dst */ OpCase(i_bs_get_integer_small_imm_xIfId): { - tmp_arg1 = xb(Arg(0)); - tmp_arg2 = Arg(1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } + Ms = xb(Arg(0)); + Sz = Arg(1); + I += 2; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } - /* - * tmp_arg1 = match context - * tmp_arg2 = size of field - * Operands: Fail Flags Dst - */ + /* + * Ms = match context + * Sz = size of field + * Operands: Fail Flags Dst + */ do_bs_get_integer_imm: { - ErlBinMatchBuffer* mb; - Eterm result; + ErlBinMatchBuffer* mb; + Eterm result; - mb = ms_matchbuffer(tmp_arg1); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); + mb = ms_matchbuffer(Ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(2, result); } - StoreBifResult(2, result); } /* -- cgit v1.2.3 From dddd225934cfe79c052e9013a8a2c1d6a29c8ae0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 23 Jun 2015 15:24:07 +0200 Subject: Remove the last use of tmp_arg1 --- erts/emulator/beam/beam_emu.c | 102 +++++++++++++++++++----------------------- erts/emulator/beam/ops.tab | 53 ++++++---------------- 2 files changed, 59 insertions(+), 96 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 89234a9a80..7dbf14de02 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -603,47 +603,39 @@ void** beam_ops; H = CAR(tmp_ptr); \ T = CDR(tmp_ptr); } while (0) -#define GetTupleElement(Src, Element, Dest) \ - do { \ - tmp_arg1 = (Eterm) (((unsigned char *) tuple_val(Src)) + (Element));\ - (Dest) = (*(Eterm *) tmp_arg1); \ - } while (0) - -#define ExtractNextElement(Dest) \ - tmp_arg1 += sizeof(Eterm); \ - (Dest) = (* (Eterm *) (((unsigned char *) tmp_arg1))) - -#define ExtractNextElement2(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ - ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ - tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \ - } while (0) - -#define ExtractNextElement3(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ - ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ - ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ - tmp_arg1 += 3*sizeof(Eterm); \ +#define GetTupleElement(Src, Element, Dest) \ + do { \ + Eterm* src; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + (Dest) = *src; \ } while (0) -#define ExtractNextElement4(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ - ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ - ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ - ene_dstp[3] = ((Eterm *) tmp_arg1)[4]; \ - tmp_arg1 += 4*sizeof(Eterm); \ +#define GetTupleElement2(Src, Element, Dest) \ + do { \ + Eterm* src; \ + Eterm* dst; \ + Eterm E1, E2; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + dst = &(Dest); \ + E1 = src[0]; \ + E2 = src[1]; \ + dst[0] = E1; \ + dst[1] = E2; \ } while (0) -#define ExtractElement(Element, Dest) \ - do { \ - tmp_arg1 += (Element); \ - (Dest) = (* (Eterm *) tmp_arg1); \ +#define GetTupleElement3(Src, Element, Dest) \ + do { \ + Eterm* src; \ + Eterm* dst; \ + Eterm E1, E2, E3; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + dst = &(Dest); \ + E1 = src[0]; \ + E2 = src[1]; \ + E3 = src[2]; \ + dst[0] = E1; \ + dst[1] = E2; \ + dst[2] = E3; \ } while (0) #define EqualImmed(X, Y, Action) if (X != Y) { Action; } @@ -683,11 +675,9 @@ void** beam_ops; #define IsTuple(X, Action) if (is_not_tuple(X)) Action -#define IsArity(Pointer, Arity, Fail) \ - if (*(Eterm *) \ - (tmp_arg1 = (Eterm) (tuple_val(Pointer))) != (Arity)) \ - { \ - Fail; \ +#define IsArity(Pointer, Arity, Fail) \ + if (*tuple_val(Pointer) != (Arity)) { \ + Fail; \ } #define IsMap(Src, Fail) if (!is_map(Src)) { Fail; } @@ -724,14 +714,21 @@ void** beam_ops; } \ } while (0) -#define IsTupleOfArity(Src, Arity, Fail) \ - do { \ - if (is_not_tuple(Src) || \ - *(Eterm *) \ - (tmp_arg1 = (Eterm) (tuple_val(Src))) != Arity) { \ - Fail; \ - } \ +#ifdef DEBUG +#define IsTupleOfArity(Src, Arityval, Fail) \ + do { \ + if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \ + Fail; \ + } \ } while (0) +#else +#define IsTupleOfArity(Src, Arityval, Fail) \ + do { \ + if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \ + Fail; \ + } \ + } while (0) +#endif #define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; } @@ -988,14 +985,12 @@ init_emulator(void) # define REG_stop asm("%l3") # define REG_I asm("%l4") # define REG_fcalls asm("%l5") -# define REG_tmp_arg1 asm("%l6") #else # define REG_xregs # define REG_htop # define REG_stop # define REG_I # define REG_fcalls -# define REG_tmp_arg1 #endif #ifdef USE_VM_PROBES @@ -1139,11 +1134,6 @@ void process_main(void) */ register Sint FCALLS REG_fcalls = 0; - /* - * Temporaries used for picking up arguments for instructions. - */ - register Eterm tmp_arg1 REG_tmp_arg1 = NIL; - /* * X registers and floating point registers are located in * scheduler specific data. diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 631e10215c..853ba82f83 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -230,6 +230,12 @@ i_get_tuple_element x P y i_get_tuple_element y P y %hot +%macro: i_get_tuple_element2 GetTupleElement2 -pack +i_get_tuple_element2 x P x + +%macro: i_get_tuple_element3 GetTupleElement3 -pack +i_get_tuple_element3 x P x + %macro: is_number IsNumber -fail_action %cold is_number f x @@ -552,48 +558,15 @@ test_arity Fail=f c Arity => jump Fail test_arity f x A test_arity f y A -is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ - is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P - -test_arity Fail Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ - test_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P - -original_reg Reg P1 | get_tuple_element Reg P2 Dst=xy | succ(P1, P2) => \ - extract_next_element Dst | original_reg Reg P2 - -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg P - -original_reg Reg Pos => - -original_reg/2 - -extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -succ(P1, P2) | succ(D1, D2) => \ - extract_next_element2 D1 | original_reg Reg P2 - -extract_next_element2 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -succ(P1, P2) | succ2(D1, D2) => \ - extract_next_element3 D1 | original_reg Reg P2 - -#extract_next_element3 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -#succ(P1, P2) | succ3(D1, D2) => \ -# extract_next_element4 D1 | original_reg Reg P2 - -%macro: extract_next_element ExtractNextElement -pack -extract_next_element x -extract_next_element y - -%macro: extract_next_element2 ExtractNextElement2 -pack -extract_next_element2 x -extract_next_element2 y +get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ + get_tuple_element Reg=x P3 D3=x | \ + succ(P1, P2) | succ(P2, P3) | \ + succ(D1, D2) | succ(D2, D3) => i_get_tuple_element3 Reg P1 D1 -%macro: extract_next_element3 ExtractNextElement3 -pack -extract_next_element3 x -extract_next_element3 y +get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ + succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1 -#%macro: extract_next_element4 ExtractNextElement4 -pack -#extract_next_element4 x -#extract_next_element4 y +get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst is_integer Fail=f i => is_integer Fail=f an => jump Fail -- cgit v1.2.3 From d252130b8e880f2f7f826217fe806da76fbcbb7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 10 Apr 2012 12:28:11 +0200 Subject: Rewrite the hipe_mode_switch instructions The 'cmd' variable that were shared by several hipe_mode_switch instructions would cause clang to produce sub-optimal code, probably because it considered the instructions as part of of loop that needed to be optimized. What would was that 'cmd' would be assigned to the ESI register (lower 32 bits of the RSI register). It would use ESI for other purposes in instructions, but at the end of every instruction it would set ESI to 1 just in case the next instruction happened to be hipe_trap_return. This can be seen clearly if this commit is omitted and the define HIPE_MODE_SWITCH_CMD_RETURN in hipe/hipe_mode_switch.h is changed from 1 to some other number such as 42. You will see that 42 is assigned to ESI at the end of every instruction. Eliminate this problem by elimininating the shared 'cmd' variable. --- erts/emulator/beam/beam_emu.c | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 7dbf14de02..362c6e4826 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4681,7 +4681,12 @@ do { \ #ifdef HIPE { - unsigned cmd; +#define HIPE_MODE_SWITCH(Cmd) \ + SWAPOUT; \ + c_p->fcalls = FCALLS; \ + c_p->def_arg_reg[4] = -neg_o_reds; \ + c_p = hipe_mode_switch(c_p, Cmd, reg); \ + goto L_post_hipe_mode_switch OpCase(hipe_trap_call): { /* @@ -4695,38 +4700,31 @@ do { \ */ ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; - cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8); ++hipe_trap_count; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8)); } OpCase(hipe_trap_call_closure): { ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; - cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8); ++hipe_trap_count; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8)); } OpCase(hipe_trap_return): { - cmd = HIPE_MODE_SWITCH_CMD_RETURN; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); } OpCase(hipe_trap_throw): { - cmd = HIPE_MODE_SWITCH_CMD_THROW; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); } OpCase(hipe_trap_resume): { - cmd = HIPE_MODE_SWITCH_CMD_RESUME; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); } - L_hipe_mode_switch: - /* XXX: this abuse of def_arg_reg[] is horrid! */ - SWAPOUT; - c_p->fcalls = FCALLS; - c_p->def_arg_reg[4] = -neg_o_reds; - c_p = hipe_mode_switch(c_p, cmd, reg); +#undef HIPE_MODE_SWITCH + + L_post_hipe_mode_switch: reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); + /* XXX: this abuse of def_arg_reg[] is horrid! */ neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; -- cgit v1.2.3 From 1f73d45327bb13a615f2f0a8d9d4888ddacb95a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 23 Jun 2015 09:38:23 +0200 Subject: Add back frequently used x(0) instructions --- erts/emulator/beam/beam_emu.c | 10 ++++++++++ erts/emulator/beam/ops.tab | 37 +++++++++++++++++++++++++++++++++---- 2 files changed, 43 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 362c6e4826..bac7057abe 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1298,6 +1298,11 @@ void process_main(void) Uint live; Eterm result; + OpCase(i_increment_rIId): + increment_reg_val = x(0); + I--; + goto do_increment; + OpCase(i_increment_xIId): increment_reg_val = xb(Arg(0)); goto do_increment; @@ -1357,6 +1362,11 @@ void process_main(void) PlusOp2 = xb(Arg(3)); goto do_plus; + OpCase(i_plus_jIxyd): + PlusOp1 = xb(Arg(2)); + PlusOp2 = yb(Arg(3)); + goto do_plus; + OpCase(i_plus_jIssd): GetArg2(2, PlusOp1, PlusOp2); goto do_plus; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 853ba82f83..4ab08faae3 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -204,6 +204,14 @@ get_list y x y get_list y y x get_list y y y +# The following get_list instructions using x(0) are frequently used. +get_list r x x +get_list r r y +get_list x r x +get_list r x y +get_list r y r +get_list r x r + # Old-style catch. catch y f catch_end y @@ -348,6 +356,14 @@ move c x move n x move y y +# The following move instructions using x(0) are frequently used. + +move x r +move r x +move y r +move c r +move r y + # Receive operations. loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail @@ -390,6 +406,7 @@ is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C %macro: i_is_eq_exact_immed EqualImmed -fail_action +i_is_eq_exact_immed f r c i_is_eq_exact_immed f x c i_is_eq_exact_immed f y c @@ -478,15 +495,21 @@ put_list x c x put_list x c y put_list y c x -put_list y c y # put_list Constant SrcReg Dst put_list c x x -put_list c x y - put_list c y x -put_list c y y + +# The following put_list instructions using x(0) are frequently used. + +put_list y r r +put_list x r r +put_list r n r +put_list r n x +put_list r x x +put_list r x r +put_list x x r %cold put_list s s d @@ -544,10 +567,12 @@ is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S %macro:is_tuple_of_arity IsTupleOfArity -fail_action +is_tuple_of_arity f r A is_tuple_of_arity f x A is_tuple_of_arity f y A %macro: is_tuple IsTuple -fail_action +is_tuple f r is_tuple f x is_tuple f y @@ -593,6 +618,7 @@ is_list f y is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs %macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack +is_nonempty_list_allocate f r I t is_nonempty_list_allocate f x I t is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2 @@ -1440,6 +1466,7 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # +gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst @@ -1471,10 +1498,12 @@ gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst +i_increment r I I d i_increment x I I d i_increment y I I d i_plus j I x x d +i_plus j I x y d i_plus j I s s d i_minus j I x x d -- cgit v1.2.3 From 3dc2bee53b4d36f41821a6ab512cf01c958c11f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 23 Jun 2015 17:31:49 +0200 Subject: Introduce specialized versions of move2 Currently, move2/2 does the two moves sequentially to ensure that the instruction will always work correctly. We can do better than that. If the two move instructions have any registers in common, we can introduce simpler and slightly more efficient instructions to handle those cases: move_shift/3 move_dup/3 For the remaining cases when the the move instructions have no common registers, the move2/4 instruction can perform the moves in parallel which is probably slightly more efficient. For clarity's sake, we will remain the instruction to move2_par/4. --- erts/emulator/beam/beam_emu.c | 18 ++++++++++- erts/emulator/beam/ops.tab | 71 +++++++++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 21 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index bac7057abe..2c10e7ae7c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -551,7 +551,23 @@ void** beam_ops; Store(term, Dst); \ } while (0) -#define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2) +#define Move2Par(S1, D1, S2, D2) \ + do { \ + Eterm V1, V2; \ + V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \ + } while (0) + +#define MoveShift(Src, SD, D) \ + do { \ + Eterm V; \ + V = Src; D = SD; SD = V; \ + } while (0) + +#define MoveDup(Src, D1, D2) \ + do { \ + D1 = D2 = (Src); \ + } while (0) + #define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) #define MoveReturn(Src) \ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 4ab08faae3..97525c3b72 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -303,21 +303,40 @@ move_window3 x x x y move_window4 x x x x y move_window5 x x x x x y -move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 -move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2 -move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4 +move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2 +move Src=x SD=x | move SD=x D=x => move_dup Src SD D +move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2 +move Src=y SD=x | move SD=x D=y => move_dup Src SD D +move Src=x SD=x | move SD=x D=y => move_dup Src SD D +move Src=y SD=x | move SD=x D=x => move_dup Src SD D -move X1=x X2=x | move X3=x Y1=y => move2 X1 X2 X3 Y1 +move SD=x D=x | move Src=xy SD=x => move_shift Src SD D +move SD=y D=x | move Src=x SD=y => move_shift Src SD D +move SD=x D=y | move Src=x SD=x => move_shift Src SD D -move S1=x S2=x | move X1=x Y1=y => move2 S1 S2 X1 Y1 -move S1=y S2=x | move X1=x Y1=y => move2 S1 S2 X1 Y1 +# The transformations above guarantee that the source for +# the second move is not the same as the destination for +# the first move. That means that we can do the moves in +# parallel (fetch both values, then store them) which could +# be faster. -move Y1=y X1=x | move S1=x D1=x => move2 Y1 X1 S1 D1 -move S1=x D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1 +move X1=x Y1=y | move X2=x Y2=y => move2_par X1 Y1 X2 Y2 +move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2 -move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3 -move2 Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3 -move2 X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6 +move X1=x X2=x | move X3=x X4=x => move2_par X1 X2 X3 X4 + +move X1=x X2=x | move X3=x Y1=y => move2_par X1 X2 X3 Y1 + +move S1=x S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1 + +move S1=y S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1 + +move Y1=y X1=x | move S1=x D1=x => move2_par Y1 X1 S1 D1 +move S1=x D1=x | move Y1=y X1=x => move2_par S1 D1 Y1 X1 + +move2_par X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3 +move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3 +move2_par X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6 move C=aiq X=x==1 => move_x1 C move C=aiq X=x==2 => move_x2 C @@ -325,18 +344,30 @@ move C=aiq X=x==2 => move_x2 C move_x1 c move_x2 c -%macro: move2 Move2 -pack -move2 x y x y -move2 y x y x -move2 x x x x +%macro: move_shift MoveShift -pack +move_shift x x x +move_shift y x x +move_shift x y x +move_shift x x y + +%macro: move_dup MoveDup -pack +move_dup x x x +move_dup x x y +move_dup y x x +move_dup y x y + +%macro: move2_par Move2Par -pack + +move2_par x y x y +move2_par y x y x +move2_par x x x x -move2 x x x y +move2_par x x x y -move2 x y x y -move2 y x x y +move2_par y x x y -move2 x x y x -move2 y x x x +move2_par x x y x +move2_par y x x x %macro: move3 Move3 move3 x y x y x y -- cgit v1.2.3 From 62473daf8169a04a07409f344d938bc51a4536c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 25 Jun 2015 13:21:14 +0200 Subject: Introduce swap_temp/3 and swap/2 Sequences of three move instructionst that effectively swap the contents of two registers are fairly common. We can replace them with a swap_temp/3 instruction. The third operand is the temporary register to be used for swapping, since the temporary register may actually be used. If swap_temp/3 instruction is followed by a call, the temporary register will often (but not always) be killed by the call. If it is killed, we can replace the swap_temp/3 instruction with a slightly cheaper swap/2 instruction. --- erts/emulator/beam/beam_emu.c | 14 ++++++++++++++ erts/emulator/beam/beam_load.c | 6 ++++++ erts/emulator/beam/ops.tab | 28 ++++++++++++++++++++++++++++ 3 files changed, 48 insertions(+) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 2c10e7ae7c..4e6e7aa48a 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -545,6 +545,20 @@ void** beam_ops; HTOP += 2; \ } while (0) +#define Swap(R1, R2) \ + do { \ + Eterm V = R1; \ + R1 = R2; \ + R2 = V; \ + } while (0) + +#define SwapTemp(R1, R2, Tmp) \ + do { \ + Eterm V = R1; \ + R1 = R2; \ + R2 = Tmp = V; \ + } while (0) + #define Move(Src, Dst, Store) \ do { \ Eterm term = (Src); \ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 871c2b1f55..1e3690fcd6 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2702,6 +2702,12 @@ same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) Target.val == Label.val; } +static int +is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live) +{ + return Reg.type == TAG_x && Live.type == TAG_u && + Live.val <= Reg.val; +} /* * Generate an instruction for element/2. diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 97525c3b72..386de0a658 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -303,6 +303,34 @@ move_window3 x x x y move_window4 x x x x y move_window5 x x x x x y +# Swap registers. +move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp + +swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | apply Live + +swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | call Live Addr +swap_temp R1 R2 Tmp | call_only Live Addr | \ + is_killed(Tmp, Live) => swap R1 R2 | call_only Live Addr +swap_temp R1 R2 Tmp | call_last Live Addr D | \ + is_killed(Tmp, Live) => swap R1 R2 | call_last Live Addr D + +swap_temp R1 R2 Tmp | line Loc | call_ext Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | call_ext Live Addr +swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \ + is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_only Live Addr +swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \ + is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D + +%macro: swap_temp SwapTemp -pack +swap_temp x x x +swap_temp x y x + +%macro: swap Swap -pack +swap x x +swap x y + move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2 move Src=x SD=x | move SD=x D=x => move_dup Src SD D move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2 -- cgit v1.2.3 From 5e83d2ae89c731bd7e4c32b550150336008d2974 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 25 Jun 2015 16:18:18 +0200 Subject: Use a cheaper tag scheme for 'd' operands Since 'd' operands can only either an X register or an Y register, we only need a single bit to distinguish them. Furthermore, we can pre-multiply the register number with the word size to speed up address calculation. --- erts/emulator/beam/beam_debug.c | 13 ++++------ erts/emulator/beam/beam_emu.c | 57 ++++++++++++++++++----------------------- erts/emulator/beam/beam_load.c | 4 +-- erts/emulator/beam/beam_load.h | 1 + 4 files changed, 33 insertions(+), 42 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 30e3765502..ea1f2cd012 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -475,15 +475,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'd': /* Destination (x(0), x(N), y(N)) */ - switch (loader_tag(*ap)) { - case LOADER_X_REG: - erts_print(to, to_arg, "x(%d)", - loader_x_reg_index(*ap)); - break; - case LOADER_Y_REG: + if (*ap & 1) { erts_print(to, to_arg, "y(%d)", - loader_y_reg_index(*ap) - CP_SIZE); - break; + *ap / sizeof(Eterm) - CP_SIZE); + } else { + erts_print(to, to_arg, "x(%d)", + *ap / sizeof(Eterm)); } ap++; break; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4e6e7aa48a..60a399a5ac 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -148,23 +148,21 @@ do { \ ASSERT(VALID_INSTR(* (Eterm *)(ip))); \ I = (ip) +/* + * Register target (X or Y register). + */ +#define REG_TARGET(Target) (*(((Target) & 1) ? &yb(Target-1) : &xb(Target))) + /* * Store a result into a register given a destination descriptor. */ -#define StoreResult(Result, DestDesc) \ - do { \ - Eterm stb_reg; \ - stb_reg = (DestDesc); \ - CHECK_TERM(Result); \ - switch (loader_tag(stb_reg)) { \ - case LOADER_X_REG: \ - x(loader_x_reg_index(stb_reg)) = (Result); \ - break; \ - default: \ - y(loader_y_reg_index(stb_reg)) = (Result); \ - break; \ - } \ +#define StoreResult(Result, DestDesc) \ + do { \ + Eterm stb_reg; \ + stb_reg = (DestDesc); \ + CHECK_TERM(Result); \ + REG_TARGET(stb_reg) = (Result); \ } while (0) #define StoreSimpleDest(Src, Dest) Dest = (Src) @@ -175,22 +173,16 @@ do { \ * be just before the next instruction. */ -#define StoreBifResult(Dst, Result) \ - do { \ - BeamInstr* stb_next; \ - Eterm stb_reg; \ - stb_reg = Arg(Dst); \ - I += (Dst) + 2; \ - stb_next = (BeamInstr *) *I; \ - CHECK_TERM(Result); \ - switch (loader_tag(stb_reg)) { \ - case LOADER_X_REG: \ - x(loader_x_reg_index(stb_reg)) = (Result); \ - Goto(stb_next); \ - default: \ - y(loader_y_reg_index(stb_reg)) = (Result); \ - Goto(stb_next); \ - } \ +#define StoreBifResult(Dst, Result) \ + do { \ + BeamInstr* stb_next; \ + Eterm stb_reg; \ + stb_reg = Arg(Dst); \ + I += (Dst) + 2; \ + stb_next = (BeamInstr *) *I; \ + CHECK_TERM(Result); \ + REG_TARGET(stb_reg) = (Result); \ + Goto(stb_next); \ } while (0) #define ClauseFail() goto jump_f @@ -3277,7 +3269,8 @@ do { \ Eterm* p; PreFetch(3, next); - GetArg2(0, element, tuple); + GetArg1(0, element); + tuple = REG_TARGET(Arg(1)); ASSERT(is_tuple(tuple)); p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2)); *p = element; @@ -4605,7 +4598,7 @@ do { \ BeamInstr *next; PreFetch(2, next); - GetR(0, targ1); + targ1 = REG_TARGET(Arg(0)); /* Arg(0) == HEADER_FLONUM */ GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); NextPF(2, next); @@ -4625,7 +4618,7 @@ do { \ Eterm fr = Arg(1); BeamInstr *next; - GetR(0, targ1); + targ1 = REG_TARGET(Arg(0)); PreFetch(2, next); if (is_small(targ1)) { fb(fr) = (double) signed_val(targ1); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 1e3690fcd6..a9d47eb7b0 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2227,10 +2227,10 @@ load_code(LoaderState* stp) case 'd': /* Destination (x(0), x(N), y(N) */ switch (tag) { case TAG_x: - code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm); break; case TAG_y: - code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm) + 1; break; default: LoadError1(stp, "bad tag %d for destination", diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index d5af634fad..eedb5ee4cd 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -52,6 +52,7 @@ extern BeamInstr* em_call_error_handler; extern BeamInstr* em_apply_bif; extern BeamInstr* em_call_nif; + /* * The following variables keep a sorted list of address ranges for * each module. It allows us to quickly find a function given an -- cgit v1.2.3 From 0a4750f91c837d6a68b5a9ad58ffb1fe52b67d71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 29 Jun 2015 10:19:53 +0200 Subject: beam_makeops: Eliminate unnecessary masking when packing 3 operands When packing 3 operands into one word, there would be an unnecessary mask operation when extracting the last operand. --- erts/emulator/utils/beam_makeops | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index e61096355c..974b29e9d8 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -48,7 +48,7 @@ $pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize '(3*BEAM_LOOSE_SHIFT)']; $pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; -$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; +$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize 'BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK', -- cgit v1.2.3 From a52bd8a9ebece53c67024e3ad17a899c22cea2ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 29 Jun 2015 15:56:44 +0200 Subject: Ensure that the move_call_ext_{last,only} instructions are used Update transformations to ensure that the move_call_ext_last and move_call_ext_last are used. --- erts/emulator/beam/ops.tab | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 386de0a658..18202a4200 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -76,17 +76,6 @@ return # with the following call instruction, we need to make sure that # there is no line/1 instruction between the move and the call. # - -move S X0=x==0 | line Loc | call_ext Ar Func => \ - line Loc | move S X0 | call_ext Ar Func -move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_bif D => \ - line Loc | move S X0 | call_ext_last Ar Func D -move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_bif => \ - line Loc | move S X0 | call_ext_only Ar Func -move S X0=x==0 | line Loc | call Ar Func => \ - line Loc | move S X0 | call Ar Func - -# # A tail-recursive call to an external function (non-BIF) will # never be saved on the stack, so there is no reason to keep # the line instruction. (The compiler did not remove the line @@ -94,10 +83,14 @@ move S X0=x==0 | line Loc | call Ar Func => \ # BIFs and ordinary Erlang functions.) # -line Loc | call_ext_last Ar Func=u$is_not_bif D => \ - call_ext_last Ar Func D -line Loc | call_ext_only Ar Func=u$is_not_bif => \ - call_ext_only Ar Func +move S X0=x==0 | line Loc | call_ext Ar Func => \ + line Loc | move S X0 | call_ext Ar Func +move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \ + move S X0 | call_ext_last Ar Func D +move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \ + move S X0 | call_ext_only Ar Func +move S X0=x==0 | line Loc | call Ar Func => \ + line Loc | move S X0 | call Ar Func line Loc | func_info M F A => func_info M F A | line Loc -- cgit v1.2.3 From fad052472def54fff1268b21313b15bd666437c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 21 Jun 2015 18:09:52 +0200 Subject: Teach beam_makeops to pack operands for move3 and move_window It is currently only possible to pack up to 4 operands. However, the move_window4 instrucion has 5 operands and move_window5 and move3 instrucations have 6 operands. Teach beam_makeops to pack instructions with 5 or 6 operands. Also rewrite the move_window instructions in beam_emu.c to macros to allow their operands to get packed. --- erts/emulator/beam/beam_emu.c | 88 +++++++++++++++++++--------------------- erts/emulator/beam/ops.tab | 6 ++- erts/emulator/utils/beam_makeops | 30 ++++++++++---- 3 files changed, 68 insertions(+), 56 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 60a399a5ac..a3b38adc4b 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -576,6 +576,48 @@ void** beam_ops; #define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3) +#define MoveWindow3(S1, S2, S3, D) \ + do { \ + Eterm xt0, xt1, xt2; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + } while (0) + +#define MoveWindow4(S1, S2, S3, S4, D) \ + do { \ + Eterm xt0, xt1, xt2, xt3; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + xt3 = S4; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + y[3] = xt3; \ + } while (0) + +#define MoveWindow5(S1, S2, S3, S4, S5, D) \ + do { \ + Eterm xt0, xt1, xt2, xt3, xt4; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + xt3 = S4; \ + xt4 = S5; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + y[3] = xt3; \ + y[4] = xt4; \ + } while (0) + #define MoveReturn(Src) \ x(0) = (Src); \ I = c_p->cp; \ @@ -1466,52 +1508,6 @@ void process_main(void) Next(3); } - OpCase(move_window3_xxxy): { - BeamInstr *next; - Eterm xt0, xt1, xt2; - Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(3))); - PreFetch(4, next); - xt0 = xb(Arg(0)); - xt1 = xb(Arg(1)); - xt2 = xb(Arg(2)); - y[0] = xt0; - y[1] = xt1; - y[2] = xt2; - NextPF(4, next); - } - OpCase(move_window4_xxxxy): { - BeamInstr *next; - Eterm xt0, xt1, xt2, xt3; - Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(4))); - PreFetch(5, next); - xt0 = xb(Arg(0)); - xt1 = xb(Arg(1)); - xt2 = xb(Arg(2)); - xt3 = xb(Arg(3)); - y[0] = xt0; - y[1] = xt1; - y[2] = xt2; - y[3] = xt3; - NextPF(5, next); - } - OpCase(move_window5_xxxxxy): { - BeamInstr *next; - Eterm xt0, xt1, xt2, xt3, xt4; - Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(5))); - PreFetch(6, next); - xt0 = xb(Arg(0)); - xt1 = xb(Arg(1)); - xt2 = xb(Arg(2)); - xt3 = xb(Arg(3)); - xt4 = xb(Arg(4)); - y[0] = xt0; - y[1] = xt1; - y[2] = xt2; - y[3] = xt3; - y[4] = xt4; - NextPF(6, next); - } - OpCase(i_move_call_only_fc): { r(0) = Arg(1); } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 18202a4200..bce6bacd5c 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -292,6 +292,10 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \ move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1 move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1 +%macro: move_window3 MoveWindow3 -pack +%macro: move_window4 MoveWindow4 -pack +%macro: move_window5 MoveWindow5 -pack + move_window3 x x x y move_window4 x x x x y move_window5 x x x x x y @@ -390,7 +394,7 @@ move2_par y x x y move2_par x x y x move2_par y x x x -%macro: move3 Move3 +%macro: move3 Move3 -pack move3 x y x y x y move3 y x y x y x move3 x x x x x x diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 974b29e9d8..44977ecffc 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -54,6 +54,11 @@ $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize 'BEAM_LOOSE_MASK', $WHOLE_WORD]; +# Mapping from packagable arguments to number of packed arguments per +# word. Initialized after the wordsize is known. + +my @args_per_word; + # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. # Corresponding to each generic instruction, there is generally a @@ -236,6 +241,20 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { die "$0: Bad option: -$_\n"; } +# +# Initialize number of arguments per packed word. +# + +$args_per_word[2] = 2; +$args_per_word[3] = 3; +$args_per_word[4] = 2; +$args_per_word[5] = 3; +$args_per_word[6] = 3; + +if ($wordsize == 64) { + $args_per_word[4] = 4; +} + # # Parse the input files. # @@ -736,7 +755,7 @@ sub init_item { print "${sep}NULL"; } elsif (/^\{/) { print "$sep$_"; - } elsif (/^-?\d/) { + } elsif (/^-?\d+$/) { print "$sep$_"; } else { print "$sep\"$_\""; @@ -1105,7 +1124,6 @@ sub do_pack { # Get out of here if too few or too many arguments. # return ('', '', @args) if $packable_args < 2; - &error("too many packable arguments") if $packable_args > 4; my($size) = 0; my($pack_prefix) = ''; @@ -1113,14 +1131,8 @@ sub do_pack { # beginning). my($up) = ''; # Pack commands (storing back while # moving forward). - my $args_per_word; - if ($packable_args < 4 or $wordsize == 64) { - $args_per_word = $packable_args; - } else { - # 4 packable argument, 32 bit wordsize. Need 2 words. - $args_per_word = 2; - } + my $args_per_word = $args_per_word[$packable_args]; my @shift; my @mask; my @instr; -- cgit v1.2.3 From 6d6fce257cf666113e982c0887121739dff5bf1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 1 Apr 2012 09:28:34 +0200 Subject: Eliminate prefetch for conditional instructions Not pre-fetching in conditional instructions (instructions that use -fail_action) seems to improve performance slightly. The reason for that is that conditional instructions may jump to the failure label, wasting the pre-fetched instruction. Another reason is that that many conditional instructions do a function call, and the register pressure is therefore high. Avoiding the pre-fetch may reduce the register pressure and pontentially result in more efficient code. --- erts/emulator/beam/ops.tab | 2 +- erts/emulator/utils/beam_makeops | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index bce6bacd5c..3d52da77d3 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -477,7 +477,7 @@ i_is_ne_exact_literal f x c i_is_ne_exact_literal f y c is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y -%macro: is_eq_exact EqualExact -fail_action +%macro: is_eq_exact EqualExact -fail_action -pack is_eq_exact f x x is_eq_exact f x y is_eq_exact f s s diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 44977ecffc..06515c6346 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -917,6 +917,7 @@ sub basic_generator { my($var_decls) = ''; my($gen_dest_arg) = 'StoreSimpleDest'; my($i); + my($no_prefetch) = 0; # The following argument types should be included as macro arguments. my(%incl_arg) = ('c' => 1, @@ -1015,6 +1016,7 @@ sub basic_generator { # $flags =~ /-fail_action/ and do { + $no_prefetch = 1; if (!defined $fail_type) { my($i); for ($i = 0; $i < @f_types; $i++) { @@ -1061,6 +1063,12 @@ sub basic_generator { "I += $size + 1;", "goto $goto;", "}"); + } elsif ($no_prefetch) { + $code = join("\n", + "{ $var_decls", + $macro_code, + "Next($size);", + "}", ""); } else { $code = join("\n", "{ $var_decls", -- cgit v1.2.3 From 7bfff20c48cdcabf1eae4b193a374a72977b9d3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 2 Jul 2015 14:50:47 +0200 Subject: Eliminate the variable temp_bits at the top scope of process_main() --- erts/emulator/beam/beam_emu.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a3b38adc4b..1ab8c71685 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -819,6 +819,7 @@ void** beam_ops; #define BsGetFieldSize(Bits, Unit, Fail, Target) \ do { \ Sint _signed_size; Uint _uint_size; \ + Uint temp_bits; \ if (is_small(Bits)) { \ _signed_size = signed_val(Bits); \ if (_signed_size < 0) { Fail; } \ @@ -833,6 +834,7 @@ void** beam_ops; #define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \ do { \ Sint _signed_size; Uint _uint_size; \ + Uint temp_bits; \ if (is_small(Bits)) { \ _signed_size = signed_val(Bits); \ if (_signed_size < 0) { Fail; } \ @@ -1219,8 +1221,6 @@ void process_main(void) #endif #endif - Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ - Eterm pt_arity; /* Used by do_put_tuple */ Uint64 start_time = 0; /* Monitor long schedule */ -- cgit v1.2.3 From e820b8534fd440aaf4991f3c57b8990ce836c8b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 4 Jul 2015 08:58:33 +0200 Subject: Speed up list matching The combination is_non_empty_list followed by get_list is extremly common (but not in estone_SUITE, which is why it has not been noticed before). Therefore it is worthwile to introduce a combined instruction. --- erts/emulator/beam/beam_emu.c | 11 +++++++++++ erts/emulator/beam/ops.tab | 7 +++++++ 2 files changed, 18 insertions(+) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 1ab8c71685..989066a1ca 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -737,6 +737,17 @@ void** beam_ops; if (is_not_list(x(0))) { Fail; } \ TestHeap(Need, Alive) +#define IsNonemptyListGetList(Src, H, T, Fail) \ + if (is_not_list(Src)) { \ + Fail; \ + } else { \ + Eterm* tmp_ptr = list_val(Src); \ + Eterm hd, tl; \ + hd = CAR(tmp_ptr); \ + tl = CDR(tmp_ptr); \ + H = hd; T = tl; \ + } + #define IsTuple(X, Action) if (is_not_tuple(X)) Action #define IsArity(Pointer, Arity, Fail) \ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 3d52da77d3..46fefb88af 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -682,6 +682,13 @@ is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 %macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack is_non_empty_list_test_heap f I t +is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \ + is_nonempty_list_get_list Fail S D1 D2 + +%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack +is_nonempty_list_get_list f r x x +is_nonempty_list_get_list f x x x + %macro: is_nonempty_list IsNonemptyList -fail_action is_nonempty_list f x is_nonempty_list f y -- cgit v1.2.3 From c5755ae5ded3ba27dc5d884303ead232abc77a40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 4 Jul 2015 17:10:14 +0200 Subject: Slightly tweak the peformance for get_list Fetch the head and tail parts to temporary variables before writing them to their destinations. That should allow the CPU to perform the moves in parallel, which might improve performance. --- erts/emulator/beam/beam_emu.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 989066a1ca..a296713a0a 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -662,10 +662,14 @@ void** beam_ops; SET_I((BeamInstr *) Arg(0)); \ Goto(*I); -#define GetList(Src, H, T) do { \ - Eterm* tmp_ptr = list_val(Src); \ - H = CAR(tmp_ptr); \ - T = CDR(tmp_ptr); } while (0) +#define GetList(Src, H, T) \ + do { \ + Eterm* tmp_ptr = list_val(Src); \ + Eterm hd, tl; \ + hd = CAR(tmp_ptr); \ + tl = CDR(tmp_ptr); \ + H = hd; T = tl; \ + } while (0) #define GetTupleElement(Src, Element, Dest) \ do { \ -- cgit v1.2.3 From 1ffb2647ffcc29170b461c31c018c5d2b046beae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 6 Jul 2015 11:27:45 +0200 Subject: Improve unpacking performance on x86_64 When unpacking operands on 64-bit CPUs, use a smarter mask to help the compiler optimize the code. It turns out that on x86_64, if we use the mask 0xFFFFUL (selecting the 16 least significant bits), the compiler can combine a move and a mask operation into the single insruction 'movzwl', which will eliminate one instruction. --- erts/emulator/utils/beam_makeops | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 06515c6346..f805e7cc64 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -629,8 +629,8 @@ sub emulator_output { print "\n"; print "#ifdef ARCH_64\n"; print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; - print "# define BEAM_LOOSE_MASK 0x1FFFUL\n"; - print "# define BEAM_TIGHT_MASK 0x1FF8UL\n"; + print "# define BEAM_LOOSE_MASK 0xFFFFUL\n"; + print "# define BEAM_TIGHT_MASK 0xFFFFUL\n"; print "# define BEAM_WIDE_SHIFT 32\n"; print "# define BEAM_LOOSE_SHIFT 16\n"; print "# define BEAM_TIGHT_SHIFT 16\n"; -- cgit v1.2.3 From c431a065ba515d27830f01c852f70940efb3003b Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 2 Jul 2015 11:13:32 +0200 Subject: ose: Remove all code related to the OSE port The OSE port is no longer supported and this commit removed it and any changes related to it. The things that were general improvements have been left in the code. --- HOWTO/INSTALL-CROSS.md | 23 - erts/aclocal.m4 | 48 +- erts/configure.in | 25 +- erts/doc/src/driver_entry.xml | 8 +- erts/doc/src/erl_driver.xml | 6 +- erts/doc/src/erlang.xml | 2 +- erts/doc/src/run_erl.xml | 2 +- erts/emulator/Makefile.in | 45 - erts/emulator/beam/atom.names | 7 - erts/emulator/beam/erl_alloc.types | 15 - erts/emulator/beam/erl_async.c | 1 - erts/emulator/beam/erl_driver.h | 10 - erts/emulator/beam/erl_port_task.c | 2 +- erts/emulator/beam/erl_process.c | 68 +- erts/emulator/beam/erl_process.h | 7 - erts/emulator/beam/erl_trace.c | 6 - erts/emulator/beam/io.c | 4 - erts/emulator/beam/sys.h | 4 +- erts/emulator/drivers/common/efile_drv.c | 6 - erts/emulator/drivers/common/inet_drv.c | 573 +-------- erts/emulator/drivers/ose/ose_efile.c | 1125 ----------------- erts/emulator/drivers/ose/ose_signal_drv.c | 897 -------------- erts/emulator/drivers/ose/ttsl_drv.c | 69 -- erts/emulator/sys/common/erl_check_io.c | 24 - erts/emulator/sys/common/erl_poll.h | 22 +- erts/emulator/sys/ose/beam.lmconf | 26 - erts/emulator/sys/ose/driver_int.h | 42 - erts/emulator/sys/ose/erl_main.c | 54 - erts/emulator/sys/ose/erl_ose_sys.h | 356 ------ erts/emulator/sys/ose/erl_ose_sys_ddll.c | 127 -- erts/emulator/sys/ose/erl_poll.c | 818 ------------ erts/emulator/sys/ose/erts.sig | 17 - erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf | 182 --- erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf | 242 ---- erts/emulator/sys/ose/sys.c | 1847 ---------------------------- erts/emulator/sys/ose/sys_float.c | 845 ------------- erts/emulator/sys/ose/sys_time.c | 57 - erts/emulator/test/emulator.spec.ose | 2 - erts/epmd/src/Makefile.in | 37 +- erts/epmd/src/epmd.c | 2 +- erts/epmd/src/epmd_int.h | 18 +- erts/epmd/src/epmd_srv.c | 7 +- erts/etc/common/Makefile.in | 83 +- erts/etc/common/run_erl_common.c | 696 ----------- erts/etc/common/run_erl_common.h | 97 -- erts/etc/common/run_erl_vsn.h | 30 - erts/etc/common/safe_string.c | 123 -- erts/etc/common/safe_string.h | 65 - erts/etc/common/to_erl_common.c | 717 ----------- erts/etc/common/to_erl_common.h | 29 - erts/etc/ose/etc.lmconf | 20 - erts/etc/ose/run_erl.c | 664 ---------- erts/etc/ose/run_erl.h | 30 - erts/etc/ose/run_erl_main.c | 80 -- erts/etc/unix/run_erl.c | 610 ++++++++- erts/etc/unix/run_erl.h | 31 + erts/etc/unix/safe_string.c | 124 ++ erts/etc/unix/safe_string.h | 66 + erts/etc/unix/to_erl.c | 591 ++++++++- erts/include/internal/ethr_mutex.h | 8 +- erts/include/internal/ethread.h | 96 +- erts/include/internal/ose/ethr_event.h | 114 -- erts/lib_src/common/erl_misc_utils.c | 6 - erts/lib_src/common/ethr_aux.c | 15 - erts/lib_src/common/ethr_mutex.c | 2 +- erts/lib_src/ose/ethr_event.c | 220 ---- erts/lib_src/ose/ethread.c | 833 ------------- lib/Makefile | 2 +- lib/asn1/c_src/Makefile | 7 - lib/crypto/Makefile | 4 - lib/crypto/c_src/Makefile.in | 7 - lib/crypto/c_src/crypto.c | 132 -- lib/crypto/test/crypto_SUITE.erl | 6 +- lib/hipe/cerl/erl_bif_types.erl | 3 +- lib/kernel/doc/src/notes.xml | 3 +- lib/kernel/doc/src/ref_man.xml.src | 68 - lib/kernel/src/inet_config.erl | 3 - lib/kernel/src/os.erl | 2 +- lib/kernel/test/erl_prim_loader_SUITE.erl | 71 +- lib/kernel/test/file_SUITE.erl | 22 +- lib/kernel/test/gen_tcp_misc_SUITE.erl | 16 - lib/kernel/test/prim_file_SUITE.erl | 12 +- lib/ose/Makefile | 37 - lib/ose/doc/html/.gitignore | 0 lib/ose/doc/man3/.gitignore | 0 lib/ose/doc/man6/.gitignore | 0 lib/ose/doc/pdf/.gitignore | 0 lib/ose/doc/src/.gitignore | 1 - lib/ose/doc/src/Makefile | 133 -- lib/ose/doc/src/book.xml | 49 - lib/ose/doc/src/notes.xml | 109 -- lib/ose/doc/src/ose_app.xml | 38 - lib/ose/doc/src/ose_erl_driver.xml | 111 -- lib/ose/doc/src/ose_intro.xml | 154 --- lib/ose/doc/src/ose_signals_chapter.xml | 240 ---- lib/ose/doc/src/part.xml | 39 - lib/ose/doc/src/ref_man.xml | 40 - lib/ose/ebin/.gitignore | 0 lib/ose/include/.gitignore | 0 lib/ose/info | 2 - lib/ose/src/Makefile | 107 -- lib/ose/src/ose.app.src | 28 - lib/ose/src/ose.appup.src | 23 - lib/ose/src/ose.erl | 453 ------- lib/ose/test/Makefile | 67 - lib/ose/test/ose.cover | 2 - lib/ose/test/ose.spec | 1 - lib/ose/test/ose_SUITE.erl | 766 ------------ lib/ose/vsn.mk | 1 - lib/runtime_tools/c_src/Makefile.in | 7 - lib/stdlib/src/slave.erl | 23 +- lib/stdlib/test/filename_SUITE.erl | 35 +- lib/tools/c_src/Makefile.in | 8 - make/ose_lm.mk.in | 76 -- make/otp.mk.in | 10 +- xcomp/erl-xcomp-powerpc-ose5.conf | 358 ------ xcomp/erl-xcomp-sfk-linux-ose5.conf | 305 ----- xcomp/erl-xcomp-vars.sh | 2 +- 118 files changed, 1496 insertions(+), 15115 deletions(-) delete mode 100644 erts/emulator/drivers/ose/ose_efile.c delete mode 100644 erts/emulator/drivers/ose/ose_signal_drv.c delete mode 100644 erts/emulator/drivers/ose/ttsl_drv.c delete mode 100644 erts/emulator/sys/ose/beam.lmconf delete mode 100644 erts/emulator/sys/ose/driver_int.h delete mode 100644 erts/emulator/sys/ose/erl_main.c delete mode 100644 erts/emulator/sys/ose/erl_ose_sys.h delete mode 100644 erts/emulator/sys/ose/erl_ose_sys_ddll.c delete mode 100644 erts/emulator/sys/ose/erl_poll.c delete mode 100644 erts/emulator/sys/ose/erts.sig delete mode 100644 erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf delete mode 100644 erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf delete mode 100644 erts/emulator/sys/ose/sys.c delete mode 100644 erts/emulator/sys/ose/sys_float.c delete mode 100644 erts/emulator/sys/ose/sys_time.c delete mode 100644 erts/emulator/test/emulator.spec.ose delete mode 100644 erts/etc/common/run_erl_common.c delete mode 100644 erts/etc/common/run_erl_common.h delete mode 100644 erts/etc/common/run_erl_vsn.h delete mode 100644 erts/etc/common/safe_string.c delete mode 100644 erts/etc/common/safe_string.h delete mode 100644 erts/etc/common/to_erl_common.c delete mode 100644 erts/etc/common/to_erl_common.h delete mode 100644 erts/etc/ose/etc.lmconf delete mode 100644 erts/etc/ose/run_erl.c delete mode 100644 erts/etc/ose/run_erl.h delete mode 100644 erts/etc/ose/run_erl_main.c create mode 100644 erts/etc/unix/run_erl.h create mode 100644 erts/etc/unix/safe_string.c create mode 100644 erts/etc/unix/safe_string.h delete mode 100644 erts/include/internal/ose/ethr_event.h delete mode 100644 erts/lib_src/ose/ethr_event.c delete mode 100644 erts/lib_src/ose/ethread.c delete mode 100644 lib/kernel/doc/src/ref_man.xml.src delete mode 100644 lib/ose/Makefile delete mode 100644 lib/ose/doc/html/.gitignore delete mode 100644 lib/ose/doc/man3/.gitignore delete mode 100644 lib/ose/doc/man6/.gitignore delete mode 100644 lib/ose/doc/pdf/.gitignore delete mode 100644 lib/ose/doc/src/.gitignore delete mode 100644 lib/ose/doc/src/Makefile delete mode 100644 lib/ose/doc/src/book.xml delete mode 100644 lib/ose/doc/src/notes.xml delete mode 100644 lib/ose/doc/src/ose_app.xml delete mode 100644 lib/ose/doc/src/ose_erl_driver.xml delete mode 100644 lib/ose/doc/src/ose_intro.xml delete mode 100644 lib/ose/doc/src/ose_signals_chapter.xml delete mode 100644 lib/ose/doc/src/part.xml delete mode 100644 lib/ose/doc/src/ref_man.xml delete mode 100644 lib/ose/ebin/.gitignore delete mode 100644 lib/ose/include/.gitignore delete mode 100644 lib/ose/info delete mode 100644 lib/ose/src/Makefile delete mode 100644 lib/ose/src/ose.app.src delete mode 100644 lib/ose/src/ose.appup.src delete mode 100644 lib/ose/src/ose.erl delete mode 100644 lib/ose/test/Makefile delete mode 100644 lib/ose/test/ose.cover delete mode 100644 lib/ose/test/ose.spec delete mode 100644 lib/ose/test/ose_SUITE.erl delete mode 100644 lib/ose/vsn.mk delete mode 100644 make/ose_lm.mk.in delete mode 100644 xcomp/erl-xcomp-powerpc-ose5.conf delete mode 100644 xcomp/erl-xcomp-sfk-linux-ose5.conf diff --git a/HOWTO/INSTALL-CROSS.md b/HOWTO/INSTALL-CROSS.md index 224f238fd0..0c984a825d 100644 --- a/HOWTO/INSTALL-CROSS.md +++ b/HOWTO/INSTALL-CROSS.md @@ -520,29 +520,6 @@ 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 --------------------- diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 01541aff72..fc2078025e 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -74,21 +74,6 @@ 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, @@ -503,8 +488,6 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include #include -#elif __OSE__ -#error "no ipv6" #else #include #endif], @@ -517,8 +500,6 @@ else #ifdef __WIN32__ #include #include -#elif __OSE__ -#error "no ipv6" #else #include #endif], @@ -985,12 +966,6 @@ 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= @@ -1577,22 +1552,9 @@ case "$THR_LIB_NAME" in fi ;; - 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 + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1651,7 +1613,6 @@ 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" @@ -1696,7 +1657,6 @@ 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, \ @@ -1916,8 +1876,6 @@ case "$THR_LIB_NAME" in esac CFLAGS=$old_CFLAGS - fi ## test "x$THR_LIB_NAME" = "xpthread" - if test "X$disable_native_ethr_impls" = "Xyes"; then ethr_have_native_atomics=no else diff --git a/erts/configure.in b/erts/configure.in index 293ff825f8..6950915a6a 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -897,10 +897,7 @@ 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" -case $host in - *ose) ;; - *) LD='$(CC)' ;; -esac +LD='$(CC)' AC_SUBST(LD) LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" @@ -915,8 +912,6 @@ 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 @@ -1225,7 +1220,7 @@ case "$enable_threads"-"$found_threads" in AC_MSG_RESULT(yes; enabled by user) ;; unknown-yes) case $host_os in - solaris*|linux*|darwin*|win32|ose) + solaris*|linux*|darwin*|win32) emu_threads=yes AC_MSG_RESULT(yes; default on this platform) ;; @@ -1307,7 +1302,7 @@ else enable_child_waiter_thread=no fi ;; - win32|ose) + win32) # Child waiter thread cannot be enabled disable_child_waiter_thread=yes enable_child_waiter_thread=no @@ -2071,7 +2066,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 \ - memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ + mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll mlockall ppoll]) @@ -2123,17 +2118,6 @@ 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 ]) disable_vfork=false @@ -4887,7 +4871,6 @@ 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 30772c68fe..32fc9e13a4 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -246,14 +246,10 @@ typedef struct erl_drv_entry { something that the WaitForMultipleObjects API function understands). (Some trickery in the emulator allows more than the built-in limit of 64 Events to be used.)

-

On Enea OSE the event is one or more signals that can - be retrieved using erl_drv_ose_get_signal.

To use this with threads and asynchronous routines, create a - pipe on unix, an Event on Windows or a unique signal number on - Enea OSE. When the routine + pipe on unix and an Event on Windows. When the routine completes, write to the pipe (use SetEvent on - Windows or send a message to the emulator process on Enea OSE), - this will make the emulator call + Windows), this will make the emulator call ready_input or ready_output.

Spurious events may happen. That is, calls to ready_input or ready_output even though no real events are signaled. In diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 1f7fe0f961..3bf18ae8d0 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -1044,9 +1044,7 @@ typedef struct ErlIOVec { select/poll can use). On windows, the Win32 API function WaitForMultipleObjects is used. This places other restrictions on the event object. - Refer to the Win32 SDK documentation. - On Enea OSE, the receive function is used. See the for more details.

+ Refer to the Win32 SDK documentation.

The on parameter should be 1 for setting events and 0 for clearing them.

The mode argument is a bitwise-or combination of @@ -1058,7 +1056,7 @@ typedef struct ErlIOVec { ready_output.

-

Some OS (Windows and Enea OSE) do not differentiate between read and write events. +

Some OS (Windows) do not differentiate between read and write events. The call-back for a fired event then only depends on the value of mode.

ERL_DRV_USE specifies if we are using the event object or if we want to close it. diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 37f0aa289e..e77532463e 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1054,7 +1054,7 @@ Print a term on standard output

Prints a text representation of Term on the standard - output. On OSE the term is printed to the ramlog.

+ output.

This BIF is intended for debugging only.

 diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml index 0a5b2c6136..faec3c68c1 100644 --- a/erts/doc/src/run_erl.xml +++ b/erts/doc/src/run_erl.xml @@ -59,7 +59,7 @@ first argument to run_erl on the command line. pipe_dir This is where to put the named pipe, usually - on Unix or on OSE. It shall be suffixed by a (slash), + . It shall be suffixed by a (slash), i.e. not , but . log_dir This is where the log files are written. There will be one diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index a919f0e3ac..c5080d5b5d 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -23,10 +23,6 @@ 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@ DTRACE_ENABLED=@DTRACE_ENABLED@ @@ -245,9 +241,7 @@ HCC = @HCC@ LD = @LD@ DEXPORT = @DEXPORT@ RANLIB = @RANLIB@ -ifneq ($(findstring ose,$(TARGET)),ose) STRIP = strip -endif PERL = @PERL@ RM = @RM@ MKDIR = @MKDIR@ @@ -684,14 +678,6 @@ $(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 $@ @@ -809,29 +795,6 @@ OS_OBJS = \ $(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 \ @@ -849,7 +812,6 @@ DRV_OBJS = \ $(OBJDIR)/ram_file_drv.o \ $(OBJDIR)/ttsl_drv.o endif -endif ifneq ($(STATIC_NIFS),no) STATIC_NIF_LIBS = $(STATIC_NIFS) @@ -1021,12 +983,6 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(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) $(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ @@ -1034,7 +990,6 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS) endif -endif # ---------------------------------------------------------------------- # Dependencies diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index f9a2f3e33e..6328b3d18f 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -437,13 +437,6 @@ atom orelse atom os_pid atom os_type atom os_version -atom ose_bg_proc -atom ose_int_proc -atom ose_phantom -atom ose_pri_proc -atom ose_process_prio -atom ose_process_type -atom ose_ti_proc atom out atom out_exited atom out_exiting diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 1d5dec4807..4804fb407d 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -394,21 +394,6 @@ type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf +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_async.c b/erts/emulator/beam/erl_async.c index f071898046..be0bc0cfec 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -167,7 +167,6 @@ async_ready_q(Uint sched_id) #endif - void erts_init_async(void) { diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index ef2d41e7a2..e71b87803b 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -690,16 +690,6 @@ 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_port_task.c b/erts/emulator/beam/erl_port_task.c index 5c38db1cbc..2c09834d19 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1734,7 +1734,7 @@ 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/ose drivers use ->ready_input + /* NOTE some windows drivers use ->ready_input for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 135f09c04d..5b13f74dcb 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -58,11 +58,7 @@ #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 @@ -152,12 +148,7 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; -#ifdef __OSE__ -/* Eager check I/O not supported on OSE yet. */ -int erts_eager_check_io = 0; -#else int erts_eager_check_io = 1; -#endif int erts_sched_compact_load; int erts_sched_balance_util = 0; Uint erts_no_schedulers; @@ -2521,19 +2512,10 @@ try_set_sys_scheduling(void) #endif static ERTS_INLINE int -prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking) +prepare_for_sys_schedule(int non_blocking) { if (non_blocking && erts_eager_check_io) { #ifdef ERTS_SMP -#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); - wake_scheduler(rq); - return 0; - } -#endif return try_set_sys_scheduling(); #else return 1; @@ -2543,16 +2525,6 @@ prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking) #ifdef ERTS_SMP while (!erts_port_task_have_outstanding_io_tasks() && try_set_sys_scheduling()) { -#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(); @@ -2876,8 +2848,6 @@ 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) { @@ -2945,7 +2915,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(esdp, 0)) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) { sched_waiting(esdp->no, rq); @@ -3010,8 +2980,6 @@ 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); @@ -3082,13 +3050,8 @@ 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); - erts_smp_runq_unlock(rq); ASSERT(working); @@ -3158,7 +3121,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(esdp, 0)) { + if (!prepare_for_sys_schedule(0)) { spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT; goto tse_wait; } @@ -3180,7 +3143,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(esdp, 0)) { + if (!prepare_for_sys_schedule(0)) { /* * Not allowed to wait in erl_sys_schedule; * do tse wait instead... @@ -5301,17 +5264,11 @@ 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 @@ -8187,18 +8144,12 @@ erts_start_schedulers(void) erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1); -#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) { break; } } - erts_no_schedulers = actual; #ifdef ERTS_DIRTY_SCHEDULERS @@ -8227,10 +8178,6 @@ erts_start_schedulers(void) erts_snprintf(opts.name, 16, "aux"); -#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"); @@ -8250,7 +8197,6 @@ erts_start_schedulers(void) actual, actual == 1 ? " was" : "s were"); erts_send_error_to_logger_nogl(dsbufp); } - } #endif /* ERTS_SMP */ @@ -9391,12 +9337,10 @@ Process *schedule(Process *p, int calls) 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 | ERTS_SCHED_FAIR) { + if (aux_work | leader_update) { 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); @@ -9472,7 +9416,7 @@ Process *schedule(Process *p, int calls) } else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && (fcalls > input_reductions && - prepare_for_sys_schedule(esdp, !0))) { + prepare_for_sys_schedule(!0))) { ErtsMonotonicTime current_time; /* * Schedule system-level activities. diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 20ffe7ea7c..caac89c087 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -691,13 +691,6 @@ 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 diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index e1b03a057f..3a74d752fe 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -3297,8 +3297,6 @@ 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 @@ -3453,9 +3451,6 @@ 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; thr_opts.name = "sys_msg_dispatcher"; init_smq_element_alloc(); @@ -3463,7 +3458,6 @@ init_sys_msg_dispatcher(void) sys_message_queue_end = NULL; erts_smp_cnd_init(&smq_cnd); erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); - erts_smp_thr_create(&sys_msg_dispatcher_tid, sys_msg_dispatcher_func, NULL, diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 6b4b90cb06..d754fc634e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -52,9 +52,7 @@ #include "erl_hl_timer.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 */ @@ -2794,9 +2792,7 @@ 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++) diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 14eeb0ee8f..34011147d9 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -74,9 +74,7 @@ #if defined (__WIN32__) # include "erl_win_sys.h" -#elif defined (__OSE__) -# include "erl_ose_sys.h" -#else +#else # include "erl_unix_sys.h" #ifndef UNIX # define UNIX 1 diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 0317a95e8b..2cb4662fc3 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -101,15 +101,9 @@ # include "config.h" #endif -#ifndef __OSE__ #include #include #include -#else -#include "ctype.h" -#include "sys/types.h" -#include "stdlib.h" -#endif /* Need (NON)BLOCKING macros for sendfile */ #ifndef WANT_NONBLOCKING diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 549de6503c..31b4b22081 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -94,10 +94,6 @@ typedef unsigned long long llu_t; #define INT16_MAX (32767) #endif -#ifdef __OSE__ -#include "inet.h" -#endif - #ifdef __WIN32__ #define STRNCASECMP strncasecmp @@ -298,139 +294,7 @@ static unsigned long one_value = 1; #define TCP_SHUT_RD SD_RECEIVE #define TCP_SHUT_RDWR SD_BOTH -#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) - -#define TCP_SHUT_WR SHUT_WR -#define TCP_SHUT_RD SHUT_RD -#define TCP_SHUT_RDWR SHUT_RDWR - -#else /* !__OSE__ && !__WIN32__ */ +#else /* !__WIN32__ */ #include #ifdef NETDB_H_NEEDS_IN_H @@ -704,7 +568,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define TCP_SHUT_RD SHUT_RD #define TCP_SHUT_RDWR SHUT_RDWR -#endif /* !__WIN32__ && !__OSE__ */ +#endif /* !__WIN32__ */ #ifdef HAVE_SOCKLEN_T # define SOCKLEN_T socklen_t @@ -1166,13 +1030,6 @@ 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; @@ -1188,10 +1045,8 @@ 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); @@ -1204,71 +1059,6 @@ static void tcp_inet_event(ErlDrvData, ErlDrvEvent); static void find_dynamic_functions(void); #endif -#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 !! */ @@ -1278,9 +1068,6 @@ 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, @@ -1288,17 +1075,9 @@ 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, @@ -1450,14 +1229,6 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event); /* convert descriptor pointer 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) @@ -4353,16 +4124,6 @@ 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. @@ -4372,7 +4133,6 @@ 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; @@ -4414,65 +4174,6 @@ 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) { @@ -4555,9 +4256,6 @@ 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; @@ -4581,13 +4279,7 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, 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); @@ -4605,12 +4297,6 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, sz = sizeof(name); 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 } } @@ -8404,15 +8090,6 @@ 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; } @@ -9139,10 +8816,6 @@ 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; } @@ -9204,23 +8877,6 @@ 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, char* buf, ErlDrvSizeT len, @@ -9662,17 +9318,6 @@ 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) { tcp_descriptor* desc = (tcp_descriptor*)e; @@ -9745,22 +9390,6 @@ 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 @@ -10309,146 +9938,7 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event) return; } -#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__ */ +#endif /* __WIN32__ */ /* socket has input: @@ -10935,49 +10425,6 @@ static void tcp_shutdown_async(tcp_descriptor* desc) desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE; } -#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); @@ -10987,7 +10434,6 @@ 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 ? @@ -11053,13 +10499,6 @@ 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)); @@ -11087,12 +10526,6 @@ 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) { diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c deleted file mode 100644 index c8337a95d5..0000000000 --- a/erts/emulator/drivers/ose/ose_efile.c +++ /dev/null @@ -1,1125 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * 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 ./ - * 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 deleted file mode 100644 index 2be9462a47..0000000000 --- a/erts/emulator/drivers/ose/ose_signal_drv.c +++ /dev/null @@ -1,897 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#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 deleted file mode 100644 index f759b47984..0000000000 --- a/erts/emulator/drivers/ose/ttsl_drv.c +++ /dev/null @@ -1,69 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * 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/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 105b129065..f87196d724 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1337,11 +1337,7 @@ 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) GET_FD(fd), @@ -1861,25 +1857,6 @@ 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; @@ -1891,7 +1868,6 @@ 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) { diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 19ce582154..6d8aef822e 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -93,7 +93,7 @@ # if defined(ERTS_USE_POLL) # undef ERTS_POLL_USE_POLL # define ERTS_POLL_USE_POLL 1 -# elif !defined(__WIN32__) && !defined(__OSE__) +# elif !defined(__WIN32__) # undef ERTS_POLL_USE_SELECT # define ERTS_POLL_USE_SELECT 1 # endif @@ -104,31 +104,13 @@ typedef Uint32 ErtsPollEvents; #undef ERTS_POLL_EV_E2N -#if defined(__WIN32__) || defined(__OSE__) /* --- win32 or ose -------- */ +#if defined(__WIN32__) /* --- win32 --------------------------------------- */ #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 diff --git a/erts/emulator/sys/ose/beam.lmconf b/erts/emulator/sys/ose/beam.lmconf deleted file mode 100644 index 4ad46b01d9..0000000000 --- a/erts/emulator/sys/ose/beam.lmconf +++ /dev/null @@ -1,26 +0,0 @@ -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 deleted file mode 100644 index 4a5b7171d1..0000000000 --- a/erts/emulator/sys/ose/driver_int.h +++ /dev/null @@ -1,42 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * System dependant driver declarations - */ - -#ifndef __DRIVER_INT_H__ -#define __DRIVER_INT_H__ - -#ifdef HAVE_SYS_UIO_H -#include -#include - -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 deleted file mode 100644 index 877e85f43a..0000000000 --- a/erts/emulator/sys/ose/erl_main.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#include - -#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 deleted file mode 100644 index d0cd3180bf..0000000000 --- a/erts/emulator/sys/ose/erl_ose_sys.h +++ /dev/null @@ -1,356 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - * 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 - -#define erts_isfinite finite - -#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 deleted file mode 100644 index 5051f7fcc1..0000000000 --- a/erts/emulator/sys/ose/erl_ose_sys_ddll.c +++ /dev/null @@ -1,127 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * 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 deleted file mode 100644 index 5cee582a00..0000000000 --- a/erts/emulator/sys/ose/erl_poll.c +++ /dev/null @@ -1,818 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2006-2012. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * 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_atomic64_t timeout_time; -#ifdef ERTS_SMP - erts_smp_mtx_t mtx; -#endif -}; - -static int max_fds = -1; - -static ERTS_INLINE void -init_timeout_time(ErtsPollSet ps) -{ - erts_atomic64_init_nob(&ps->timeout_time, - (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX); -} - -static ERTS_INLINE void -set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time) -{ - erts_atomic64_set_relb(&ps->timeout_time, - (erts_aint64_t) time); -} - -static ERTS_INLINE ErtsMonotonicTime -get_timeout_time(ErtsPollSet ps) -{ - return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time); -} - -#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, - ErtsTimeoutTime timeout_time) { - HARDTRACEF("erts_poll_interrupt_timed called!\n"); - - if (!set) - reset_interrupt(ps); - else if (get_timeout_time(ps) > timeout_time) - 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, - ErtsMonotonicTime timeout_time) -{ - int res = ETIMEDOUT, no_fds, currid = 0; - OSTIME timeout; - union SIGNAL *sig; - ErtsMonotonicTime current_time, diff_time, timeout; - // 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; - - /* erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n", - timeout_time); */ - - if (timeout_time == ERTS_POLL_NO_TIMEOUT) { - no_timeout: - timeout = (OSTIME) 0; - save_timeout_time = ERTS_MONOTONIC_TIME_MIN; - } - else { - ErtsMonotonicTime current_time, diff_time; - current_time = erts_get_monotonic_time(NULL); - diff_time = timeout_time - current_time; - if (diff_time <= 0) - goto no_timeout; - diff_time = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1); - if (diff_time > INT_MAX) - diff_time = INT_MAX; - timeout = (OSTIME) diff_time; - save_timeout_time = current_time; - save_timeout_time += ERTS_MSEC_TO_MONOTONIC(diff_time); - } - - set_timeout_time(ps, save_timeout_time); - - 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); - set_timeout_time(ps, ERTS_MONOTONIC_TIME_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); - init_timeout_time(ps); -#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 deleted file mode 100644 index 78b883ee6c..0000000000 --- a/erts/emulator/sys/ose/erts.sig +++ /dev/null @@ -1,17 +0,0 @@ -#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 deleted file mode 100644 index a19d23facf..0000000000 --- a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf +++ /dev/null @@ -1,182 +0,0 @@ -/******************************************************************************* - * 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 deleted file mode 100644 index 3440c2961b..0000000000 --- a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf +++ /dev/null @@ -1,242 +0,0 @@ -/******************************************************************************* - * 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 deleted file mode 100644 index bcd0ffa0b6..0000000000 --- a/erts/emulator/sys/ose/sys.c +++ /dev/null @@ -1,1847 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#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, ErtsMonotonicTime timeout_time) -{ - ERTS_CHK_IO_INTR_TMD(set, timeout_time); -} -#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#" ",,,," */ - 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 deleted file mode 100644 index 3d9abc6bd1..0000000000 --- a/erts/emulator/sys/ose/sys_float.c +++ /dev/null @@ -1,845 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#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 - -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 -#include - -/* - * 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 -#include -#elif defined(__FreeBSD__) && defined(__i386__) -#include -#include -#elif defined(__DARWIN__) -#include -#elif defined(__OpenBSD__) && defined(__x86_64__) -#include -#include -#endif -#if !(defined(__OpenBSD__) && defined(__x86_64__)) -#include -#endif -#include - -#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 deleted file mode 100644 index 5dac75956a..0000000000 --- a/erts/emulator/sys/ose/sys_time.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#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/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose deleted file mode 100644 index 9f494609d9..0000000000 --- a/erts/emulator/test/emulator.spec.ose +++ /dev/null @@ -1,2 +0,0 @@ -{topcase, {dir, "../emulator_test"}}. -{skip, {obsolete_SUITE, "Not on ose"}}. diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in index b6e3ba7762..1266be44cb 100644 --- a/erts/epmd/src/Makefile.in +++ b/erts/epmd/src/Makefile.in @@ -19,10 +19,6 @@ # include $(ERL_TOP)/make/target.mk -ifeq ($(findstring ose,$(TARGET)),ose) -include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk -endif - ifeq ($(TYPE),debug) PURIFY = TYPEMARKER = .debug @@ -32,21 +28,13 @@ else ifeq ($(TYPE),purify) PURIFY = purify TYPEMARKER = -ifeq ($(findstring ose,$(TARGET)),ose) - TYPE_FLAGS = -DPURIFY -else - TYPE_FLAGS = -O2 -DPURIFY -endif +TYPE_FLAGS = -O2 -DPURIFY else override TYPE = opt PURIFY = TYPEMARKER = -ifeq ($(findstring ose,$(TARGET)),ose) - TYPE_FLAGS = -else - TYPE_FLAGS = -O2 -endif +TYPE_FLAGS = -O2 endif endif @@ -68,13 +56,9 @@ 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 @@ -82,11 +66,7 @@ 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@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS) -endif LDFLAGS = @LDFLAGS@ @@ -135,25 +115,12 @@ 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 132bda725c..7c373509be 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -397,7 +397,7 @@ static void run_daemon(EpmdVars *g) } #endif -#if defined(VXWORKS) || defined(__OSE__) +#if defined(VXWORKS) static void run_daemon(EpmdVars *g) { run(g); diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index 26100afc93..e222abb4b7 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -37,13 +37,6 @@ #define DONT_USE_MAIN #endif -#ifdef __OSE__ -# define NO_DAEMON -# define NO_SYSLOG -# define NO_SYSCONF -# define NO_FCNTL -#endif - /* ************************************************************************ */ /* Standard includes */ @@ -100,12 +93,7 @@ #endif /* ! WIN32 */ #include - -#if !defined(__OSE__) -# include -#endif - - +#include #include #ifdef HAVE_SYSLOG_H @@ -122,10 +110,6 @@ #include -#ifdef __OSE__ -# include "sys/select.h" -#endif - #ifdef HAVE_SYSTEMD_DAEMON # include #endif /* HAVE_SYSTEMD_DAEMON */ diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 8c8d7304f2..829eb4c74d 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -30,11 +30,6 @@ # 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 @@ -315,7 +310,7 @@ void run(EpmdVars *g) } #endif /* HAVE_SYSTEMD_DAEMON */ -#if !defined(__WIN32__) && !defined(__OSE__) +#if !defined(__WIN32__) /* 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); diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in index 8e55fa78c9..05d925f19f 100644 --- a/erts/etc/common/Makefile.in +++ b/erts/etc/common/Makefile.in @@ -21,10 +21,6 @@ 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@ @@ -85,18 +81,13 @@ EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@ SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@ DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@ UXETC = ../unix -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 @@ -180,25 +171,6 @@ PORT_ENTRY_POINT=erl_port_entry ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT) 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= @@ -223,7 +195,6 @@ INSTALL_PROGS = \ $(BINDIR)/$(ERLEXEC) \ $(INSTALL_EMBEDDED_PROGS) endif -endif .PHONY: etc etc: $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN) @@ -269,8 +240,8 @@ endif 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)/run_erl_common.o - rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl_common.o + 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)/typer.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/ct_run.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o @@ -423,28 +394,24 @@ $(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) # 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 $< +$(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: $(ETC)/run_erl.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/run_erl.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 $< +$(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: $(ETC)/to_erl.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/to_erl.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: $(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 +$(OBJDIR)/safe_string.o: $(ETC)/safe_string.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/safe_string.c ifneq ($(TARGET),win32) $(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) @@ -499,30 +466,6 @@ erl.src: $(UXETC)/erl.src.src ../../vsn.mk $(TARGET)/Makefile -e 's;%VSN%;$(VSN);' \ $(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 # ---------------------------------------------------- @@ -537,11 +480,9 @@ endif $(INSTALL_DIR) "$(RELEASE_PATH)/erts-$(VSN)/bin" ifneq ($(TARGET), win32) ifneq ($(findstring vxworks,$(TARGET)), vxworks) -ifneq ($(findstring ose,$(TARGET)), ose) $(INSTALL_SCRIPT) erl.src "$(RELEASE_PATH)/erts-$(VSN)/bin" endif endif -endif ifneq ($(INSTALL_PROGS),) $(INSTALL_PROGRAM) $(INSTALL_PROGS) "$(RELEASE_PATH)/erts-$(VSN)/bin" endif diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c deleted file mode 100644 index c03d5e3ae2..0000000000 --- a/erts/etc/common/run_erl_common.c +++ /dev/null @@ -1,696 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2014. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef __ANDROID__ -# include -#endif - -#ifdef HAVE_SYSLOG_H -# include -#endif - -#ifdef HAVE_SYS_IOCTL_H -# include -#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. - */ - -#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; -}; - -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 - -/* 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, int mfd) -{ - 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 deleted file mode 100644 index cecf7521f9..0000000000 --- a/erts/etc/common/run_erl_common.h +++ /dev/null @@ -1,97 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * 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 -#include -#include - -#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, int mfd); - -/* 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/common/run_erl_vsn.h b/erts/etc/common/run_erl_vsn.h deleted file mode 100644 index 2c3e67e81c..0000000000 --- a/erts/etc/common/run_erl_vsn.h +++ /dev/null @@ -1,30 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * The protocol version number used between to_erl and run_erl. - */ -#define RUN_ERL_HI_VER 1 /* My preferred protocol version */ -#define RUN_ERL_LO_VER 0 /* The lowest version I accept to talk with */ - -/* Version history: - * 0: Older, without version handshake - * 1: R12B-3, version handshake + window size ctrl - */ diff --git a/erts/etc/common/safe_string.c b/erts/etc/common/safe_string.c deleted file mode 100644 index cdcdbf16f0..0000000000 --- a/erts/etc/common/safe_string.c +++ /dev/null @@ -1,123 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: safe_string.c - * - * This is a bunch of generic string operation - * that are safe regarding buffer overflow. - * - * All string functions terminate the process with an error message - * on buffer overflow. - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#include "safe_string.h" -#include -#include -#include -#include - - -static void string_overflow_handler(const char* format, ...) -{ - va_list args; - va_start(args, format); - vfprintf(stderr,format,args); - va_end(args); - exit(1); -} - -int vsn_printf(char* dst, size_t size, const char* format, va_list args) -{ - int ret = vsnprintf(dst, size, format, args); - if (ret >= size || ret < 0) { - string_overflow_handler("Buffer truncated '%s'\n",dst); - } - return ret; -} - -int sn_printf(char* dst, size_t size, const char* format, ...) -{ - va_list args; - int ret; - va_start(args, format); - ret = vsn_printf(dst,size,format,args); - va_end(args); - return ret; -} - -int strn_cpy(char* dst, size_t size, const char* src) -{ - return sn_printf(dst,size,"%s",src); -} - -int strn_cat(char* dst, size_t size, const char* src) -{ - return strn_catf(dst,size,"%s",src); -} - -int strn_catf(char* dst, size_t size, const char* format, ...) -{ - int ret; - va_list args; -#ifdef _GNU_SOURCE - int len = strnlen(dst,size); -#else - int len = strlen(dst); -#endif - - if (len >= size) { - string_overflow_handler("Buffer already overflowed '%.*s'\n", - size, dst); - } - va_start(args, format); - ret = vsn_printf(dst+len, size-len, format, args); - va_end(args); - return len+ret; -} - -char* find_str(const char* haystack, int hsize, const char* needle) -{ - int i = 0; - int nsize = strlen(needle); - hsize -= nsize - 1; - for (i=0; i dest) { - for (i=0; i=0; i--) ((char*)dest)[i] = ((char*)src)[i]; - } - return dest; -} -#endif /* HAVE_MEMMOVE */ diff --git a/erts/etc/common/safe_string.h b/erts/etc/common/safe_string.h deleted file mode 100644 index f9d2b2023a..0000000000 --- a/erts/etc/common/safe_string.h +++ /dev/null @@ -1,65 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: safe_string.h - * - * This is an interface to a bunch of generic string operation - * that are safe regarding buffer overflow. - * - * All string functions terminate the process with an error message - * on buffer overflow. - */ - -#include -#include - -/* Like vsnprintf() - */ -int vsn_printf(char* dst, size_t size, const char* format, va_list args); - -/* Like snprintf() - */ -int sn_printf(char* dst, size_t size, const char* format, ...); - -/* Like strncpy() - * Returns length of copied string. - */ -int strn_cpy(char* dst, size_t size, const char* src); - -/* Almost like strncat() - * size is sizeof entire dst buffer. - * Returns length of resulting string. - */ -int strn_cat(char* dst, size_t size, const char* src); - -/* Combination of strncat() and snprintf() - * size is sizeof entire dst buffer. - * Returns length of resulting string. - */ -int strn_catf(char* dst, size_t size, const char* format, ...); - -/* Simular to strstr() but search size bytes of haystack - * without regard to '\0' characters. - */ -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 deleted file mode 100644 index 8aa94ccfa4..0000000000 --- a/erts/etc/common/to_erl_common.c +++ /dev/null @@ -1,717 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: 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 -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef __OSE__ -#include -#include "ose.h" -#include "efs.h" -#include "ose_spi/fm.sig" -#else /* __UNIX__ */ -#include -#include -#endif - -#ifdef HAVE_SYS_IOCTL_H -# include -#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 deleted file mode 100644 index a139da418f..0000000000 --- a/erts/etc/common/to_erl_common.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef ERL_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 deleted file mode 100644 index b402b325b1..0000000000 --- a/erts/etc/ose/etc.lmconf +++ /dev/null @@ -1,20 +0,0 @@ -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 deleted file mode 100644 index 6775525297..0000000000 --- a/erts/etc/ose/run_erl.c +++ /dev/null @@ -1,664 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: run_erl.c - * - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -/* System includes */ -#include -#include -#include -#include -#include -#include -#include -#include - -/* 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, s->ofd); - - 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 deleted file mode 100644 index bdc8b6c355..0000000000 --- a/erts/etc/ose/run_erl.h +++ /dev/null @@ -1,30 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef ERL_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 deleted file mode 100644 index 8895c773a1..0000000000 --- a/erts/etc/ose/run_erl_main.c +++ /dev/null @@ -1,80 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: 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 - -#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/run_erl.c b/erts/etc/unix/run_erl.c index c8414030ca..44efb975ba 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2015. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -41,13 +41,11 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif - #ifdef HAVE_WORKING_POSIX_OPENPT #ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 #endif #endif - #include #include #include @@ -65,6 +63,11 @@ #include #include #include + +#ifdef __ANDROID__ +# include +#endif + #ifdef HAVE_SYSLOG_H # include #endif @@ -84,25 +87,81 @@ # include #endif -#include "run_erl_common.h" +#include "run_erl.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); @@ -110,11 +169,20 @@ 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. @@ -145,13 +213,29 @@ 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; - char *ptyslave=NULL; + int fd; + char *p, *ptyslave=NULL; int i = 1; int off_argv; + int calculated_pipename = 0; + int highest_pipe_num = 0; program_name = argv[0]; @@ -169,16 +253,122 @@ int main(int argc, char **argv) off_argv = i; strn_cpy(pipename, sizeof(pipename), argv[i++]); - - erts_run_erl_log_init(run_daemon,argv[i]); + strn_cpy(log_dir, sizeof(log_dir), argv[i]); + strn_cpy(statusfile, sizeof(statusfile), log_dir); + strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME); #ifdef DEBUG - erts_run_erl_log_status("%s: pid is : %d\n", argv[0], getpid()); + status("%s: pid is : %d\n", argv[0], getpid()); #endif - /* Open read and write fifo */ - if (erts_run_erl_open_fifo(pipename,fifo1,fifo2)) - exit(1); + /* 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 master pseudo-terminal @@ -250,7 +440,7 @@ int main(int argc, char **argv) sf_close(2); if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { - erts_run_erl_log_status("Cannot dup\n"); + status("Cannot dup\n"); } sf_close(sfd); exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ @@ -293,7 +483,9 @@ static void pass_on(pid_t childpid) struct timeval timeout; time_t last_activity; char buf[BUFSIZ]; - int rfd, wfd=0; + char log_alive_buffer[ALIVE_BUFFSIZ+1]; + int lognum; + int rfd, wfd=0, lfd=0; int maxfd; int ready; int got_some = 0; /* from to_erl */ @@ -308,12 +500,13 @@ static void pass_on(pid_t childpid) } #ifdef DEBUG - erts_run_erl_log_status("run_erl: %s opened for reading\n", fifo2); + status("run_erl: %s opened for reading\n", fifo2); #endif /* Open the log file */ - erts_run_erl_log_open(); + lognum = find_next_log_num(); + lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC); /* Enter the work loop */ @@ -332,8 +525,7 @@ static void pass_on(pid_t childpid) writefds_ptr = &writefds; } time(&last_activity); - /* don't assume old BSD bug */ - timeout.tv_sec = erts_run_erl_log_alive_minutes()*60; + timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */ timeout.tv_usec = 0; ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout); if (ready < 0) { @@ -363,7 +555,28 @@ static void pass_on(pid_t childpid) /* Check how long time we've been inactive */ time(&now); - erts_run_erl_log_activity(!ready,now,last_activity); + 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)); + } } /* @@ -398,7 +611,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(mfd, &readfds)) { #ifdef DEBUG - erts_run_erl_log_status("Pty master read; "); + status("Pty master read; "); #endif if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) { sf_close(rfd); @@ -416,7 +629,7 @@ static void pass_on(pid_t childpid) exit(0); } - erts_run_erl_log_write(buf, len); + write_to_log(&lfd, &lognum, buf, len); /* * Save in the output queue. @@ -432,7 +645,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(rfd, &readfds)) { #ifdef DEBUG - erts_run_erl_log_status("FIFO read; "); + status("FIFO read; "); #endif if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) { sf_close(rfd); @@ -461,7 +674,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) { - erts_run_erl_log_status("Client expected on FIFO %s, but can't open (len=%d)\n", + 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); @@ -473,7 +686,7 @@ static void pass_on(pid_t childpid) } else { #ifdef DEBUG - erts_run_erl_log_status("run_erl: %s opened for writing\n", fifo1); + status("run_erl: %s opened for writing\n", fifo1); #endif } } @@ -489,15 +702,14 @@ static void pass_on(pid_t childpid) /* Write the message */ #ifdef DEBUG - erts_run_erl_log_status("Pty master write; "); + status("Pty master write; "); #endif - len = erts_run_erl_extract_ctrl_seq(buf, len, mfd); + len = extract_ctrl_seq(buf, len); if(len==1 && buf[0] == '\003') { kill(childpid,SIGINT); - } - else if (len>0 && erts_run_erl_write_all(mfd, buf, len) != len) - { + } + else if (len>0 && write_all(mfd, buf, len) != len) { ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); sf_close(rfd); if(wfd) sf_close(wfd); @@ -506,7 +718,7 @@ static void pass_on(pid_t childpid) } } #ifdef DEBUG - erts_run_erl_log_status("OK\n"); + status("OK\n"); #endif } } @@ -516,6 +728,173 @@ 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. @@ -712,9 +1091,9 @@ static void exec_shell(char **argv) else argv[0] = sh; argv[1] = "-c"; - erts_run_erl_log_status("Args before exec of shell:\n"); + status("Args before exec of shell:\n"); for (vp = argv, i = 0; *vp; vp++, i++) - erts_run_erl_log_status("argv[%d] = %s\n", i, *vp); + status("argv[%d] = %s\n", i, *vp); if (stdstatus) { fclose(stdstatus); } @@ -725,6 +1104,26 @@ 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... */ @@ -764,10 +1163,47 @@ 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: "); - fprintf(stderr, RUN_ERL_USAGE, 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; } static void init_outbuf(void) @@ -838,6 +1274,114 @@ 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/run_erl.h b/erts/etc/unix/run_erl.h new file mode 100644 index 0000000000..cc70a98e52 --- /dev/null +++ b/erts/etc/unix/run_erl.h @@ -0,0 +1,31 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * The protocol version number used between to_erl and run_erl. + */ +#define RUN_ERL_HI_VER 1 /* My preferred protocol version */ +#define RUN_ERL_LO_VER 0 /* The lowest version I accept to talk with */ + +/* Version history: + * 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/unix/safe_string.c new file mode 100644 index 0000000000..a5c11d41d8 --- /dev/null +++ b/erts/etc/unix/safe_string.c @@ -0,0 +1,124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.c + * + * This is a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "safe_string.h" +#include +#include +#include +#include + + +static void string_overflow_handler(const char* format, ...) +{ + va_list args; + va_start(args, format); + vfprintf(stderr,format,args); + va_end(args); + exit(1); +} + +int vsn_printf(char* dst, size_t size, const char* format, va_list args) +{ + int ret = vsnprintf(dst, size, format, args); + if (ret >= size || ret < 0) { + string_overflow_handler("Buffer truncated '%s'\n",dst); + } + return ret; +} + +int sn_printf(char* dst, size_t size, const char* format, ...) +{ + va_list args; + int ret; + va_start(args, format); + ret = vsn_printf(dst,size,format,args); + va_end(args); + return ret; +} + +int strn_cpy(char* dst, size_t size, const char* src) +{ + return sn_printf(dst,size,"%s",src); +} + +int strn_cat(char* dst, size_t size, const char* src) +{ + return strn_catf(dst,size,"%s",src); +} + +int strn_catf(char* dst, size_t size, const char* format, ...) +{ + int ret; + va_list args; +#ifdef _GNU_SOURCE + int len = strnlen(dst,size); +#else + int len = strlen(dst); +#endif + + if (len >= size) { + string_overflow_handler("Buffer already overflowed '%.*s'\n", + size, dst); + } + va_start(args, format); + ret = vsn_printf(dst+len, size-len, format, args); + va_end(args); + return len+ret; +} + +char* find_str(const char* haystack, int hsize, const char* needle) +{ + int i = 0; + int nsize = strlen(needle); + hsize -= nsize - 1; + for (i=0; i dest) { + for (i=0; i=0; i--) ((char*)dest)[i] = ((char*)src)[i]; + } + return dest; +} +#endif /* HAVE_MEMMOVE */ + diff --git a/erts/etc/unix/safe_string.h b/erts/etc/unix/safe_string.h new file mode 100644 index 0000000000..5a471f10de --- /dev/null +++ b/erts/etc/unix/safe_string.h @@ -0,0 +1,66 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.h + * + * This is an interface to a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#include +#include + +/* Like vsnprintf() + */ +int vsn_printf(char* dst, size_t size, const char* format, va_list args); + +/* Like snprintf() + */ +int sn_printf(char* dst, size_t size, const char* format, ...); + +/* Like strncpy() + * Returns length of copied string. + */ +int strn_cpy(char* dst, size_t size, const char* src); + +/* Almost like strncat() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_cat(char* dst, size_t size, const char* src); + +/* Combination of strncat() and snprintf() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_catf(char* dst, size_t size, const char* format, ...); + +/* Simular to strstr() but search size bytes of haystack + * without regard to '\0' characters. + */ +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/unix/to_erl.c b/erts/etc/unix/to_erl.c index 82d3218964..0bd469727c 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2015. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -17,9 +17,592 @@ * * %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 +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#ifdef HAVE_SYS_IOCTL_H +# include +#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 ^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"); + } + + /* + * 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 + * | | + * |---------- '\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; +} + -#include "to_erl_common.h" +#ifdef DEBUG +#define S(x) ((x) > 0 ? 1 : 0) -int main(int argc,char **argv) { - return to_erl(argc,argv); +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 diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h index f76c4262ca..b402a139f5 100644 --- a/erts/include/internal/ethr_mutex.h +++ b/erts/include/internal/ethr_mutex.h @@ -98,7 +98,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) || defined(ETHR_OSE_THREADS) +#elif defined(ETHR_PTHREADS) # define ETHR_MTX_Q_LOCK_PTHREAD_MUTEX__ # define ETHR_MTX_QLOCK_TYPE__ pthread_mutex_t #elif defined(ETHR_WIN32_THREADS) @@ -211,7 +211,7 @@ struct ethr_cond_ { #endif }; -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) typedef struct ethr_mutex_ ethr_mutex; struct ethr_mutex_ { @@ -355,7 +355,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__, __func__,#A))) + ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__, #A))) #else #define ETHR_MTX_HARD_ASSERT(A) ((void) 1) #endif @@ -634,7 +634,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) #endif /* ETHR_TRY_INLINE_FUNCS */ -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !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 f9c203e97c..899aa4ad3c 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -193,28 +193,6 @@ 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 -#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__ - #else /* No supported thread lib found */ #ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL @@ -382,19 +360,7 @@ extern ethr_runtime_t ethr_runtime__; #include "ethr_atomics.h" /* The atomics API */ -#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) +#if defined(__GNUC__) # ifndef ETHR_SPIN_BODY # if defined(__i386__) || defined(__x86_64__) # define ETHR_SPIN_BODY __asm__ __volatile__("rep;nop" : : : "memory") @@ -410,20 +376,9 @@ ose_yield(void) # 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 @@ -446,18 +401,13 @@ ose_yield(void) # 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 -#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. - */ +#if defined(VALGRIND) +/* mutex as fallback for spinlock for VALGRIND. */ # undef ETHR_HAVE_NATIVE_SPINLOCKS # undef ETHR_HAVE_NATIVE_RWSPINLOCKS #else @@ -504,16 +454,9 @@ typedef struct { int detached; /* boolean (default false) */ int suggested_stack_size; /* kilo words (default sys dependent) */ char *name; /* max 14 char long (default no-name) */ -#ifdef ETHR_OSE_THREADS - U32 coreNo; -#endif } ethr_thr_opts; -#if defined(ETHR_OSE_THREADS) -#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL, 0} -#else #define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL} -#endif #if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_AUX_IMPL__) # define ETHR_NEED_SPINLOCK_PROTOTYPES__ @@ -627,8 +570,6 @@ typedef struct ethr_ts_event_ ethr_ts_event; /* Needed by ethr_mutex.h */ # include "win/ethr_event.h" #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); @@ -718,37 +659,6 @@ 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/ose/ethr_event.h b/erts/include/internal/ose/ethr_event.h deleted file mode 100644 index c18f30aa4a..0000000000 --- a/erts/include/internal/ose/ethr_event.h +++ /dev/null @@ -1,114 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2009-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * 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 1262c50718..053217304b 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -160,8 +160,6 @@ 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; @@ -320,10 +318,6 @@ 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 0cbb1b2fb8..56fecf81b8 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -207,18 +207,7 @@ 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 @@ -664,10 +653,6 @@ 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 72aa34ec1c..a596e6c31c 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -1250,7 +1250,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return 0; } -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) /* -- pthread mutex and condition variables -------------------------------- */ int diff --git a/erts/lib_src/ose/ethr_event.c b/erts/lib_src/ose/ethr_event.c deleted file mode 100644 index 24ea191c4b..0000000000 --- a/erts/lib_src/ose/ethr_event.c +++ /dev/null @@ -1,220 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * 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 deleted file mode 100644 index dc16acdd08..0000000000 --- a/erts/lib_src/ose/ethread.c +++ /dev/null @@ -1,833 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * 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/lib/Makefile b/lib/Makefile index 34c2fe9a9e..64143a39e0 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -36,7 +36,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 ose + eunit ssh typer percept eldap dialyzer hipe ifdef BUILD_ALL ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index 2b72e1a214..e0d4f09a70 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -97,12 +97,7 @@ 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 @@ -140,9 +135,7 @@ 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/crypto/Makefile b/lib/crypto/Makefile index 24db75bf91..fbf108c410 100644 --- a/lib/crypto/Makefile +++ b/lib/crypto/Makefile @@ -24,11 +24,7 @@ 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 e66c0ca916..e7f750b60a 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -127,12 +127,7 @@ 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) @@ -203,14 +198,12 @@ 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 9de8dc74c2..e9cac30c9c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -507,47 +507,6 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) -#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 - - static int verify_lib_version(void) { const unsigned long libv = SSLeay(); @@ -609,9 +568,6 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) ErlNifBinary lib_bin; char lib_buf[1000]; - if (!INIT_OSE_CRYPTO()) - return 0; - if (!verify_lib_version()) return 0; @@ -853,7 +809,6 @@ 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); } @@ -865,7 +820,6 @@ 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; } @@ -874,7 +828,6 @@ 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)) { @@ -891,7 +844,6 @@ 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); } @@ -904,7 +856,6 @@ 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); } @@ -916,7 +867,6 @@ 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; } @@ -925,7 +875,6 @@ 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)) { @@ -942,7 +891,6 @@ 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); } @@ -956,7 +904,6 @@ 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); } @@ -968,7 +915,6 @@ 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; } @@ -977,7 +923,6 @@ 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); @@ -993,7 +938,6 @@ 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); } @@ -1007,7 +951,6 @@ 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); } @@ -1023,7 +966,6 @@ 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 @@ -1036,7 +978,6 @@ 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); @@ -1056,7 +997,6 @@ 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); } @@ -1073,7 +1013,6 @@ 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); } @@ -1089,7 +1028,6 @@ 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 @@ -1102,7 +1040,6 @@ 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); @@ -1122,7 +1059,6 @@ 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); } @@ -1139,7 +1075,6 @@ 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); } @@ -1155,7 +1090,6 @@ 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 @@ -1168,7 +1102,6 @@ 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); @@ -1188,7 +1121,6 @@ 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); } @@ -1205,7 +1137,6 @@ 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); } @@ -1233,7 +1164,6 @@ 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); @@ -1253,7 +1183,6 @@ 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); } @@ -1270,7 +1199,6 @@ 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); } @@ -1282,7 +1210,6 @@ 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; } @@ -1291,7 +1218,6 @@ 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); @@ -1307,7 +1233,6 @@ 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); } @@ -1322,7 +1247,6 @@ 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) { @@ -1340,7 +1264,6 @@ 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) { @@ -1360,7 +1283,6 @@ 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) { @@ -1383,7 +1305,6 @@ 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) { @@ -1406,7 +1327,6 @@ 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) { @@ -1430,7 +1350,6 @@ 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) { @@ -1462,7 +1381,6 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ const EVP_MD *md; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); if (argv[0] == atom_sha) md = EVP_sha1(); #ifdef HAVE_SHA224 @@ -1502,7 +1420,6 @@ 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)) { @@ -1529,7 +1446,6 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv 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))) { @@ -1564,7 +1480,6 @@ 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 @@ -1587,7 +1502,6 @@ 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 @@ -1607,7 +1521,6 @@ 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); @@ -1627,7 +1540,6 @@ 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 @@ -1657,7 +1569,6 @@ 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 @@ -1714,7 +1625,6 @@ 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 || key.size == 24 || key.size == 32) @@ -1744,7 +1654,6 @@ 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 @@ -1777,7 +1686,6 @@ 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 @@ -1816,7 +1724,6 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char *outp; ERL_NIF_TERM out, out_tag; - 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 @@ -1866,7 +1773,6 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char *outp; ERL_NIF_TERM out; - 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 @@ -1937,7 +1843,6 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER unsigned char poly1305_key[32]; poly1305_state poly1305; - CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN @@ -1991,7 +1896,6 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER unsigned char mac[POLY1305_TAG_LEN]; poly1305_state poly1305; - CHECK_OSE_CRYPTO(); if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN @@ -2045,7 +1949,6 @@ static ERL_NIF_TERM aes_ecb_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) @@ -2074,7 +1977,6 @@ 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); } @@ -2088,7 +1990,6 @@ 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); } @@ -2106,7 +2007,6 @@ 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)) { @@ -2130,7 +2030,6 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned dlen; ERL_NIF_TERM ret; - CHECK_OSE_CRYPTO(); if (!enif_get_uint(env, argv[0], &bits) || !enif_get_int(env, argv[1], &top) @@ -2200,7 +2099,6 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER 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)) { @@ -2233,7 +2131,6 @@ 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) @@ -2277,7 +2174,6 @@ 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)) { @@ -2446,7 +2342,6 @@ 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) { @@ -2508,7 +2403,6 @@ 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) @@ -2569,7 +2463,6 @@ 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) @@ -2607,7 +2500,6 @@ 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) @@ -2629,7 +2521,6 @@ 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)) { @@ -2647,7 +2538,6 @@ 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); @@ -2664,7 +2554,6 @@ 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) @@ -2686,7 +2575,6 @@ static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a 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) @@ -2748,7 +2636,6 @@ 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) { @@ -2816,7 +2703,6 @@ 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)) { @@ -2903,7 +2789,6 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER int padding, i; RSA* rsa; - CHECK_OSE_CRYPTO(); rsa = RSA_new(); @@ -2953,7 +2838,6 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE int padding, i; RSA* rsa; - CHECK_OSE_CRYPTO(); rsa = RSA_new(); @@ -3001,7 +2885,6 @@ 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)) { @@ -3030,7 +2913,6 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] int i; ERL_NIF_TERM ret, head, tail; - CHECK_OSE_CRYPTO(); dh_params = DH_new(); @@ -3066,7 +2948,6 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ - CHECK_OSE_CRYPTO(); dh_params = DH_new(); @@ -3112,7 +2993,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; - CHECK_OSE_CRYPTO(); dh_params = DH_new(); @@ -3154,7 +3034,6 @@ 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) @@ -3216,7 +3095,6 @@ 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) @@ -3297,7 +3175,6 @@ 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) @@ -3359,7 +3236,6 @@ 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) @@ -3384,7 +3260,6 @@ 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) @@ -3409,7 +3284,6 @@ 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) @@ -3431,7 +3305,6 @@ 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) @@ -3756,7 +3629,6 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM priv_key; ERL_NIF_TERM pub_key = atom_undefined; - CHECK_OSE_CRYPTO(); if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key)) goto badarg; @@ -3799,7 +3671,6 @@ 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) { @@ -3868,7 +3739,6 @@ 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) { @@ -3933,7 +3803,6 @@ 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); @@ -3978,7 +3847,6 @@ out_err: 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); diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index e84f5e1075..0b955c0965 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -118,10 +118,10 @@ init_per_suite(Config) -> _ -> Config catch error:low_entropy -> - %% Make sure we are on OSE, otherwise we want to crash - {ose,_} = os:type(), + %% We are testing on an OS with low entropy in its random + %% seed. So we have to seed it with a binary to get started. - %% This is NOT how you want to seed this, it is just here + %% This is NOT how you want to do seeding, 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(), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 41a6c731c9..0b033ca439 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -913,8 +913,7 @@ 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('ose')]), + t_atom('win32')]), t_atom()]); ['os_version'] -> t_sup(t_tuple([t_non_neg_fixnum(), diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index b8db22aba7..e759f214df 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -423,8 +423,7 @@ Erlang/OTP has been ported to the realtime operating system OSE. The port supports both smp and non-smp emulator. For details around the port and how to started - see the User's Guide in the ose application.

+ see the User's Guide in the ose application.

Note that not all parts of Erlang/OTP has been ported.

diff --git a/lib/kernel/doc/src/ref_man.xml.src b/lib/kernel/doc/src/ref_man.xml.src deleted file mode 100644 index 7eb48a5f1d..0000000000 --- a/lib/kernel/doc/src/ref_man.xml.src +++ /dev/null @@ -1,68 +0,0 @@ - - - - -

- - 19962013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Kernel Reference Manual - - - - -
- -

The Kernel application has all the code necessary to run - the Erlang runtime system itself: file servers and code servers - and so on.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 803fae846e..a0d5344f11 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -188,9 +188,6 @@ 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/os.erl b/lib/kernel/src/os.erl index 3330b38d84..ffb899e5ca 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -93,7 +93,7 @@ unsetenv(_) -> %%% End of BIFs -spec type() -> {Osfamily, Osname} when - Osfamily :: unix | win32 | ose, + Osfamily :: unix | win32, Osname :: atom(). type() -> diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index 0803cf428f..ffcde5e458 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -260,46 +260,41 @@ multiple_slaves(doc) -> ["Start nodes in parallell, all using the 'inet' loading method, ", "verify that the boot server manages"]; multiple_slaves(Config) when is_list(Config) -> - case os:type() of - {ose,_} -> - {comment, "OSE: multiple nodes not supported"}; - _ -> - ?line Name = erl_prim_test_multiple_slaves, - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - - NoOfNodes = 10, % no of slave nodes to be started - - NamesAndNodes = - lists:map(fun(N) -> - NameN = atom_to_list(Name) ++ - integer_to_list(N), - NodeN = NameN ++ "@" ++ Host, - {list_to_atom(NameN),list_to_atom(NodeN)} - end, lists:seq(1, NoOfNodes)), - - ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), - - %% "queue up" the nodes to wait for the boot server to respond - %% (note: test_server supervises each node start by accept() - %% on a socket, the timeout value for the accept has to be quite - %% long for this test to work). - ?line test_server:sleep(test_server:seconds(5)), - %% start the code loading circus! - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), - %% give the nodes a chance to boot up before attempting to stop them - ?line test_server:sleep(test_server:seconds(10)), + ?line Name = erl_prim_test_multiple_slaves, + ?line Host = host(), + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + + NoOfNodes = 10, % no of slave nodes to be started + + NamesAndNodes = + lists:map(fun(N) -> + NameN = atom_to_list(Name) ++ + integer_to_list(N), + NodeN = NameN ++ "@" ++ Host, + {list_to_atom(NameN),list_to_atom(NodeN)} + end, lists:seq(1, NoOfNodes)), + + ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), + + %% "queue up" the nodes to wait for the boot server to respond + %% (note: test_server supervises each node start by accept() + %% on a socket, the timeout value for the accept has to be quite + %% long for this test to work). + ?line test_server:sleep(test_server:seconds(5)), + %% start the code loading circus! + ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + %% give the nodes a chance to boot up before attempting to stop them + ?line test_server:sleep(test_server:seconds(10)), - ?line wait_and_shutdown(lists:reverse(Nodes), 30), + ?line wait_and_shutdown(lists:reverse(Nodes), 30), - ?line unlink(BootPid), - ?line exit(BootPid, kill), - ok - end. + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok. start_multiple_nodes([{Name,Node} | NNs], Args, Started) -> ?line {ok,Node} = start_node(Name, Args, [{wait, false}]), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 8856be31c2..5263130574 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -167,12 +167,7 @@ init_per_suite(Config) when is_list(Config) -> ok -> [{sasl,started}] end, - ok = case os:type() of - {ose,_} -> - ok; - _ -> - application:start(os_mon) - end, + application:start(os_mon), case os:type() of {win32, _} -> @@ -198,12 +193,7 @@ end_per_suite(Config) when is_list(Config) -> ok end, - case os:type() of - {ose,_} -> - ok; - _ -> - application:stop(os_mon) - end, + application:stop(os_mon), case proplists:get_value(sasl, Config) of started -> application:stop(sasl); @@ -888,10 +878,7 @@ 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 case io:get_line(Fd2,'') of - Str -> Str; - eof -> Str - end, + ?line Str = io:get_line(Fd2,''), ?line ok = ?FILE_MODULE:close(Fd2), ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), ?line ok = ?FILE_MODULE:truncate(Fd1), @@ -2346,9 +2333,6 @@ 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(), diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 81c6dcd0fd..3adca83ec9 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -58,14 +58,6 @@ 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,_} -> @@ -74,14 +66,6 @@ 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]; diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 3e6d8492f7..366231d2cc 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -455,10 +455,7 @@ 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 case ?PRIM_FILE:read(Fd2,Length) of - {ok,Str} -> Str; - eof -> Str - end, + ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length), ?line ok = ?PRIM_FILE:close(Fd2), ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), ?line ok = ?PRIM_FILE:truncate(Fd1), @@ -1629,7 +1626,7 @@ e_rename(Config) when is_list(Config) -> %% successfully move a file to %% another drive. ok; - {unix, _ } -> + _ -> OtherFs = "/tmp", ?line NameOnOtherFs = filename:join(OtherFs, @@ -1653,10 +1650,7 @@ e_rename(Config) when is_list(Config) -> Else -> Else end, - Com; - {ose, _} -> - %% disabled for now - ok + Com end, ?line test_server:timetrap_cancel(Dog), Comment. diff --git a/lib/ose/Makefile b/lib/ose/Makefile deleted file mode 100644 index 6119b75c3f..0000000000 --- a/lib/ose/Makefile +++ /dev/null @@ -1,37 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -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 deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/doc/man3/.gitignore b/lib/ose/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/doc/man6/.gitignore b/lib/ose/doc/man6/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/doc/pdf/.gitignore b/lib/ose/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/doc/src/.gitignore b/lib/ose/doc/src/.gitignore deleted file mode 100644 index 860e9e703e..0000000000 --- a/lib/ose/doc/src/.gitignore +++ /dev/null @@ -1 +0,0 @@ -ose.xml diff --git a/lib/ose/doc/src/Makefile b/lib/ose/doc/src/Makefile deleted file mode 100644 index 7ebd4125ba..0000000000 --- a/lib/ose/doc/src/Makefile +++ /dev/null @@ -1,133 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -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 deleted file mode 100644 index d62e0d32f4..0000000000 --- a/lib/ose/doc/src/book.xml +++ /dev/null @@ -1,49 +0,0 @@ - - - - -
- - 20142014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - OSE - Lukas Larsson - - 2014-01-08 - 1.0 - book.xml -
- - - OSE - - - - - - - - - - - - - - - diff --git a/lib/ose/doc/src/notes.xml b/lib/ose/doc/src/notes.xml deleted file mode 100644 index 06881b6c99..0000000000 --- a/lib/ose/doc/src/notes.xml +++ /dev/null @@ -1,109 +0,0 @@ - - - - -
- - 20142014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - OSE Release Notes - - - - - notes.xml -
-

This document describes the changes made to the OSE application.

- -
Ose 1.1 - -
Improvements and New Features - - -

- Change license text from Erlang Public License to Apache - Public License v2

-

- Own Id: OTP-12845

- - -
- -
- -
Ose 1.0.2 - -
Fixed Bugs and Malfunctions - - -

- Add missing release notes for the OSE application.

-

- Own Id: OTP-12177

- - -
- -
- -
Ose 1.0.1 - -
Fixed Bugs and Malfunctions - - -

- Fix some spelling mistakes in documentation

-

- Own Id: OTP-12152

- - -
- -
- -
Ose 1.0 - -
Improvements and New Features - - -

- Erlang/OTP has been ported to the realtime operating - system OSE. The port supports both smp and non-smp - emulator. For details around the port and how to started - see the User's Guide in the ose application.

-

- Note that not all parts of Erlang/OTP has been ported.

-

- Notable things that work are: non-smp and smp emulators, - OSE signal interaction, crypto, asn1, run_erl/to_erl, - tcp, epmd, distribution and most if not all non-os - specific functionality of Erlang.

-

- Notable things that does not work are: udp/sctp, os_mon, - erl_interface, binding of schedulers.

-

- Own Id: OTP-11334

- - -
- -
- - diff --git a/lib/ose/doc/src/ose_app.xml b/lib/ose/doc/src/ose_app.xml deleted file mode 100644 index d555f0ec4f..0000000000 --- a/lib/ose/doc/src/ose_app.xml +++ /dev/null @@ -1,38 +0,0 @@ - - - - -
- - 20142014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Enea OSE - - - - -
- ose - The OSE Application - -

The OSE application contains modules and documentation that only - applies when running Erlang/OTP on Enea OSE.

- - - diff --git a/lib/ose/doc/src/ose_erl_driver.xml b/lib/ose/doc/src/ose_erl_driver.xml deleted file mode 100644 index b804c29d2d..0000000000 --- a/lib/ose/doc/src/ose_erl_driver.xml +++ /dev/null @@ -1,111 +0,0 @@ - - - - -
- - 20132014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - erl_driver for Enea OSE - Lukas Larsson - - 2014-01-08 - A - ose_erl_driver.xml -
- ose_erl_driver - Linked-in drivers in Enea OSE - -

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. -

- -
- DATA TYPES - - - union SIGNAL - See the Enea OSE SPI documentation for a description. - SIGSELECT - See the Enea OSE SPI documentation for a description. - ErlDrvEvent - The ErlDrvEvent is a handle to a signal number and id combination. It is passed to driver_select(3). - ErlDrvOseEventId - This is the id used to associate a specific signal to a - certain driver instance. - -
- - - union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent drv_event) - - -

Fetch the next signal associated with drv_event. - Signals will be returned in the order which they were received and - when no more signals are available NULL will be returned. - Use this function in the ready_input/ready_output callbacks - to get signals.

- - - - ErlDrvEventerl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, ErlDrvOseEventId (*resolve_signal)(union SIGNAL* sig), void *extra) - - -

Create a new ErlDrvEvent associated with signo, - id and uses the resolve_signal function to extract - the id from a signal with signo. The extra - parameter can be used for additional data. See - - Signals in a Linked-in driver in the OSE User's Guide. -

- - - - voiderl_drv_ose_event_free(ErlDrvEvent drv_event) - - -

Free a ErlDrvEvent. This should always be done in the - stop_select - callback when the event is no longer being used.

- - - - voiderl_drv_ose_event_fetch(ErlDrvEvent drv_event, SIGSELECT *signo, ErlDrvOseEventId *id, void **extra) - - -

Write the signal number, id and any extra data associated with drv_event - into *signo and *id respectively. NULL can be - also passed as signo or id in order to ignore that field. -

- - - -
- SEE ALSO -

- driver_entry(3), - erl_driver(3) -

-
- diff --git a/lib/ose/doc/src/ose_intro.xml b/lib/ose/doc/src/ose_intro.xml deleted file mode 100644 index 982516c8bd..0000000000 --- a/lib/ose/doc/src/ose_intro.xml +++ /dev/null @@ -1,154 +0,0 @@ - - - - -
- - 20132014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Introduction - Lukas Larsson - - 2014-01-08 - A - ose_intro.xml -
- -
- Features -
- -
- Starting Erlang/OTP -

- 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 erl on Unix/Windows has a - undocumented flag called -emu_args_exit that can be used to - figure out what the arguments to beam look like. For example:

- # 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 --- -

- The arguments are printed on separate 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:

- 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 -

- Also note that since we are running erl to figure out the arguments on a - separate machine the paths have to be updated. In the example above - /usr/local/lib/erlang was replaced by /mst/erlang/. 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. -

- - 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. - -
- -
- run_erl and to_erl -

- 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: - - -block Name - 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: - 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 --" - - - The same argument munching as when starting Erlang/OTP without run_erl - has to be done. If -daemon is given then all error printouts - are sent to the ramlog. - See also - run_erl for more details. -

-

- Below is an example of how to get started with run_erl_lm. - 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. - Note that Ctrl-C is used instead of Ctrl-D to exit the to_erl shell. -

-
- -
- epmd -

- In OSE epmd will not be started automatically so if you want to use - Erlang distribution you have to manually start epmd. -

-
- -
- VM Process Priorities -

- 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. -

-
- - diff --git a/lib/ose/doc/src/ose_signals_chapter.xml b/lib/ose/doc/src/ose_signals_chapter.xml deleted file mode 100644 index bcf2259577..0000000000 --- a/lib/ose/doc/src/ose_signals_chapter.xml +++ /dev/null @@ -1,240 +0,0 @@ - - - - -
- - 20132014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Interacting with Enea OSE - Lukas Larsson - - 2014-01-08 - A - ose_signals_chapter.xml -
- - -
- Introduction -

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 ose module, or by writing a custom linked-in - driver. This User's Guide describes and provides examples for both - approaches. -

-
- - -
- Signals in Erlang -

Erlang/OTP on OSE provides a erlang module called - ose 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. -

- 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 -
- - -
- Signals in a Linked-in driver -

- 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. -

-

- 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: - ErlDrvEvent event = erl_drv_ose_event_alloc(1234,port,resolver); - The event you get back from - - erl_drv_ose_event_alloc can then be used by - driver_select - 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 - start 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 - erl_drv_ose_event_fetch - , eg: - erl_drv_ose_event_fetch(event, &signal, &port, (void **)&extra); - example of what this could look like in - the next section. - 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. -

-

- 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 - erl_drv_ose_get_signal. Additionally multiple signals might be - associated with the event, so you should call - - erl_drv_ose_get_signal until NULL is returned. -

-
- - -
- Example Linked-in driver -#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 -}; - -
- - diff --git a/lib/ose/doc/src/part.xml b/lib/ose/doc/src/part.xml deleted file mode 100644 index 0c9ebd16c0..0000000000 --- a/lib/ose/doc/src/part.xml +++ /dev/null @@ -1,39 +0,0 @@ - - - - -
- - 2014 - 2014 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - OSE User's Guide - Lukas Larsson - - 2014-01-08 - 1.0 - part.xml -
- -

OSE.

- - - - diff --git a/lib/ose/doc/src/ref_man.xml b/lib/ose/doc/src/ref_man.xml deleted file mode 100644 index 964e5ab8ff..0000000000 --- a/lib/ose/doc/src/ref_man.xml +++ /dev/null @@ -1,40 +0,0 @@ - - - - -
- - 20142014 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - OSE Reference Manual - Lukas Larsson - - 2014-01-08 - 1.0 - ref_man.xml -
- -

The Standard Erlang Libraries application, STDLIB, - contains modules for manipulating lists, strings and files etc.

-

- - - - - diff --git a/lib/ose/ebin/.gitignore b/lib/ose/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/include/.gitignore b/lib/ose/include/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/ose/info b/lib/ose/info deleted file mode 100644 index 85c07dbe82..0000000000 --- a/lib/ose/info +++ /dev/null @@ -1,2 +0,0 @@ -group: misc Miscellaneous Applications -short: Description of Enea OSE specific functionality diff --git a/lib/ose/src/Makefile b/lib/ose/src/Makefile deleted file mode 100644 index a89e9392e9..0000000000 --- a/lib/ose/src/Makefile +++ /dev/null @@ -1,107 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2013. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -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 deleted file mode 100644 index 036779eb16..0000000000 --- a/lib/ose/src/ose.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% This is an -*- erlang -*- file. -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -{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 deleted file mode 100644 index 28b6da3439..0000000000 --- a/lib/ose/src/ose.appup.src +++ /dev/null @@ -1,23 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -{"%VSN%", - [ - ], - [ - ]}. diff --git a/lib/ose/src/ose.erl b/lib/ose/src/ose.erl deleted file mode 100644 index 5534dba4d4..0000000000 --- a/lib/ose/src/ose.erl +++ /dev/null @@ -1,453 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% @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 - 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, <>) 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, <>) 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, <>) 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, <>) 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, [<>, 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, [<>, 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 <- 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 deleted file mode 100644 index 7e2080ba38..0000000000 --- a/lib/ose/test/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -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 deleted file mode 100644 index 7b846cfaf6..0000000000 --- a/lib/ose/test/ose.cover +++ /dev/null @@ -1,2 +0,0 @@ -%% -*- erlang -*- -{incl_app,ose,details}. diff --git a/lib/ose/test/ose.spec b/lib/ose/test/ose.spec deleted file mode 100644 index c897e8cd16..0000000000 --- a/lib/ose/test/ose.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../ose_test",all}. diff --git a/lib/ose/test/ose_SUITE.erl b/lib/ose/test/ose_SUITE.erl deleted file mode 100644 index 31d950bd03..0000000000 --- a/lib/ose/test/ose_SUITE.erl +++ /dev/null @@ -1,766 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(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 deleted file mode 100644 index fb1cf8219f..0000000000 --- a/lib/ose/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -OSE_VSN = 1.1 diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 448b8c62c2..aeacee0655 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -102,12 +102,7 @@ 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) @@ -159,10 +154,8 @@ 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/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 24fc8ce204..4e629a5e56 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -289,10 +289,7 @@ register_unique_name(Number) -> %% no need to use rsh. mk_cmd(Host, Name, Args, Waiter, Prog0) -> - Prog = case os:type() of - {ose,_} -> mk_ose_prog(Prog0); - _ -> quote_progname(Prog0) - end, + Prog = quote_progname(Prog0), BasicCmd = lists:concat([Prog, " -detached -noinput -master ", node(), " ", long_or_short(), Name, "@", Host, @@ -312,24 +309,6 @@ 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/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index fd47da8150..4372e77df9 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -97,20 +97,11 @@ absname(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - 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, - + {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"), ?line file:set_cwd("/"), ?line "/foo" = filename:absname(foo), ?line "/foo" = filename:absname("foo"), @@ -494,18 +485,10 @@ absname_bin(Config) when is_list(Config) -> ?line file:set_cwd(Cwd), ok; - 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, - + {unix, _} -> + ?line ok = file:set_cwd(<<"/usr">>), + ?line <<"/usr/foo">> = filename:absname(<<"foo">>), + ?line <<"/usr/../ebin">> = filename:absname(<<"../ebin">>), ?line file:set_cwd(<<"/">>), ?line <<"/foo">> = filename:absname(<<"foo">>), ?line <<"/../ebin">> = filename:absname(<<"../ebin">>), diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index 66bba229f6..e8bce149b1 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -97,11 +97,8 @@ 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) @@ -152,12 +149,7 @@ 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/make/ose_lm.mk.in b/make/ose_lm.mk.in deleted file mode 100644 index de8d351af3..0000000000 --- a/make/ose_lm.mk.in +++ /dev/null @@ -1,76 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode -# ---------------------------------------------------- -# Template target for generating an OSE5 load module -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2013. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -# 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.mk.in b/make/otp.mk.in index 723f83cb45..c05c499d66 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -90,14 +90,10 @@ OTP_RELEASE = @OTP_RELEASE@ # Erlang language section # ---------------------------------------------------- EMULATOR = beam -ifeq ($(findstring ose_ppc750,$(TARGET)),ose_ppc750) -ERL_COMPILE_FLAGS += +compressed +ifdef BOOTSTRAP + ERL_COMPILE_FLAGS += +slim else - ifdef BOOTSTRAP - ERL_COMPILE_FLAGS += +slim - else - ERL_COMPILE_FLAGS += +debug_info - endif + ERL_COMPILE_FLAGS += +debug_info endif ERLC_WFLAGS = -W ERLC = erlc $(ERLC_WFLAGS) $(ERLC_FLAGS) diff --git a/xcomp/erl-xcomp-powerpc-ose5.conf b/xcomp/erl-xcomp-powerpc-ose5.conf deleted file mode 100644 index 88b2135593..0000000000 --- a/xcomp/erl-xcomp-powerpc-ose5.conf +++ /dev/null @@ -1,358 +0,0 @@ -## -*-shell-script-*- -## -## %CopyrightBegin% -## -## Copyright Ericsson AB 2009-2012. All Rights Reserved. -## -## Licensed under the Apache License, Version 2.0 (the "License"); -## you may not use this file except in compliance with the License. -## You may obtain a copy of the License at -## -## http://www.apache.org/licenses/LICENSE-2.0 -## -## Unless required by applicable law or agreed to in writing, software -## distributed under the License is distributed on an "AS IS" BASIS, -## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -## See the License for the specific language governing permissions and -## limitations under the License. -## -## %CopyrightEnd% -## -## 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=' -## ----------------------------------------------------------------------------- - -## 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 `-' you probably do -## not need to set these variables (where `' is what has been passed as -## `--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, )' 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 deleted file mode 100644 index a4d64e5636..0000000000 --- a/xcomp/erl-xcomp-sfk-linux-ose5.conf +++ /dev/null @@ -1,305 +0,0 @@ -## -*-shell-script-*- -## -## %CopyrightBegin% -## -## Copyright Ericsson AB 2009-2012. All Rights Reserved. -## -## Licensed under the Apache License, Version 2.0 (the "License"); -## you may not use this file except in compliance with the License. -## You may obtain a copy of the License at -## -## http://www.apache.org/licenses/LICENSE-2.0 -## -## Unless required by applicable law or agreed to in writing, software -## distributed under the License is distributed on an "AS IS" BASIS, -## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -## See the License for the specific language governing permissions and -## limitations under the License. -## -## %CopyrightEnd% -## -## 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=' -## ----------------------------------------------------------------------------- - -## 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 `-' you probably do -## not need to set these variables (where `' is what has been passed as -## `--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, )' 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 0443867341..e864f7b96b 100644 --- a/xcomp/erl-xcomp-vars.sh +++ b/xcomp/erl-xcomp-vars.sh @@ -27,4 +27,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_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" +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" -- cgit v1.2.3 From d2a0690865339a2d37badc4b79025f97b34e3d46 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 2 Jul 2015 16:07:32 +0200 Subject: Remove OSE from erl_interface --- lib/erl_interface/src/Makefile.in | 63 --------------------------------------- 1 file changed, 63 deletions(-) diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 777d709b1e..d6176ec053 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -126,11 +126,7 @@ else WARNFLAGS = @WFLAGS@ endif -ifneq ($(findstring ose,$(TARGET)),ose) CFLAGS = @LIB_CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -else -CFLAGS = @CFLAGS@ $(INCFLAGS) -endif PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Ilegacy ifeq ($(findstring vxworks,$(TARGET)),vxworks) @@ -210,12 +206,8 @@ MDD_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_mdd$(LIBEXT) # Specify targets to build ########################################################################### -ifneq ($(findstring ose,$(TARGET)),ose) EXE_TARGETS = \ $(ERL_CALL) -else -EXE_TARGETS = -endif ifeq ($(USING_VC),yes) @@ -480,44 +472,6 @@ ERLSOURCES = \ SOURCES = $(EISOURCES) $(ERLSOURCES) -OSE_EISOURCES = \ - $(DECODESRC) \ - $(ENCODESRC) \ - misc/ei_decode_term.c \ - misc/ei_format.c \ - misc/ei_locking.c \ - misc/ei_malloc.c \ - misc/ei_printterm.c \ - misc/ei_pthreads.c \ - misc/ei_trace.c \ - misc/ei_x_encode.c \ - misc/eimd5.c \ - misc/get_type.c \ - misc/show_msg.c \ - misc/ei_compat.c \ - registry/hash_dohash.c \ - registry/hash_foreach.c \ - registry/hash_freetab.c \ - registry/hash_insert.c \ - registry/hash_isprime.c \ - registry/hash_lookup.c \ - registry/hash_newtab.c \ - registry/hash_remove.c \ - registry/hash_resize.c \ - registry/hash_rlookup.c - -OSE_ERLSOURCES = \ - legacy/decode_term.c \ - legacy/encode_term.c \ - legacy/erl_error.c \ - legacy/erl_eterm.c \ - legacy/erl_fix_alloc.c \ - legacy/erl_format.c \ - legacy/erl_malloc.c \ - legacy/erl_marshal.c - -OSE_SOURCES = $(OSE_EISOURCES) $(OSE_ERLSOURCES) - NEVERUSED = \ whereis.c \ ei_send.c \ @@ -532,13 +486,8 @@ ERLCALL = \ # Note that encode/decode_term.c defines ei functions that is # located in the erl_interface library, not ei library. -ifneq ($(findstring ose,$(TARGET)),ose) ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) -else -ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_EISOURCES:.c=.o))) -ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(OSE_ERLSOURCES:.c=.o))) -endif MT_EIOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) MT_ERLOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) MD_EIOBJECTS = $(addprefix $(MD_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) @@ -587,14 +536,6 @@ $(TARGET)/config.h: $(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@ endif -ifeq ($(findstring ose,$(TARGET)),ose) -$(TARGET)/config.h: - $(gen_verbose) - $(V_at)echo "/* Generated by Makefile */" > $@ - $(V_at)echo "#define HAVE_STRERROR 1" >> $@ - $(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@ -endif - ########################################################################### # Default rules, normal and threaded ########################################################################### @@ -718,9 +659,6 @@ $(ST_OBJDIR)/erl_call.o: prog/erl_call.c $(ST_OBJDIR)/erl_start.o: prog/erl_start.c $(V_CC) $(CFLAGS) -c $< -o $@ -else -ifeq ($(findstring ose,$(TARGET)),ose) -$(ERL_CALL): else ifdef THR_DEFS $(ERL_CALL): $(ERLCALL) ../include/ei.h $(MT_EILIB) @@ -733,7 +671,6 @@ $(ERL_CALL): $(ERLCALL) ../include/ei.h $(ST_EILIB) endif endif endif -endif ########################################################################### # Fake application targets used to test header files and linking -- cgit v1.2.3 From 7db3c1bff2850f395e85c58eeda3f0dae1a218f4 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 14 Jul 2015 16:39:33 +0200 Subject: erts: Update major version number --- erts/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/vsn.mk b/erts/vsn.mk index 1012f5eafd..9e4248a668 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 7.0 +VSN = 8.0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 -- cgit v1.2.3 From a3d94569e38abe3faa08bc1b2305f7045470e510 Mon Sep 17 00:00:00 2001 From: Sean Charles Date: Thu, 30 Apr 2015 12:30:05 +0100 Subject: Increased left-nav width for readability It just makes it easier to read stuff. For example, gen_server functions are now totally visible, no more guessing. --- lib/erl_docgen/priv/css/otp_doc.css | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index 0b531db701..347782eb1e 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -37,7 +37,7 @@ a:visited { color: blue; text-decoration: none } top: 0; bottom: 0; left: 0; - width: 200px; + width: 300px; overflow:auto; margin: 0; padding: 1px; @@ -45,7 +45,7 @@ a:visited { color: blue; text-decoration: none } } #content { - margin-left: 240px; /* set left value to WidthOfFrameDiv */ + margin-left: 340px; /* set left value to WidthOfFrameDiv */ } .frontpage -- cgit v1.2.3 From b4030b60b58a681b2dea5453fbc36f7f4cc41bd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 7 Jul 2015 15:21:30 +0200 Subject: Teach the compiler the 'da' and 'dz' options Add the 'da' option to create a list after the beam_a pass. Seeing how the code looks after beam_a, but before the blocks have been established, is sometimes useful. For symmetry, add the 'dz' option, even though it is just a synonym for 'S'. --- lib/compiler/src/compile.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e0a29fe9b1..cf79fdc9f9 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -671,6 +671,7 @@ asm_passes() -> %% Assembly level optimisations. [{delay, [{pass,beam_a}, + {iff,da,{listing,"a"}}, {unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, @@ -703,6 +704,7 @@ asm_passes() -> {iff,no_postopt,[{pass,beam_clean}]}, {pass,beam_z}, + {iff,dz,{listing,"z"}}, {iff,dopt,{listing,"optimize"}}, {iff,'S',{listing,"S"}}, {iff,'to_asm',{done,"S"}}]}, -- cgit v1.2.3 From f3cc9d1b16d86124a70f5dd0609113ec6e3b4dcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 5 Aug 2015 19:35:45 +0200 Subject: beam_block: Eliminate redundant wasteful call to opt/1 opt_alloc/1 makes a redundant call to opt/1. It is redundant because the opt/1 function has already been applied to the instruction sequence prior to calling opt_alloc/1. --- lib/compiler/src/beam_block.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 2def3de7f3..4861a2d7ec 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -346,7 +346,7 @@ is_transparent(_, _) -> false. %% Optimises all allocate instructions. opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) -> - [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|opt(Is)]; + [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is]; opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; opt_alloc([]) -> []. -- cgit v1.2.3 From 7a47b20c3accf323bdbf7bcf9c86fbf8b2c18e20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 22 Jul 2015 09:45:04 +0200 Subject: beam_block: Clean up optimization of move optimizations The 'move' optimization was relatively clean until GC BIFs were introduced. Instead of re-thinking the implementation, the existing code was fixed and patched. The current code unsuccessfully attempts to eliminate 'move' instructions across GC BIF and allocation instructions. We can simplify the code if we give up as soon as we encounter any instruction that allocates. --- lib/compiler/src/beam_block.erl | 83 ++++++++++++++++++----------------------- 1 file changed, 37 insertions(+), 46 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 4861a2d7ec..58e8f77a2c 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -287,60 +287,51 @@ opt_moves(Ds, Is) -> %% If there is a {move,Dest,FinalDest} instruction %% in the instruction stream, remove the move instruction %% and let FinalDest be the destination. -%% -%% For this optimization to be safe, we must be sure that -%% Dest will not be referenced in any other by other instructions -%% in the rest of the instruction stream. Not even the indirect -%% reference by an instruction that may allocate (such as -%% test_heap/2 or a GC Bif) is allowed. opt_move(Dest, Is) -> - opt_move_1(Dest, Is, ?MAXREG, []). - -opt_move_1(R, [{set,_,_,{alloc,Live,_}}|_]=Is, SafeRegs, Acc) when Live < SafeRegs -> - %% Downgrade number of safe regs and rescan the instruction, as it most probably - %% is a gc_bif instruction. - opt_move_1(R, Is, Live, Acc); -opt_move_1(R, [{set,[{x,X}=D],[R],move}|Is], SafeRegs, Acc) -> - case X < SafeRegs andalso beam_utils:is_killed_block(R, Is) of - true -> opt_move_2(D, Acc, Is); - false -> not_possible - end; -opt_move_1(R, [{set,[D],[R],move}|Is], _SafeRegs, Acc) -> + opt_move_1(Dest, Is, []). + +opt_move_1(R, [{set,[D],[R],move}|Is], Acc) -> + %% Check whether this instruction can be safely eliminated. + %% First check that the source (R) is not used by the + %% instructions that follow. case beam_utils:is_killed_block(R, Is) of - true -> opt_move_2(D, Acc, Is); + true -> opt_move_rev(D, Acc, Is); false -> not_possible end; -opt_move_1(R, [I|Is], SafeRegs, Acc) -> - case is_transparent(R, I) of - false -> not_possible; - true -> opt_move_1(R, Is, SafeRegs, [I|Acc]) - end. +opt_move_1({x,_}, [{set,_,_,{alloc,_,_}}|_], _) -> + %% The optimization is not possible. If the X register is not + %% killed by allocation, the optimization would not be safe. + %% If the X register is killed, it means that there cannot + %% follow a 'move' instruction with this X register as the + %% source. + not_possible; +opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> + %% If the source register is either killed or used by this + %% instruction, the optimimization is not possible. + case is_killed_or_used(R, I) of + true -> not_possible; + false -> opt_move_1(R, Is, [I|Acc]) + end; +opt_move_1(_, _, _) -> + not_possible. -%% Reverse the instructions, while checking that there are no instructions that -%% would interfere with using the new destination register chosen. +%% Reverse the instructions, while checking that there are no +%% instructions that would interfere with using the new destination +%% register (D). -opt_move_2(D, [I|Is], Acc) -> - case is_transparent(D, I) of - false -> not_possible; - true -> opt_move_2(D, Is, [I|Acc]) - end; -opt_move_2(D, [], Acc) -> {D,Acc}. - -%% is_transparent(Register, Instruction) -> true | false -%% Returns true if Instruction does not in any way references Register -%% (even indirectly by an allocation instruction). -%% Returns false if Instruction does reference Register, or we are -%% not sure. - -is_transparent({x,X}, {set,_,_,{alloc,Live,_}}) when X < Live -> - false; -is_transparent(R, {set,Ds,Ss,_Op}) -> - case member(R, Ds) of - true -> false; - false -> not member(R, Ss) +opt_move_rev(D, [I|Is], Acc) -> + case is_killed_or_used(D, I) of + true -> not_possible; + false -> opt_move_rev(D, Is, [I|Acc]) end; -is_transparent(_, _) -> false. +opt_move_rev(D, [], Acc) -> {D,Acc}. + +%% is_killed_or_used(Register, {set,_,_,_}) -> bool() +%% Test whether the register is used by the instruction. + +is_killed_or_used(R, {set,Ss,Ds,_}) -> + member(R, Ds) orelse member(R, Ss). %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. -- cgit v1.2.3 From 02d6135813dc133e018c161d803a642582aac36f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 22 Jul 2015 10:20:59 +0200 Subject: beam_block: Improve the move optimizations Here is an example of a move instruction that could not be optimized away because the {x,2} register was not killed: get_tuple_element Reg Pos {x,2} . . . move {x,2} {y,0} put_list {x,2} nil Any We can do the optimization if we replace all occurrences of the {x,2} register as a source with {y,0}: get_tuple_element Reg Pos {y,0} . . . put_list {y,0} nil Dst --- lib/compiler/src/beam_block.erl | 53 +++++++++++++++++++++++++++++++++++------ 1 file changed, 46 insertions(+), 7 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 58e8f77a2c..af1bf8fd08 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -291,13 +291,12 @@ opt_moves(Ds, Is) -> opt_move(Dest, Is) -> opt_move_1(Dest, Is, []). -opt_move_1(R, [{set,[D],[R],move}|Is], Acc) -> - %% Check whether this instruction can be safely eliminated. - %% First check that the source (R) is not used by the - %% instructions that follow. - case beam_utils:is_killed_block(R, Is) of - true -> opt_move_rev(D, Acc, Is); - false -> not_possible +opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) -> + %% Provided that the source register is killed by instructions + %% that follow, the optimization is safe. + case eliminate_use_of_from_reg(Is0, R, D, []) of + {yes,Is} -> opt_move_rev(D, Acc, Is); + no -> not_possible end; opt_move_1({x,_}, [{set,_,_,{alloc,_,_}}|_], _) -> %% The optimization is not possible. If the X register is not @@ -333,6 +332,46 @@ opt_move_rev(D, [], Acc) -> {D,Acc}. is_killed_or_used(R, {set,Ss,Ds,_}) -> member(R, Ds) orelse member(R, Ss). +%% eliminate_use_of_from_reg([Instruction], FromRegister, ToRegister, Acc) -> +%% {yes,Is} | no +%% Eliminate any use of FromRegister in the instruction sequence +%% by replacing uses of FromRegister with ToRegister. If FromRegister +%% is referenced by an allocation instruction, return 'no' to indicate +%% that FromRegister is still used and that the optimization is not +%% possible. + +eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) -> + if + X < Live -> + no; + true -> + {yes,reverse(Acc, Is0)} + end; +eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) -> + I = case member(From, Ss0) of + true -> + Ss = [case S of + From -> To; + _ -> S + end || S <- Ss0], + {set,Ds,Ss,Op}; + false -> + I0 + end, + case member(From, Ds) of + true -> + {yes,reverse(Acc, [I|Is])}; + false -> + eliminate_use_of_from_reg(Is, From, To, [I|Acc]) + end; +eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> + case beam_utils:is_killed_block(From, [I]) of + true -> + {yes,reverse(Acc, Is)}; + false -> + no + end. + %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. -- cgit v1.2.3 From 5f431276f1044c673c2e434e003e2f1ffddab341 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 23 Jul 2015 17:43:15 +0200 Subject: Optimize get_tuple_element instructions by moving them forward --- lib/compiler/src/beam_block.erl | 53 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index af1bf8fd08..49e66b379b 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -183,7 +183,9 @@ opt_blocks([I|Is]) -> opt_blocks([]) -> []. opt_block(Is0) -> - Is = find_fixpoint(fun opt/1, Is0), + Is = find_fixpoint(fun(Is) -> + opt_tuple_element(opt(Is)) + end, Is0), opt_alloc(Is). find_fixpoint(OptFun, Is0) -> @@ -315,6 +317,55 @@ opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> opt_move_1(_, _, _) -> not_possible. +%% opt_tuple_element([Instruction]) -> [Instruction] +%% If possible, move get_tuple_element instructions forward +%% in the instruction stream to a move instruction, eliminating +%% the move instruction. Example: +%% +%% get_tuple_element Tuple Pos Dst1 +%% ... +%% move Dst1 Dst2 +%% +%% This code may be possible to rewrite to: +%% +%% %%(Moved get_tuple_element instruction) +%% ... +%% get_tuple_element Tuple Pos Dst2 +%% + +opt_tuple_element([{set,[D],[S],{get_tuple_element,_}}=I|Is0]) -> + case opt_tuple_element_1(Is0, I, {S,D}, []) of + no -> + [I|opt_tuple_element(Is0)]; + {yes,Is} -> + opt_tuple_element(Is) + end; +opt_tuple_element([I|Is]) -> + [I|opt_tuple_element(Is)]; +opt_tuple_element([]) -> []. + +opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) -> + no; +opt_tuple_element_1([{set,_,_,{'catch',_}}|_], _, _, _) -> + no; +opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) -> + case eliminate_use_of_from_reg(Is0, S, D, []) of + no -> + no; + {yes,Is} -> + {set,[S],Ss,Op} = I0, + I = {set,[D],Ss,Op}, + {yes,reverse(Acc, [I|Is])} + end; +opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) -> + case member(S, Ds) orelse member(D, Ss) of + true -> + no; + false -> + opt_tuple_element_1(Is, MovedI, Regs, [I|Acc]) + end; +opt_tuple_element_1(_, _, _, _) -> no. + %% Reverse the instructions, while checking that there are no %% instructions that would interfere with using the new destination %% register (D). -- cgit v1.2.3 From c288ab87fd6cafe22ce46be551baa2e815b495b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 7 Jul 2015 10:45:38 +0200 Subject: Delay get_tuple_element instructions until they are needed When matching tuples, the pattern matching compiler would generate code that would fetch all elements of the tuple that will ultimately be used, *before* testing that (for example) the first element is the correct record tag. For example: is_tuple Fail {x,0} test_arity Fail {x,0} 3 get_tuple_element {x,0} 0 {x,1} get_tuple_element {x,0} 1 {x,2} get_tuple_element {x,0} 2 {x,3} is_eq_exact Fail {x,1} some_tag If {x,2} and {x,3} are not used at label Fail, we can re-arrange the code like this: is_tuple Fail {x,0} test_arity Fail {x,0} 3 get_tuple_element {x,0} 0 {x,1} is_eq_exact Fail {x,1} some_tag get_tuple_element {x,0} 1 {x,2} get_tuple_element {x,0} 2 {x,3} Doing that may be beneficial in two ways. If the branch is taken, we have eliminated the execution of two unnecessary instructions. Even if the branch is never or rarely taken, there is the possibility for more optimizations following the is_eq_exact instructions. For example, imagine that the code looks like this: get_tuple_element {x,0} 1 {x,2} get_tuple_element {x,0} 2 {x,3} move {x,2} {y,0} move {x,3} {y,1} Assuming that {x,2} and {x,3} have no further uses in the code that follows, that can be rewritten to: get_tuple_element {x,0} 1 {y,0} get_tuple_element {x,0} 2 {y,1} When should we perform this optimization? At the very latest, it must be done before opt_blocks/1 in beam_block which does the elimination of unnecessary moves. Actually, we want do the optimization before the blocks have been established, since moving instructions out of one block into another is cumbersome. Therefore, we will do the optimization in a new pass that is run before beam_block. A new pass will make debugging easier, and beam_block already has a fair number of sub passes. --- lib/compiler/src/Makefile | 1 + lib/compiler/src/beam_reorder.erl | 113 ++++++++++++++++++++++++++++++++++++++ lib/compiler/src/beam_utils.erl | 9 +++ lib/compiler/src/compile.erl | 4 +- lib/compiler/src/compiler.app.src | 1 + lib/compiler/test/misc_SUITE.erl | 8 +++ 6 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 lib/compiler/src/beam_reorder.erl diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 299b2892fc..ae4007c61c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -62,6 +62,7 @@ MODULES = \ beam_opcodes \ beam_peep \ beam_receive \ + beam_reorder \ beam_split \ beam_trim \ beam_type \ diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl new file mode 100644 index 0000000000..3230e33dbd --- /dev/null +++ b/lib/compiler/src/beam_reorder.erl @@ -0,0 +1,113 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_reorder). + +-export([module/2]). +-import(lists, [member/2,reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}) -> + try + Is = reorder(Is0), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%% reorder(Instructions0) -> Instructions +%% Reorder instructions before the beam_block pass, because reordering +%% will be more cumbersome when the blocks are in place. +%% +%% Execution of get_tuple_element instructions can be delayed until +%% they are actually needed. Consider the sequence: +%% +%% get_tuple_element Tuple Pos Dst +%% test Test Fail Operands +%% +%% If Dst is killed at label Fail (and not referenced in Operands), +%% we can can swap the instructions: +%% +%% test Test Fail Operands +%% get_tuple_element Tuple Pos Dst +%% +%% That can be beneficial in two ways: Firstly, if the branch is taken +%% we have avoided execution of the get_tuple_element instruction. +%% Secondly, even if the branch is not taken, subsequent optimization +%% (opt_blocks/1) may be able to change Dst to the final destination +%% register and eliminate a 'move' instruction. + +reorder(Is) -> + D = beam_utils:index_labels(Is), + reorder_1(Is, D, []). + +reorder_1([{label,L}=I|_], D, Acc) -> + Is = beam_utils:code_at(L, D), + reorder_1(Is, D, [I|Acc]); +reorder_1([{test,is_nonempty_list,_,_}=I|Is], D, Acc) -> + %% The run-time system may combine the is_nonempty_list test with + %% the following get_list instruction. + reorder_1(Is, D, [I|Acc]); +reorder_1([{test,_,_,_}=I, + {select,_,_,_,_}=S|Is], D, Acc) -> + %% There is nothing to gain by inserting a get_tuple_element + %% instruction between the test instruction and the select + %% instruction. + reorder_1(Is, D, [S,I|Acc]); +reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, + [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> + case member(El, Ss) of + true -> + reorder_1(Is0, D0, [I|Acc]); + false -> + case beam_utils:is_killed_at(El, L, D0) of + true -> + Is = [I,G|Is0], + reorder_1(Is, D0, Acc0); + false -> + case beam_utils:is_killed(El, Is0, D0) of + true -> + Code0 = beam_utils:code_at(L, D0), + Code = [G|Code0], + D = beam_utils:index_label(L, Code, D0), + Is = [I|Is0], + reorder_1(Is, D, Acc0); + false -> + reorder_1(Is0, D0, [I|Acc]) + end + end + end; +reorder_1([{allocate_zero,N,Live}|Is], D, + [{get_tuple_element,_,_,{x,X}}=G|Acc]) + when X+1 =:= Live -> + %% Move allocation instruction upwards past get_tuple_element + %% instructions to give more opportunities for moving + %% get_tuple_element instructions. + I = {allocate_zero,N,X}, + reorder_1([I,G|Is], D, Acc); +reorder_1([I|Is], D, Acc) -> + reorder_1(Is, D, [I|Acc]); +reorder_1([], _, Acc) -> reverse(Acc). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index fbcd5de1bb..68d6105cfa 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -484,6 +484,15 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> Other end end; +check_liveness(R, [{test_heap,N,Live}|Is], St) -> + I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, + check_liveness(R, [I|Is], St); +check_liveness(R, [{allocate_zero,N,Live}|Is], St) -> + I = {block,[{set,[],[],{alloc,Live,{zero,N,0,[]}}}]}, + check_liveness(R, [I|Is], St); +check_liveness(R, [{get_list,S,D1,D2}|Is], St) -> + I = {block,[{set,[D1,D2],[S],get_list}]}, + check_liveness(R, [I|Is], St); check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index cf79fdc9f9..605f5b8fd5 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -673,7 +673,9 @@ asm_passes() -> [{pass,beam_a}, {iff,da,{listing,"a"}}, {unless,no_postopt, - [{pass,beam_block}, + [{unless,no_reorder,{pass,beam_reorder}}, + {iff,dre,{listing,"reorder"}}, + {pass,beam_block}, {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index afb85f4710..62ea9cee80 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -37,6 +37,7 @@ beam_opcodes, beam_peep, beam_receive, + beam_reorder, beam_split, beam_trim, beam_type, diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 8606935504..3582e055c8 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -192,6 +192,14 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_a:module(BeamAInput, []) end), + %% beam_reorder + BlockInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_reorder:module(BlockInput, []) end), + %% beam_block BlockInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, -- cgit v1.2.3 From 3640e5c89bda0ca45b3320e8a00efb48b9d9f531 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 5 Aug 2015 19:12:15 +0200 Subject: Reorder instructions across try/catch Simplify further optimizations by moving safe instructions to before the 'try' or 'catch' instruction. --- lib/compiler/src/beam_reorder.erl | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 3230e33dbd..70adca6b04 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -64,6 +64,16 @@ reorder(Is) -> D = beam_utils:index_labels(Is), reorder_1(Is, D, []). +reorder_1([{Op,_,_}=TryCatch|[I|Is]=Is0], D, Acc) + when Op =:= 'catch'; Op =:= 'try' -> + %% Don't allow 'try' or 'catch' instructions to split blocks if + %% it can be avoided. + case is_safe(I) of + false -> + reorder_1(Is0, D, [TryCatch|Acc]); + true -> + reorder_1([TryCatch|Is], D, [I|Acc]) + end; reorder_1([{label,L}=I|_], D, Acc) -> Is = beam_utils:code_at(L, D), reorder_1(Is, D, [I|Acc]); @@ -111,3 +121,14 @@ reorder_1([{allocate_zero,N,Live}|Is], D, reorder_1([I|Is], D, Acc) -> reorder_1(Is, D, [I|Acc]); reorder_1([], _, Acc) -> reverse(Acc). + +%% is_safe(Instruction) -> true|false +%% Test whether an instruction is safe (cannot cause an exception). + +is_safe({kill,_}) -> true; +is_safe({move,_,_}) -> true; +is_safe({put,_}) -> true; +is_safe({put_list,_,_,_}) -> true; +is_safe({put_tuple,_,_}) -> true; +is_safe({test_heap,_,_}) -> true; +is_safe(_) -> false. -- cgit v1.2.3 From 30cc5c902d9e653d48452a7f84fcd664cfc3f0a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 5 Aug 2015 19:19:56 +0200 Subject: Put 'try' in blocks to optimize allocation instructions Put 'try' instructions inside block to improve the optimization of allocation instructions. Currently, the compiler only looks at initialization of y registers inside blocks when determining which y registers that will be "naturally" initialized. --- lib/compiler/src/beam_block.erl | 7 +++++-- lib/compiler/src/beam_jump.erl | 2 +- lib/compiler/src/beam_split.erl | 4 ++-- lib/compiler/src/beam_type.erl | 4 ++-- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 49e66b379b..0b284299be 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -149,7 +149,10 @@ collect({put_map,F,Op,S,D,R,{list,Puts}}) -> collect({get_map_elements,F,S,{list,Gets}}) -> {Ss,Ds} = beam_utils:split_even(Gets), {set,Ds,[S|Ss],{get_map_elements,F}}; -collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; +collect({'catch'=Op,R,L}) -> + {set,[R],[],{try_catch,Op,L}}; +collect({'try'=Op,R,L}) -> + {set,[R],[],{try_catch,Op,L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; collect({fmove,S,D}) -> {set,[D],[S],fmove}; @@ -346,7 +349,7 @@ opt_tuple_element([]) -> []. opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) -> no; -opt_tuple_element_1([{set,_,_,{'catch',_}}|_], _, _, _) -> +opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) -> no; opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) -> case eliminate_use_of_from_reg(Is0, S, D, []) of diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 5e58e0f6ac..3b6eb19fe8 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -495,7 +495,7 @@ is_label_used_in_block({set,_,_,Info}, Lbl) -> {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; {get_map_elements,{f,F}} -> F =:= Lbl; - {'catch',{f,F}} -> F =:= Lbl; + {try_catch,_,{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; {get_tuple_element,_} -> false; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 3be9311080..bb1c0e23a9 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -57,8 +57,8 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) -> Gets = beam_utils:join_even(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); -split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> - split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[R],[],{try_catch,Op,L}}|Is], Bl, Acc) -> + split_block(Is, [], [{Op,R,L}|make_block(Bl, Acc)]); split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> split_block(Is, [], [Line|make_block(Bl, Acc)]); split_block([I|Is], Bl, Acc) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 5298589f83..40d67d1670 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -92,7 +92,7 @@ simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) - Ts = update(I, Ts0), simplify_basic_1(Is0, Ts, [I|Acc]) end; -simplify_basic_1([{set,_,_,{'catch',_}}=I|Is], _Ts, Acc) -> +simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) -> simplify_basic_1(Is, tdb_new(), [I|Acc]); simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of @@ -199,7 +199,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts = tdb_update([{D0,float}], Ts0), simplify_float_1(Is, Ts, Rs, Acc) end; -simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> +simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, Acc0), simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> -- cgit v1.2.3 From f63b503f9c7ea4d5824899dc5b287075e261e6a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 10 Aug 2015 14:27:50 +0200 Subject: Move rewriting of select_val to is_boolean from beam_peep to beam_dead We can rewrite more instances of select_val to is_boolean because it is not necessary that a particular label follows the select_val. --- lib/compiler/src/beam_dead.erl | 24 +++++++++++++++++++++--- lib/compiler/src/beam_peep.erl | 28 ---------------------------- 2 files changed, 21 insertions(+), 31 deletions(-) diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index ead88b57e9..0cb5040177 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -242,8 +242,15 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> List = shortcut_select_list(List0, Reg, D, []), Fail1 = shortcut_label(Fail0, D), Fail = shortcut_bs_test(Fail1, Is, D), - Sel = {select,select_val,Reg,{f,Fail},List}, - backward(Is, D, [Sel|Acc]); + case List of + [{atom,B1},F,{atom,B2},F] when B1 =:= not B2 -> + Test = {test,is_boolean,{f,Fail},[Reg]}, + Jump = {jump,F}, + backward([Jump,Test|Is], D, Acc); + [_|_] -> + Sel = {select,select_val,Reg,{f,Fail},List}, + backward(Is, D, [Sel|Acc]) + end; backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, @@ -295,7 +302,18 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> is_eq_exact -> combine_eqs(To, Ops0, D, Acc); _ -> {test,Op,{f,To},Ops0} end, - backward(Is, D, [I|Acc]); + case {I,Acc} of + {{test,is_atom,Fail,Ops0},[{test,is_boolean,Fail,Ops0}|_]} -> + %% An is_atom test before an is_boolean test (with the + %% same failure label) is redundant. + backward(Is, D, Acc); + {{test,_,_,_},_} -> + %% Still a test instruction. Done. + backward(Is, D, [I|Acc]); + {_,_} -> + %% Rewritten to a select_val. Rescan. + backward([I|Is], D, Acc) + end; backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To2 = shortcut_label(To1, D), diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 17fd2e502a..75be86b83f 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -65,18 +65,6 @@ function({function,Name,Arity,CLabel,Is0}) -> %% InEncoding =:= latin1, OutEncoding =:= unicode; %% InEncoding =:= latin1, OutEncoding =:= utf8 -> %% -%% (2) A select_val/4 instruction that only verifies that -%% its argument is either 'true' or 'false' can be -%% be replaced with an is_boolean/2 instruction. That is: -%% -%% select_val Reg Fail [ true Next false Next ] -%% Next: ... -%% -%% can be rewritten to -%% -%% is_boolean Fail Reg -%% Next: ... -%% peep(Is) -> peep(Is, gb_sets:empty(), []). @@ -95,12 +83,6 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), peep(Is, SeenTests, [I|Acc]); -peep([{test,is_boolean,{f,Fail},Ops}|_]=Is, SeenTests, - [{test,is_atom,{f,Fail},Ops}|Acc]) -> - %% The previous is_atom/2 test (with the same failure label) is redundant. - %% (If is_boolean(Src) is true, is_atom(Src) is also true, so it is - %% OK to still remember that we have seen is_atom/1.) - peep(Is, SeenTests, Acc); peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of false -> @@ -121,16 +103,6 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> peep(Is, SeenTests, [I|Acc]) end end; -peep([{select,select_val,Src,Fail, - [{atom,false},{f,L},{atom,true},{f,L}]}| - [{label,L}|_]=Is], SeenTests, Acc) -> - I = {test,is_boolean,Fail,[Src]}, - peep([I|Is], SeenTests, Acc); -peep([{select,select_val,Src,Fail, - [{atom,true},{f,L},{atom,false},{f,L}]}| - [{label,L}|_]=Is], SeenTests, Acc) -> - I = {test,is_boolean,Fail,[Src]}, - peep([I|Is], SeenTests, Acc); peep([I|Is], _, Acc) -> %% An unknown instruction. Throw away all information we %% have collected about test instructions. -- cgit v1.2.3 From e92ad3c4d6358cecbba7643ccc14610957ad79ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 10 Aug 2015 06:25:00 +0200 Subject: v3_core: Improve code generation for guards When translating guards to Core Erlang, it is sometimes necessary to add an is_boolean/1 guard test. Here is an example when it is necessary: o(A, B) when A or B -> ok. That would be translated to something like: o(A, B) when ((A =:= true) or (B =:= true)) and is_boolean(A) and is_boolean(B) -> ok. The is_boolean/1 tests are necessary to ensure that the guard fails for calls such as: o(true, not_boolean) However, because of a bug in v3_core, is_boolean/1 tests were added when they were not necessary. Here is an example: f(B) when not B -> ok. That would be translated to: f(B) when (B =:= false) and is_boolean(B) -> ok. The following translation will work just as well. f(B) when B =:= false -> ok. Correct the bug to suppress those unnecessary is_boolean/1 tests. --- lib/compiler/src/v3_core.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 0941ad5dd5..7c229210a0 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -469,7 +469,8 @@ unforce_tree([#iset{var=#c_var{name=V},arg=Arg0}|Es], D0) -> unforce_tree(Es, D); unforce_tree([#icall{}=Call], D) -> unforce_tree_subst(Call, D); -unforce_tree([Top], _) -> Top. +unforce_tree([#c_var{name=V}], D) -> + gb_trees:get(V, D). unforce_tree_subst(#icall{module=#c_literal{val=erlang}, name=#c_literal{val='=:='}, -- cgit v1.2.3 From 93c5e457faeccfd8ccbb1e6c587ad6df1f200408 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 21 Aug 2015 07:07:49 +0200 Subject: beam_validator: Don't allow x(1023) to be used In 45f469ca0890, the BEAM loader started to use x(1023) as scratch register for some instructions. Therefore we should not allow x(1023) to be used in code emitted by the compiler. --- lib/compiler/src/beam_block.erl | 1 - lib/compiler/src/beam_bool.erl | 2 -- lib/compiler/src/beam_clean.erl | 2 +- lib/compiler/src/beam_validator.erl | 31 +++++++++++++--------- lib/compiler/test/beam_validator_SUITE.erl | 6 ++--- .../test/beam_validator_SUITE_data/xrange.S | 4 +-- 6 files changed, 24 insertions(+), 22 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 0b284299be..4e179daa0e 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -24,7 +24,6 @@ -export([module/2]). -import(lists, [mapfoldl/3,reverse/1,reverse/2,foldl/3,member/2]). --define(MAXREG, 1024). module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 14b6381230..c9e103eae9 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -25,8 +25,6 @@ -import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]). --define(MAXREG, 1024). - -record(st, {next, %Next label number. ll %Live regs at labels. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 919ee3ee7d..7d66985791 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -141,7 +141,7 @@ renumber_labels([{bif,is_record,{f,_}, renumber_labels(Is, Acc, St); renumber_labels([{test,is_record,{f,_}=Fail, [Term,{atom,Tag}=TagAtom,{integer,Arity}]}|Is0], Acc, St) -> - Tmp = {x,1023}, + Tmp = {x,1022}, Is = case is_record_tuple(Term, Tag, Arity) of yes -> Is0; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 942d69a756..ab5fedf3bf 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -31,8 +31,6 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). --define(MAXREG, 1024). - %%-define(DEBUG, 1). -ifdef(DEBUG). -define(DBG_FORMAT(F, D), (io:format((F), (D)))). @@ -970,9 +968,9 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls. init_fregs() -> 0. -set_freg({fr,Fr}, #vst{current=#st{f=Fregs0}=St}=Vst) +set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) when is_integer(Fr), 0 =< Fr -> - limit_check(Fr), + check_limit(Freg), Bit = 1 bsl Fr, if Fregs0 band Bit =:= 0 -> @@ -985,9 +983,10 @@ set_freg(Fr, _) -> error({bad_target,Fr}). assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}}) when is_integer(Fr), 0 =< Fr -> if - Fregs band (1 bsl Fr) =/= 0 -> - limit_check(Fr); - true -> error({uninitialized_reg,Freg}) + (Fregs bsr Fr) band 1 =:= 0 -> + error({uninitialized_reg,Freg}); + true -> + ok end; assert_freg_set(Fr, _) -> error({bad_source,Fr}). @@ -1066,16 +1065,16 @@ set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst); set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst); set_type(_, _, #vst{}=Vst) -> Vst. -set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) +set_type_reg(Type, {x,X}=Reg, #vst{current=#st{x=Xs}=St}=Vst) when is_integer(X), 0 =< X -> - limit_check(X), + check_limit(Reg), Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}}; set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> - limit_check(Y), + check_limit(Reg), Ys = case gb_trees:lookup(Y, Ys0) of none -> error({invalid_store,Reg,Type}); @@ -1591,9 +1590,15 @@ return_type_math(pow, 2) -> {float,[]}; return_type_math(pi, 0) -> {float,[]}; return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. -limit_check(Num) when is_integer(Num), Num >= ?MAXREG -> - error(limit); -limit_check(_) -> ok. +check_limit({x,X}) when is_integer(X), X < 1023 -> + %% Note: x(1023) is reserved for use by the BEAM loader. + ok; +check_limit({y,Y}) when is_integer(Y), Y < 1024 -> + ok; +check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 -> + ok; +check_limit(_) -> + error(limit). min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 69391b15eb..d6deb4a730 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -107,13 +107,13 @@ xrange(Config) when is_list(Config) -> {{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4, {uninitialized_reg,{x,-1}}}}, {{t,sum_2,2}, - {{bif,'+',{f,0},[{x,0},{x,1024}],{x,0}},4, - {uninitialized_reg,{x,1024}}}}, + {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4, + {uninitialized_reg,{x,1023}}}}, {{t,sum_3,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4, {invalid_store,{x,-1},number}}}, {{t,sum_4,2}, - {{bif,'+',{f,0},[{x,0},{x,1}],{x,1024}},4,limit}}] = Errors, + {{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors, ok. yrange(Config) when is_list(Config) -> diff --git a/lib/compiler/test/beam_validator_SUITE_data/xrange.S b/lib/compiler/test/beam_validator_SUITE_data/xrange.S index c6f20288f7..a76408dde3 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/xrange.S +++ b/lib/compiler/test/beam_validator_SUITE_data/xrange.S @@ -20,7 +20,7 @@ {label,3}. {func_info,{atom,t},{atom,sum_2},2}. {label,4}. - {bif,'+',{f,0},[{x,0},{x,1024}],{x,0}}. + {bif,'+',{f,0},[{x,0},{x,1023}],{x,0}}. {'%live',1}. return. @@ -38,7 +38,7 @@ {label,7}. {func_info,{atom,t},{atom,sum_4},2}. {label,8}. - {bif,'+',{f,0},[{x,0},{x,1}],{x,1024}}. + {bif,'+',{f,0},[{x,0},{x,1}],{x,1023}}. {'%live',1}. return. -- cgit v1.2.3 From d07a3cbf1a7e71d6d18905b726319687c7010a1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 24 Aug 2015 10:41:51 +0200 Subject: Update primary bootstrap --- bootstrap/bin/start.boot | Bin 5285 -> 5285 bytes bootstrap/bin/start_clean.boot | Bin 5285 -> 5285 bytes bootstrap/lib/compiler/ebin/beam_a.beam | Bin 2700 -> 2684 bytes bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11536 -> 11480 bytes bootstrap/lib/compiler/ebin/beam_block.beam | Bin 14776 -> 16012 bytes bootstrap/lib/compiler/ebin/beam_bool.beam | Bin 16436 -> 16352 bytes bootstrap/lib/compiler/ebin/beam_bsm.beam | Bin 12740 -> 12624 bytes bootstrap/lib/compiler/ebin/beam_clean.beam | Bin 9416 -> 9272 bytes bootstrap/lib/compiler/ebin/beam_dead.beam | Bin 12156 -> 12444 bytes bootstrap/lib/compiler/ebin/beam_dict.beam | Bin 5300 -> 5248 bytes bootstrap/lib/compiler/ebin/beam_disasm.beam | Bin 26320 -> 26220 bytes bootstrap/lib/compiler/ebin/beam_except.beam | Bin 3564 -> 3540 bytes bootstrap/lib/compiler/ebin/beam_flatten.beam | Bin 3020 -> 2996 bytes bootstrap/lib/compiler/ebin/beam_jump.beam | Bin 9444 -> 9372 bytes bootstrap/lib/compiler/ebin/beam_listing.beam | Bin 2992 -> 2964 bytes bootstrap/lib/compiler/ebin/beam_peep.beam | Bin 2780 -> 2144 bytes bootstrap/lib/compiler/ebin/beam_receive.beam | Bin 6444 -> 6384 bytes bootstrap/lib/compiler/ebin/beam_reorder.beam | Bin 0 -> 1920 bytes bootstrap/lib/compiler/ebin/beam_split.beam | Bin 2416 -> 2396 bytes bootstrap/lib/compiler/ebin/beam_trim.beam | Bin 7928 -> 7864 bytes bootstrap/lib/compiler/ebin/beam_type.beam | Bin 14692 -> 14632 bytes bootstrap/lib/compiler/ebin/beam_utils.beam | Bin 13620 -> 13784 bytes bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 29640 -> 29504 bytes bootstrap/lib/compiler/ebin/beam_z.beam | Bin 2652 -> 2636 bytes bootstrap/lib/compiler/ebin/cerl.beam | Bin 32112 -> 31688 bytes bootstrap/lib/compiler/ebin/cerl_clauses.beam | Bin 2956 -> 2956 bytes bootstrap/lib/compiler/ebin/cerl_inline.beam | Bin 38940 -> 38760 bytes bootstrap/lib/compiler/ebin/cerl_sets.beam | Bin 2868 -> 2868 bytes bootstrap/lib/compiler/ebin/cerl_trees.beam | Bin 20368 -> 20360 bytes bootstrap/lib/compiler/ebin/compile.beam | Bin 39368 -> 38968 bytes bootstrap/lib/compiler/ebin/compiler.app | 1 + bootstrap/lib/compiler/ebin/core_lib.beam | Bin 5240 -> 5200 bytes bootstrap/lib/compiler/ebin/core_lint.beam | Bin 13656 -> 13580 bytes bootstrap/lib/compiler/ebin/core_parse.beam | Bin 50920 -> 50896 bytes bootstrap/lib/compiler/ebin/core_pp.beam | Bin 13252 -> 13148 bytes bootstrap/lib/compiler/ebin/core_scan.beam | Bin 6692 -> 6636 bytes bootstrap/lib/compiler/ebin/rec_env.beam | Bin 4772 -> 4720 bytes bootstrap/lib/compiler/ebin/sys_core_dsetel.beam | Bin 7340 -> 7308 bytes bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 50068 -> 49668 bytes .../lib/compiler/ebin/sys_core_fold_lists.beam | Bin 4596 -> 4596 bytes bootstrap/lib/compiler/ebin/sys_core_inline.beam | Bin 4276 -> 4236 bytes .../lib/compiler/ebin/sys_pre_attributes.beam | Bin 3348 -> 3308 bytes bootstrap/lib/compiler/ebin/sys_pre_expand.beam | Bin 14940 -> 14764 bytes bootstrap/lib/compiler/ebin/v3_codegen.beam | Bin 56912 -> 56344 bytes bootstrap/lib/compiler/ebin/v3_core.beam | Bin 53608 -> 53116 bytes bootstrap/lib/compiler/ebin/v3_kernel.beam | Bin 47352 -> 46896 bytes bootstrap/lib/compiler/ebin/v3_kernel_pp.beam | Bin 12556 -> 12472 bytes bootstrap/lib/compiler/ebin/v3_life.beam | Bin 19172 -> 19044 bytes bootstrap/lib/kernel/ebin/application.beam | Bin 4620 -> 4604 bytes .../lib/kernel/ebin/application_controller.beam | Bin 32152 -> 31932 bytes bootstrap/lib/kernel/ebin/application_master.beam | Bin 6696 -> 6632 bytes bootstrap/lib/kernel/ebin/application_starter.beam | Bin 1256 -> 1256 bytes bootstrap/lib/kernel/ebin/auth.beam | Bin 6552 -> 6516 bytes bootstrap/lib/kernel/ebin/code.beam | Bin 7136 -> 7140 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 28580 -> 28708 bytes bootstrap/lib/kernel/ebin/disk_log.beam | Bin 36492 -> 36344 bytes bootstrap/lib/kernel/ebin/disk_log_1.beam | Bin 25016 -> 24660 bytes bootstrap/lib/kernel/ebin/disk_log_server.beam | Bin 6668 -> 6624 bytes bootstrap/lib/kernel/ebin/dist_ac.beam | Bin 26656 -> 26328 bytes bootstrap/lib/kernel/ebin/dist_util.beam | Bin 10568 -> 10368 bytes bootstrap/lib/kernel/ebin/erl_boot_server.beam | Bin 6012 -> 5964 bytes bootstrap/lib/kernel/ebin/erl_ddll.beam | Bin 2916 -> 2908 bytes bootstrap/lib/kernel/ebin/erl_distribution.beam | Bin 1832 -> 1832 bytes bootstrap/lib/kernel/ebin/erl_epmd.beam | Bin 7092 -> 7068 bytes bootstrap/lib/kernel/ebin/erl_reply.beam | Bin 924 -> 920 bytes bootstrap/lib/kernel/ebin/error_handler.beam | Bin 1660 -> 1660 bytes bootstrap/lib/kernel/ebin/error_logger.beam | Bin 4480 -> 4464 bytes bootstrap/lib/kernel/ebin/erts_debug.beam | Bin 5460 -> 5452 bytes bootstrap/lib/kernel/ebin/file.beam | Bin 14556 -> 14460 bytes bootstrap/lib/kernel/ebin/file_io_server.beam | Bin 15348 -> 15212 bytes bootstrap/lib/kernel/ebin/file_server.beam | Bin 5436 -> 5408 bytes bootstrap/lib/kernel/ebin/gen_sctp.beam | Bin 3636 -> 3612 bytes bootstrap/lib/kernel/ebin/gen_tcp.beam | Bin 2416 -> 2404 bytes bootstrap/lib/kernel/ebin/gen_udp.beam | Bin 1632 -> 1616 bytes bootstrap/lib/kernel/ebin/global.beam | Bin 32764 -> 32504 bytes bootstrap/lib/kernel/ebin/global_group.beam | Bin 17740 -> 17568 bytes bootstrap/lib/kernel/ebin/group.beam | Bin 14160 -> 14040 bytes bootstrap/lib/kernel/ebin/heart.beam | Bin 4072 -> 4064 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 13516 -> 13712 bytes bootstrap/lib/kernel/ebin/inet.beam | Bin 23076 -> 23004 bytes bootstrap/lib/kernel/ebin/inet6_sctp.beam | Bin 1556 -> 1536 bytes bootstrap/lib/kernel/ebin/inet6_tcp.beam | Bin 2676 -> 2664 bytes bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam | Bin 6248 -> 6216 bytes bootstrap/lib/kernel/ebin/inet6_udp.beam | Bin 1728 -> 1728 bytes bootstrap/lib/kernel/ebin/inet_config.beam | Bin 7796 -> 7728 bytes bootstrap/lib/kernel/ebin/inet_db.beam | Bin 26652 -> 26652 bytes bootstrap/lib/kernel/ebin/inet_dns.beam | Bin 19808 -> 19664 bytes bootstrap/lib/kernel/ebin/inet_gethost_native.beam | Bin 10500 -> 10448 bytes bootstrap/lib/kernel/ebin/inet_hosts.beam | Bin 2144 -> 2140 bytes bootstrap/lib/kernel/ebin/inet_parse.beam | Bin 12940 -> 12924 bytes bootstrap/lib/kernel/ebin/inet_res.beam | Bin 14976 -> 14872 bytes bootstrap/lib/kernel/ebin/inet_sctp.beam | Bin 2324 -> 2304 bytes bootstrap/lib/kernel/ebin/inet_tcp.beam | Bin 2484 -> 2472 bytes bootstrap/lib/kernel/ebin/inet_tcp_dist.beam | Bin 6808 -> 6772 bytes bootstrap/lib/kernel/ebin/inet_udp.beam | Bin 1916 -> 1916 bytes bootstrap/lib/kernel/ebin/kernel.beam | Bin 3796 -> 3776 bytes bootstrap/lib/kernel/ebin/kernel_config.beam | Bin 2768 -> 2764 bytes bootstrap/lib/kernel/ebin/net_adm.beam | Bin 3016 -> 3012 bytes bootstrap/lib/kernel/ebin/net_kernel.beam | Bin 22760 -> 22600 bytes bootstrap/lib/kernel/ebin/os.beam | Bin 5848 -> 5836 bytes bootstrap/lib/kernel/ebin/pg2.beam | Bin 7916 -> 7912 bytes bootstrap/lib/kernel/ebin/ram_file.beam | Bin 7044 -> 6996 bytes bootstrap/lib/kernel/ebin/rpc.beam | Bin 8616 -> 8580 bytes bootstrap/lib/kernel/ebin/seq_trace.beam | Bin 1336 -> 1332 bytes bootstrap/lib/kernel/ebin/standard_error.beam | Bin 3864 -> 3864 bytes bootstrap/lib/kernel/ebin/user.beam | Bin 11588 -> 11572 bytes bootstrap/lib/kernel/ebin/user_drv.beam | Bin 11428 -> 11352 bytes bootstrap/lib/kernel/ebin/user_sup.beam | Bin 1764 -> 1752 bytes bootstrap/lib/kernel/ebin/wrap_log_reader.beam | Bin 3372 -> 3320 bytes bootstrap/lib/stdlib/ebin/array.beam | Bin 12032 -> 12008 bytes bootstrap/lib/stdlib/ebin/base64.beam | Bin 4544 -> 4544 bytes bootstrap/lib/stdlib/ebin/beam_lib.beam | Bin 18612 -> 18532 bytes bootstrap/lib/stdlib/ebin/binary.beam | Bin 3812 -> 3812 bytes bootstrap/lib/stdlib/ebin/c.beam | Bin 14660 -> 14608 bytes bootstrap/lib/stdlib/ebin/calendar.beam | Bin 5172 -> 5136 bytes bootstrap/lib/stdlib/ebin/dets.beam | Bin 53600 -> 53116 bytes bootstrap/lib/stdlib/ebin/dets_server.beam | Bin 7028 -> 6988 bytes bootstrap/lib/stdlib/ebin/dets_utils.beam | Bin 28764 -> 28684 bytes bootstrap/lib/stdlib/ebin/dets_v8.beam | Bin 27592 -> 27448 bytes bootstrap/lib/stdlib/ebin/dets_v9.beam | Bin 50200 -> 49808 bytes bootstrap/lib/stdlib/ebin/dict.beam | Bin 9332 -> 9272 bytes bootstrap/lib/stdlib/ebin/digraph.beam | Bin 8308 -> 8192 bytes bootstrap/lib/stdlib/ebin/digraph_utils.beam | Bin 6844 -> 6824 bytes bootstrap/lib/stdlib/ebin/edlin.beam | Bin 10196 -> 10136 bytes bootstrap/lib/stdlib/ebin/edlin_expand.beam | Bin 3164 -> 3156 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 28220 -> 28016 bytes bootstrap/lib/stdlib/ebin/erl_anno.beam | Bin 4900 -> 4808 bytes bootstrap/lib/stdlib/ebin/erl_bits.beam | Bin 2552 -> 2528 bytes bootstrap/lib/stdlib/ebin/erl_compile.beam | Bin 7324 -> 7280 bytes bootstrap/lib/stdlib/ebin/erl_eval.beam | Bin 30980 -> 30624 bytes bootstrap/lib/stdlib/ebin/erl_expand_records.beam | Bin 22536 -> 22328 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89840 -> 89040 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 308128 -> 84136 bytes bootstrap/lib/stdlib/ebin/erl_pp.beam | Bin 26880 -> 26956 bytes bootstrap/lib/stdlib/ebin/erl_scan.beam | Bin 31380 -> 31308 bytes bootstrap/lib/stdlib/ebin/erl_tar.beam | Bin 17256 -> 17156 bytes bootstrap/lib/stdlib/ebin/error_logger_file_h.beam | Bin 5124 -> 5084 bytes bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam | Bin 5052 -> 5020 bytes bootstrap/lib/stdlib/ebin/escript.beam | Bin 17676 -> 17592 bytes bootstrap/lib/stdlib/ebin/ets.beam | Bin 22604 -> 22604 bytes bootstrap/lib/stdlib/ebin/eval_bits.beam | Bin 8136 -> 8096 bytes bootstrap/lib/stdlib/ebin/file_sorter.beam | Bin 30668 -> 30436 bytes bootstrap/lib/stdlib/ebin/filelib.beam | Bin 8088 -> 8056 bytes bootstrap/lib/stdlib/ebin/filename.beam | Bin 12512 -> 12500 bytes bootstrap/lib/stdlib/ebin/gb_sets.beam | Bin 8432 -> 8396 bytes bootstrap/lib/stdlib/ebin/gb_trees.beam | Bin 5176 -> 5128 bytes bootstrap/lib/stdlib/ebin/gen.beam | Bin 4296 -> 4276 bytes bootstrap/lib/stdlib/ebin/gen_event.beam | Bin 19752 -> 19484 bytes bootstrap/lib/stdlib/ebin/gen_fsm.beam | Bin 17412 -> 17324 bytes bootstrap/lib/stdlib/ebin/gen_server.beam | Bin 19648 -> 19508 bytes bootstrap/lib/stdlib/ebin/io.beam | Bin 6696 -> 6680 bytes bootstrap/lib/stdlib/ebin/io_lib.beam | Bin 10008 -> 9988 bytes bootstrap/lib/stdlib/ebin/io_lib_format.beam | Bin 13404 -> 13372 bytes bootstrap/lib/stdlib/ebin/io_lib_fread.beam | Bin 7384 -> 7280 bytes bootstrap/lib/stdlib/ebin/io_lib_pretty.beam | Bin 15224 -> 15212 bytes bootstrap/lib/stdlib/ebin/lib.beam | Bin 9660 -> 9600 bytes bootstrap/lib/stdlib/ebin/lists.beam | Bin 29708 -> 29708 bytes bootstrap/lib/stdlib/ebin/log_mf_h.beam | Bin 2672 -> 2636 bytes bootstrap/lib/stdlib/ebin/maps.beam | Bin 2628 -> 2624 bytes bootstrap/lib/stdlib/ebin/ms_transform.beam | Bin 20632 -> 20420 bytes bootstrap/lib/stdlib/ebin/orddict.beam | Bin 2792 -> 2772 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11248 -> 11536 bytes bootstrap/lib/stdlib/ebin/pool.beam | Bin 3848 -> 3836 bytes bootstrap/lib/stdlib/ebin/proc_lib.beam | Bin 10460 -> 10432 bytes bootstrap/lib/stdlib/ebin/proplists.beam | Bin 4948 -> 4944 bytes bootstrap/lib/stdlib/ebin/qlc.beam | Bin 70644 -> 70124 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 76520 -> 76072 bytes bootstrap/lib/stdlib/ebin/rand.beam | Bin 13452 -> 13444 bytes bootstrap/lib/stdlib/ebin/random.beam | Bin 1712 -> 1704 bytes bootstrap/lib/stdlib/ebin/re.beam | Bin 13844 -> 13804 bytes bootstrap/lib/stdlib/ebin/sets.beam | Bin 7096 -> 7060 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 30452 -> 30260 bytes bootstrap/lib/stdlib/ebin/slave.beam | Bin 5200 -> 4852 bytes bootstrap/lib/stdlib/ebin/sofs.beam | Bin 40816 -> 40696 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 24072 -> 23884 bytes bootstrap/lib/stdlib/ebin/supervisor_bridge.beam | Bin 2932 -> 2900 bytes bootstrap/lib/stdlib/ebin/sys.beam | Bin 8620 -> 8564 bytes bootstrap/lib/stdlib/ebin/timer.beam | Bin 5488 -> 5476 bytes bootstrap/lib/stdlib/ebin/unicode.beam | Bin 11616 -> 11584 bytes bootstrap/lib/stdlib/ebin/win32reg.beam | Bin 5632 -> 5600 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 27080 -> 26812 bytes bootstrap/lib/stdlib/include/assert.hrl | 261 +++++++++++++++++++++ 182 files changed, 262 insertions(+) create mode 100644 bootstrap/lib/compiler/ebin/beam_reorder.beam create mode 100644 bootstrap/lib/stdlib/include/assert.hrl diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot index 25c092961c..421e14f015 100644 Binary files a/bootstrap/bin/start.boot and b/bootstrap/bin/start.boot differ diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot index 25c092961c..421e14f015 100644 Binary files a/bootstrap/bin/start_clean.boot and b/bootstrap/bin/start_clean.boot differ diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam index 3ff689bd81..599f9cb073 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_a.beam and b/bootstrap/lib/compiler/ebin/beam_a.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index b25c33084f..90808bd195 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam index 59084464a0..4c638cac32 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_block.beam and b/bootstrap/lib/compiler/ebin/beam_block.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam index 0fa7612114..15ca7ee757 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bool.beam and b/bootstrap/lib/compiler/ebin/beam_bool.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam index a6757dfcfb..4294fcb23f 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bsm.beam and b/bootstrap/lib/compiler/ebin/beam_bsm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam index 2fd2d2a82f..52e6a797d4 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_clean.beam and b/bootstrap/lib/compiler/ebin/beam_clean.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam index 6ae6de1d8b..8e3df16335 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dead.beam and b/bootstrap/lib/compiler/ebin/beam_dead.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam index 17b3c40eda..1576d1bb8f 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dict.beam and b/bootstrap/lib/compiler/ebin/beam_dict.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index b63864c96c..932da83c77 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam index f4fccfeef7..e5d2c51c4d 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_except.beam and b/bootstrap/lib/compiler/ebin/beam_except.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam index c1d5604349..f6fc8dfc50 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_flatten.beam and b/bootstrap/lib/compiler/ebin/beam_flatten.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam index 8dd6375403..7382cafb48 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_jump.beam and b/bootstrap/lib/compiler/ebin/beam_jump.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam index 4d8f94c4ea..41fac49d23 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_listing.beam and b/bootstrap/lib/compiler/ebin/beam_listing.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam index 7a7856e247..c08f6254ec 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_peep.beam and b/bootstrap/lib/compiler/ebin/beam_peep.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam index 78c9eb1c39..0aa196f3de 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_receive.beam and b/bootstrap/lib/compiler/ebin/beam_receive.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam new file mode 100644 index 0000000000..d884aa011d Binary files /dev/null and b/bootstrap/lib/compiler/ebin/beam_reorder.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam index 4821d92c96..a4e2b78938 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_split.beam and b/bootstrap/lib/compiler/ebin/beam_split.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam index 6878a8a01c..194882f68a 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_trim.beam and b/bootstrap/lib/compiler/ebin/beam_trim.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam index cb3bc1a8bd..4c766059ac 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_type.beam and b/bootstrap/lib/compiler/ebin/beam_type.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam index fc2e1b6c78..813b9dc576 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_utils.beam and b/bootstrap/lib/compiler/ebin/beam_utils.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index 38b749d9ae..b19913760c 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam index ac156a37e9..7bf77d7d33 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_z.beam and b/bootstrap/lib/compiler/ebin/beam_z.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam index 758861af20..32e0485ff8 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl.beam and b/bootstrap/lib/compiler/ebin/cerl.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam index 2357df79f4..95dd3f3cbb 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_clauses.beam and b/bootstrap/lib/compiler/ebin/cerl_clauses.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam index 0e466ad38e..75a3bdf771 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_inline.beam and b/bootstrap/lib/compiler/ebin/cerl_inline.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_sets.beam b/bootstrap/lib/compiler/ebin/cerl_sets.beam index d16543cdbe..20cf324b41 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_sets.beam and b/bootstrap/lib/compiler/ebin/cerl_sets.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam index fc1a7e04f8..76b19363e9 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_trees.beam and b/bootstrap/lib/compiler/ebin/cerl_trees.beam differ diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam index 111f85acd2..562eae315a 100644 Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index d3b2296ea4..e41604f261 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -37,6 +37,7 @@ beam_opcodes, beam_peep, beam_receive, + beam_reorder, beam_split, beam_trim, beam_type, diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam index ec87099635..f5973746a3 100644 Binary files a/bootstrap/lib/compiler/ebin/core_lib.beam and b/bootstrap/lib/compiler/ebin/core_lib.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam index b1cbbf030d..69143cdd23 100644 Binary files a/bootstrap/lib/compiler/ebin/core_lint.beam and b/bootstrap/lib/compiler/ebin/core_lint.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam index 025ac1591b..3ef8588f65 100644 Binary files a/bootstrap/lib/compiler/ebin/core_parse.beam and b/bootstrap/lib/compiler/ebin/core_parse.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam index 7ba89c698e..f320fd6908 100644 Binary files a/bootstrap/lib/compiler/ebin/core_pp.beam and b/bootstrap/lib/compiler/ebin/core_pp.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam index c54edfc0e7..5f7b22ba8b 100644 Binary files a/bootstrap/lib/compiler/ebin/core_scan.beam and b/bootstrap/lib/compiler/ebin/core_scan.beam differ diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam index c49a2e23e9..69d3f62ca0 100644 Binary files a/bootstrap/lib/compiler/ebin/rec_env.beam and b/bootstrap/lib/compiler/ebin/rec_env.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam index 14c69eec6c..10df50e1e5 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam and b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam index 1b5467a54b..8942f40f4d 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam index 58ae7c0393..20cd2af6bc 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam index 4f44297bee..963b7ef6e1 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_inline.beam and b/bootstrap/lib/compiler/ebin/sys_core_inline.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam index a1c6466ccd..934a539ad9 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam and b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam index 6eba755081..d82f802bd7 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam and b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam index e53f0fcd12..5f5b8b9213 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_codegen.beam and b/bootstrap/lib/compiler/ebin/v3_codegen.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam index e4c5f51f77..2082153b33 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_core.beam and b/bootstrap/lib/compiler/ebin/v3_core.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam index f5cdbb6e40..d451819f19 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel.beam and b/bootstrap/lib/compiler/ebin/v3_kernel.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam index d54716bbee..306ecb1569 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam and b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam index 741a702e88..d8822f929f 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_life.beam and b/bootstrap/lib/compiler/ebin/v3_life.beam differ diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam index d8e98c021b..c80144ec65 100644 Binary files a/bootstrap/lib/kernel/ebin/application.beam and b/bootstrap/lib/kernel/ebin/application.beam differ diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam index c4fa46e33e..2b3c8cf454 100644 Binary files a/bootstrap/lib/kernel/ebin/application_controller.beam and b/bootstrap/lib/kernel/ebin/application_controller.beam differ diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam index b81dfa81d3..24492a6771 100644 Binary files a/bootstrap/lib/kernel/ebin/application_master.beam and b/bootstrap/lib/kernel/ebin/application_master.beam differ diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam index f5059a487a..043e15fb2a 100644 Binary files a/bootstrap/lib/kernel/ebin/application_starter.beam and b/bootstrap/lib/kernel/ebin/application_starter.beam differ diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam index 74dde4fd1c..cbe477830b 100644 Binary files a/bootstrap/lib/kernel/ebin/auth.beam and b/bootstrap/lib/kernel/ebin/auth.beam differ diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index 55d123c6a2..2a61400c9a 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index aa75ae9bd1..b51e120974 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam index 287a8c0de8..ba4c54d72b 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log.beam and b/bootstrap/lib/kernel/ebin/disk_log.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam index 55a9365f05..c4a071afd6 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log_1.beam and b/bootstrap/lib/kernel/ebin/disk_log_1.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam index 8c1622c7d8..50154045be 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log_server.beam and b/bootstrap/lib/kernel/ebin/disk_log_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam index ea948cfe88..d2c186f03a 100644 Binary files a/bootstrap/lib/kernel/ebin/dist_ac.beam and b/bootstrap/lib/kernel/ebin/dist_ac.beam differ diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam index c92373c68e..14bc5aeaeb 100644 Binary files a/bootstrap/lib/kernel/ebin/dist_util.beam and b/bootstrap/lib/kernel/ebin/dist_util.beam differ diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam index 91899fe231..20c41fd06e 100644 Binary files a/bootstrap/lib/kernel/ebin/erl_boot_server.beam and b/bootstrap/lib/kernel/ebin/erl_boot_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam index e15e49d61c..0a644d2e38 100644 Binary files a/bootstrap/lib/kernel/ebin/erl_ddll.beam and b/bootstrap/lib/kernel/ebin/erl_ddll.beam differ diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam index 9a6acc0585..eacacf799c 100644 Binary files a/bootstrap/lib/kernel/ebin/erl_distribution.beam and b/bootstrap/lib/kernel/ebin/erl_distribution.beam differ diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam index 92d6387af3..267958ae88 100644 Binary files a/bootstrap/lib/kernel/ebin/erl_epmd.beam and b/bootstrap/lib/kernel/ebin/erl_epmd.beam differ diff --git a/bootstrap/lib/kernel/ebin/erl_reply.beam b/bootstrap/lib/kernel/ebin/erl_reply.beam index 79fb539bd3..6cf7d9e196 100644 Binary files a/bootstrap/lib/kernel/ebin/erl_reply.beam and b/bootstrap/lib/kernel/ebin/erl_reply.beam differ diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam index 740ba28f72..64f44baeb7 100644 Binary files a/bootstrap/lib/kernel/ebin/error_handler.beam and b/bootstrap/lib/kernel/ebin/error_handler.beam differ diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam index 10f7a0b984..64c2d58205 100644 Binary files a/bootstrap/lib/kernel/ebin/error_logger.beam and b/bootstrap/lib/kernel/ebin/error_logger.beam differ diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam index bd73ff6c5c..d1a60d5cd9 100644 Binary files a/bootstrap/lib/kernel/ebin/erts_debug.beam and b/bootstrap/lib/kernel/ebin/erts_debug.beam differ diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam index 32a3a27993..a66a2621b9 100644 Binary files a/bootstrap/lib/kernel/ebin/file.beam and b/bootstrap/lib/kernel/ebin/file.beam differ diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam index be820676ed..ac176f5aab 100644 Binary files a/bootstrap/lib/kernel/ebin/file_io_server.beam and b/bootstrap/lib/kernel/ebin/file_io_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam index 48352e9dfd..151293e05c 100644 Binary files a/bootstrap/lib/kernel/ebin/file_server.beam and b/bootstrap/lib/kernel/ebin/file_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam index e2bb806f2b..91aaa41063 100644 Binary files a/bootstrap/lib/kernel/ebin/gen_sctp.beam and b/bootstrap/lib/kernel/ebin/gen_sctp.beam differ diff --git a/bootstrap/lib/kernel/ebin/gen_tcp.beam b/bootstrap/lib/kernel/ebin/gen_tcp.beam index 0182e11345..e40f1f2e45 100644 Binary files a/bootstrap/lib/kernel/ebin/gen_tcp.beam and b/bootstrap/lib/kernel/ebin/gen_tcp.beam differ diff --git a/bootstrap/lib/kernel/ebin/gen_udp.beam b/bootstrap/lib/kernel/ebin/gen_udp.beam index e49561399d..ec4eda12f7 100644 Binary files a/bootstrap/lib/kernel/ebin/gen_udp.beam and b/bootstrap/lib/kernel/ebin/gen_udp.beam differ diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam index 158fbd1c93..893b1bf0fe 100644 Binary files a/bootstrap/lib/kernel/ebin/global.beam and b/bootstrap/lib/kernel/ebin/global.beam differ diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam index 85306ef123..534d46de2a 100644 Binary files a/bootstrap/lib/kernel/ebin/global_group.beam and b/bootstrap/lib/kernel/ebin/global_group.beam differ diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam index 0f72880f49..3df8f6030c 100644 Binary files a/bootstrap/lib/kernel/ebin/group.beam and b/bootstrap/lib/kernel/ebin/group.beam differ diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam index d4972ecdd2..bd24310b0b 100644 Binary files a/bootstrap/lib/kernel/ebin/heart.beam and b/bootstrap/lib/kernel/ebin/heart.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index fc12b6b194..a2987da34b 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam index a76806293f..cb1aa0fe8b 100644 Binary files a/bootstrap/lib/kernel/ebin/inet.beam and b/bootstrap/lib/kernel/ebin/inet.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_sctp.beam b/bootstrap/lib/kernel/ebin/inet6_sctp.beam index 10c2644259..5c827589bd 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_sctp.beam and b/bootstrap/lib/kernel/ebin/inet6_sctp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam index d080a1200b..3f3936dc91 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_tcp.beam and b/bootstrap/lib/kernel/ebin/inet6_tcp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam index 3f98206013..fa464256f3 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam index 73f0b52b90..2eb8c09701 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_udp.beam and b/bootstrap/lib/kernel/ebin/inet6_udp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam index f31fb16742..f49fa7a376 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_config.beam and b/bootstrap/lib/kernel/ebin/inet_config.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam index 8c7c6ba218..8b6273610c 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_db.beam and b/bootstrap/lib/kernel/ebin/inet_db.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam index 0c5b6c73e1..9404760336 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_dns.beam and b/bootstrap/lib/kernel/ebin/inet_dns.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam index 098c397936..f87b79e2ff 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam and b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam index 3e70a8b8c1..7278913418 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_hosts.beam and b/bootstrap/lib/kernel/ebin/inet_hosts.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam index 294afcea30..4323d12bf1 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_parse.beam and b/bootstrap/lib/kernel/ebin/inet_parse.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam index f35242f49a..b89b54e0bc 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_res.beam and b/bootstrap/lib/kernel/ebin/inet_res.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam index 19506c14e9..835c7b2928 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_sctp.beam and b/bootstrap/lib/kernel/ebin/inet_sctp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam index 60e0d9f569..65dbeeeef8 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_tcp.beam and b/bootstrap/lib/kernel/ebin/inet_tcp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam index a3635e5dde..2437e97387 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam index 6fbdd29f6d..6876ba3892 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_udp.beam and b/bootstrap/lib/kernel/ebin/inet_udp.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam index caeda89fa5..1dae85119a 100644 Binary files a/bootstrap/lib/kernel/ebin/kernel.beam and b/bootstrap/lib/kernel/ebin/kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam index 5a4649a054..8691aff64a 100644 Binary files a/bootstrap/lib/kernel/ebin/kernel_config.beam and b/bootstrap/lib/kernel/ebin/kernel_config.beam differ diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam index 4b09aae8a5..50dbfcf541 100644 Binary files a/bootstrap/lib/kernel/ebin/net_adm.beam and b/bootstrap/lib/kernel/ebin/net_adm.beam differ diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam index 9a0bfa2ba4..bd15759017 100644 Binary files a/bootstrap/lib/kernel/ebin/net_kernel.beam and b/bootstrap/lib/kernel/ebin/net_kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam index 9eaf7dfe5d..054c70e8b1 100644 Binary files a/bootstrap/lib/kernel/ebin/os.beam and b/bootstrap/lib/kernel/ebin/os.beam differ diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam index 944f6a27a4..2115e46b60 100644 Binary files a/bootstrap/lib/kernel/ebin/pg2.beam and b/bootstrap/lib/kernel/ebin/pg2.beam differ diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam index a8b23f5490..b119b3656c 100644 Binary files a/bootstrap/lib/kernel/ebin/ram_file.beam and b/bootstrap/lib/kernel/ebin/ram_file.beam differ diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam index 4a8aa5da69..11c41fdc05 100644 Binary files a/bootstrap/lib/kernel/ebin/rpc.beam and b/bootstrap/lib/kernel/ebin/rpc.beam differ diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam index 13489135a2..775f43ce2f 100644 Binary files a/bootstrap/lib/kernel/ebin/seq_trace.beam and b/bootstrap/lib/kernel/ebin/seq_trace.beam differ diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam index be4f9292e7..9dfd66b2f4 100644 Binary files a/bootstrap/lib/kernel/ebin/standard_error.beam and b/bootstrap/lib/kernel/ebin/standard_error.beam differ diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam index d69339866a..5b07718039 100644 Binary files a/bootstrap/lib/kernel/ebin/user.beam and b/bootstrap/lib/kernel/ebin/user.beam differ diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam index 726a130b55..971c19a824 100644 Binary files a/bootstrap/lib/kernel/ebin/user_drv.beam and b/bootstrap/lib/kernel/ebin/user_drv.beam differ diff --git a/bootstrap/lib/kernel/ebin/user_sup.beam b/bootstrap/lib/kernel/ebin/user_sup.beam index 79dd095896..9e7b95544d 100644 Binary files a/bootstrap/lib/kernel/ebin/user_sup.beam and b/bootstrap/lib/kernel/ebin/user_sup.beam differ diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam index 68578800a0..91ef523b99 100644 Binary files a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam and b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam differ diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam index 4ad9c7cd04..4ad8942b06 100644 Binary files a/bootstrap/lib/stdlib/ebin/array.beam and b/bootstrap/lib/stdlib/ebin/array.beam differ diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam index e8d4b44102..9ea98fb928 100644 Binary files a/bootstrap/lib/stdlib/ebin/base64.beam and b/bootstrap/lib/stdlib/ebin/base64.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index abf4949465..67aeb1a587 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam index 666544c492..a1f369e834 100644 Binary files a/bootstrap/lib/stdlib/ebin/binary.beam and b/bootstrap/lib/stdlib/ebin/binary.beam differ diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam index 0e07dc1531..133035102e 100644 Binary files a/bootstrap/lib/stdlib/ebin/c.beam and b/bootstrap/lib/stdlib/ebin/c.beam differ diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam index 383d66e1a8..e71eebae3f 100644 Binary files a/bootstrap/lib/stdlib/ebin/calendar.beam and b/bootstrap/lib/stdlib/ebin/calendar.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam index 100996bf85..d9d34914f9 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets.beam and b/bootstrap/lib/stdlib/ebin/dets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam index 46c6769dfe..da999f3025 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_server.beam and b/bootstrap/lib/stdlib/ebin/dets_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam index f2d1d86a60..964ed4e791 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_utils.beam and b/bootstrap/lib/stdlib/ebin/dets_utils.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam index eca5a85114..6c2a3e9efb 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v8.beam and b/bootstrap/lib/stdlib/ebin/dets_v8.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam index 711ca0b9f0..2b68042bf1 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v9.beam and b/bootstrap/lib/stdlib/ebin/dets_v9.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam index 6ba808d6af..45cc303498 100644 Binary files a/bootstrap/lib/stdlib/ebin/dict.beam and b/bootstrap/lib/stdlib/ebin/dict.beam differ diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam index 40db38c992..28b65ce7b5 100644 Binary files a/bootstrap/lib/stdlib/ebin/digraph.beam and b/bootstrap/lib/stdlib/ebin/digraph.beam differ diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam index 458c6d2895..9065fda936 100644 Binary files a/bootstrap/lib/stdlib/ebin/digraph_utils.beam and b/bootstrap/lib/stdlib/ebin/digraph_utils.beam differ diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam index 4d052a0c50..b1c5af32ba 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin.beam and b/bootstrap/lib/stdlib/ebin/edlin.beam differ diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam index 3d9846bdcf..adc0f4ba1c 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin_expand.beam and b/bootstrap/lib/stdlib/ebin/edlin_expand.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index 00cf6f2a5c..c144ae0f21 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam index 4807dac5f9..a254259665 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_anno.beam and b/bootstrap/lib/stdlib/ebin/erl_anno.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam index 627b9ca711..af8619bac0 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_bits.beam and b/bootstrap/lib/stdlib/ebin/erl_bits.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam index e650afbf6d..82949da20a 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_compile.beam and b/bootstrap/lib/stdlib/ebin/erl_compile.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam index 2354a065ca..c8358c42b8 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_eval.beam and b/bootstrap/lib/stdlib/ebin/erl_eval.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam index db2d0e6b85..001709532a 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam and b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 16cacefb7c..5657d00131 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 0522f5c05e..6bd75ad6b9 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam index f38ba5fa71..d97b5e075b 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_pp.beam and b/bootstrap/lib/stdlib/ebin/erl_pp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam index c29200f2e0..c555a25a9c 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_scan.beam and b/bootstrap/lib/stdlib/ebin/erl_scan.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam index e525b3738b..9bcbabc27c 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_tar.beam and b/bootstrap/lib/stdlib/ebin/erl_tar.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam index 5c1bc6045f..b7ced33bc1 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam index 9711f57e43..1211fecf41 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam index e923cecea8..c006d9a1ad 100644 Binary files a/bootstrap/lib/stdlib/ebin/escript.beam and b/bootstrap/lib/stdlib/ebin/escript.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam index 7d30fc9fc1..a15534b365 100644 Binary files a/bootstrap/lib/stdlib/ebin/ets.beam and b/bootstrap/lib/stdlib/ebin/ets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam index 6627e1132c..be20e8c720 100644 Binary files a/bootstrap/lib/stdlib/ebin/eval_bits.beam and b/bootstrap/lib/stdlib/ebin/eval_bits.beam differ diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam index a2a82fb77d..78d9d727eb 100644 Binary files a/bootstrap/lib/stdlib/ebin/file_sorter.beam and b/bootstrap/lib/stdlib/ebin/file_sorter.beam differ diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam index 5941f9189f..5ea27fdca6 100644 Binary files a/bootstrap/lib/stdlib/ebin/filelib.beam and b/bootstrap/lib/stdlib/ebin/filelib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam index e4b462f5ff..7df2d414f4 100644 Binary files a/bootstrap/lib/stdlib/ebin/filename.beam and b/bootstrap/lib/stdlib/ebin/filename.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam index 71da2376ba..3cb606350b 100644 Binary files a/bootstrap/lib/stdlib/ebin/gb_sets.beam and b/bootstrap/lib/stdlib/ebin/gb_sets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam index db59d5af19..d8579c63cd 100644 Binary files a/bootstrap/lib/stdlib/ebin/gb_trees.beam and b/bootstrap/lib/stdlib/ebin/gb_trees.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam index ccaabd8087..260e33f30e 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen.beam and b/bootstrap/lib/stdlib/ebin/gen.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam index bc3e71f6a7..4d64451826 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_event.beam and b/bootstrap/lib/stdlib/ebin/gen_event.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam index 268b8798c8..5e26fae139 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_fsm.beam and b/bootstrap/lib/stdlib/ebin/gen_fsm.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam index 1e1e530eea..6b1a335e48 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_server.beam and b/bootstrap/lib/stdlib/ebin/gen_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam index fd64aedde1..1f2a113fdd 100644 Binary files a/bootstrap/lib/stdlib/ebin/io.beam and b/bootstrap/lib/stdlib/ebin/io.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam index c95a88c0f0..5797180d1e 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib.beam and b/bootstrap/lib/stdlib/ebin/io_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam index 032e15eeb1..baff44c53b 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_format.beam and b/bootstrap/lib/stdlib/ebin/io_lib_format.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam index b4af88d5b5..62a4beeb2d 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam and b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam index eed02e5fa5..7a5ec3d7f5 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam and b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam differ diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam index 1cc92d1b8d..8e594d97ad 100644 Binary files a/bootstrap/lib/stdlib/ebin/lib.beam and b/bootstrap/lib/stdlib/ebin/lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam index 9db37e21d4..56b9d2c88a 100644 Binary files a/bootstrap/lib/stdlib/ebin/lists.beam and b/bootstrap/lib/stdlib/ebin/lists.beam differ diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam index 58a8d68ed5..0c4b22c3df 100644 Binary files a/bootstrap/lib/stdlib/ebin/log_mf_h.beam and b/bootstrap/lib/stdlib/ebin/log_mf_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam index d1aa8bb9dd..d616a902ae 100644 Binary files a/bootstrap/lib/stdlib/ebin/maps.beam and b/bootstrap/lib/stdlib/ebin/maps.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam index cc8503fdb3..d3ae7b6775 100644 Binary files a/bootstrap/lib/stdlib/ebin/ms_transform.beam and b/bootstrap/lib/stdlib/ebin/ms_transform.beam differ diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam index 665941a17c..f04348f982 100644 Binary files a/bootstrap/lib/stdlib/ebin/orddict.beam and b/bootstrap/lib/stdlib/ebin/orddict.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 52b13fb974..9e63d204b6 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam index 72934a42d7..a06ae1717a 100644 Binary files a/bootstrap/lib/stdlib/ebin/pool.beam and b/bootstrap/lib/stdlib/ebin/pool.beam differ diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam index cb6a8d6049..6e02f1fae2 100644 Binary files a/bootstrap/lib/stdlib/ebin/proc_lib.beam and b/bootstrap/lib/stdlib/ebin/proc_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam index 2640cfe4ae..835df8c3a0 100644 Binary files a/bootstrap/lib/stdlib/ebin/proplists.beam and b/bootstrap/lib/stdlib/ebin/proplists.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam index 652604afc0..51529c5570 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc.beam and b/bootstrap/lib/stdlib/ebin/qlc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 0e59d769a4..915c8dfc91 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam index b6e0d20bd7..588bbb3394 100644 Binary files a/bootstrap/lib/stdlib/ebin/rand.beam and b/bootstrap/lib/stdlib/ebin/rand.beam differ diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam index f576b310df..e1d62c98d5 100644 Binary files a/bootstrap/lib/stdlib/ebin/random.beam and b/bootstrap/lib/stdlib/ebin/random.beam differ diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam index 9e140def2c..ea3a7afb4f 100644 Binary files a/bootstrap/lib/stdlib/ebin/re.beam and b/bootstrap/lib/stdlib/ebin/re.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam index d8546de28d..4d4a2205f9 100644 Binary files a/bootstrap/lib/stdlib/ebin/sets.beam and b/bootstrap/lib/stdlib/ebin/sets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index 3b2d0eb0fa..3b9f67eb29 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam index 532c46cd38..373d65f198 100644 Binary files a/bootstrap/lib/stdlib/ebin/slave.beam and b/bootstrap/lib/stdlib/ebin/slave.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam index 976483833f..8de0d8435e 100644 Binary files a/bootstrap/lib/stdlib/ebin/sofs.beam and b/bootstrap/lib/stdlib/ebin/sofs.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index 6dd01bf004..e5ab7f8fc7 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam index 1ebc561ee5..279fded868 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam and b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam index a569f8003f..d0162bdd07 100644 Binary files a/bootstrap/lib/stdlib/ebin/sys.beam and b/bootstrap/lib/stdlib/ebin/sys.beam differ diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam index 9887f37c70..8d8fcf8937 100644 Binary files a/bootstrap/lib/stdlib/ebin/timer.beam and b/bootstrap/lib/stdlib/ebin/timer.beam differ diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam index 16557d5631..3544510884 100644 Binary files a/bootstrap/lib/stdlib/ebin/unicode.beam and b/bootstrap/lib/stdlib/ebin/unicode.beam differ diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam index b37ead63ba..2b4f9229ea 100644 Binary files a/bootstrap/lib/stdlib/ebin/win32reg.beam and b/bootstrap/lib/stdlib/ebin/win32reg.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index e80b6ae0cd..71b7d63112 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ diff --git a/bootstrap/lib/stdlib/include/assert.hrl b/bootstrap/lib/stdlib/include/assert.hrl new file mode 100644 index 0000000000..f913760102 --- /dev/null +++ b/bootstrap/lib/stdlib/include/assert.hrl @@ -0,0 +1,261 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(ASSERT_HRL). +-define(ASSERT_HRL, true). + +%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to +%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes +%% precedence, and NOASSERT will become undefined. +%% +%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or +%% ASSERT are defined. +%% +%% If asserts are disabled, all assert macros are defined to be the atom +%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok' +%% as the result if the test succeeds, and raise an error exception if the +%% test fails. The error term will then have the form {Name, Info} where +%% Name is the name of the macro and Info is a list of tagged tuples. + +%% allow NODEBUG to imply NOASSERT, unless DEBUG +-ifdef(NODEBUG). +-ifndef(DEBUG). +-ifndef(NOASSERT). +-define(NOASSERT, true). +-endif. +-endif. +-endif. + +%% allow ASSERT to override NOASSERT +-ifdef(ASSERT). +-undef(NOASSERT). +-endif. + +%% Assert macros must not depend on any non-kernel or stdlib libraries. +%% +%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid +%% exporting local variables, and furthermore we only use variable names +%% prefixed with "__", that hopefully will not be bound outside the fun. +%% It is not possible to nest assert macros. + +-ifdef(NOASSERT). +-define(assert(BoolExpr),ok). +-else. +%% The assert macro is written the way it is so as not to cause warnings +%% for clauses that cannot match, even if the expression is a constant. +-define(assert(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + true -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, true}, + case __V of false -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assert, for convenience. +-ifdef(NOASSERT). +-define(assertNot(BoolExpr),ok). +-else. +-define(assertNot(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + false -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, false}, + case __V of true -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is mostly a convenience which gives more detailed reports. +%% Note: Guard is a guarded pattern, and can not be used for value. +-ifdef(NOASSERT). +-define(assertMatch(Guard, Expr), ok). +-else. +-define(assertMatch(Guard, Expr), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). +-endif. + +%% This is a convenience macro which gives more detailed reports when +%% the expected LHS value is not a pattern, but a computed value +-ifdef(NOASSERT). +-define(assertEqual(Expect, Expr), ok). +-else. +-define(assertEqual(Expect, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)(Expect)) + end). +-endif. + +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected)) + end). +-endif. + +%% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. +-ifdef(NOASSERT). +-define(assertException(Class, Term, Expr), ok). +-else. +-define(assertException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). +-endif. + +-define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). + +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). +-endif. + +-endif. % ASSERT_HRL -- cgit v1.2.3 From 3a3e91b3592c911fc251c496421135a1a116fa00 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 7 Sep 2015 16:57:30 +0200 Subject: Fix watchdog function_clause Commit 4f365c07 introduced the error on set_watchdog/2, as a consequence of timeout/1 returning stop, which only happens with accepting transports with {restrict_connections, false}. --- lib/diameter/src/base/diameter_watchdog.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 885dc6c801..26bca7a5bc 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -539,13 +539,13 @@ set_watchdog(#watchdog{tref = undefined} = S) -> %% Timer already set: start at new one only at expiry. set_watchdog(#watchdog{} = S) -> - S#watchdog{tref = now()}; - -set_watchdog(stop = No) -> - No. + S#watchdog{tref = now()}. %% set_watchdog/2 +set_watchdog(_, stop = No) -> + No; + set_watchdog(Ms, #watchdog{tw = TwInit} = S) -> S#watchdog{tref = erlang:start_timer(tw(TwInit, Ms), self(), tw)}. -- cgit v1.2.3 From 52595d8da8bc43da6848075f869111e0de1dceb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Sep 2015 15:44:45 +0200 Subject: core_lib: Remove previously deprecated functions --- lib/compiler/src/core_lib.erl | 38 +------------------------------------- lib/stdlib/src/otp_internal.erl | 10 +++++----- 2 files changed, 6 insertions(+), 42 deletions(-) diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 3abb520485..839c736ff2 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -21,52 +21,16 @@ -module(core_lib). --deprecated({get_anno,1,next_major_release}). --deprecated({set_anno,2,next_major_release}). --deprecated({is_literal,1,next_major_release}). --deprecated({is_literal_list,1,next_major_release}). --deprecated({literal_value,1,next_major_release}). - --export([get_anno/1,set_anno/2]). --export([is_literal/1,is_literal_list/1]). --export([literal_value/1]). -export([make_values/1]). -export([is_var_used/2]). -include("core_parse.hrl"). -%% -%% Generic get/set annotation that should be used only with cerl() structures. -%% --spec get_anno(cerl:cerl()) -> term(). - -get_anno(C) -> cerl:get_ann(C). - --spec set_anno(cerl:cerl(), term()) -> cerl:cerl(). - -set_anno(C, A) -> cerl:set_ann(C, A). - --spec is_literal(cerl:cerl()) -> boolean(). - -is_literal(Cerl) -> - cerl:is_literal(cerl:fold_literal(Cerl)). - --spec is_literal_list([cerl:cerl()]) -> boolean(). - -is_literal_list(Es) -> lists:all(fun is_literal/1, Es). - -%% Return the value of LitExpr. --spec literal_value(cerl:c_literal() | cerl:c_binary() | - cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term(). - -literal_value(Cerl) -> - cerl:concrete(cerl:fold_literal(Cerl)). - %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). make_values([E]) -> E; -make_values([H|_]=Es) -> #c_values{anno=get_anno(H),es=Es}; +make_values([H|_]=Es) -> #c_values{anno=cerl:get_ann(H),es=Es}; make_values([]) -> #c_values{es=[]}; make_values(E) -> E. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..e8faecb41f 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -586,16 +586,16 @@ obsolete_1(asn1rt, utf8_list_to_binary, 1) -> %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> - {deprecated,{cerl,get_ann,1}}; + {removed,{cerl,get_ann,1},"19"}; obsolete_1(core_lib, set_anno, 2) -> - {deprecated,{cerl,set_ann,2}}; + {removed,{cerl,set_ann,2},"19"}; obsolete_1(core_lib, is_literal, 1) -> - {deprecated,{cerl,is_literal,1}}; + {removed,{cerl,is_literal,1},"19"}; obsolete_1(core_lib, is_literal_list, 1) -> - {deprecated,"deprecated; use lists:all(fun cerl:is_literal/1, L)" + {removed,"removed; use lists:all(fun cerl:is_literal/1, L)" " instead"}; obsolete_1(core_lib, literal_value, 1) -> - {deprecated,{core_lib,concrete,1}}; + {removed,{core_lib,concrete,1},"19"}; obsolete_1(erl_scan, set_attribute, 3) -> {deprecated, "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; -- cgit v1.2.3 From e7df61f5efccd3ca106ebffb598455d0c5ea3dfd Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 8 Sep 2015 17:12:18 +0200 Subject: erts: Refactor config test for posix_memalign --- erts/configure.in | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/erts/configure.in b/erts/configure.in index 6950915a6a..25256bcac9 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2084,8 +2084,7 @@ fi case X$erl_xcomp_posix_memalign in Xno) ;; - Xyes) AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) ;; + Xyes) have_posix_memalign=yes ;; *) AC_CHECK_FUNC( [posix_memalign], @@ -2100,15 +2099,19 @@ int main(void) { return error; return 0; } -],AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) +],have_posix_memalign=yes ) else - AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) + have_posix_memalign=yes fi]);; esac +if test $have_posix_memalign = yes; then + AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], + [Define to 1 if you have the `posix_memalign' function.]) +fi + + dnl writev on OS X snow leopard is broken for files > 4GB case $host_os in darwin10.8.0) -- cgit v1.2.3 From 997881b9046d3468685c545dc917e8204e0a9ef6 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 3 Sep 2015 17:57:30 +0200 Subject: erts: Remove unused erts_have_erts_mmap --- erts/emulator/sys/common/erl_mmap.c | 6 ------ erts/emulator/sys/common/erl_mmap.h | 3 --- 2 files changed, 9 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index e6d0e1e281..eeaf96dd93 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -67,7 +67,6 @@ (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \ < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot))) -int erts_have_erts_mmap; UWord erts_page_inv_mask; #if defined(DEBUG) || defined(ERTS_MMAP_DEBUG) @@ -2131,8 +2130,6 @@ erts_mmap_init(ErtsMMapInit *init) ERTS_MMAP_OP_RINGBUF_INIT(); - erts_have_erts_mmap = 0; - mmap_state.supercarrier = 0; mmap_state.reserve_physical = reserve_noop; mmap_state.unreserve_physical = unreserve_noop; @@ -2206,8 +2203,6 @@ erts_mmap_init(ErtsMMapInit *init) } #endif } - if (!mmap_state.no_os_mmap) - erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP; #endif mmap_state.no.free_seg_descs = 0; @@ -2291,7 +2286,6 @@ erts_mmap_init(ErtsMMapInit *init) init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER); mmap_state.supercarrier = 1; - erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; mmap_state.desc.new_area_hint = end; diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 66619c5161..51f830d045 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -30,9 +30,6 @@ #define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1) #define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2) -#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0) -#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1) -extern int erts_have_erts_mmap; extern UWord erts_page_inv_mask; typedef struct { -- cgit v1.2.3 From 34e1b675f95d0837823b794f3440300806f7ef88 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 11 Sep 2015 16:40:56 +0200 Subject: erts: Cleanup main carrier creation and remove that magic "-40" from default mmbcs for ll_alloc --- erts/emulator/beam/erl_alloc.c | 4 ++-- erts/emulator/beam/erl_alloc_util.c | 33 ++++++++++++++++++++++++--------- 2 files changed, 26 insertions(+), 11 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index d68f22d573..70d5357e27 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -272,9 +272,9 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.name_prefix = "ll_"; ip->init.util.alloc_no = ERTS_ALC_A_LONG_LIVED; #ifndef SMALL_MEMORY - ip->init.util.mmbcs = 2*1024*1024 - 40; /* Main carrier size */ + ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ #else - ip->init.util.mmbcs = 1*1024*1024 - 40; /* Main carrier size */ + ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_LONG_LIVED; ip->init.util.asbcst = 0; diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index db4c30b9eb..444d7055c8 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -3534,7 +3534,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) return NULL; } - blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + if (flags & CFLG_MAIN_CARRIER) { + ASSERT(flags & CFLG_MBC); + ASSERT(flags & CFLG_NO_CPOOL); + ASSERT(umem_sz == allctr->main_carrier_size); + ERTS_UNDEF(blk_sz, 0); + + if (allctr->main_carrier_size < allctr->min_mbc_size) + allctr->main_carrier_size = allctr->min_mbc_size; + crr_sz = bcrr_sz = allctr->main_carrier_size; + } + else { + ERTS_UNDEF(bcrr_sz, 0); + ERTS_UNDEF(crr_sz, 0); + blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + } #ifdef ERTS_SMP allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON; @@ -3580,10 +3594,12 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) mseg_flags = ERTS_MSEG_FLG_NONE; } else { - crr_sz = (*allctr->get_next_mbc_size)(allctr); - if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz) - crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; - mseg_flags = ERTS_MSEG_FLG_2POW; + if (!(flags & CFLG_MAIN_CARRIER)) { + crr_sz = (*allctr->get_next_mbc_size)(allctr); + if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz) + crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; + } + mseg_flags = ERTS_MSEG_FLG_2POW; } crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags); @@ -3618,11 +3634,10 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) if (flags & CFLG_SBC) { bcrr_sz = blk_sz + SBC_HEADER_SIZE; } - else { + else if (!(flags & CFLG_MAIN_CARRIER)) { bcrr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; - if (!(flags & CFLG_MAIN_CARRIER) - && bcrr_sz < allctr->smallest_mbc_size) - bcrr_sz = allctr->smallest_mbc_size; + if (bcrr_sz < allctr->smallest_mbc_size) + bcrr_sz = allctr->smallest_mbc_size; } crr_sz = (flags & CFLG_FORCE_SIZE -- cgit v1.2.3 From 1fd4809777931a4dc166fd9f1b552317a385cd62 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 7 Sep 2015 19:58:47 +0200 Subject: erts: Fix strangeness in treatment of MSEG_ALIGN_BITS And remove old case of using only page alignment (12 bits). --- erts/emulator/beam/erl_alloc_util.h | 2 +- erts/emulator/sys/common/erl_mseg.h | 10 ---------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 792f8c63ac..f314eab4c2 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -220,7 +220,7 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #if ERTS_HAVE_MSEG_SUPER_ALIGNED \ || (!HAVE_ERTS_MSEG && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC) -# ifndef MSEG_ALIGN_BITS +# ifdef MSEG_ALIGN_BITS # define ERTS_SUPER_ALIGN_BITS MSEG_ALIGN_BITS # else # define ERTS_SUPER_ALIGN_BITS 18 diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 656484702d..677f8ea4ed 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -42,16 +42,6 @@ #if ERTS_HAVE_MSEG_SUPER_ALIGNED # define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS -#else -/* If we don't use super aligned multiblock carriers - * we will mmap with page size alignment (and thus use corresponding - * align bits). - * - * Current implementation needs this to be a constant and - * only uses this for user dev testing so setting page size - * to 4096 (12 bits) is fine. - */ -# define MSEG_ALIGN_BITS (12) #endif #if HAVE_ERTS_MSEG -- cgit v1.2.3 From ada8342bedf8d4b84d4c3c10fcfc7919e532fd8c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 4 Sep 2015 18:45:06 +0200 Subject: erts: Add new allocator LITERAL --- erts/emulator/beam/beam_bif_load.c | 6 ++++++ erts/emulator/beam/beam_load.c | 24 +++++++++++------------ erts/emulator/beam/erl_alloc.c | 39 ++++++++++++++++++++++++++++++++++++++ erts/emulator/beam/erl_alloc.types | 3 +++ erts/emulator/beam/erl_bif_info.c | 2 +- erts/emulator/hipe/hipe_bif0.c | 2 +- 6 files changed, 62 insertions(+), 14 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 11508a1b39..68689b8e7f 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -684,6 +684,9 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) erts_cleanup_funs_on_purge(code, end); beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length, erts_active_code_ix()); + if (code[MI_LITERALS_START]) { + erts_free(ERTS_ALC_T_LITERAL, (void *) code[MI_LITERALS_START]); + } erts_free(ERTS_ALC_T_CODE, (void *) code); modp->curr.code = NULL; modp->curr.code_length = 0; @@ -1019,6 +1022,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) beam_catches_delmod(modp->old.catches, code, modp->old.code_length, code_ix); decrement_refc(code); + if (code[MI_LITERALS_START]) { + erts_free(ERTS_ALC_T_LITERAL, (void *) code[MI_LITERALS_START]); + } erts_free(ERTS_ALC_T_CODE, (void *) code); modp->old.code = NULL; modp->old.code_length = 0; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index a9d47eb7b0..f0b4be4c3d 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -654,6 +654,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, stp->code[MI_COMPILE_PTR] = 0; stp->code[MI_COMPILE_SIZE] = 0; stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_LITERALS_START] = 0; stp->code[MI_MD5_PTR] = 0; /* @@ -921,6 +922,9 @@ loader_state_dtor(Binary* magic) stp->bin = 0; } if (stp->code != 0) { + if (stp->code[MI_LITERALS_START]) { + erts_free(ERTS_ALC_T_LITERAL, (void*) stp->code[MI_LITERALS_START]); + } erts_free(ERTS_ALC_T_CODE, stp->code); stp->code = 0; } @@ -4348,7 +4352,6 @@ static int freeze_code(LoaderState* stp) { BeamInstr* code = stp->code; - Uint *literal_end = NULL; int i; byte* str_table; unsigned strtab_size = stp->chunks[STR_CHUNK].size; @@ -4378,7 +4381,6 @@ freeze_code(LoaderState* stp) sizeof(Eterm) + (stp->current_li+1) * stp->loc_size; } size = (stp->ci * sizeof(BeamInstr)) + - (stp->total_literal_size * sizeof(Eterm)) + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; /* @@ -4406,10 +4408,9 @@ freeze_code(LoaderState* stp) } CHKBLK(ERTS_ALC_T_CODE,code); - literal_end = (Uint *) (code+stp->ci); /* - * Place the literal heap directly after the code and fix up all - * instructions that refer to it. + * Place the literals in their own allocated heap (for fast range check) + * and fix up all instructions that refer to it. */ { Uint* ptr; @@ -4420,7 +4421,8 @@ freeze_code(LoaderState* stp) ERTS_INIT_OFF_HEAP(&code_off_heap); - low = (Uint *) (code+stp->ci); + low = erts_alloc(ERTS_ALC_T_LITERAL, + stp->total_literal_size*sizeof(Eterm)); high = low + stp->total_literal_size; code[MI_LITERALS_START] = (BeamInstr) low; code[MI_LITERALS_END] = (BeamInstr) high; @@ -4443,7 +4445,6 @@ freeze_code(LoaderState* stp) op_ptr[0] = lit->term; lp = lp->next; } - literal_end += stp->total_literal_size; } CHKBLK(ERTS_ALC_T_CODE,code); @@ -4452,9 +4453,9 @@ freeze_code(LoaderState* stp) */ if (stp->line_instr == 0) { code[MI_LINE_TABLE] = (BeamInstr) 0; - str_table = (byte *) literal_end; + str_table = (byte *) (code+stp->ci); } else { - Eterm* line_tab = (Eterm *) literal_end; + Eterm* line_tab = (Eterm *) (code+stp->ci); Eterm* p; int ftab_size = stp->num_functions; int num_instrs = stp->current_li; @@ -4486,7 +4487,7 @@ freeze_code(LoaderState* stp) *locp++ = (Uint16) stp->line_instr[i].loc; } *locp++ = LINE_INVALID_LOCATION; - str_table = (byte *) locp; + str_table = (byte *) locp; } else { Uint32* locp = (Uint32 *) p; ASSERT(stp->loc_size == 4); @@ -4494,9 +4495,8 @@ freeze_code(LoaderState* stp) *locp++ = stp->line_instr[i].loc; } *locp++ = LINE_INVALID_LOCATION; - str_table = (byte *) locp; + str_table = (byte *) locp; } - CHKBLK(ERTS_ALC_T_CODE,code); } diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 70d5357e27..d83a2930d6 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -130,6 +130,7 @@ static ErtsAllocatorState_t binary_alloc_state; static ErtsAllocatorState_t ets_alloc_state; static ErtsAllocatorState_t driver_alloc_state; static ErtsAllocatorState_t fix_alloc_state; +static ErtsAllocatorState_t literal_alloc_state; typedef struct { erts_smp_atomic32_t refc; @@ -211,6 +212,7 @@ typedef struct { struct au_init ets_alloc; struct au_init driver_alloc; struct au_init fix_alloc; + struct au_init literal_alloc; } erts_alc_hndl_args_init_t; #define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} @@ -284,6 +286,32 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL_LL_ALLOC; } +static void +set_default_literal_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.sbct = ~((UWord) 0); + ip->init.util.name_prefix = "literal_"; + ip->init.util.alloc_no = ERTS_ALC_A_LITERAL; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_LITERAL; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; + ip->init.util.acul = 0; +} + static void set_default_temp_alloc_opts(struct au_init *ip) { @@ -577,6 +605,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_default_driver_alloc_opts(&init.driver_alloc); set_default_fix_alloc_opts(&init.fix_alloc, fix_type_sizes); + set_default_literal_alloc_opts(&init.literal_alloc); if (argc && argv) handle_args(argc, argv, &init); @@ -604,6 +633,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.thr_spec = 0; init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; + init.literal_alloc.thr_spec = 0; #endif /* Make adjustments for carrier migration support */ @@ -616,6 +646,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_carrier_migration_support(&init.ets_alloc); adjust_carrier_migration_support(&init.driver_alloc); adjust_carrier_migration_support(&init.fix_alloc); + adjust_carrier_migration_support(&init.literal_alloc); if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ @@ -630,6 +661,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.thr_spec = 0; init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; + init.literal_alloc.thr_spec = 0; /* No carrier migration */ init.temp_alloc.init.util.acul = 0; @@ -641,6 +673,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.init.util.acul = 0; init.driver_alloc.init.util.acul = 0; init.fix_alloc.init.util.acul = 0; + init.literal_alloc.init.util.acul = 0; } #ifdef ERTS_SMP @@ -657,6 +690,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_tpref(&init.ets_alloc, erts_no_schedulers); adjust_tpref(&init.driver_alloc, erts_no_schedulers); adjust_tpref(&init.fix_alloc, erts_no_schedulers); + adjust_tpref(&init.literal_alloc, erts_no_schedulers); #else /* No thread specific if not smp */ @@ -675,6 +709,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) refuse_af_strategy(&init.ets_alloc); refuse_af_strategy(&init.driver_alloc); refuse_af_strategy(&init.fix_alloc); + refuse_af_strategy(&init.literal_alloc); #ifdef ERTS_SMP if (!init.temp_alloc.thr_spec) @@ -718,6 +753,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu); set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu); set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { if (!erts_allctrs[i].alloc) @@ -770,6 +806,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) start_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, &fix_alloc_state); + start_au_allocator(ERTS_ALC_A_LITERAL, + &init.literal_alloc, + &literal_alloc_state); erts_mtrace_install_wrapper_functions(); extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 4804fb407d..7d519c1be4 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -86,6 +86,7 @@ allocator LONG_LIVED true ll_alloc allocator EHEAP true eheap_alloc allocator ETS true ets_alloc allocator FIXED_SIZE true fix_alloc +allocator LITERAL true literal_alloc +else # Non smp build @@ -96,6 +97,7 @@ allocator LONG_LIVED false ll_alloc allocator EHEAP false eheap_alloc allocator ETS false ets_alloc allocator FIXED_SIZE false fix_alloc +allocator LITERAL false literal_alloc +endif @@ -343,6 +345,7 @@ type DDLL_PROCESS STANDARD SYSTEM ddll_processes type MONITOR_LH STANDARD PROCESSES monitor_lh type NLINK_LH STANDARD PROCESSES nlink_lh type CODE LONG_LIVED CODE code +type LITERAL LITERAL CODE literal type DB_HEIR_DATA STANDARD ETS db_heir_data type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 9a132ee007..79ccf8db64 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -4321,7 +4321,7 @@ static void os_info_init(void) os_flavor(buf, 1024); flav = erts_atom_put((byte *) buf, strlen(buf), ERTS_ATOM_ENC_LATIN1, 1); erts_free(ERTS_ALC_T_TMP, (void *) buf); - hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm)); os_type_tuple = TUPLE2(hp, type, flav); hp += 3; os_version(&major, &minor, &build); diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index cc68e1f74d..7193c3d301 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -488,7 +488,7 @@ static void *const_term_alloc(void *tmpl) alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm)); hipe_constants_size += alloc_size; - p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm)); + p = (struct const_term*)erts_alloc(ERTS_ALC_T_LITERAL, alloc_size * sizeof(Eterm)); /* I have absolutely no idea if having a private 'off_heap' works or not. _Some_ off_heap object is required for -- cgit v1.2.3 From d9daff6d87c217ba7d3cba00642710e473e9b226 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 26 Jun 2015 14:09:43 +0200 Subject: stdlib: Remove deprecated functions in erl_parse and erl_scan The recently added module erl_anno can no longer handle negative line numbers. --- lib/dialyzer/test/r9c_SUITE_data/results/mnesia | 2 +- .../small_SUITE_data/src/big_external_type.erl | 6 +- .../test/small_SUITE_data/src/big_local_type.erl | 6 +- lib/stdlib/doc/src/erl_scan.xml | 185 +------------- lib/stdlib/src/erl_anno.erl | 96 ++----- lib/stdlib/src/erl_lint.erl | 22 +- lib/stdlib/src/erl_parse.yrl | 27 -- lib/stdlib/src/erl_scan.erl | 267 ++------------------ lib/stdlib/src/otp_internal.erl | 45 ++-- lib/stdlib/test/erl_anno_SUITE.erl | 72 +----- lib/stdlib/test/erl_lint_SUITE.erl | 38 +-- lib/stdlib/test/erl_scan_SUITE.erl | 279 ++++++++------------- 12 files changed, 192 insertions(+), 853 deletions(-) diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index b73943422a..1dc5a105bf 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | ' mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed -mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{integer(),atom() | tuple(),_}} | {'ok',_} +mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom() | tuple(),_}} | {'ok',_} mnesia_tm.erl:1522: Function commit_participant/5 has no local return mnesia_tm.erl:2169: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl index ab84e94106..9ad4810a5e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/big_external_type.erl @@ -36,7 +36,7 @@ %% Start of Abstract Format --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -export_type([af_record_index/0, af_record_field/1, af_record_name/0, af_field_name/0, af_function_decl/0]). @@ -332,8 +332,8 @@ %% End of Abstract Format -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. --type token() :: {Tag :: atom(), Line :: erl_scan:line()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_scan:anno()}. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl index fc7c5241a8..fe567ff10d 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/big_local_type.erl @@ -36,7 +36,7 @@ %% Start of Abstract Format --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, af_compile/0, af_file/0, af_record_decl/0, @@ -329,8 +329,8 @@ %% End of Abstract Format -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. --type token() :: {Tag :: atom(), Line :: erl_scan:line()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_anno:line()}. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 18e988e286..01b845a039 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -39,39 +39,15 @@ Erlang tokens.

- - - - - - - - - - - - - - - - - - - - - - - - @@ -87,9 +63,6 @@ - - - @@ -122,25 +95,23 @@ StartLocation, []).

StartLocation indicates the initial location when scanning starts. If StartLocation is a line, - attributes() as well as EndLocation and + Anno as well as EndLocation and ErrorLocation will be lines. If StartLocation is a pair of a line and a column - attributes() takes the form of an opaque compound + Anno takes the form of an opaque compound data type, and EndLocation and ErrorLocation will be pairs of a line and a column. The token - attributes contain information about the column and the + annotations contain information about the column and the line where the token begins, as well as the text of the token (if the text option is given), all of which can - be accessed by calling token_info/1,2, attributes_info/1,2, + be accessed by calling column/1, line/1, location/1, and text/1.

A token is a tuple containing information about - syntactic category, the token attributes, and the actual + syntactic category, the token annotations, and the actual terminal symbol. For punctuation characters (e.g. ;, |) and reserved words, the category and the symbol coincide, and the token is represented by a two-tuple. @@ -172,7 +143,7 @@

Short for [return_comments, return_white_spaces].

 text -

Include the token's text in the token attributes. The +

Include the token's text in the token annotation. The text is the part of the input corresponding to the token.

 @@ -305,150 +276,6 @@

- - - Return information about a token - -

Returns a list containing information about the token - Token. The order of the - TokenInfoTuples is not - defined. See token_info/2 for - information about specific - TokenInfoTuples.

-

Note that if token_info(Token, TokenItem) returns - undefined for some TokenItem, the - item is not included in TokenInfo.

- - - - - - - - Return information about a token - -

Returns a list containing information about the token - Token. If one single - TokenItem is given the returned value is - the corresponding - TokenInfoTuple, or undefined if the - TokenItem has no value. If a list of - TokenItems is given the result is a list of - TokenInfoTuple. The - TokenInfoTuples will - appear with the corresponding TokenItems in - the same order as the TokenItems - appear in the list of TokenItems. - TokenItems with no value are not included - in the list of TokenInfoTuple.

-

The following TokenInfoTuples with corresponding - TokenItems are valid:

- - {category, - category()} -

The category of the token.

- - {column, - column()} -

The column where the token begins.

- - {length, integer() > 0} -

The length of the token's text.

- - {line, - line()} -

The line where the token begins.

- - {location, - location()} -

The line and column where the token begins, or - just the line if the column unknown.

- - {symbol, - symbol()} -

The token's symbol.

- - {text, string()} -

The token's text.

- - - - - - - Return information about token attributes - -

Returns a list containing information about the token - attributes Attributes. The order of the - AttributeInfoTuples is not defined. - See attributes_info/2 for - information about specific - AttributeInfoTuples.

-

Note that if attributes_info(Token, AttributeItem) - returns undefined for some AttributeItem in - the list above, the item is not included in - AttributesInfo.

- - - - - - Return information about a token attributes - - -

Returns a list containing information about the token - attributes Attributes. If one single - AttributeItem is given the returned value is the - corresponding AttributeInfoTuple, - or undefined if the AttributeItem - has no value. If a list of AttributeItem - is given the result is a list of - AttributeInfoTuple. - The AttributeInfoTuples - will appear with the corresponding AttributeItems - in the same order as the AttributeItems - appear in the list of AttributeItems. - AttributeItems with no - value are not included in the list of - AttributeInfoTuple.

-

The following AttributeInfoTuples with - corresponding AttributeItems are valid:

- - {column, - column()} -

The column where the token begins.

- - {length, integer() > 0} -

The length of the token's text.

- - {line, - line()} -

The line where the token begins.

- - {location, - location()} -

The line and column where the token begins, or - just the line if the column unknown.

- - {text, string()} -

The token's text.

- - - - - - - Set a token attribute value - -

Sets the value of the line attribute of the token - attributes Attributes.

-

The SetAttributeFun is called with the value of - the line attribute, and is to return the new value of - the line attribute.

- - Format an error descriptor diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl index 143318aa55..d32c34dabd 100644 --- a/lib/stdlib/src/erl_anno.erl +++ b/lib/stdlib/src/erl_anno.erl @@ -33,7 +33,7 @@ -export_type([anno_term/0]). --define(LN(L), is_integer(L)). +-define(LN(L), is_integer(L), L >= 0). -define(COL(C), (is_integer(C) andalso C >= 1)). %% Location. @@ -52,13 +52,13 @@ | {'record', record()} | {'text', string()}. --type anno() :: location() | [annotation(), ...]. +-opaque anno() :: location() | [annotation(), ...]. -type anno_term() :: term(). -type column() :: pos_integer(). -type generated() :: boolean(). -type filename() :: file:filename_all(). --type line() :: integer(). +-type line() :: non_neg_integer(). -type location() :: line() | {line(), column()}. -type record() :: boolean(). -type text() :: string(). @@ -90,9 +90,13 @@ to_term(Anno) -> -ifdef(DEBUG). from_term(Term) when is_list(Term) -> Term; +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> [{location, Term}]. -else. +from_term(Line) when is_integer(Line), Line < 0 -> % Before OTP 19 + set_generated(true, new(-Line)); from_term(Term) -> Term. -endif. @@ -198,18 +202,11 @@ file(Anno) -> Anno :: anno(). generated(Line) when ?ALINE(Line) -> - Line =< 0; + false; generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - Line =< 0; + false; generated(Anno) -> - _ = anno_info(Anno, generated, false), - {location, Location} = lists:keyfind(location, 1, Anno), - case Location of - {Line, _Column} -> - Line =< 0; - Line -> - Line =< 0 - end. + anno_info(Anno, generated, false). -spec line(Anno) -> line() when Anno :: anno(). @@ -226,18 +223,11 @@ line(Anno) -> Anno :: anno(). location(Line) when ?ALINE(Line) -> - abs(Line); -location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> - {abs(Line), Column}; + Line; +location({Line, Column}=Location) when ?ALINE(Line), ?ACOLUMN(Column) -> + Location; location(Anno) -> - case anno_info(Anno, location) of - Line when Line < 0 -> - -Line; - {Line, Column} when Line < 0 -> - {-Line, Column}; - Location -> - Location - end. + anno_info(Anno, location). -spec record(Anno) -> record() when Anno :: anno(). @@ -270,31 +260,8 @@ set_file(File, Anno) -> Generated :: generated(), Anno :: anno(). -set_generated(true, Line) when ?ALINE(Line) -> - -abs(Line); -set_generated(false, Line) when ?ALINE(Line) -> - abs(Line); -set_generated(true, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {-abs(Line),Column}; -set_generated(false, {Line, Column}) when ?ALINE(Line), - ?ACOLUMN(Column) -> - {abs(Line),Column}; set_generated(Generated, Anno) -> - _ = set(generated, Generated, Anno), - {location, Location} = lists:keyfind(location, 1, Anno), - NewLocation = - case Location of - {Line, Column} when Generated -> - {-abs(Line), Column}; - {Line, Column} when not Generated -> - {abs(Line), Column}; - Line when Generated -> - -abs(Line); - Line when not Generated -> - abs(Line) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). + set(generated, Generated, Anno). -spec set_line(Line, Anno) -> Anno when Line :: line(), @@ -313,38 +280,17 @@ set_line(Line, Anno) -> Anno :: anno(). set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), ?LLINE(Line) -> - new_location(fix_line(Line, L)); + new_location(Line); set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), ?LLINE(L), ?LCOLUMN(C) -> - new_location(fix_location(Loc, Line)); + new_location(Loc); set_location(Location, Anno) -> - _ = set(location, Location, Anno), - {location, OldLocation} = lists:keyfind(location, 1, Anno), - NewLocation = - case {Location, OldLocation} of - {{_Line, _Column}=Loc, {L, _C}} -> - fix_location(Loc, L); - {Line, {L, _C}} -> - fix_line(Line, L); - {{_Line, _Column}=Loc, L} -> - fix_location(Loc, L); - {Line, L} -> - fix_line(Line, L) - end, - lists:keyreplace(location, 1, Anno, {location, NewLocation}). - -fix_location({Line, Column}, OldLine) -> - {fix_line(Line, OldLine), Column}. - -fix_line(Line, OldLine) when OldLine < 0, Line > 0 -> - -Line; -fix_line(Line, _OldLine) -> - Line. + set(location, Location, Anno). -spec set_record(Record, Anno) -> Anno when Record :: record(), @@ -383,7 +329,7 @@ set_anno(Item, Value, Anno) -> _ -> lists:keyreplace(Item, 1, Anno, {Item, Value}) end, - simplify(R) + reset_simplify(R) end. reset(Anno, Item) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index c4cb5fdc80..a5f0e7dbd3 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -31,12 +31,8 @@ -export([is_guard_expr/1]). -export([bool_option/4,value_option/3,value_option/7]). --export([modify_line/2]). - -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). --deprecated([{modify_line, 2, next_major_release}]). - %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -79,7 +75,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). --type line() :: erl_anno:line(). % a convenient alias +-type line() :: erl_anno:anno(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity @@ -238,6 +234,9 @@ format_error({removed, MFA, ReplacementMFA, Rel}) -> "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({removed, MFA, String}) when is_list(String) -> io_lib:format("~s: ~s", [format_mfa(MFA), String]); +format_error({removed_type, MNA, ReplacementMNA, Rel}) -> + io_lib:format("the type ~s was removed in ~s; use ~s instead", + [format_mna(MNA), Rel, format_mna(ReplacementMNA)]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); format_error({too_many_arguments,Arity}) -> @@ -413,6 +412,9 @@ format_mfa({M, F, A}) when is_integer(A) -> format_mf(M, F, ArityString) when is_atom(M), is_atom(F) -> atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ ArityString. +format_mna({M, N, A}) when is_integer(A) -> + atom_to_list(M) ++ ":" ++ atom_to_list(N) ++ gen_type_paren(A). + format_where(L) when is_integer(L) -> io_lib:format("(line ~p)", [L]); format_where({L,C}) when is_integer(L), is_integer(C) -> @@ -3482,13 +3484,6 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. copy_expr(Expr, Anno) -> erl_parse:map_anno(fun(_A) -> Anno end, Expr). -%% modify_line(Form, Fun) -> Form -%% modify_line(Expression, Fun) -> Expression -%% Applies Fun to each line number occurrence. - -modify_line(T, F0) -> - erl_parse:map_anno(F0, T). - %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3557,6 +3552,7 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of @@ -3567,6 +3563,8 @@ deprecated_type(L, M, N, As, St) -> false -> St end; + {removed, Replacement, Rel} -> + add_warning(L, {removed_type, {M,N,NAs}, Replacement, Rel}, St); no -> St end. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index e82282421e..206b0c6e7b 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -525,11 +525,6 @@ Erlang code. -export([type_inop_prec/1,type_preop_prec/1]). -export([map_anno/2, fold_anno/3, mapfold_anno/3, new_anno/1, anno_to_term/1, anno_from_term/1]). --export([set_line/2,get_attribute/2,get_attributes/1]). - --deprecated([{set_line, 2, next_major_release}, - {get_attribute, 2, next_major_release}, - {get_attributes, 1, next_major_release}]). %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. @@ -1118,28 +1113,6 @@ type_preop_prec('-') -> {600,700}; type_preop_prec('bnot') -> {600,700}; type_preop_prec('#') -> {700,800}. -%%% [Experimental]. The parser just copies the attributes of the -%%% scanner tokens to the abstract format. This design decision has -%%% been hidden to some extent: use set_line() and get_attribute() to -%%% access the second element of (almost all) of the abstract format -%%% tuples. A typical use is to negate line numbers to prevent the -%%% compiler from emitting warnings and errors. The second element can -%%% (of course) be set to any value, but then these functions no -%%% longer apply. To get all present attributes as a property list -%%% get_attributes() should be used. - --compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}). -set_line(L, F) -> - erl_scan:set_attribute(line, L, F). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}). -get_attribute(L, Name) -> - erl_scan:attributes_info(L, Name). - --compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}). -get_attributes(L) -> - erl_scan:attributes_info(L). - -spec map_anno(Fun, Abstr) -> NewAbstr when Fun :: fun((Anno) -> Anno), Anno :: erl_anno:anno(), diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index d2f53816b8..47223b129c 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -52,25 +52,15 @@ %%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, - format_error/1,reserved_word/1, - token_info/1,token_info/2, - attributes_info/1,attributes_info/2,set_attribute/3]). + format_error/1,reserved_word/1]). -export([column/1,end_location/1,line/1,location/1,text/1, category/1,symbol/1]). --deprecated([{attributes_info, 1, next_major_release}, - {attributes_info, 2, next_major_release}, - {set_attribute, 3, next_major_release}, - {token_info, 1, next_major_release}, - {token_info, 2, next_major_release}]). - %%% Private -export([continuation_location/1]). -export_type([error_info/0, - line/0, - location/0, options/0, return_cont/0, token/0, @@ -85,29 +75,18 @@ -define(ALINE(L), is_integer(L)). -define(STRING(S), is_list(S)). -define(RESWORDFUN(F), is_function(F, 1)). --define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). % Deprecated --type line() :: integer(). % Deprecated --type location() :: line() | {line(),column()}. % Deprecated -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. -type options() :: option() | [option()]. -type symbol() :: atom() | float() | integer() | string(). --type info_line() :: integer() | term(). --type attributes_data() - :: [{'column', column()} | {'line', info_line()} | {'text', string()}] - | {line(), column()}. -%% The fact that {line(),column()} is a possible attributes() type -%% is hidden. --type attributes() :: line() | attributes_data(). --type token() :: {category(), attributes(), symbol()} - | {category(), attributes()}. +-type token() :: {category(), Anno :: erl_anno:anno(), symbol()} + | {category(), Anno :: erl_anno:anno()}. -type tokens() :: [token()]. -type error_description() :: term(). --type error_info() :: {location(), module(), error_description()}. +-type error_info() :: {erl_anno:location(), module(), error_description()}. %%% Local record. -record(erl_scan, @@ -136,8 +115,8 @@ format_error(Other) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - EndLocation :: location(), - ErrorLocation :: location(). + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String) -> string(String, 1, []). @@ -145,9 +124,9 @@ string(String) -> String :: string(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, StartLocation) -> string(String, StartLocation, []). @@ -156,9 +135,9 @@ string(String, StartLocation) -> Options :: options(), Return :: {'ok', Tokens :: tokens(), EndLocation} | {'error', ErrorInfo :: error_info(), ErrorLocation}, - StartLocation :: location(), - EndLocation :: location(), - ErrorLocation :: location(). + StartLocation :: erl_anno:location(), + EndLocation :: erl_anno:location(), + ErrorLocation :: erl_anno:location(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), @@ -167,20 +146,23 @@ string(String, {Line,Column}, Options) when ?STRING(String), string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. --type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), +-type cont_fun() :: fun((char_spec(), #erl_scan{}, + erl_anno:line(), erl_anno:column(), tokens(), any()) -> any()). -opaque return_cont() :: {erl_scan_continuation, - string(), column(), tokens(), line(), + string(), erl_anno:column(), tokens(), + erl_anno:line(), #erl_scan{}, any(), cont_fun()}. --type tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()} - | {'eof', EndLocation :: location()} +-type tokens_result() :: {'ok', Tokens :: tokens(), + EndLocation :: erl_anno:location()} + | {'eof', EndLocation :: erl_anno:location()} | {'error', ErrorInfo :: error_info(), - EndLocation :: location()}. + EndLocation :: erl_anno:location()}. -spec tokens(Continuation, CharSpec, StartLocation) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. tokens(Cont, CharSpec, StartLocation) -> @@ -189,7 +171,7 @@ tokens(Cont, CharSpec, StartLocation) -> -spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when Continuation :: return_cont() | [], CharSpec :: char_spec(), - StartLocation :: location(), + StartLocation :: erl_anno:location(), Options :: options(), Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} | {'more', Continuation1 :: return_cont()}. @@ -257,155 +239,6 @@ symbol({_Category,_Anno,Symbol}) -> symbol(T) -> erlang:error(badarg, [T]). --type attribute_item() :: 'column' | 'length' | 'line' - | 'location' | 'text'. --type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} - | {'location', info_location()} - | {'text', string()}. --type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} - | attribute_info(). - --spec token_info(Token) -> TokenInfo when - Token :: token(), - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(Token) -> - Items = [category,column,length,line,symbol,text], % undefined order - token_info(Token, Items). - --spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when - Token :: token(), - TokenItem :: token_item(), - TokenInfoTuple :: token_info(); - (Token, TokenItems) -> TokenInfo when - Token :: token(), - TokenItems :: [TokenItem :: token_item()], - TokenInfo :: [TokenInfoTuple :: token_info()]. -token_info(_Token, []) -> - []; -token_info(Token, [Item|Items]) when is_atom(Item) -> - case token_info(Token, Item) of - undefined -> - token_info(Token, Items); - TokenInfo when is_tuple(TokenInfo) -> - [TokenInfo|token_info(Token, Items)] - end; -token_info({Category,_Attrs}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs,_Symbol}, category=Item) -> - {Item,Category}; -token_info({Category,_Attrs}, symbol=Item) -> - {Item,Category}; -token_info({_Category,_Attrs,Symbol}, symbol=Item) -> - {Item,Symbol}; -token_info({_Category,Attrs}, Item) -> - attributes_info(Attrs, Item); -token_info({_Category,Attrs,_Symbol}, Item) -> - attributes_info(Attrs, Item). - --spec attributes_info(Attributes) -> AttributesInfo when - Attributes :: attributes(), - AttributesInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(Attributes) -> - Items = [column,length,line,text], % undefined order - attributes_info(Attributes, Items). - --spec attributes_info - (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when - Attributes :: attributes(), - AttributeItem :: attribute_item(), - AttributeInfoTuple :: attribute_info(); - (Attributes, AttributeItems) -> AttributeInfo when - Attributes :: attributes(), - AttributeItems :: [AttributeItem :: attribute_item()], - AttributeInfo :: [AttributeInfoTuple :: attribute_info()]. -attributes_info(_Attrs, []) -> - []; -attributes_info(Attrs, [A|As]) when is_atom(A) -> - case attributes_info(Attrs, A) of - undefined -> - attributes_info(Attrs, As); - AttributeInfo when is_tuple(AttributeInfo) -> - [AttributeInfo|attributes_info(Attrs, As)] - end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Column}; -attributes_info(Line, column) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, column=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case erl_anno:column(Attrs) of - undefined -> - undefined; - Column -> - {Item,Column} - end; - T -> - T - end; -attributes_info(Attrs, length=Item) -> - case attributes_info(Attrs, text) of - undefined -> - undefined; - {text,Text} -> - {Item,length(Text)} - end; -attributes_info(Line, line=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Line}; -attributes_info(Attrs, line=Item) -> - case attr_info(Attrs, Item) of - undefined -> - case attr_info(Attrs, location) of - {location,{Line,_Column}} -> - {Item,Line}; - {location,Line} -> - {Item,Line}; - undefined -> - undefined - end; - T -> - T - end; -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), - ?COLUMN(Column) -> - {Item,Location}; -attributes_info(Line, location=Item) when ?ALINE(Line) -> - {Item,Line}; -attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), - case attributes_info(Attrs, column) of - undefined -> - %% If set_attribute() has assigned a term such as {17,42} - %% to 'line', then Line will look like {Line,Column}. One - %% should not use 'location' but 'line' and 'column' in - %% such special cases. - {Item,Line}; - {column,Column} -> - {Item,{Line,Column}} - end; -attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) -> - undefined; -attributes_info(Line, text) when ?ALINE(Line) -> - undefined; -attributes_info(Attrs, text=Item) -> - attr_info(Attrs, Item); -attributes_info(T1, T2) -> - erlang:error(badarg, [T1,T2]). - --spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when - AttributeItem :: 'line', - Attributes :: attributes(), - SetAttributeFun :: fun((info_line()) -> info_line()). -set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) -> - set_attr(Tag, Attributes, Fun). - %%% %%% Local functions %%% @@ -471,62 +304,6 @@ expand_opt(return, Os) -> expand_opt(O, Os) -> [O|Os]. -attr_info(Attrs, Item) -> - try lists:keyfind(Item, 1, Attrs) of - {_Item, _Value} = T -> - T; - false -> - undefined - catch - _:_ -> - erlang:error(badarg, [Attrs, Item]) - end. - --spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes(). - -set_attr(line, Line, Fun) when ?ALINE(Line) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - Ln; - true -> - [{line,Ln}] - end; -set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> - Ln = Fun(Line), - if - ?ALINE(Ln) -> - {Ln,Column}; - true -> - [{line,Ln},{column,Column}] - end; -set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - case lists:keyfind(Tag, 1, Attrs) of - {line,Line} -> - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end; - false -> - {location, Location} = lists:keyfind(location, 1, Attrs), - Ln = case Location of - {Line,Column} when ?ALINE(Line), ?COLUMN(Column) -> - {Fun(Line),Column}; - _ -> - Fun(Location) - end, - case lists:keyreplace(location, 1, Attrs, {location,Ln}) of - [{location,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As - end - end; -set_attr(T1, T2, T3) -> - erlang:error(badarg, [T1,T2,T3]). - tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof -> case Fun(Cs, St, Line, Col, Toks, Any) of {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..27e195e1f3 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -597,38 +597,29 @@ obsolete_1(core_lib, is_literal_list, 1) -> obsolete_1(core_lib, literal_value, 1) -> {deprecated,{core_lib,concrete,1}}; obsolete_1(erl_scan, set_attribute, 3) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_scan, attributes_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, attributes_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_scan, token_info, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_scan, token_info, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; obsolete_1(erl_parse, set_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; + {removed,{erl_anno,set_line,2},"19.0"}; obsolete_1(erl_parse, get_attributes, 1) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_parse, get_attribute, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use " + {removed,"removed in 19.0; use " "erl_anno:{column,line,location,text}/1 instead"}; obsolete_1(erl_lint, modify_line, 2) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"}; + {removed,{erl_parse,map_anno,2},"19.0"}; obsolete_1(ssl, negotiated_next_protocol, 1) -> {deprecated,{ssl,negotiated_protocol,1}}; @@ -698,26 +689,24 @@ is_snmp_agent_function(_, _) -> false. -spec obsolete_type(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. +-dialyzer({no_match, obsolete_type/3}). obsolete_type(Module, Name, NumberOfVariables) -> case obsolete_type_1(Module, Name, NumberOfVariables) of -%% {deprecated=Tag,{_,_,_}=Replacement} -> -%% {Tag,Replacement,"in a future release"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; -%% {_,_,_}=Ret -> -%% Ret; + {_,_,_}=Ret -> + Ret; no -> no end. obsolete_type_1(erl_scan,column,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:column() instead"}; + {removed,{erl_anno,column,0},"19.0"}; obsolete_type_1(erl_scan,line,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:line() instead"}; + {removed,{erl_anno,line,0},"19.0"}; obsolete_type_1(erl_scan,location,0) -> - {deprecated, - "deprecated (will be removed in OTP 19); use erl_anno:location() instead"}; + {removed,{erl_anno,location,0},"19.0"}; obsolete_type_1(_,_,_) -> no. diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl index 66b02151a0..0369455846 100644 --- a/lib/stdlib/test/erl_anno_SUITE.erl +++ b/lib/stdlib/test/erl_anno_SUITE.erl @@ -34,7 +34,7 @@ init_per_testcase/2, end_per_testcase/2]). -export([new/1, is_anno/1, generated/1, end_location/1, file/1, - line/1, location/1, record/1, text/1, bad/1, neg_line/1]). + line/1, location/1, record/1, text/1, bad/1]). -export([parse_abstract/1, mapfold_anno/1]). @@ -43,7 +43,7 @@ all() -> groups() -> [{anno, [], [new, is_anno, generated, end_location, file, - line, location, record, text, bad, neg_line]}, + line, location, record, text, bad]}, {parse, [], [parse_abstract, mapfold_anno]}]. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -229,74 +229,6 @@ bad(_Config) -> (catch erl_anno:record(bad)), % 1st arg not opaque ok. -neg_line(doc) -> - ["Test negative line numbers (OTP 18)"]; -neg_line(_Config) -> - neg_line1(false), - neg_line1(true), - ok. - -neg_line1(TextToo) -> - Minus8_0 = erl_anno:new(-8), - Plus8_0 = erl_anno:new(8), - Minus8C_0 = erl_anno:new({-8, 17}), - Plus8C_0 = erl_anno:new({8, 17}), - - [Minus8, Plus8, Minus8C, Plus8C] = - [case TextToo of - true -> - erl_anno:set_text("foo", A); - false -> - A - end || A <- [Minus8_0, Plus8_0, Minus8C_0, Plus8C_0]], - - tst(-3, erl_anno:set_location(3, Minus8)), - tst(-3, erl_anno:set_location(-3, Plus8)), - tst(-3, erl_anno:set_location(-3, Minus8)), - tst({-3,9}, erl_anno:set_location({3, 9}, Minus8)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8)), - tst(-3, erl_anno:set_location(3, Minus8C)), - tst(-3, erl_anno:set_location(-3, Plus8C)), - tst(-3, erl_anno:set_location(-3, Minus8C)), - tst({-3,9}, erl_anno:set_location({3, 9}, Minus8C)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8C)), - tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8C)), - - tst(-8, erl_anno:set_generated(true, Plus8)), - tst(-8, erl_anno:set_generated(true, Minus8)), - tst({-8,17}, erl_anno:set_generated(true, Plus8C)), - tst({-8,17}, erl_anno:set_generated(true, Minus8C)), - tst(8, erl_anno:set_generated(false, Plus8)), - tst(8, erl_anno:set_generated(false, Minus8)), - tst({8,17}, erl_anno:set_generated(false, Plus8C)), - tst({8,17}, erl_anno:set_generated(false, Minus8C)), - - tst(-3, erl_anno:set_line(3, Minus8)), - tst(-3, erl_anno:set_line(-3, Plus8)), - tst(-3, erl_anno:set_line(-3, Minus8)), - tst({-3,17}, erl_anno:set_line(3, Minus8C)), - tst({-3,17}, erl_anno:set_line(-3, Plus8C)), - tst({-3,17}, erl_anno:set_line(-3, Minus8C)), - ok. - -tst(Term, Anno) -> - ?format("Term: ~p\n", [Term]), - ?format("Anno: ~p\n", [Anno]), - case anno_to_term(Anno) of - Term -> - ok; - Else -> - case lists:keyfind(location, 1, Else) of - {location, Term} -> - ok; - _Else2 -> - ?format("Else2 ~p\n", [_Else2]), - io:format("expected ~p\n got ~p\n", [Term, Else]), - exit({Term, Else}) - end - end. - parse_abstract(doc) -> ["Test erl_parse:new_anno/1, erl_parse:anno_to_term/1" ", and erl_parse:anno_from_term/1"]; diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 0424e2b967..6c07dc1ec6 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_12195/1 + maps/1,maps_type/1,otp_11851/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +94,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_12195]. + maps, maps_type, otp_11851]. groups() -> [{unused_vars_warn, [], @@ -3835,40 +3835,6 @@ otp_11851(Config) when is_list(Config) -> [] = run(Config, Ts), ok. -otp_12195(doc) -> - "OTP-12195: Check obsolete types (tailor made for OTP 18)."; -otp_12195(Config) when is_list(Config) -> - Ts = [{otp_12195_1, - <<"-export_type([r1/0]). - -type r1() :: erl_scan:line() - | erl_scan:column() - | erl_scan:location() - | erl_anno:line().">>, - [], - {warnings,[{2,erl_lint, - {deprecated_type,{erl_scan,line,0}, - "deprecated (will be removed in OTP 19); " - "use erl_anno:line() instead"}}, - {3,erl_lint, - {deprecated_type,{erl_scan,column,0}, - "deprecated (will be removed in OTP 19); use " - "erl_anno:column() instead"}}, - {4,erl_lint, - {deprecated_type,{erl_scan,location,0}, - "deprecated (will be removed in OTP 19); " - "use erl_anno:location() instead"}}]}}, - {otp_12195_2, - <<"-export_type([r1/0]). - -compile(nowarn_deprecated_type). - -type r1() :: erl_scan:line() - | erl_scan:column() - | erl_scan:location() - | erl_anno:line().">>, - [], - []}], - [] = run(Config, Ts), - ok. - run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 12ea3d128c..db669aae99 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -191,8 +191,7 @@ otp_7810(Config) when is_list(Config) -> ?line ok = more_chars(), ?line ok = more_options(), - ?line ok = attributes_info(), - ?line ok = set_attribute(), + ?line ok = anno_info(), ok. @@ -269,7 +268,7 @@ punctuations() -> comments() -> ?line test("a %%\n b"), - {ok,[],1} = erl_scan_string("%"), + ?line {ok,[],1} = erl_scan_string("%"), ?line test("a %%\n b"), {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan_string("a %%\n b", {1,1}), @@ -338,7 +337,7 @@ base_integers() -> erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], - {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), + ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = erl_scan_string("16#ef@", {1,1}, []), {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = @@ -387,20 +386,15 @@ dots() -> R2 = erl_scan_string(S, {1,1}, []) end || {S, R, R2} <- Dot], - ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T1, [column, length, line, text]), - ?line {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T2, [column, length, line, text]), - ?line {ok,[{dot,_}=T3],{1,6}} = + {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), + [1, 1, "."] = token_info(T1), + {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), + [1, 1, "."] = token_info(T2), + {ok,[{dot,_}=T3],{1,6}} = erl_scan:string(".% öh", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = - erl_scan:token_info(T3, [column, length, line, text]), - ?line {error,{{1,2},erl_scan,char},{1,3}} = - erl_scan:string(".$", {1,1}), - ?line {error,{{1,2},erl_scan,char},{1,4}} = - erl_scan:string(".$\\", {1,1}), + [1, 1, "."] = token_info(T3), + {error,{{1,2},erl_scan,char},{1,3}} = erl_scan:string(".$", {1,1}), + {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), test_string(". ", [{dot,{1,1}}]), test_string(". ", [{dot,{1,1}}]), @@ -413,18 +407,18 @@ dots() -> test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), test_string("%. \n. ", [{dot,{2,1}}]), - ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), + {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), {done,{ok,[{comment,{1,1},"%. "}, {white_space,{1,4},"\n"}, {dot,{2,1}}], {2,3}}, ""} = erl_scan_tokens(C, "\n. ", {1,1}, return), % any loc, any options - ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, - {"$\\\n", [{char,{1,1},$\n}]}, - {"'\\\n'", [{atom,{1,1},'\n'}]}, - {"$\n", [{char,{1,1},$\n}]}] ], + [test_string(S, R) || + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> @@ -540,8 +534,8 @@ eof() -> %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), - {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), - {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), + ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), + ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), %% With column. {more, CCol} = erl_scan:tokens([], "a.", {1,1}), @@ -655,145 +649,72 @@ options() -> ok. more_options() -> - ?line {ok,[{atom,A1,foo}],{19,20}} = + {ok,[{atom,_,foo}=T1],{19,20}} = erl_scan:string("foo", {19,17},[]), - ?line [{column,17},{line,19}] = erl_scan:attributes_info(A1), - ?line {done,{ok,[{atom,A2,foo},{dot,_}],{19,22}},[]} = + {19,17} = erl_scan:location(T1), + {done,{ok,[{atom,_,foo}=T2,{dot,_}],{19,22}},[]} = erl_scan:tokens([], "foo. ", {19,17}, [bad_opt]), % type error - ?line [{column,17},{line,19}] = erl_scan:attributes_info(A2), - ?line {ok,[{atom,A3,foo}],{19,20}} = + {19,17} = erl_scan:location(T2), + {ok,[{atom,_,foo}=T3],{19,20}} = erl_scan:string("foo", {19,17},[text]), - ?line [{column,17},{length,3},{line,19},{text,"foo"}] = - erl_scan:attributes_info(A3), + {19,17} = erl_scan:location(T3), + "foo" = erl_scan:text(T3), - ?line {ok,[{atom,A4,foo}],1} = erl_scan:string("foo", 1, [text]), - ?line [{length,3},{line,1},{text,"foo"}] = erl_scan:attributes_info(A4), + {ok,[{atom,_,foo}=T4],1} = erl_scan:string("foo", 1, [text]), + 1 = erl_scan:line(T4), + 1 = erl_scan:location(T4), + "foo" = erl_scan:text(T4), ok. token_info() -> - ?line {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), + {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), {'EXIT',{badarg,_}} = - (catch {foo, erl_scan:token_info(T1, foo)}), % type error - ?line {line,1} = erl_scan:token_info(T1, line), - ?line {column,18} = erl_scan:token_info(T1, column), - ?line {length,3} = erl_scan:token_info(T1, length), - ?line {text,"foo"} = erl_scan:token_info(T1, text), - ?line [{category,atom},{column,18},{length,3},{line,1}, - {symbol,foo},{text,"foo"}] = - erl_scan:token_info(T1), - ?line [{length,3},{column,18}] = - erl_scan:token_info(T1, [length, column]), - ?line [{location,{1,18}}] = - erl_scan:token_info(T1, [location]), - ?line {category,atom} = erl_scan:token_info(T1, category), - ?line [{symbol,foo}] = erl_scan:token_info(T1, [symbol]), - - ?line {ok,[T2],_} = erl_scan:string("foo", 1, []), - ?line {line,1} = erl_scan:token_info(T2, line), - ?line undefined = erl_scan:token_info(T2, column), - ?line undefined = erl_scan:token_info(T2, length), - ?line undefined = erl_scan:token_info(T2, text), - ?line {location,1} = erl_scan:token_info(T2, location), - ?line [{category,atom},{line,1},{symbol,foo}] = erl_scan:token_info(T2), - ?line [{line,1}] = erl_scan:token_info(T2, [length, line]), - - ?line {ok,[T3],_} = erl_scan:string("=", 1, []), - ?line [{line,1}] = erl_scan:token_info(T3, [column, line]), - ?line {category,'='} = erl_scan:token_info(T3, category), - ?line [{symbol,'='}] = erl_scan:token_info(T3, [symbol]), + (catch {foo, erl_scan:category(foo)}), % type error + {'EXIT',{badarg,_}} = + (catch {foo, erl_scan:symbol(foo)}), % type error + atom = erl_scan:category(T1), + foo = erl_scan:symbol(T1), + + {ok,[T2],_} = erl_scan:string("foo", 1, []), + 1 = erl_scan:line(T2), + undefined = erl_scan:column(T2), + undefined = erl_scan:text(T2), + 1 = erl_scan:location(T2), + + {ok,[T3],_} = erl_scan:string("=", 1, []), + '=' = erl_scan:category(T3), + '=' = erl_scan:symbol(T3), ok. -attributes_info() -> - ?line {'EXIT',_} = - (catch {foo,erl_scan:attributes_info(foo)}), % type error - [{line,18}] = erl_scan:attributes_info(erl_anno:new(18)), - {location,19} = - erl_scan:attributes_info(erl_anno:new(19), location), - ?line {ok,[{atom,A0,foo}],_} = erl_scan:string("foo", 19, [text]), - ?line {location,19} = erl_scan:attributes_info(A0, location), - - ?line {ok,[{atom,A3,foo}],_} = erl_scan:string("foo", {1,3}, [text]), - ?line {line,1} = erl_scan:attributes_info(A3, line), - ?line {column,3} = erl_scan:attributes_info(A3, column), - ?line {location,{1,3}} = erl_scan:attributes_info(A3, location), - ?line {text,"foo"} = erl_scan:attributes_info(A3, text), - - ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", 2, [text]), - ?line {line,2} = erl_scan:attributes_info(A4, line), - ?line undefined = erl_scan:attributes_info(A4, column), - ?line {location,2} = erl_scan:attributes_info(A4, location), - ?line {text,"foo"} = erl_scan:attributes_info(A4, text), - - ?line {ok,[{atom,A5,foo}],_} = erl_scan:string("foo", {1,3}, []), - ?line {line,1} = erl_scan:attributes_info(A5, line), - ?line {column,3} = erl_scan:attributes_info(A5, column), - ?line {location,{1,3}} = erl_scan:attributes_info(A5, location), - ?line undefined = erl_scan:attributes_info(A5, text), - - ?line undefined = erl_scan:attributes_info([], line), % type error +anno_info() -> + {'EXIT',_} = + (catch {foo,erl_scan:line(foo)}), % type error + {ok,[{atom,_,foo}=T0],_} = erl_scan:string("foo", 19, [text]), + 19 = erl_scan:location(T0), + 19 = erl_scan:end_location(T0), + + {ok,[{atom,_,foo}=T3],_} = erl_scan:string("foo", {1,3}, [text]), + 1 = erl_scan:line(T3), + 3 = erl_scan:column(T3), + {1,3} = erl_scan:location(T3), + {1,6} = erl_scan:end_location(T3), + "foo" = erl_scan:text(T3), + + {ok,[{atom,_,foo}=T4],_} = erl_scan:string("foo", 2, [text]), + 2 = erl_scan:line(T4), + undefined = erl_scan:column(T4), + 2 = erl_scan:location(T4), + "foo" = erl_scan:text(T4), + + {ok,[{atom,_,foo}=T5],_} = erl_scan:string("foo", {1,3}, []), + 1 = erl_scan:line(T5), + 3 = erl_scan:column(T5), + {1,3} = erl_scan:location(T5), + undefined = erl_scan:text(T5), ok. -set_attribute() -> - F = fun(Line) -> -Line end, - Anno2 = erl_anno:new(2), - A0 = erl_scan:set_attribute(line, Anno2, F), - {line, -2} = erl_scan:attributes_info(A0, line), - ?line {ok,[{atom,A1,foo}],_} = erl_scan:string("foo", {9,17}), - ?line A2 = erl_scan:set_attribute(line, A1, F), - ?line {line,-9} = erl_scan:attributes_info(A2, line), - ?line {location,{-9,17}} = erl_scan:attributes_info(A2, location), - ?line [{line,-9},{column,17}] = - erl_scan:attributes_info(A2, [line,column,text]), - - F2 = fun(Line) -> {17,Line} end, - ?line Attr1 = erl_scan:set_attribute(line, 2, F2), - ?line {line,{17,2}} = erl_scan:attributes_info(Attr1, line), - ?line undefined = erl_scan:attributes_info(Attr1, column), - ?line {location,{17,2}} = % a bit mixed up - erl_scan:attributes_info(Attr1, location), - - ?line A3 = erl_scan:set_attribute(line, A1, F2), - ?line {line,{17,9}} = erl_scan:attributes_info(A3, line), - ?line {location,{{17,9},17}} = erl_scan:attributes_info(A3, location), - ?line [{line,{17,9}},{column,17}] = - erl_scan:attributes_info(A3, [line,column,text]), - - ?line {ok,[{atom,A4,foo}],_} = erl_scan:string("foo", {9,17}, [text]), - ?line A5 = erl_scan:set_attribute(line, A4, F), - ?line {line,-9} = erl_scan:attributes_info(A5, line), - ?line {location,{-9,17}} = erl_scan:attributes_info(A5, location), - ?line [{line,-9},{column,17},{text,"foo"}] = - erl_scan:attributes_info(A5, [line,column,text]), - - ?line {ok,[{atom,A6,foo}],_} = erl_scan:string("foo", 11, [text]), - ?line A7 = erl_scan:set_attribute(line, A6, F2), - %% Incompatible with pre 18: - %% {line,{17,11}} = erl_scan:attributes_info(A7, line), - {line,17} = erl_scan:attributes_info(A7, line), - ?line {location,{17,11}} = % mixed up - erl_scan:attributes_info(A7, location), - %% Incompatible with pre 18: - %% [{line,{17,11}},{text,"foo"}] = - %% erl_scan:attributes_info(A7, [line,column,text]), - [{line,17},{column,11},{text,"foo"}] = - erl_scan:attributes_info(A7, [line,column,text]), - - ?line {'EXIT',_} = - (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error - ?line {'EXIT',{badarg,_}} = - (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error - - Attr10 = erl_anno:new(8), - Attr20 = erl_scan:set_attribute(line, Attr10, - fun(L) -> {nos,'X',L} end), - %% OTP-9412 - Attr30 = erl_scan:set_attribute(line, Attr20, - fun({nos,_V,VL}) -> VL end), - 8 = erl_anno:to_term(Attr30), - ok. - column_errors() -> ?line {error,{{1,1},erl_scan,{string,$',""}},{1,3}} = % $' erl_scan:string("'\\",{1,1}), @@ -892,14 +813,13 @@ unicode() -> erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - [{category,char},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = - erl_scan:token_info(Q2), + [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] = + token_info_long(Q2), U1 = "\"\\x{aaa}\"", - {ok,[{string,A1,[2730]}],{1,10}} = erl_scan:string(U1, {1,1}, [text]), - [{line,1},{column,1},{text,"\"\\x{aaa}\""}] = - erl_scan:attributes_info(A1, [line, column, text]), + {ok,[{string,_,[2730]}=T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]), + {1,1} = erl_scan:location(T1), + "\"\\x{aaa}\"" = erl_scan:text(T1), {ok,[{string,1,[2730]}],1} = erl_scan_string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", @@ -1012,16 +932,13 @@ otp_10302(Config) when is_list(Config) -> Qs = "$\\x{aaa}", {ok,[{char,1,2730}],1} = erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string(Qs,{1,1},[text]), - [{category,char},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = - erl_scan:token_info(Q2), - - Tags = [category, column, length, line, symbol, text], + [{category,char},{column,1},{line,1},{symbol,16#aaa},{text,Qs}] = + token_info_long(Q2), U1 = "\"\\x{aaa}\"", {ok,[T1],{1,10}} = erl_scan:string(U1, {1,1}, [text]), - [{category,string},{column,1},{length,9},{line,1}, - {symbol,[16#aaa]},{text,U1}] = erl_scan:token_info(T1, Tags), + [{category,string},{column,1},{line,1},{symbol,[16#aaa]},{text,U1}] = + token_info_long(T1), U2 = "\"\\x41\\x{fff}\\x42\"", {ok,[{string,1,[65,4095,66]}],1} = erl_scan_string(U2, 1), @@ -1353,9 +1270,7 @@ test_wsc([], []) -> ok; test_wsc([Token|Tokens], [Token2|Tokens2]) -> [Text, Text2] = [Text || - {text, Text} <- - [erl_scan:token_info(T, text) || - T <- [Token, Token2]]], + Text <- [erl_scan:text(T) || T <- [Token, Token2]]], Sz = erts_debug:size(Text), Sz2 = erts_debug:size({Text, Text2}), IsCompacted = Sz2 < 2*Sz+erts_debug:size({a,a}), @@ -1394,7 +1309,7 @@ all_same(L, Char) -> newlines_first([]) -> ok; newlines_first([Token|Tokens]) -> - {text,Text} = erl_scan:token_info(Token, text), + Text = erl_scan:text(Token), Nnls = length([C || C <- Text, C =:= $\n]), OK = case Text of [$\n|_] -> @@ -1414,7 +1329,7 @@ select_tokens(Tokens, Tags) -> lists:filter(fun(T) -> lists:member(element(1, T), Tags) end, Tokens). simplify([Token|Tokens]) -> - {line,Line} = erl_scan:token_info(Token, line), + Line = erl_scan:line(Token), [setelement(2, Token, erl_anno:new(Line)) | simplify(Tokens)]; simplify([]) -> []. @@ -1423,17 +1338,31 @@ get_text(Tokens) -> lists:flatten( [T || Token <- Tokens, - ({text,T} = erl_scan:token_info(Token, text)) =/= []]). + (T = erl_scan:text(Token)) =/= []]). test_decorated_tokens(String, Tokens) -> ToksAttrs = token_attrs(Tokens), test_strings(ToksAttrs, String, 1, 1). token_attrs(Tokens) -> - [{L,C,Len,T} || + [{L,C,length(T),T} || Token <- Tokens, - ([{line,L},{column,C},{length,Len},{text,T}] = - erl_scan:token_info(Token, [line,column,length,text])) =/= []]. + ([C,L,T] = token_info(Token)) =/= []]. + +token_info(T) -> + Column = erl_scan:column(T), + Line = erl_scan:line(T), + Text = erl_scan:text(T), + [Column, Line, Text]. + +token_info_long(T) -> + Column = erl_scan:column(T), + Line = erl_scan:line(T), + Text = erl_scan:text(T), + Category = erl_scan:category(T), + Symbol = erl_scan:symbol(T), + [{category,Category},{column,Column},{line,Line}, + {symbol,Symbol},{text,Text}]. test_strings([], _S, Line, Column) -> {Line,Column}; @@ -1514,8 +1443,7 @@ consistent_attributes([Ts | TsL]) -> L = [T || T <- Ts, is_integer(element(2, T))], case L of [] -> - TagsL = [[Tag || {Tag,_} <- - erl_scan:attributes_info(element(2, T))] || + TagsL = [[Tag || {Tag,_} <- defined(token_info_long(T))] || T <- Ts], case lists:usort(TagsL) of [_] -> @@ -1531,6 +1459,9 @@ consistent_attributes([Ts | TsL]) -> Ts end. +defined(L) -> + [{T,V} || {T,V} <- L, V =/= undefined]. + family_list(L) -> sofs:to_external(family(L)). -- cgit v1.2.3 From 7fd49429e85a1fe2c24b76bd5d3d8dfddc908822 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 30 Jun 2015 16:25:49 +0200 Subject: debugger: Fix a bug related to the use of the erl_anno module The (harmless) bug was introduced in 541e87f. --- lib/debugger/src/dbg_iload.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 2a8bcd32d8..7746a06fcb 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -541,7 +541,7 @@ fun_clauses([]) -> []. new_map(Fs0, Anno, F) -> Line = ln(Anno), Fs1 = map_fields(Fs0, F), - Fs2 = [{ln(A),K,V} || {map_field_assoc,A,K,V} <- Fs1], + Fs2 = [{L,K,V} || {map_field_assoc,L,K,V} <- Fs1], try {value,Line,map_literal(Fs2, #{})} catch -- cgit v1.2.3 From 5ba36a3857eb2673d28fd33ec4655da41ee78d3d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 30 Jun 2015 16:43:02 +0200 Subject: test_server: Fix a bug related to the use of the erl_anno module The (harmless) bug was introduced in 42cf8b8. --- lib/test_server/src/erl2html2.erl | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index 2c63103264..e281c9de1b 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -170,23 +170,32 @@ get_line(Anno) -> %%%----------------------------------------------------------------- %%% Find the line number of the last expression in the function find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause - try tuple_to_list(lists:last(Exprs)) of - [_Type,ExprLine | _] when is_integer(ExprLine) -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; - [tree,_ | Exprs1] -> + case classify_exprs(Exprs) of + {anno, Anno} -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(Anno)}; + {tree, Exprs1} -> find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs); - [macro,{_var,ExprLine,_MACRO} | _] when is_integer(ExprLine) -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(ExprLine)}; - _ -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} - catch - _:_ -> + unknown -> {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} end; - find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]). +classify_exprs(Exprs) -> + case tuple_to_list(lists:last(Exprs)) of + [macro,{_var,Anno,_MACRO} | _] -> + {anno, Anno}; + [T,ExprAnno | Exprs1] -> + case erl_anno:is_anno(ExprAnno) of + true -> + {anno, ExprAnno}; + false when T =:= tree -> + {tree, Exprs1}; + false -> + unknown + end + end. + %%%----------------------------------------------------------------- %%% Add a link target for each line and one for each function definition. build_html(SFd,DFd,Encoding,FuncsAndCs) -> -- cgit v1.2.3 From d16c327bd35493a3687f7e07e2b332d2d18c5bc8 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 2 Jul 2015 13:28:46 +0200 Subject: syntax_tools: Use the erl_anno module a bit more --- lib/syntax_tools/src/erl_syntax.erl | 2 +- lib/syntax_tools/src/merl.erl | 22 ++++++++++++++++------ lib/syntax_tools/src/merl_transform.erl | 16 ++++++++++++---- 3 files changed, 29 insertions(+), 11 deletions(-) diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 3f2a3e05dd..97b5797b06 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -355,7 +355,7 @@ %% where `Pos' `Ann' and `Comments' are the corresponding values of a %% `tree' or `wrapper' record. --record(attr, {pos = 0 :: term(), +-record(attr, {pos = erl_anno:new(0) :: term(), ann = [] :: [term()], com = none :: 'none' | #com{}}). -type syntaxTreeAttributes() :: #attr{}. diff --git a/lib/syntax_tools/src/merl.erl b/lib/syntax_tools/src/merl.erl index 690306c17b..163ce48bbc 100644 --- a/lib/syntax_tools/src/merl.erl +++ b/lib/syntax_tools/src/merl.erl @@ -514,15 +514,17 @@ parse_forms([]) -> parse_2(Ts) -> %% one or more comma-separated expressions? %% (recall that Ts has no dot tokens if we get to this stage) - case erl_parse:parse_exprs(Ts ++ [{dot,0}]) of + A = a0(), + case erl_parse:parse_exprs(Ts ++ [{dot,A}]) of {ok, Exprs} -> Exprs; {error, E} -> - parse_3(Ts ++ [{'end',0}, {dot,0}], [E]) + parse_3(Ts ++ [{'end',A}, {dot,A}], [E]) end. parse_3(Ts, Es) -> %% try-clause or clauses? - case erl_parse:parse_exprs([{'try',0}, {atom,0,true}, {'catch',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'try',A}, {atom,A,true}, {'catch',A} | Ts]) of {ok, [{'try',_,_,_,_,_}=X]} -> %% get the right kind of qualifiers in the clause patterns erl_syntax:try_expr_handlers(X); @@ -533,7 +535,8 @@ parse_3(Ts, Es) -> parse_4(Ts, Es) -> %% fun-clause or clauses? (`(a)' is also a pattern, but `(a,b)' isn't, %% so fun-clauses must be tried before normal case-clauses - case erl_parse:parse_exprs([{'fun',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'fun',A} | Ts]) of {ok, [{'fun',_,{clauses,Cs}}]} -> Cs; {error, E} -> parse_5(Ts, [E|Es]) @@ -541,7 +544,8 @@ parse_4(Ts, Es) -> parse_5(Ts, Es) -> %% case-clause or clauses? - case erl_parse:parse_exprs([{'case',0}, {atom,0,true}, {'of',0} | Ts]) of + A = a0(), + case erl_parse:parse_exprs([{'case',A}, {atom,A,true}, {'of',A} | Ts]) of {ok, [{'case',_,_,Cs}]} -> Cs; {error, E} -> %% select the best error to report @@ -1210,7 +1214,7 @@ merge_comments(StartLine, Cs, [], Acc) -> merge_comments(StartLine, [], [], [erl_syntax:set_pos( erl_syntax:comment(Indent, Text), - StartLine + Line - 1) + anno(StartLine + Line - 1)) || {Line, _, Indent, Text} <- Cs] ++ Acc); merge_comments(StartLine, [C|Cs], [T|Ts], Acc) -> {Line, _Col, Indent, Text} = C, @@ -1228,3 +1232,9 @@ merge_comments(StartLine, [C|Cs], [T|Ts], Acc) -> [erl_syntax:comment(Indent, Text)], T), merge_comments(StartLine, Cs, [Tc|Ts], Acc) end. + +a0() -> + anno(0). + +anno(Location) -> + erl_anno:new(Location). diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl index 66b06c8137..fe58b6a122 100644 --- a/lib/syntax_tools/src/merl_transform.erl +++ b/lib/syntax_tools/src/merl_transform.erl @@ -68,8 +68,7 @@ case_guard([{expr,_}, {text,Text}]) -> erl_syntax:is_literal(Text). case_body([{expr,Expr}, {text,_Text}], T) -> - pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), - erl_syntax:get_pos(T)). + pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)). post(T) -> merl:switch( @@ -79,7 +78,7 @@ post(T) -> lists:all(fun erl_syntax:is_literal/1, [F|As]) end, fun ([{args, As}, {function, F}]) -> - Line = erl_syntax:get_pos(F), + Line = get_location(F), [F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]), eval_call(Line, F1, As1, T) end}, @@ -118,7 +117,7 @@ expand_qquote(_As, T, _StartPos) -> expand_template(F, [Pattern | Args], T) -> case erl_syntax:is_literal(Pattern) of true -> - Line = erl_syntax:get_pos(Pattern), + Line = get_location(Pattern), As = [erl_syntax:concrete(Pattern)], merl:qquote(Line, "merl:_@function(_@pattern, _@args)", [{function, F}, @@ -260,3 +259,12 @@ is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× -> true; is_erlang_var(_) -> false. + +get_location(T) -> + Pos = erl_syntax:get_pos(T), + case erl_anno:is_anno(Pos) of + true -> + erl_anno:location(Pos); + false -> + Pos + end. -- cgit v1.2.3 From 92e500538666c79557d805de1e66622e09db2f07 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 15 Sep 2015 14:29:19 +0200 Subject: Update primary bootstrap --- bootstrap/lib/stdlib/ebin/erl_anno.beam | Bin 4808 -> 4016 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89040 -> 89280 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 84136 -> 83772 bytes bootstrap/lib/stdlib/ebin/erl_scan.beam | Bin 31308 -> 28932 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11536 -> 11640 bytes 5 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam index a254259665..72a255c88f 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_anno.beam and b/bootstrap/lib/stdlib/ebin/erl_anno.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 5657d00131..18e9ecf412 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 6bd75ad6b9..6abc91b505 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam index c555a25a9c..73ded63f14 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_scan.beam and b/bootstrap/lib/stdlib/ebin/erl_scan.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 9e63d204b6..6bf5fc1e2c 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ -- cgit v1.2.3 From 576b2e9cbb4dab925b3943d2b82b43a3b4d79487 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 21 Sep 2015 10:25:58 +0200 Subject: Update primary bootstrap --- bootstrap/bin/start.boot | Bin 5285 -> 5285 bytes bootstrap/bin/start_clean.boot | Bin 5285 -> 5285 bytes bootstrap/lib/compiler/ebin/beam_block.beam | Bin 16012 -> 16064 bytes bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 29504 -> 30160 bytes bootstrap/lib/compiler/ebin/core_lib.beam | Bin 5200 -> 4408 bytes bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 49668 -> 49672 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 13712 -> 13712 bytes bootstrap/lib/kernel/ebin/inet_dns.beam | Bin 19664 -> 19672 bytes bootstrap/lib/kernel/ebin/kernel.app | 6 +++--- bootstrap/lib/kernel/ebin/kernel.appup | 8 +++++--- bootstrap/lib/stdlib/ebin/error_logger_file_h.beam | Bin 5084 -> 4656 bytes bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam | Bin 5020 -> 4936 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11640 -> 11656 bytes bootstrap/lib/stdlib/ebin/proc_lib.beam | Bin 10432 -> 10656 bytes bootstrap/lib/stdlib/ebin/re.beam | Bin 13804 -> 13632 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 30260 -> 30272 bytes bootstrap/lib/stdlib/ebin/stdlib.app | 4 ++-- bootstrap/lib/stdlib/ebin/stdlib.appup | 8 +++++--- bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 23884 -> 23888 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 26812 -> 26572 bytes 20 files changed, 15 insertions(+), 11 deletions(-) diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot index 421e14f015..b93d49f146 100644 Binary files a/bootstrap/bin/start.boot and b/bootstrap/bin/start.boot differ diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot index 421e14f015..b93d49f146 100644 Binary files a/bootstrap/bin/start_clean.boot and b/bootstrap/bin/start_clean.boot differ diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam index 4c638cac32..c862a391b6 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_block.beam and b/bootstrap/lib/compiler/ebin/beam_block.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index b19913760c..03582d94c3 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam index f5973746a3..32b770c186 100644 Binary files a/bootstrap/lib/compiler/ebin/core_lib.beam and b/bootstrap/lib/compiler/ebin/core_lib.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam index 8942f40f4d..fd67612ed5 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index a2987da34b..e60cf784ea 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam index 9404760336..415c436dc2 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_dns.beam and b/bootstrap/lib/kernel/ebin/inet_dns.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 85ba41bcef..644077b9e7 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "4.0"}, + {vsn, "4.1"}, {modules, [application, application_controller, application_master, @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.5", "sasl-2.4"]} + {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index d09e0c6347..b2a161aa1d 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -16,9 +16,11 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"4.0", +{"4.1", %% Up from - max one major revision back - [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 + [{<<"4\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.0.* + {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 + [{<<"4\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.0.* + {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam index b7ced33bc1..0e61e87708 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam index 1211fecf41..46eafce18e 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 6bf5fc1e2c..97b7826149 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam index 6e02f1fae2..568015b3e4 100644 Binary files a/bootstrap/lib/stdlib/ebin/proc_lib.beam and b/bootstrap/lib/stdlib/ebin/proc_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam index ea3a7afb4f..2aff2bfcfa 100644 Binary files a/bootstrap/lib/stdlib/ebin/re.beam and b/bootstrap/lib/stdlib/ebin/re.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index 3b9f67eb29..e27b7bcb84 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 4a52c6a443..7a76bc0ff1 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.5"}, + {vsn, "2.6"}, {modules, [array, base64, beam_lib, @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-4.0","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 689485f421..8cfe41a2e1 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -16,9 +16,11 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"2.5", +{"2.6", %% Up from - max one major revision back - [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 + [{<<"2\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, %% OTP-18.0.* + {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 %% Down to - max one major revision back - [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 + [{<<"2\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, %% OTP-18.0.* + {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index e5ab7f8fc7..c27ce0b092 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index 71b7d63112..35b6dbbd1f 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ -- cgit v1.2.3 From 9a1f7c4156093effddd555e88fd16a2ffd6ae75a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 15 Sep 2015 17:23:19 +0200 Subject: Regain full coverage of beam_block d0784035ab fixed a problem with register corruption. Because of that, opt_moves/2 will never be asked to optimize instructions with more than two destination registers. Therefore, to regain full coverage of beam_block, remove the final clause in opt_moves/2. --- lib/compiler/src/beam_block.erl | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 75202d9379..ebf9b5fec5 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -283,11 +283,7 @@ opt_moves([X0,Y0], Is0) -> not_possible -> {[X,Y0],Is2}; {X,_} -> {[X,Y0],Is2}; {Y,Is} -> {[X,Y],Is} - end; -opt_moves(Ds, Is) -> - %% multiple destinations -> pass through - {Ds,Is}. - + end. %% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible %% If there is a {move,Dest,FinalDest} instruction -- cgit v1.2.3 From 6fa5c094e94e06f02b717f00e90ac777652ea6b8 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 18 Sep 2015 15:00:38 +0200 Subject: Adjust test case for missing applications --- erts/test/otp_SUITE.erl | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 69a0d19719..c92a7cf6f7 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -301,9 +301,11 @@ call_to_now_0(Config) when is_list(Config) -> test_server,tools,webtool], not_recommended_calls(Config, Apps, {erlang,now,0}). -not_recommended_calls(Config, Apps, MFA) -> +not_recommended_calls(Config, Apps0, MFA) -> Server = ?config(xref_server, Config), + Apps = [App || App <- Apps0, is_present_application(App, Server)], + Fs = [MFA], Q1 = io_lib:format("E || ~p : Fun", [Fs]), @@ -337,11 +339,28 @@ not_recommended_calls(Config, Apps, MFA) -> end, case CallsToMFA of [] -> - ok; + SkippedApps = ordsets:subtract(ordsets:from_list(Apps0), + ordsets:from_list(Apps)), + case SkippedApps of + [] -> + ok; + _ -> + AppStrings = [atom_to_list(A) || A <- SkippedApps], + Mess = io_lib:format("Application(s) not present: ~s\n", + [string:join(AppStrings, ", ")]), + {comment, Mess} + end; _ -> ?t:fail({length(CallsToMFA),calls_to_size_1}) end. +is_present_application(Name, Server) -> + Q = io_lib:format("~w : App", [Name]), + case xref:q(Server, lists:flatten(Q)) of + {ok,[Name]} -> true; + {error,_,_} -> false + end. + strong_components(Config) when is_list(Config) -> Server = ?config(xref_server, Config), ?line {ok,Cs} = xref:q(Server, "components AE"), -- cgit v1.2.3 From 9504c0dd71d0b1b49251a97f45c71c8882ce7708 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 15 Sep 2015 13:55:38 +0200 Subject: v3_codegen: Optimize matching of the final size-less binary segment Consider the following function: f(Bin, Bool) -> case Bin of <> when Bool -> Val end. Simplified, the generated code looks like: bs_start_match2 Fail Live Bin => Bin bs_get_integer2 Fail Live Bin size=Sz unit=1 => Val bs_skip_bits2 Fail Bin size=all unit=8 is_eq_exact Fail Bool true The code generator will replace the bs_skip_bits2 instruction with a bs_test_unit instruction if it can be clearly seen that the context register will not be used again. In this case, it is not obvious without looking at the code at the Fail label. However, it turns out that bs_test_unit instruction is always safe beacuse of the way v3_kernel compiles pattern matching. It doesn't matter whether the match context will be used again. If it will be used again, the position in it will *not* be used. Instead, a bs_restore2 instruction will restore one of the saved instructions. --- lib/compiler/src/v3_codegen.erl | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 34c67b16ca..5083995f30 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -827,21 +827,24 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, {bs_save2,CtxReg,{Ctx,Tl}}],Int1} end, {Es,clear_dead(Aft, I, Vdb),St}; -select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, +select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf, I, Vdb, Bef, Ctx, Body, St) -> - SizeReg = get_bin_size_reg(Size0, Bef), + %% Match the last segment of a binary. We KNOW that the size + %% must be 'all'. + Size = {atom,all}, %Assertion. {Es,Aft} = case vdb_find(Hd, Vdb) of {_,_,Lhd} when Lhd =< I -> + %% The result will not be used. Furthermore, since we + %% we are at the end of the binary, the position will + %% not be used again; thus, it is safe to do a cheaper + %% test of the unit. CtxReg = fetch_var(Ctx, Bef), - {case SizeReg =:= {atom,all} andalso is_context_unused(Body) of - true when Unit =:= 1 -> + {case Unit of + 1 -> []; - true -> - [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}]; - false -> - [{test,bs_skip_bits2,{f,Vf}, - [CtxReg,SizeReg,Unit,{field_flags,Flags}]}] + _ -> + [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}] end,Bef}; {_,_,_} -> case is_context_unused(Body) of @@ -853,7 +856,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Bef#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],Rhd}], + [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}], Int1}; true -> %% Since the matching context will not be used again, @@ -868,7 +871,7 @@ select_extract_bin([{var,Hd}], Size0, Unit, binary, Flags, Vf, Name = bs_get_binary2, Live = max_reg(Int1#sr.reg), {[{test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],CtxReg}], + [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}], Int1} end end, -- cgit v1.2.3 From f7fd259f27bce0058d996af6287e6bb81d12ea47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 15 Sep 2015 16:50:19 +0200 Subject: sys_core_fold: Extend the list of BIFs that return integers Knowing that a BIF returns an integer makes it possible to replace '==' with the cheaper '=:=' test. --- lib/compiler/src/sys_core_fold.erl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 27d023d067..0a16776bd4 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2793,12 +2793,18 @@ extract_type_1(Expr, Sub) -> true -> bool end. +returns_integer('band', [_,_]) -> true; +returns_integer('bnot', [_]) -> true; +returns_integer('bor', [_,_]) -> true; +returns_integer('bxor', [_,_]) -> true; returns_integer(bit_size, [_]) -> true; returns_integer('bsl', [_,_]) -> true; returns_integer('bsr', [_,_]) -> true; returns_integer(byte_size, [_]) -> true; +returns_integer('div', [_,_]) -> true; returns_integer(length, [_]) -> true; returns_integer('rem', [_,_]) -> true; +returns_integer('round', [_]) -> true; returns_integer(size, [_]) -> true; returns_integer(tuple_size, [_]) -> true; returns_integer(trunc, [_]) -> true; -- cgit v1.2.3 From 8372f56a06ef24cf4455a54e15d876ab6ca8c570 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 21 Sep 2015 14:27:30 +0200 Subject: Move out bit syntax optimizations from beam_block In the future we might want to add more bit syntax optimizations, but beam_block is already sufficiently complicated. Therefore, move the bit syntax optimizations out of beam_block into a separate compiler pass called beam_bs. --- lib/compiler/src/Makefile | 1 + lib/compiler/src/beam_block.erl | 261 ++------------------------------- lib/compiler/src/beam_bs.erl | 278 ++++++++++++++++++++++++++++++++++++ lib/compiler/src/compile.erl | 2 + lib/compiler/src/compiler.app.src | 1 + lib/compiler/test/compile_SUITE.erl | 2 + lib/compiler/test/misc_SUITE.erl | 4 + 7 files changed, 298 insertions(+), 251 deletions(-) create mode 100644 lib/compiler/src/beam_bs.erl diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index ae4007c61c..f75beaba20 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -50,6 +50,7 @@ MODULES = \ beam_asm \ beam_block \ beam_bool \ + beam_bs \ beam_bsm \ beam_clean \ beam_dead \ diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index ebf9b5fec5..741fdbb973 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -23,13 +23,13 @@ -module(beam_block). -export([module/2]). --import(lists, [mapfoldl/3,reverse/1,reverse/2,foldl/3,member/2]). +-import(lists, [reverse/1,reverse/2,foldl/3,member/2]). -module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> - {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}, Lc0) -> +function({function,Name,Arity,CLabel,Is0}) -> try %% Collect basic blocks and optimize them. Is1 = blockify(Is0), @@ -39,11 +39,8 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> Is5 = opt_blocks(Is4), Is6 = beam_utils:delete_live_annos(Is5), - %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is6, Lc0), - %% Done. - {{function,Name,Arity,CLabel,Is},Lc} + {function,Name,Arity,CLabel,Is6} catch Class:Error -> Stack = erlang:get_stacktrace(), @@ -89,18 +86,11 @@ blockify([{test,is_atom,{f,Fail},[Reg]}=I| {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) end; blockify([I|Is0]=IsAll, Acc) -> - case is_bs_put(I) of - true -> - {BsPuts0,Is} = collect_bs_puts(IsAll), - BsPuts = opt_bs_puts(BsPuts0), - blockify(Is, reverse(BsPuts, Acc)); - false -> - case collect(I) of - error -> blockify(Is0, [I|Acc]); - Instr when is_tuple(Instr) -> - {Block,Is} = collect_block(IsAll), - blockify(Is, [{block,Block}|Acc]) - end + case collect(I) of + error -> blockify(Is0, [I|Acc]); + Instr when is_tuple(Instr) -> + {Block,Is} = collect_block(IsAll), + blockify(Is, [{block,Block}|Acc]) end; blockify([], Acc) -> reverse(Acc). @@ -493,234 +483,3 @@ x_dead([], Regs) -> Regs. x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. - -%%% -%%% Evaluation of constant bit fields. -%%% - -is_bs_put({bs_put,_,{bs_put_integer,_,_},_}) -> true; -is_bs_put({bs_put,_,{bs_put_float,_,_},_}) -> true; -is_bs_put(_) -> false. - -collect_bs_puts(Is) -> - collect_bs_puts_1(Is, []). - -collect_bs_puts_1([I|Is]=Is0, Acc) -> - case is_bs_put(I) of - false -> {reverse(Acc),Is0}; - true -> collect_bs_puts_1(Is, [I|Acc]) - end. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put,Fail, - {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> - try eval_put_float(Src, Sz, Flags0) of - <> -> - Flags = force_big(Flags0), - I = {bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}, - opt_bs_1([I|Is], Acc) - catch - error:_ -> - opt_bs_1(Is, [I0|Acc]) - end; -opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, - Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], - Acc) when Sz > 8 -> - case field_endian(F) of - big -> - %% We can do this optimization for any field size without risk - %% for code explosion. - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little when Sz < 128 -> - %% We only try to optimize relatively small fields, to avoid - %% an explosion in code size. - <> = <>, - Flags = force_big(F), - Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}|Is0], - opt_bs_1(Is, Acc); - _ -> %native or too wide little field - opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> - opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) when Sz =< 256 -> %Only evaluate if Sz is reasonable. - Val = value(Src), - case field_endian(Flags) of - little -> <>; - big -> <> - %% native intentionally not handled here - we can't optimize it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F. - -bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(-1, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only 255 bytes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,-1}]}, - [I|Acc]; -bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,0}]}, - [I|Acc]; -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,ByteSz},{integer,N band Mask}]}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. - - -%%% -%%% Optimization of new bit syntax matching: get rid -%%% of redundant bs_restore2/2 instructions across select_val -%%% instructions, as well as a few other simple peep-hole optimizations. -%%% - -bsm_opt(Is0, Lc0) -> - {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), - Is2 = case D0 of - [] -> - Is1; - _ -> - D = gb_trees:from_orddict(orddict:from_list(D0)), - bsm_reroute(Is1, D, none, []) - end, - Is = beam_clean:bs_clean_saves(Is2), - {bsm_opt_2(Is, []),Lc}. - -bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> - D = [{{L,Save},Lc}|D0], - Acc = [{label,Lc},R,Lbl|Acc0], - bsm_scan(Is, D, Lc+1, Acc); -bsm_scan([I|Is], D, Lc, Acc) -> - bsm_scan(Is, D, Lc, [I|Acc]); -bsm_scan([], D, Lc, Acc) -> - {reverse(Acc),D,Lc}. - -bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{label,_}=I|Is], D, S, Acc) -> - bsm_reroute(Is, D, S, [I|Acc]); -bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> - [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), - Acc = [{select,select_val,Reg,F,Lbls}|Acc0], - bsm_reroute(Is, D, S, Acc); -bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,TestArgs}|Acc0], - case bsm_not_bs_test(I) of - true -> - %% The test instruction will not update the bit offset for the - %% binary being matched. Therefore the save position can be kept. - bsm_reroute(Is, D, S, Acc); - false -> - %% The test instruction might update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc) - end; -bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], - %% The test instruction will update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc); -bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, - {bs_context_to_binary,_}=I|Is], D, S, Acc) -> - %% To help further bit syntax optimizations. - bsm_reroute([I,Bl|Is], D, S, Acc); -bsm_reroute([I|Is], D, _, Acc) -> - bsm_reroute(Is, D, none, [I|Acc]); -bsm_reroute([], _, _, Acc) -> reverse(Acc). - -bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); -bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -bsm_opt_2([I|Is], Acc) -> - bsm_opt_2(Is, [I|Acc]); -bsm_opt_2([], Acc) -> reverse(Acc). - -%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. -%% Test whether is the test is a "safe", i.e. does not move the -%% bit offset for a binary. -%% -%% 'true' means that the test is safe, 'false' that we don't know or -%% that the test moves the offset (e.g. bs_get_integer2). - -bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; -bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). - -bsm_subst_labels(Fs, Save, D) -> - bsm_subst_labels_1(Fs, Save, D, []). - -bsm_subst_labels_1([F|Fs], Save, D, Acc) -> - bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); -bsm_subst_labels_1([], _, _, Acc) -> - reverse(Acc). - -bsm_subst_label({f,Lbl0}=F, Save, D) -> - case gb_trees:lookup({Lbl0,Save}, D) of - {value,Lbl} -> {f,Lbl}; - none -> F - end; -bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl new file mode 100644 index 0000000000..55fa7ce10c --- /dev/null +++ b/lib/compiler/src/beam_bs.erl @@ -0,0 +1,278 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose : Partitions assembly instructions into basic blocks and +%% optimizes them. + +-module(beam_bs). + +-export([module/2]). +-import(lists, [mapfoldl/3,reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> + {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}, Lc0) -> + try + Is1 = bs_put_opt(Is0), + {Is,Lc} = bsm_opt(Is1, Lc0), + {{function,Name,Arity,CLabel,Is},Lc} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%%% +%%% Evaluation of constant bit fields. +%%% + +bs_put_opt([{bs_put,_,_,_}=I|Is0]) -> + {BsPuts0,Is} = collect_bs_puts(Is0, [I]), + BsPuts = opt_bs_puts(BsPuts0), + BsPuts ++ bs_put_opt(Is); +bs_put_opt([I|Is]) -> + [I|bs_put_opt(Is)]; +bs_put_opt([]) -> []. + +collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> + collect_bs_puts(Is, [I|Acc]); +collect_bs_puts([_|_]=Is, Acc) -> + {reverse(Acc),Is}. + +opt_bs_puts(Is) -> + opt_bs_1(Is, []). + +opt_bs_1([{bs_put,Fail, + {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> + try eval_put_float(Src, Sz, Flags0) of + <> -> + Flags = force_big(Flags0), + I = {bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}, + opt_bs_1([I|Is], Acc) + catch + error:_ -> + opt_bs_1(Is, [I0|Acc]) + end; +opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, + Acc0) -> + {Is,Acc} = bs_collect_string(IsAll, Acc0), + opt_bs_1(Is, Acc); +opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], + Acc) when Sz > 8 -> + case field_endian(F) of + big -> + %% We can do this optimization for any field size without + %% risk for code explosion. + case bs_split_int(N, Sz, Fail, Is0) of + no_split -> opt_bs_1(Is0, [I|Acc]); + Is -> opt_bs_1(Is, Acc) + end; + little when Sz < 128 -> + %% We only try to optimize relatively small fields, to + %% avoid an explosion in code size. + <> = <>, + Flags = force_big(F), + Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}|Is0], + opt_bs_1(Is, Acc); + _ -> %native or too wide little field + opt_bs_1(Is0, [I|Acc]) + end; +opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> + opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); +opt_bs_1([I|Is], Acc) -> + opt_bs_1(Is, [I|Acc]); +opt_bs_1([], Acc) -> reverse(Acc). + +eval_put_float(Src, Sz, Flags) when Sz =< 256 -> + %%Only evaluate if Sz is reasonable. + Val = value(Src), + case field_endian(Flags) of + little -> <>; + big -> <> + %% native intentionally not handled here - we can't optimize + %% it. + end. + +value({integer,I}) -> I; +value({float,F}) -> F. + +bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> + bs_coll_str_1(Is, Len, reverse(Str), Acc); +bs_collect_string(Is, Acc) -> + bs_coll_str_1(Is, 0, [], Acc). + +bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], + Len, StrAcc, IsAcc) when U*Sz =:= 8 -> + Byte = V band 16#FF, + bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); +bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> + {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. + +field_endian({field_flags,F}) -> field_endian_1(F). + +field_endian_1([big=E|_]) -> E; +field_endian_1([little=E|_]) -> E; +field_endian_1([native=E|_]) -> E; +field_endian_1([_|Fs]) -> field_endian_1(Fs). + +force_big({field_flags,F}) -> + {field_flags,force_big_1(F)}. + +force_big_1([big|_]=Fs) -> Fs; +force_big_1([little|Fs]) -> [big|Fs]; +force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. + +bs_split_int(0, Sz, _, _) when Sz > 64 -> + %% We don't want to split in this case because the + %% string will consist of only zeroes. + no_split; +bs_split_int(-1, Sz, _, _) when Sz > 64 -> + %% We don't want to split in this case because the + %% string will consist of only 255 bytes. + no_split; +bs_split_int(N, Sz, Fail, Acc) -> + FirstByteSz = case Sz rem 8 of + 0 -> 8; + Rem -> Rem + end, + bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). + +bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,-1}]}, + [I|Acc]; +bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,0}]}, + [I|Acc]; +bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> + Mask = (1 bsl ByteSz) - 1, + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,ByteSz},{integer,N band Mask}]}, + bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); +bs_split_int_1(_, _, _, _, Acc) -> Acc. + +%%% +%%% Optimization of bit syntax matching: get rid +%%% of redundant bs_restore2/2 instructions across select_val +%%% instructions, as well as a few other simple peep-hole +%%% optimizations. +%%% + +bsm_opt(Is0, Lc0) -> + {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), + Is2 = case D0 of + [] -> + %% No bit syntax matching in this function. + Is1; + [_|_] -> + %% Optimize the bit syntax matching. + D = gb_trees:from_orddict(orddict:from_list(D0)), + bsm_reroute(Is1, D, none, []) + end, + Is = beam_clean:bs_clean_saves(Is2), + {bsm_opt_2(Is, []),Lc}. + +bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> + D = [{{L,Save},Lc}|D0], + Acc = [{label,Lc},R,Lbl|Acc0], + bsm_scan(Is, D, Lc+1, Acc); +bsm_scan([I|Is], D, Lc, Acc) -> + bsm_scan(Is, D, Lc, [I|Acc]); +bsm_scan([], D, Lc, Acc) -> + {reverse(Acc),D,Lc}. + +bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> + bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); +bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> + bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); +bsm_reroute([{label,_}=I|Is], D, S, Acc) -> + bsm_reroute(Is, D, S, [I|Acc]); +bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> + [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), + Acc = [{select,select_val,Reg,F,Lbls}|Acc0], + bsm_reroute(Is, D, S, Acc); +bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> + F = bsm_subst_label(F0, Save, D), + Acc = [{test,TestOp,F,TestArgs}|Acc0], + case bsm_not_bs_test(I) of + true -> + %% The test instruction will not update the bit offset for + %% the binary being matched. Therefore the save position + %% can be kept. + bsm_reroute(Is, D, S, Acc); + false -> + %% The test instruction might update the bit offset. Kill + %% our remembered Save position. + bsm_reroute(Is, D, none, Acc) + end; +bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> + F = bsm_subst_label(F0, Save, D), + Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], + %% The test instruction will update the bit offset. Kill our + %% remembered Save position. + bsm_reroute(Is, D, none, Acc); +bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, + {bs_context_to_binary,_}=I|Is], D, S, Acc) -> + %% To help further bit syntax optimizations. + bsm_reroute([I,Bl|Is], D, S, Acc); +bsm_reroute([I|Is], D, _, Acc) -> + bsm_reroute(Is, D, none, [I|Acc]); +bsm_reroute([], _, _, Acc) -> reverse(Acc). + +bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], + [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> + bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); +bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], + [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> + bsm_opt_2(Is, [{test,bs_skip_bits2,F, + [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); +bsm_opt_2([I|Is], Acc) -> + bsm_opt_2(Is, [I|Acc]); +bsm_opt_2([], Acc) -> reverse(Acc). + +%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. +%% Test whether is the test is a "safe", i.e. does not move the +%% bit offset for a binary. +%% +%% 'true' means that the test is safe, 'false' that we don't know or +%% that the test moves the offset (e.g. bs_get_integer2). + +bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; +bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). + +bsm_subst_labels(Fs, Save, D) -> + bsm_subst_labels_1(Fs, Save, D, []). + +bsm_subst_labels_1([F|Fs], Save, D, Acc) -> + bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); +bsm_subst_labels_1([], _, _, Acc) -> + reverse(Acc). + +bsm_subst_label({f,Lbl0}=F, Save, D) -> + case gb_trees:lookup({Lbl0,Save}, D) of + {value,Lbl} -> {f,Lbl}; + none -> F + end; +bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 605f5b8fd5..a2a23a2b90 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -679,6 +679,8 @@ asm_passes() -> {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, + {unless,no_bs_opt,{pass,beam_bs}}, + {iff,dbs,{listing,"bs"}}, {unless,no_bopt,{pass,beam_bool}}, {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 62ea9cee80..a2b2a1d277 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -25,6 +25,7 @@ beam_asm, beam_block, beam_bool, + beam_bs, beam_bsm, beam_clean, beam_dead, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index cbdd9ce8cd..806cb58bab 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -330,6 +330,8 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dlife, ".life"), do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), + do_listing(Simple, TargetDir, dexcept, ".except"), + do_listing(Simple, TargetDir, dbs, ".bs"), do_listing(Simple, TargetDir, dbool, ".bool"), do_listing(Simple, TargetDir, dtype, ".type"), do_listing(Simple, TargetDir, ddead, ".dead"), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 3582e055c8..b88abaf62d 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -208,6 +208,10 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_block:module(BlockInput, []) end), + %% beam_bs + BsInput = BlockInput, + expect_error(fun() -> beam_bs:module(BsInput, []) end), + %% beam_type TypeInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, -- cgit v1.2.3 From 58a0c1c6c7efdb1f1250edec1b5fcd5eb72e99b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 22 Sep 2015 06:14:36 +0200 Subject: beam_dead: Optimize select_val instructions In a select_val instruction, values associated with a label which is the same as the failure label can be removed. We already do this optimization in beam_clean, but it is better do this sort of optimization before the beam_jump pass. Also rewrite a select_val instruction with a single value to is_eq_exact instruction followed by a jump instruction. --- lib/compiler/src/beam_dead.erl | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 0cb5040177..fcd108bd89 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -239,10 +239,18 @@ backward([{test,is_eq_exact,Fail,[Dst,{integer,Arity}]}=I| backward([{label,Lbl}=L|Is], D, Acc) -> backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]); backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> - List = shortcut_select_list(List0, Reg, D, []), + List1 = shortcut_select_list(List0, Reg, D, []), Fail1 = shortcut_label(Fail0, D), Fail = shortcut_bs_test(Fail1, Is, D), + List = prune_redundant(List1, Fail), case List of + [] -> + Jump = {jump,{f,Fail}}, + backward([Jump|Is], D, Acc); + [V,F] -> + Test = {test,is_eq_exact,{f,Fail},[Reg,V]}, + Jump = {jump,F}, + backward([Jump,Test|Is], D, Acc); [{atom,B1},F,{atom,B2},F] when B1 =:= not B2 -> Test = {test,is_boolean,{f,Fail},[Reg]}, Jump = {jump,F}, @@ -307,6 +315,16 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> %% An is_atom test before an is_boolean test (with the %% same failure label) is redundant. backward(Is, D, Acc); + {{test,is_atom,Fail,[R]}, + [{test,is_eq_exact,Fail,[R,{atom,_}]}|_]} -> + %% An is_atom test before a comparison with an atom (with + %% the same failure label) is redundant. + backward(Is, D, Acc); + {{test,is_integer,Fail,[R]}, + [{test,is_eq_exact,Fail,[R,{integer,_}]}|_]} -> + %% An is_integer test before a comparison with an integer + %% (with the same failure label) is redundant. + backward(Is, D, Acc); {{test,_,_,_},_} -> %% Still a test instruction. Done. backward(Is, D, [I|Acc]); @@ -366,6 +384,12 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). +prune_redundant([_,{f,Fail}|T], Fail) -> + prune_redundant(T, Fail); +prune_redundant([V,F|T], Fail) -> + [V,F|prune_redundant(T, Fail)]; +prune_redundant([], _) -> []. + %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% -- cgit v1.2.3 From 105c5b0071056dc062797e58772e098d2a3a4627 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 22 Sep 2015 10:40:06 +0200 Subject: beam_dead: Improve optimization of literal binary matching When the bit syntax is used to match a single binary literal, the bit syntax instructions will be replaced with a comparison to a binary literal. The only problem is that the bs_context_to_binary instruction will not be eliminated. Example: f(<<"string">>) -> ok. This function would be translated to: {function, f, 1, 2}. {label,1}. {line,...}. {func_info,...}. {label,2}. {test,is_eq_exact,{f,3},[{x,0},{literal,<<"string">>}]}. {move,{atom,ok},{x,0}}. return. {label,3}. {bs_context_to_binary,{x,0}}. {jump,{f,1}}. The bs_context_to_binary instruction serves no useful purpose, since {x,0} can never be a match context. Eliminating the instruction, the resulting code will be: {function, f, 1, 2}. {label,1}. {line,...}. {func_info,...}. {label,2}. {test,is_eq_exact,{f,1},[{x,0},{literal,<<"string">>}]}. {move,{atom,ok},{x,0}}. return. --- lib/compiler/src/beam_dead.erl | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index fcd108bd89..11129c39bc 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -272,14 +272,17 @@ backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> catch throw:not_possible -> backward(Is0, D, [J|Acc]) end; -backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D, +backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D, [{test,bs_match_string,F,[Ctxt,Bs]}, {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> + {f,To0} = F, + To = shortcut_bs_start_match(To0, R, D), case beam_utils:is_killed(Ctxt, Acc0, D) of true -> - Eq = {test,is_eq_exact,F,[R,{literal,Bs}]}, + Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]}, backward(Is, D, [Eq|Acc0]); false -> + I = {test,bs_start_match2,{f,To},Live,Args,Ctxt}, backward(Is, D, [I|Acc]) end; backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> -- cgit v1.2.3 From c60b4d8ae7d6481bd02782f561fd4d9f626ea6df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 23 Sep 2015 10:35:52 +0200 Subject: beam_type: Fix forgotten change of internal representation 30cc5c90 changed the internal representation of catch and try...catch, but beam_type was not updated in one place. --- lib/compiler/src/beam_type.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 40d67d1670..6b5cf667ba 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -311,7 +311,7 @@ flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) -> {[],H,Fl}; flt_need_heap_2({set,_,_,get_list}, H, Fl) -> {[],H,Fl}; -flt_need_heap_2({set,_,_,{'catch',_}}, H, Fl) -> +flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) -> {[],H,Fl}; %% All other instructions should cause the insertion of an allocation %% instruction if needed. -- cgit v1.2.3 From ae125a3bc62c2165a9db028e12aa6e9f90c7d9cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 24 Sep 2015 14:46:16 +0200 Subject: beam_type: Remove unused clause The clause cannot possibly match, because there will always be a {bif,...} clause that will match before reaching the fclearerror instruction. --- lib/compiler/src/beam_type.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 6b5cf667ba..bb91bbcc0a 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -618,7 +618,6 @@ checkerror(Is) -> checkerror_1(Is, Is). checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); -- cgit v1.2.3 From c0c5943c3a2646a3383d974c2a1afcff8c5d16d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 23 Sep 2015 07:23:15 +0200 Subject: beam_type: Improve optimization by keeping track of integers The ASN.1 compiler often generates code similar to: f(<<0:1,...>>) -> ...; f(<<1:1,...>>) -> .... Internally that will be rewritten to (conceptually): f(<>) -> case B of 0 -> case Tail of ... end; 1 -> case Tail of ... end; _ -> error(case_clause) end. Since B comes from a bit field of one bit, we know that the only possible values are 0 and 1. Therefore the error clause can be eliminated like this: f(<>) -> case B of 0 -> case Tail of ... end; _ -> case Tail of ... end end. Similarly, we can also a deduce the range for an integer from a 'band' operation with a literal integer. While we are at it, also add a test case to improve the coverage. --- lib/compiler/src/beam_type.erl | 121 ++++++++++++++++++++++++++++++---- lib/compiler/test/Makefile | 2 + lib/compiler/test/beam_type_SUITE.erl | 87 ++++++++++++++++++++++++ lib/compiler/test/bs_match_SUITE.erl | 18 ++++- 4 files changed, 215 insertions(+), 13 deletions(-) create mode 100644 lib/compiler/test/beam_type_SUITE.erl diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index bb91bbcc0a..17ce7082f6 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -23,7 +23,8 @@ -export([module/2]). --import(lists, [foldl/3,reverse/1,filter/2]). +-import(lists, [filter/2,foldl/3,keyfind/3,member/2, + reverse/1,reverse/2,sort/1]). module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> Fs = [function(F) || F <- Fs0], @@ -94,6 +95,12 @@ simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) - end; simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) -> simplify_basic_1(Is, tdb_new(), [I|Acc]); +simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> + case tdb_find(R, Ts) of + integer -> simplify_basic_1(Is, Ts, Acc); + {integer,_} -> simplify_basic_1(Is, Ts, Acc); + _ -> simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc); @@ -137,6 +144,14 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) -> + I = case tdb_find(Reg, Ts) of + {integer,Range} -> + simplify_select_val_int(I0, Range); + _ -> + I0 + end, + simplify_basic_1(Is, tdb_new(), [I|Acc]); simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); @@ -144,6 +159,23 @@ simplify_basic_1([], Ts, Acc) -> Is = reverse(Acc), {Is,Ts}. +simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> + Vs = sort([V || {integer,V} <- L0]), + case eq_ranges(Vs, Min, Max) of + false -> I; + true -> simplify_select_val_1(L0, {integer,Max}, R, []) + end. + +simplify_select_val_1([Val,F|T], Val, R, Acc) -> + L = reverse(Acc, T), + {select,select_val,R,F,L}; +simplify_select_val_1([V,F|T], Val, R, Acc) -> + simplify_select_val_1(T, Val, R, [F,V|Acc]). + +eq_ranges([H], H, H) -> true; +eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); +eq_ranges(_, _, _) -> false. + %% simplify_float([Instruction], TypeDatabase) -> %% {[Instruction],TypeDatabase'} | not_possible %% Simplify floating point operations in blocks. @@ -390,6 +422,13 @@ update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> true -> tdb_update([{D,float}], Ts0); false -> Ts0 end; +update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) -> + case keyfind(integer, 1, [S1,S2]) of + {integer,N} -> + update_band(N, D, Ts); + false -> + tdb_update([{D,integer}], Ts) + end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) -> %% Make sure we reject non-numeric literals. case possibly_numeric(S1) andalso possibly_numeric(S2) of @@ -397,15 +436,17 @@ update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) -> false -> Ts0 end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) -> - case arith_op(Op) of - no -> - tdb_update([{D,kill}], Ts0); - {yes,_} -> + case op_type(Op) of + integer -> + tdb_update([{D,integer}], Ts0); + {float,_} -> case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of {float,_} -> tdb_update([{D,float}], Ts0); {_,float} -> tdb_update([{D,float}], Ts0); {_,_} -> tdb_update([{D,kill}], Ts0) - end + end; + unknown -> + tdb_update([{D,kill}], Ts0) end; update({set,[],_Src,_Op}, Ts0) -> Ts0; update({set,[D],_Src,_Op}, Ts0) -> @@ -437,6 +478,8 @@ update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts); update({test,_Test,_Fail,_Other}, Ts) -> Ts; +update({test,bs_get_integer2,_,_,Args,Dst}, Ts) -> + tdb_update([{Dst,get_bs_integer_type(Args)}], Ts); update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> case is_math_bif(Math, Ar) of true -> tdb_update([{{x,0},float}], Ts); @@ -453,10 +496,43 @@ update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); update({line,_}, Ts) -> Ts; +update({bs_save2,_,_}, Ts) -> Ts; +update({bs_restore2,_,_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). +update_band(N, Reg, Ts) -> + Type = update_band_1(N, 0), + tdb_update([{Reg,Type}], Ts). + +update_band_1(N, Bits) when Bits < 64 -> + case 1 bsl Bits of + P when P =:= N + 1 -> + {integer,{0,N}}; + P when P > N + 1 -> + integer; + _ -> + update_band_1(N, Bits+1) + end; +update_band_1(_, _) -> + %% Negative or large positive number. Give up. + integer. + +get_bs_integer_type([_,{integer,N},U,{field_flags,Fl}]) + when N*U < 64 -> + NumBits = N*U, + case member(unsigned, Fl) of + true -> + {integer,{0,(1 bsl NumBits)-1}}; + false -> + %% Signed integer. Don't bother. + integer + end; +get_bs_integer_type(_) -> + %% Avoid creating ranges with a huge upper limit. + integer. + is_math_bif(cos, 1) -> true; is_math_bif(cosh, 1) -> true; is_math_bif(sin, 1) -> true; @@ -545,11 +621,22 @@ load_reg(V, Ts, Rs0, Is0) -> {Rs,Is} end. -arith_op('+') -> {yes,fadd}; -arith_op('-') -> {yes,fsub}; -arith_op('*') -> {yes,fmul}; -arith_op('/') -> {yes,fdiv}; -arith_op(_) -> no. +arith_op(Op) -> + case op_type(Op) of + {float,Instr} -> {yes,Instr}; + _ -> no + end. + +op_type('+') -> {float,fadd}; +op_type('-') -> {float,fsub}; +op_type('*') -> {float,fmul}; +%% '/' and 'band' are specially handled. +op_type('bor') -> integer; +op_type('bxor') -> integer; +op_type('bsl') -> integer; +op_type('bsr') -> integer; +op_type('div') -> integer; +op_type(_) -> unknown. flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> Acc = flush_all(Rs, Is0, Acc0), @@ -639,6 +726,9 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% of the first element). %%% %%% 'float' means that the register contains a float. +%%% +%%% 'integer' or {integer,{Min,Max}} that the register contains an +%%% integer. %% tdb_new() -> EmptyDataBase %% Creates a new, empty type database. @@ -728,10 +818,19 @@ merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> merge_type_info({tuple,Sz1,First}, Tuple2); merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> merge_type_info(Tuple1, {tuple,Sz2,First}); +merge_type_info(integer, {integer,_}=Int) -> + Int; +merge_type_info({integer,_}=Int, integer) -> + Int; +merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> + {integer,{max(Min1, Min2),min(Max1, Max2)}}; merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(integer) -> ok; +verify_type({integer,{Min,Max}}) + when is_integer(Min), is_integer(Max) -> ok; verify_type(map) -> ok; verify_type(nonempty_list) -> ok; verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 6553d10077..0cd8618730 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -11,6 +11,7 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_type_SUITE \ beam_utils_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ @@ -43,6 +44,7 @@ NO_OPT= \ andor \ apply \ beam_except \ + beam_type \ beam_utils \ bs_construct \ bs_match \ diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl new file mode 100644 index 0000000000..8d99d76180 --- /dev/null +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_type_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + integers/1,coverage/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [integers, + coverage + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +integers(_Config) -> + a = do_integers_1(2#11000), + b = do_integers_1(2#11001), + + a = do_integers_2(<<0:1>>), + {'EXIT',{{case_clause,-1},_}} = (catch do_integers_2(<<1:1>>)), + + ok. + +do_integers_1(B0) -> + B = B0 band 1, + case B band 15 of + 0 -> a; + 1 -> b + end. + +do_integers_2(Bin) -> + <> = Bin, + case B of + 0 -> a; + 1 -> b + end. + +coverage(_Config) -> + {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), + {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), + {'EXIT',{badarith,_}} = (catch a + 0.5), + {'EXIT',{badarith,_}} = (catch 2.0 * b), + + {'EXIT',{badarith,_}} = (catch id(42.0) / (1 bsl 2000)), + + id(id(42) band 387439739874298734983787934283479243879), + id(-1 band id(13)), + + ok. + +id(I) -> + I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 6e138b0a43..a19b152bc5 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -36,7 +36,7 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, no_partition/1,calling_a_binary/1,binary_in_map/1, - match_string_opt/1]). + match_string_opt/1,select_on_integer/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -62,7 +62,7 @@ groups() -> otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, no_partition,calling_a_binary,binary_in_map, - match_string_opt]}]. + match_string_opt,select_on_integer]}]. init_per_suite(Config) -> @@ -1225,6 +1225,20 @@ match_string_opt(Config) when is_list(Config) -> do_match_string_opt({<<1>>,{v,V}}=T) -> {x,V,T}. +select_on_integer(Config) when is_list(Config) -> + 42 = do_select_on_integer(<<42>>), + <<"abc">> = do_select_on_integer(<<128,"abc">>), + + {'EXIT',_} = (catch do_select_on_integer(<<0:1>>)), + {'EXIT',_} = (catch do_select_on_integer(<<1:1>>)), + {'EXIT',_} = (catch do_select_on_integer(<<0:1,0:15>>)), + ok. + +%% The ASN.1 compiler frequently generates code like this. +do_select_on_integer(<<0:1,I:7>>) -> + I; +do_select_on_integer(<<1:1,_:7,Bin/binary>>) -> + Bin. check(F, R) -> R = F(). -- cgit v1.2.3 From b66193afc3fe85072da4631c52c5ccec136caa05 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 23 Sep 2015 12:30:16 +0200 Subject: beam_type: Improve optimizations by keeping track of booleans There is an optimization in beam_block to simplify a select_val on a known boolean value. We can implement this optimization in a cleaner way in beam_type and it will also be applicable in more situations. (When I added the optimization to beam_type without removing the optimization from beam_block, the optimization was applied 66 times.) --- lib/compiler/src/beam_block.erl | 34 ---------------------------------- lib/compiler/src/beam_type.erl | 28 ++++++++++++++++++++++++++++ lib/compiler/test/beam_type_SUITE.erl | 15 +++++++++++++-- 3 files changed, 41 insertions(+), 36 deletions(-) diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 741fdbb973..10dbaf462c 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -58,33 +58,6 @@ blockify(Is) -> blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> %% Useless instruction sequence. blockify(Is, Acc); -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select,select_val,Reg,{f,Fail}, - [{atom,false},{f,_}=BrFalse, - {atom,true}=AtomTrue,{f,_}=BrTrue]}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - %% The last instruction is a boolean operator/guard BIF that can't fail. - %% We can convert the three-way branch to a two-way branch (eliminating - %% the reference to the failure label). - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select,select_val,Reg,{f,Fail}, - [{atom,true}=AtomTrue,{f,_}=BrTrue, - {atom,false},{f,_}=BrFalse]}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; blockify([I|Is0]=IsAll, Acc) -> case collect(I) of error -> blockify(Is0, [I|Acc]); @@ -94,13 +67,6 @@ blockify([I|Is0]=IsAll, Acc) -> end; blockify([], Acc) -> reverse(Acc). -is_last_bool([{set,[Reg],As,{bif,N,_}}], Reg) -> - Ar = length(As), - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) - orelse erl_internal:bool_op(N, Ar); -is_last_bool([_|Is], Reg) -> is_last_bool(Is, Reg); -is_last_bool([], _) -> false. - collect_block(Is) -> collect_block(Is, []). diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 17ce7082f6..4b45c28623 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -95,6 +95,11 @@ simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) - end; simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) -> simplify_basic_1(Is, tdb_new(), [I|Acc]); +simplify_basic_1([{test,is_atom,_,[R]}=I|Is], Ts, Acc) -> + case tdb_find(R, Ts) of + boolean -> simplify_basic_1(Is, Ts, Acc); + _ -> simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of integer -> simplify_basic_1(Is, Ts, Acc); @@ -148,6 +153,8 @@ simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) -> I = case tdb_find(Reg, Ts) of {integer,Range} -> simplify_select_val_int(I0, Range); + boolean -> + simplify_select_val_bool(I0); _ -> I0 end, @@ -166,6 +173,15 @@ simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> true -> simplify_select_val_1(L0, {integer,Max}, R, []) end. +simplify_select_val_bool({select,select_val,R,_,L}=I) -> + Vs = sort([V || {atom,V} <- L]), + case Vs of + [false,true] -> + simplify_select_val_1(L, {atom,false}, R, []); + _ -> + I + end. + simplify_select_val_1([Val,F|T], Val, R, Acc) -> L = reverse(Acc, T), {select,select_val,R,F,L}; @@ -414,6 +430,17 @@ update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); +update({set,[D],Args,{bif,N,_}}, Ts0) -> + Ar = length(Args), + BoolOp = erl_internal:new_type_test(N, Ar) orelse + erl_internal:comp_op(N, Ar) orelse + erl_internal:bool_op(N, Ar), + case BoolOp of + true -> + tdb_update([{D,boolean}], Ts0); + false -> + tdb_update([{D,kill}], Ts0) + end; update({set,[D],[S],{get_tuple_element,0}}, Ts) -> tdb_update([{D,{tuple_element,S,0}}], Ts); update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> @@ -828,6 +855,7 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(boolean) -> ok; verify_type(integer) -> ok; verify_type({integer,{Min,Max}}) when is_integer(Min), is_integer(Max) -> ok; diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 8d99d76180..8d5c0190ed 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_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, - integers/1,coverage/1]). + integers/1,coverage/1,booleans/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -32,7 +32,8 @@ all() -> groups() -> [{p,[parallel], [integers, - coverage + coverage, + booleans ]}]. init_per_suite(Config) -> @@ -83,5 +84,15 @@ coverage(_Config) -> ok. +booleans(_Config) -> + {'EXIT',{{case_clause,_},_}} = (catch do_booleans(42)), + ok. + +do_booleans(B) -> + case is_integer(B) of + yes -> yes; + no -> no + end. + id(I) -> I. -- cgit v1.2.3 From 464ca2f8049feec6453d2d9a327f996662978e51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 25 Sep 2015 07:06:38 +0200 Subject: Move select_val optimization from beam_clean to beam_peep There is an optimization in beam_clean that will remove values having the same label as the failure label in a select_val instruction. Conceptually, this optimization is in the wrong module since ideally beam_clean is a mandatory pass that should not do optimizations. Furthermore, this part of beam_clean is called three times (from beam_dead, beam_peep, and as a compiler pass from the 'compile' module), but it only does useful one of the times it is called. Therefore, move this optimization to the beam_peep pass. The same optimization is done in beam_dead, but unfortunately it misses some opportunities for optimization because the code sharing optimization in beam_jump (share/1) runs after beam_dead. It would be more satisfactory to have this optimization only in beam_dead, but it turned out not to be trivial. If we try to run beam_jump:share/1 before beam_dead, some optimizations will no longer work in beam_dead because fallthroughs have been eliminated. For the moment, the possible solutions to this problem seems to involve more work and more complicated code than the gain from eliminating the duplicated optimization would gain. --- lib/compiler/src/beam_clean.erl | 20 ++++---------------- lib/compiler/src/beam_peep.erl | 16 ++++++++++++++++ 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 7d66985791..d9108c383d 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -190,17 +190,11 @@ replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D); replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) -> - Vls1 = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other end, Vls0), + Vls = map(fun ({f,L}) -> {f,label(L, D)}; + (Other) -> Other + end, Vls0), Fail = label(Fail0, D), - case redundant_values(Vls1, Fail, []) of - [] -> - %% Oops, no choices left. The loader will not accept that. - %% Convert to a plain jump. - replace(Is, [{jump,{f,Fail}}|Acc], D); - Vls -> - replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D) - end; + replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D); replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> @@ -241,12 +235,6 @@ label(Old, D) -> {value,Val} -> Val; none -> throw({error,{undefined_label,Old}}) end. - -redundant_values([_,{f,Fail}|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, Acc); -redundant_values([Val,Lbl|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, [Lbl,Val|Acc]); -redundant_values([], _, Acc) -> reverse(Acc). %%% %%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 75be86b83f..0c1abfe6a0 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -83,6 +83,16 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), peep(Is, SeenTests, [I|Acc]); +peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> + case prune_redundant_values(Vls0, F) of + [] -> + %% No values left. Must convert to plain jump. + I = {jump,F}, + peep(Is, gb_sets:empty(), [I|Acc]); + [_|_]=Vls -> + I = {select,Op,R,F,Vls}, + peep(Is, gb_sets:empty(), [I|Acc]) + end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of false -> @@ -127,3 +137,9 @@ kill_seen_1([{_,Ops}=Test|T], Dst) -> false -> [Test|kill_seen_1(T, Dst)] end; kill_seen_1([], _) -> []. + +prune_redundant_values([_Val,F|Vls], F) -> + prune_redundant_values(Vls, F); +prune_redundant_values([Val,Lbl|Vls], F) -> + [Val,Lbl|prune_redundant_values(Vls, F)]; +prune_redundant_values([], _) -> []. -- cgit v1.2.3 From 0540e422498a2b3f362025c7a4afa4a8269554d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 28 Sep 2015 11:45:30 +0200 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11480 -> 11456 bytes bootstrap/lib/compiler/ebin/beam_block.beam | Bin 16064 -> 9564 bytes bootstrap/lib/compiler/ebin/beam_bs.beam | Bin 0 -> 5928 bytes bootstrap/lib/compiler/ebin/beam_clean.beam | Bin 9272 -> 8948 bytes bootstrap/lib/compiler/ebin/beam_dead.beam | Bin 12444 -> 12972 bytes bootstrap/lib/compiler/ebin/beam_disasm.beam | Bin 26220 -> 26216 bytes bootstrap/lib/compiler/ebin/beam_peep.beam | Bin 2144 -> 2424 bytes bootstrap/lib/compiler/ebin/beam_type.beam | Bin 14632 -> 17148 bytes bootstrap/lib/compiler/ebin/beam_utils.beam | Bin 13784 -> 13756 bytes bootstrap/lib/compiler/ebin/cerl_inline.beam | Bin 38760 -> 38716 bytes bootstrap/lib/compiler/ebin/compile.beam | Bin 38968 -> 38984 bytes bootstrap/lib/compiler/ebin/compiler.app | 3 ++- bootstrap/lib/compiler/ebin/compiler.appup | 2 +- bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 49672 -> 49728 bytes bootstrap/lib/compiler/ebin/v3_codegen.beam | Bin 56344 -> 56164 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 28708 -> 28688 bytes bootstrap/lib/kernel/ebin/disk_log_1.beam | Bin 24660 -> 24640 bytes bootstrap/lib/kernel/ebin/dist_util.beam | Bin 10368 -> 10352 bytes bootstrap/lib/kernel/ebin/file_io_server.beam | Bin 15212 -> 15184 bytes bootstrap/lib/kernel/ebin/global.beam | Bin 32504 -> 32460 bytes bootstrap/lib/kernel/ebin/inet_dns.beam | Bin 19672 -> 19612 bytes bootstrap/lib/kernel/ebin/inet_gethost_native.beam | Bin 10448 -> 10436 bytes bootstrap/lib/kernel/ebin/inet_res.beam | Bin 14872 -> 14868 bytes bootstrap/lib/kernel/ebin/net_adm.beam | Bin 3012 -> 3008 bytes bootstrap/lib/kernel/ebin/rpc.beam | Bin 8580 -> 8580 bytes bootstrap/lib/stdlib/ebin/base64.beam | Bin 4544 -> 4540 bytes bootstrap/lib/stdlib/ebin/dets_v9.beam | Bin 49808 -> 49804 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 28016 -> 28004 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89280 -> 89268 bytes bootstrap/lib/stdlib/ebin/erl_scan.beam | Bin 28932 -> 28844 bytes bootstrap/lib/stdlib/ebin/filename.beam | Bin 12500 -> 12444 bytes bootstrap/lib/stdlib/ebin/gen.beam | Bin 4276 -> 4276 bytes bootstrap/lib/stdlib/ebin/gen_server.beam | Bin 19508 -> 19508 bytes bootstrap/lib/stdlib/ebin/io_lib.beam | Bin 9988 -> 9984 bytes bootstrap/lib/stdlib/ebin/io_lib_format.beam | Bin 13372 -> 13348 bytes bootstrap/lib/stdlib/ebin/io_lib_pretty.beam | Bin 15212 -> 15156 bytes bootstrap/lib/stdlib/ebin/re.beam | Bin 13632 -> 13600 bytes bootstrap/lib/stdlib/ebin/sofs.beam | Bin 40696 -> 40656 bytes bootstrap/lib/stdlib/ebin/unicode.beam | Bin 11584 -> 11552 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 26572 -> 26568 bytes 40 files changed, 3 insertions(+), 2 deletions(-) create mode 100644 bootstrap/lib/compiler/ebin/beam_bs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index 90808bd195..3656edb0a0 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam index c862a391b6..2854b91bae 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_block.beam and b/bootstrap/lib/compiler/ebin/beam_block.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam new file mode 100644 index 0000000000..0823cb2dd7 Binary files /dev/null and b/bootstrap/lib/compiler/ebin/beam_bs.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam index 52e6a797d4..0f24e040e3 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_clean.beam and b/bootstrap/lib/compiler/ebin/beam_clean.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam index 8e3df16335..10926614e6 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dead.beam and b/bootstrap/lib/compiler/ebin/beam_dead.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index 932da83c77..5c2308ef9d 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam index c08f6254ec..334047bbf6 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_peep.beam and b/bootstrap/lib/compiler/ebin/beam_peep.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam index 4c766059ac..35bc046ef8 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_type.beam and b/bootstrap/lib/compiler/ebin/beam_type.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam index 813b9dc576..a97fc853a7 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_utils.beam and b/bootstrap/lib/compiler/ebin/beam_utils.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam index 75a3bdf771..cc90a53ef9 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_inline.beam and b/bootstrap/lib/compiler/ebin/cerl_inline.beam differ diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam index 562eae315a..8f60633c81 100644 Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index e41604f261..d31b449f72 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,12 +19,13 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "6.0"}, + {vsn, "6.0.1"}, {modules, [ beam_a, beam_asm, beam_block, beam_bool, + beam_bs, beam_bsm, beam_clean, beam_dead, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 889b72bd6b..1ff223434a 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"5.0.4", +{"6.0.1", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam index fd67612ed5..809de44217 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam index 5f5b8b9213..aa4b5f9585 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_codegen.beam and b/bootstrap/lib/compiler/ebin/v3_codegen.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index b51e120974..22ae0e7ce6 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam index c4a071afd6..9111e3c69c 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log_1.beam and b/bootstrap/lib/kernel/ebin/disk_log_1.beam differ diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam index 14bc5aeaeb..521bdb5d91 100644 Binary files a/bootstrap/lib/kernel/ebin/dist_util.beam and b/bootstrap/lib/kernel/ebin/dist_util.beam differ diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam index ac176f5aab..f29483ef36 100644 Binary files a/bootstrap/lib/kernel/ebin/file_io_server.beam and b/bootstrap/lib/kernel/ebin/file_io_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam index 893b1bf0fe..52711457ff 100644 Binary files a/bootstrap/lib/kernel/ebin/global.beam and b/bootstrap/lib/kernel/ebin/global.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam index 415c436dc2..15b48fffdb 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_dns.beam and b/bootstrap/lib/kernel/ebin/inet_dns.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam index f87b79e2ff..93f60428a1 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam and b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam index b89b54e0bc..ada7300673 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_res.beam and b/bootstrap/lib/kernel/ebin/inet_res.beam differ diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam index 50dbfcf541..00772b61ff 100644 Binary files a/bootstrap/lib/kernel/ebin/net_adm.beam and b/bootstrap/lib/kernel/ebin/net_adm.beam differ diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam index 11c41fdc05..4d1cbdb625 100644 Binary files a/bootstrap/lib/kernel/ebin/rpc.beam and b/bootstrap/lib/kernel/ebin/rpc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam index 9ea98fb928..ad725f61b9 100644 Binary files a/bootstrap/lib/stdlib/ebin/base64.beam and b/bootstrap/lib/stdlib/ebin/base64.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam index 2b68042bf1..46f8d2c6a5 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v9.beam and b/bootstrap/lib/stdlib/ebin/dets_v9.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index c144ae0f21..6a585f8a08 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 18e9ecf412..8c07c78369 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam index 73ded63f14..6c35d20c46 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_scan.beam and b/bootstrap/lib/stdlib/ebin/erl_scan.beam differ diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam index 7df2d414f4..f1252b1e7e 100644 Binary files a/bootstrap/lib/stdlib/ebin/filename.beam and b/bootstrap/lib/stdlib/ebin/filename.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam index 260e33f30e..586973a973 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen.beam and b/bootstrap/lib/stdlib/ebin/gen.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam index 6b1a335e48..d40b5808f3 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_server.beam and b/bootstrap/lib/stdlib/ebin/gen_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam index 5797180d1e..c52bf42077 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib.beam and b/bootstrap/lib/stdlib/ebin/io_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam index baff44c53b..3fdf08d9e4 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_format.beam and b/bootstrap/lib/stdlib/ebin/io_lib_format.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam index 7a5ec3d7f5..9d37b74ad3 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam and b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam differ diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam index 2aff2bfcfa..7b2e736a21 100644 Binary files a/bootstrap/lib/stdlib/ebin/re.beam and b/bootstrap/lib/stdlib/ebin/re.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam index 8de0d8435e..7cc095b953 100644 Binary files a/bootstrap/lib/stdlib/ebin/sofs.beam and b/bootstrap/lib/stdlib/ebin/sofs.beam differ diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam index 3544510884..e34f8a35cf 100644 Binary files a/bootstrap/lib/stdlib/ebin/unicode.beam and b/bootstrap/lib/stdlib/ebin/unicode.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index 35b6dbbd1f..943fce47e0 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ -- cgit v1.2.3 From 76bb9f0e9a0b36ea7c9720c2bf90f6b52a4eabf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 5 Oct 2015 06:43:12 +0200 Subject: beam_reorder: Eliminate compiler crash c288ab87 added beam_reorder to move get_tuple_element instructions. Compiling code such as the following would crash the compiler: alloc(_U1, _U2, R) -> V = R#alloc.version, Res = id(V), _ = id(0), Res. The crash would occur because the following two instructions: {get_tuple_element,{x,2},1,{x,1}}. {allocate_zero,1,2}. were swapped and rewritten to: {allocate_zero,1,1}. {get_tuple_element,{x,2},1,{x,1}}. That transformation is not safe because the allocate_zero instruction would kill {x,2}, which is the register that is holding the reference to the tuple. Only do the transformation when the tuple reference is in an x register with a lower number than the destination register. --- lib/compiler/src/beam_reorder.erl | 21 ++++++---- lib/compiler/test/Makefile | 2 + lib/compiler/test/beam_reorder_SUITE.erl | 69 ++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+), 8 deletions(-) create mode 100644 lib/compiler/test/beam_reorder_SUITE.erl diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 70adca6b04..41586a7bf2 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -110,14 +110,19 @@ reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, end end end; -reorder_1([{allocate_zero,N,Live}|Is], D, - [{get_tuple_element,_,_,{x,X}}=G|Acc]) - when X+1 =:= Live -> - %% Move allocation instruction upwards past get_tuple_element - %% instructions to give more opportunities for moving - %% get_tuple_element instructions. - I = {allocate_zero,N,X}, - reorder_1([I,G|Is], D, Acc); +reorder_1([{allocate_zero,N,Live}=I0|Is], D, + [{get_tuple_element,{x,Tup},_,{x,Dst}}=G|Acc]=Acc0) -> + case Tup < Dst andalso Dst+1 =:= Live of + true -> + %% Move allocation instruction upwards past + %% get_tuple_element instructions to create more + %% opportunities for moving get_tuple_element + %% instructions. + I = {allocate_zero,N,Dst}, + reorder_1([I,G|Is], D, Acc); + false -> + reorder_1(Is, D, [I0|Acc0]) + end; reorder_1([I|Is], D, Acc) -> reorder_1(Is, D, [I|Acc]); reorder_1([], _, Acc) -> reverse(Acc). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 0cd8618730..400565100f 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -11,6 +11,7 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_reorder_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ bs_bincomp_SUITE \ @@ -44,6 +45,7 @@ NO_OPT= \ andor \ apply \ beam_except \ + beam_reorder \ beam_type \ beam_utils \ bs_construct \ diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl new file mode 100644 index 0000000000..4b2262f65b --- /dev/null +++ b/lib/compiler/test/beam_reorder_SUITE.erl @@ -0,0 +1,69 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_reorder_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + alloc/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [alloc + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +-record(alloc, {version}). + +alloc(_Config) -> + {ok,42} = alloc_a(1, 2, #alloc{version=42}), + {a,b,c} = alloc_b(1, 2, #alloc{version={a,b,c}}), + ok. + +alloc_a(_U1, _U2, R) -> + V = R#alloc.version, + Res = id({ok,V}), + _ = id(0), + Res. + +alloc_b(_U1, _U2, R) -> + V = R#alloc.version, + Res = id(V), + _ = id(0), + Res. + +id(I) -> + I. -- cgit v1.2.3 From 5472eb516e969f7f9ac50ab57b195e5b043e1d79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 8 Oct 2015 10:19:56 +0200 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_reorder.beam | Bin 1920 -> 1992 bytes bootstrap/lib/kernel/ebin/inet_dns.beam | Bin 19612 -> 19596 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 23888 -> 23880 bytes 3 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam index d884aa011d..0dc44add6b 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_reorder.beam and b/bootstrap/lib/compiler/ebin/beam_reorder.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam index 15b48fffdb..88ecaaf10b 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_dns.beam and b/bootstrap/lib/kernel/ebin/inet_dns.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index c27ce0b092..ea3cf38ccd 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ -- cgit v1.2.3 From 6e93fb788aebb9050da2166749b41ff54197e049 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Thu, 7 May 2015 14:43:02 +0200 Subject: Take out automatic insertion of 'undefined' from typed record fields Background ----------- In record fields with a type declaration but without an initializer, the Erlang parser inserted automatically the singleton type 'undefined' to the list of declared types, if that value was not present there. I.e. the record declaration: -record(rec, {f1 :: float(), f2 = 42 :: integer(), f3 :: some_mod:some_typ()}). was translated by the parser to: -record(rec, {f1 :: float() | 'undefined', f2 = 42 :: integer(), f3 :: some_mod:some_typ() | 'undefined'}). The rationale for this was that creation of a "dummy" #rec{} record should not result in a warning from dialyzer that e.g. the implicit initialization of the #rec.f1 field violates its type declaration. Problems --------- This seemingly innocent action has some unforeseen consequences. For starters, there is no way for programmers to declare that e.g. only floats make sense for the f1 field of #rec{} records when there is no `obvious' default initializer for this field. (This also affects tools like PropEr that use these declarations produced by the Erlang parser to generate random instances of records for testing purposes.) It also means that dialyzer does not warn if e.g. an is_atom/1 test or something more exotic like an atom_to_list/1 call is performed on the value of the f1 field. Similarly, there is no way to extend dialyzer to warn if it finds record constructions where f1 is not initialized to some float. Last but not least, it is semantically problematic when the type of the field is an opaque type: creating a union of an opaque and a structured type is very problematic for analysis because it fundamentally breaks the opacity of the term at that point. Change ------- To solve these problems the parser will not automatically insert the 'undefined' value anymore; instead the user has the option to choose the places where this value makes sense (for the field) and where it does not and insert the | 'undefined' there manually. Consequences of this change ---------------------------- This change means that dialyzer will issue a warning for all places where records with uninitialized fields are created and those fields have a declared type that is incompatible with 'undefined' (e.g. float()). This warning can be suppressed easily by adding | 'undefined' to the type of this field. This also adds documentation that the user really intends to create records where this field is uninitialized. --- erts/doc/src/absform.xml | 6 ----- .../results/callbacks_and_specs | 6 ++--- lib/dialyzer/test/opaque_SUITE_data/results/crash | 10 ++++---- lib/dialyzer/test/opaque_SUITE_data/results/simple | 2 +- lib/dialyzer/test/r9c_SUITE_data/results/inets | 2 ++ .../test/small_SUITE_data/results/literals | 12 ++++----- .../small_SUITE_data/results/record_creation_diffs | 2 +- .../test/small_SUITE_data/results/record_pat | 2 +- .../results/relevant_record_warning | 2 +- .../test/small_SUITE_data/results/undefined | 2 ++ lib/dialyzer/test/small_SUITE_data/src/trec.erl | 2 +- lib/dialyzer/test/small_SUITE_data/undefined.erl | 29 ++++++++++++++++++++++ lib/hipe/cerl/erl_types.erl | 13 +++++----- lib/stdlib/src/erl_parse.yrl | 22 +--------------- lib/stdlib/test/erl_pp_SUITE.erl | 6 +++-- 15 files changed, 63 insertions(+), 55 deletions(-) create mode 100644 lib/dialyzer/test/small_SUITE_data/results/undefined create mode 100644 lib/dialyzer/test/small_SUITE_data/undefined.erl diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index df2553ced3..49fe784d06 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -246,12 +246,6 @@ Rep(V) = . If V is , then Rep(V) = . - If V is , where is - an atom and is a type and it does not contain - syntactically, then Rep(V) = - . - Note that if is an annotated type, it will be wrapped in - parentheses. If V is , where is an atom and is a type, then Rep(V) = . diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs index 33d135048e..38999e8919 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs @@ -1,5 +1,5 @@ -my_callbacks_wrong.erl:26: The return type #state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour -my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::'undefined' | pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour -my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:26: The return type #state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 (atom()) is not a supertype of pid(), which is expected type for this argument in the callback of the my_behaviour behaviour diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 69bdc00257..d63389f79c 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,6 +1,6 @@ -crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() -crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list()) -crash_1.erl:50: The pattern <_Branch, []> can never match the type -crash_1.erl:52: The pattern can never match the type -crash_1.erl:54: The pattern can never match the type +crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::crash_1:target() +crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list()) +crash_1.erl:50: The pattern <_Branch, []> can never match the type +crash_1.erl:52: The pattern can never match the type +crash_1.erl:54: The pattern can never match the type diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 1a7a139d6e..5f58f69730 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -18,7 +18,7 @@ rec_api.erl:104: Matching of pattern {'r2', 10} tagged with a record name violat rec_api.erl:113: The attempt to match a term of type #r3{f1::queue:queue(_)} against the pattern {'r3', 'a'} breaks the opaqueness of queue:queue(_) rec_api.erl:118: Record construction #r3{f1::10} violates the declared type of field f1::queue:queue(_) rec_api.erl:123: The attempt to match a term of type #r3{f1::10} against the pattern {'r3', 10} breaks the opaqueness of queue:queue(_) -rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::'undefined' | rec_api:a() +rec_api.erl:24: Record construction #r1{f1::10} violates the declared type of field f1::rec_api:a() rec_api.erl:29: Matching of pattern {'r1', 10} tagged with a record name violates the declared type of #r1{f1::10} rec_api.erl:33: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opaqueness of the term rec_api.erl:35: Invalid type specification for function rec_api:adt_t1/1. The success typing is (#r1{f1::'a'}) -> #r1{f1::'a'} diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index d377f34978..89be9652e3 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -37,6 +37,7 @@ mod_cgi.erl:372: The pattern {'http_response', NewAccResponse} can never match t mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) mod_dir.erl:72: The pattern {'error', Reason} can never match the type {'ok',[[[any()] | char()],...]} mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type +mod_get.erl:150: Record construction #file_info{} violates the declared type of field size::non_neg_integer() and type::'device' | 'directory' | 'other' | 'regular' | 'symlink' and access::'none' | 'read' | 'read_write' | 'write' and atime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mtime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and ctime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mode::non_neg_integer() and links::non_neg_integer() and major_device::non_neg_integer() and minor_device::non_neg_integer() and inode::non_neg_integer() and uid::non_neg_integer() and gid::non_neg_integer() mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type mod_htaccess.erl:460: The pattern {'error', BadData} can never match the type {'ok',_} mod_include.erl:193: The pattern {_, Name, {[], []}} can never match the type {[any()],[any()],maybe_improper_list()} @@ -47,6 +48,7 @@ mod_include.erl:692: The pattern <{'read', Reason}, Info, Path> can never match mod_include.erl:706: The pattern <{'enfile', _}, _Info, Path> can never match the type mod_include.erl:716: Function read_error/3 will never be called mod_include.erl:719: Function read_error/4 will never be called +mod_range.erl:308: Record construction #file_info{} violates the declared type of field size::non_neg_integer() and type::'device' | 'directory' | 'other' | 'regular' | 'symlink' and access::'none' | 'read' | 'read_write' | 'write' and atime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mtime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and ctime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mode::non_neg_integer() and links::non_neg_integer() and major_device::non_neg_integer() and minor_device::non_neg_integer() and inode::non_neg_integer() and uid::non_neg_integer() and gid::non_neg_integer() mod_security_server.erl:386: The variable O can never match since previous clauses completely covered the type [tuple()] mod_security_server.erl:433: The variable Other can never match since previous clauses completely covered the type [tuple()] mod_security_server.erl:585: The variable _ can never match since previous clauses completely covered the type [tuple()] diff --git a/lib/dialyzer/test/small_SUITE_data/results/literals b/lib/dialyzer/test/small_SUITE_data/results/literals index 03e161ca71..222d2c0cdb 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/literals +++ b/lib/dialyzer/test/small_SUITE_data/results/literals @@ -1,14 +1,14 @@ literals.erl:11: Function t1/0 has no local return -literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:12: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:14: Function t2/0 has no local return -literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:17: Function t3/0 has no local return -literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' -literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' | 'undefined' +literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' +literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:23: Function m1/1 has no local return -literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'} +literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:26: Function m2/1 has no local return -literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer' | 'undefined'} +literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:29: Function m3/1 has no local return literals.erl:29: The pattern {{'r', 'a'}} can never match the type any() diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs index f00c4b10ff..c971935bbf 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs +++ b/lib/dialyzer/test/small_SUITE_data/results/record_creation_diffs @@ -1,3 +1,3 @@ record_creation_diffs.erl:10: Function foo/1 has no local return -record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::'undefined' | [any()] +record_creation_diffs.erl:11: Record construction #bar{some_list::{'this','is','a','tuple'}} violates the declared type of field some_list::[any()] diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_pat b/lib/dialyzer/test/small_SUITE_data/results/record_pat index a46be6c451..8317ea041a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/record_pat +++ b/lib/dialyzer/test/small_SUITE_data/results/record_pat @@ -1,2 +1,2 @@ -record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::'undefined' | integer()} +record_pat.erl:14: Matching of pattern {'foo', 'baz'} tagged with a record name violates the declared type of #foo{bar::integer()} diff --git a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning index 2e417e1b2a..ea3ac92d96 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning +++ b/lib/dialyzer/test/small_SUITE_data/results/relevant_record_warning @@ -1,3 +1,3 @@ relevant_record_warning.erl:22: Function test/1 has no local return -relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary' | 'undefined' +relevant_record_warning.erl:23: Record construction #r{field::<<_:8>>} violates the declared type of field field::'binary' diff --git a/lib/dialyzer/test/small_SUITE_data/results/undefined b/lib/dialyzer/test/small_SUITE_data/results/undefined new file mode 100644 index 0000000000..9daa8640d3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/undefined @@ -0,0 +1,2 @@ + +r.erl:16: Record construction #r{a::{'fi'},b::{'a','b'},c::[],d::'undefined',e::[],f::'undefined'} violates the declared type of field b::[any()] and d::[any()] and f::[any()] diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl index 06706162c1..516358f7c6 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl @@ -8,7 +8,7 @@ -module(trec). -export([test/0, mk_foo_exp/2]). --record(foo, {a :: integer(), b :: [atom()]}). +-record(foo, {a :: integer() | 'undefined', b :: [atom()]}). %% %% For these functions we currently get the following warnings: diff --git a/lib/dialyzer/test/small_SUITE_data/undefined.erl b/lib/dialyzer/test/small_SUITE_data/undefined.erl new file mode 100644 index 0000000000..8549f2e161 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/undefined.erl @@ -0,0 +1,29 @@ +-module(undefined). + +-export([t/0]). + +%% As of OTP 19.0 'undefined' is no longer added to fields with a type +%% declaration but without an initializer. The pretty printing of +%% records (erl_types:t_to_string()) is updated to reflect this: if a +%% field is of type 'undefined', it is output if 'undefined' is not in +%% the declared type of the field. (It used to be the case that the +%% singleton type 'undefined' was never output.) +%% +%% One consequence is shown by the example below: the warning about +%% the record construction violating the the declared type shows +%% #r{..., d::'undefined', ...} which is meant to be of help to the +%% user, who could otherwise get confused the first time (s)he gets +%% confronted by the warning. + +-record(r, + { + a = {fi}, + b = {a,b} :: list(), % violation + c = {a,b} :: list(), + d :: list(), % violation + e = [] :: list(), + f = undefined :: list() % violation + }). + +t() -> + #r{c = []}. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cd2d2fe207..420d7e2a8f 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -3974,18 +3974,17 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". -record_fields_to_string([F|Fs], [{FName, _Abstr, _DefType}|FDefs], +record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> NewAcc = - case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of + case + t_is_equal(F, t_any()) orelse + (t_is_any_atom('undefined', F) andalso + not t_is_none(t_inf(F, DefType))) + of true -> Acc; false -> StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict), - %% ActualDefType = t_subtract(DefType, t_atom('undefined')), - %% Str = case t_is_any(ActualDefType) of - %% true -> StrFV; - %% false -> StrFV ++ "::" ++ t_to_string(ActualDefType, RecDict) - %% end, [StrFV|Acc] end, record_fields_to_string(Fs, FDefs, RecDict, NewAcc); diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 206b0c6e7b..ae42a8f0b1 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -790,31 +790,11 @@ record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = - case Expr of - {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, Aa, _} -> - case has_undefined(TypeInfo) of - false -> - lift_unions(abstract2(undefined, Aa), TypeInfo); - true -> - TypeInfo - end - end, - [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; + [{typed_record_field,Field,TypeInfo}|record_fields(Fields)]; record_fields([Other|_Fields]) -> ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. -has_undefined({atom,_,undefined}) -> - true; -has_undefined({ann_type,_,[_,T]}) -> - has_undefined(T); -has_undefined({type,_,union,Ts}) -> - lists:any(fun has_undefined/1, Ts); -has_undefined(_) -> - false. - term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?anno(Expr), "bad attribute") diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 389fd059f6..9bb193d865 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -928,7 +928,9 @@ otp_8522(Config) when is_list(Config) -> ?line {ok, _} = compile:file(FileName, [{outdir,?privdir},debug_info]), BF = filename("otp_8522", Config), ?line {ok, A} = beam_lib:chunks(BF, [abstract_code]), - ?line 5 = count_atom(A, undefined), + %% OTP-12719: Since 'undefined' is no longer added by the Erlang + %% Parser, the number of 'undefined' is 4. It used to be 5. + ?line 4 = count_atom(A, undefined), ok. count_atom(A, A) -> @@ -1062,7 +1064,7 @@ otp_9147(Config) when is_list(Config) -> ?line {ok, Bin} = file:read_file(PFileName), %% The parentheses around "F1 :: a | b" are new (bugfix). ?line true = - lists:member("-record(undef,{f1 :: undefined | (F1 :: a | b)}).", + lists:member("-record(undef,{f1 :: F1 :: a | b}).", string:tokens(binary_to_list(Bin), "\n")), ok. -- cgit v1.2.3 From 3224c9b0b7022ccf2483af95f4efd8a6b6234f47 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 6 Oct 2015 15:08:57 +0200 Subject: Update Kernel and STDLIB Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/kernel/include/file.hrl | 31 ++++++++++--------- lib/kernel/src/disk_log.erl | 68 +++++++++++++++++++---------------------- lib/kernel/src/disk_log.hrl | 6 ++-- lib/kernel/src/global.erl | 20 ++++++------ lib/kernel/src/global_group.erl | 4 +-- lib/stdlib/include/erl_bits.hrl | 10 +++--- lib/stdlib/src/beam_lib.erl | 2 +- lib/stdlib/src/epp.erl | 3 +- lib/stdlib/src/escript.erl | 8 ++--- lib/stdlib/src/supervisor.erl | 10 +++--- 10 files changed, 80 insertions(+), 82 deletions(-) diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl index 7cf033f7f5..36112bb040 100644 --- a/lib/kernel/include/file.hrl +++ b/lib/kernel/include/file.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,37 +23,40 @@ %%-------------------------------------------------------------------------- -record(file_info, - {size :: non_neg_integer(), % Size of file in bytes. - type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink', - access :: 'read' | 'write' | 'read_write' | 'none', - atime :: file:date_time() | non_neg_integer(), + {size :: non_neg_integer() | 'undefined', % Size of file in bytes. + type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink' + | 'undefined', + access :: 'read' | 'write' | 'read_write' | 'none' | 'undefined', + atime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last read: % {{Year, Mon, Day}, {Hour, Min, Sec}}. % atime, ctime, mtime may also be unix epochs() - mtime :: file:date_time() | non_neg_integer(), + mtime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last written. - ctime :: file:date_time() | non_neg_integer(), + ctime :: file:date_time() | non_neg_integer() | 'undefined', % The interpretation of this time field % is dependent on operating system. % On Unix it is the last time the file % or the inode was changed. On Windows, % it is the creation time. - mode :: non_neg_integer(), % File permissions. On Windows, + mode :: non_neg_integer() | 'undefined', + % File permissions. On Windows, % the owner permissions will be % duplicated for group and user. - links :: non_neg_integer(), + links :: non_neg_integer() | 'undefined', % Number of links to the file (1 if the % filesystem doesn't support links). - major_device :: non_neg_integer(), + major_device :: non_neg_integer() | 'undefined', % Identifies the file system (Unix), % or the drive number (A: = 0, B: = 1) % (Windows). %% The following are Unix specific. %% They are set to zero on other operating systems. - minor_device :: non_neg_integer(), % Only valid for devices. - inode :: non_neg_integer(), % Inode number for file. - uid :: non_neg_integer(), % User id for owner. - gid :: non_neg_integer()}). % Group id for owner. + minor_device :: non_neg_integer() | 'undefined', + % Only valid for devices. + inode :: non_neg_integer() | 'undefined', % Inode number for file. + uid :: non_neg_integer() | 'undefined', % User id for owner. + gid :: non_neg_integer() | 'undefined'}). % Group id for owner. -record(file_descriptor, diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index f5450f30af..9b44021872 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1310,13 +1310,20 @@ compare_arg(_Attr, _Val, _A) -> %% -> {ok, Res, log(), Cnt} | Error do_open(A) -> - L = #log{name = A#arg.name, - filename = A#arg.file, - size = A#arg.size, - head = mk_head(A#arg.head, A#arg.format), - mode = A#arg.mode, - version = A#arg.version}, - do_open2(L, A). + #arg{type = Type, format = Format, name = Name, head = Head0, + file = FName, repair = Repair, size = Size, mode = Mode, + version = V} = A, + Head = mk_head(Head0, Format), + case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of + {ok, Ret, Extra, FormatType, NoItems} -> + L = #log{name = Name, type = Type, format = Format, + filename = FName, size = Size, + format_type = FormatType, head = Head, mode = Mode, + version = V, extra = Extra}, + {ok, Ret, L, NoItems}; + Error -> + Error + end. mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)}; mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)}; @@ -1432,57 +1439,44 @@ do_inc_wrap_file(L) -> %%----------------------------------------------------------------- %% -> {ok, Reply, log(), Cnt} | Error %% Note: the header is always written, even if the log size is too small. -do_open2(L, #arg{type = halt, format = internal, name = Name, - file = FName, repair = Repair, size = Size, mode = Mode}) -> - case catch disk_log_1:int_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, internal, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:int_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, L#log{format_type = halt_int, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_int, NoItems}; {repaired, FdC, Rec, Bad, FileSize} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{format_type = halt_int, extra = Halt}, - Rec}; + Halt, halt_int, Rec}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = internal, size = {MaxB, MaxF}, - name = Name, repair = Repair, file = FName, mode = Mode, - version = V}) -> +do_open2(wrap, internal, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_int, - extra = Handle}, Cnt}; + {ok, {ok, Name}, Handle, wrap_int, Cnt}; {repaired, Handle, Rec, Bad, Cnt} -> {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{type = wrap, format_type = wrap_int, extra = Handle}, Cnt}; + Handle, wrap_int, Cnt}; Error -> Error end; -do_open2(L, #arg{type = halt, format = external, file = FName, name = Name, - size = Size, repair = Repair, mode = Mode}) -> - case catch disk_log_1:ext_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, external, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:ext_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, - L#log{format_type = halt_ext, format = external, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_ext, NoItems}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = external, size = {MaxB, MaxF}, - name = Name, file = FName, repair = Repair, mode = Mode, - version = V}) -> +do_open2(wrap, external, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_ext, - extra = Handle, - format = external}, Cnt}; + {ok, {ok, Name}, Handle, wrap_ext, Cnt}; Error -> Error end. diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index 6c0aea070f..3262d979ee 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -152,8 +152,8 @@ users = 0 :: non_neg_integer(), %% non-linked users filename :: file:filename(), %% real name of the file owners = [] :: [{pid(), boolean()}],%% [{pid, notify}] - type = halt :: dlog_type(), - format = internal :: dlog_format(), + type :: dlog_type(), + format :: dlog_format(), format_type :: dlog_format_type(), head = none, %% none | {head, H} | {M,F,A} %% called when wraplog wraps diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 2be1efaf24..dcabeb5e49 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -459,17 +459,17 @@ init([]) -> no_trace end, + Ca = case init:get_argument(connect_all) of + {ok, [["false"]]} -> + false; + _ -> + true + end, S = #state{the_locker = start_the_locker(DoTrace), trace = T0, - the_registrar = start_the_registrar()}, - S1 = trace_message(S, {init, node()}, []), - - case init:get_argument(connect_all) of - {ok, [["false"]]} -> - {ok, S1#state{connect_all = false}}; - _ -> - {ok, S1#state{connect_all = true}} - end. + the_registrar = start_the_registrar(), + connect_all = Ca}, + {ok, trace_message(S, {init, node()}, [])}. %%----------------------------------------------------------------- %% Connection algorithm diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 848df13c39..e71f83f9d3 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -273,7 +273,7 @@ init([]) -> {ok, #state{publish_type = PT, group_publish_type = PubTpGrp, sync_state = synced, group_name = DefGroupName, no_contact = lists:sort(DefNodes), - other_grps = DefOther}} + other_grps = DefOther, connect_all = Ca}} end. diff --git a/lib/stdlib/include/erl_bits.hrl b/lib/stdlib/include/erl_bits.hrl index 8405a55d55..2a54587a17 100644 --- a/lib/stdlib/include/erl_bits.hrl +++ b/lib/stdlib/include/erl_bits.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,10 +26,10 @@ -type bt_unit() :: 1..256. -record(bittype, { - type :: bt_type(), - unit :: bt_unit(), %% element unit - sign :: bt_sign(), - endian :: bt_endian() + type :: bt_type() | 'undefined', + unit :: bt_unit() | 'undefined', %% element unit + sign :: bt_sign() | 'undefined', + endian :: bt_endian() | 'undefined' }). -record(bitdefault, { diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index b93ce97cd3..cb19fe4175 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -867,7 +867,7 @@ mandatory_chunks() -> %%% can use it. %%% ==================================================================== --record(state, {crypto_key_f :: crypto_fun()}). +-record(state, {crypto_key_f :: crypto_fun() | 'undefined'}). -define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server). diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d3124ac593..c8bba579cc 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -49,7 +49,8 @@ -define(DEFAULT_ENCODING, utf8). %% Epp state record. --record(epp, {file :: file:io_device(), %Current file +-record(epp, {file :: file:io_device() + | 'undefined', %Current file location=1, %Current location delta=0 :: non_neg_integer(), %Offset from Location (-file) name="" :: file:name(), %Current file name diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 41b49f4a86..b8ce311c35 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -38,7 +38,7 @@ -record(state, {file :: file:filename(), module :: module(), forms_or_bin, - source :: source(), + source :: source() | 'undefined', n_errors :: non_neg_integer(), mode :: mode(), exports_main :: boolean(), @@ -49,9 +49,9 @@ -type emu_args() :: string(). -record(sections, {type, - shebang :: shebang(), - comment :: comment(), - emu_args :: emu_args(), + shebang :: shebang() | 'undefined', + comment :: comment() | 'undefined', + emu_args :: emu_args() | 'undefined', body}). -record(extract_options, {compile_source}). diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 92a0c29011..142aaa8688 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -107,11 +107,11 @@ -define(SET, sets:set). -record(state, {name, - strategy :: strategy(), + strategy :: strategy() | 'undefined', children = [] :: [child_rec()], - dynamics :: ?DICT(pid(), list()) | ?SET(pid()), - intensity :: non_neg_integer(), - period :: pos_integer(), + dynamics :: ?DICT(pid(), list()) | ?SET(pid()) | 'undefined', + intensity :: non_neg_integer() | 'undefined', + period :: pos_integer() | 'undefined', restarts = [], module, args}). -- cgit v1.2.3 From cc5a470ee25f7db55b586f4908e7e6b9057cafea Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 30 Sep 2015 16:15:26 +0200 Subject: stdlib: Refactor the supervisor module's state The field 'dynamics' in #state{} is a union of two opaque types, which is possibly problematic. Tagging the types should make the code safe for warnings from future versions of Dialyzer. --- lib/stdlib/src/supervisor.erl | 66 +++++++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 142aaa8688..23f3aaee1f 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -109,7 +109,9 @@ -record(state, {name, strategy :: strategy() | 'undefined', children = [] :: [child_rec()], - dynamics :: ?DICT(pid(), list()) | ?SET(pid()) | 'undefined', + dynamics :: {'dict', ?DICT(pid(), list())} + | {'set', ?SET(pid())} + | 'undefined', intensity :: non_neg_integer() | 'undefined', period :: pos_integer() | 'undefined', restarts = [], @@ -577,7 +579,7 @@ handle_cast({try_again_restart,Pid}, #state{children=[Child]}=State) when ?is_simple(State) -> RT = Child#child.restart_type, RPid = restarting(Pid), - case dynamic_child_args(RPid, dynamics_db(RT, State#state.dynamics)) of + case dynamic_child_args(RPid, RT, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = RPid, mfargs = {M, F, Args}}, @@ -735,7 +737,7 @@ handle_start_child(Child, State) -> restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> RestartType = Child#child.restart_type, - case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of + case dynamic_child_args(Pid, RestartType, State#state.dynamics) of {ok, Args} -> {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, @@ -812,14 +814,16 @@ restart(simple_one_for_one, Child, State) -> State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {ok, Pid, _Extra} -> - NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICTS:store(restarting(OldPid), A, - Dynamics)}, + DynamicsDb = {dict, ?DICTS:store(restarting(OldPid), A, Dynamics)}, + NState = State#state{dynamics = DynamicsDb}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} end; @@ -1102,31 +1106,32 @@ save_child(Child, #state{children = Children} = State) -> State#state{children = [Child |Children]}. save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?SETS:add_element(Pid, dynamics_db(temporary, Dynamics))}; + DynamicsDb = dynamics_db(temporary, Dynamics), + State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}}; save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> - State#state{dynamics = ?DICTS:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + DynamicsDb = dynamics_db(RestartType, Dynamics), + State#state{dynamics = {dict, ?DICTS:store(Pid, Args, DynamicsDb)}}. dynamics_db(temporary, undefined) -> ?SETS:new(); dynamics_db(_, undefined) -> ?DICTS:new(); -dynamics_db(_,Dynamics) -> - Dynamics. - -dynamic_child_args(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - {ok, undefined}; - false -> - ?DICTS:find(Pid, Dynamics) - end. +dynamics_db(_, {_Tag, DynamicsDb}) -> + DynamicsDb. + +dynamic_child_args(_Pid, temporary, _DynamicsDb) -> + {ok, undefined}; +dynamic_child_args(Pid, _RT, {dict, DynamicsDb}) -> + ?DICTS:find(Pid, DynamicsDb); +dynamic_child_args(_Pid, _RT, undefined) -> + error. state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> NDynamics = ?SETS:del_element(Pid, dynamics_db(temporary, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {set, NDynamics}}; state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> NDynamics = ?DICTS:erase(Pid, dynamics_db(RType, State#state.dynamics)), - State#state{dynamics = NDynamics}; + State#state{dynamics = {dict, NDynamics}}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), State#state{children = NChildren}. @@ -1160,19 +1165,19 @@ split_child(_, [], After) -> get_child(Name, State) -> get_child(Name, State, false). + get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> get_dynamic_child(Pid, State); get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> - DynamicsDb = dynamics_db(Child#child.restart_type, Dynamics), - case is_dynamic_pid(Pid, DynamicsDb) of + case is_dynamic_pid(Pid, Dynamics) of true -> {value, Child#child{pid=Pid}}; false -> RPid = restarting(Pid), - case is_dynamic_pid(RPid, DynamicsDb) of + case is_dynamic_pid(RPid, Dynamics) of true -> {value, Child#child{pid=RPid}}; false -> @@ -1183,13 +1188,12 @@ get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> end end. -is_dynamic_pid(Pid, Dynamics) -> - case ?SETS:is_set(Dynamics) of - true -> - ?SETS:is_element(Pid, Dynamics); - false -> - ?DICTS:is_key(Pid, Dynamics) - end. +is_dynamic_pid(Pid, {dict, Dynamics}) -> + ?DICTS:is_key(Pid, Dynamics); +is_dynamic_pid(Pid, {set, Dynamics}) -> + ?SETS:is_element(Pid, Dynamics); +is_dynamic_pid(_Pid, undefined) -> + false. replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), -- cgit v1.2.3 From 93f5844185a459cbf9efc3843919c463a2eef0fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 8 Oct 2015 13:04:40 +0200 Subject: Teach erlang:is_builtin/3 that erlang:apply/3 is built-in erlang:is_builtin(erlang, apply, 3) returns 'false'. That seems to be an oversight in the implementation of erlang:is_builtin/3 rather than a conscious design decision. Part of apply/3 is implemented in C (as a special instruction), and part of it in Erlang (only used if apply/3 is used recursively). That makes apply/3 special compared to all other BIFs. From the viewpoint of the user, apply/3 is a built-in function, since it cannot possibly be implemented in pure Erlang. Noticed-by: Stavros Aronis --- erts/emulator/beam/beam_emu.c | 9 +++++++++ erts/emulator/test/bif_SUITE.erl | 21 +++++++++++++++++++-- lib/tools/test/xref_SUITE.erl | 28 +++++++++++++--------------- 3 files changed, 41 insertions(+), 17 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a42ce1c9f1..faf496a030 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -6752,6 +6752,15 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity) Export e; Export* ep; + if (Mod == am_erlang && Name == am_apply && arity == 3) { + /* + * Special case. apply/3 is built-in (implemented in C), + * but implemented in a different way than all other + * BIFs. + */ + return 1; + } + e.code[0] = Mod; e.code[1] = Name; e.code[2] = arity; diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index d6a771e7b9..ebc4db53c4 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -32,7 +32,8 @@ specs/1,improper_bif_stubs/1,auto_imports/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, binary_to_atom/1,binary_to_existing_atom/1, - atom_to_binary/1,min_max/1, erlang_halt/1]). + atom_to_binary/1,min_max/1, erlang_halt/1, + is_builtin/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -42,7 +43,7 @@ all() -> t_list_to_existing_atom, os_env, otp_7526, display, atom_to_binary, binary_to_atom, binary_to_existing_atom, - min_max, erlang_halt]. + min_max, erlang_halt, is_builtin]. groups() -> []. @@ -716,6 +717,22 @@ wait_until_stable_size(File,PrevSz) -> wait_until_stable_size(File,NewSz) end. +is_builtin(_Config) -> + Exp0 = [{M,F,A} || {M,_} <- code:all_loaded(), + {F,A} <- M:module_info(exports)], + Exp = ordsets:from_list(Exp0), + + %% erlang:apply/3 is considered to be built-in, but is not + %% implemented as other BIFs. + + Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)], + Builtins = ordsets:from_list(Builtins0), + NotBuiltin = ordsets:subtract(Exp, Builtins), + _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins], + _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin], + + ok. + %% Helpers diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index ad47b31443..71c8b1a277 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1151,17 +1151,13 @@ read_expected(Version) -> {POS8+4,{FF,{a,b,1}}}, {POS8+4,{FF,{erlang,apply,2}}}, {POS8+5,{FF,{erlang,apply,2}}}, - {POS8+6,{FF,{erlang,apply,3}}}, {POS8+6,{FF,{m,f,1}}}, - {POS8+7,{FF,{erlang,apply,3}}}, - {POS9+1,{FF,{erlang,apply,3}}}, {POS9+1,{FF,{read,bi,0}}}, {POS9+2,{FF,{a,b,1}}}, {POS9+2,{FF,{erlang,apply,2}}}, {POS9+3,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,apply,2}}}, {POS9+4,{FF,{erlang,not_a_function,1}}}, - {POS9+5,{FF,{erlang,apply,3}}}, {POS9+5,{FF,{mod,func,2}}}, {POS9+6,{FF,{erlang,apply,1}}}, {POS9+7,{FF,{erlang,apply,2}}}, @@ -1169,17 +1165,11 @@ read_expected(Version) -> {POS9+8,{FF,{q,f,1}}}, {POS10+4,{FF,{erlang,apply,2}}}, {POS10+5,{FF,{mod1,fun1,1}}}, - {POS11+1,{FF,{erlang,apply,3}}}, - {POS11+2,{FF,{erlang,apply,3}}}, - {POS11+3,{FF,{erlang,apply,3}}}, - {POS11+4,{FF,{erlang,apply,3}}}, {POS11+6,{FF,{erlang,apply,2}}}, {POS12+1,{FF,{erlang,apply,2}}}, {POS12+4,{FF,{erlang,apply,2}}}, - {POS12+5,{FF,{erlang,apply,3}}}, {POS12+5,{FF,{m3,f3,2}}}, {POS12+7,{FF,{erlang,apply,2}}}, - {POS12+8,{FF,{erlang,apply,3}}}, {POS13+1,{FF,{dm,df,1}}}, {POS13+6,{{read,bi,0},{foo,module_info,0}}}, {POS13+7,{{read,bi,0},{read,module_info,0}}}, @@ -1189,10 +1179,6 @@ read_expected(Version) -> OK = case Version of abstract_v1 -> - [{POS8+3, {FF,{erlang,apply,3}}}, - {POS10+1, {FF,{erlang,apply,3}}}, - {POS10+6, {FF,{erlang,apply,3}}}] - ++ [{0,{FF,{read,'$F_EXPR',178}}}, {0,{FF,{modul,'$F_EXPR',179}}}] ++ O1; @@ -1213,13 +1199,25 @@ read_expected(Version) -> {POS3+3, {FF,{erlang,spawn_link,3}}}, {POS3+4, {FF,{erlang,spawn_link,3}}}, {POS6+4, {FF,{erlang,spawn,3}}}, + {POS8+6,{FF,{erlang,apply,3}}}, + {POS8+7,{FF,{erlang,apply,3}}}, + {POS9+1,{FF,{erlang,apply,3}}}, + {POS9+5,{FF,{erlang,apply,3}}}, + {POS11+1,{FF,{erlang,apply,3}}}, + {POS11+2,{FF,{erlang,apply,3}}}, + {POS11+3,{FF,{erlang,apply,3}}}, + {POS11+4,{FF,{erlang,apply,3}}}, + {POS12+5,{FF,{erlang,apply,3}}}, + {POS12+8,{FF,{erlang,apply,3}}}, {POS13+5, {{read,bi,0},{erlang,length,1}}}, {POS14+3, {{read,bi,0},{erlang,length,1}}}], %% Operators (OTP-8647): OKB = case Version of abstract_v1 -> - []; + [{POS8+3, {FF,{erlang,apply,3}}}, + {POS10+1, {FF,{erlang,apply,3}}}, + {POS10+6, {FF,{erlang,apply,3}}}]; _ -> [{POS13+16, {{read,bi,0},{erlang,'!',2}}}, {POS13+16, {{read,bi,0},{erlang,'-',1}}}, -- cgit v1.2.3 From 973ef43fbb837c7e790d487dbdd7656dc3376717 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 14 Sep 2015 14:41:48 +0200 Subject: Update Compiler A record field type has been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/compiler/src/core_lint.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index cc54f6e411..7d3513c0ba 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -73,7 +73,7 @@ %% Define the lint state record. -record(lint, {module :: module(), % Current module - func :: fa(), % Current function + func :: fa() | 'undefined', % Current function errors = [] :: [error()], % Errors warnings= [] :: [warning()]}). % Warnings -- cgit v1.2.3 From 3318e2a51b83d1dd4038950f51880ac872076564 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 28 Sep 2015 16:26:02 +0200 Subject: Update Dialyzer Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/dialyzer/src/dialyzer.app.src | 2 +- lib/dialyzer/src/dialyzer.hrl | 10 ++++--- lib/dialyzer/src/dialyzer_callgraph.erl | 21 +++++++++----- lib/dialyzer/src/dialyzer_cl.erl | 2 +- lib/dialyzer/src/dialyzer_codeserver.erl | 10 +++---- lib/dialyzer/src/dialyzer_dataflow.erl | 28 ++++++++++++------ lib/dialyzer/src/dialyzer_gui_wx.erl | 9 +++--- lib/dialyzer/src/dialyzer_races.erl | 40 ++++++++++++++------------ lib/dialyzer/src/dialyzer_succ_typings.erl | 3 +- lib/dialyzer/src/dialyzer_typesig.erl | 37 +++++++++++++----------- lib/dialyzer/test/r9c_SUITE_data/results/inets | 2 -- lib/dialyzer/vsn.mk | 2 +- 12 files changed, 93 insertions(+), 73 deletions(-) diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 8ac6dc1367..7794cb46c6 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -44,7 +44,7 @@ dialyzer_timing, dialyzer_worker]}, {registered, []}, - {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, + {applications, [compiler, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.5", "kernel-3.0","hipe-3.13","erts-7.0", diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index de236f91ab..601e2e954b 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -2,7 +2,7 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %%% %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. @@ -123,10 +123,12 @@ %% Record declarations used by various files %%-------------------------------------------------------------------- --record(analysis, {analysis_pid :: pid(), +-type doc_plt() :: 'undefined' | dialyzer_plt:plt(). + +-record(analysis, {analysis_pid :: pid() | 'undefined', type = succ_typings :: anal_type(), defines = [] :: [dial_define()], - doc_plt :: dialyzer_plt:plt(), + doc_plt :: doc_plt(), files = [] :: [file:filename()], include_dirs = [] :: [file:filename()], start_from = byte_code :: start_from(), @@ -135,7 +137,7 @@ race_detection = false :: boolean(), behaviours_chk = false :: boolean(), timing = false :: boolean() | 'debug', - timing_server :: dialyzer_timing:timing_server(), + timing_server = none :: dialyzer_timing:timing_server(), callgraph_file = "" :: file:filename(), solvers :: [solver()]}). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index a1cd2015ca..069c02fa65 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -96,15 +96,22 @@ %% whenever applicable. %%----------------------------------------------------------------------------- +%% Types with comment 'race' are due to dialyzer_races.erl. -record(callgraph, {digraph = digraph:new() :: digraph:graph(), - active_digraph :: active_digraph(), - esc :: ets:tid(), - letrec_map :: ets:tid(), + active_digraph :: active_digraph() + | 'undefined', % race + esc :: ets:tid() + | 'undefined', % race + letrec_map :: ets:tid() + | 'undefined', % race name_map :: ets:tid(), rev_name_map :: ets:tid(), - rec_var_map :: ets:tid(), - self_rec :: ets:tid(), - calls :: ets:tid(), + rec_var_map :: ets:tid() + | 'undefined', % race + self_rec :: ets:tid() + | 'undefined', % race + calls :: ets:tid() + | 'undefined', % race race_detection = false :: boolean(), race_data_server = new_race_data_server() :: pid()}). diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 4116866916..92134b7b81 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -36,7 +36,7 @@ -include_lib("kernel/include/file.hrl"). % needed for #file_info{} -record(cl_state, - {backend_pid :: pid(), + {backend_pid :: pid() | 'undefined', erlang_mode = false :: boolean(), external_calls = [] :: [mfa()], external_types = [] :: [mfa()], diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 978ecd3843..03cd9671af 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -81,10 +81,10 @@ -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), - exported_types :: set_ets(), % set(mfa()) - records :: dict_ets(), - contracts :: dict_ets(), - callbacks :: dict_ets(), + exported_types :: set_ets() | 'undefined', % set(mfa()) + records :: dict_ets() | 'undefined', + contracts :: dict_ets() | 'undefined', + callbacks :: dict_ets() | 'undefined', fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index cabc5e9e0d..6e49043551 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -99,19 +99,29 @@ -define(BITS, 128). --record(state, {callgraph :: dialyzer_callgraph:callgraph(), - codeserver :: dialyzer_codeserver:codeserver(), - envs :: env_tab(), - fun_tab :: fun_tab(), - fun_homes :: dict:dict(label(), mfa()), - plt :: dialyzer_plt:plt(), - opaques :: [type()], +%% Types with comment 'race' are due to dialyzer_races.erl. +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', % race + codeserver :: dialyzer_codeserver:codeserver() + | 'undefined', % race + envs :: env_tab() + | 'undefined', % race + fun_tab :: fun_tab() + | 'undefined', % race + fun_homes :: dict:dict(label(), mfa()) + | 'undefined', % race + plt :: dialyzer_plt:plt() + | 'undefined', % race + opaques :: [type()] + | 'undefined', % race races = dialyzer_races:new() :: dialyzer_races:races(), records = dict:new() :: types(), - tree_map :: dict:dict(label(), cerl:cerl()), + tree_map :: dict:dict(label(), cerl:cerl()) + | 'undefined', % race warning_mode = false :: boolean(), warnings = [] :: [raw_warning()], - work :: {[_], [_], sets:set()}, + work :: {[_], [_], sets:set()} + | 'undefined', % race module :: module(), curr_fun :: curr_fun() }). diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index ff54a91ce1..9f344d87ff 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------ %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -52,7 +52,6 @@ add_dir :: wx:wx_object(), add_rec :: wx:wx_object(), chosen_box :: wx:wx_object(), - analysis_pid :: pid(), del_file :: wx:wx_object(), doc_plt :: dialyzer_plt:plt(), clear_chosen :: wx:wx_object(), @@ -72,11 +71,11 @@ stop :: wx:wx_object(), frame :: wx:wx_object(), warnings_box :: wx:wx_object(), - explanation_box :: wx:wx_object(), + explanation_box :: wx:wx_object() | 'undefined', wantedWarnings :: list(), rawWarnings :: list(), - backend_pid :: pid(), - expl_pid :: pid()}). + backend_pid :: pid() | 'undefined', + expl_pid :: pid() | 'undefined'}). %%------------------------------------------------------------------------ diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 39de071bde..bb43d1dcb8 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -92,27 +92,28 @@ -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()}). --record(end_clause, {arg :: var_to_map1(), - pats :: var_to_map1(), - guard :: cerl:cerl()}). +-record(beg_clause, {arg :: var_to_map1() | 'undefined', + pats :: var_to_map1() | 'undefined', + guard :: cerl:cerl() | 'undefined'}). +-record(end_clause, {arg :: var_to_map1() | 'undefined', + pats :: var_to_map1() | 'undefined', + guard :: cerl:cerl() | 'undefined'}). -record(end_case, {clauses :: [#end_clause{}]}). --record(curr_fun, {status :: 'in' | 'out', - mfa :: dialyzer_callgraph:mfa_or_funlbl(), - label :: label(), - def_vars :: [core_vars()], - arg_types :: [erl_types:erl_type()], - call_vars :: [core_vars()], - var_map :: dict:dict()}). +-record(curr_fun, {status :: 'in' | 'out' | 'undefined', + mfa :: dialyzer_callgraph:mfa_or_funlbl() + | 'undefined', + label :: label() | 'undefined', + def_vars :: [core_vars()] | 'undefined', + arg_types :: [erl_types:erl_type()] | 'undefined', + call_vars :: [core_vars()] | 'undefined', + var_map :: dict:dict() | 'undefined'}). -record(dep_call, {call_name :: dep_calls(), - args :: args(), + args :: args() | 'undefined', arg_types :: [erl_types:erl_type()], vars :: [core_vars()], state :: dialyzer_dataflow:state(), file_line :: file_line(), - var_map :: dict:dict()}). + var_map :: dict:dict() | 'undefined'}). -record(fun_call, {caller :: dialyzer_callgraph:mfa_or_funlbl(), callee :: dialyzer_callgraph:mfa_or_funlbl(), arg_types :: [erl_types:erl_type()], @@ -121,7 +122,7 @@ arg :: var_to_map1()}). -record(warn_call, {call_name :: warn_calls(), args :: args(), - var_map :: dict:dict()}). + var_map :: dict:dict() | 'undefined'}). -type case_tags() :: 'beg_case' | #beg_clause{} | #end_clause{} | #end_case{}. -type code() :: [#dep_call{} | #fun_call{} | #warn_call{} | @@ -139,8 +140,9 @@ fun_mfa :: dialyzer_callgraph:mfa_or_funlbl(), fun_label :: label()}). --record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl(), - curr_fun_label :: label(), +-record(races, {curr_fun :: dialyzer_callgraph:mfa_or_funlbl() + | 'undefined', + curr_fun_label :: label() | 'undefined', curr_fun_args = 'empty' :: core_args(), new_table = 'no_t' :: table(), race_list = [] :: code(), diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 18f02e6742..987da3aecf 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -134,7 +134,6 @@ get_refined_success_typings(SCCs, #st{callgraph = Callgraph, end end. --type doc_plt() :: 'undefined' | dialyzer_plt:plt(). -spec get_warnings(dialyzer_callgraph:callgraph(), dialyzer_plt:plt(), doc_plt(), dialyzer_codeserver:codeserver(), dialyzer_timing:timing_server(), [solver()], pid()) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 0b8b244cc9..5f0881bbcd 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -68,7 +68,7 @@ -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} -record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], - origin :: integer()}). + origin :: integer() | 'undefined'}). -type constr_op() :: 'eq' | 'sub'. -type fvar_or_type() :: #fun_var{} | erl_types:erl_type(). @@ -83,9 +83,9 @@ -record(constraint_list, {type :: 'conj' | 'disj', list :: [constr()], deps :: [dep()], - masks :: [{dep(),[non_neg_integer()]}] | - {'d',dict:dict(dep(), [non_neg_integer()])}, - id :: {'list', dep()}}). + masks = [] :: [{dep(),[non_neg_integer()]}] | + {'d',dict:dict(dep(), [non_neg_integer()])}, + id :: {'list', dep()} | 'undefined'}). -type constraint_list() :: #constraint_list{}. @@ -104,7 +104,8 @@ -type dict_or_ets() :: {'d', prop_types()} | {'e', ets:tid()}. --record(state, {callgraph :: dialyzer_callgraph:callgraph(), +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', cs = [] :: [constr()], cmap = {'d', dict:new()} :: dict_or_ets(), fun_map = [] :: typesig_funmap(), @@ -116,7 +117,8 @@ cerl:c_fun()), next_label = 0 :: label(), self_rec :: 'false' | erl_types:erl_type(), - plt :: dialyzer_plt:plt(), + plt :: dialyzer_plt:plt() + | 'undefined', prop_types = {'d', dict:new()} :: dict_or_ets(), records = dict:new() :: types(), scc = [] :: [type_var()], @@ -1746,7 +1748,10 @@ minimize_state(#state{ fun_arities = FunArities, self_rec = SelfRec, prop_types = {e, ETSPropTypes}, - solvers = Solvers + solvers = Solvers, + callgraph = undefined, + plt = undefined, + mfas = [] }. dispose_state(#state{cmap = {e, ETSCMap}, @@ -2884,8 +2889,7 @@ mk_constraint(Lhs, Op, Rhs) -> case t_is_any(Lhs) orelse constraint_opnd_is_any(Rhs) of false -> Deps = find_constraint_deps([Lhs, Rhs]), - C0 = mk_constraint_1(Lhs, Op, Rhs), - C = C0#constraint{deps = Deps}, + C = mk_constraint_1(Lhs, Op, Rhs, Deps), case Deps =:= [] of true -> %% This constraint is constant. Solve it immediately. @@ -2903,8 +2907,7 @@ mk_constraint(Lhs, Op, Rhs) -> end. mk_constraint_any(Op) -> - C = mk_constraint_1(t_any(), Op, t_any()), - C#constraint{deps = []}. + mk_constraint_1(t_any(), Op, t_any(), []). %% the following function is used so that we do not call %% erl_types:t_is_any/1 with a term other than an erl_type() @@ -2952,12 +2955,12 @@ find_constraint_deps([Type|Tail], Acc) -> find_constraint_deps([], Acc) -> lists:flatten(Acc). -mk_constraint_1(Lhs, eq, Rhs) when Lhs < Rhs -> - #constraint{lhs = Lhs, op = eq, rhs = Rhs}; -mk_constraint_1(Lhs, eq, Rhs) -> - #constraint{lhs = Rhs, op = eq, rhs = Lhs}; -mk_constraint_1(Lhs, Op, Rhs) -> - #constraint{lhs = Lhs, op = Op, rhs = Rhs}. +mk_constraint_1(Lhs, eq, Rhs, Deps) when Lhs < Rhs -> + #constraint{lhs = Lhs, op = eq, rhs = Rhs, deps = Deps}; +mk_constraint_1(Lhs, eq, Rhs, Deps) -> + #constraint{lhs = Rhs, op = eq, rhs = Lhs, deps = Deps}; +mk_constraint_1(Lhs, Op, Rhs, Deps) -> + #constraint{lhs = Lhs, op = Op, rhs = Rhs, deps = Deps}. mk_constraints([Lhs|LhsTail], Op, [Rhs|RhsTail]) -> [mk_constraint(Lhs, Op, Rhs) | diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index 89be9652e3..d377f34978 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -37,7 +37,6 @@ mod_cgi.erl:372: The pattern {'http_response', NewAccResponse} can never match t mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) mod_dir.erl:72: The pattern {'error', Reason} can never match the type {'ok',[[[any()] | char()],...]} mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type -mod_get.erl:150: Record construction #file_info{} violates the declared type of field size::non_neg_integer() and type::'device' | 'directory' | 'other' | 'regular' | 'symlink' and access::'none' | 'read' | 'read_write' | 'write' and atime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mtime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and ctime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mode::non_neg_integer() and links::non_neg_integer() and major_device::non_neg_integer() and minor_device::non_neg_integer() and inode::non_neg_integer() and uid::non_neg_integer() and gid::non_neg_integer() mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type mod_htaccess.erl:460: The pattern {'error', BadData} can never match the type {'ok',_} mod_include.erl:193: The pattern {_, Name, {[], []}} can never match the type {[any()],[any()],maybe_improper_list()} @@ -48,7 +47,6 @@ mod_include.erl:692: The pattern <{'read', Reason}, Info, Path> can never match mod_include.erl:706: The pattern <{'enfile', _}, _Info, Path> can never match the type mod_include.erl:716: Function read_error/3 will never be called mod_include.erl:719: Function read_error/4 will never be called -mod_range.erl:308: Record construction #file_info{} violates the declared type of field size::non_neg_integer() and type::'device' | 'directory' | 'other' | 'regular' | 'symlink' and access::'none' | 'read' | 'read_write' | 'write' and atime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mtime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and ctime::non_neg_integer() | {{non_neg_integer(),1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12,1..255},{byte(),byte(),byte()}} and mode::non_neg_integer() and links::non_neg_integer() and major_device::non_neg_integer() and minor_device::non_neg_integer() and inode::non_neg_integer() and uid::non_neg_integer() and gid::non_neg_integer() mod_security_server.erl:386: The variable O can never match since previous clauses completely covered the type [tuple()] mod_security_server.erl:433: The variable Other can never match since previous clauses completely covered the type [tuple()] mod_security_server.erl:585: The variable _ can never match since previous clauses completely covered the type [tuple()] diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index e57caa9ad3..9480f17f51 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.8.1 +DIALYZER_VSN = 2.8.2 -- cgit v1.2.3 From b0ad54fdc41528ddff7c1767403a514a4e0a3f9c Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Fri, 2 Oct 2015 16:18:58 +0200 Subject: Fix errors in dialyzer_{coordinator,worker} specs --- lib/dialyzer/src/dialyzer_coordinator.erl | 21 +++++++++++---------- lib/dialyzer/src/dialyzer_worker.erl | 7 ++++--- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 612f379d32..3290161ca1 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -38,7 +38,7 @@ %%% Exports for the compilation workers -export([get_next_label/2]). --export_type([coordinator/0, mode/0, init_data/0, result/0]). +-export_type([coordinator/0, mode/0, init_data/0, result/0, job/0]). %%-------------------------------------------------------------------- @@ -52,10 +52,12 @@ -type scc() :: [mfa_or_funlbl()]. -type mode() :: 'typesig' | 'dataflow' | 'compile' | 'warnings'. --type compile_jobs() :: [file:filename()]. --type typesig_jobs() :: [scc()]. --type dataflow_jobs() :: [module()]. --type warnings_jobs() :: [module()]. +-type compile_job() :: file:filename(). +-type typesig_job() :: scc(). +-type dataflow_job() :: module(). +-type warnings_job() :: module(). + +-type job() :: compile_job() | typesig_job() | dataflow_job() | warnings_job(). -type compile_init_data() :: dialyzer_analysis_callgraph:compile_init_data(). -type typesig_init_data() :: dialyzer_succ_typings:typesig_init_data(). @@ -73,7 +75,6 @@ -type result() :: compile_result() | typesig_result() | dataflow_result() | warnings_result(). --type job() :: scc() | module() | file:filename(). -type job_result() :: dialyzer_analysis_callgraph:one_file_result() | typesig_result() | dataflow_result() | warnings_result(). @@ -90,13 +91,13 @@ %%-------------------------------------------------------------------- --spec parallel_job('compile', compile_jobs(), compile_init_data(), timing()) -> +-spec parallel_job('compile', [compile_job()], compile_init_data(), timing()) -> {compile_result(), integer()}; - ('typesig', typesig_jobs(), typesig_init_data(), timing()) -> + ('typesig', [typesig_job()], typesig_init_data(), timing()) -> typesig_result(); - ('dataflow', dataflow_jobs(), dataflow_init_data(), + ('dataflow', [dataflow_job()], dataflow_init_data(), timing()) -> dataflow_result(); - ('warnings', warnings_jobs(), warnings_init_data(), + ('warnings', [warnings_job()], warnings_init_data(), timing()) -> warnings_result(). parallel_job(Mode, Jobs, InitData, Timing) -> diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 4be93c75bf..979e3a621d 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -31,10 +31,11 @@ -type coordinator() :: dialyzer_coordinator:coordinator(). -type init_data() :: dialyzer_coordinator:init_data(). -type result() :: dialyzer_coordinator:result(). +-type job() :: dialyzer_coordinator:job(). -record(state, { mode :: mode(), - job :: mfa_or_funlbl() | file:filename(), + job :: job(), coordinator :: coordinator(), init_data :: init_data(), depends_on = [] :: list() @@ -52,7 +53,7 @@ %%-------------------------------------------------------------------- --spec launch(mode(), [mfa_or_funlbl()], init_data(), coordinator()) -> worker(). +-spec launch(mode(), job(), init_data(), coordinator()) -> worker(). launch(Mode, Job, InitData, Coordinator) -> State = #state{mode = Mode, @@ -174,7 +175,7 @@ collect_warnings(#state{job = Job, init_data = InitData}) -> -type extra() :: label() | 'unused'. --spec sequential(mode(), [mfa_or_funlbl()], init_data(), extra()) -> result(). +-spec sequential(mode(), job(), init_data(), extra()) -> result(). sequential('compile', Job, InitData, Extra) -> case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of -- cgit v1.2.3 From 9221ddadb0eb879462cd96183d3eaf6352830eb3 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 5 Oct 2015 23:53:27 +0200 Subject: Update and cleanup HiPE records The bulk of the changes concerns cleanups and code refactorings concerning record constructions that assigned 'undefined' to record fields whose type did not contain this value. See commit 8ce35b2. While at it, some new type definitions were introduced and type names were used instead of record type notation. Minor code cleaups were also done. --- lib/hipe/cerl/cerl_cconv.erl | 13 ++++++---- lib/hipe/cerl/cerl_hipeify.erl | 12 ++++----- lib/hipe/flow/cfg.hrl | 8 +++--- lib/hipe/icode/hipe_icode.erl | 36 +++++++++++++------------- lib/hipe/icode/hipe_icode.hrl | 3 ++- lib/hipe/icode/hipe_icode_exceptions.erl | 20 ++++++-------- lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl | 6 ++--- lib/hipe/main/hipe.erl | 5 ++-- lib/hipe/main/hipe.hrl.src | 5 ++-- lib/hipe/main/hipe_main.erl | 16 +++++++----- 10 files changed, 65 insertions(+), 59 deletions(-) diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl index 0fc28be5f3..ac9d01ab0e 100644 --- a/lib/hipe/cerl/cerl_cconv.erl +++ b/lib/hipe/cerl/cerl_cconv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -710,7 +710,7 @@ ren__new() -> ren__add(Key, Value, Ren) -> dict:store(Key, Value, Ren). -ren__map(Key, Ren) -> +ren__map(Key, Ren) -> case dict:find(Key, Ren) of {ok, Value} -> Value; @@ -722,11 +722,14 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State --record(state, {module :: module(), function :: {atom(), arity()}, - names, refs, defs = []}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + names = sets:new() :: sets:set(), %% XXX: refine + refs = dict:new() :: dict:dict(), %% XXX: refine + defs = []}). s__new(Module) -> - #state{module = Module, names = sets:new(), refs = dict:new()}. + #state{module = Module}. s__add_function_name(Name, S) -> S#state{names = sets:add_element(Name, S#state.names)}. diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl index 8691e80cac..6611abd204 100644 --- a/lib/hipe/cerl/cerl_hipeify.erl +++ b/lib/hipe/cerl/cerl_hipeify.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -623,12 +623,12 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State -%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all' +-type pmatch() :: 'true' | 'false' | 'no_duplicates' | 'duplicate_all'. --record(state, {module::atom(), - function::{atom(), 0..256}, - pmatch=true, - revisit = false}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + pmatch = true :: pmatch(), + revisit = false :: boolean()}). s__new(Module) -> #state{module = Module}. diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl index f79fff4efe..641ec102db 100644 --- a/lib/hipe/flow/cfg.hrl +++ b/lib/hipe/flow/cfg.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,11 +34,13 @@ %% -record(cfg_info, {'fun' :: mfa(), start_label :: cfg_lbl(), + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), params, % :: list() info = []}). %% this field seems not needed; take out?? +-type cfg_info() :: #cfg_info{}. %% %% Data is a triple with a dict of constants, a list of labels and an integer @@ -49,6 +51,6 @@ %% The following is to be used by other modules %% -record(cfg, {table = gb_trees:empty() :: gb_trees:tree(), - info :: #cfg_info{}, + info :: cfg_info(), data :: cfg_data()}). -type cfg() :: #cfg{}. diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 5c7003b0ed..9692eebb10 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -631,59 +631,59 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> -spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], hipe_consttab(), {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, data=Data, is_closure=IsClosure, is_leaf=IsLeaf, var_range=VarRange, label_range=LabelRange}. --spec icode_fun(#icode{}) -> mfa(). +-spec icode_fun(icode()) -> mfa(). icode_fun(#icode{'fun' = MFA}) -> MFA. --spec icode_params(#icode{}) -> [icode_var()]. +-spec icode_params(icode()) -> [icode_var()]. icode_params(#icode{params = Params}) -> Params. --spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}. +-spec icode_params_update(icode(), [icode_var()]) -> icode(). icode_params_update(Icode, Params) -> Icode#icode{params = Params}. --spec icode_is_closure(#icode{}) -> boolean(). +-spec icode_is_closure(icode()) -> boolean(). icode_is_closure(#icode{is_closure = Closure}) -> Closure. --spec icode_is_leaf(#icode{}) -> boolean(). +-spec icode_is_leaf(icode()) -> boolean(). icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf. --spec icode_code(#icode{}) -> icode_instrs(). +-spec icode_code(icode()) -> icode_instrs(). icode_code(#icode{code = Code}) -> Code. --spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}. +-spec icode_code_update(icode(), icode_instrs()) -> icode(). icode_code_update(Icode, NewCode) -> Vmax = highest_var(NewCode), Lmax = highest_label(NewCode), Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}. --spec icode_data(#icode{}) -> hipe_consttab(). +-spec icode_data(icode()) -> hipe_consttab(). icode_data(#icode{data=Data}) -> Data. -%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}. +%% %% -spec icode_data_update(icode(), hipe_consttab()) -> icode(). %% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}. --spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_var_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_var_range(#icode{var_range = VarRange}) -> VarRange. --spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_label_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_label_range(#icode{label_range = LabelRange}) -> LabelRange. --spec icode_info(#icode{}) -> icode_info(). +-spec icode_info(icode()) -> icode_info(). icode_info(#icode{info = Info}) -> Info. --spec icode_info_update(#icode{}, icode_info()) -> #icode{}. +-spec icode_info_update(icode(), icode_info()) -> icode(). icode_info_update(Icode, Info) -> Icode#icode{info = Info}. --spec icode_closure_arity(#icode{}) -> arity(). +-spec icode_closure_arity(icode()) -> arity(). icode_closure_arity(#icode{closure_arity = Arity}) -> Arity. --spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}. +-spec icode_closure_arity_update(icode(), arity()) -> icode(). icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}. @@ -1709,7 +1709,7 @@ mk_new_label() -> %% @doc Removes comments from Icode. %% --spec strip_comments(#icode{}) -> #icode{}. +-spec strip_comments(icode()) -> icode(). strip_comments(ICode) -> icode_code_update(ICode, no_comments(icode_code(ICode))). diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 9b24c4914e..3bb7bae019 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -170,8 +170,9 @@ -record(icode, {'fun' :: mfa(), params :: [icode_var()], + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), code = [] :: icode_instrs(), data :: hipe_consttab(), diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl index 41556ab80f..f03ce2faaa 100644 --- a/lib/hipe/icode/hipe_icode_exceptions.erl +++ b/lib/hipe/icode/hipe_icode_exceptions.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -85,7 +85,7 @@ %%---------------------------------------------------------------------------- --spec fix_catches(#cfg{}) -> #cfg{}. +-spec fix_catches(cfg()) -> cfg(). fix_catches(CFG) -> {Map, State} = build_mapping(find_catches(init_state(CFG))), @@ -393,10 +393,10 @@ get_renaming(C, Map) -> %%--------------------------------------------------------------------- %% State abstraction --record(state, {cfg :: #cfg{}, +-record(state, {cfg :: cfg(), changed = false :: boolean(), - succ :: #cfg{}, - pred :: #cfg{}, + succ :: cfg(), + pred :: cfg(), start_labels :: [icode_lbl(),...], visited = hipe_icode_cfg:none_visited() :: gb_sets:set(), out = gb_trees:empty() :: gb_trees:tree(), @@ -404,13 +404,8 @@ get_renaming(C, Map) -> }). init_state(CFG) -> - State = #state{cfg = CFG}, - refresh_state_cache(State). - -refresh_state_cache(State) -> - CFG = State#state.cfg, SLs = [hipe_icode_cfg:start_label(CFG)], - State#state{succ = CFG, pred = CFG, start_labels = SLs}. + #state{cfg = CFG, succ = CFG, pred = CFG, start_labels = SLs}. get_cfg(State) -> State#state.cfg. @@ -466,7 +461,8 @@ get_bb_code(L, State) -> set_bb_code(L, Code, State) -> CFG = State#state.cfg, CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)), - refresh_state_cache(State#state{cfg = CFG1}). + SLs = [hipe_icode_cfg:start_label(CFG1)], + State#state{cfg = CFG1, succ = CFG1, pred = CFG1, start_labels = SLs}. get_new_catches_in(L, State) -> Ps = get_pred(L, State), diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl index e350a6ff18..7613024787 100644 --- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl +++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -314,7 +314,7 @@ node_create(Label, Pred, Succ) -> %% tree - the tree of nodes, with labels as keys and node records as values -record(nodes, { - domtree :: hipe_dominators:domTree(), + domtree = none :: 'none' | hipe_dominators:domTree(), labels = none :: 'none' | [icode_lbl()], postorder = none :: 'none' | [icode_lbl()], start_label = none :: 'none' | icode_lbl(), @@ -390,7 +390,7 @@ update_del_red_test_set(Update) -> %%----------------------------------------------------------------------------- %% Main function called from the hipe_main module --spec struct_reuse(#cfg{}) -> #cfg{}. +-spec struct_reuse(cfg()) -> cfg(). struct_reuse(CFG) -> %% debug_init_case_count(?SR_INSTR_TYPE), diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 1a4bbf179f..0e32da1d36 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -764,7 +764,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) -> finalize_fun(MfaIcodeList, Exports, Opts) -> case proplists:get_value(concurrent_comp, Opts) of FalseVal when (FalseVal =:= undefined) orelse (FalseVal =:= false) -> - [finalize_fun_sequential(MFAIcode, Opts, #comp_servers{}) + NoServers = #comp_servers{pp_server = none, range = none, type = none}, + [finalize_fun_sequential(MFAIcode, Opts, NoServers) || {_MFA, _Icode} = MFAIcode <- MfaIcodeList]; TrueVal when (TrueVal =:= true) orelse (TrueVal =:= debug) -> finalize_fun_concurrent(MfaIcodeList, Exports, Opts) diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index ba27878a84..3be824ac34 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -299,7 +299,8 @@ %% Records defined in the hipe module used in other parts of the compiler %%---------------------------------------------------------------------------- --record(comp_servers, {pp_server :: pid(), range :: pid(), type :: pid()}). +-type mpid() :: 'none' | pid(). +-record(comp_servers, {pp_server :: mpid(), range :: mpid(), type :: mpid()}). %%---------------------------------------------------------------------------- %% Basic types of the 'hipe' application used in other parts of the system diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 5753169961..be5050e155 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -55,7 +55,7 @@ %%===================================================================== %% @spec compile_icode(MFA::mfa(), -%% LinearIcode::#icode{}, +%% LinearIcode::icode(), %% CompilerOptions::comp_options(), %% CompServers::#comp_servers()) -> %% {native,Platform,{unprofiled,NativeCode}} | {rtl,RTLCode} @@ -69,7 +69,7 @@ %% generated). The compiler options must have already been expanded %% (cf. `hipe:expand_options').

--spec compile_icode(mfa(), #icode{}, comp_options(), #comp_servers{}) -> +-spec compile_icode(mfa(), icode(), comp_options(), #comp_servers{}) -> comp_icode_ret(). compile_icode(MFA, LinearIcode, Options, Servers) -> @@ -230,10 +230,12 @@ get_pp_module(icode_liveness) -> hipe_icode_liveness; get_pp_module(rtl_liveness) -> hipe_rtl_liveness. perform_io(no_fun, _) -> ok; -perform_io(Fun,PPServer) when is_pid(PPServer) -> - PPServer ! {print,Fun}; -perform_io(Fun, undefined) -> - Fun(). +perform_io(Fun, PPServer) when is_pid(PPServer) -> + PPServer ! {print, Fun}, + ok; +perform_io(Fun, none) -> + Fun(), + ok. %%-------------------------------------------------------------------- -- cgit v1.2.3 From 3b2a4ad2db8115e9c4b982a7400692cf9847869b Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 09:25:54 +0200 Subject: Update Tools Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/tools/src/lcnt.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index e8b3d242e4..9ee75a688a 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -94,12 +94,12 @@ -record(stats, { file :: atom(), - line :: non_neg_integer(), + line :: non_neg_integer() | 'undefined', tries :: non_neg_integer(), colls :: non_neg_integer(), time :: non_neg_integer(), % us nt :: non_neg_integer(), % #timings collected - hist :: tuple() % histogram + hist :: tuple() | 'undefined' % histogram }). -record(lock, { @@ -757,7 +757,7 @@ list2lock([F|Fs], Ls) -> stats2stats([]) -> []; stats2stats([Stat|Stats]) -> - Sz = tuple_size(#stats{}), + Sz = record_info(size, stats), [stat2stat(Stat,Sz)|stats2stats(Stats)]. stat2stat(Stat,Sz) when tuple_size(Stat) =:= Sz -> Stat; -- cgit v1.2.3 From 99dd169e4c499c78dd85c6e34296fdc150e47d24 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 09:41:06 +0200 Subject: Update Syntax Tools Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/syntax_tools/src/erl_tidy.erl | 10 +++++----- lib/syntax_tools/src/igor.erl | 5 +++-- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index db7f0939a3..f2de12b410 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -937,7 +937,7 @@ hidden_uses_2(Tree, Used) -> -record(env, {file :: file:filename(), module :: atom(), - current :: fa(), + current :: fa() | 'undefined', imports = dict:new() :: dict:dict(atom(), atom()), context = normal :: context(), verbosity = 1 :: 0 | 1 | 2, @@ -949,10 +949,10 @@ hidden_uses_2(Tree, Used) -> new_guard_tests = true :: boolean(), old_guard_tests = false :: boolean()}). --record(st, {varc :: non_neg_integer(), +-record(st, {varc :: non_neg_integer() | 'undefined', used = sets:new() :: sets:set({atom(), arity()}), imported :: sets:set({atom(), arity()}), - vars :: sets:set(atom()), + vars :: sets:set(atom()) | 'undefined', functions :: sets:set({atom(), arity()}), new_forms = [] :: [erl_syntax:syntaxTree()], rename :: dict:dict(mfa(), {atom(), atom()})}). @@ -1064,13 +1064,13 @@ visit_clause(Tree, Env, St0) -> visit_infix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_infix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). visit_prefix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_prefix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index eac5af5540..4557678f9d 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -1594,10 +1594,11 @@ alias_expansions_2(Modules, Table) -> preserved :: boolean(), no_headers :: boolean(), notes :: notes(), - map :: map_fun(), + map :: map_fun() | 'undefined', renaming :: fun((atom()) -> map_fun()), expand :: dict:dict({atom(), integer()}, - {atom(), {atom(), integer()}}), + {atom(), {atom(), integer()}}) + | 'undefined', redirect :: dict:dict(atom(), atom()) }). -- cgit v1.2.3 From 358d162cef263cc7e9d4d072aef259a41835e9d8 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 09:41:31 +0200 Subject: Update Test Server A record field type has been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/test_server/src/test_server_gl.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl index c5ec3ccbe6..31098d9726 100644 --- a/lib/test_server/src/test_server_gl.erl +++ b/lib/test_server/src/test_server_gl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,7 +30,7 @@ -export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). -record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor - tc :: mfa(), %Current test case MFA + tc :: mfa() | 'undefined', %Current test case MFA minor :: 'none'|pid(), %Minor fd minor_monitor, %Monitor ref for minor fd capture :: 'none'|pid(), %Capture output -- cgit v1.2.3 From 1c639b17643da67905717b05d1af66fe6e3b7c37 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 10:12:12 +0200 Subject: Update SSL Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/ssl/src/ssl_connection.hrl | 23 ++++++++++++----------- lib/ssl/src/ssl_internal.hrl | 14 +++++++------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 9a58f2b8f7..bb41ef2b62 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -48,27 +48,28 @@ socket_options :: #socket_options{}, connection_states :: #connection_states{} | secret_printout(), protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hrl - tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout(), - cert_db :: reference(), + tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout() + | 'undefined', + cert_db :: reference() | 'undefined', session :: #session{} | secret_printout(), session_cache :: db_handle(), session_cache_cb :: atom(), crl_db :: term(), - negotiated_version :: ssl_record:ssl_version(), + negotiated_version :: ssl_record:ssl_version() | 'undefined', client_certificate_requested = false :: boolean(), key_algorithm :: ssl_cipher:key_algo(), hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm, - public_key_info :: ssl_handshake:public_key_info(), - private_key :: public_key:private_key() | secret_printout(), + public_key_info :: ssl_handshake:public_key_info() | 'undefined', + private_key :: public_key:private_key() | secret_printout() | 'undefined', diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(), diffie_hellman_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(), - psk_identity :: binary(), % server psk identity hint - srp_params :: #srp_user{} | secret_printout(), - srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout(), - premaster_secret :: binary() | secret_printout() , + psk_identity :: binary() | 'undefined', % server psk identity hint + srp_params :: #srp_user{} | secret_printout() | 'undefined', + srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout() | 'undefined', + premaster_secret :: binary() | secret_printout() | 'undefined', file_ref_db :: db_handle(), - cert_db_ref :: certdb_ref(), + cert_db_ref :: certdb_ref() | 'undefined', bytes_to_read :: undefined | integer(), %% bytes to read in passive mode user_data_buffer :: undefined | binary() | secret_printout(), renegotiation :: undefined | {boolean(), From::term() | internal | peer}, @@ -81,7 +82,7 @@ expecting_finished = false ::boolean(), negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} - tracker :: pid(), %% Tracker process for listen socket + tracker :: pid() | 'undefined', %% Tracker process for listen socket sni_hostname = undefined }). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 3851b2bc6e..007723c982 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -90,16 +90,16 @@ validate_extensions_fun, depth :: integer(), certfile :: binary(), - cert :: public_key:der_encoded() | secret_printout(), + cert :: public_key:der_encoded() | secret_printout() | 'undefined', keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout(), - password :: string() | secret_printout(), - cacerts :: [public_key:der_encoded()] | secret_printout(), + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout() | 'undefined', + password :: string() | secret_printout() | 'undefined', + cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined', cacertfile :: binary(), dh :: public_key:der_encoded() | secret_printout(), - dhfile :: binary() | secret_printout(), + dhfile :: binary() | secret_printout() | 'undefined', user_lookup_fun, % server option, fun to lookup the user - psk_identity :: binary() | secret_printout() , + psk_identity :: binary() | secret_printout() | 'undefined', srp_identity, % client option {User, Password} ciphers, % %% Local policy for the server if it want's to reuse the session @@ -115,7 +115,7 @@ %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: boolean(), + hibernate_after :: boolean() | 'undefined', %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), alpn_advertised_protocols = undefined :: [binary()] | undefined , -- cgit v1.2.3 From 93e1b6fc08c688b03d35a30db4bf3d3c464f330a Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 12:33:40 +0200 Subject: Update Reltool Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/reltool/src/reltool.hrl | 46 ++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 4c3f76bdc6..9ac22b9450 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -141,15 +141,15 @@ app_name :: '_' | app_name(), incl_cond :: '_' | incl_cond() | undefined, debug_info :: '_' | debug_info() | undefined, - is_app_mod :: '_' | boolean(), - is_ebin_mod :: '_' | boolean(), - uses_mods :: '$2' | [mod_name()], - exists :: '_' | boolean(), + is_app_mod :: '_' | boolean() | undefined, + is_ebin_mod :: '_' | boolean() | undefined, + uses_mods :: '$2' | [mod_name()] | undefined, + exists :: '_' | boolean() | undefined, %% Dynamic - status :: '_' | status(), - used_by_mods :: '_' | [mod_name()], - is_pre_included :: '_' | boolean() | undefined, - is_included :: '_' | boolean() | undefined + status = ok :: '_' | status(), + used_by_mods = [] :: '_' | [mod_name()], + is_pre_included :: '_' | boolean() | undefined, + is_included :: '_' | boolean() | undefined }). -record(app_info, @@ -177,10 +177,10 @@ name :: '_' | app_name(), is_escript :: '_' | boolean() | {inlined, escript_app_name()}, use_selected_vsn :: '_' | vsn | dir | undefined, - active_dir :: '_' | dir(), + active_dir :: '_' | dir() | undefined, sorted_dirs :: '_' | [dir()], - vsn :: '_' | app_vsn(), - label :: '_' | app_label(), + vsn :: '_' | app_vsn() | undefined, + label :: '_' | app_label() | undefined, info :: '_' | #app_info{} | undefined, mods :: '_' | [#mod{}], @@ -192,21 +192,21 @@ debug_info :: '_' | debug_info() | undefined, app_file :: '_' | app_file() | undefined, app_type :: '_' | app_type() | undefined, - incl_app_filters :: '_' | [#regexp{}], - excl_app_filters :: '_' | [#regexp{}], - incl_archive_filters :: '_' | [#regexp{}], - excl_archive_filters :: '_' | [#regexp{}], - archive_opts :: '_' | [archive_opt()], + incl_app_filters :: '_' | [#regexp{}] | undefined, + excl_app_filters :: '_' | [#regexp{}] | undefined, + incl_archive_filters :: '_' | [#regexp{}] | undefined, + excl_archive_filters :: '_' | [#regexp{}] | undefined, + archive_opts :: '_' | [archive_opt()] | undefined, %% Dynamic status :: '_' | status(), - uses_mods :: '_' | [mod_name()], - used_by_mods :: '_' | [mod_name()], - uses_apps :: '_' | [app_name()], - used_by_apps :: '_' | [app_name()], + uses_mods :: '_' | [mod_name()] | undefined, + used_by_mods :: '_' | [mod_name()] | undefined, + uses_apps :: '_' | [app_name()] | undefined, + used_by_apps :: '_' | [app_name()] | undefined, is_pre_included :: '_' | '$2' | boolean() | undefined, is_included :: '_' | '$1' | boolean() | undefined, - rels :: '_' | [rel_name()] + rels :: '_' | [rel_name()] | undefined }). -record(rel_app, @@ -237,7 +237,7 @@ rels :: [#rel{}], emu_name :: emu_name(), profile :: profile(), - excl_lib :: excl_lib(), + excl_lib :: excl_lib() | undefined, incl_sys_filters :: [#regexp{}], excl_sys_filters :: [#regexp{}], incl_app_filters :: [#regexp{}], -- cgit v1.2.3 From 18042b7fd5510cfa355cc6ce057ba5b936a7c498 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 12:39:26 +0200 Subject: Update Inets A record field type has been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/inets/src/tftp/tftp_engine.erl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl index d0510e795b..282a97e720 100644 --- a/lib/inets/src/tftp/tftp_engine.erl +++ b/lib/inets/src/tftp/tftp_engine.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -63,7 +63,8 @@ -record(file_info, {peer_req, pid}). -record(sys_misc, {module, function, arguments}). -record(error, {where, code, text, filename}). --record(prepared, {status :: prep_status(), result, block_no, next_data, prev_data}). +-record(prepared, {status :: prep_status() | 'undefined', + result, block_no, next_data, prev_data}). -record(transfer_res, {status, decoded_msg, prepared}). -define(ERROR(Where, Code, Text, Filename), #error{where = Where, code = Code, text = Text, filename = Filename}). -- cgit v1.2.3 From b3bf0e29bb884ff5296fa61012066ae619d531f6 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 12:46:21 +0200 Subject: Update Eunit A record field type has been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/eunit/src/eunit_surefire.erl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index f3e58a3d1c..1b468551d8 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -56,7 +56,11 @@ { name :: chars(), description :: chars(), - result :: ok | {failed, tuple()} | {aborted, tuple()} | {skipped, term()}, + result :: ok + | {failed, tuple()} + | {aborted, tuple()} + | {skipped, term()} + | undefined, time :: integer(), output :: binary() }). -- cgit v1.2.3 From fb18a3f184ac47b07c801b88b9d166ae52ba757d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 29 Sep 2015 14:24:57 +0200 Subject: Update Diameter Record field types have been modified due to commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/diameter/src/base/diameter_peer_fsm.erl | 2 +- lib/diameter/src/base/diameter_service.erl | 2 +- lib/diameter/src/transport/diameter_sctp.erl | 12 +++++++----- lib/diameter/src/transport/diameter_tcp.erl | 2 +- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 2b23183d18..fb874013a3 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -117,7 +117,7 @@ parent :: pid(), %% watchdog process transport :: pid(), %% transport process dictionary :: module(), %% common dictionary - service :: #diameter_service{}, + service :: #diameter_service{} | undefined, dpr = false :: false | true %% DPR received, DPA sent | {boolean(), uint32(), uint32()}, diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 13508321c3..86781c02bf 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -137,7 +137,7 @@ %% Record representing an RFC 3539 watchdog process implemented by %% diameter_watchdog. -record(watchdog, - {pid :: match(pid()), + {pid :: match(pid()) | undefined, type :: match(connect | accept), ref :: match(reference()), %% key into diameter_config options :: match([diameter:transport_opt()]),%% from start_transport diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 678dc9b5d6..8a80ce630a 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -84,16 +84,18 @@ %% Accepting/connecting transport process state. -record(transport, - {parent :: pid(), + {parent :: pid() | undefined, mode :: {accept, pid()} | accept | {connect, {[inet:ip_address()], uint(), list()}} %% {RAs, RP, Errors} | connect, - socket :: gen_sctp:sctp_socket(), + socket :: gen_sctp:sctp_socket() | undefined, assoc_id :: gen_sctp:assoc_id(), %% association identifier - peer :: {[inet:ip_address()], uint()}, %% {RAs, RP} - streams :: {uint(), uint()}, %% {InStream, OutStream} counts + peer :: {[inet:ip_address()], uint()} %% {RAs, RP} + | undefined, + streams :: {uint(), uint()} %% {InStream, OutStream} counts + | undefined, os = 0 :: uint()}). %% next output stream %% Listener process state. @@ -102,7 +104,7 @@ socket :: gen_sctp:sctp_socket(), count = 0 :: uint(), %% attached transport processes pending = {0, queue:new()}, - tref :: reference(), + tref :: reference() | undefined, accept :: [match()]}). %% Field pending implements two queues: the first of transport-to-be %% processes to which an association has been assigned but for which diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 005b2442c0..c79d85820b 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -73,7 +73,7 @@ %% Listener process state. -record(listener, {socket :: inet:socket(), count = 1 :: non_neg_integer(), - tref :: reference()}). + tref :: reference() | undefined}). %% Monitor process state. -record(monitor, -- cgit v1.2.3 From 13c39e40ff18ab1ab5ddeb0a5bde99658e3fab74 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 30 Sep 2015 12:07:23 +0200 Subject: Update Debugger The update was motivated by commit 8ce35b2: "Take out automatic insertion of 'undefined' from typed record fields". --- lib/debugger/src/dbg_wx_win.erl | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 63f74392b5..1ff8818bbe 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -95,10 +95,9 @@ create_menu_item(Menu, [{Name, _N, cascade, Items}|Is], Win, Id0,Connect) -> false -> Acc end end, - Filter = fun(_,_) -> + Filter = fun(Ev,_) -> Enabled = lists:foldl(IsChecked, [], Butts), - Self ! #wx{userData={Name, Enabled}, - event=#wxCommand{type=command_menu_selected}} + Self ! Ev#wx{userData={Name, Enabled}} end, wxMenu:connect(Win, command_menu_selected, [{id,Id0},{lastId, Id-1},{callback,Filter}]), -- cgit v1.2.3 From dfd61c933a5d19c7ff3fd34f9891e864273b9a8e Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 9 Oct 2015 11:40:21 +0200 Subject: Update primary bootstrap --- bootstrap/lib/kernel/ebin/disk_log.beam | Bin 36344 -> 35860 bytes bootstrap/lib/kernel/ebin/global.beam | Bin 32460 -> 32348 bytes bootstrap/lib/kernel/ebin/global_group.beam | Bin 17568 -> 17568 bytes bootstrap/lib/kernel/include/file.hrl | 31 +++++++++++++++------------- bootstrap/lib/stdlib/ebin/edlin.beam | Bin 10136 -> 10196 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 83772 -> 83340 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 23880 -> 23896 bytes bootstrap/lib/stdlib/include/erl_bits.hrl | 10 ++++----- 8 files changed, 22 insertions(+), 19 deletions(-) diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam index ba4c54d72b..3384baedc0 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log.beam and b/bootstrap/lib/kernel/ebin/disk_log.beam differ diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam index 52711457ff..469859fa03 100644 Binary files a/bootstrap/lib/kernel/ebin/global.beam and b/bootstrap/lib/kernel/ebin/global.beam differ diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam index 534d46de2a..1269f7e321 100644 Binary files a/bootstrap/lib/kernel/ebin/global_group.beam and b/bootstrap/lib/kernel/ebin/global_group.beam differ diff --git a/bootstrap/lib/kernel/include/file.hrl b/bootstrap/lib/kernel/include/file.hrl index 7cf033f7f5..36112bb040 100644 --- a/bootstrap/lib/kernel/include/file.hrl +++ b/bootstrap/lib/kernel/include/file.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,37 +23,40 @@ %%-------------------------------------------------------------------------- -record(file_info, - {size :: non_neg_integer(), % Size of file in bytes. - type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink', - access :: 'read' | 'write' | 'read_write' | 'none', - atime :: file:date_time() | non_neg_integer(), + {size :: non_neg_integer() | 'undefined', % Size of file in bytes. + type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink' + | 'undefined', + access :: 'read' | 'write' | 'read_write' | 'none' | 'undefined', + atime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last read: % {{Year, Mon, Day}, {Hour, Min, Sec}}. % atime, ctime, mtime may also be unix epochs() - mtime :: file:date_time() | non_neg_integer(), + mtime :: file:date_time() | non_neg_integer() | 'undefined', % The local time the file was last written. - ctime :: file:date_time() | non_neg_integer(), + ctime :: file:date_time() | non_neg_integer() | 'undefined', % The interpretation of this time field % is dependent on operating system. % On Unix it is the last time the file % or the inode was changed. On Windows, % it is the creation time. - mode :: non_neg_integer(), % File permissions. On Windows, + mode :: non_neg_integer() | 'undefined', + % File permissions. On Windows, % the owner permissions will be % duplicated for group and user. - links :: non_neg_integer(), + links :: non_neg_integer() | 'undefined', % Number of links to the file (1 if the % filesystem doesn't support links). - major_device :: non_neg_integer(), + major_device :: non_neg_integer() | 'undefined', % Identifies the file system (Unix), % or the drive number (A: = 0, B: = 1) % (Windows). %% The following are Unix specific. %% They are set to zero on other operating systems. - minor_device :: non_neg_integer(), % Only valid for devices. - inode :: non_neg_integer(), % Inode number for file. - uid :: non_neg_integer(), % User id for owner. - gid :: non_neg_integer()}). % Group id for owner. + minor_device :: non_neg_integer() | 'undefined', + % Only valid for devices. + inode :: non_neg_integer() | 'undefined', % Inode number for file. + uid :: non_neg_integer() | 'undefined', % User id for owner. + gid :: non_neg_integer() | 'undefined'}). % Group id for owner. -record(file_descriptor, diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam index b1c5af32ba..136c2d5196 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin.beam and b/bootstrap/lib/stdlib/ebin/edlin.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 6abc91b505..aab674f3c8 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index ea3cf38ccd..ed50c91bf7 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/include/erl_bits.hrl b/bootstrap/lib/stdlib/include/erl_bits.hrl index 8405a55d55..2a54587a17 100644 --- a/bootstrap/lib/stdlib/include/erl_bits.hrl +++ b/bootstrap/lib/stdlib/include/erl_bits.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,10 +26,10 @@ -type bt_unit() :: 1..256. -record(bittype, { - type :: bt_type(), - unit :: bt_unit(), %% element unit - sign :: bt_sign(), - endian :: bt_endian() + type :: bt_type() | 'undefined', + unit :: bt_unit() | 'undefined', %% element unit + sign :: bt_sign() | 'undefined', + endian :: bt_endian() | 'undefined' }). -record(bitdefault, { -- cgit v1.2.3 From 76777477d8722b785afa8da0166b4577fb7e047c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 9 Oct 2015 17:18:31 +0200 Subject: erts: Remove vheap mature from process control block Binary vheap mature is not necessary for binary gc. --- erts/emulator/beam/erl_gc.c | 2 -- erts/emulator/beam/erl_process.c | 2 -- erts/emulator/beam/erl_process.h | 2 -- 3 files changed, 6 deletions(-) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 734f120e09..29579f74e6 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -848,7 +848,6 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) if (OLD_HEAP(p) && ((mature <= OLD_HEND(p) - OLD_HTOP(p)) && - ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { ErlMessage *msgp; Uint size_after; @@ -2373,7 +2372,6 @@ sweep_off_heap(Process *p, int fullsweep) } BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p)); MSO(p).overhead = bin_vheap; - BIN_VHEAP_MATURE(p) = bin_vheap; /* * If we got any shrink candidates, check them out. diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 879b523c38..15a6d5d651 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10834,7 +10834,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; p->bin_old_vheap = 0; - p->bin_vheap_mature = 0; p->sys_task_qs = NULL; @@ -11054,7 +11053,6 @@ void erts_init_empty_process(Process *p) p->bin_old_vheap_sz = BIN_VH_MIN_SIZE; p->bin_old_vheap = 0; p->sys_task_qs = NULL; - p->bin_vheap_mature = 0; ERTS_PTMR_INIT(p); p->next = NULL; p->off_heap.first = NULL; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 65422b8c15..e7c5614b9c 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -898,7 +898,6 @@ struct ErtsPendingSuspend_ { # define MIN_VHEAP_SIZE(p) (p)->min_vheap_size # define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz -# define BIN_VHEAP_MATURE(p) (p)->bin_vheap_mature # define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz # define BIN_OLD_VHEAP(p) (p)->bin_old_vheap @@ -1017,7 +1016,6 @@ struct process { ErtsPSD *psd; /* Rarely used process specific data */ Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */ - Uint64 bin_vheap_mature; /* Virtual heap block size for binaries */ Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */ Uint64 bin_old_vheap; /* Virtual old heap size for binaries */ -- cgit v1.2.3 From d8ff1e37c38c37304fb44ba6618da141e4d08c21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 12 Oct 2015 12:21:15 +0200 Subject: Remove the deprecated webtool application --- erts/test/otp_SUITE.erl | 4 +- lib/Makefile | 2 +- lib/sasl/test/systools_SUITE.erl | 5 - lib/tools/Makefile | 2 +- lib/tools/doc/src/cover_chapter.xml | 43 - lib/tools/priv/.gitignore | 0 lib/tools/priv/Makefile | 69 -- lib/tools/priv/cover.tool | 2 - lib/tools/priv/index.html | 10 - lib/tools/src/Makefile | 1 - lib/tools/src/cover.erl | 4 +- lib/tools/src/cover_web.erl | 1185 ----------------------- lib/tools/src/tools.app.src | 5 +- lib/webtool/AUTHORS | 4 - lib/webtool/Makefile | 39 - lib/webtool/doc/html/.gitignore | 0 lib/webtool/doc/man1/.gitignore | 0 lib/webtool/doc/man3/.gitignore | 0 lib/webtool/doc/pdf/.gitignore | 0 lib/webtool/doc/src/Makefile | 132 --- lib/webtool/doc/src/book.xml | 48 - lib/webtool/doc/src/fascicules.xml | 18 - lib/webtool/doc/src/notes.xml | 253 ----- lib/webtool/doc/src/notes_history.xml | 74 -- lib/webtool/doc/src/part.xml | 38 - lib/webtool/doc/src/part_notes.xml | 40 - lib/webtool/doc/src/part_notes_history.xml | 40 - lib/webtool/doc/src/ref_man.xml | 39 - lib/webtool/doc/src/start_webtool.xml | 104 -- lib/webtool/doc/src/webtool.xml | 157 --- lib/webtool/doc/src/webtool_chapter.xml | 246 ----- lib/webtool/ebin/.gitignore | 0 lib/webtool/info | 2 - lib/webtool/priv/Makefile | 82 -- lib/webtool/priv/bin/start_webtool | 3 - lib/webtool/priv/bin/start_webtool.bat | 2 - lib/webtool/priv/root/conf/mime.types | 99 -- lib/webtool/priv/root/doc/index.html | 11 - lib/webtool/priv/root/doc/start_info.html | 28 - lib/webtool/priv/root/doc/tool_management.html | 9 - lib/webtool/src/Makefile | 98 -- lib/webtool/src/webtool.app.src | 28 - lib/webtool/src/webtool.appup.src | 22 - lib/webtool/src/webtool.erl | 1208 ------------------------ lib/webtool/src/webtool_sup.erl | 75 -- lib/webtool/test/Makefile | 65 -- lib/webtool/test/webtool.spec | 1 - lib/webtool/test/webtool_SUITE.erl | 51 - lib/webtool/vsn.mk | 1 - 49 files changed, 7 insertions(+), 4342 deletions(-) create mode 100644 lib/tools/priv/.gitignore delete mode 100644 lib/tools/priv/Makefile delete mode 100644 lib/tools/priv/cover.tool delete mode 100644 lib/tools/priv/index.html delete mode 100644 lib/tools/src/cover_web.erl delete mode 100644 lib/webtool/AUTHORS delete mode 100644 lib/webtool/Makefile delete mode 100644 lib/webtool/doc/html/.gitignore delete mode 100644 lib/webtool/doc/man1/.gitignore delete mode 100644 lib/webtool/doc/man3/.gitignore delete mode 100644 lib/webtool/doc/pdf/.gitignore delete mode 100644 lib/webtool/doc/src/Makefile delete mode 100644 lib/webtool/doc/src/book.xml delete mode 100644 lib/webtool/doc/src/fascicules.xml delete mode 100644 lib/webtool/doc/src/notes.xml delete mode 100644 lib/webtool/doc/src/notes_history.xml delete mode 100644 lib/webtool/doc/src/part.xml delete mode 100644 lib/webtool/doc/src/part_notes.xml delete mode 100644 lib/webtool/doc/src/part_notes_history.xml delete mode 100644 lib/webtool/doc/src/ref_man.xml delete mode 100644 lib/webtool/doc/src/start_webtool.xml delete mode 100644 lib/webtool/doc/src/webtool.xml delete mode 100644 lib/webtool/doc/src/webtool_chapter.xml delete mode 100644 lib/webtool/ebin/.gitignore delete mode 100644 lib/webtool/info delete mode 100644 lib/webtool/priv/Makefile delete mode 100755 lib/webtool/priv/bin/start_webtool delete mode 100644 lib/webtool/priv/bin/start_webtool.bat delete mode 100644 lib/webtool/priv/root/conf/mime.types delete mode 100644 lib/webtool/priv/root/doc/index.html delete mode 100644 lib/webtool/priv/root/doc/start_info.html delete mode 100644 lib/webtool/priv/root/doc/tool_management.html delete mode 100644 lib/webtool/src/Makefile delete mode 100644 lib/webtool/src/webtool.app.src delete mode 100644 lib/webtool/src/webtool.appup.src delete mode 100644 lib/webtool/src/webtool.erl delete mode 100644 lib/webtool/src/webtool_sup.erl delete mode 100644 lib/webtool/test/Makefile delete mode 100644 lib/webtool/test/webtool.spec delete mode 100644 lib/webtool/test/webtool_SUITE.erl delete mode 100644 lib/webtool/vsn.mk diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index c92a7cf6f7..87d620b180 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -290,7 +290,7 @@ call_to_deprecated(Config) when is_list(Config) -> call_to_size_1(Config) when is_list(Config) -> %% Applications that do not call erlang:size/1: Apps = [asn1,compiler,debugger,kernel,observer,parsetools, - runtime_tools,stdlib,tools,webtool], + runtime_tools,stdlib,tools], not_recommended_calls(Config, Apps, {erlang,size,1}). call_to_now_0(Config) when is_list(Config) -> @@ -298,7 +298,7 @@ call_to_now_0(Config) when is_list(Config) -> Apps = [asn1,common_test,compiler,debugger,dialyzer, gs,kernel,mnesia,observer,parsetools,reltool, runtime_tools,sasl,stdlib,syntax_tools, - test_server,tools,webtool], + test_server,tools], not_recommended_calls(Config, Apps, {erlang,now,0}). not_recommended_calls(Config, Apps0, MFA) -> diff --git a/lib/Makefile b/lib/Makefile index 64143a39e0..863b9abac6 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -35,7 +35,7 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ ic mnesia crypto orber os_mon syntax_tools \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ - cosProperty cosFileTransfer cosEventDomain et megaco webtool \ + cosProperty cosFileTransfer cosEventDomain et megaco \ eunit ssh typer percept eldap dialyzer hipe ifdef BUILD_ALL diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index cf0ed5fcfc..825a7f6e86 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1640,25 +1640,21 @@ app_start_type_relup(Dir2,Name2,Config) -> %% ?t:format("Dn: ~p",[DownInstructions]), [{load_object_code, {mnesia, _, _}}, {load_object_code, {runtime_tools, _, _}}, - {load_object_code, {webtool, _, _}}, {load_object_code, {snmp, _, _}}, {load_object_code, {xmerl, _, _}}, point_of_no_return | UpInstructionsT] = UpInstructions, true = lists:member({apply,{application,start,[mnesia,permanent]}}, UpInstructionsT), true = lists:member({apply,{application,start,[runtime_tools,transient]}}, UpInstructionsT), - true = lists:member({apply,{application,start,[webtool,temporary]}}, UpInstructionsT), true = lists:member({apply,{application,load,[snmp]}}, UpInstructionsT), false = lists:any(fun({apply,{application,_,[xmerl|_]}}) -> true; (_) -> false end, UpInstructionsT), [point_of_no_return | DownInstructionsT] = DownInstructions, true = lists:member({apply,{application,stop,[mnesia]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[runtime_tools]}}, DownInstructionsT), - true = lists:member({apply,{application,stop,[webtool]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[snmp]}}, DownInstructionsT), true = lists:member({apply,{application,stop,[xmerl]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[mnesia]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[runtime_tools]}}, DownInstructionsT), - true = lists:member({apply,{application,unload,[webtool]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[snmp]}}, DownInstructionsT), true = lists:member({apply,{application,unload,[xmerl]}}, DownInstructionsT), ok. @@ -2207,7 +2203,6 @@ create_script(latest_app_start_type1,Config) -> create_script(latest_app_start_type2,Config) -> OtherApps = [{mnesia,current,permanent}, {runtime_tools,current,transient}, - {webtool,current,temporary}, {snmp,current,load}, {xmerl,current,none}], Apps = core_apps(current) ++ OtherApps, diff --git a/lib/tools/Makefile b/lib/tools/Makefile index 2699ffab51..fef33743c0 100644 --- a/lib/tools/Makefile +++ b/lib/tools/Makefile @@ -24,7 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # ---------------------------------------------------- -SUB_DIRECTORIES = c_src src doc/src examples priv emacs +SUB_DIRECTORIES = c_src src doc/src examples emacs include vsn.mk VSN = $(TOOLS_VSN) diff --git a/lib/tools/doc/src/cover_chapter.xml b/lib/tools/doc/src/cover_chapter.xml index 2f7f8d8083..c3f1570477 100644 --- a/lib/tools/doc/src/cover_chapter.xml +++ b/lib/tools/doc/src/cover_chapter.xml @@ -451,48 +451,5 @@ ok

When Cover is stopped, all Cover compiled modules are unloaded.

- -
- Using the Web Based User Interface to Cover - -
- Introduction -

To ease the use of Cover there is a web based user interface - to Cover called WebCover. WebCover is designed to be started - and used via WebTool. It is possible to Cover compile Erlang - modules and to generate printable Cover and Call analyses via - the web based user interface.

-
- -
- Start the Web Based User Interface to Cover -

To start WebCover you can either start WebTool, point a - browser to the start page of WebTool and start WebCover from - there, or you can use the start_webtool script to start - Webtool, WebCover and a browser. See WebTool documentation for - further information.

-

Currently WebCover is only compatible - with Internet Explorer and Netscape Navigator 4.0 and higher.

-
- -
- Navigating WebCover -

From the menu in the lefthand frame you can select the - Nodes, Compile, Import or Result - page.

-

From the Nodes page you can add remote nodes to - participate in the coverage analysis. Coverage data from all - involved nodes will then be merged during analysis.

-

From the Compile page you can Cover compile .erl - or .beam files.

-

From the Import page you can import coverage data from - a previous analysis. Imported data will then be merged with - the current coverage data. Note that it is only possible to - import files with the extension .coverdata.

-

From the Result page you can analyse, reset or export - coverage data.

-

Please follow the instructions on each page.

-
-
diff --git a/lib/tools/priv/.gitignore b/lib/tools/priv/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/tools/priv/Makefile b/lib/tools/priv/Makefile deleted file mode 100644 index aa4aaa2fc8..0000000000 --- a/lib/tools/priv/Makefile +++ /dev/null @@ -1,69 +0,0 @@ -# ``Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN = $(TOOLS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -HTDOCS_FILES = index.html - -TOOL_FILES = cover.tool - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(TOOL_FILES) "$(RELSYSDIR)/priv" - -release_docs_spec: - - - diff --git a/lib/tools/priv/cover.tool b/lib/tools/priv/cover.tool deleted file mode 100644 index 9e72f89ff4..0000000000 --- a/lib/tools/priv/cover.tool +++ /dev/null @@ -1,2 +0,0 @@ -{version,"1.2"}. -[{config_func,{cover_web,configData,[]}}]. diff --git a/lib/tools/priv/index.html b/lib/tools/priv/index.html deleted file mode 100644 index 6b60ef5d0a..0000000000 --- a/lib/tools/priv/index.html +++ /dev/null @@ -1,10 +0,0 @@ - - -Erlang webb tools - - - - - - - diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile index 9fcfb79628..7301ff856a 100644 --- a/lib/tools/src/Makefile +++ b/lib/tools/src/Makefile @@ -37,7 +37,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/tools-$(VSN) MODULES= \ cover \ - cover_web \ eprof \ fprof \ cprof \ diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 366d6bcbd9..1d7d112c06 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -20,9 +20,7 @@ -module(cover). %% -%% This module implements the Erlang coverage tool. The module named -%% cover_web implements a user interface for the coverage tool to run -%% under webtool. +%% This module implements the Erlang coverage tool. %% %% ARCHITECTURE %% The coverage tool consists of one process on each node involved in diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl deleted file mode 100644 index ae8b3f25cf..0000000000 --- a/lib/tools/src/cover_web.erl +++ /dev/null @@ -1,1185 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(cover_web). --author('marting@erix.ericsson.se'). --behaviour(gen_server). - -%%Export of configuration function --export([configData/0]). -%% External exports --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --export([start_link/0,start/0,stop/0]). --export([menu_frame/2,nodes_frame/2,import_frame/2, - compile_frame/2,result_frame/2]). --export([list_dir/2,compile/2,add_node/2,remove_node/2,result/2, - calls/2,coverage/2,import/2]). - --record(state,{dir}). - --include_lib("kernel/include/file.hrl"). - -%% Timeouts --define(DEFAULT_TIME,10000). --define(MAX_COMPILE_TIME,60000). --define(MAX_ANALYSE_TIME,30000). - -%% Colors --define(INFO_BG_COLOR,"#C0C0EA"). - -%%%---------------------------------------------------------------------- -%%% API - called from erlang shell -%%%---------------------------------------------------------------------- -%% Start webtool and webcover from erlang shell -start() -> - webtool:start(), - webtool:start_tools([],"app=webcover"), - ok. - -%% Stop webtool and webcover from erlang shell -stop() -> - webtool:stop_tools([],"app=webcover"), - webtool:stop(). - - - -%%%---------------------------------------------------------------------- -%%% API - called from webtool -%%%---------------------------------------------------------------------- -start_link() -> - gen_server:start_link({local, webcover_server},cover_web, [], []). - - -nodes_frame(Env,Input)-> - call({nodes_frame,Env,Input}). - -add_node(Env,Input)-> - call({add_node,Env,Input}). - -remove_node(Env,Input)-> - call({remove_node,Env,Input}). - -compile_frame(Env,Input)-> - call({compile_frame,Env,Input}). - -list_dir(Env,Input) -> - call({list_dir,Env,Input}). - -compile(Env,Input)-> - call({compile,Env,Input},?MAX_COMPILE_TIME). - -result_frame(Env,Input)-> - call({result_frame,Env,Input}). - -result(Env,Input) -> - call({result,Env,Input},?MAX_ANALYSE_TIME). - -calls(Env,Input) -> - call({calls,Env,Input}). - -coverage(Env,Input) -> - call({coverage,Env,Input}). - -import_frame(Env,Input)-> - call({import_frame,Env,Input}). - -import(Env,Input)-> - call({import,Env,Input}). - -menu_frame(Env,Input)-> - call({menu_frame,Env,Input}). - -call(Msg) -> - call(Msg,?DEFAULT_TIME). -call(Msg,Time) -> - gen_server:call(webcover_server,Msg,Time). - - - -configData()-> - {webcover,[{web_data,{"WebCover","/webcover"}}, - {alias,{"/webcover",code:priv_dir(tools)}}, - {alias,{erl_alias,"/webcover/erl",[cover_web]}}, - {start,{child,{{local,webcover_server}, - {cover_web,start_link,[]}, - permanent,100,worker,[cover_web]}}} - ]}. - - -%%%---------------------------------------------------------------------- -%%% Callback functions from gen_server -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, State} | -%% {ok, State, Timeout} | -%% ignore | -%% {stop, Reason} -%%---------------------------------------------------------------------- -init([]) -> - cover:start(), - CS = whereis(cover_server), - link(CS), - GL = spawn_link(fun group_leader_proc/0), - group_leader(GL,CS), - - %% Must trap exists in order to have terminate/2 executed when - %% crashing because of a linked process crash. - process_flag(trap_exit,true), - {ok,Cwd} = file:get_cwd(), - {ok, #state{dir=Cwd}}. - -group_leader_proc() -> - register(cover_group_leader_proc,self()), - group_leader_loop([]). -group_leader_loop(Warnings) -> - receive - {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> group_leader_loop(Warnings); - false -> group_leader_loop([Msg|Warnings]) - end; - {io_request,From,ReplyAs,{put_chars,_Encoding,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> group_leader_loop(Warnings); - false -> group_leader_loop([Msg|Warnings]) - end; - IoReq when element(1,IoReq)=:= io_request -> - group_leader() ! IoReq, - group_leader_loop(Warnings); - {From,get_warnings} -> - Warnings1 = - receive - {io_request,From,ReplyAs, - {put_chars,io_lib,Func,[Format,Args]}} -> - Msg = (catch io_lib:Func(Format,Args)), - From ! {io_reply,ReplyAs,ok}, - case lists:member(Msg,Warnings) of - true -> Warnings; - false -> [Msg|Warnings] - end - after 0 -> - Warnings - end, - From ! {warnings,Warnings1}, - group_leader_loop([]) - end. - -%%---------------------------------------------------------------------- -%% Func: handle_call/3 -%% Returns: {reply, Reply, State} | -%% {reply, Reply, State, Timeout} | -%% {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, Reply, State} | (terminate/2 is called) -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_call({nodes_frame,_Env,_Input},_From,State)-> - {reply,nodes_frame1(),State}; - -handle_call({add_node,_Env,Input},_From,State)-> - {reply,do_add_node(Input),State}; - -handle_call({remove_node,_Env,Input},_From,State)-> - {reply,do_remove_node(Input),State}; - -handle_call({compile_frame,_Env,_Input},_From,State)-> - {reply,compile_frame1(State#state.dir),State}; - -handle_call({list_dir,_Env,Input},_From,State)-> - Dir = get_input_data(Input,"path"), - case filelib:is_dir(Dir) of - true -> - {reply,compile_frame1(Dir),State#state{dir=Dir}}; - false -> - Err = Dir ++ " is not a directory", - {reply,compile_frame1(State#state.dir,Err),State} - end; -handle_call({compile,_Env,Input},_From,State)-> - {reply,do_compile(Input,State#state.dir),State}; - -handle_call({result_frame,_Env,_Input},_From,State)-> - {reply,result_frame1(),State}; - -handle_call({result,_Env,Input},_From,State)-> - {reply,handle_result(Input),State}; - -handle_call({calls,_Env,Input},_From,State)-> - {reply,call_page(Input),State}; - -handle_call({coverage,_Env,Input},_From,State)-> - {reply,coverage_page(Input),State}; - -handle_call({import_frame,_Env,_Input},_From,State)-> - {ok,Cwd} = file:get_cwd(), - {reply,import_frame1(Cwd),State}; - -handle_call({import,_Env,Input},_From,State)-> - {reply,do_import(Input),State}; - -handle_call({menu_frame,_Env,_Input},_From,State)-> - {reply,menu_frame1(),State}; - -handle_call(_Request, _From, State) -> - Reply = bad_request, - {reply, Reply, State}. - - -%%---------------------------------------------------------------------- -%% Func: handle_cast/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_cast(_Msg, State) -> - {noreply, State}. - -%%---------------------------------------------------------------------- -%% Func: handle_info/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%---------------------------------------------------------------------- -handle_info({'EXIT',_Pid,Reason}, State) -> - {stop, Reason, State}. - -%%---------------------------------------------------------------------- -%% Func: terminate/2 -%% Purpose: Shutdown the server -%% Returns: any (ignored by gen_server) -%%---------------------------------------------------------------------- -terminate(_Reason, _State) -> - cover:stop(), - ok. - -%%-------------------------------------------------------------------- -%% Func: code_change/3 -%% Purpose: Convert process state when code is changed -%% Returns: {ok, NewState} -%%-------------------------------------------------------------------- -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that creates the whole pages by collecting all the %% -%% neccessary data for each page. These functions are the public %% -%% interface. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%---------------------------------------------------------------------- -%% Returns the page to the left frame -%%---------------------------------------------------------------------- -menu_frame1()-> - [header(),html_header(""),menu_body(),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can add and remove nodes -%%---------------------------------------------------------------------- - -nodes_frame1()-> - nodes_frame1([]). -nodes_frame1(Err)-> - [header(),html_header("Add/remove nodes"),nodes_body(Err),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can cover compile modules -%%---------------------------------------------------------------------- - -compile_frame1(Dir)-> - compile_frame1(Dir,[]). -compile_frame1(Dir,Err) -> - [header(),html_header("Cover compile"),compile_body(Dir,Err),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user can handle results -%%---------------------------------------------------------------------- - -result_frame1()-> - result_frame1([]). -result_frame1(Err) -> - [header(),html_header("Show cover results"),result_body(Err),html_end()]. - -%%---------------------------------------------------------------------- -%%The beginning of the page that clear the cover information on a cover -%%compiled module -%%---------------------------------------------------------------------- -call_page(Input)-> - [header(),html_header("Code coverage"),call_result(Input),html_end()]. - -coverage_page(Input)-> - [header(),html_header("Code coverage"),coverage_result(Input),html_end()]. - -%%---------------------------------------------------------------------- -%% Creates the page where the user an import files -%%---------------------------------------------------------------------- -import_frame1(Dir) -> - import_frame1(Dir,""). -import_frame1(Dir,Err) -> - [header(),html_header("Import coverdata"),import_body(Dir,Err),html_end()]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that build the body of the menu frame %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -menu_body() -> - Nodes = cover:which_nodes(), - Modules = cover:modules(), - Imported = cover:imported(), - ["Nodes
\n", - "Compile
\n", - "Import
\n", - "Result\n", - "

Nodes:\n", - "

    \n", - lists:map(fun(N) -> "
  • "++atom_to_list(N)++"
    • \n" end,[node()|Nodes]), - "
\n", - "

Compiled modules:\n", - "

    \n", - lists:map(fun(M) -> "
  • "++atom_to_list(M)++"
    • \n" end,Modules), - "
\n", - "

Imported files:\n", - "

    \n", - "\n", - lists:map(fun(F) -> - Short = filename:basename(F), - "
  • "++Short++"
    • \n" end,Imported), - "    \n", - "
\n"]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that build the body of the nodes frame %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -nodes_body(Err) -> - CN = cover:which_nodes(), - Fun = fun(N) -> - NStr = atom_to_list(N), - ["\n"] - end, - AllNodes = lists:append(lists:map(Fun,nodes()--CN)), - CoverNodes = lists:append(lists:map(Fun,CN)), - - [reload_menu_script(Err), - "

Nodes

\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n" - "\n", - "\n", - "\n", - "\n", - "\n", - "", - "
\n", - "

You can run cover over several nodes simultaneously. Coverage data\n", - "from all involved nodes will be merged during analysis.\n", - "

Select or enter node names to add or remove here.\n", - "



Add node:", - "" - "
\n", - "


Remove node:\n", - "" - "
"]. - - -do_add_node(Input) -> - NodeStr = get_input_data(Input, "node"), - Node = list_to_atom(NodeStr), - case net_adm:ping(Node) of - pong -> - cover:start(Node), - nodes_frame1(); - pang -> - nodes_frame1("Node \\\'" ++ NodeStr ++ "\\\' is not alive") - end. - -do_remove_node(Input) -> - Node = list_to_atom(get_input_data(Input, "node")), - cover:stop(Node), - nodes_frame1(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that is used when the user wants to compile something % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -compile_body(Dir,Err) -> - Erls = filelib:wildcard(filename:join(Dir,"*.erl")), - Beams = filelib:wildcard(filename:join(Dir,"*.beam")), - - [reload_menu_script(Err), - "

Compile

\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n" - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
\n", - "Each module which shall be part of the cover analysis must be prepared\n", - "or 'cover compiled'. On this page you can select .erl files and/or\n", - ".beam files to include in the analysis. If you select a .erl file it\n", - "will first be compiled with the Erlang compiler and then prepared for\n", - "coverage analysis. If you select a .beam file it will be prepared for\n", - "coverage analysis directly.\n", - "
\n", - "To list a different directory, enter the directory name here.\n", - "
List directory:
\n", - "", - "", - "

\n", - "

Select one or more .erl or .beam files to prepare for coverage\n" - "analysis, and click the \"Compile\" button.\n", - "

To reload the original file after coverage analysis is complete,\n" - "select one or more files and click the \"Uncompile\" button, or\n", - "simply click the \"Uncompile all\" button to reload all originals.\n" - "

.erl files.beam files
\n", - "\n", - "
\n", - "Compile options are only needed for .erl files. The options must be\n" - "given e.g. like this: \n" - "[{i,\"/my/path/include\"},{i,\"/other/path/\"}]\n" - "
Compile options:
\n", - "\n", - "
\n", - "", - "", - "", - "
\n"]. - -list_modules([File|Files]) -> - Mod = filename:basename(File), - ["\n" | list_modules(Files)]; -list_modules([]) -> - []. - -do_compile(Input,Dir) -> - {Erls,Beams,Opts,Action} = get_compile_input(parse(Input),[],[]), - Errs = - case Action of - "compile" -> - do_compile(Erls,Beams,Opts,[]); - "uncompile" -> - do_uncompile(Erls++Beams); - "uncompile_all" -> - do_uncompile(cover:modules()) - end, - compile_frame1(Dir,Errs). - -get_compile_input([{"erl",File}|Input],Erl,Beam) -> - get_compile_input(Input,[File|Erl],Beam); -get_compile_input([{"beam",File}|Input],Erl,Beam) -> - get_compile_input(Input,Erl,[File|Beam]); -get_compile_input([{"options",Opts0},{"action",Action}],Erl,Beam) -> - Opts = parse_options(Opts0), - {Erl,Beam,Opts,Action}. - -do_compile([Erl|Erls],Beams,Opts,Errs) -> - case cover:compile_module(Erl,Opts) of - {ok,_} -> - do_compile(Erls,Beams,Opts,Errs); - {error,File} -> - do_compile(Erls,Beams,Opts,["\\n"++File|Errs]) - end; -do_compile([],[Beam|Beams],Opts,Errs) -> - case cover:compile_beam(Beam) of - {ok,_} -> - do_compile([],Beams,Opts,Errs); - {error,{no_abstract_code,File}} -> - do_compile([],Beams,Opts,["\\n"++File++" (no_abstract_code)"|Errs]) - end; -do_compile([],[],_,[]) -> - []; -do_compile([],[],_,Errs) -> - "Compilation failed for the following files:" ++ Errs. - -parse_options(Options)-> - case erl_scan:string(Options ++".") of - {ok,Tokens,_Line} -> - case erl_parse:parse_exprs(Tokens) of - {ok,X}-> - case lists:map(fun erl_parse:normalise/1, X) of - [List] when is_list(List) -> List; - List -> List - end; - _ -> - [] - end; - _ -> - [] - end. - - -do_uncompile(Files) -> - lists:foreach( - fun(File) -> - Module = - if is_atom(File) -> - File; - true -> - ModStr = filename:basename(filename:rootname(File)), - list_to_atom(ModStr) - end, - case code:which(Module) of - cover_compiled -> - code:purge(Module), - case code:load_file(Module) of - {module, Module} -> - ok; - {error, _Reason2} -> - code:delete(Module) - end; - _ -> - ok - end - end, - Files), - []. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page for coverage analysis% -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -result_body(Err) -> - [reload_menu_script(Err), - "

Result

\n", - "\n", - "\n", - "
\n", - "

After executing all your tests you can view the result of the\n", - "coverage analysis here. For each module you can\n", - "

\n", - "
Analyse to file
\n", - "
The source code of the module is shown with the number of calls\n", - "to each line stated in the left margin. Lines which are never called\n", - "are colored red.
\n", - "
Analyse coverage
\n", - "
Show the number of covered and uncovered lines in the module.
\n", - "
Analyse calls
\n", - "
Show the number of calls in the module.
\n", - "
Reset module
\n", - "
Delete all coverage data for the module.
\n", - "
Export module
\n", - "
Write all coverage data for the module to a file. The data can\n", - "later be imported from the \"Import\" page.
\n", - "
\n", - "

You can also reset or export data for all modules with the\n", - "Reset all and Export all actions respectively. For these\n", - "two actions there is no need to select a module.\n", - "

Select module and action from the drop down menus below, and click\n", - "the \"Execute\" button.\n", - "



\n", - result_selections(), - "
"]. - -result_selections() -> - ModList = filter_modlist(cover:modules()++cover:imported_modules(),[]), - - ["
\n", - "\n", - "\n", - "\n", - "\n" - "
\n", - "Module:\n", - "
\n", - "		\n", - "Action:\n", - "
\n", - "		\n" - "
\n", - "
\n"]. - -filter_modlist([M|Ms],Already) -> - case lists:member(M,Already) of - true -> - filter_modlist(Ms,Already); - false -> - MStr = atom_to_list(M), - ["\n" | - filter_modlist(Ms,[M|Already])] - end; -filter_modlist([],_Already) -> - []. - - - -handle_result(Input) -> - case parse(Input) of - [{"module",M},{"action",A}] -> - case A of - "analyse_to_file" -> - case cover:analyse_to_file(list_to_atom(M),[html]) of - {ok,File} -> - case file:read_file(File) of - {ok,HTML}-> - file:delete(File), - [header(), - reload_menu_script(""), - binary_to_list(HTML)]; - _ -> - result_frame1("Can not read file" ++ File) - end; - {error,no_source_code_found} -> - result_frame1("No source code found for \\\'" ++ - M ++ "\\\'") - end; - "calls" -> - call_page(Input); - "coverage" -> - coverage_page(Input); - "reset" -> - cover:reset(list_to_atom(M)), - result_frame1("Coverage data for \\\'" ++ M ++ - "\\\' is now reset"); - "reset_all" -> - cover:reset(), - result_frame1("All coverage data is now reset"); - "export" -> - ExportFile = generate_filename(M), - cover:export(ExportFile,list_to_atom(M)), - result_frame1("Coverage data for \\\'" ++ M ++ - "\\\' is now exported to file \\\"" ++ - ExportFile ++ "\\\""); - "export_all" -> - ExportFile = generate_filename("COVER"), - cover:export(ExportFile), - result_frame1( - "All coverage data is now exported to file \\\"" ++ - ExportFile ++ "\\\"") - end; - [{"action",_A}] -> - result_frame1("No module is selected") - end. - -generate_filename(Prefix) -> - {ok,Cwd} = file:get_cwd(), - filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata"). - -ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), - io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", - [Y,M,D,H,Min,S]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page that shows the calls % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -call_result(Input)-> - Mod = list_to_atom(get_input_data(Input, "module")), - case cover:analyse(Mod,calls) of - {error,_}-> - error_body(); - {ok,_} -> - call_result2(Mod,Input) - end. - -call_result2(Mod,Input)-> - Result = - case get_input_data(Input,"what") of - "mod" -> - call_result(mod,Mod); - "func" -> - call_result(func,Mod); - "clause" -> - call_result(clause,Mod); - _-> - call_result(all,Mod) - end, - result_choice("calls",Mod) ++ Result. - -result_choice(Level,Mod)-> - ModStr=atom_to_list(Mod), - [reload_menu_script(""), - "\n", - "\n", - "\n", - "\n", - "\n", - "
All DataModuleFunctionClause

\n"]. - -call_result(Mode,Module)-> - Content = - case Mode of - mod-> - format_cover_call(cover:analyse(Module,calls,module),mod); - func-> - format_cover_call(cover:analyse(Module,calls,function),func); - clause-> - format_cover_call(cover:analyse(Module,calls,clause),clause); - _-> - format_cover_call(cover:analyse(Module,calls,module),mod) ++ - format_cover_call(cover:analyse(Module,calls,function),func)++ - format_cover_call(cover:analyse(Module,calls,clause),clause) - end, - getModDate(Module,date())++"
"++ - "" - ++ Content ++"
". - - -format_cover_call({error,_},_)-> - ["\n", - "



\n", - "The selected module is not Cover Compiled\n", - "
\n", - "\n"]; - -format_cover_call({ok,{Mod,Calls}},mod)-> - ["Module calls\n", - "Module", - "Number of calls\n", - "" ++ atom_to_list(Mod) ++"" - "" ++ integer_to_list(Calls)++"\n"]; - -format_cover_call({ok,Calls},func)-> - ["Function calls\n", - "ModuleFunction", - "Arity", - "Number of calls \n", - lists:append( - lists:map( - fun({{Mod,Func,Arity},Nr_of_calls})-> - [""++ atom_to_list(Mod)++"\n", - "" ++ atom_to_list(Func) ++" \n", - "", - integer_to_list(Arity), - "\n", - "", - integer_to_list(Nr_of_calls), - "\n"] - end, - Calls))]; - -format_cover_call({ok,Calls},clause)-> - ["Clause calls\n", - "ModuleFunction", - "Arity", - "Ordinal", - "Number of calls\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity,Ord},Nr_of_calls})-> - ["", atom_to_list(Mod), "\n", - "", atom_to_list(Func), "\n", - "", - integer_to_list(Arity), - "\n", - "", - integer_to_list(Ord), - "\n", - "", - integer_to_list(Nr_of_calls), - "\n"] - end, - Calls))]. - - -error_body()-> - ["\n", - "\n", - "\n", - "\n", - "
\n", - "





\n", - "The selected module is not Cover Compiled\n", - "
\n", - "
\n"]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the page that shows coverage % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -coverage_result(Input)-> - Mod = list_to_atom(get_input_data(Input, "module")), - case cover:analyse(Mod,coverage) of - {error,_}-> - error_body(); - {ok,_} -> - coverage_result2(Mod,Input) - end. - -coverage_result2(Mod,Input)-> - Result = - case get_input_data(Input,"what") of - "mod" -> - coverage_result(mod,Mod); - "func" -> - coverage_result(func,Mod); - "clause" -> - coverage_result(clause,Mod); - _-> - coverage_result(all,Mod) - end, - result_choice("coverage",Mod) ++ Result. - -coverage_result(Mode,Module)-> - Content = - case Mode of - mod-> - format_cover_coverage(cover:analyse(Module,coverage,module), - mod); - func-> - format_cover_coverage(cover:analyse(Module,coverage,function), - func); - clause-> - format_cover_coverage(cover:analyse(Module,coverage,clause), - clause); - _-> - format_cover_coverage(cover:analyse(Module,coverage,module), - mod) ++ - format_cover_coverage(cover:analyse(Module,coverage,function), - func)++ - format_cover_coverage(cover:analyse(Module,coverage,clause), - clause) - end, - getModDate(Module,date())++"
"++ - "" - ++ Content ++"
". - -getModDate(Module,{Year,Mon,Day})-> - " - - - - - - - - -
Module:" ++ atom_to_list(Module) ++ "
Date:" ++ integer_to_list(Day) ++ "/" ++ - integer_to_list(Mon) ++" - "++ - integer_to_list(Year) ++ - "
". - - -format_cover_coverage({error,_},_)-> - " -



- The selected module is not Cover Compiled -
- "; - - -format_cover_coverage({ok,{Mod,{Cov,Not_cov}}},mod)-> - ["Module coverage\n", - "Module\n", - "Covered\n" - "Not Covered\n", - "\n", - "", atom_to_list(Mod), "\n" - "", integer_to_list(Cov), "\n" - "", integer_to_list(Not_cov), "\n"]; - -format_cover_coverage({ok,Cov_res},func)-> - ["Function coverage\n", - "\n", - "ModuleFunction", - "Arity", - "Covered", - "Not Covered", - "\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity},{Cov,Not_cov}})-> - [""++ atom_to_list(Mod) ++" \n", - "" ++ atom_to_list(Func) ++"\n", - "", - integer_to_list(Arity), - "\n", - "", - integer_to_list(Cov), - "\n" - "", - integer_to_list(Not_cov), - "\n"] - end, - Cov_res))]; - -format_cover_coverage({ok,Cov_res},clause)-> - ["Clause coverage\n", - "ModuleFunction\n", - "Arity\n", - "Ordinal\n", - "Covered\n", - "Not Covered\n", - lists:append( - lists:map( - fun({{Mod,Func,Arity,Ord},{Cov,Not_cov}})-> - [""++ atom_to_list(Mod) ++"\n", - "" ++ atom_to_list(Func) ++" \n", - "", - integer_to_list(Arity), - "\n" - "", - integer_to_list(Ord), - "\n" - "", - integer_to_list(Cov), - "\n" - "", - integer_to_list(Not_cov), - "\n"] - end, - Cov_res))]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% The functions that builds the body of the import page % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -import_body(Dir,Err) -> - [reload_menu_script(Err), - "

Import

\n", - "\n", - "\n", - "
\n", - "

You can import coverage data from a previous analysis. If you do so\n", - "the imported data will be merged with the current coverage data.\n", - "

You can export data from the current analysis from the \"Result\"\n", - "page.\n", - "

Select the file to import here.\n", - "



\n", - "
\n", - "Change directory:
\n", - "", - "\n", - "
\n", - "
\n", - browse_import(Dir), - "
"]. - -browse_import(Dir) -> - {ok,List} = file:list_dir(Dir), - Sorted = lists:reverse(lists:sort(List)), - {Dirs,Files} = filter_files(Dir,Sorted,[],[]), - ["
\n" - "\n", - "\n", - "
\n" - "
\n"]. - -filter_files(Dir,[File|Files],Ds,Fs) -> - case filename:extension(File) of - ".coverdata" -> - Fs1 = ["\n" | Fs], - filter_files(Dir,Files,Ds,Fs1); - _ -> - FullName = filename:join(Dir,File), - case filelib:is_dir(FullName) of - true -> - Ds1 = ["\n" | Ds], - filter_files(Dir,Files,Ds1,Fs); - false -> - filter_files(Dir,Files,Ds,Fs) - end - end; -filter_files(_Dir,[],Ds,Fs) -> - {Ds,Fs}. - - - - -do_import(Input) -> - case parse(Input) of - [{"file",File0},{"dir",Dir}] -> - File = filename:join(Dir,File0), - case filelib:is_dir(File) of - true -> - import_frame1(File); - false -> - case filelib:is_file(File) of - true -> - case cover:import(File) of - ok -> - import_frame1(Dir); - {error,{cant_open_file,ExportFile,_Reason}} -> - import_frame1(Dir, - "Error importing file\\n\\\"" - ++ ExportFile ++ "\\\"") - end; - false -> - import_frame1(Dir, - "Error importing file\\n\\\"" ++ - File ++ "\\\"") - end - end; - [{"dir",Dir}] -> - import_frame1(Dir,"No file is selected") - end. - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% Different private helper functions % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%Create the Header for the page If we now the mimetype use that type %% -%%otherwise use text %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -header() -> - header("text/html"). -header(MimeType) -> - "Pragma:no-cache\r\n" ++ - "Content-type: " ++ MimeType ++ "\r\n\r\n". - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%Create the Htmlheader set the title of the page %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -html_header(Title) -> - "\n" ++ - "\n" ++ - "" ++ Title ++ "\n" ++ - "\n" - "\n". - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Close the body- and Html tags %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -html_end()-> - "". - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% A script which reloads the menu frame and possibly pops up an alert%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -reload_menu_script(Err) -> - ["\n", - ""]. - -fix_newline([$\n|Rest]) -> - [$\\,$n|fix_newline(Rest)]; -fix_newline([$"|Rest]) -> - [$\\,$"|fix_newline(Rest)]; -fix_newline([Char|Rest]) -> - [Char|fix_newline(Rest)]; -fix_newline([]) -> - []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Control the input data and return the intresting values or error % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_input_data(Input,Key)-> - case lists:keysearch(Key,1,parse(Input)) of - {value,{Key,Value}} -> - Value; - false -> - undefined - end. - -parse(Input) -> - httpd:parse_query(Input). - - -get_warnings() -> - cover_group_leader_proc ! {self(), get_warnings}, - receive {warnings,Warnings} -> - Warnings - end. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index 978b54719c..a00969eabe 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -21,7 +21,6 @@ [{description, "DEVTOOLS CXC 138 16"}, {vsn, "%VSN%"}, {modules, [cover, - cover_web, eprof, fprof, instrument, @@ -36,12 +35,12 @@ xref_utils ] }, - {registered,[webcover_server]}, + {registered, []}, {applications, [kernel, stdlib]}, {env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]} ] }, - {runtime_dependencies, ["webtool-0.8.10","stdlib-2.5","runtime_tools-1.8.14", + {runtime_dependencies, ["stdlib-2.5","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","erts-7.0", "compiler-5.0"]} ] diff --git a/lib/webtool/AUTHORS b/lib/webtool/AUTHORS deleted file mode 100644 index 5f173dd264..0000000000 --- a/lib/webtool/AUTHORS +++ /dev/null @@ -1,4 +0,0 @@ -Original Authors and Contributors: - -Siri Hansen -Martin Gustafsson diff --git a/lib/webtool/Makefile b/lib/webtool/Makefile deleted file mode 100644 index 9afcb87af2..0000000000 --- a/lib/webtool/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2009. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = src priv doc/src - -include vsn.mk -VSN = $(WEBTOOL_VSN) - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk - - diff --git a/lib/webtool/doc/html/.gitignore b/lib/webtool/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/webtool/doc/man1/.gitignore b/lib/webtool/doc/man1/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/webtool/doc/man3/.gitignore b/lib/webtool/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/webtool/doc/pdf/.gitignore b/lib/webtool/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/webtool/doc/src/Makefile b/lib/webtool/doc/src/Makefile deleted file mode 100644 index 57de52a616..0000000000 --- a/lib/webtool/doc/src/Makefile +++ /dev/null @@ -1,132 +0,0 @@ -# ``Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(WEBTOOL_VSN) -APPLICATION=webtool - -DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ -The Webtool application is obsolete and will be removed \ -in the next major OTP release - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml - -XML_REF1_FILES = start_webtool.xml - -XML_REF3_FILES = webtool.xml - -XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml - -XML_CHAPTER_FILES = \ - webtool_chapter.xml \ - notes.xml \ - notes_history.xml - -BOOK_FILES = book.xml - -XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) \ - $(XML_REF1_FILES) $(XML_APPLICATION_FILES) - -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN1_FILES) $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# 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/man1" - $(INSTALL_DATA) $(MAN1_FILES) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - -release_spec: - diff --git a/lib/webtool/doc/src/book.xml b/lib/webtool/doc/src/book.xml deleted file mode 100644 index feccee7c62..0000000000 --- a/lib/webtool/doc/src/book.xml +++ /dev/null @@ -1,48 +0,0 @@ - - - - -
- - 20012013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - WebTool - - - - 1.0 -
- - - WebTool - - - - - - - - - - - - - - - diff --git a/lib/webtool/doc/src/fascicules.xml b/lib/webtool/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/webtool/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ - - - - - - User's Guide - - - Reference Manual - - - Release Notes - - - Off-Print - - - diff --git a/lib/webtool/doc/src/notes.xml b/lib/webtool/doc/src/notes.xml deleted file mode 100644 index 21309261a8..0000000000 --- a/lib/webtool/doc/src/notes.xml +++ /dev/null @@ -1,253 +0,0 @@ - - - - -
- - 20042013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Webtool Release Notes - otp_appnotes - nil - nil - nil - notes.xml -
-

This document describes the changes made to the Webtool - application.

- -
WebTool 0.9 - -
Improvements and New Features - - -

- The Webtool application has been marked as obsolete and - will be removed from OTP in the next major release (OTP - 19.0).

-

- Own Id: OTP-10922 Aux Id: OTP-12705

- - -
- -
- -
WebTool 0.8.10 - -
Fixed Bugs and Malfunctions - - -

- Application upgrade (appup) files are corrected for the - following applications:

-

- asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl

-

- A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.

-

- (Thanks to Tobias Schlager)

-

- Own Id: OTP-11744

- - -
- -
- -
WebTool 0.8.9.2 - -
Improvements and New Features - - -

- Misc build updates

-

- Own Id: OTP-10784

- - -
- -
- -
WebTool 0.8.9.1 - -
Improvements and New Features - - -

- Miscellaneous documentation build updates

-

- Own Id: OTP-9813

- - -
- -
- -
WebTool 0.8.9 - -
Fixed Bugs and Malfunctions - - -

- Do not install *.bat files on non-win32 machines (Thanks - to Hans Ulrich Niedermann)

-

- Own Id: OTP-9515

- - -
- -
- -
WebTool 0.8.8 - -
Fixed Bugs and Malfunctions - - -

- Various small documentation fixes (Thanks to Bernard - Duggan)

-

- Own Id: OTP-9172

- - -
- -
- -
WebTool 0.8.7 - -
Improvements and New Features - - -

- Up until now Netscape has been the default web browser on - Unix/Linux. Webtool has now been updated to start Firefox - as default browser instead.

-

- Own Id: OTP-8651 Aux Id: OTP-8650

- - -
- -
- -
WebTool 0.8.6 - -
Improvements and New Features - - -

- Misc updates

-

- Own Id: OTP-8456

- - -
- -
- -
WebTool 0.8.5 - -
Improvements and New Features - - -

- The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.

-

- Own Id: OTP-8201

- - -
- -
- -
WebTool 0.8.4 - -
Improvements and New Features - - -

The copyright notices have been updated.

-

- Own Id: OTP-7851

- - -
- -
-
WebTool 0.8.3.2 - -
Improvements and New Features - - -

- Minor updates.

-

- Own Id: OTP-6998

- - -
- -
- -
- WebTool 0.8.3.1 - -
- Improvements and New Features - - -

Minor Makefile changes.

-

Own Id: OTP-6689

- - -

Obsolete guard tests (such as list()) have been replaced - with the modern guard tests (such as is_list()).

-

Own Id: OTP-6725

- - -
-
- -
- WebTool 0.8.3 - -
- Improvements and New Features - - -

Removed some dead code discovered by Dialyzer.

-

Own Id: OTP-6041

- - -
-
- - diff --git a/lib/webtool/doc/src/notes_history.xml b/lib/webtool/doc/src/notes_history.xml deleted file mode 100644 index 792475d948..0000000000 --- a/lib/webtool/doc/src/notes_history.xml +++ /dev/null @@ -1,74 +0,0 @@ - - - - -
- - 2006 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - Webtool Release Notes History - otp_appnotes - nil - nil - nil -
- -
- Webtool 0.8.2 - -
- Fixed Bugs and Malfunctions - - -

Bugfix: webtool crashed when trying to find a free - port number if connection failed with other reason than - econnrefused.

-

Own Id: OTP-5166

- - -
- -
- Improvements and New Features - - -

Misc improvements:

- - The function debug_app/1 and some error - printouts are added to simplify debugging of own - application. - Multiple webtool instances can now be started on - the same host. If the default port (8888) is in use, port - 8889 is tried. If 8889 is also used, 8890 is tried and so - on. Max number of ports tried is 256. - Incompatible: If Data is set to - PortNumber in start(Path,Data), the default - data will be used for ip-number (127.0.0.1) and - server name (localhost). - -

*** POTENTIAL INCOMPATIBILITY ***

-

Own Id: OTP-4724

- - -
-
- - diff --git a/lib/webtool/doc/src/part.xml b/lib/webtool/doc/src/part.xml deleted file mode 100644 index b0c4ee310d..0000000000 --- a/lib/webtool/doc/src/part.xml +++ /dev/null @@ -1,38 +0,0 @@ - - - - -
- - 20012013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - WebTool User's Guide - - - - -
- -

WebTool provides a easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.

- - - - diff --git a/lib/webtool/doc/src/part_notes.xml b/lib/webtool/doc/src/part_notes.xml deleted file mode 100644 index db2b790f3f..0000000000 --- a/lib/webtool/doc/src/part_notes.xml +++ /dev/null @@ -1,40 +0,0 @@ - - - - -
- - 20042013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - WebTool Release Notes - - - - -
- -

WebTool provides an easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.

-

For information about older versions, see - Release Notes History.

- - - - diff --git a/lib/webtool/doc/src/part_notes_history.xml b/lib/webtool/doc/src/part_notes_history.xml deleted file mode 100644 index 50ce62e58d..0000000000 --- a/lib/webtool/doc/src/part_notes_history.xml +++ /dev/null @@ -1,40 +0,0 @@ - - - - -
- - 2006 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - WebTool Release Notes History - - - - -
- -

WebTool provides a easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.

- - - - diff --git a/lib/webtool/doc/src/ref_man.xml b/lib/webtool/doc/src/ref_man.xml deleted file mode 100644 index aa81392b11..0000000000 --- a/lib/webtool/doc/src/ref_man.xml +++ /dev/null @@ -1,39 +0,0 @@ - - - - -
- - 20012013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - WebTool Reference Manual - - - - -
- -

WebTool provides an easy way to use web based tools with - Erlang/OTP. It configures and starts a webserver as well as all - available tools.

- - - - - diff --git a/lib/webtool/doc/src/start_webtool.xml b/lib/webtool/doc/src/start_webtool.xml deleted file mode 100644 index e9c94c4271..0000000000 --- a/lib/webtool/doc/src/start_webtool.xml +++ /dev/null @@ -1,104 +0,0 @@ - - - - -
- - 20032013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - start_webtool - - - 1 - - - 2003-06-18 - - start_webtool.sgml -
- start_webtool - WebTool Start Script - -

The start_webtool script starts WebTool, a WebTool - application and a web browser pointing to this application.

- - - - start_webtool application [ browser ] - Start a WebTool Application - -

Starts WebTool, the given WebTool Application and a web - browser pointing to this application. -

-

If no argument is given, a list of available applications - is displayed, e.g.

- 
->start_webtool
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or  http://127.0.0.1:8888/
-
-Usage: start_webtool application [ browser ]
-
-Available applications are: [orber,appmon,crashdump_viewer,webcover]
-Default browser is 'iexplore' (Internet Explorer) on Windows or else 'firefox'
-

To start any of the listed applications, give the - application name as the first argument, e.g.

- 
->start_webtool webcover
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or  http://127.0.0.1:8888/
-Starting webcover...
-Sending URL to netscape...done
-

The WebTool application WebCover is then started and the - default browser is used. The default browser is Internet - Explorer on Windows or else Firefox. -

-

To use another browser, give the browser's start command - as the second argument, e.g.

- 
->start_webtool webcover mozilla
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or  http://127.0.0.1:8888/
-Starting webcover...
-Sending URL to mozilla...done
-

If the given browser name is not known to WebTool, WebTool - will run it as a command with the start URL as the only - argument, e.g.

- 
->start_webtool webcover mybrowser
-Starting webtool...
-WebTool is available at http://localhost:8888/
-Or  http://127.0.0.1:8888/
-Starting webcover...
-Starting mybrowser...
-

Here the command "mybrowser http://localhost:8888/webcover" is executed. -

- - - - -
- See Also -

webtool(3)

-
- - diff --git a/lib/webtool/doc/src/webtool.xml b/lib/webtool/doc/src/webtool.xml deleted file mode 100644 index 2647518dae..0000000000 --- a/lib/webtool/doc/src/webtool.xml +++ /dev/null @@ -1,157 +0,0 @@ - - - - -
- - 2001 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - webtool - - - - -
- webtool - WebTool is a tool used to simplify the implementation of web based tools with Erlang/OTP. - -

WebTool makes it easy to use web based tools with Erlang/OTP. WebTool - configures and starts the webserver httpd.

- - - - start()-> {ok,Pid}| {stop,Reason} - Start WebTool. - -

Start WebTool with default data, i.e. port 8888, ip-number - 127.0.0.1, and server-name localhost. If port 8888 is - in use, port 8889 is tried instead. If 8889 is also in use, - 8890 is tried and so on. Max number of ports tried is 256. -

-

The mime.types file and WebTool's own HTML files - are assumed to be in the directory - /priv/root/conf]]>.

- - - - start(Path,Data)->{ok,Pid}|{stop,Reason} - Start WebTool with default configuration. - - Path = string() | standard_path - Data = [Port,Address,Name] | PortNumber | standard_data - Port = {port,PortNumber} - Address = {bind_address,IpNumber} - Name = {server_name,ServerName} - PortNumber = integer() - IpNumber = tuple(), e.g. {127,0,0,1} - ServerName = string() - Pid = pid() - - -

Use this function to start WebTool if the default port, - ip-number,servername or path can not be used.

-

Path is the directory where the mime.types - file and WebTool's own HTML files are located. By default - this is /priv]]>, and in most cases there - is no need to change this. If Path is set to - standard_path the default will be used.

-

If Data is set to PortNumber, the default data - will be used for ip-number (127.0.0.1) and server - name (localhost).

- - - - stop()->void - Stop WebTool. - -

Stop WebTool and the tools started by WebTool.

- - - - debug_app(Module)->void - Debug a WebTool application. - - Module = atom() - - -

Debug a WebTool application by tracing all functions in the - given module which are called from WebTool.

- - - - stop_debug()->void - Stop debugging an application and format the trace log. - -

Stop the tracing started by debug_app/1, and format - the trace log.

- - - - -
- CALLBACK FUNCTIONS -

The following callback function must be implemented by each web - based tool that will be used via WebTool. When started, WebTool - searches the Erlang code path for *.tool files to locate all web - based tools and their callback functions. See the WebTool User's Guide for more - information about the *.tool files.

-
- - - Module:Func(Data)-> {Name,WebData}|error - Returns configuration data needed by WebTool to configure and start a tool. - - Data = term() - Name = atom() - WebData = [WebOptions] - WebOptions = LinkData | Alias | Start - LinkData = {web_data,{ToolName,Url}} - Alias = {alias,{VirtualPath,RealPath}} | {alias,{erl_alias,Path,[Modules]} - Start = {start,StartData} - ToolName = Url = VirtualPath = RealPath = Path = string() - Modules = atom() - StartData = AppData | ChildSpec | Func - AppData = {app,AppName} - ChildSpec = {child,child_spec()} - See the Reference Manual for the module supervisor in the STDLIB application for details about child_spec(). - Func = {func,{StartMod,StartFunc,StartArg}, {StopMod,StopFunc,StopArg}} - AppName = StartMod = StartFunc = StopMod = StopFunc =atom() - StartArg = StopArg = [term()] - - -

This is the configuration function (config_func) - which must be stated in the *.tool file.

-

The function is called by WebTool at startup to retrieve the - data needed to start and configure the tool. LinkData is - used by WebTool to create the link to the tool. Alias is - used to create the aliases needed by the webserver. Start - is used to start and stop the tool.

- - - - -
- See Also -

start_webtool(1), - WebTool User's Guide

-
- - diff --git a/lib/webtool/doc/src/webtool_chapter.xml b/lib/webtool/doc/src/webtool_chapter.xml deleted file mode 100644 index 160a42f855..0000000000 --- a/lib/webtool/doc/src/webtool_chapter.xml +++ /dev/null @@ -1,246 +0,0 @@ - - - - -
- - 20012013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - WebTool User Guide - - - - - webtool_chapter.xml -
- -
- Introduction -

WebTool provides an easy and efficient way to implement web - based tools with Erlang/OTP. WebTool configures and starts the - webserver and the various web based tools.

-

All tools that shall run under WebTool must have a *.tool - file in the code path or in its priv directory. When WebTool - starts it searches the code path for such files. For each - ebin directory in the path, the priv directory is - also searched. The *.tool files contain the configuration data - for each web based tool.

-
- -
- Starting WebTool -

Start WebTool by calling the function webtool:start/0 or - webtool:start/2. If webtool:start/0 is used the - start page of WebTool is available at - http://localhost:8888/ or - http://127.0.0.1:8888/, and the directory containing - the root directory for the webserver, is assumed to be - /priv]]>.

-

Use webtool:start/2 if the default path for the root - directory, port, ip-number or server name can not be used. See - the Reference Manual for webtool for more information.

-

WebTool, with the default configuration as in start/0, - can also be started with the start_webtool script which - is available in the priv directory of the WebTool - application. See the Reference Manual for start_webtool for further - information about this script. For Windows users, the batch file - start_webtool.bat can be used for the same purpose.

-
- -
- Using WebTool -

Start WebTool and point the browser to the corresponding URL. - At the top of the page there is a frame with a link named - WebTool. Click that link and a page where it is - possible to start the available tools will appear in the main - frame.

-
- -
- Start a web based tool -

Click on the link labeled WebTool in the topmost frame, - select the checkbox for each tool to start and - click on the button labeled Start. A link to each tool - that WebTool succeeded to start will appear in the topmost frame.

-
- -
- Stop a web based tool -

Click on the link labeled WebTool in the topmost - frame. Select Stop Tools in the left frame. Select the - checkbox for each tool to stop and click on the button labeled - Stop.

-
- -
- Develop new web based tools -

WebTool can be used as a framework when developing new web based - tools.

-

A web based tool running under WebTool will typically consist of - three parts.

- - A *.tool file which defines how WebTool can find the tool's - configuration data - The Erlang code generating the web interface to the tool (HTML - code) - The tool itself. - -

In most cases it is a good idea to separate the code for - creation of the html-pages and the code for the logic. This - increases the readability of the code and the logic might be - possible to reuse.

- -
- The *.tool file -

When WebTool starts it searches the current path for - *.tool files to find all available tools. The *.tool - file contains a version identifier and a list of tuples which - is the configuration data. The version identifier specifies - the *.tool file version, i.e. not the version of - webtool. Currently the only valid version is "1.2" and the - only valid configuration tag is - config_func. config_func specifies which - function WebTool must call to get further configuration data - for the tool. This means that a *.tool file generally must - look like this:

- - {version,"1.2"}. - [{config_func,{Module,Function,Arguments}}]. -

Module is the name of the module where the callback - function is defined. Function is the name of the - callback function, and Arguments is the list of - arguments to the callback function.

-
- -
- The configuration function -

The *.tool file points out a configuration function. This - function must return a list of configuration parameters (see - the Reference Manual for webtool).

-

The web_data parameter is mandatory and it specifies - the name of the tool and the link to the tool's start - page. All other parameters are optional.

-

If the tool requires any processes to run, the start - parameter specifies the function that WebTool must call in - order to start the process(es).

-

The alias parameters are passed directly on to the - webserver (INETS). The webserver has three ways to create - dynamic web pages CGI, Eval Scheme and Erl Scheme. All tools - running under WebTool must use Erl Scheme.

-

Erl Scheme tries to resemble plain CGI. The big difference is - that Erl Scheme can only execute Erlang code. The code will - furthermore be executed on the same instance as the webserver.

-

An URL which calls an Erlang function with Erl Scheme can have - the following syntax:

- ]]> -

An alias parameter in the configuration function can be - an ErlScriptAlias as used in the above URL. The definition of - an ErlScriptAlias shall be like this:

-

{alias,{erl_alias,Path,[Modules]}}, e.g.

-

{alias,{erl_alias,"/testtool",[helloworld]}}

-

The following URL will then cause a call to the function - helloworld:helloworld/2 (if WebTool is started with default - settings i.e. servername "localhost" and port 8888):

-

http://localhost:8888/testtool/helloworld/helloworld

-

Note that the module helloworld must be in the code - path of the node running WebTool.

-

Functions that are called via the Erl Scheme must take two - arguments, Environment and Input. -

- - Environment is a list of key/value tuples. - Input is the part of the URL after the "?", i.e. the - part of the URL containing name-value pairs. If the page was - called with the URL: -

-

-Input will be the string - . In the module - httpd in the INETS application there is a function - parse_query which will parse such a string and return - a list of key-value tuples. - -

An alias parameter in the configuration function can - also be a normal path alias. This can e.g. be used to point - out a directory where HTML files are stored. The following - definition states that the URL - http://localhost:8888/mytool_home/ really points to the - directory /usr/local/otp/lib/myapp-1.0/priv:

-

{alias,{"/mytool_home","/usr/local/otp/lib/myapp-1.0/priv"}}

-

See the INETS documentation, especially the module - mod_esi, for a more in depth coverage of the Erl Scheme.

-
- -
- A small example -

A Hello World example that uses Erl Scheme would look like - this. Note that this example does not have a process running - and thus does not need a start parameter in the - configuration function. -

-

helloworld.erl:

- 
-        -module(helloworld).
-        -export([config_data/0]).
-        -export([helloworld/2]).
-        
-        config_data()->
-            {testtool,
-             [{web_data,{"TestTool","/testtool/helloworld/helloworld"}},
-              {alias,{erl_alias,"/testtool",[helloworld]}}]}.
-        
-        helloworld(_Env,_Input)->
-            [header(),html_header(),helloworld_body(),html_end()].
-
-        header() ->
-            header("text/html").
-
-        header(MimeType) ->
-            "Content-type: " ++ MimeType ++ "\r\n\r\n".
-
-        html_header() ->    
-            "<HTML>
-               <HEAD>
-                  <TITLE>Hello world Example </TITLE>
-               </HEAD>\n".
-
-        helloworld_body()->
-            "<BODY>Hello World</BODY>".
-
-        html_end()->
-            "</HTML>".
-
-

To use this example with WebTool a *.tool file must be created - and added to a directory in the current path, e.g. the same - directory as the compiled helloworld.beam.

-

testtool.tool:

- - {version,"1.2"}. - [{config_func, {helloworld,config_data,[]}}]. - -

When helloworld.erl is compiled, start WebTool by - calling the function webtool:start() and point your - browser to http://localhost:8888/. Select WebTool in - the topmost frame and start TestTool from the web page. Click - on the link labeled TestTool in the topmost frame.

-
-
- - diff --git a/lib/webtool/ebin/.gitignore b/lib/webtool/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/webtool/info b/lib/webtool/info deleted file mode 100644 index 4d8dc6f2cb..0000000000 --- a/lib/webtool/info +++ /dev/null @@ -1,2 +0,0 @@ -group: tools -short: A tool that simplifying the use of web based Erlang tools diff --git a/lib/webtool/priv/Makefile b/lib/webtool/priv/Makefile deleted file mode 100644 index 4963767a4d..0000000000 --- a/lib/webtool/priv/Makefile +++ /dev/null @@ -1,82 +0,0 @@ -# ``Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(WEBTOOL_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -WEBSERVER_CONFIG_FILES = root/conf/mime.types - -HTDOCS_FILES = root/doc/index.html \ - root/doc/tool_management.html \ - root/doc/start_info.html - -ifeq ($(findstring win32,$(TARGET)),win32) -WIN32_SCRIPTS= bin/start_webtool.bat -else -WIN32_SCRIPTS= -endif -SCRIPTS = bin/start_webtool $(WIN32_SCRIPTS) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/priv" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/conf" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/root/doc" - $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv/root/doc" - $(INSTALL_DATA) $(WEBSERVER_CONFIG_FILES) "$(RELSYSDIR)/priv/root/conf" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/bin" - $(INSTALL_SCRIPT) $(SCRIPTS) "$(RELSYSDIR)/priv/bin" - -release_docs_spec: - - diff --git a/lib/webtool/priv/bin/start_webtool b/lib/webtool/priv/bin/start_webtool deleted file mode 100755 index e552fb5af0..0000000000 --- a/lib/webtool/priv/bin/start_webtool +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh - -erl -sname webtool -s webtool script_start $@ diff --git a/lib/webtool/priv/bin/start_webtool.bat b/lib/webtool/priv/bin/start_webtool.bat deleted file mode 100644 index cd16aa6200..0000000000 --- a/lib/webtool/priv/bin/start_webtool.bat +++ /dev/null @@ -1,2 +0,0 @@ -@ECHO OFF -CALL erl -sname webtool -s webtool script_start %* -s erlang halt \ No newline at end of file diff --git a/lib/webtool/priv/root/conf/mime.types b/lib/webtool/priv/root/conf/mime.types deleted file mode 100644 index 32f7cd853c..0000000000 --- a/lib/webtool/priv/root/conf/mime.types +++ /dev/null @@ -1,99 +0,0 @@ -# This is a comment. I love comments. - -application/activemessage -application/andrew-inset -application/applefile -application/atomicmail -application/dca-rft -application/dec-dx -application/mac-binhex40 hqx -application/mac-compactpro cpt -application/macwriteii -application/msword doc -application/news-message-id -application/news-transmission -application/octet-stream bin dms lha lzh exe class -application/oda oda -application/pdf pdf -application/postscript ai eps ps -application/powerpoint ppt -application/remote-printing -application/rtf rtf -application/slate -application/wita -application/wordperfect5.1 -application/x-bcpio bcpio -application/x-cdlink vcd -application/x-compress Z -application/x-cpio cpio -application/x-csh csh -application/x-director dcr dir dxr -application/x-dvi dvi -application/x-gtar gtar -application/x-gzip gz -application/x-hdf hdf -application/x-httpd-cgi cgi -application/x-koan skp skd skt skm -application/x-latex latex -application/x-mif mif -application/x-netcdf nc cdf -application/x-sh sh -application/x-shar shar -application/x-stuffit sit -application/x-sv4cpio sv4cpio -application/x-sv4crc sv4crc -application/x-tar tar -application/x-tcl tcl -application/x-tex tex -application/x-texinfo texinfo texi -application/x-troff t tr roff -application/x-troff-man man -application/x-troff-me me -application/x-troff-ms ms -application/x-ustar ustar -application/x-wais-source src -application/zip zip -audio/basic au snd -audio/mpeg mpga mp2 -audio/x-aiff aif aiff aifc -audio/x-pn-realaudio ram -audio/x-pn-realaudio-plugin rpm -audio/x-realaudio ra -audio/x-wav wav -chemical/x-pdb pdb xyz -image/gif gif -image/ief ief -image/jpeg jpeg jpg jpe -image/png png -image/tiff tiff tif -image/x-cmu-raster ras -image/x-portable-anymap pnm -image/x-portable-bitmap pbm -image/x-portable-graymap pgm -image/x-portable-pixmap ppm -image/x-rgb rgb -image/x-xbitmap xbm -image/x-xpixmap xpm -image/x-xwindowdump xwd -message/external-body -message/news -message/partial -message/rfc822 -multipart/alternative -multipart/appledouble -multipart/digest -multipart/mixed -multipart/parallel -text/html html htm -text/x-server-parsed-html shtml -text/plain txt -text/richtext rtx -text/tab-separated-values tsv -text/x-setext etx -text/x-sgml sgml sgm -video/mpeg mpeg mpg mpe -video/quicktime qt mov -video/x-msvideo avi -video/x-sgi-movie movie -x-conference/x-cooltalk ice -x-world/x-vrml wrl vrml diff --git a/lib/webtool/priv/root/doc/index.html b/lib/webtool/priv/root/doc/index.html deleted file mode 100644 index 9fbb143cc7..0000000000 --- a/lib/webtool/priv/root/doc/index.html +++ /dev/null @@ -1,11 +0,0 @@ - - -Erlang WebTool - - - - - - - - diff --git a/lib/webtool/priv/root/doc/start_info.html b/lib/webtool/priv/root/doc/start_info.html deleted file mode 100644 index fcf44433f1..0000000000 --- a/lib/webtool/priv/root/doc/start_info.html +++ /dev/null @@ -1,28 +0,0 @@ - - - - - - - - -
- - - - - - - - - - - - - -
Welcome
to
WebTool




-
Click on the link WebTool on the top of the page, or here to start the Web based tools.
- -
- - \ No newline at end of file diff --git a/lib/webtool/priv/root/doc/tool_management.html b/lib/webtool/priv/root/doc/tool_management.html deleted file mode 100644 index 19d9dbcb9e..0000000000 --- a/lib/webtool/priv/root/doc/tool_management.html +++ /dev/null @@ -1,9 +0,0 @@ - - -Erlang WebTool - - - - - - diff --git a/lib/webtool/src/Makefile b/lib/webtool/src/Makefile deleted file mode 100644 index a5a8eaf5dc..0000000000 --- a/lib/webtool/src/Makefile +++ /dev/null @@ -1,98 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(WEBTOOL_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/webtool-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= webtool \ - webtool_sup - - - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -APP_FILE= webtool.app -APPUP_FILE= webtool.appup - -APP_SRC= $(APP_FILE).src -APPUP_SRC= $(APPUP_FILE).src - - -APP_TARGET= $(EBIN)/$(APP_FILE) -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard - - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) - -clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) - rm -f core - -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) $(HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \ - "$(RELSYSDIR)/ebin" - -release_docs_spec: - diff --git a/lib/webtool/src/webtool.app.src b/lib/webtool/src/webtool.app.src deleted file mode 100644 index 6b9750c2b4..0000000000 --- a/lib/webtool/src/webtool.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -{application,webtool, - [{description,"Toolbar lookalike for the web"}, - {vsn,"%VSN%"}, - {modules,[webtool,webtool_sup]}, - {registered,[web_tool,websup]}, - {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/src/webtool.appup.src b/lib/webtool/src/webtool.appup.src deleted file mode 100644 index 1394d0d6d5..0000000000 --- a/lib/webtool/src/webtool.appup.src +++ /dev/null @@ -1,22 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -{"%VSN%", - [{<<".*">>,[{restart_application, webtool}]}], - [{<<".*">>,[{restart_application, webtool}]}] -}. diff --git a/lib/webtool/src/webtool.erl b/lib/webtool/src/webtool.erl deleted file mode 100644 index 80dad53f8f..0000000000 --- a/lib/webtool/src/webtool.erl +++ /dev/null @@ -1,1208 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(webtool). --behaviour(gen_server). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The general idea is: %% -%% %% -%% %% -%% 1. Scan through the path for *.tool files and find all the web %% -%% based tools. Query each tool for configuration data. %% -%% 2. Add Alias for Erlscript and html for each tool to %% -%% the webserver configuration data. %% -%% 3. Start the webserver. %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API functions --export([start/0, start/2, stop/0]). - -%% Starting Webtool from a shell script --export([script_start/0, script_start/1]). - -%% Web api --export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). - -%% API against other tools --export([is_localhost/0]). - -%% Debug export s --export([get_tools1/1]). --export([debug/1, stop_debug/0, debug_app/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - --include_lib("kernel/include/file.hrl"). --include_lib("stdlib/include/ms_transform.hrl"). - --record(state,{priv_dir,app_data,supvis,web_data,started=[]}). - --define(MAX_NUMBER_OF_WEBTOOLS,256). --define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix --define(DEFAULT_ADDR,{127,0,0,1}). - --define(WEBTOOL_ALIAS,{webtool,[{alias,{erl_alias,"/webtool",[webtool]}}]}). --define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). --define(HTML_HEADER,"\r\n\r\nWebTool\r\n\r\n\r\n"). --define(HTML_HEADER_RELOAD,"\r\n\r\nWebTool - \r\n\r\n - \r\n"). - --define(HTML_END,""). - --define(SEND_URL_TIMEOUT,5000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% For debugging only. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Start tracing with -%% debug(Functions). -%% Functions = local | global | FunctionList -%% FunctionList = [Function] -%% Function = {FunctionName,Arity} | FunctionName | -%% {Module, FunctionName, Arity} | {Module,FunctionName} -debug(F) -> - ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes - ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - tp(F,MS), - ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func - ok. -tp(local,MS) -> % all functions - ttb:tpl(?MODULE,MS); -tp(global,MS) -> % all exported functions - ttb:tp(?MODULE,MS); -tp([{M,F,A}|T],MS) -> % Other module - ttb:tpl(M,F,A,MS), - tp(T,MS); -tp([{M,F}|T],MS) when is_atom(F) -> % Other module - ttb:tpl(M,F,MS), - tp(T,MS); -tp([{F,A}|T],MS) -> % function/arity - ttb:tpl(?MODULE,F,A,MS), - tp(T,MS); -tp([F|T],MS) -> % function - ttb:tpl(?MODULE,F,MS), - tp(T,MS); -tp([],_MS) -> - ok. -stop_debug() -> - ttb:stop([format]). - -debug_app(Mod) -> - ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), - ttb:p(all,[call,timestamp]), - MS = [{'_',[],[{return_trace},{message,{caller}}]}], - ttb:tp(Mod,MS), - ok. - -out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) - when W==webtool;W==mod_esi-> - io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]), - [{M,F,length(A)}|S]; -out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> - io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]), - S; -out(_,_,_,_) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Functions called via script. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -script_start() -> - usage(), - halt(). -script_start([App]) -> - DefaultBrowser = - case os:type() of - {win32,_} -> iexplore; - _ -> firefox - end, - script_start([App,DefaultBrowser]); -script_start([App,Browser]) -> - io:format("Starting webtool...\n"), - start(), - AvailableApps = get_applications(), - {OSType,_} = os:type(), - case lists:keysearch(App,1,AvailableApps) of - {value,{App,StartPage}} -> - io:format("Starting ~w...\n",[App]), - start_tools([],"app=" ++ atom_to_list(App)), - PortStr = integer_to_list(get_port()), - Url = case StartPage of - "/" ++ Page -> - "http://localhost:" ++ PortStr ++ "/" ++ Page; - _ -> - "http://localhost:" ++ PortStr ++ "/" ++ StartPage - end, - case Browser of - none -> - ok; - iexplore when OSType == win32-> - io:format("Starting internet explorer...\n"), - {ok,R} = win32reg:open(""), - Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", - win32reg:change_key(R,Key), - {ok,Val} = win32reg:value(R,"Path"), - IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), - os:cmd("\"" ++ IExplore ++ "\" " ++ Url); - _ when OSType == win32 -> - io:format("Starting ~w...\n",[Browser]), - os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); - B when B==firefox; B==mozilla -> - io:format("Sending URL to ~w...",[Browser]), - BStr = atom_to_list(Browser), - SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ - Url ++ ")\'", - Port = open_port({spawn,SendCmd},[exit_status]), - receive - {Port,{exit_status,0}} -> - io:format("done\n"), - ok; - {Port,{exit_status,_Error}} -> - io:format(" not running, starting ~w...\n", - [Browser]), - os:cmd(BStr ++ " " ++ Url), - ok - after ?SEND_URL_TIMEOUT -> - io:format(" failed, starting ~w...\n",[Browser]), - erlang:port_close(Port), - os:cmd(BStr ++ " " ++ Url) - end; - _ -> - io:format("Starting ~w...\n",[Browser]), - os:cmd(atom_to_list(Browser) ++ " " ++ Url) - end, - ok; - false -> - stop(), - io:format("\n{error,{unknown_app,~p}}\n",[App]), - halt() - end. - -usage() -> - io:format("Starting webtool...\n"), - start(), - Apps = lists:map(fun({A,_}) -> A end,get_applications()), - io:format( - "\nUsage: start_webtool application [ browser ]\n" - "\nAvailable applications are: ~p\n" - "Default browser is \'iexplore\' (Internet Explorer) on Windows " - "or else \'firefox\'\n", - [Apps]), - stop(). - - -get_applications() -> - gen_server:call(web_tool,get_applications). - -get_port() -> - gen_server:call(web_tool,get_port). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Api functions to the genserver. %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% -%---------------------------------------------------------------------- - -start()-> - start(standard_path,standard_data). - -start(Path,standard_data)-> - case get_standard_data() of - {error,Reason} -> - {error,Reason}; - Data -> - start(Path,Data) - end; - -start(standard_path,Data)-> - Path=get_path(), - start(Path,Data); - -start(Path,Port) when is_integer(Port)-> - Data = get_standard_data(Port), - start(Path,Data); - -start(Path,Data0)-> - Data = Data0 ++ rest_of_standard_data(), - gen_server:start({local,web_tool},webtool,{Path,Data},[]). - -stop()-> - gen_server:call(web_tool,stoppit). - -%---------------------------------------------------------------------- -%Web Api functions called by the web -%---------------------------------------------------------------------- -started_tools(Env,Input)-> - gen_server:call(web_tool,{started_tools,Env,Input}). - -toolbar(Env,Input)-> - gen_server:call(web_tool,{toolbar,Env,Input}). - -start_tools(Env,Input)-> - gen_server:call(web_tool,{start_tools,Env,Input}). - -stop_tools(Env,Input)-> - gen_server:call(web_tool,{stop_tools,Env,Input}). -%---------------------------------------------------------------------- -%Support API for other tools -%---------------------------------------------------------------------- - -is_localhost()-> - gen_server:call(web_tool,is_localhost). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%%The gen_server callback functions that builds the webbpages %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -handle_call(get_applications,_,State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), - Tools = ets:select(State#state.app_data,MS), - {reply,Tools,State}; - -handle_call(get_port,_,State)-> - {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), - {reply,Port,State}; - -handle_call({started_tools,_Env,_Input},_,State)-> - {reply,started_tools_page(State),State}; - -handle_call({toolbar,_Env,_Input},_,State)-> - {reply,toolbar(),State}; - -handle_call({start_tools,Env,Input},_,State)-> - {NewState,Page}=start_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call({stop_tools,Env,Input},_,State)-> - {NewState,Page}=stop_tools_page(Env,Input,State), - {reply,Page,NewState}; - -handle_call(stoppit,_From,Data)-> - {stop,normal,ok,Data}; - -handle_call(is_localhost,_From,Data)-> - Result=case proplists:get_value(bind_address, Data#state.web_data) of - ?DEFAULT_ADDR -> - true; - _IpNumber -> - false - end, - {reply,Result,Data}. - - -handle_info(_Message,State)-> - {noreply,State}. - -handle_cast(_Request,State)-> - {noreply,State}. - -code_change(_,State,_)-> - {ok,State}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% The other functions needed by the gen_server behaviour -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -% Start the gen_server -%---------------------------------------------------------------------- -init({Path,Config})-> - case filelib:is_dir(Path) of - true -> - {ok, Table} = get_tool_files_data(), - insert_app(?WEBTOOL_ALIAS, Table), - case webtool_sup:start_link() of - {ok, Pid} -> - case start_webserver(Table, Path, Config) of - {ok, _} -> - print_url(Config), - {ok,#state{priv_dir=Path, - app_data=Table, - supvis=Pid, - web_data=Config}}; - {error, Error} -> - {stop, {error, Error}} - end; - Error -> - {stop,Error} - end; - false -> - {stop, {error, error_dir}} - end. - -terminate(_Reason,Data)-> - %%shut down the webbserver - shutdown_server(Data), - %%Shutdown the different tools that are started with application:start - shutdown_apps(Data), - %%Shutdown the supervisor and its children will die - shutdown_supervisor(Data), - ok. - -print_url(ConfigData)-> - Server=proplists:get_value(server_name,ConfigData,"undefined"), - Port=proplists:get_value(port,ConfigData,"undefined"), - {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), - io:format("WebTool is available at http://~s:~w/~n",[Server,Port]), - io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% begin build the pages -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -%The page that shows the started tools -%---------------------------------------------------------------------- -started_tools_page(State)-> - [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. - -toolbar()-> - [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. - - -start_tools_page(_Env,Input,State)-> - %%io:format("~n======= ~n ~p ~n============~n",[Input]), - case get_tools(Input) of - {tools,Tools}-> - %%io:format("~n======= ~n ~p ~n============~n",[Tools]), - {ok,NewState}=handle_apps(Tools,State,start), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_unstarted_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} - end. - -stop_tools_page(_Env,Input,State)-> - case get_tools(Input) of - {tools,Tools}-> - {ok,NewState}=handle_apps(Tools,State,stop), - {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), - show_started_apps(NewState),?HTML_END]}; - _ -> - {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Functions that start and config the webserver -%% 1. Collect the config data -%% 2. Start webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Start the webserver -%---------------------------------------------------------------------- -start_webserver(Data,Path,Config)-> - case get_conf_data(Data,Path,Config) of - {ok,Conf_data}-> - %%io:format("Conf_data: ~p~n",[Conf_data]), - start_server(Conf_data); - {error,Error} -> - {error,{error_server_conf_file,Error}} - end. - -start_server(Conf_data)-> - case inets:start(httpd, Conf_data, stand_alone) of - {ok,Pid}-> - {ok,Pid}; - Error-> - {error,{server_error,Error}} - end. - -%---------------------------------------------------------------------- -% Create config data for the webserver -%---------------------------------------------------------------------- -get_conf_data(Data,Path,Config)-> - Aliases=get_aliases(Data), - ServerRoot = filename:join([Path,"root"]), - MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), - case httpd_conf:load_mime_types(MimeTypesFile) of - {ok,MimeTypes} -> - Config1 = Config ++ Aliases, - Config2 = [{server_root,ServerRoot}, - {document_root,filename:join([Path,"root/doc"])}, - {mime_types,MimeTypes} | - Config1], - {ok,Config2}; - Error -> - Error - end. - -%---------------------------------------------------------------------- -% Control the path for *.tools files -%---------------------------------------------------------------------- -get_tool_files_data()-> - Tools=get_tools1(code:get_path()), - %%io:format("Data : ~p ~n",[Tools]), - get_file_content(Tools). - -%---------------------------------------------------------------------- -%Control that the data in the file really is erlang terms -%---------------------------------------------------------------------- -get_file_content(Tools)-> - Get_data=fun({tool,ToolData}) -> - %%io:format("Data : ~p ~n",[ToolData]), - case proplists:get_value(config_func,ToolData) of - {M,F,A}-> - case catch apply(M,F,A) of - {'EXIT',_} -> - bad_data; - Data when is_tuple(Data) -> - Data; - _-> - bad_data - end; - _ -> - bad_data - end - end, - insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). - -%---------------------------------------------------------------------- -%Insert the data from the file in to the ets:table -%---------------------------------------------------------------------- -insert_file_content(Content)-> - Table=ets:new(app_data,[bag]), - lists:foreach(fun(X)-> - insert_app(X,Table) - end,Content), - {ok,Table}. - -%---------------------------------------------------------------------- -%Control that we got a a tuple of a atom and a list if so add the -%elements in the list to the ets:table -%---------------------------------------------------------------------- -insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> - %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), - lists:foreach( - fun({alias,{erl_alias,Alias,Mods}}) -> - Key_val = {erl_script_alias,{Alias,Mods}}, - %%io:format("Insert: ~p~n",[Key_val]), - ets:insert(Table,{Name,Key_val}); - (Key_val_pair)-> - %%io:format("Insert: ~p~n",[Key_val_pair]), - ets:insert(Table,{Name,Key_val_pair}) - end, - Key_val_list); - -insert_app(_,_)-> - ok. - -%---------------------------------------------------------------------- -% Select all the alias in the database -%---------------------------------------------------------------------- -get_aliases(Data)-> - MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> - {erl_script_alias,Alias}; - ({_,{alias,Alias}}) -> - {alias,Alias} - end), - ets:select(Data,MS). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Helper functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_standard_data(Port)-> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ]. - -get_standard_data()-> - case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of - {error,Reason} -> {error,Reason}; - Port -> - [ - {port,Port}, - {bind_address,?DEFAULT_ADDR}, - {server_name,"localhost"} - ] - end. - -get_free_port(_Port,0) -> - {error,no_free_port_found}; -get_free_port(Port,N) -> - case gen_tcp:connect("localhost",Port,[]) of - {error, _Reason} -> - Port; - {ok,Sock} -> - gen_tcp:close(Sock), - get_free_port(Port+1,N-1) - end. - -rest_of_standard_data() -> - [ - %% Do not allow the server to be crashed by malformed http-request - {max_header_siz,1024}, - {max_header_action,reply414}, - %% Go on a straight ip-socket - {com_type,ip_comm}, - %% Do not change the order of these module names!! - {modules,[mod_alias, - mod_auth, - mod_esi, - mod_actions, - mod_cgi, - mod_include, - mod_dir, - mod_get, - mod_head, - mod_log, - mod_disk_log]}, - {directory_index,["index.html"]}, - {default_type,"text/plain"} - ]. - - -get_path()-> - code:priv_dir(webtool). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These functions is used to shutdown the webserver -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Shut down the webbserver -%---------------------------------------------------------------------- -shutdown_server(State)-> - {Addr,Port} = get_addr_and_port(State#state.web_data), - inets:stop(httpd,{Addr,Port}). - -get_addr_and_port(Config) -> - Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), - Port = proplists:get_value(port,Config,?DEFAULT_PORT), - {Addr,Port}. - -%---------------------------------------------------------------------- -% Select all apps in the table and close them -%---------------------------------------------------------------------- -shutdown_apps(State)-> - Data=State#state.app_data, - MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), - lists:foreach(fun(Start_app)-> - stop_app(Start_app) - end, - ets:select(Data,MS)). - -%---------------------------------------------------------------------- -%Shuts down the supervisor that supervises tools that is not -%Designed as applications -%---------------------------------------------------------------------- -shutdown_supervisor(State)-> - %io:format("~n==================~n"), - webtool_sup:stop(State#state.supvis). - %io:format("~n==================~n"). - -%---------------------------------------------------------------------- -%close the individual apps. -%---------------------------------------------------------------------- -stop_app({child,_Real_name})-> - ok; - -stop_app({app,Real_name})-> - application:stop(Real_name); - -stop_app({func,_Start,Stop})-> - case Stop of - {M,F,A} -> - catch apply(M,F,A); - _NoStop -> - ok - end. - - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webpage where the user can select if -%% to start apps or to stop apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -toolbar_page()-> - " - - - - - - - - - -
- Select Action -
- Start Tools -
- Stop Tools -
". -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% These functions creates the webbpage that shows the started apps -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% started_tools(State)->String (html table) -% State is a record of type state -%---------------------------------------------------------------------- -started_tools(State)-> - Names=get_started_apps(State#state.app_data,State#state.started), - " - "++ make_rows(Names,[],0) ++" -
". -%---------------------------------------------------------------------- -%get_started_apps(Data,Started)-> [{web_name,link}] -%selects the started apps from the ets table of apps. -%---------------------------------------------------------------------- - -get_started_apps(Data,Started)-> - SelectData=fun({Name,Link}) -> - {Name,Link} - end, - MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), - - [{"WebTool","/tool_management.html"} | - [SelectData(X) || X <- ets:select(Data,MS)]]. - -%---------------------------------------------------------------------- -% make_rows(List,Result,Fields)-> String (The rows of a htmltable -% List a list of tupler discibed above -% Result an accumulator for the result -% Field, counter that counts the number of cols in each row. -%---------------------------------------------------------------------- -make_rows([],Result,Fields)-> - Result ++ fill_out(Fields); -make_rows([Data|Paths],Result,Field)when Field==0-> - make_rows(Paths,Result ++ "" ++ make_field(Data),Field+1); - -make_rows([Path|Paths],Result,Field)when Field==4-> - make_rows(Paths,Result ++ make_field(Path) ++ "",0); - -make_rows([Path|Paths],Result,Field)-> - make_rows(Paths,Result ++ make_field(Path),Field+1). - -%---------------------------------------------------------------------- -% make_fields(Path)-> String that is a field i a html table -% Path is a name url tuple {Name,url} -%---------------------------------------------------------------------- -make_field(Path)-> - "" ++ get_name(Path) ++ "". - - -%---------------------------------------------------------------------- -%get_name({Nae,Url})->String that represents a tag in html. -%---------------------------------------------------------------------- -get_name({Name,Url})-> - "" ++ Name ++ "". - - -%---------------------------------------------------------------------- -% fill_out(Nr)-> String, that represent Nr fields in a html-table. -%---------------------------------------------------------------------- -fill_out(Nr)when Nr==0-> - []; -fill_out(Nr)when Nr==4-> - " "; - -fill_out(Nr)-> - " " ++ fill_out(Nr+1). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%%These functions starts applicatons and builds the page showing tools -%%to start -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Controls whether the user selected a tool to start -%---------------------------------------------------------------------- -get_tools(Input)-> - case httpd:parse_query(Input) of - []-> - no_tools; - Tools-> - FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, - SelectData= - fun({Name,_Data}) -> string:equal(Name,"app") end, - {tools,[FormatData(X)||X<-Tools,SelectData(X)]} - end. - -%---------------------------------------------------------------------- -% Selects the data to start the applications the user has ordered -% starting of -%---------------------------------------------------------------------- -handle_apps([],State,_Cmd)-> - {ok,State}; - -handle_apps([Tool|Tools],State,Cmd)-> - case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of - []-> - Started = case Cmd of - start -> - [Tool|State#state.started]; - stop -> - lists:delete(Tool,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - ToStart -> - case handle_apps2(ToStart,State,Cmd) of - {ok,NewState}-> - handle_apps(Tools,NewState,Cmd); - _-> - handle_apps(Tools,State,Cmd) - end - end. - -%---------------------------------------------------------------------- -%execute every start or stop data about a tool. -%---------------------------------------------------------------------- -handle_apps2([{Name,Start_data}],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of - ok-> - Started = case Cmd of - start -> - [Name|State#state.started]; - stop -> - - lists:delete(Name,State#state.started) - end, - {ok,#state{priv_dir=State#state.priv_dir, - app_data=State#state.app_data, - supvis=State#state.supvis, - web_data=State#state.web_data, - started=Started}}; - _-> - error - end; - -handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> - case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of - ok-> - handle_apps2(Rest,State,Cmd); - _-> - error - end. - - -%---------------------------------------------------------------------- -% Handle start and stop of applications -%---------------------------------------------------------------------- - -handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> - Action = case Cmd of - start -> - Start; - _ -> - Stop - end, - case Action of - {M,F,A} -> - case catch apply(M,F,A) of - {'EXIT',_} = Exit-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "~w:~w(~s) ->\n" - "~p\n\n", - [?LINE,Name,M,F,format_args(A),Exit]), - ets:delete(Data,Name); - _OK-> - ok - end; - _NoStart -> - ok - end; - - -handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> - case Cmd of - start -> - case catch supervisor:start_child(Pid,ChildSpec) of - {ok,_}-> - ok; - {ok,_,_}-> - ok; - {error,Reason}-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Pid,ChildSpec,{error,Reason}]), - ets:delete(Data,Name); - Error -> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "supervisor:start_child(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Pid,ChildSpec,Error]), - ets:delete(Data,Name) - end; - stop -> - case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of - ok -> - supervisor:delete_child(websup,element(1,ChildSpec)); - _ -> - error - end - end; - - - -handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> - case Cmd of - start -> - case application:start(Real_name,temporary) of - ok-> - io:write(Name), - ok; - {error,{already_started,_}}-> - %% Remove it from the database so we dont start - %% anything already started - ets:match_delete(Data,{Name,{start,{app,Real_name}}}), - ok; - {error,_Reason}=Error-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not start application \'~p\'\n\n" - "application:start(~p,~p) ->\n" - "~p\n\n", - [?LINE,Name,Real_name,temporary,Error]), - ets:delete(Data,Name) - end; - - stop -> - application:stop(Real_name) - end; - -%---------------------------------------------------------------------- -% If the data is incorrect delete the app -%---------------------------------------------------------------------- -handle_app({Name,Incorrect},Data,_Pid,Cmd)-> - %%! Here the tool disappears from the webtool interface!! - io:format("\n=======ERROR (webtool, line ~w) =======\n" - "Could not ~w application \'~p\'\n\n" - "Incorrect data: ~p\n\n", - [?LINE,Cmd,Name,Incorrect]), - ets:delete(Data,Name). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% this functions creates the page that shows the unstarted tools %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -reload_started_apps()-> - "". - -show_unstarted_apps(State)-> - " - - -
-
- - - - - - - - -
Available Tools
- - "++ list_available_apps(State)++" - - - - -
 
- -
- 		- To Start a Tool: -
    -
  • Select the - checkbox for each tool to - start.
    • -
  • Click on the - button marked Start.
-
-
-
 
". - - - -list_available_apps(State)-> - MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), - Unstarted_apps= - lists:filter( - fun({Tool,_})-> - false==lists:member(Tool,State#state.started) - end, - ets:select(State#state.app_data,MS)), - case Unstarted_apps of - []-> - "All tools are started"; - _-> - list_apps(Unstarted_apps) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% these functions creates the page that shows the started apps %% -%% the user can select to shutdown %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -show_started_apps(State)-> - " - - -
-
- - - - - - - - -
Started Tools
- - "++ list_started_apps(State)++" - - - - -
 
- -
- 		- Stop a Tool: -
    -
  • Select the - checkbox for each tool to - stop.
    • -
  • Click on the - button marked Stop.
-
-
-
 
". - -list_started_apps(State)-> - MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, - State#state.started), - Started_apps= ets:select(State#state.app_data,MS), - case Started_apps of - []-> - "No tool is started yet."; - _-> - list_apps(Started_apps) - end. - - -list_apps(Apps) -> - lists:map(fun({Tool,Name})-> - " - - " ++ Name ++ " - " - end, - Apps). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Collecting the data from the *.tool files %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------- -% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] -% Dirs - [string()] Directory names -% Calls get_tools2/2 recursively for a number of directories -% to retireve the configuration data for the web based tools. -%---------------------------------------- -get_tools1(Dirs)-> - get_tools1(Dirs,[]). - -get_tools1([Dir|Rest],Data) when is_list(Dir) -> - Tools=case filename:basename(Dir) of - %% Dir is an 'ebin' directory, check in '../priv' as well - "ebin" -> - [get_tools2(filename:join(filename:dirname(Dir),"priv")) | - get_tools2(Dir)]; - _ -> - get_tools2(Dir) - end, - get_tools1(Rest,[Tools|Data]); - -get_tools1([],Data) -> - lists:flatten(Data). - -%---------------------------------------- -% get_tools2(Directory) => DataList -% DataList : [WebTuple]|[] -% WebTuple: {tool,[{web,M,F,A}]} -% -%---------------------------------------- -get_tools2(Dir)-> - get_tools2(tool_files(Dir),[]). - -get_tools2([ToolFile|Rest],Data) -> - case get_tools3(ToolFile) of - {tool,WebData} -> - get_tools2(Rest,[{tool,WebData}|Data]); - {error,_Reason} -> - get_tools2(Rest,Data); - nodata -> - get_tools2(Rest,Data) - end; - -get_tools2([],Data) -> - Data. - -%---------------------------------------- -% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata -% Tool: {tool,[KeyValTuple]} -% ToolFile - string() A .tool file -% Now we have the file get the data and sort it out -%---------------------------------------- -get_tools3(ToolFile) -> - case file:consult(ToolFile) of - {error,open} -> - {error,nofile}; - {error,read} -> - {error,format}; - {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> - webdata(ToolInfo); - {ok,[{version,_Vsn},_Info]} -> - {error,old_version}; - {ok,_Other} -> - {error,format} - end. - - -%---------------------------------------------------------------------- -% webdata(TupleList)-> ToolTuple| nodata -% ToolTuple: {tool,[{config_func,{M,F,A}}]} -% -% There are a little unneccesary work in this format but it is extendable -%---------------------------------------------------------------------- -webdata(TupleList)-> - case proplists:get_value(config_func,TupleList,nodata) of - {M,F,A} -> - {tool,[{config_func,{M,F,A}}]}; - _ -> - nodata - end. - - -%============================================================================= -% Functions for getting *.tool configuration files -%============================================================================= - -%---------------------------------------- -% tool_files(Dir) => ToolFiles -% Dir - string() Directory name -% ToolFiles - [string()] -% Return the list of all files in Dir ending with .tool (appended to Dir) -%---------------------------------------- -tool_files(Dir) -> - case file:list_dir(Dir) of - {ok,Files} -> - filter_tool_files(Dir,Files); - {error,_Reason} -> - [] - end. - -%---------------------------------------- -% filter_tool_files(Dir,Files) => ToolFiles -% Dir - string() Directory name -% Files, ToolFiles - [string()] File names -% Filters out the files in Files ending with .tool and append them to Dir -%---------------------------------------- -filter_tool_files(_Dir,[]) -> - []; -filter_tool_files(Dir,[File|Rest]) -> - case filename:extension(File) of - ".tool" -> - [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; - _ -> - filter_tool_files(Dir,Rest) - end. - - -%%%----------------------------------------------------------------- -%%% format functions -ffunc({M,F,A}) when is_list(A) -> - io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]); -ffunc({M,F,A}) when is_integer(A) -> - io_lib:format("~w:~w/~w\n",[M,F,A]). - -format_args([]) -> - ""; -format_args(Args) -> - Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]), - io_lib:format(Str,Args). diff --git a/lib/webtool/src/webtool_sup.erl b/lib/webtool/src/webtool_sup.erl deleted file mode 100644 index e4a05c53ae..0000000000 --- a/lib/webtool/src/webtool_sup.erl +++ /dev/null @@ -1,75 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(webtool_sup). - --behaviour(supervisor). - -%% External exports --export([start_link/0,stop/1]). - -%% supervisor callbacks --export([init/1]). - -%%%---------------------------------------------------------------------- -%%% API -%%%---------------------------------------------------------------------- -start_link() -> - supervisor:start_link({local,websup},webtool_sup, []). - -stop(Pid)-> - exit(Pid,normal). -%%%---------------------------------------------------------------------- -%%% Callback functions from supervisor -%%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, {SupFlags, [ChildSpec]}} | -%% ignore | -%% {error, Reason} -%%---------------------------------------------------------------------- -init(_StartArgs) -> - %%Child1 = - %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, - %%{ok,{{simple_one_for_one,5,10},[Child1]}}. - {ok,{{one_for_one,100,10},[]}}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - - - - - - - - - - - - - - - - - - - diff --git a/lib/webtool/test/Makefile b/lib/webtool/test/Makefile deleted file mode 100644 index 93aa1c09eb..0000000000 --- a/lib/webtool/test/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - webtool_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INSTALL_PROGS= $(TARGET_FILES) - -EMAKEFILE=Emakefile - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/webtool_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include - -EBIN = . - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ - > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ - >> $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) $(GEN_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) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) webtool.spec "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - -release_docs_spec: diff --git a/lib/webtool/test/webtool.spec b/lib/webtool/test/webtool.spec deleted file mode 100644 index 134e6ed40c..0000000000 --- a/lib/webtool/test/webtool.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../webtool_test",all}. diff --git a/lib/webtool/test/webtool_SUITE.erl b/lib/webtool/test/webtool_SUITE.erl deleted file mode 100644 index 9e2d9a2e0f..0000000000 --- a/lib/webtool/test/webtool_SUITE.erl +++ /dev/null @@ -1,51 +0,0 @@ -%% ``Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% --module(webtool_SUITE). - --compile([export_all]). --include_lib("common_test/include/ct.hrl"). - -suite() -> - [{ct_hooks, [ts_install_cth]}]. - -all() -> - [app, appup]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -app() -> - [{doc, "Test that the webtool app file is ok"}]. -app(Config) when is_list(Config) -> - ok = ?t:app_test(webtool). - -appup() -> - [{doc, "Test that the webtool appup file is ok"}]. -appup(Config) when is_list(Config) -> - ok = ?t:appup_test(webtool). diff --git a/lib/webtool/vsn.mk b/lib/webtool/vsn.mk deleted file mode 100644 index 4a701ae6e0..0000000000 --- a/lib/webtool/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -WEBTOOL_VSN=0.9 -- cgit v1.2.3 From 22bb75c811f1922618d4840f5e927333aa231bca Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Mon, 21 Sep 2015 22:44:02 +0100 Subject: Delete remote types-related dead code in erl_types Code became dead in 854ee8b. --- lib/hipe/cerl/erl_types.erl | 105 ++++++++++++-------------------------------- 1 file changed, 27 insertions(+), 78 deletions(-) diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cd2d2fe207..6ce407a1a7 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -140,7 +140,6 @@ t_is_port/1, t_is_port/2, t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, t_is_reference/1, t_is_reference/2, - t_is_remote/1, t_is_string/1, t_is_subtype/2, t_is_tuple/1, t_is_tuple/2, @@ -180,7 +179,6 @@ %% t_maybe_improper_list/2, t_product/1, t_reference/0, - t_remote/3, t_string/0, t_struct_from_opaque/2, t_subst/2, @@ -208,7 +206,6 @@ type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, - subst_all_remote/2, lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, @@ -280,7 +277,6 @@ -define(number_tag, number). -define(opaque_tag, opaque). -define(product_tag, product). --define(remote_tag, remote). -define(tuple_set_tag, tuple_set). -define(tuple_tag, tuple). -define(union_tag, union). @@ -288,7 +284,7 @@ -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag - | ?opaque_tag | ?product_tag | ?remote_tag + | ?opaque_tag | ?product_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. -define(float_qual, float). @@ -330,7 +326,6 @@ %% was updated to 2.7 due to this change. -record(opaque, {mod :: module(), name :: atom(), args = [] :: [erl_type()], struct :: erl_type()}). --record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}). -define(atom(Set), #c{tag=?atom_tag, elements=Set}). -define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}). @@ -350,7 +345,6 @@ -define(map(Pairs), #c{tag=?map_tag, elements=Pairs}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). --define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, qualifier={Arity, Qual}}). -define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}). @@ -380,19 +374,18 @@ %% Unions %% --define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_,_]=List}). - --define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none,?none])). --define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). --define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). --define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). --define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). --define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). --define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). --define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). --define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). --define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). --define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). +-define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}). + +-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). +-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). +-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). +-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). +-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). +-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). +-define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). +-define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). +-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). @@ -679,8 +672,8 @@ list_decorate(List, L, Opaques) -> union_decorate(U1, U2, Opaques) -> Union = union_decorate(U1, U2, Opaques, 0, []), - [A,B,F,I,L,N,T,M,_,_R,Map] = U1, - [_,_,_,_,_,_,_,_,Opaque,_,_] = U2, + [A,B,F,I,L,N,T,M,_,Map] = U1, + [_,_,_,_,_,_,_,_,Opaque,_] = U2, List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, @@ -792,21 +785,6 @@ list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- -%% Remote types: these types are used for preprocessing; -%% they should never reach the analysis stage. - --spec t_remote(atom(), atom(), [erl_type()]) -> erl_type(). - -t_remote(Mod, Name, Args) -> - ?remote(set_singleton(#remote{mod = Mod, name = Name, args = Args})). - --spec t_is_remote(erl_type()) -> boolean(). - -t_is_remote(Type) -> - do_opaque(Type, 'universe', fun is_remote/1). - -is_remote(?remote(_)) -> true; -is_remote(_) -> false. -type mod_records() :: dict:dict(module(), type_table()). @@ -2178,8 +2156,6 @@ t_sup(?opaque(Set1), ?opaque(Set2)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; %%t_sup(T1, T2=?opaque(_,_,_)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; -t_sup(?remote(Set1), ?remote(Set2)) -> - ?remote(set_union_no_limit(Set1, Set2)); t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) -> ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2)); t_sup(?nil, ?nil) -> ?nil; @@ -2373,7 +2349,6 @@ force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); -force_union(T = ?remote(_)) -> ?remote_union(T); force_union(T = ?map(_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); @@ -2880,8 +2855,8 @@ inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). inf_union(U1, U2, Opaques) -> OpaqueFun = fun(Union1, Union2, InfFun) -> - [_,_,_,_,_,_,_,_,Opaque,_,_] = Union1, - [A,B,F,I,L,N,T,M,_,_R,Map] = Union2, + [_,_,_,_,_,_,_,_,Opaque,_] = Union1, + [A,B,F,I,L,N,T,M,_,Map] = Union2, List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, @@ -3060,18 +3035,6 @@ t_subst_aux(?union(List), VarMap) -> ?union([t_subst_aux(E, VarMap) || E <- List]); t_subst_aux(T, _VarMap) -> T. - --spec subst_all_remote(erl_type(), erl_type()) -> erl_type(). - -subst_all_remote(Type0, Substitute) -> - Map = - fun(Type) -> - case t_is_remote(Type) of - true -> Substitute; - false -> Type - end - end, - t_map(Map, Type0). %%----------------------------------------------------------------------------- %% Unification @@ -3175,11 +3138,11 @@ unify_union1(?union(List), T1, T2) -> end. unify_union(List) -> - [A,B,F,I,L,N,T,M,O,R,Map] = List, + [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> no; true -> S = t_opaque_structure(O), - {yes, t_sup([A,B,F,I,L,N,T,M,S,R,Map])} + {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])} end. -spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). @@ -3537,10 +3500,10 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1,Map1] = U1, - [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2,Map2] = U2, - List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1,Map1], - List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2,Map2], + [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1, + [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2, + List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1], + List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2], Sub1 = subtract_union(List1, List2, 0, []), O = if O1 =:= ?none -> O1; true -> t_subtract(O1, ?union(U2)) @@ -3656,7 +3619,7 @@ t_unopaque(?product(Types), Opaques) -> ?product([t_unopaque(T, Opaques) || T <- Types]); t_unopaque(?function(Domain, Range), Opaques) -> ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques)); -t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> +t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), @@ -3665,7 +3628,7 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,R,Map]), Opaques) -> ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,R,UMap])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,UMap])|UO]); t_unopaque(T, _) -> T. @@ -3932,16 +3895,6 @@ t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; -t_to_string(?remote(Set), RecDict) -> - string:join([case Args =:= [] of - true -> flat_format("~w:~w()", [Mod, Name]); - false -> - ArgString = comma_sequence(Args, RecDict), - flat_format("~w:~w(~s)", [Mod, Name, ArgString]) - end - || #remote{mod = Mod, name = Name, args = Args} <- - set_to_list(Set)], - " | "); t_to_string(?map(Pairs), RecDict) -> "#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; @@ -4825,13 +4778,13 @@ do_opaque(?opaque(_) = Type, Opaques, Pred) -> false -> Pred(Type) end; do_opaque(?union(List) = Type, Opaques, Pred) -> - [A,B,F,I,L,N,T,M,O,R,Map] = List, + [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> Pred(Type); true -> case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of true -> S = t_opaque_structure(O), - do_opaque(t_sup([A,B,F,I,L,N,T,M,S,R,Map]), Opaques, Pred); + do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred); false -> Pred(Type) end end; @@ -4865,10 +4818,6 @@ set_union(S1, S2) -> _ -> ?any end. -set_union_no_limit(?any, _) -> ?any; -set_union_no_limit(_, ?any) -> ?any; -set_union_no_limit(S1, S2) -> ordsets:union(S1, S2). - %% The intersection and subtraction can return ?none. %% This should always be handled right away since ?none is not a valid set. %% However, ?any is considered a valid set. -- cgit v1.2.3 From c0c2f6a204d83ee89cd179b0a6d5996e248539e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Mon, 19 Oct 2015 16:55:24 +0200 Subject: Use full list of bindings when matching on map keys Prior to this patch, the following code would not eval: X = key, (fun(#{X := value}) -> true end)(#{X => value}) That's because the key evaluation was using the new list of bindings introduced on every anonymous fun. Since keys only match on values defined prior to the pattern and do not introduce any new binding, we must use the full and original list of binding. --- lib/stdlib/src/erl_eval.erl | 2 +- lib/stdlib/test/erl_eval_SUITE.erl | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index ca3cc43b19..568eb1c852 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1184,7 +1184,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, Bs0), + {value, Ke, _} = expr(K, BBs), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b9c4ad0a46..50fc62a00e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1483,6 +1483,16 @@ eep43(Config) when is_list(Config) -> " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " "end.", #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), + check(fun () -> + X = key, + (fun(#{X := value}) -> true end)(#{X => value}) + end, + "begin " + " X = key, " + " (fun(#{X := value}) -> true end)(#{X => value}) " + "end.", + true), + error_check("[camembert]#{}.", {badmap,[camembert]}), error_check("[camembert]#{nonexisting:=v}.", {badmap,[camembert]}), error_check("#{} = 1.", {badmatch,1}), -- cgit v1.2.3 From 285b4fa13914dc4748c1020213a9c65cad3d2738 Mon Sep 17 00:00:00 2001 From: Serge Aleynikov Date: Tue, 2 Jun 2015 08:44:23 -0400 Subject: erts: Add {line_delimiter, byte()} option to inet:setopts/2 A new {line_delimiter, byte()} option allows line-oriented TCP-based protocols to use a custom line delimiting character. It is to be used in conjunction with {packet, line}. This option also works with erlang:decode_packet/3 when its first argument is 'line'. --- bootstrap/bin/start.boot | Bin 5285 -> 5285 bytes bootstrap/bin/start_clean.boot | Bin 5285 -> 5285 bytes bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11536 -> 11540 bytes bootstrap/lib/compiler/ebin/beam_block.beam | Bin 14776 -> 14828 bytes bootstrap/lib/compiler/ebin/beam_disasm.beam | Bin 26320 -> 26320 bytes bootstrap/lib/compiler/ebin/beam_jump.beam | Bin 9444 -> 9448 bytes bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 29640 -> 30304 bytes bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 50068 -> 50072 bytes bootstrap/lib/kernel/ebin/application.beam | Bin 4620 -> 4620 bytes bootstrap/lib/kernel/ebin/code.beam | Bin 7136 -> 7152 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 28580 -> 28916 bytes bootstrap/lib/kernel/ebin/dist_util.beam | Bin 10568 -> 10568 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 13516 -> 13768 bytes bootstrap/lib/kernel/ebin/inet.beam | Bin 23076 -> 23156 bytes bootstrap/lib/kernel/ebin/inet6_tcp.beam | Bin 2676 -> 3044 bytes bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam | Bin 6248 -> 768 bytes bootstrap/lib/kernel/ebin/inet_db.beam | Bin 26652 -> 26764 bytes bootstrap/lib/kernel/ebin/inet_dns.beam | Bin 19808 -> 19764 bytes bootstrap/lib/kernel/ebin/inet_tcp.beam | Bin 2484 -> 2756 bytes bootstrap/lib/kernel/ebin/inet_tcp_dist.beam | Bin 6808 -> 7224 bytes bootstrap/lib/kernel/ebin/net_kernel.beam | Bin 22760 -> 22760 bytes bootstrap/lib/stdlib/ebin/edlin.beam | Bin 10196 -> 10260 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 308128 -> 84208 bytes bootstrap/lib/stdlib/ebin/erl_pp.beam | Bin 26880 -> 27072 bytes bootstrap/lib/stdlib/ebin/error_logger_file_h.beam | Bin 5124 -> 4708 bytes bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam | Bin 5052 -> 4976 bytes bootstrap/lib/stdlib/ebin/ets.beam | Bin 22604 -> 22720 bytes bootstrap/lib/stdlib/ebin/gen_event.beam | Bin 19752 -> 19624 bytes bootstrap/lib/stdlib/ebin/gen_fsm.beam | Bin 17412 -> 17412 bytes bootstrap/lib/stdlib/ebin/gen_server.beam | Bin 19648 -> 19596 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11248 -> 11536 bytes bootstrap/lib/stdlib/ebin/proc_lib.beam | Bin 10460 -> 10692 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 76520 -> 76684 bytes bootstrap/lib/stdlib/ebin/re.beam | Bin 13844 -> 13672 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 30452 -> 30464 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 24072 -> 24080 bytes bootstrap/lib/stdlib/ebin/supervisor_bridge.beam | Bin 2932 -> 2908 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 27080 -> 26840 bytes bootstrap/lib/stdlib/include/assert.hrl | 261 +++++++++++++++++++++ erts/doc/src/erlang.xml | 4 + erts/emulator/beam/atom.names | 1 + erts/emulator/beam/erl_bif_port.c | 10 +- erts/emulator/beam/packet_parser.c | 5 +- erts/emulator/beam/packet_parser.h | 3 +- erts/emulator/drivers/common/inet_drv.c | 11 +- erts/preloaded/ebin/prim_inet.beam | Bin 72748 -> 36456 bytes erts/preloaded/src/prim_inet.erl | 3 + lib/kernel/doc/src/inet.xml | 5 + lib/kernel/src/inet.erl | 4 +- lib/kernel/src/inet_int.hrl | 1 + lib/kernel/test/bif_SUITE.erl | 10 + lib/kernel/test/gen_tcp_api_SUITE.erl | 17 +- 52 files changed, 327 insertions(+), 8 deletions(-) create mode 100644 bootstrap/lib/stdlib/include/assert.hrl diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot index 25c092961c..cd628918e0 100644 Binary files a/bootstrap/bin/start.boot and b/bootstrap/bin/start.boot differ diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot index 25c092961c..cd628918e0 100644 Binary files a/bootstrap/bin/start_clean.boot and b/bootstrap/bin/start_clean.boot differ diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index b25c33084f..6dcce01def 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam index 59084464a0..5d1e45fd72 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_block.beam and b/bootstrap/lib/compiler/ebin/beam_block.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index b63864c96c..7c5dca424f 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam index 8dd6375403..630a370a94 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_jump.beam and b/bootstrap/lib/compiler/ebin/beam_jump.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index 38b749d9ae..8b13cea141 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam index 1b5467a54b..4c2a702ef8 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam index d8e98c021b..97c6d9d415 100644 Binary files a/bootstrap/lib/kernel/ebin/application.beam and b/bootstrap/lib/kernel/ebin/application.beam differ diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index 55d123c6a2..cbef1633ee 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index aa75ae9bd1..13ec972cc2 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam index c92373c68e..f87dd4a45c 100644 Binary files a/bootstrap/lib/kernel/ebin/dist_util.beam and b/bootstrap/lib/kernel/ebin/dist_util.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index fc12b6b194..8e2911cd13 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam index a76806293f..e989be2ca6 100644 Binary files a/bootstrap/lib/kernel/ebin/inet.beam and b/bootstrap/lib/kernel/ebin/inet.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam index d080a1200b..96dd4739ea 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_tcp.beam and b/bootstrap/lib/kernel/ebin/inet6_tcp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam index 3f98206013..1be1dc1c57 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam index 8c7c6ba218..f1e5cb3548 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_db.beam and b/bootstrap/lib/kernel/ebin/inet_db.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam index 0c5b6c73e1..b1c3bf3369 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_dns.beam and b/bootstrap/lib/kernel/ebin/inet_dns.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam index 60e0d9f569..c2b42fef1c 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_tcp.beam and b/bootstrap/lib/kernel/ebin/inet_tcp.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam index a3635e5dde..1b389cbb4d 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam index 9a0bfa2ba4..e0bb445bf5 100644 Binary files a/bootstrap/lib/kernel/ebin/net_kernel.beam and b/bootstrap/lib/kernel/ebin/net_kernel.beam differ diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam index 4d052a0c50..aaa080bd97 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin.beam and b/bootstrap/lib/stdlib/ebin/edlin.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 0522f5c05e..4b0e853390 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam index f38ba5fa71..97d8913447 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_pp.beam and b/bootstrap/lib/stdlib/ebin/erl_pp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam index 5c1bc6045f..0b98a9ceed 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam index 9711f57e43..565904b903 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam index 7d30fc9fc1..9ac333dbee 100644 Binary files a/bootstrap/lib/stdlib/ebin/ets.beam and b/bootstrap/lib/stdlib/ebin/ets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam index bc3e71f6a7..d22f9ec402 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_event.beam and b/bootstrap/lib/stdlib/ebin/gen_event.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam index 268b8798c8..119c20e1d7 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_fsm.beam and b/bootstrap/lib/stdlib/ebin/gen_fsm.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam index 1e1e530eea..d6e5d223fb 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_server.beam and b/bootstrap/lib/stdlib/ebin/gen_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 52b13fb974..9e63d204b6 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam index cb6a8d6049..0f732c8cae 100644 Binary files a/bootstrap/lib/stdlib/ebin/proc_lib.beam and b/bootstrap/lib/stdlib/ebin/proc_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 0e59d769a4..90bc537b85 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam index 9e140def2c..875c4a5513 100644 Binary files a/bootstrap/lib/stdlib/ebin/re.beam and b/bootstrap/lib/stdlib/ebin/re.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index 3b2d0eb0fa..51e2b503ab 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index 6dd01bf004..ce7b63a6c2 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam index 1ebc561ee5..4af6cc8f40 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam and b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index e80b6ae0cd..83407cdb87 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ diff --git a/bootstrap/lib/stdlib/include/assert.hrl b/bootstrap/lib/stdlib/include/assert.hrl new file mode 100644 index 0000000000..f913760102 --- /dev/null +++ b/bootstrap/lib/stdlib/include/assert.hrl @@ -0,0 +1,261 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(ASSERT_HRL). +-define(ASSERT_HRL, true). + +%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to +%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes +%% precedence, and NOASSERT will become undefined. +%% +%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or +%% ASSERT are defined. +%% +%% If asserts are disabled, all assert macros are defined to be the atom +%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok' +%% as the result if the test succeeds, and raise an error exception if the +%% test fails. The error term will then have the form {Name, Info} where +%% Name is the name of the macro and Info is a list of tagged tuples. + +%% allow NODEBUG to imply NOASSERT, unless DEBUG +-ifdef(NODEBUG). +-ifndef(DEBUG). +-ifndef(NOASSERT). +-define(NOASSERT, true). +-endif. +-endif. +-endif. + +%% allow ASSERT to override NOASSERT +-ifdef(ASSERT). +-undef(NOASSERT). +-endif. + +%% Assert macros must not depend on any non-kernel or stdlib libraries. +%% +%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid +%% exporting local variables, and furthermore we only use variable names +%% prefixed with "__", that hopefully will not be bound outside the fun. +%% It is not possible to nest assert macros. + +-ifdef(NOASSERT). +-define(assert(BoolExpr),ok). +-else. +%% The assert macro is written the way it is so as not to cause warnings +%% for clauses that cannot match, even if the expression is a constant. +-define(assert(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + true -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, true}, + case __V of false -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assert, for convenience. +-ifdef(NOASSERT). +-define(assertNot(BoolExpr),ok). +-else. +-define(assertNot(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + false -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, false}, + case __V of true -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is mostly a convenience which gives more detailed reports. +%% Note: Guard is a guarded pattern, and can not be used for value. +-ifdef(NOASSERT). +-define(assertMatch(Guard, Expr), ok). +-else. +-define(assertMatch(Guard, Expr), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). +-endif. + +%% This is a convenience macro which gives more detailed reports when +%% the expected LHS value is not a pattern, but a computed value +-ifdef(NOASSERT). +-define(assertEqual(Expect, Expr), ok). +-else. +-define(assertEqual(Expect, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)(Expect)) + end). +-endif. + +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected)) + end). +-endif. + +%% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. +-ifdef(NOASSERT). +-define(assertException(Class, Term, Expr), ok). +-else. +-define(assertException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). +-endif. + +-define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). + +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). +-endif. + +-endif. % ASSERT_HRL diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 0492924164..1963b27915 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -933,6 +933,10 @@ if packet_size itself is not set. This use is only intended for backward compatibility.

 + {line_delimiter, 0 ≤ char() ≤ 255} +

For packet type line, sets delimiting character. + Default $\n.

+

Examples:

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index f9a2f3e33e..190e7817dc 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -321,6 +321,7 @@ atom ldflags
 atom Le='=<'
 atom lf
 atom line
+atom line_delimiter
 atom line_length
 atom linked_in_driver
 atom links
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index 3ff54c7a60..e47d7bcbbb 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -1329,7 +1329,8 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
     ErlSubBin* rest;
     Eterm res;
     Eterm options;
-    int code;
+    int   code;
+    char  delimiter = '\n';
 
     if (!is_binary(BIF_ARG_2) || 
         (!is_list(BIF_ARG_3) && !is_nil(BIF_ARG_3))) {
@@ -1370,6 +1371,11 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
                 case am_line_length:
                     trunc_len = val;
                     goto next_option;
+                case am_line_delimiter:
+                    if (type == TCP_PB_LINE_LF && val >= 0 && val <= 255) {
+                        delimiter = (char)val;
+                        goto next_option;
+                    }
                 }
             }
         }
@@ -1390,7 +1396,7 @@ BIF_RETTYPE decode_packet_3(BIF_ALIST_3)
         pca.aligned_ptr = bin_ptr;
     }
     packet_sz = packet_get_length(type, (char*)pca.aligned_ptr, pca.bin_sz,
-                                  max_plen, trunc_len, &http_state);
+                                  max_plen, trunc_len, delimiter, &http_state);
     if (!(packet_sz > 0 && packet_sz <= pca.bin_sz)) {
         if (packet_sz < 0) {
 	    goto error;
diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c
index 2dd421a9e9..a737a86f14 100644
--- a/erts/emulator/beam/packet_parser.c
+++ b/erts/emulator/beam/packet_parser.c
@@ -256,6 +256,7 @@ int packet_get_length(enum PacketParseType htype,
                       const char* ptr, unsigned n, /* Bytes read so far */
                       unsigned max_plen,     /* Max packet length, 0=no limit */
                       unsigned trunc_len,    /* Truncate (lines) if longer, 0=no limit */
+                      char     delimiter,    /* Line delimiting character */
                       int*     statep)       /* Protocol specific state */
 {
     unsigned hlen, plen;
@@ -299,9 +300,9 @@ int packet_get_length(enum PacketParseType htype,
         goto remain;
 
     case TCP_PB_LINE_LF: {
-        /* TCP_PB_LINE_LF:  [Data ... \n]  */
+        /* TCP_PB_LINE_LF:  [Data ... Delimiter]  */
         const char* ptr2;
-        if ((ptr2 = memchr(ptr, '\n', n)) == NULL) {
+        if ((ptr2 = memchr(ptr, delimiter, n)) == NULL) {
             if (n > max_plen && max_plen != 0) { /* packet full */
                 DEBUGF((" => packet full (no NL)=%d\r\n", n));
                 goto error;
diff --git a/erts/emulator/beam/packet_parser.h b/erts/emulator/beam/packet_parser.h
index ff158ff8b8..717d905fad 100644
--- a/erts/emulator/beam/packet_parser.h
+++ b/erts/emulator/beam/packet_parser.h
@@ -105,7 +105,8 @@ int packet_get_length(enum PacketParseType htype,
 		      const char* ptr, unsigned n,  /* Bytes read so far */
 		      unsigned max_plen,      /* Packet max length, 0=no limit */
 		      unsigned trunc_len,     /* Truncate (lines) if longer, 0=no limit */
-		      int* statep);           /* Internal protocol state */
+		      char     delimiter,     /* Line delimiting character */
+		      int*     statep);       /* Internal protocol state */
 
 ERTS_GLB_INLINE
 void packet_get_body(enum PacketParseType htype,
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 89b71aa66a..a829599fe5 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -885,6 +885,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
 #define INET_LOPT_MSGQ_LOWTRMRK     37  /* set local msgq low watermark */
 #define INET_LOPT_NETNS             38  /* Network namespace pathname */
 #define INET_LOPT_TCP_SHOW_ECONNRESET 39  /* tell user about incoming RST */
+#define INET_LOPT_LINE_DELIM        40  /* Line delimiting char */
 /* SCTP options: a separate range, from 100: */
 #define SCTP_OPT_RTOINFO		100
 #define SCTP_OPT_ASSOCINFO		101
@@ -1154,6 +1155,7 @@ typedef struct {
 #else
     Uint32        send_oct[2];  /* number of octets sent, 64 bits */
 #endif
+    char          delimiter;    /* Line delimiting character (def: '\n')  */
     unsigned long send_cnt;     /* number of packets sent */
     unsigned long send_max;     /* maximum packet send */
     double send_avg;            /* average packet size sent */
@@ -6276,6 +6278,12 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
 	    }
 	    continue;
 
+	case INET_LOPT_LINE_DELIM:
+	    DEBUGF(("inet_set_opts(%ld): s=%d, LINE_DELIM=%d\r\n",
+		    (long)desc->port, desc->s, ival));
+	    desc->delimiter = (char)ival;
+	    continue;
+
 	case INET_OPT_REUSEADDR: 
 #ifdef __WIN32__
 	    continue;  /* Bjorn says */
@@ -8371,6 +8379,7 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol)
     desc->deliver = INET_DELIVER_TERM; /* standard term format */
     desc->active  = INET_PASSIVE;      /* start passive */
     desc->active_count = 0;
+    desc->delimiter    = '\n';         /* line delimiting char */
     desc->oph = NULL;
     desc->opt = NULL;
 
@@ -9882,7 +9891,7 @@ static int tcp_remain(tcp_descriptor* desc, int* len)
 
     tlen = packet_get_length(desc->inet.htype, ptr, n, 
                              desc->inet.psize, desc->i_bufsz,
-                             &desc->http_state);
+                             desc->inet.delimiter, &desc->http_state);
 
     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));
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 5a188be3ba..6cf8d30cb2 100644
Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ
diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl
index 4d04e1dacb..d5c8fd4268 100644
--- a/erts/preloaded/src/prim_inet.erl
+++ b/erts/preloaded/src/prim_inet.erl
@@ -1147,6 +1147,7 @@ enc_opt(packet_size)     -> ?INET_LOPT_PACKET_SIZE;
 enc_opt(read_packets)    -> ?INET_LOPT_READ_PACKETS;
 enc_opt(netns)           -> ?INET_LOPT_NETNS;
 enc_opt(show_econnreset) -> ?INET_LOPT_TCP_SHOW_ECONNRESET;
+enc_opt(line_delimiter)  -> ?INET_LOPT_LINE_DELIM;
 enc_opt(raw)             -> ?INET_OPT_RAW;
 % Names of SCTP opts:
 enc_opt(sctp_rtoinfo)	 	   -> ?SCTP_OPT_RTOINFO;
@@ -1205,6 +1206,7 @@ dec_opt(?INET_LOPT_PACKET_SIZE)      -> packet_size;
 dec_opt(?INET_LOPT_READ_PACKETS)     -> read_packets;
 dec_opt(?INET_LOPT_NETNS)           -> netns;
 dec_opt(?INET_LOPT_TCP_SHOW_ECONNRESET) -> show_econnreset;
+dec_opt(?INET_LOPT_LINE_DELIM)      -> line_delimiter;
 dec_opt(?INET_OPT_RAW)              -> raw;
 dec_opt(I) when is_integer(I)     -> undefined.
 
@@ -1287,6 +1289,7 @@ type_opt_1(packet) ->
 	   {httph_bin,?TCP_PB_HTTPH_BIN},
 	   {ssl, ?TCP_PB_SSL_TLS}, % obsolete
 	   {ssl_tls, ?TCP_PB_SSL_TLS}]};
+type_opt_1(line_delimiter)  -> int;
 type_opt_1(mode) ->
     {enum,[{list, ?INET_MODE_LIST},
 	   {binary, ?INET_MODE_BINARY}]};
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index e5d7ce048a..e6d418dc58 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -981,6 +981,11 @@ setcap cap_sys_admin,cap_sys_ptrace,cap_dac_read_search+epi beam.smp
 	    indicated length are accepted and not considered invalid due
 	    to internal buffer limitations.

           
+          {line_delimiter, Char}(TCP/IP sockets)
+          
+            
Sets the line delimiting character for line oriented protocols
+              (line). Default value is $\n.

+          
 
 		  {priority, Priority}
            
Set the protocol-defined priority for all packets to be sent
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index da7f04089d..855c6377a3 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -671,7 +671,7 @@ stats() ->
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 connect_options() ->
     [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay,
-     header, active, packet, packet_size, buffer, mode, deliver,
+     header, active, packet, packet_size, buffer, mode, deliver, line_delimiter,
      exit_on_close, high_watermark, low_watermark, high_msgq_watermark,
      low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw,
      show_econnreset].
@@ -721,6 +721,8 @@ con_opt([Opt | Opts], #connect_opts{} = R, As) ->
         {active,N} when is_integer(N), N < 32768, N >= -32768 ->
             NOpts = lists:keydelete(active, 1, R#connect_opts.opts),
             con_opt(Opts, R#connect_opts { opts = [{active,N}|NOpts] }, As);
+	{line_delimiter,C} when is_integer(C), C >= 0, C =< 255 ->
+	    con_add(line_delimiter, C, R, Opts, As);
 	{Name,Val} when is_atom(Name) -> con_add(Name, Val, R, Opts, As);
 	_ -> {error, badarg}
     end;
diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl
index bfe4c9ec8c..e7c6cf8ae2 100644
--- a/lib/kernel/src/inet_int.hrl
+++ b/lib/kernel/src/inet_int.hrl
@@ -149,6 +149,7 @@
 -define(INET_LOPT_MSGQ_LOWTRMRK,  37).
 -define(INET_LOPT_NETNS,          38).
 -define(INET_LOPT_TCP_SHOW_ECONNRESET, 39).
+-define(INET_LOPT_LINE_DELIM,     40).
 % Specific SCTP options: separate range:
 -define(SCTP_OPT_RTOINFO,	 	100).
 -define(SCTP_OPT_ASSOCINFO,	 	101).
diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl
index c3840f3d16..dd3010567a 100644
--- a/lib/kernel/test/bif_SUITE.erl
+++ b/lib/kernel/test/bif_SUITE.erl
@@ -33,6 +33,7 @@
 	 spawn_failures/1,
 
 	 run_fun/1,
+     decode_packet_delim/1,
 	 wilderness/1]).
 
 -export([init_per_testcase/2, end_per_testcase/2]).
@@ -516,6 +517,15 @@ fetch_proc_vals(Pid) ->
     {value,{heap_size,HS}} = lists:keysearch(heap_size, 1, PI),
     ?line {Ls, P, FA, HS}.
      
+decode_packet_delim(doc) ->
+    ["Test erlang:packet_delim/3 with {line_delimiter,0} option"];
+decode_packet_delim(suite) ->
+    [];
+decode_packet_delim(Config) when is_list(Config) ->
+    {ok,<<"abc",0>>,<<"efg",0>>} =
+        erlang:decode_packet(line, <<"abc",0,"efg",0>>, [{line_delimiter, 0}]),
+    {more, undefined} = erlang:decode_packet(line, <<"abc",0,"efg",0>>, []).
+
 % This testcase should probably be moved somewhere else
 wilderness(doc) ->
     ["Test that memory allocation command line options affecting the"
diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
index a051d504b2..2febb1bd68 100644
--- a/lib/kernel/test/gen_tcp_api_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -31,7 +31,7 @@
 	 init_per_testcase/2, end_per_testcase/2,
 	 t_connect_timeout/1, t_accept_timeout/1,
 	 t_connect_bad/1,
-	 t_recv_timeout/1, t_recv_eof/1,
+	 t_recv_timeout/1, t_recv_eof/1, t_recv_delim/1,
 	 t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1,
 	 t_shutdown_async/1,
 	 t_fdopen/1, t_fdconnect/1, t_implicit_inet6/1]).
@@ -131,6 +131,21 @@ t_recv_eof(Config) when is_list(Config) ->
     ?line {error, closed} = gen_tcp:recv(Client, 0),
     ok.
 
+t_recv_delim(doc) -> "Test using message delimiter $X";
+t_recv_delim(suite) -> [];
+t_recv_delim(Config) when is_list(Config) ->
+    {ok, L} = gen_tcp:listen(0, []),
+    {ok, Port} = inet:port(L),
+    Opts = [{active,false},{packet,line},{line_delimiter,$X}],
+    {ok, Client} = gen_tcp:connect(localhost, Port, Opts),
+    {ok, A} = gen_tcp:accept(L),
+    ok = gen_tcp:send(A, "abcXefgX"),
+    {ok, "abcX"} = gen_tcp:recv(Client, 0, 0),
+    {ok, "efgX"} = gen_tcp:recv(Client, 0, 0),
+    ok = gen_tcp:close(Client),
+    ok = gen_tcp:close(A),
+    ok.
+
 %%% gen_tcp:shutdown/2
 
 t_shutdown_write(Config) when is_list(Config) ->
-- 
cgit v1.2.3


From 8377afdf5f56d018a1b439bbccc918ce123a834b Mon Sep 17 00:00:00 2001
From: Ingela Anderton Andin 
Date: Fri, 16 Oct 2015 11:43:20 +0200
Subject: erts: Clarify documentation

---
 erts/doc/src/erlang.xml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 1963b27915..70d000f763 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -874,10 +874,10 @@
           
           line
           
-            
A packet is a line terminated with newline. The
-              newline character is included in the returned packet
-              unless the line was truncated according to option
-              line_length.
 
+            
A packet is a line terminated by a delimiter byte,
+            default is the latin1 newline character. The delimiter
+            byte is included in the returned packet unless the line
+            was truncated according to option line_length.

           
           asn1 | cdr | sunrm | fcgi | tpkt
           
@@ -933,9 +933,9 @@
                 if packet_size itself is not set. This use is
                 only intended for backward compatibility.

               
-              {line_delimiter, 0 ≤ char() ≤ 255}
-              
For packet type line, sets delimiting character.
-                Default $\n.

+              {line_delimiter, 0 =< byte() =< 255}
+              
For packet type line, sets the delimiting byte.
+                Default is the latin1 character $\n.

               
             
         
Examples:

-- 
cgit v1.2.3


From 235bf943d762bfdb5638d23b3270f92c50050b0a Mon Sep 17 00:00:00 2001
From: Ingela Anderton Andin 
Date: Fri, 23 Oct 2015 10:34:49 +0200
Subject: erts: Include test in group so that it is run

---
 lib/kernel/test/gen_tcp_api_SUITE.erl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
index 2febb1bd68..962471c20c 100644
--- a/lib/kernel/test/gen_tcp_api_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -48,7 +48,7 @@ all() ->
 groups() -> 
     [{t_accept, [], [t_accept_timeout]},
      {t_connect, [], [t_connect_timeout, t_connect_bad]},
-     {t_recv, [], [t_recv_timeout, t_recv_eof]}].
+     {t_recv, [], [t_recv_timeout, t_recv_eof, t_recv_delim]}].
 
 
 
-- 
cgit v1.2.3


From 33ddd3f0699cbb4aa9aea2ec7fcf690d5c498c53 Mon Sep 17 00:00:00 2001
From: Luca Favatella 
Date: Fri, 16 Oct 2015 00:31:11 +0100
Subject: Teach Dialyzer call to funs `M:F/A` (literal M, F, A)

---
 lib/dialyzer/src/dialyzer_analysis_callgraph.erl   | 22 ++++++++++++++++++
 lib/dialyzer/src/dialyzer_callgraph.erl            | 27 ++++++++++++++++++++--
 .../test/small_SUITE_data/results/fun_arity        |  2 ++
 .../test/small_SUITE_data/results/non_existing     |  1 +
 4 files changed, 50 insertions(+), 2 deletions(-)

diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index c57a22129c..826ac51775 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -624,6 +624,28 @@ find_call_file_and_line(Tree, MFA) ->
 		  MFA ->
 		    Ann = cerl:get_ann(SubTree),
 		    [{get_file(Ann), get_line(Ann)}|Acc];
+		  {erlang, make_fun, 3} ->
+		    [CA1, CA2, CA3] = cerl:call_args(SubTree),
+		    case
+		      cerl:is_c_atom(CA1) andalso
+		      cerl:is_c_atom(CA2) andalso
+		      cerl:is_c_int(CA3)
+		    of
+		      true ->
+			case
+			  {cerl:concrete(CA1),
+			   cerl:concrete(CA2),
+			   cerl:concrete(CA3)}
+			of
+			  MFA ->
+			    Ann = cerl:get_ann(SubTree),
+			    [{get_file(Ann), get_line(Ann)}|Acc];
+			  _ ->
+			    Acc
+			end;
+		      false ->
+			Acc
+		    end;
 		  _ -> Acc
 		end;
 	      false -> Acc
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index a1cd2015ca..9e53e171c0 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -478,14 +478,37 @@ scan_one_core_fun(TopTree, FunName) ->
 		  call ->
 		    CalleeM = cerl:call_module(Tree),
 		    CalleeF = cerl:call_name(Tree),
-		    A = length(cerl:call_args(Tree)),
+		    CalleeArgs = cerl:call_args(Tree),
+		    A = length(CalleeArgs),
 		    case (cerl:is_c_atom(CalleeM) andalso 
 			  cerl:is_c_atom(CalleeF)) of
 		      true -> 
 			M = cerl:atom_val(CalleeM),
 			F = cerl:atom_val(CalleeF),
 			case erl_bif_types:is_known(M, F, A) of
-			  true -> Acc;
+			  true ->
+			    case {M, F, A} of
+			      {erlang, make_fun, 3} ->
+				[CA1, CA2, CA3] = CalleeArgs,
+				case
+				  cerl:is_c_atom(CA1) andalso
+				  cerl:is_c_atom(CA2) andalso
+				  cerl:is_c_int(CA3)
+				of
+				  true ->
+				    MM = cerl:atom_val(CA1),
+				    FF = cerl:atom_val(CA2),
+				    AA = cerl:int_val(CA3),
+				    case erl_bif_types:is_known(MM, FF, AA) of
+				      true -> Acc;
+				      false -> [{FunName, {MM, FF, AA}}|Acc]
+				    end;
+				  false ->
+				    Acc
+				end;
+			      _ ->
+				Acc
+			    end;
 			  false -> [{FunName, {M, F, A}}|Acc]
 			end;
 		      false -> 
diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_arity b/lib/dialyzer/test/small_SUITE_data/results/fun_arity
index 280f5490d0..cc9db65152 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/fun_arity
+++ b/lib/dialyzer/test/small_SUITE_data/results/fun_arity
@@ -31,5 +31,7 @@ fun_arity.erl:81: Function mfa_ne_1_ko/0 has no local return
 fun_arity.erl:83: Function mf_ne/1 will never be called
 fun_arity.erl:89: Fun application will fail since _cor0 :: fun(() -> any()) is not a function of arity 1
 fun_arity.erl:89: Function mfa_nd_0_ko/0 has no local return
+fun_arity.erl:90: Call to missing or unexported function fun_arity:mf_nd/0
 fun_arity.erl:93: Fun application will fail since _cor0 :: fun((_) -> any()) is not a function of arity 0
 fun_arity.erl:93: Function mfa_nd_1_ko/0 has no local return
+fun_arity.erl:94: Call to missing or unexported function fun_arity:mf_nd/1
diff --git a/lib/dialyzer/test/small_SUITE_data/results/non_existing b/lib/dialyzer/test/small_SUITE_data/results/non_existing
index 58da2bfc8b..b0da5998c7 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/non_existing
+++ b/lib/dialyzer/test/small_SUITE_data/results/non_existing
@@ -1,2 +1,3 @@
 
+non_existing.erl:12: Call to missing or unexported function lists:non_existing_fun/1
 non_existing.erl:9: Call to missing or unexported function lists:non_existing_call/1
-- 
cgit v1.2.3


From fcf198456fcd8e80c78b58c6616f7cf1266406cc Mon Sep 17 00:00:00 2001
From: Magnus Henoch 
Date: Wed, 28 Oct 2015 17:06:10 +0000
Subject: Report bad options for TLS distribution connections

If ssl:ssl_accept/2 returns an error related to options, it's most
likely something we want to log.  In particular, if the specified
certificate file doesn't exist, this is where the error ends up, so we
shouldn't just throw the error away.
---
 lib/ssl/src/ssl_tls_dist_proxy.erl | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
index a22af6b960..e7f7fa96a1 100644
--- a/lib/ssl/src/ssl_tls_dist_proxy.erl
+++ b/lib/ssl/src/ssl_tls_dist_proxy.erl
@@ -157,6 +157,11 @@ accept_loop(Proxy, world = Type, Listen, Extra) ->
 				   end),
 		    ok = ssl:controlling_process(SslSocket, PairHandler),
 		    flush_old_controller(PairHandler, SslSocket);
+		{error, {options, _}} = Error ->
+		    %% Bad options: that's probably our fault.  Let's log that.
+		    error_logger:error_msg("Cannot accept TLS distribution connection: ~s~n",
+					   [ssl:format_error(Error)]),
+		    gen_tcp:close(Socket);
 		_ ->
 		    gen_tcp:close(Socket)
 	    end;
-- 
cgit v1.2.3


From c4e594710f0e822db06a277b0a763e02d73d6e24 Mon Sep 17 00:00:00 2001
From: Magnus Henoch 
Date: Wed, 28 Oct 2015 17:25:07 +0000
Subject: TLS distribution: wait for code server

As described in the comments in the patch, doing a TLS handshake
requires the crypto module to be loaded.  The crypto module needs the
code server to find its NIF library.  However, there is a time window
between opening the listening ports for distribution and starting the
code server, and if we get an incoming connection in that time window,
the node would believe that it's alive, but it wouldn't actually
accept any more connections.
---
 lib/ssl/src/ssl_tls_dist_proxy.erl | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
index a22af6b960..cc4c410520 100644
--- a/lib/ssl/src/ssl_tls_dist_proxy.erl
+++ b/lib/ssl/src/ssl_tls_dist_proxy.erl
@@ -149,6 +149,7 @@ accept_loop(Proxy, world = Type, Listen, Extra) ->
     case gen_tcp:accept(Listen) of
 	{ok, Socket} ->
 	    Opts = get_ssl_options(server),
+	    wait_for_code_server(),
 	    case ssl:ssl_accept(Socket, Opts) of
 		{ok, SslSocket} ->
 		    PairHandler =
@@ -165,6 +166,35 @@ accept_loop(Proxy, world = Type, Listen, Extra) ->
     end,
     accept_loop(Proxy, Type, Listen, Extra).
 
+wait_for_code_server() ->
+    %% This is an ugly hack.  Upgrading a socket to TLS requires the
+    %% crypto module to be loaded.  Loading the crypto module triggers
+    %% its on_load function, which calls code:priv_dir/1 to find the
+    %% directory where its NIF library is.  However, distribution is
+    %% started earlier than the code server, so the code server is not
+    %% necessarily started yet, and code:priv_dir/1 might fail because
+    %% of that, if we receive an incoming connection on the
+    %% distribution port early enough.
+    %%
+    %% If the on_load function of a module fails, the module is
+    %% unloaded, and the function call that triggered loading it fails
+    %% with 'undef', which is rather confusing.
+    %%
+    %% Thus, the ssl_tls_dist_proxy process will terminate, and be
+    %% restarted by ssl_dist_sup.  However, it won't have any memory
+    %% of being asked by net_kernel to listen for incoming
+    %% connections.  Hence, the node will believe that it's open for
+    %% distribution, but it actually isn't.
+    %%
+    %% So let's avoid that by waiting for the code server to start.
+    case whereis(code_server) of
+	undefined ->
+	    timer:sleep(10),
+	    wait_for_code_server();
+	Pid when is_pid(Pid) ->
+	    ok
+    end.
+
 try_connect(Port) ->
     case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of
 	R = {ok, _S} ->
-- 
cgit v1.2.3


From 30a4adb7d4b534a512a717244ebaeb29c78cddc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 29 Sep 2015 13:59:47 +0200
Subject: epp_SUITE: Add smoke and coverage test of format_error/1

---
 lib/stdlib/test/epp_SUITE.erl | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 4e5df661b3..2ac2316ce9 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -1528,8 +1528,11 @@ compile_test(Config, Test0) ->
 
 warnings(File, Ws) ->
     case lists:append([W || {F, W} <- Ws, F =:= File]) of
-        [] -> [];
-        L -> {warnings, L}
+        [] ->
+	    [];
+        L ->
+	    call_format_error(L),
+	    {warnings, L}
     end.
 
 compile_file(File, Opts) ->
@@ -1540,12 +1543,20 @@ compile_file(File, Opts) ->
     end.
 
 errs([{File,Es}|L], File) ->
+    call_format_error(Es),
     Es ++ errs(L, File);
 errs([_|L], File) ->
     errs(L, File);
 errs([], _File) ->
     [].
 
+%% Smoke test and coverage of format_error/1.
+call_format_error([{_,M,E}|T]) ->
+    _ = M:format_error(E),
+    call_format_error(T);
+call_format_error([]) ->
+    ok.
+
 epp_parse_file(File, Opts) ->
     case epp:parse_file(File, Opts) of
         {ok, Forms} ->
-- 
cgit v1.2.3


From a657f1f5e4d1d520865497fc0421ebd5f43ca70d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Thu, 29 Oct 2015 16:03:36 +0100
Subject: epp_SUITE: Avoid hard-coding list of macros more than once

---
 lib/stdlib/test/epp_SUITE.erl | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 2ac2316ce9..199d2f193d 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -826,14 +826,14 @@ otp_8130(Config) when is_list(Config) ->
                                "-define(a, 3.14).\n"
                                "t() -> ?a.\n"),
     ?line {ok,Epp} = epp:open(File, []),
-    ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE',
-           'MACHINE','MODULE','MODULE_STRING'] = macs(Epp),
+    PreDefMacs = macs(Epp),
+    ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE',
+     'MACHINE','MODULE','MODULE_STRING'] = PreDefMacs,
     ?line {ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp),
     ?line {ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp),
     ?line {ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp),
     ?line {eof,_} = epp:scan_erl_form(Epp),
-    ?line ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE',
-           'MACHINE','MODULE','MODULE_STRING',a] = macs(Epp),
+    [a] = macs(Epp) -- PreDefMacs,
     ?line epp:close(Epp),
 
     %% escript
-- 
cgit v1.2.3


From 5066ac923c1dbaa90d63e39b52b60f883284a8ad Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 24 Sep 2015 13:43:32 +0200
Subject: hipe/dialyzer: Remove functions from erl_bif_types

---
 lib/dialyzer/test/small_SUITE_data/results/bif1    |  3 +
 .../test/small_SUITE_data/src/bif1/bif1.erl        | 16 ++++
 .../test/small_SUITE_data/src/bif1/bif1_adt.erl    | 12 +++
 lib/hipe/cerl/erl_bif_types.erl                    | 89 ----------------------
 4 files changed, 31 insertions(+), 89 deletions(-)
 create mode 100644 lib/dialyzer/test/small_SUITE_data/results/bif1
 create mode 100644 lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl
 create mode 100644 lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl

diff --git a/lib/dialyzer/test/small_SUITE_data/results/bif1 b/lib/dialyzer/test/small_SUITE_data/results/bif1
new file mode 100644
index 0000000000..289b6f821f
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/bif1
@@ -0,0 +1,3 @@
+
+bif1.erl:13: Function string_chars/0 has no local return
+bif1.erl:16: The call string:chars(S::65,10,L2::bif1_adt:s()) contains an opaque term as 3rd argument when terms of different types are expected in these positions
diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl
new file mode 100644
index 0000000000..bc746538d3
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1.erl
@@ -0,0 +1,16 @@
+-module(bif1).
+
+%% Other set of warnings due to removed of functions from
+%% erl_bif_types.
+
+-export([ets_rename/0, string_chars/0]).
+
+ets_rename() ->
+    A = ets:new(fipp, []),
+    true = not is_atom(A),
+    ets:rename(A, fopp). % No warning
+
+string_chars() ->
+    L2 = bif1_adt:opaque_string(),
+    S = $A,
+    string:chars(S, 10, L2). % Warning
diff --git a/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl
new file mode 100644
index 0000000000..01b0bccc68
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/bif1/bif1_adt.erl
@@ -0,0 +1,12 @@
+-module(bif1_adt).
+
+-export([opaque_string/0]).
+
+-export_type([s/0]).
+
+-opaque s() :: string().
+
+-spec opaque_string() -> s().
+
+opaque_string() ->
+    "string".
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index c92a4f2c78..622c235638 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -46,7 +46,6 @@
 		    t_bitstr/0,
 		    t_boolean/0,
 		    t_byte/0,
-		    t_char/0,
 		    t_cons/0,
 		    t_cons/2,
 		    t_cons_hd/1,
@@ -87,7 +86,6 @@
 		    t_is_port/2,
 		    t_is_maybe_improper_list/2,
 		    t_is_reference/2,
-		    t_is_string/1,
 		    t_is_subtype/2,
 		    t_is_tuple/2,
 		    t_list/0,
@@ -552,9 +550,6 @@ type(erlang, bit_size, 1, Xs, Opaques) ->
 type(erlang, byte_size, 1, Xs, Opaques) ->
   strict(erlang, byte_size, 1, Xs,
 	 fun (_) -> t_non_neg_integer() end, Opaques);
-type(erlang, disconnect_node, 1, Xs, Opaques) ->
-  strict(erlang, disconnect_node, 1, Xs,
-         fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end, Opaques);
 %% Guard bif, needs to be here.
 %% Also much more expressive than anything you could write in a spec...
 type(erlang, element, 2, Xs, Opaques) ->
@@ -583,16 +578,9 @@ type(erlang, element, 2, Xs, Opaques) ->
 %% Guard bif, needs to be here.
 type(erlang, float, 1, Xs, Opaques) ->
   strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques);
-type(erlang, fun_info, 1, Xs, Opaques) ->
-  strict(erlang, fun_info, 1, Xs,
-	 fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end, Opaques);
-type(erlang, get_cookie, 0, _, _Opaques) -> t_atom();  % | t_atom('nocookie')
 %% Guard bif, needs to be here.
 type(erlang, hd, 1, Xs, Opaques) ->
   strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques);
-type(erlang, integer_to_list, 2, Xs, Opaques) ->
-  strict(erlang, integer_to_list, 2, Xs,
-	 fun (_) -> t_string() end, Opaques);
 type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias
 %% All type tests are guard BIF's and may be implemented in ways that
 %% cannot be expressed in a type spec, why they are kept in erl_bif_types.
@@ -796,8 +784,6 @@ type(erlang, make_tuple, 3, Xs, Opaques) ->
 	       _Other -> t_tuple()
 	     end
 	 end, Opaques);
-type(erlang, memory, 0, _, _Opaques) ->
-  t_list(t_tuple([t_atom(), t_non_neg_fixnum()]));
 type(erlang, nif_error, 1, Xs, Opaques) ->
   %% this BIF and the next one are stubs for NIFs and never return
   strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques);
@@ -813,8 +799,6 @@ type(erlang, round, 1, Xs, Opaques) ->
   strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques);
 %% Guard bif, needs to be here.
 type(erlang, self, 0, _, _Opaques) -> t_pid();
-type(erlang, set_cookie, 2, Xs, Opaques) ->
-  strict(erlang, set_cookie, 2, Xs, fun (_) -> t_atom('true') end, Opaques);
 type(erlang, setelement, 3, Xs, Opaques) ->
   strict(erlang, setelement, 3, Xs,
 	 fun ([X1, X2, X3]) ->
@@ -849,19 +833,7 @@ type(erlang, setelement, 3, Xs, Opaques) ->
 %% Guard bif, needs to be here.
 type(erlang, size, 1, Xs, Opaques) ->
   strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques);
-type(erlang, spawn, 1, Xs, Opaques) ->
-  strict(erlang, spawn, 1, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn, 2, Xs, Opaques) ->
-  strict(erlang, spawn, 2, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn, 4, Xs, Opaques) ->
-  strict(erlang, spawn, 4, Xs, fun (_) -> t_pid() end, Opaques);
-type(erlang, spawn_link, 1, Xs, _) -> type(erlang, spawn, 1, Xs);  % same
-type(erlang, spawn_link, 2, Xs, _) -> type(erlang, spawn, 2, Xs);  % same
-type(erlang, spawn_link, 4, Xs, _) -> type(erlang, spawn, 4, Xs);  % same
 type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias
-type(erlang, suspend_process, 1, Xs, Opaques) ->
-  strict(erlang, suspend_process, 1, Xs,
-	 fun (_) -> t_atom('true') end, Opaques);
 type(erlang, system_info, 1, Xs, Opaques) ->
   strict(erlang, system_info, 1, Xs,
 	 fun ([Type]) ->
@@ -1014,10 +986,6 @@ type(erlang, tuple_to_list, 1, Xs, Opaques) ->
 		 end
 	     end
 	 end, Opaques);
-type(erlang, yield, 0, _, _Opaques) -> t_atom('true');
-%%-- ets ----------------------------------------------------------------------
-type(ets, rename, 2, Xs, Opaques) ->
-  strict(ets, rename, 2, Xs, fun ([_, Name]) -> Name end, Opaques);
 %%-- hipe_bifs ----------------------------------------------------------------
 type(hipe_bifs, add_ref, 2, Xs, Opaques) ->
   strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_nil() end, Opaques);
@@ -1677,25 +1645,6 @@ type(lists, zipwith3, 4, Xs, Opaques) ->
 	 fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)),
                                         t_nil()) end, Opaques);
 
-%%-- string -------------------------------------------------------------------
-type(string, chars, 2, Xs, Opaques) ->  % NOTE: added to avoid loss of info
-  strict(string, chars, 2, Xs, fun (_) -> t_string() end, Opaques);
-type(string, chars, 3, Xs, Opaques) -> % NOTE: added to avoid loss of info
-  strict(string, chars, 3, Xs,
-	 fun ([Char, N, Tail]) ->
-	     case t_is_nil(Tail) of
-	       true ->
-		 type(string, chars, 2, [Char, N]);
-	       false ->
-		 case t_is_string(Tail) of
-		   true ->
-		     t_string();
-		   false ->
-		     t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail))
-		 end
-	     end
-	 end, Opaques);
-
 %%-----------------------------------------------------------------------------
 type(M, F, A, Xs, _O) when is_atom(M), is_atom(F),
 		       is_integer(A), 0 =< A, A =< 255 ->
@@ -2300,8 +2249,6 @@ arg_types(erlang, bit_size, 1) ->
 %% Guard bif, needs to be here.
 arg_types(erlang, byte_size, 1) ->
   [t_binary()];
-arg_types(erlang, disconnect_node, 1) ->
-  [t_node()];
 arg_types(erlang, halt, 0) ->
   [];
 arg_types(erlang, halt, 1) ->
@@ -2321,17 +2268,11 @@ arg_types(erlang, element, 2) ->
 %% Guard bif, needs to be here.
 arg_types(erlang, float, 1) ->
   [t_number()];
-arg_types(erlang, fun_info, 1) ->
-  [t_fun()];
-arg_types(erlang, get_cookie, 0) ->
-  [];
 %% Guard bif, needs to be here.
 arg_types(erlang, hd, 1) ->
   [t_cons()];
 arg_types(erlang, info, 1) ->
   arg_types(erlang, system_info, 1); % alias
-arg_types(erlang, integer_to_list, 2) ->
-  [t_integer(), t_from_range(2, 36)];
 arg_types(erlang, is_atom, 1) ->
   [t_any()];
 arg_types(erlang, is_binary, 1) ->
@@ -2378,8 +2319,6 @@ arg_types(erlang, make_tuple, 2) ->
   [t_non_neg_fixnum(), t_any()];  % the value 0 is OK as first argument
 arg_types(erlang, make_tuple, 3) ->
   [t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))];
-arg_types(erlang, memory, 0) ->
-  [];
 arg_types(erlang, nif_error, 1) ->
   [t_any()];
 arg_types(erlang, nif_error, 2) ->
@@ -2396,29 +2335,13 @@ arg_types(erlang, round, 1) ->
 %% Guard bif, needs to be here.
 arg_types(erlang, self, 0) ->
   [];
-arg_types(erlang, set_cookie, 2) ->
-  [t_node(), t_atom()];
 arg_types(erlang, setelement, 3) ->
   [t_pos_integer(), t_tuple(), t_any()];
 %% Guard bif, needs to be here.
 arg_types(erlang, size, 1) ->
   [t_sup(t_tuple(), t_binary())];
-arg_types(erlang, spawn, 1) -> %% TODO: Tuple?
-  [t_fun()];
-arg_types(erlang, spawn, 2) -> %% TODO: Tuple?
-  [t_node(), t_fun()];
-arg_types(erlang, spawn, 4) -> %% TODO: Tuple?
-  [t_node(), t_atom(), t_atom(), t_list()];
-arg_types(erlang, spawn_link, 1) ->
-  arg_types(erlang, spawn, 1);  % same
-arg_types(erlang, spawn_link, 2) ->
-  arg_types(erlang, spawn, 2);  % same
-arg_types(erlang, spawn_link, 4) ->
-  arg_types(erlang, spawn, 4);  % same
 arg_types(erlang, subtract, 2) ->
   arg_types(erlang, '--', 2);
-arg_types(erlang, suspend_process, 1) ->
-  [t_pid()];
 arg_types(erlang, system_info, 1) ->
   [t_sup([t_atom(),                     % documented
 	  t_tuple([t_atom(), t_any()]), % documented
@@ -2437,11 +2360,6 @@ arg_types(erlang, tuple_size, 1) ->
   [t_tuple()];
 arg_types(erlang, tuple_to_list, 1) ->
   [t_tuple()];
-arg_types(erlang, yield, 0) ->
-  [];
-%%------- ets -----------------------------------------------------------------
-arg_types(ets, rename, 2) ->
-  [t_atom(), t_atom()];
 %%------- hipe_bifs -----------------------------------------------------------
 arg_types(hipe_bifs, add_ref, 2) ->
   [t_mfa(), t_tuple([t_mfa(),
@@ -2638,13 +2556,6 @@ arg_types(lists, zipwith, 3) ->
   [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()];
 arg_types(lists, zipwith3, 4) ->
   [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()];
-
-%%------- string --------------------------------------------------------------
-arg_types(string, chars, 2) ->
-  [t_char(), t_non_neg_integer()];
-arg_types(string, chars, 3) ->
-  [t_char(), t_non_neg_integer(), t_any()];
-%%-----------------------------------------------------------------------------
 arg_types(M, F, A) when is_atom(M), is_atom(F),
 			is_integer(A), 0 =< A, A =< 255 ->
   unknown.                     % safe approximation for all functions.
-- 
cgit v1.2.3


From b93e9b611056828ac2c82f225960aa29348ebe97 Mon Sep 17 00:00:00 2001
From: Andrew Bennett 
Date: Wed, 10 Jun 2015 13:48:30 -0600
Subject: stdlib: Add BIF binary:split/2 and binary:split/3

---
 erts/emulator/beam/atom.names       |   2 +
 erts/emulator/beam/bif.tab          |   7 +
 erts/emulator/beam/erl_bif_binary.c | 697 ++++++++++++++++++++++++++++++++++++
 lib/stdlib/src/binary.erl           |  77 +---
 4 files changed, 714 insertions(+), 69 deletions(-)

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index f9a2f3e33e..3d357886ee 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -121,6 +121,7 @@ atom binary_longest_prefix_trap
 atom binary_longest_suffix_trap
 atom binary_match_trap
 atom binary_matches_trap
+atom binary_split_trap
 atom binary_to_list_continue
 atom binary_to_term_trap
 atom block
@@ -584,6 +585,7 @@ atom trace trace_ts traced
 atom trace_control_word
 atom tracer
 atom trap_exit
+atom trim
 atom try_clause
 atom true
 atom tuple
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 4f0656d174..65f8d6f1f5 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -643,3 +643,10 @@ bif erts_debug:map_info/1
 #
 
 bif erlang:hash/2
+
+#
+# New in 19.0
+#
+
+bif binary:split/2
+bif binary:split/3
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 134aa2d396..68e5fe23c7 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -67,12 +67,16 @@ static Export binary_bin_to_list_trap_export;
 static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3);
 static Export binary_copy_trap_export;
 static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
+static Export binary_split_trap_export;
+static BIF_RETTYPE binary_split_trap(BIF_ALIST_3);
 static Uint max_loop_limit;
 
 static BIF_RETTYPE
 binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
 static BIF_RETTYPE
 binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+static BIF_RETTYPE
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
 
 void erts_init_bif_binary(void)
 {
@@ -100,6 +104,10 @@ void erts_init_bif_binary(void)
 			  am_erlang, am_binary_copy_trap, 2,
 			  &binary_copy_trap);
 
+    erts_init_trap_export(&binary_split_trap_export,
+			  am_erlang, am_binary_split_trap, 3,
+			  &binary_split_trap);
+
     max_loop_limit = 0;
     return;
 }
@@ -2534,6 +2542,695 @@ BIF_RETTYPE binary_copy_2(BIF_ALIST_2)
     return do_binary_copy(BIF_P,BIF_ARG_1,BIF_ARG_2);
 }
 
+#define BINARY_SPLIT_GLOBAL	0x01
+#define BINARY_SPLIT_TRIM	0x02
+
+static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
+			   Uint hsend, Uint hsflags, Eterm type, Binary *bin,
+			   Eterm state_term, Eterm *res_term)
+{
+    byte *bytes;
+    Uint bitoffs, bitsize;
+    byte *temp_alloc = NULL;
+
+    ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+    if (bitsize != 0) {
+	goto badarg;
+    }
+    if (bitoffs != 0) {
+	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
+    }
+    if (state_term != NIL) {
+	Eterm *ptr = big_val(state_term);
+	type = ptr[1];
+	hsflags = (Uint)(ptr[2]);
+    }
+
+    if (hsflags & BINARY_SPLIT_GLOBAL) {
+	if (type == am_bm) {
+	    BMData *bm;
+	    Sint pos;
+	    Eterm ret;
+	    Eterm *hp;
+	    BMFindAllState state;
+	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_bm_data(bm);
+#endif
+	    if (state_term == NIL) {
+		bm_init_find_all(&state, hsstart, hsend);
+	    } else {
+		Eterm *ptr = big_val(state_term);
+		bm_restore_find_all(&state, (char *)(ptr+3));
+	    }
+
+	    pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
+	    if (pos == BM_NOT_FOUND) {
+		hp = HAlloc(p, 2);
+		ret = NIL;
+		ret = CONS(hp, subject, ret);
+	    } else if (pos == BM_RESTART) {
+		int x =
+		    (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap bm!\n");
+#endif
+		hp = HAlloc(p, x+3);
+		hp[0] = make_pos_bignum_header(x+2);
+		hp[1] = type;
+		hp[2] = (Eterm)(hsflags);
+		bm_serialize_find_all(&state, (char *)(hp+3));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		bm_clean_find_all(&state);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		size_t orig_size;
+		Eterm orig;
+		Uint offset;
+		Uint bit_offset;
+		Uint bit_size;
+		ErlSubBin *sb;
+		FindallData *fad = state.out;
+		int i, j, k;
+		orig_size = binary_size(subject);
+		j = state.m - 1;
+		k = (int)(orig_size);
+		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - fad[j].pos - fad[j].len) == 0) {
+		    for (i = (j - 1); i >= 0; --i) {
+			if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
+			    break;
+			}
+		    }
+		    if (i == -1) {
+			if (fad[0].pos == 0) {
+			    ret = NIL;
+			} else {
+			    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+			    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+			    sb = (ErlSubBin *)(hp);
+			    sb->thing_word = HEADER_SUB_BIN;
+			    sb->size = fad[0].pos;
+			    sb->offs = offset;
+			    sb->orig = orig;
+			    sb->bitoffs = bit_offset;
+			    sb->bitsize = bit_size;
+			    sb->is_writable = 0;
+			    fad[0].epos = make_binary(sb);
+			    hp += ERL_SUB_BIN_SIZE;
+
+			    ret = NIL;
+			    ret = CONS(hp, make_binary(sb), ret);
+			    hp += 2;
+			}
+			erts_free_aligned_binary_bytes(temp_alloc);
+			bm_clean_find_all(&state);
+			BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+			*res_term = ret;
+			return DO_BIN_MATCH_OK;
+		    }
+		    j = i;
+		    k = fad[j+1].pos;
+		}
+		hp = HAlloc(p, (j + 2) * (ERL_SUB_BIN_SIZE + 2));
+		ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+		sb = (ErlSubBin *)(hp);
+		sb->thing_word = HEADER_SUB_BIN;
+		sb->size = fad[0].pos;
+		sb->offs = offset;
+		sb->orig = orig;
+		sb->bitoffs = bit_offset;
+		sb->bitsize = 0;
+		sb->is_writable = 0;
+		fad[0].epos = make_binary(sb);
+		hp += ERL_SUB_BIN_SIZE;
+
+		for (i = 1; i <= j; ++i) {
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+		    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = 0;
+		    sb->is_writable = 0;
+		    fad[i].epos = make_binary(sb);
+		    hp += ERL_SUB_BIN_SIZE;
+		}
+		ret = NIL;
+		sb = (ErlSubBin *)(hp);
+		sb->thing_word = HEADER_SUB_BIN;
+		sb->size = k - fad[j].pos - fad[j].len;
+		sb->offs = offset + fad[j].pos + fad[j].len;
+		sb->orig = orig;
+		sb->bitoffs = bit_offset;
+		sb->bitsize = bit_size;
+		sb->is_writable = 0;
+		hp += ERL_SUB_BIN_SIZE;
+		ret = CONS(hp, make_binary(sb), ret);
+		hp += 2;
+		for (i = j; i >= 0; --i) {
+		    ret = CONS(hp, fad[i].epos, ret);
+		    hp += 2;
+		}
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    bm_clean_find_all(&state);
+	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+	    *res_term = ret;
+	    return DO_BIN_MATCH_OK;
+	} else if (type == am_ac) {
+	    ACTrie *act;
+	    int acr;
+	    ACFindAllState state;
+	    Eterm ret;
+	    Eterm *hp;
+	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_ac_trie(act);
+#endif
+	    if (state_term == NIL) {
+		ac_init_find_all(&state, act, hsstart, hsend);
+	    } else {
+		Eterm *ptr = big_val(state_term);
+		ac_restore_find_all(&state, (char *)(ptr+3));
+	    }
+	    acr = ac_find_all_non_overlapping(&state, bytes, &reds);
+	    if (acr == AC_NOT_FOUND) {
+		hp = HAlloc(p, 2);
+		ret = NIL;
+		ret = CONS(hp, subject, ret);
+	    } else if (acr == AC_RESTART) {
+		int x = (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap ac!\n");
+#endif
+		hp = HAlloc(p, x+3);
+		hp[0] = make_pos_bignum_header(x+2);
+		hp[1] = type;
+		hp[2] = (Eterm)(hsflags);
+		ac_serialize_find_all(&state, (char *)(hp+3));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		ac_clean_find_all(&state);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		size_t orig_size;
+		Eterm orig;
+		Uint offset;
+		Uint bit_offset;
+		Uint bit_size;
+		ErlSubBin *sb;
+		FindallData *fad = state.out;
+		int i, j, k;
+		orig_size = binary_size(subject);
+		j = state.m - 1;
+		k = (int)(orig_size);
+		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - fad[j].pos - fad[j].len) == 0) {
+		    for (i = (j - 1); i >= 0; --i) {
+			if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
+			    break;
+			}
+		    }
+		    if (i == -1) {
+			if (fad[0].pos == 0) {
+			    ret = NIL;
+			} else {
+			    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+			    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+			    sb = (ErlSubBin *)(hp);
+			    sb->thing_word = HEADER_SUB_BIN;
+			    sb->size = fad[0].pos;
+			    sb->offs = offset;
+			    sb->orig = orig;
+			    sb->bitoffs = bit_offset;
+			    sb->bitsize = bit_size;
+			    sb->is_writable = 0;
+			    fad[0].epos = make_binary(sb);
+			    hp += ERL_SUB_BIN_SIZE;
+
+			    ret = NIL;
+			    ret = CONS(hp, make_binary(sb), ret);
+			    hp += 2;
+			}
+			erts_free_aligned_binary_bytes(temp_alloc);
+			ac_clean_find_all(&state);
+			BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+			*res_term = ret;
+			return DO_BIN_MATCH_OK;
+		    }
+		    j = i;
+		    k = fad[j+1].pos;
+		}
+		hp = HAlloc(p, (j + 2) * (ERL_SUB_BIN_SIZE + 2));
+		ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+		sb = (ErlSubBin *)(hp);
+		sb->thing_word = HEADER_SUB_BIN;
+		sb->size = fad[0].pos;
+		sb->offs = offset;
+		sb->orig = orig;
+		sb->bitoffs = bit_offset;
+		sb->bitsize = 0;
+		sb->is_writable = 0;
+		fad[0].epos = make_binary(sb);
+		hp += ERL_SUB_BIN_SIZE;
+
+		for (i = 1; i <= j; ++i) {
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+		    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = 0;
+		    sb->is_writable = 0;
+		    fad[i].epos = make_binary(sb);
+		    hp += ERL_SUB_BIN_SIZE;
+		}
+		ret = NIL;
+		sb = (ErlSubBin *)(hp);
+		sb->thing_word = HEADER_SUB_BIN;
+		sb->size = k - fad[j].pos - fad[j].len;
+		sb->offs = offset + fad[j].pos + fad[j].len;
+		sb->orig = orig;
+		sb->bitoffs = bit_offset;
+		sb->bitsize = bit_size;
+		sb->is_writable = 0;
+		hp += ERL_SUB_BIN_SIZE;
+		ret = CONS(hp, make_binary(sb), ret);
+		hp += 2;
+		for (i = j; i >= 0; --i) {
+		    ret = CONS(hp, fad[i].epos, ret);
+		    hp += 2;
+		}
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    ac_clean_find_all(&state);
+	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+	    *res_term = ret;
+	    return DO_BIN_MATCH_OK;
+	}
+    } else {
+	if (type == am_bm) {
+	    BMData *bm;
+	    Sint pos;
+	    Eterm ret;
+	    Eterm *hp;
+	    BMFindFirstState state;
+	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_bm_data(bm);
+#endif
+	    if (state_term == NIL) {
+		bm_init_find_first_match(&state, hsstart, hsend);
+	    } else {
+		Eterm *ptr = big_val(state_term);
+		memcpy((void *)(&state), (const void *)(ptr+3), sizeof(BMFindFirstState));
+	    }
+
+#ifdef HARDDEBUG
+	    erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
+			state.len);
+#endif
+	    pos = bm_find_first_match(&state, bm, bytes, &reds);
+	    if (pos == BM_NOT_FOUND) {
+		hp = HAlloc(p, 2);
+		ret = NIL;
+		ret = CONS(hp, subject, ret);
+	    } else if (pos == BM_RESTART) {
+		int x =
+		    (sizeof(state) / sizeof(Eterm)) +
+		    !!(sizeof(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap bm!\n");
+#endif
+		hp = HAlloc(p, x+3);
+		hp[0] = make_pos_bignum_header(x+2);
+		hp[1] = type;
+		hp[2] = (Eterm)(hsflags);
+		memcpy((void *)(hp+3), (const void *)(&state), sizeof(state));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		size_t orig_size;
+		Eterm orig;
+		Uint offset;
+		Uint bit_offset;
+		Uint bit_size;
+		ErlSubBin *sb1;
+		ErlSubBin *sb2;
+
+		orig_size = binary_size(subject);
+
+		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - pos - bm->len) == 0) {
+		    if (pos == 0) {
+			ret = NIL;
+		    } else {
+			hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = (ErlSubBin *) hp;
+			sb1->thing_word = HEADER_SUB_BIN;
+			sb1->size = pos;
+			sb1->offs = offset;
+			sb1->orig = orig;
+			sb1->bitoffs = bit_offset;
+			sb1->bitsize = bit_size;
+			sb1->is_writable = 0;
+			hp += ERL_SUB_BIN_SIZE;
+
+			ret = NIL;
+			ret = CONS(hp, make_binary(sb1), ret);
+			hp += 2;
+		    }
+		} else {
+		    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+		    sb1 = (ErlSubBin *) hp;
+		    sb1->thing_word = HEADER_SUB_BIN;
+		    sb1->size = pos;
+		    sb1->offs = offset;
+		    sb1->orig = orig;
+		    sb1->bitoffs = bit_offset;
+		    sb1->bitsize = 0;
+		    sb1->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    sb2 = (ErlSubBin *) hp;
+		    sb2->thing_word = HEADER_SUB_BIN;
+		    sb2->size = orig_size - pos - bm->len;
+		    sb2->offs = offset + pos + bm->len;
+		    sb2->orig = orig;
+		    sb2->bitoffs = bit_offset;
+		    sb2->bitsize = bit_size;
+		    sb2->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb2), ret);
+		    hp += 2;
+		    ret = CONS(hp, make_binary(sb1), ret);
+		    hp += 2;
+		}
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+	    *res_term = ret;
+	    return DO_BIN_MATCH_OK;
+	} else if (type == am_ac) {
+	    ACTrie *act;
+	    Uint pos, rlen;
+	    int acr;
+	    ACFindFirstState state;
+	    Eterm ret;
+	    Eterm *hp;
+	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_ac_trie(act);
+#endif
+	    if (state_term == NIL) {
+		ac_init_find_first_match(&state, act, hsstart, hsend);
+	    } else {
+		Eterm *ptr = big_val(state_term);
+		memcpy((void *)(&state), (const void *)(ptr+3), sizeof(ACFindFirstState));
+	    }
+	    acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
+	    if (acr == AC_NOT_FOUND) {
+		hp = HAlloc(p, 2);
+		ret = NIL;
+		ret = CONS(hp, subject, ret);
+	    } else if (acr == AC_RESTART) {
+		int x =
+		    (sizeof(state) / sizeof(Eterm)) +
+		    !!(sizeof(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap ac!\n");
+#endif
+		hp = HAlloc(p, x+3);
+		hp[0] = make_pos_bignum_header(x+2);
+		hp[1] = type;
+		hp[2] = (Eterm)(hsflags);
+		memcpy((void *)(hp+3), (const void *)(&state), sizeof(state));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		size_t orig_size;
+		Eterm orig;
+		Uint offset;
+		Uint bit_offset;
+		Uint bit_size;
+		ErlSubBin *sb1;
+		ErlSubBin *sb2;
+
+		orig_size = binary_size(subject);
+
+		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - pos - rlen) == 0) {
+		    if (pos == 0) {
+			ret = NIL;
+		    } else {
+			hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = (ErlSubBin *) hp;
+			sb1->thing_word = HEADER_SUB_BIN;
+			sb1->size = pos;
+			sb1->offs = offset;
+			sb1->orig = orig;
+			sb1->bitoffs = bit_offset;
+			sb1->bitsize = bit_size;
+			sb1->is_writable = 0;
+			hp += ERL_SUB_BIN_SIZE;
+
+			ret = NIL;
+			ret = CONS(hp, make_binary(sb1), ret);
+			hp += 2;
+		    }
+		} else {
+		    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+		    sb1 = (ErlSubBin *) hp;
+		    sb1->thing_word = HEADER_SUB_BIN;
+		    sb1->size = pos;
+		    sb1->offs = offset;
+		    sb1->orig = orig;
+		    sb1->bitoffs = bit_offset;
+		    sb1->bitsize = 0;
+		    sb1->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    sb2 = (ErlSubBin *) hp;
+		    sb2->thing_word = HEADER_SUB_BIN;
+		    sb2->size = orig_size - pos - rlen;
+		    sb2->offs = offset + pos + rlen;
+		    sb2->orig = orig;
+		    sb2->bitoffs = bit_offset;
+		    sb2->bitsize = bit_size;
+		    sb2->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb2), ret);
+		    hp += 2;
+		    ret = CONS(hp, make_binary(sb1), ret);
+		    hp += 2;
+		}
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+	    *res_term = ret;
+	    return DO_BIN_MATCH_OK;
+	}
+    }
+ badarg:
+    return DO_BIN_MATCH_BADARG;
+}
+
+static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
+{
+    Eterm *tp;
+    Uint pos;
+    Sint len;
+    *optp = 0;
+    *posp = 0;
+    *endp = binary_size(bin);
+    if (l == ((Eterm) 0) || l == NIL) {
+	return 0;
+    } else if (is_list(l)) {
+	while(is_list(l)) {
+	    Eterm t = CAR(list_val(l));
+	    Uint orig_size;
+	    if (is_atom(t)) {
+		if (t == am_global) {
+		    *optp |= BINARY_SPLIT_GLOBAL;
+		    l = CDR(list_val(l));
+		    continue;
+		}
+		if (t == am_trim) {
+		    *optp |= BINARY_SPLIT_TRIM;
+		    l = CDR(list_val(l));
+		    continue;
+		}
+	    }
+	    if (!is_tuple(t)) {
+		goto badarg;
+	    }
+	    tp = tuple_val(t);
+	    if (arityval(*tp) != 2) {
+		goto badarg;
+	    }
+	    if (tp[1] != am_scope || is_not_tuple(tp[2])) {
+		goto badarg;
+	    }
+	    tp = tuple_val(tp[2]);
+	    if (arityval(*tp) != 2) {
+		goto badarg;
+	    }
+	    if (!term_to_Uint(tp[1], &pos)) {
+		goto badarg;
+	    }
+	    if (!term_to_Sint(tp[2], &len)) {
+		goto badarg;
+	    }
+	    if (len < 0) {
+		Uint lentmp = -(Uint)len;
+		/* overflow */
+		if ((Sint)lentmp < 0) {
+		    goto badarg;
+		}
+		len = lentmp;
+		pos -= len;
+	    }
+	    /* overflow */
+	    if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+		goto badarg;
+	    }
+	    *endp = len + pos;
+	    *posp = pos;
+	    if ((orig_size = binary_size(bin)) < pos ||
+		orig_size < (*endp)) {
+		goto badarg;
+	    }
+	    l = CDR(list_val(l));
+	}
+	return 0;
+    } else {
+    badarg:
+	return 1;
+    }
+}
+
+static BIF_RETTYPE binary_split_trap(BIF_ALIST_3)
+{
+    int runres;
+    Eterm result;
+    Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+    runres = do_binary_split(BIF_P,BIF_ARG_1,0,0,0,NIL,bin,BIF_ARG_2,&result);
+    if (runres == DO_BIN_MATCH_OK) {
+	BIF_RET(result);
+    } else {
+	BUMP_ALL_REDS(BIF_P);
+	BIF_TRAP3(&binary_split_trap_export, BIF_P, BIF_ARG_1, result,
+		  BIF_ARG_3);
+    }
+}
+
+BIF_RETTYPE binary_split_3(BIF_ALIST_3)
+{
+    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
+    Uint hsflags;
+    Uint hsstart;
+    Uint hsend;
+    Eterm *tp;
+    Eterm type;
+    Binary *bin;
+    Eterm bin_term = NIL;
+    int runres;
+    Eterm result;
+
+    if (is_not_binary(arg1)) {
+	goto badarg;
+    }
+    if (parse_split_opts_list(arg3, arg1, &hsstart, &hsend, &hsflags)) {
+	goto badarg;
+    }
+    if (hsend == 0) {
+	tp = HAlloc(p, 2);
+	result = NIL;
+	result = CONS(tp, arg1, result);
+	BIF_RET(result);
+    }
+    if (is_tuple(arg2)) {
+	tp = tuple_val(arg2);
+	if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
+	    goto badarg;
+	}
+	if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
+	    !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
+	    goto badarg;
+	}
+	type = tp[1];
+	bin = ((ProcBin *) binary_val(tp[2]))->val;
+	if (type == am_bm &&
+	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
+	    goto badarg;
+	}
+	if (type == am_ac &&
+	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
+	    goto badarg;
+	}
+	bin_term = tp[2];
+    } else if (do_binary_match_compile(arg2, &type, &bin)) {
+	goto badarg;
+    }
+    runres = do_binary_split(p, arg1, hsstart, hsend, hsflags, type, bin, NIL, &result);
+    if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
+	Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+	bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
+    } else if (bin_term == NIL) {
+	erts_bin_free(bin);
+    }
+    switch(runres) {
+    case DO_BIN_MATCH_OK:
+	BIF_RET(result);
+    case DO_BIN_MATCH_RESTART:
+	BIF_TRAP3(&binary_split_trap_export, p, arg1, result, bin_term);
+    default:
+	goto badarg;
+    }
+ badarg:
+    BIF_ERROR(p,BADARG);
+}
+
+
+BIF_RETTYPE binary_split_2(BIF_ALIST_2)
+{
+    return binary_split(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+}
+
+
 BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
 {
     ErlSubBin *sb;
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index af00410572..fb0c395d70 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -20,7 +20,7 @@
 -module(binary).
 %%
 %% Implemented in this module:
--export([split/2,split/3,replace/3,replace/4]).
+-export([replace/3,replace/4]).
 
 -export_type([cp/0]).
 
@@ -34,7 +34,8 @@
          decode_unsigned/2, encode_unsigned/1, encode_unsigned/2,
          first/1, last/1, list_to_bin/1, longest_common_prefix/1,
          longest_common_suffix/1, match/2, match/3, matches/2,
-         matches/3, part/2, part/3, referenced_byte_size/1]).
+         matches/3, part/2, part/3, referenced_byte_size/1,
+         split/2, split/3]).
 
 -spec at(Subject, Pos) -> byte() when
       Subject :: binary(),
@@ -198,19 +199,13 @@ part(_, _, _) ->
 referenced_byte_size(_) ->
     erlang:nif_error(undef).
 
-%%% End of BIFs.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% split
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
 -spec split(Subject, Pattern) -> Parts when
       Subject :: binary(),
       Pattern :: binary() | [binary()] | cp(),
       Parts :: [binary()].
 
-split(H,N) ->
-    split(H,N,[]).
+split(_, _) ->
+    erlang:nif_error(undef).
 
 -spec split(Subject, Pattern, Options) -> Parts when
       Subject :: binary(),
@@ -219,53 +214,10 @@ split(H,N) ->
       Option :: {scope, part()} | trim | global | trim_all,
       Parts :: [binary()].
 
-split(Haystack,Needles,Options) ->
-    try
-	{Part,Global,Trim,TrimAll} =
-        get_opts_split(Options,{no,false,false,false}),
-	Moptlist = case Part of
-		       no ->
-			   [];
-		       {A,B} ->
-			   [{scope,{A,B}}]
-		   end,
-	MList = if
-		    Global ->
-			binary:matches(Haystack,Needles,Moptlist);
-		    true ->
-			case binary:match(Haystack,Needles,Moptlist) of
-			    nomatch -> [];
-			    Match -> [Match]
-			end
-		end,
-	do_split(Haystack,MList,0,Trim,TrimAll)
-    catch
-	_:_ ->
-	    erlang:error(badarg)
-    end.
-
-do_split(H,[],N,true,_) when N >= byte_size(H) ->
-    [];
-do_split(H,[],N,_,true) when N >= byte_size(H) ->
-    [];
-do_split(H,[],N,_,_) ->
-    [binary:part(H,{N,byte_size(H)-N})];
-do_split(H,[{A,B}|T],N,Trim,TrimAll) ->
-    case binary:part(H,{N,A-N}) of
-	<<>> when TrimAll == true ->
-	    do_split(H,T,A+B,Trim,TrimAll);
-	<<>> ->
-	    Rest =  do_split(H,T,A+B,Trim,TrimAll),
-	    case {Trim, Rest} of
-		{true,[]} ->
-		    [];
-		_ ->
-		    [<<>> | Rest]
-	    end;
-	Oth ->
-	    [Oth | do_split(H,T,A+B,Trim,TrimAll)]
-    end.
+split(_, _, _) ->
+    erlang:nif_error(undef).
 
+%%% End of BIFs.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% replace
@@ -352,19 +304,6 @@ splitat(H,N,[I|T]) ->
 %% Simple helper functions
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-get_opts_split([],{Part,Global,Trim,TrimAll}) ->
-    {Part,Global,Trim,TrimAll};
-get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) ->
-    get_opts_split(T,{{A,B},Global,Trim,TrimAll});
-get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) ->
-    get_opts_split(T,{Part,true,Trim,TrimAll});
-get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) ->
-    get_opts_split(T,{Part,Global,true,TrimAll});
-get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) ->
-    get_opts_split(T,{Part,Global,Trim,true});
-get_opts_split(_,_) ->
-    throw(badopt).
-
 get_opts_replace([],{Part,Global,Insert}) ->
     {Part,Global,Insert};
 get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) ->
-- 
cgit v1.2.3


From d1283d1f826bdbd584bc87572ab46001164939e1 Mon Sep 17 00:00:00 2001
From: Andrew Bennett 
Date: Thu, 25 Jun 2015 11:26:48 -0600
Subject: stdlib: Add BIF option 'trim_all' to binary:split/3

---
 bootstrap/lib/stdlib/ebin/binary.beam | Bin 3812 -> 8408 bytes
 erts/emulator/beam/atom.names         |   1 +
 erts/emulator/beam/erl_bif_binary.c   | 496 ++++++++++++++++++++++++----------
 3 files changed, 349 insertions(+), 148 deletions(-)

diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam
index 666544c492..32d68c2504 100644
Binary files a/bootstrap/lib/stdlib/ebin/binary.beam and b/bootstrap/lib/stdlib/ebin/binary.beam differ
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 3d357886ee..5f27aaa14b 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -586,6 +586,7 @@ atom trace_control_word
 atom tracer
 atom trap_exit
 atom trim
+atom trim_all
 atom try_clause
 atom true
 atom tuple
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 68e5fe23c7..1709f7671d 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -2544,6 +2544,7 @@ BIF_RETTYPE binary_copy_2(BIF_ALIST_2)
 
 #define BINARY_SPLIT_GLOBAL	0x01
 #define BINARY_SPLIT_TRIM	0x02
+#define BINARY_SPLIT_TRIM_ALL	0x04
 
 static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 			   Uint hsend, Uint hsflags, Eterm type, Binary *bin,
@@ -2616,88 +2617,177 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		Uint bit_size;
 		ErlSubBin *sb;
 		FindallData *fad = state.out;
-		int i, j, k;
+		Sint i, j;
+		Sint drop = 0;
+		Sint head = 0;
+		Sint tail;
+		Uint list_size;
+		Uint tail_pos;
+
+		tail = state.m - 1;
+		list_size = state.m + 1;
 		orig_size = binary_size(subject);
-		j = state.m - 1;
-		k = (int)(orig_size);
-		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - fad[j].pos - fad[j].len) == 0) {
-		    for (i = (j - 1); i >= 0; --i) {
-			if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
-			    break;
+		tail_pos = (Uint)(orig_size);
+
+		if (hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) {
+		    if ((orig_size - fad[tail].pos - fad[tail].len) == 0) {
+			list_size--;
+			for (i = (tail - 1); i >= 0; --i) {
+			    if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
+				break;
+			    }
+			    list_size--;
 			}
+			if (i == -1) {
+			    if (fad[head].pos == 0) {
+				ret = NIL;
+			    } else {
+				hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+				ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+				sb = (ErlSubBin *)(hp);
+				sb->thing_word = HEADER_SUB_BIN;
+				sb->size = fad[head].pos;
+				sb->offs = offset;
+				sb->orig = orig;
+				sb->bitoffs = bit_offset;
+				sb->bitsize = bit_size;
+				sb->is_writable = 0;
+				fad[head].epos = make_binary(sb);
+				hp += ERL_SUB_BIN_SIZE;
+
+				ret = NIL;
+				ret = CONS(hp, make_binary(sb), ret);
+				hp += 2;
+			    }
+			    erts_free_aligned_binary_bytes(temp_alloc);
+			    bm_clean_find_all(&state);
+			    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+			    *res_term = ret;
+			    return DO_BIN_MATCH_OK;
+			}
+			tail = i;
+			tail_pos = fad[tail+1].pos;
 		    }
-		    if (i == -1) {
-			if (fad[0].pos == 0) {
-			    ret = NIL;
-			} else {
-			    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-			    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+		}
+		if (hsflags & BINARY_SPLIT_TRIM_ALL) {
+		    if (fad[head].pos == 0) {
+			drop++;
+			list_size--;
+			for (i = drop, j = tail; i <= j; ++i) {
+			    if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
+				break;
+			    }
+			    drop++;
+			    list_size--;
+			}
+			head = drop - 1;
+		    }
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) == 0) {
+			    list_size--;
+			}
+		    }
+
+		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
 
+		    if (drop == 0) {
+			sb = (ErlSubBin *)(hp);
+			sb->thing_word = HEADER_SUB_BIN;
+			sb->size = fad[head].pos;
+			sb->offs = offset;
+			sb->orig = orig;
+			sb->bitoffs = bit_offset;
+			sb->bitsize = 0;
+			sb->is_writable = 0;
+			fad[head].epos = make_binary(sb);
+			hp += ERL_SUB_BIN_SIZE;
+		    }
+
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
 			    sb = (ErlSubBin *)(hp);
 			    sb->thing_word = HEADER_SUB_BIN;
-			    sb->size = fad[0].pos;
-			    sb->offs = offset;
+			    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+			    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
 			    sb->orig = orig;
 			    sb->bitoffs = bit_offset;
-			    sb->bitsize = bit_size;
+			    sb->bitsize = 0;
 			    sb->is_writable = 0;
-			    fad[0].epos = make_binary(sb);
+			    fad[i].epos = make_binary(sb);
 			    hp += ERL_SUB_BIN_SIZE;
+			}
+		    }
 
-			    ret = NIL;
-			    ret = CONS(hp, make_binary(sb), ret);
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
+		    sb->offs = offset + fad[tail].pos + fad[tail].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = bit_size;
+		    sb->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb), ret);
+		    hp += 2;
+		    for (i = tail, j = head; i > j; --i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
+			    ret = CONS(hp, fad[i].epos, ret);
 			    hp += 2;
 			}
-			erts_free_aligned_binary_bytes(temp_alloc);
-			bm_clean_find_all(&state);
-			BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-			*res_term = ret;
-			return DO_BIN_MATCH_OK;
 		    }
-		    j = i;
-		    k = fad[j+1].pos;
-		}
-		hp = HAlloc(p, (j + 2) * (ERL_SUB_BIN_SIZE + 2));
-		ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		sb = (ErlSubBin *)(hp);
-		sb->thing_word = HEADER_SUB_BIN;
-		sb->size = fad[0].pos;
-		sb->offs = offset;
-		sb->orig = orig;
-		sb->bitoffs = bit_offset;
-		sb->bitsize = 0;
-		sb->is_writable = 0;
-		fad[0].epos = make_binary(sb);
-		hp += ERL_SUB_BIN_SIZE;
-
-		for (i = 1; i <= j; ++i) {
+		    if (drop == 0) {
+			ret = CONS(hp, fad[head].epos, ret);
+			hp += 2;
+		    }
+		} else {
+		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
 		    sb = (ErlSubBin *)(hp);
 		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-		    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+		    sb->size = fad[head].pos;
+		    sb->offs = offset;
 		    sb->orig = orig;
 		    sb->bitoffs = bit_offset;
 		    sb->bitsize = 0;
 		    sb->is_writable = 0;
-		    fad[i].epos = make_binary(sb);
+		    fad[head].epos = make_binary(sb);
 		    hp += ERL_SUB_BIN_SIZE;
-		}
-		ret = NIL;
-		sb = (ErlSubBin *)(hp);
-		sb->thing_word = HEADER_SUB_BIN;
-		sb->size = k - fad[j].pos - fad[j].len;
-		sb->offs = offset + fad[j].pos + fad[j].len;
-		sb->orig = orig;
-		sb->bitoffs = bit_offset;
-		sb->bitsize = bit_size;
-		sb->is_writable = 0;
-		hp += ERL_SUB_BIN_SIZE;
-		ret = CONS(hp, make_binary(sb), ret);
-		hp += 2;
-		for (i = j; i >= 0; --i) {
-		    ret = CONS(hp, fad[i].epos, ret);
+
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			sb = (ErlSubBin *)(hp);
+			sb->thing_word = HEADER_SUB_BIN;
+			sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+			sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+			sb->orig = orig;
+			sb->bitoffs = bit_offset;
+			sb->bitsize = 0;
+			sb->is_writable = 0;
+			fad[i].epos = make_binary(sb);
+			hp += ERL_SUB_BIN_SIZE;
+		    }
+
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
+		    sb->offs = offset + fad[tail].pos + fad[tail].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = bit_size;
+		    sb->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb), ret);
 		    hp += 2;
+		    for (i = tail, j = head; i >= j; --i) {
+			ret = CONS(hp, fad[i].epos, ret);
+			hp += 2;
+		    }
 		}
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
@@ -2752,88 +2842,177 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		Uint bit_size;
 		ErlSubBin *sb;
 		FindallData *fad = state.out;
-		int i, j, k;
+		Sint i, j;
+		Sint drop = 0;
+		Sint head = 0;
+		Sint tail;
+		Uint list_size;
+		Uint tail_pos;
+
+		tail = state.m - 1;
+		list_size = state.m + 1;
 		orig_size = binary_size(subject);
-		j = state.m - 1;
-		k = (int)(orig_size);
-		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - fad[j].pos - fad[j].len) == 0) {
-		    for (i = (j - 1); i >= 0; --i) {
-			if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
-			    break;
+		tail_pos = (Uint)(orig_size);
+
+		if (hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) {
+		    if ((orig_size - fad[tail].pos - fad[tail].len) == 0) {
+			list_size--;
+			for (i = (tail - 1); i >= 0; --i) {
+			    if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
+				break;
+			    }
+			    list_size--;
 			}
+			if (i == -1) {
+			    if (fad[head].pos == 0) {
+				ret = NIL;
+			    } else {
+				hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+				ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+				sb = (ErlSubBin *)(hp);
+				sb->thing_word = HEADER_SUB_BIN;
+				sb->size = fad[head].pos;
+				sb->offs = offset;
+				sb->orig = orig;
+				sb->bitoffs = bit_offset;
+				sb->bitsize = bit_size;
+				sb->is_writable = 0;
+				fad[head].epos = make_binary(sb);
+				hp += ERL_SUB_BIN_SIZE;
+
+				ret = NIL;
+				ret = CONS(hp, make_binary(sb), ret);
+				hp += 2;
+			    }
+			    erts_free_aligned_binary_bytes(temp_alloc);
+			    ac_clean_find_all(&state);
+			    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+			    *res_term = ret;
+			    return DO_BIN_MATCH_OK;
+			}
+			tail = i;
+			tail_pos = fad[tail+1].pos;
+		    }
+		}
+		if (hsflags & BINARY_SPLIT_TRIM_ALL) {
+		    if (fad[head].pos == 0) {
+			drop++;
+			list_size--;
+			for (i = drop, j = tail; i <= j; ++i) {
+			    if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
+				break;
+			    }
+			    drop++;
+			    list_size--;
+			}
+			head = drop - 1;
+		    }
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) == 0) {
+			    list_size--;
+			}
+		    }
+
+		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
+		    if (drop == 0) {
+			sb = (ErlSubBin *)(hp);
+			sb->thing_word = HEADER_SUB_BIN;
+			sb->size = fad[head].pos;
+			sb->offs = offset;
+			sb->orig = orig;
+			sb->bitoffs = bit_offset;
+			sb->bitsize = 0;
+			sb->is_writable = 0;
+			fad[head].epos = make_binary(sb);
+			hp += ERL_SUB_BIN_SIZE;
 		    }
-		    if (i == -1) {
-			if (fad[0].pos == 0) {
-			    ret = NIL;
-			} else {
-			    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-			    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
 
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
 			    sb = (ErlSubBin *)(hp);
 			    sb->thing_word = HEADER_SUB_BIN;
-			    sb->size = fad[0].pos;
-			    sb->offs = offset;
+			    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+			    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
 			    sb->orig = orig;
 			    sb->bitoffs = bit_offset;
-			    sb->bitsize = bit_size;
+			    sb->bitsize = 0;
 			    sb->is_writable = 0;
-			    fad[0].epos = make_binary(sb);
+			    fad[i].epos = make_binary(sb);
 			    hp += ERL_SUB_BIN_SIZE;
+			}
+		    }
 
-			    ret = NIL;
-			    ret = CONS(hp, make_binary(sb), ret);
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
+		    sb->offs = offset + fad[tail].pos + fad[tail].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = bit_size;
+		    sb->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb), ret);
+		    hp += 2;
+		    for (i = tail, j = head; i > j; --i) {
+			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
+			    ret = CONS(hp, fad[i].epos, ret);
 			    hp += 2;
 			}
-			erts_free_aligned_binary_bytes(temp_alloc);
-			ac_clean_find_all(&state);
-			BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-			*res_term = ret;
-			return DO_BIN_MATCH_OK;
 		    }
-		    j = i;
-		    k = fad[j+1].pos;
-		}
-		hp = HAlloc(p, (j + 2) * (ERL_SUB_BIN_SIZE + 2));
-		ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		sb = (ErlSubBin *)(hp);
-		sb->thing_word = HEADER_SUB_BIN;
-		sb->size = fad[0].pos;
-		sb->offs = offset;
-		sb->orig = orig;
-		sb->bitoffs = bit_offset;
-		sb->bitsize = 0;
-		sb->is_writable = 0;
-		fad[0].epos = make_binary(sb);
-		hp += ERL_SUB_BIN_SIZE;
-
-		for (i = 1; i <= j; ++i) {
+		    if (drop == 0) {
+			ret = CONS(hp, fad[head].epos, ret);
+			hp += 2;
+		    }
+		} else {
+		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+
 		    sb = (ErlSubBin *)(hp);
 		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-		    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+		    sb->size = fad[head].pos;
+		    sb->offs = offset;
 		    sb->orig = orig;
 		    sb->bitoffs = bit_offset;
 		    sb->bitsize = 0;
 		    sb->is_writable = 0;
-		    fad[i].epos = make_binary(sb);
+		    fad[head].epos = make_binary(sb);
 		    hp += ERL_SUB_BIN_SIZE;
-		}
-		ret = NIL;
-		sb = (ErlSubBin *)(hp);
-		sb->thing_word = HEADER_SUB_BIN;
-		sb->size = k - fad[j].pos - fad[j].len;
-		sb->offs = offset + fad[j].pos + fad[j].len;
-		sb->orig = orig;
-		sb->bitoffs = bit_offset;
-		sb->bitsize = bit_size;
-		sb->is_writable = 0;
-		hp += ERL_SUB_BIN_SIZE;
-		ret = CONS(hp, make_binary(sb), ret);
-		hp += 2;
-		for (i = j; i >= 0; --i) {
-		    ret = CONS(hp, fad[i].epos, ret);
+
+		    for (i = (head+1), j = tail; i <= j; ++i) {
+			sb = (ErlSubBin *)(hp);
+			sb->thing_word = HEADER_SUB_BIN;
+			sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
+			sb->offs = offset + fad[i-1].pos + fad[i-1].len;
+			sb->orig = orig;
+			sb->bitoffs = bit_offset;
+			sb->bitsize = 0;
+			sb->is_writable = 0;
+			fad[i].epos = make_binary(sb);
+			hp += ERL_SUB_BIN_SIZE;
+		    }
+
+		    sb = (ErlSubBin *)(hp);
+		    sb->thing_word = HEADER_SUB_BIN;
+		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
+		    sb->offs = offset + fad[tail].pos + fad[tail].len;
+		    sb->orig = orig;
+		    sb->bitoffs = bit_offset;
+		    sb->bitsize = bit_size;
+		    sb->is_writable = 0;
+		    hp += ERL_SUB_BIN_SIZE;
+
+		    ret = NIL;
+		    ret = CONS(hp, make_binary(sb), ret);
 		    hp += 2;
+		    for (i = tail, j = head; i >= j; --i) {
+			ret = CONS(hp, fad[i].epos, ret);
+			hp += 2;
+		    }
 		}
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
@@ -2898,7 +3077,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 
 		orig_size = binary_size(subject);
 
-		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - pos - bm->len) == 0) {
+		if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - bm->len) == 0) {
 		    if (pos == 0) {
 			ret = NIL;
 		    } else {
@@ -2919,17 +3098,23 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 			hp += 2;
 		    }
 		} else {
-		    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-		    sb1 = (ErlSubBin *) hp;
-		    sb1->thing_word = HEADER_SUB_BIN;
-		    sb1->size = pos;
-		    sb1->offs = offset;
-		    sb1->orig = orig;
-		    sb1->bitoffs = bit_offset;
-		    sb1->bitsize = 0;
-		    sb1->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
+		    if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+			hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = NULL;
+		    } else {
+			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = (ErlSubBin *) hp;
+			sb1->thing_word = HEADER_SUB_BIN;
+			sb1->size = pos;
+			sb1->offs = offset;
+			sb1->orig = orig;
+			sb1->bitoffs = bit_offset;
+			sb1->bitsize = 0;
+			sb1->is_writable = 0;
+			hp += ERL_SUB_BIN_SIZE;
+		    }
 
 		    sb2 = (ErlSubBin *) hp;
 		    sb2->thing_word = HEADER_SUB_BIN;
@@ -2944,8 +3129,10 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		    ret = NIL;
 		    ret = CONS(hp, make_binary(sb2), ret);
 		    hp += 2;
-		    ret = CONS(hp, make_binary(sb1), ret);
-		    hp += 2;
+		    if (sb1 != NULL) {
+			ret = CONS(hp, make_binary(sb1), ret);
+			hp += 2;
+		    }
 		}
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
@@ -3003,7 +3190,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 
 		orig_size = binary_size(subject);
 
-		if ((hsflags & BINARY_SPLIT_TRIM) && (orig_size - pos - rlen) == 0) {
+		if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - rlen) == 0) {
 		    if (pos == 0) {
 			ret = NIL;
 		    } else {
@@ -3024,17 +3211,23 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 			hp += 2;
 		    }
 		} else {
-		    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-		    sb1 = (ErlSubBin *) hp;
-		    sb1->thing_word = HEADER_SUB_BIN;
-		    sb1->size = pos;
-		    sb1->offs = offset;
-		    sb1->orig = orig;
-		    sb1->bitoffs = bit_offset;
-		    sb1->bitsize = 0;
-		    sb1->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
+		    if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = NULL;
+		    } else {
+			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+			sb1 = (ErlSubBin *) hp;
+			sb1->thing_word = HEADER_SUB_BIN;
+			sb1->size = pos;
+			sb1->offs = offset;
+			sb1->orig = orig;
+			sb1->bitoffs = bit_offset;
+			sb1->bitsize = 0;
+			sb1->is_writable = 0;
+			hp += ERL_SUB_BIN_SIZE;
+		    }
 
 		    sb2 = (ErlSubBin *) hp;
 		    sb2->thing_word = HEADER_SUB_BIN;
@@ -3049,8 +3242,10 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		    ret = NIL;
 		    ret = CONS(hp, make_binary(sb2), ret);
 		    hp += 2;
-		    ret = CONS(hp, make_binary(sb1), ret);
-		    hp += 2;
+		    if (sb1 != NULL) {
+			ret = CONS(hp, make_binary(sb1), ret);
+			hp += 2;
+		    }
 		}
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
@@ -3088,6 +3283,11 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin
 		    l = CDR(list_val(l));
 		    continue;
 		}
+		if (t == am_trim_all) {
+		    *optp |= BINARY_SPLIT_TRIM_ALL;
+		    l = CDR(list_val(l));
+		    continue;
+		}
 	    }
 	    if (!is_tuple(t)) {
 		goto badarg;
-- 
cgit v1.2.3


From 20855f1819f91eeeb1fa746186477d3824024500 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Wed, 26 Aug 2015 15:20:45 +0200
Subject: erts: Replace 0 with THE_NON_VALUE

---
 erts/emulator/beam/erl_bif_binary.c | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 1709f7671d..860c9a9779 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -1305,7 +1305,7 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
     Eterm *tp;
     Uint pos;
     Sint len;
-    if (l == ((Eterm) 0) || l == NIL) {
+    if (l == THE_NON_VALUE || l == NIL) {
 	/* Invalid term or NIL, we're called from binary_match(es)_2 or
 	   have no options*/
 	*posp = 0;
@@ -1535,13 +1535,13 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
 
 BIF_RETTYPE binary_match_2(BIF_ALIST_2)
 {
-    return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
 }
 
 
 BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
 {
-    return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+    return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
 }
 
 
@@ -3266,7 +3266,7 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin
     *optp = 0;
     *posp = 0;
     *endp = binary_size(bin);
-    if (l == ((Eterm) 0) || l == NIL) {
+    if (l == THE_NON_VALUE || l == NIL) {
 	return 0;
     } else if (is_list(l)) {
 	while(is_list(l)) {
@@ -3427,7 +3427,7 @@ binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
 
 BIF_RETTYPE binary_split_2(BIF_ALIST_2)
 {
-    return binary_split(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
 }
 
 
-- 
cgit v1.2.3


From 5b600aac42fdc4d08fabba682d7803351c9bfbdb Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Wed, 26 Aug 2015 15:43:00 +0200
Subject: erts: Refactor backend of binary:split

to reduce code volume.
---
 erts/emulator/beam/erl_bif_binary.c | 659 +++++++++---------------------------
 1 file changed, 151 insertions(+), 508 deletions(-)

diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 860c9a9779..6adc61df19 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -2542,6 +2542,11 @@ BIF_RETTYPE binary_copy_2(BIF_ALIST_2)
     return do_binary_copy(BIF_P,BIF_ARG_1,BIF_ARG_2);
 }
 
+static Eterm do_split_single_result(Process*, Eterm subject,
+				    Sint pos, Sint len, Uint hsflags);
+static Eterm do_split_global_result(Process*, FindallData *fad, Uint fad_sz,
+				    Eterm subject, Uint hsflags);
+
 #define BINARY_SPLIT_GLOBAL	0x01
 #define BINARY_SPLIT_TRIM	0x02
 #define BINARY_SPLIT_TRIM_ALL	0x04
@@ -2571,7 +2576,6 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 	if (type == am_bm) {
 	    BMData *bm;
 	    Sint pos;
-	    Eterm ret;
 	    Eterm *hp;
 	    BMFindAllState state;
 	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
@@ -2591,8 +2595,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 	    pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
 	    if (pos == BM_NOT_FOUND) {
 		hp = HAlloc(p, 2);
-		ret = NIL;
-		ret = CONS(hp, subject, ret);
+		*res_term = CONS(hp, subject, NIL);
 	    } else if (pos == BM_RESTART) {
 		int x =
 		    (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
@@ -2610,196 +2613,16 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		bm_clean_find_all(&state);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
-		size_t orig_size;
-		Eterm orig;
-		Uint offset;
-		Uint bit_offset;
-		Uint bit_size;
-		ErlSubBin *sb;
-		FindallData *fad = state.out;
-		Sint i, j;
-		Sint drop = 0;
-		Sint head = 0;
-		Sint tail;
-		Uint list_size;
-		Uint tail_pos;
-
-		tail = state.m - 1;
-		list_size = state.m + 1;
-		orig_size = binary_size(subject);
-		tail_pos = (Uint)(orig_size);
-
-		if (hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) {
-		    if ((orig_size - fad[tail].pos - fad[tail].len) == 0) {
-			list_size--;
-			for (i = (tail - 1); i >= 0; --i) {
-			    if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
-				break;
-			    }
-			    list_size--;
-			}
-			if (i == -1) {
-			    if (fad[head].pos == 0) {
-				ret = NIL;
-			    } else {
-				hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-				ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-				sb = (ErlSubBin *)(hp);
-				sb->thing_word = HEADER_SUB_BIN;
-				sb->size = fad[head].pos;
-				sb->offs = offset;
-				sb->orig = orig;
-				sb->bitoffs = bit_offset;
-				sb->bitsize = bit_size;
-				sb->is_writable = 0;
-				fad[head].epos = make_binary(sb);
-				hp += ERL_SUB_BIN_SIZE;
-
-				ret = NIL;
-				ret = CONS(hp, make_binary(sb), ret);
-				hp += 2;
-			    }
-			    erts_free_aligned_binary_bytes(temp_alloc);
-			    bm_clean_find_all(&state);
-			    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-			    *res_term = ret;
-			    return DO_BIN_MATCH_OK;
-			}
-			tail = i;
-			tail_pos = fad[tail+1].pos;
-		    }
-		}
-		if (hsflags & BINARY_SPLIT_TRIM_ALL) {
-		    if (fad[head].pos == 0) {
-			drop++;
-			list_size--;
-			for (i = drop, j = tail; i <= j; ++i) {
-			    if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-				break;
-			    }
-			    drop++;
-			    list_size--;
-			}
-			head = drop - 1;
-		    }
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) == 0) {
-			    list_size--;
-			}
-		    }
-
-		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		    if (drop == 0) {
-			sb = (ErlSubBin *)(hp);
-			sb->thing_word = HEADER_SUB_BIN;
-			sb->size = fad[head].pos;
-			sb->offs = offset;
-			sb->orig = orig;
-			sb->bitoffs = bit_offset;
-			sb->bitsize = 0;
-			sb->is_writable = 0;
-			fad[head].epos = make_binary(sb);
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-			    sb = (ErlSubBin *)(hp);
-			    sb->thing_word = HEADER_SUB_BIN;
-			    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-			    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
-			    sb->orig = orig;
-			    sb->bitoffs = bit_offset;
-			    sb->bitsize = 0;
-			    sb->is_writable = 0;
-			    fad[i].epos = make_binary(sb);
-			    hp += ERL_SUB_BIN_SIZE;
-			}
-		    }
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
-		    sb->offs = offset + fad[tail].pos + fad[tail].len;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = bit_size;
-		    sb->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb), ret);
-		    hp += 2;
-		    for (i = tail, j = head; i > j; --i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-			    ret = CONS(hp, fad[i].epos, ret);
-			    hp += 2;
-			}
-		    }
-		    if (drop == 0) {
-			ret = CONS(hp, fad[head].epos, ret);
-			hp += 2;
-		    }
-		} else {
-		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = fad[head].pos;
-		    sb->offs = offset;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = 0;
-		    sb->is_writable = 0;
-		    fad[head].epos = make_binary(sb);
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			sb = (ErlSubBin *)(hp);
-			sb->thing_word = HEADER_SUB_BIN;
-			sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-			sb->offs = offset + fad[i-1].pos + fad[i-1].len;
-			sb->orig = orig;
-			sb->bitoffs = bit_offset;
-			sb->bitsize = 0;
-			sb->is_writable = 0;
-			fad[i].epos = make_binary(sb);
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
-		    sb->offs = offset + fad[tail].pos + fad[tail].len;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = bit_size;
-		    sb->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb), ret);
-		    hp += 2;
-		    for (i = tail, j = head; i >= j; --i) {
-			ret = CONS(hp, fad[i].epos, ret);
-			hp += 2;
-		    }
-		}
+                *res_term = do_split_global_result(p, state.out, state.m, subject, hsflags);
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
 	    bm_clean_find_all(&state);
 	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	    *res_term = ret;
 	    return DO_BIN_MATCH_OK;
 	} else if (type == am_ac) {
 	    ACTrie *act;
 	    int acr;
 	    ACFindAllState state;
-	    Eterm ret;
 	    Eterm *hp;
 	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
 	    Uint save_reds = reds;
@@ -2817,8 +2640,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 	    acr = ac_find_all_non_overlapping(&state, bytes, &reds);
 	    if (acr == AC_NOT_FOUND) {
 		hp = HAlloc(p, 2);
-		ret = NIL;
-		ret = CONS(hp, subject, ret);
+		*res_term = CONS(hp, subject, NIL);
 	    } else if (acr == AC_RESTART) {
 		int x = (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
 		    !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
@@ -2835,197 +2657,17 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		ac_clean_find_all(&state);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
-		size_t orig_size;
-		Eterm orig;
-		Uint offset;
-		Uint bit_offset;
-		Uint bit_size;
-		ErlSubBin *sb;
-		FindallData *fad = state.out;
-		Sint i, j;
-		Sint drop = 0;
-		Sint head = 0;
-		Sint tail;
-		Uint list_size;
-		Uint tail_pos;
-
-		tail = state.m - 1;
-		list_size = state.m + 1;
-		orig_size = binary_size(subject);
-		tail_pos = (Uint)(orig_size);
-
-		if (hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) {
-		    if ((orig_size - fad[tail].pos - fad[tail].len) == 0) {
-			list_size--;
-			for (i = (tail - 1); i >= 0; --i) {
-			    if ((fad[i+1].pos - fad[i].pos - fad[i].len) != 0) {
-				break;
-			    }
-			    list_size--;
-			}
-			if (i == -1) {
-			    if (fad[head].pos == 0) {
-				ret = NIL;
-			    } else {
-				hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-				ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-				sb = (ErlSubBin *)(hp);
-				sb->thing_word = HEADER_SUB_BIN;
-				sb->size = fad[head].pos;
-				sb->offs = offset;
-				sb->orig = orig;
-				sb->bitoffs = bit_offset;
-				sb->bitsize = bit_size;
-				sb->is_writable = 0;
-				fad[head].epos = make_binary(sb);
-				hp += ERL_SUB_BIN_SIZE;
-
-				ret = NIL;
-				ret = CONS(hp, make_binary(sb), ret);
-				hp += 2;
-			    }
-			    erts_free_aligned_binary_bytes(temp_alloc);
-			    ac_clean_find_all(&state);
-			    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-			    *res_term = ret;
-			    return DO_BIN_MATCH_OK;
-			}
-			tail = i;
-			tail_pos = fad[tail+1].pos;
-		    }
-		}
-		if (hsflags & BINARY_SPLIT_TRIM_ALL) {
-		    if (fad[head].pos == 0) {
-			drop++;
-			list_size--;
-			for (i = drop, j = tail; i <= j; ++i) {
-			    if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-				break;
-			    }
-			    drop++;
-			    list_size--;
-			}
-			head = drop - 1;
-		    }
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) == 0) {
-			    list_size--;
-			}
-		    }
-
-		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		    if (drop == 0) {
-			sb = (ErlSubBin *)(hp);
-			sb->thing_word = HEADER_SUB_BIN;
-			sb->size = fad[head].pos;
-			sb->offs = offset;
-			sb->orig = orig;
-			sb->bitoffs = bit_offset;
-			sb->bitsize = 0;
-			sb->is_writable = 0;
-			fad[head].epos = make_binary(sb);
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-			    sb = (ErlSubBin *)(hp);
-			    sb->thing_word = HEADER_SUB_BIN;
-			    sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-			    sb->offs = offset + fad[i-1].pos + fad[i-1].len;
-			    sb->orig = orig;
-			    sb->bitoffs = bit_offset;
-			    sb->bitsize = 0;
-			    sb->is_writable = 0;
-			    fad[i].epos = make_binary(sb);
-			    hp += ERL_SUB_BIN_SIZE;
-			}
-		    }
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
-		    sb->offs = offset + fad[tail].pos + fad[tail].len;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = bit_size;
-		    sb->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb), ret);
-		    hp += 2;
-		    for (i = tail, j = head; i > j; --i) {
-			if ((fad[i].pos - fad[i-1].pos - fad[i-1].len) != 0) {
-			    ret = CONS(hp, fad[i].epos, ret);
-			    hp += 2;
-			}
-		    }
-		    if (drop == 0) {
-			ret = CONS(hp, fad[head].epos, ret);
-			hp += 2;
-		    }
-		} else {
-		    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
-		    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = fad[head].pos;
-		    sb->offs = offset;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = 0;
-		    sb->is_writable = 0;
-		    fad[head].epos = make_binary(sb);
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    for (i = (head+1), j = tail; i <= j; ++i) {
-			sb = (ErlSubBin *)(hp);
-			sb->thing_word = HEADER_SUB_BIN;
-			sb->size = fad[i].pos - fad[i-1].pos - fad[i-1].len;
-			sb->offs = offset + fad[i-1].pos + fad[i-1].len;
-			sb->orig = orig;
-			sb->bitoffs = bit_offset;
-			sb->bitsize = 0;
-			sb->is_writable = 0;
-			fad[i].epos = make_binary(sb);
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    sb = (ErlSubBin *)(hp);
-		    sb->thing_word = HEADER_SUB_BIN;
-		    sb->size = tail_pos - fad[tail].pos - fad[tail].len;
-		    sb->offs = offset + fad[tail].pos + fad[tail].len;
-		    sb->orig = orig;
-		    sb->bitoffs = bit_offset;
-		    sb->bitsize = bit_size;
-		    sb->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb), ret);
-		    hp += 2;
-		    for (i = tail, j = head; i >= j; --i) {
-			ret = CONS(hp, fad[i].epos, ret);
-			hp += 2;
-		    }
-		}
+                *res_term = do_split_global_result(p, state.out, state.m, subject, hsflags);
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
 	    ac_clean_find_all(&state);
 	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	    *res_term = ret;
 	    return DO_BIN_MATCH_OK;
 	}
     } else {
 	if (type == am_bm) {
 	    BMData *bm;
 	    Sint pos;
-	    Eterm ret;
 	    Eterm *hp;
 	    BMFindFirstState state;
 	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
@@ -3049,8 +2691,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 	    pos = bm_find_first_match(&state, bm, bytes, &reds);
 	    if (pos == BM_NOT_FOUND) {
 		hp = HAlloc(p, 2);
-		ret = NIL;
-		ret = CONS(hp, subject, ret);
+		*res_term = CONS(hp, subject, NIL);
 	    } else if (pos == BM_RESTART) {
 		int x =
 		    (sizeof(state) / sizeof(Eterm)) +
@@ -3067,84 +2708,16 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		erts_free_aligned_binary_bytes(temp_alloc);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
-		size_t orig_size;
-		Eterm orig;
-		Uint offset;
-		Uint bit_offset;
-		Uint bit_size;
-		ErlSubBin *sb1;
-		ErlSubBin *sb2;
-
-		orig_size = binary_size(subject);
-
-		if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - bm->len) == 0) {
-		    if (pos == 0) {
-			ret = NIL;
-		    } else {
-			hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = (ErlSubBin *) hp;
-			sb1->thing_word = HEADER_SUB_BIN;
-			sb1->size = pos;
-			sb1->offs = offset;
-			sb1->orig = orig;
-			sb1->bitoffs = bit_offset;
-			sb1->bitsize = bit_size;
-			sb1->is_writable = 0;
-			hp += ERL_SUB_BIN_SIZE;
-
-			ret = NIL;
-			ret = CONS(hp, make_binary(sb1), ret);
-			hp += 2;
-		    }
-		} else {
-		    if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
-			hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = NULL;
-		    } else {
-			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = (ErlSubBin *) hp;
-			sb1->thing_word = HEADER_SUB_BIN;
-			sb1->size = pos;
-			sb1->offs = offset;
-			sb1->orig = orig;
-			sb1->bitoffs = bit_offset;
-			sb1->bitsize = 0;
-			sb1->is_writable = 0;
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    sb2 = (ErlSubBin *) hp;
-		    sb2->thing_word = HEADER_SUB_BIN;
-		    sb2->size = orig_size - pos - bm->len;
-		    sb2->offs = offset + pos + bm->len;
-		    sb2->orig = orig;
-		    sb2->bitoffs = bit_offset;
-		    sb2->bitsize = bit_size;
-		    sb2->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb2), ret);
-		    hp += 2;
-		    if (sb1 != NULL) {
-			ret = CONS(hp, make_binary(sb1), ret);
-			hp += 2;
-		    }
-		}
+		*res_term = do_split_single_result(p, subject, pos, bm->len, hsflags);
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
 	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	    *res_term = ret;
 	    return DO_BIN_MATCH_OK;
 	} else if (type == am_ac) {
 	    ACTrie *act;
 	    Uint pos, rlen;
 	    int acr;
 	    ACFindFirstState state;
-	    Eterm ret;
 	    Eterm *hp;
 	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
 	    Uint save_reds = reds;
@@ -3162,8 +2735,7 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 	    acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
 	    if (acr == AC_NOT_FOUND) {
 		hp = HAlloc(p, 2);
-		ret = NIL;
-		ret = CONS(hp, subject, ret);
+		*res_term = CONS(hp, subject, NIL);
 	    } else if (acr == AC_RESTART) {
 		int x =
 		    (sizeof(state) / sizeof(Eterm)) +
@@ -3180,77 +2752,10 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
 		erts_free_aligned_binary_bytes(temp_alloc);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
-		size_t orig_size;
-		Eterm orig;
-		Uint offset;
-		Uint bit_offset;
-		Uint bit_size;
-		ErlSubBin *sb1;
-		ErlSubBin *sb2;
-
-		orig_size = binary_size(subject);
-
-		if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - rlen) == 0) {
-		    if (pos == 0) {
-			ret = NIL;
-		    } else {
-			hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = (ErlSubBin *) hp;
-			sb1->thing_word = HEADER_SUB_BIN;
-			sb1->size = pos;
-			sb1->offs = offset;
-			sb1->orig = orig;
-			sb1->bitoffs = bit_offset;
-			sb1->bitsize = bit_size;
-			sb1->is_writable = 0;
-			hp += ERL_SUB_BIN_SIZE;
-
-			ret = NIL;
-			ret = CONS(hp, make_binary(sb1), ret);
-			hp += 2;
-		    }
-		} else {
-		    if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
-			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = NULL;
-		    } else {
-			hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-			ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-			sb1 = (ErlSubBin *) hp;
-			sb1->thing_word = HEADER_SUB_BIN;
-			sb1->size = pos;
-			sb1->offs = offset;
-			sb1->orig = orig;
-			sb1->bitoffs = bit_offset;
-			sb1->bitsize = 0;
-			sb1->is_writable = 0;
-			hp += ERL_SUB_BIN_SIZE;
-		    }
-
-		    sb2 = (ErlSubBin *) hp;
-		    sb2->thing_word = HEADER_SUB_BIN;
-		    sb2->size = orig_size - pos - rlen;
-		    sb2->offs = offset + pos + rlen;
-		    sb2->orig = orig;
-		    sb2->bitoffs = bit_offset;
-		    sb2->bitsize = bit_size;
-		    sb2->is_writable = 0;
-		    hp += ERL_SUB_BIN_SIZE;
-
-		    ret = NIL;
-		    ret = CONS(hp, make_binary(sb2), ret);
-		    hp += 2;
-		    if (sb1 != NULL) {
-			ret = CONS(hp, make_binary(sb1), ret);
-			hp += 2;
-		    }
-		}
+		*res_term = do_split_single_result(p, subject, pos, rlen, hsflags);
 	    }
 	    erts_free_aligned_binary_bytes(temp_alloc);
 	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	    *res_term = ret;
 	    return DO_BIN_MATCH_OK;
 	}
     }
@@ -3258,6 +2763,144 @@ static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
     return DO_BIN_MATCH_BADARG;
 }
 
+static Eterm do_split_single_result(Process* p, Eterm subject,
+				    Sint pos, Sint len, Uint hsflags)
+{
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    ErlSubBin *sb1;
+    ErlSubBin *sb2;
+    Eterm* hp;
+    Eterm ret;
+
+    orig_size = binary_size(subject);
+
+    if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - len) == 0) {
+	if (pos != 0) {
+	    ret = NIL;
+	} else {
+	    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = (ErlSubBin *) hp;
+	    sb1->thing_word = HEADER_SUB_BIN;
+	    sb1->size = pos;
+	    sb1->offs = offset;
+	    sb1->orig = orig;
+	    sb1->bitoffs = bit_offset;
+	    sb1->bitsize = bit_size;
+	    sb1->is_writable = 0;
+	    hp += ERL_SUB_BIN_SIZE;
+
+	    ret = CONS(hp, make_binary(sb1), NIL);
+	    hp += 2;
+	}
+    } else {
+	if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+	    hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = NULL;
+	} else {
+	    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = (ErlSubBin *) hp;
+	    sb1->thing_word = HEADER_SUB_BIN;
+	    sb1->size = pos;
+	    sb1->offs = offset;
+	    sb1->orig = orig;
+	    sb1->bitoffs = bit_offset;
+	    sb1->bitsize = 0;
+	    sb1->is_writable = 0;
+	    hp += ERL_SUB_BIN_SIZE;
+	}
+
+	sb2 = (ErlSubBin *) hp;
+	sb2->thing_word = HEADER_SUB_BIN;
+	sb2->size = orig_size - pos - len;
+	sb2->offs = offset + pos + len;
+	sb2->orig = orig;
+	sb2->bitoffs = bit_offset;
+	sb2->bitsize = bit_size;
+	sb2->is_writable = 0;
+	hp += ERL_SUB_BIN_SIZE;
+
+	ret = CONS(hp, make_binary(sb2), NIL);
+	hp += 2;
+	if (sb1 != NULL) {
+	    ret = CONS(hp, make_binary(sb1), ret);
+	    hp += 2;
+	}
+    }
+    return ret;
+}
+
+static Eterm do_split_global_result(Process* p, FindallData *fad, Uint fad_sz,
+				    Uint subject, Uint hsflags)
+{
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    ErlSubBin *sb;
+    Sint i;
+    Sint tail;
+    Uint list_size;
+    Uint end_pos;
+    Uint do_trim = hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL);
+    Eterm* hp;
+    Eterm* hendp;
+    Eterm ret;
+
+    tail = fad_sz - 1;
+    list_size = fad_sz + 1;
+    orig_size = binary_size(subject);
+    end_pos = (Uint)(orig_size);
+
+    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+    hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2);
+    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+    ASSERT(bit_size == 0);
+
+    ret = NIL;
+
+    for (i = tail; i >= 0; --i) {
+        sb = (ErlSubBin *)(hp);
+        sb->size = end_pos - (fad[i].pos + fad[i].len);
+        if (!(sb->size == 0 && do_trim)) {
+            sb->thing_word = HEADER_SUB_BIN;
+            sb->offs = offset + fad[i].pos + fad[i].len;
+            sb->orig = orig;
+            sb->bitoffs = bit_offset;
+            sb->bitsize = 0;
+            sb->is_writable = 0;
+            hp += ERL_SUB_BIN_SIZE;
+            ret = CONS(hp, make_binary(sb), ret);
+            hp += 2;
+            do_trim &= ~BINARY_SPLIT_TRIM;
+        }
+	end_pos = fad[i].pos;
+    }
+
+    sb = (ErlSubBin *)(hp);
+    sb->size = fad[0].pos;
+    if (!(sb->size == 0 && do_trim)) {
+        sb->thing_word = HEADER_SUB_BIN;
+        sb->offs = offset;
+        sb->orig = orig;
+        sb->bitoffs = bit_offset;
+        sb->bitsize = 0;
+        sb->is_writable = 0;
+        hp += ERL_SUB_BIN_SIZE;
+        ret = CONS(hp, make_binary(sb), ret);
+        hp += 2;
+    }
+    HRelease(p, hendp, hp);
+    return ret;
+}
+
 static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
 {
     Eterm *tp;
-- 
cgit v1.2.3


From 55777538791419a6c3d86c1c440c7eb7fbdd5e51 Mon Sep 17 00:00:00 2001
From: Andrew Bennett 
Date: Thu, 10 Sep 2015 13:40:21 -0600
Subject: erts: Refactor BIF for binary:match,matches,split

with an common do_binary_find() used by match, matches and split.
---
 erts/emulator/beam/atom.names       |    4 +-
 erts/emulator/beam/erl_bif_binary.c | 1659 ++++++++++++++---------------------
 2 files changed, 678 insertions(+), 985 deletions(-)

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 5f27aaa14b..7a50b24818 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -117,11 +117,9 @@ atom bif_timer_server
 atom binary
 atom binary_bin_to_list_trap
 atom binary_copy_trap
+atom binary_find_trap
 atom binary_longest_prefix_trap
 atom binary_longest_suffix_trap
-atom binary_match_trap
-atom binary_matches_trap
-atom binary_split_trap
 atom binary_to_list_continue
 atom binary_to_term_trap
 atom block
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 6adc61df19..9f72b8c0ac 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -55,10 +55,8 @@
 
 /* Init and local variables */
 
-static Export binary_match_trap_export;
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3);
-static Export binary_matches_trap_export;
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3);
+static Export binary_find_trap_export;
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3);
 static Export binary_longest_prefix_trap_export;
 static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3);
 static Export binary_longest_suffix_trap_export;
@@ -67,26 +65,18 @@ static Export binary_bin_to_list_trap_export;
 static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3);
 static Export binary_copy_trap_export;
 static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
-static Export binary_split_trap_export;
-static BIF_RETTYPE binary_split_trap(BIF_ALIST_3);
 static Uint max_loop_limit;
 
 static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
-static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags);
 static BIF_RETTYPE
 binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
 
 void erts_init_bif_binary(void)
 {
-    erts_init_trap_export(&binary_match_trap_export,
-			  am_erlang, am_binary_match_trap, 3,
-			  &binary_match_trap);
-
-    erts_init_trap_export(&binary_matches_trap_export,
-			  am_erlang, am_binary_matches_trap, 3,
-			  &binary_matches_trap);
+    erts_init_trap_export(&binary_find_trap_export,
+			  am_erlang, am_binary_find_trap, 3,
+			  &binary_find_trap);
 
     erts_init_trap_export(&binary_longest_prefix_trap_export,
 			  am_erlang, am_binary_longest_prefix_trap, 3,
@@ -104,10 +94,6 @@ void erts_init_bif_binary(void)
 			  am_erlang, am_binary_copy_trap, 2,
 			  &binary_copy_trap);
 
-    erts_init_trap_export(&binary_split_trap_export,
-			  am_erlang, am_binary_split_trap, 3,
-			  &binary_split_trap);
-
     max_loop_limit = 0;
     return;
 }
@@ -322,8 +308,8 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len,
 /*
  * Aho Corasick - Build a Trie and fill in the failure functions
  * when all strings are added.
- * The algorithm is nicely described by Dieter Bhler of University of
- * Tbingen:
+ * The algorithm is nicely described by Dieter Bühler of University of
+ * Tübingen:
  * http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html
  */
 
@@ -573,9 +559,6 @@ static void ac_clean_find_all(ACFindAllState *state)
 #endif
 }
 
-#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \
-          (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m))
-
 /*
  * Differs to the find_first function in that it stores all matches and the values
  * arte returned only in the state.
@@ -853,9 +836,6 @@ static void bm_clean_find_all(BMFindAllState *state)
 #endif
 }
 
-#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \
-          (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m))
-
 /*
  * Differs to the find_first function in that it stores all matches and the
  * values are returned only in the state.
@@ -1038,267 +1018,36 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
 #define DO_BIN_MATCH_BADARG -1
 #define DO_BIN_MATCH_RESTART -2
 
-static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
-			   Eterm type, Binary *bin, Eterm state_term,
-			   Eterm *res_term)
-{
-    byte *bytes;
-    Uint bitoffs, bitsize;
-    byte *temp_alloc = NULL;
-
-    ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
-    if (bitsize != 0) {
-	goto badarg;
-    }
-    if (bitoffs != 0) {
-	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
-    }
-    if (state_term != NIL) {
-	Eterm *ptr = big_val(state_term);
-	type = ptr[1];
-    }
-
-    if (type == am_bm) {
-	BMData *bm;
-	Sint pos;
-	Eterm ret;
-	Eterm *hp;
-	BMFindFirstState state;
-	Uint reds = get_reds(p, BM_LOOP_FACTOR);
-	Uint save_reds = reds;
-
-	bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	dump_bm_data(bm);
-#endif
-	if (state_term == NIL) {
-	    bm_init_find_first_match(&state, hsstart, hsend);
-	} else {
-	    Eterm *ptr = big_val(state_term);
-	    memcpy(&state,ptr+2,sizeof(state));
-	}
-#ifdef HARDDEBUG
-	erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
-		    state.len);
-#endif
-	pos = bm_find_first_match(&state, bm, bytes, &reds);
-	if (pos == BM_NOT_FOUND) {
-	    ret = am_nomatch;
-	} else if (pos == BM_RESTART) {
-	    int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) +
-		!!(sizeof(BMFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
-	    erts_printf("Trap bm!\n");
-#endif
-	    hp = HAlloc(p,x+2);
-	    hp[0] = make_pos_bignum_header(x+1);
-	    hp[1] = type;
-	    memcpy(hp+2,&state,sizeof(state));
-	    *res_term = make_big(hp);
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    return DO_BIN_MATCH_RESTART;
-	} else {
-	    Eterm erlen = erts_make_integer((Uint) bm->len, p);
-	    ret = erts_make_integer(pos,p);
-	    hp = HAlloc(p,3);
-	    ret = TUPLE2(hp, ret, erlen);
-	}
-	erts_free_aligned_binary_bytes(temp_alloc);
-	BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	*res_term = ret;
-	return DO_BIN_MATCH_OK;
-    } else if (type == am_ac) {
-	ACTrie *act;
-	Uint pos, rlen;
-	int acr;
-	ACFindFirstState state;
-	Eterm ret;
-	Eterm *hp;
-	Uint reds = get_reds(p, AC_LOOP_FACTOR);
-	Uint save_reds = reds;
-
-	act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	dump_ac_trie(act);
-#endif
-	if (state_term == NIL) {
-	    ac_init_find_first_match(&state, act, hsstart, hsend);
-	} else {
-	    Eterm *ptr = big_val(state_term);
-	    memcpy(&state,ptr+2,sizeof(state));
-	}
-	acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
-	if (acr == AC_NOT_FOUND) {
-	    ret = am_nomatch;
-	} else if (acr == AC_RESTART) {
-	    int x = (sizeof(state) / sizeof(Eterm)) +
-		!!(sizeof(ACFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
-	    erts_printf("Trap ac!\n");
-#endif
-	    hp = HAlloc(p,x+2);
-	    hp[0] = make_pos_bignum_header(x+1);
-	    hp[1] = type;
-	    memcpy(hp+2,&state,sizeof(state));
-	    *res_term = make_big(hp);
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    return DO_BIN_MATCH_RESTART;
-	} else {
-	    Eterm epos = erts_make_integer(pos,p);
-	    Eterm erlen = erts_make_integer(rlen,p);
-	    hp = HAlloc(p,3);
-	    ret = TUPLE2(hp, epos, erlen);
-	}
-	erts_free_aligned_binary_bytes(temp_alloc);
-	BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	*res_term = ret;
-	return DO_BIN_MATCH_OK;
-    }
- badarg:
-    return DO_BIN_MATCH_BADARG;
-}
-
-static int do_binary_matches(Process *p, Eterm subject, Uint hsstart,
-			     Uint hsend, Eterm type, Binary *bin,
-			     Eterm state_term, Eterm *res_term)
-{
-    byte *bytes;
-    Uint bitoffs, bitsize;
-    byte *temp_alloc = NULL;
-
-    ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
-    if (bitsize != 0) {
-	goto badarg;
-    }
-    if (bitoffs != 0) {
-	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
-    }
-    if (state_term != NIL) {
-	Eterm *ptr = big_val(state_term);
-	type = ptr[1];
-    }
-
-    if (type == am_bm) {
-	BMData *bm;
-	Sint pos;
-	Eterm ret,tpl;
-	Eterm *hp;
-	BMFindAllState state;
-	Uint reds = get_reds(p, BM_LOOP_FACTOR);
-	Uint save_reds = reds;
-
-	bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	dump_bm_data(bm);
-#endif
-	if (state_term == NIL) {
-	    bm_init_find_all(&state, hsstart, hsend);
-	} else {
-	    Eterm *ptr = big_val(state_term);
-	    bm_restore_find_all(&state,(char *) (ptr+2));
-	}
-
-	pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
-	if (pos == BM_NOT_FOUND) {
-	    ret = NIL;
-	} else if (pos == BM_RESTART) {
-	    int x =
-		(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
-		!!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-	    erts_printf("Trap bm!\n");
-#endif
-	    hp = HAlloc(p,x+2);
-	    hp[0] = make_pos_bignum_header(x+1);
-	    hp[1] = type;
-	    bm_serialize_find_all(&state, (char *) (hp+2));
-	    *res_term = make_big(hp);
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    bm_clean_find_all(&state);
-	    return DO_BIN_MATCH_RESTART;
-	} else {
-	    FindallData *fad = state.out;
-	    int i;
-	    for (i = 0; i < state.m; ++i) {
-		fad[i].epos = erts_make_integer(fad[i].pos,p);
-		fad[i].elen = erts_make_integer(fad[i].len,p);
-	    }
-	    hp = HAlloc(p,state.m * (3 + 2));
-	    ret = NIL;
-	    for (i = state.m - 1; i >= 0; --i) {
-		tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
-		hp +=3;
-		ret = CONS(hp,tpl,ret);
-		hp += 2;
-	    }
-	}
-	erts_free_aligned_binary_bytes(temp_alloc);
-	bm_clean_find_all(&state);
-	BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	*res_term = ret;
-	return DO_BIN_MATCH_OK;
-    } else if (type == am_ac) {
-	ACTrie *act;
-	int acr;
-	ACFindAllState state;
-	Eterm ret,tpl;
-	Eterm *hp;
-	Uint reds = get_reds(p, AC_LOOP_FACTOR);
-	Uint save_reds = reds;
+#define BINARY_FIND_ALL		0x01
+#define BINARY_SPLIT_TRIM	0x02
+#define BINARY_SPLIT_TRIM_ALL	0x04
 
-	act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	dump_ac_trie(act);
-#endif
-	if (state_term == NIL) {
-	    ac_init_find_all(&state, act, hsstart, hsend);
-	} else {
-	    Eterm *ptr = big_val(state_term);
-	    ac_restore_find_all(&state,(char *) (ptr+2));
-	}
-	acr = ac_find_all_non_overlapping(&state, bytes, &reds);
-	if (acr == AC_NOT_FOUND) {
-	    ret = NIL;
-	} else if (acr == AC_RESTART) {
-	    int x =
-		(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
-		!!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-	    erts_printf("Trap ac!\n");
-#endif
-	    hp = HAlloc(p,x+2);
-	    hp[0] = make_pos_bignum_header(x+1);
-	    hp[1] = type;
-	    ac_serialize_find_all(&state, (char *) (hp+2));
-	    *res_term = make_big(hp);
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    ac_clean_find_all(&state);
-	    return DO_BIN_MATCH_RESTART;
-	} else {
-	    FindallData *fad = state.out;
-	    int i;
-	    for (i = 0; i < state.m; ++i) {
-		fad[i].epos = erts_make_integer(fad[i].pos,p);
-		fad[i].elen = erts_make_integer(fad[i].len,p);
-	    }
-	    hp = HAlloc(p,state.m * (3 + 2));
-	    ret = NIL;
-	    for (i = state.m - 1; i >= 0; --i) {
-		tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
-		hp +=3;
-		ret = CONS(hp,tpl,ret);
-		hp += 2;
-	    }
-	}
-	erts_free_aligned_binary_bytes(temp_alloc);
-	ac_clean_find_all(&state);
-	BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	*res_term = ret;
-	return DO_BIN_MATCH_OK;
-    }
- badarg:
-    return DO_BIN_MATCH_BADARG;
-}
+typedef struct BinaryFindState {
+    Eterm type;
+    Uint  flags;
+    Uint  hsstart;
+    Uint  hsend;
+    Eterm (*not_found_result) (Process *, Eterm, struct BinaryFindState *);
+    Eterm (*single_result)    (Process *, Eterm, struct BinaryFindState *, Sint, Sint);
+    Eterm (*global_result)    (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint);
+} BinaryFindState;
+
+#define SIZEOF_BINARY_FIND_STATE(S) \
+	  (sizeof(BinaryFindState)+sizeof(S))
+
+#define SIZEOF_BINARY_FIND_ALL_STATE(S) \
+	  (sizeof(BinaryFindState)+sizeof(S)+(sizeof(FindallData)*(S).m))
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    Sint pos, Sint len);
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    FindallData *fad, Uint fad_sz);
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    Sint pos, Sint len);
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    FindallData *fad, Uint fad_sz);
 
 static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
 {
@@ -1363,116 +1112,298 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
     }
 }
 
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3)
-{
-    int runres;
-    Eterm result;
-    Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
-    runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
-    if (runres == DO_BIN_MATCH_OK) {
-	BIF_RET(result);
-    } else {
-	BUMP_ALL_REDS(BIF_P);
-	BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result,
-		  BIF_ARG_3);
-    }
-}
-
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
+static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
 {
-    int runres;
-    Eterm result;
-    Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
-    runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
-    if (runres == DO_BIN_MATCH_OK) {
-	BIF_RET(result);
+    Eterm *tp;
+    Uint pos;
+    Sint len;
+    *optp = 0;
+    *posp = 0;
+    *endp = binary_size(bin);
+    if (l == THE_NON_VALUE || l == NIL) {
+	return 0;
+    } else if (is_list(l)) {
+	while(is_list(l)) {
+	    Eterm t = CAR(list_val(l));
+	    Uint orig_size;
+	    if (is_atom(t)) {
+		if (t == am_global) {
+		    *optp |= BINARY_FIND_ALL;
+		    l = CDR(list_val(l));
+		    continue;
+		}
+		if (t == am_trim) {
+		    *optp |= BINARY_SPLIT_TRIM;
+		    l = CDR(list_val(l));
+		    continue;
+		}
+		if (t == am_trim_all) {
+		    *optp |= BINARY_SPLIT_TRIM_ALL;
+		    l = CDR(list_val(l));
+		    continue;
+		}
+	    }
+	    if (!is_tuple(t)) {
+		goto badarg;
+	    }
+	    tp = tuple_val(t);
+	    if (arityval(*tp) != 2) {
+		goto badarg;
+	    }
+	    if (tp[1] != am_scope || is_not_tuple(tp[2])) {
+		goto badarg;
+	    }
+	    tp = tuple_val(tp[2]);
+	    if (arityval(*tp) != 2) {
+		goto badarg;
+	    }
+	    if (!term_to_Uint(tp[1], &pos)) {
+		goto badarg;
+	    }
+	    if (!term_to_Sint(tp[2], &len)) {
+		goto badarg;
+	    }
+	    if (len < 0) {
+		Uint lentmp = -(Uint)len;
+		/* overflow */
+		if ((Sint)lentmp < 0) {
+		    goto badarg;
+		}
+		len = lentmp;
+		pos -= len;
+	    }
+	    /* overflow */
+	    if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+		goto badarg;
+	    }
+	    *endp = len + pos;
+	    *posp = pos;
+	    if ((orig_size = binary_size(bin)) < pos ||
+		orig_size < (*endp)) {
+		goto badarg;
+	    }
+	    l = CDR(list_val(l));
+	}
+	return 0;
     } else {
-	BUMP_ALL_REDS(BIF_P);
-	BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
-		  BIF_ARG_3);
+    badarg:
+	return 1;
     }
 }
 
-BIF_RETTYPE binary_match_3(BIF_ALIST_3)
-{
-    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
-}
-
-static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin,
+			  Eterm state_term, Eterm *res_term)
 {
-    Uint hsstart;
-    Uint hsend;
-    Eterm *tp;
-    Eterm type;
-    Binary *bin;
-    Eterm bin_term = NIL;
-    int runres;
-    Eterm result;
+    byte *bytes;
+    Uint bitoffs, bitsize;
+    byte *temp_alloc = NULL;
+    char *state_ptr = NULL;
 
-    if (is_not_binary(arg1)) {
-	goto badarg;
-    }
-    if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
-	goto badarg;
-    }
-    if (hsend == 0) {
-	BIF_RET(am_nomatch);
-    }
-    if (is_tuple(arg2)) {
-	tp = tuple_val(arg2);
-	if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
-	    goto badarg;
-	}
-	if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
-	    !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
-	    goto badarg;
-	}
-	type = tp[1];
-	bin = ((ProcBin *) binary_val(tp[2]))->val;
-	if (type == am_bm &&
-	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
-	    goto badarg;
-	}
-	if (type == am_ac &&
-	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
-	    goto badarg;
-	}
-	bin_term = tp[2];
-    } else if (do_binary_match_compile(arg2,&type,&bin)) {
+    ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+    if (bitsize != 0) {
 	goto badarg;
     }
-    runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result);
-    if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
-	Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
-	bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
-    } else if (bin_term == NIL) {
-	erts_bin_free(bin);
+    if (bitoffs != 0) {
+	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
     }
-    switch (runres) {
-    case DO_BIN_MATCH_OK:
-	BIF_RET(result);
-    case DO_BIN_MATCH_RESTART:
-	BUMP_ALL_REDS(p);
-	BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term);
-    default:
-	goto badarg;
+    if (state_term != NIL) {
+	state_ptr = (char *)(big_val(state_term));
+	state_ptr += sizeof(Eterm);
+	bfs = (BinaryFindState *)(state_ptr);
+	state_ptr += sizeof(BinaryFindState);
     }
- badarg:
-    BIF_ERROR(p,BADARG);
-}
 
-BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
-{
-    return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+    if (bfs->flags & BINARY_FIND_ALL) {
+	if (bfs->type == am_bm) {
+	    BMData *bm;
+	    Sint pos;
+	    Eterm *hp;
+	    BMFindAllState state;
+	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_bm_data(bm);
+#endif
+	    if (state_term == NIL) {
+		bm_init_find_all(&state, bfs->hsstart, bfs->hsend);
+	    } else {
+		bm_restore_find_all(&state, state_ptr);
+	    }
+
+	    pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
+	    if (pos == BM_NOT_FOUND) {
+		*res_term = bfs->not_found_result(p, subject, bfs);
+	    } else if (pos == BM_RESTART) {
+		int x =
+		    (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap bm!\n");
+#endif
+		hp = HAlloc(p, x+1);
+		hp[0] = make_pos_bignum_header(x);
+		state_ptr = (char *)(hp);
+		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
+		bm_serialize_find_all(&state, state_ptr+sizeof(Eterm)+sizeof(BinaryFindState));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		bm_clean_find_all(&state);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		*res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    bm_clean_find_all(&state);
+	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+	    return DO_BIN_MATCH_OK;
+	} else if (bfs->type == am_ac) {
+	    ACTrie *act;
+	    int acr;
+	    ACFindAllState state;
+	    Eterm *hp;
+	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_ac_trie(act);
+#endif
+	    if (state_term == NIL) {
+		ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend);
+	    } else {
+		ac_restore_find_all(&state, state_ptr);
+	    }
+	    acr = ac_find_all_non_overlapping(&state, bytes, &reds);
+	    if (acr == AC_NOT_FOUND) {
+		*res_term = bfs->not_found_result(p, subject, bfs);
+	    } else if (acr == AC_RESTART) {
+		int x =
+		    (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap ac!\n");
+#endif
+		hp = HAlloc(p, x+1);
+		hp[0] = make_pos_bignum_header(x);
+		state_ptr = (char *)(hp);
+		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
+		ac_serialize_find_all(&state, state_ptr+sizeof(Eterm)+sizeof(BinaryFindState));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		ac_clean_find_all(&state);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		*res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    ac_clean_find_all(&state);
+	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+	    return DO_BIN_MATCH_OK;
+	}
+    } else {
+	if (bfs->type == am_bm) {
+	    BMData *bm;
+	    Sint pos;
+	    Eterm *hp;
+	    BMFindFirstState state;
+	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_bm_data(bm);
+#endif
+	    if (state_term == NIL) {
+		bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend);
+	    } else {
+		memcpy((void *)(&state), (const void *)(state_ptr), sizeof(BMFindFirstState));
+	    }
+
+#ifdef HARDDEBUG
+	    erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
+			state.len);
+#endif
+	    pos = bm_find_first_match(&state, bm, bytes, &reds);
+	    if (pos == BM_NOT_FOUND) {
+		*res_term = bfs->not_found_result(p, subject, bfs);
+	    } else if (pos == BM_RESTART) {
+		int x =
+		    (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap bm!\n");
+#endif
+		hp = HAlloc(p, x+1);
+		hp[0] = make_pos_bignum_header(x);
+		state_ptr = (char *)(hp);
+		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
+		memcpy((void *)(state_ptr+sizeof(Eterm)+sizeof(BinaryFindState)),
+		       (const void *)(&state), sizeof(BMFindFirstState));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		*res_term = bfs->single_result(p, subject, bfs, pos, bm->len);
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+	    return DO_BIN_MATCH_OK;
+	} else if (bfs->type == am_ac) {
+	    ACTrie *act;
+	    Uint pos, rlen;
+	    int acr;
+	    ACFindFirstState state;
+	    Eterm *hp;
+	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
+	    Uint save_reds = reds;
+
+	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+	    dump_ac_trie(act);
+#endif
+	    if (state_term == NIL) {
+		ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend);
+	    } else {
+		memcpy((void *)(&state), (const void *)(state_ptr), sizeof(ACFindFirstState));
+	    }
+	    acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
+	    if (acr == AC_NOT_FOUND) {
+		*res_term = bfs->not_found_result(p, subject, bfs);
+	    } else if (acr == AC_RESTART) {
+		int x =
+		    (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+		    !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+		erts_printf("Trap ac!\n");
+#endif
+		hp = HAlloc(p, x+1);
+		hp[0] = make_pos_bignum_header(x);
+		state_ptr = (char *)(hp);
+		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
+		memcpy((void *)(state_ptr+sizeof(Eterm)+sizeof(BinaryFindState)),
+		       (const void *)(&state), sizeof(ACFindFirstState));
+		*res_term = make_big(hp);
+		erts_free_aligned_binary_bytes(temp_alloc);
+		return DO_BIN_MATCH_RESTART;
+	    } else {
+		*res_term = bfs->single_result(p, subject, bfs, pos, rlen);
+	    }
+	    erts_free_aligned_binary_bytes(temp_alloc);
+	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+	    return DO_BIN_MATCH_OK;
+	}
+    }
+ badarg:
+    return DO_BIN_MATCH_BADARG;
 }
 
 static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags)
 {
-    Uint hsstart, hsend;
+    BinaryFindState bfs;
     Eterm *tp;
-    Eterm type;
     Binary *bin;
     Eterm bin_term = NIL;
     int runres;
@@ -1481,11 +1412,12 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
     if (is_not_binary(arg1)) {
 	goto badarg;
     }
-    if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
+    bfs.flags = flags;
+    if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) {
 	goto badarg;
     }
-    if (hsend == 0) {
-	BIF_RET(NIL);
+    if (bfs.hsend == 0) {
+	BIF_RET(do_match_not_found_result(p, arg1, &bfs));
     }
     if (is_tuple(arg2)) {
 	tp = tuple_val(arg2);
@@ -1496,22 +1428,24 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
 	    !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
 	    goto badarg;
 	}
-	type = tp[1];
+	bfs.type = tp[1];
 	bin = ((ProcBin *) binary_val(tp[2]))->val;
-	if (type == am_bm &&
+	if (bfs.type == am_bm &&
 	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
 	    goto badarg;
 	}
-	if (type == am_ac &&
+	if (bfs.type == am_ac &&
 	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
 	    goto badarg;
 	}
 	bin_term = tp[2];
-    } else if (do_binary_match_compile(arg2,&type,&bin)) {
+    } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
 	goto badarg;
     }
-    runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin,
-			       NIL,&result);
+    bfs.not_found_result = &do_match_not_found_result;
+    bfs.single_result = &do_match_single_result;
+    bfs.global_result = &do_match_global_result;
+    runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
     if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
 	Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
 	bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
@@ -1523,8 +1457,7 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
 	BIF_RET(result);
     case DO_BIN_MATCH_RESTART:
 	BUMP_ALL_REDS(p);
-	BIF_TRAP3(&binary_matches_trap_export, p, arg1, result,
-		  bin_term);
+	BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
     default:
 	goto badarg;
     }
@@ -1532,98 +1465,392 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
     BIF_ERROR(p,BADARG);
 }
 
-
 BIF_RETTYPE binary_match_2(BIF_ALIST_2)
 {
-    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
+    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, 0);
 }
 
+BIF_RETTYPE binary_match_3(BIF_ALIST_3)
+{
+    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, 0);
+}
 
 BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
 {
-    return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
+    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BINARY_FIND_ALL);
 }
 
+BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
+{
+    return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL);
+}
 
-BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
+static BIF_RETTYPE
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
 {
-    Uint pos;
-    Sint len;
-    size_t orig_size;
-    Eterm orig;
-    Uint offset;
-    Uint bit_offset;
-    Uint bit_size;
-    Eterm* hp;
-    ErlSubBin* sb;
+    BinaryFindState bfs;
+    Eterm *tp;
+    Binary *bin;
+    Eterm bin_term = NIL;
+    int runres;
+    Eterm result;
 
-    if (is_not_binary(binary)) {
+    if (is_not_binary(arg1)) {
 	goto badarg;
     }
-    if (!term_to_Uint(epos, &pos)) {
+    if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) {
 	goto badarg;
     }
-    if (!term_to_Sint(elen, &len)) {
-	goto badarg;
+    if (bfs.hsend == 0) {
+	result = do_split_not_found_result(p, arg1, &bfs);
+	BIF_RET(result);
     }
-    if (len < 0) {
-	Uint lentmp = -(Uint)len;
-	/* overflow */
-	if ((Sint)lentmp < 0) {
+    if (is_tuple(arg2)) {
+	tp = tuple_val(arg2);
+	if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
 	    goto badarg;
 	}
-	len = lentmp;
-	if (len > pos) {
+	if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
+	    !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
 	    goto badarg;
 	}
-	pos -= len;
-    }
-    /* overflow */
-    if ((pos + len) < pos || (len > 0 && (pos + len) == pos)){
+	bfs.type = tp[1];
+	bin = ((ProcBin *) binary_val(tp[2]))->val;
+	if (bfs.type == am_bm &&
+	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
+	    goto badarg;
+	}
+	if (bfs.type == am_ac &&
+	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
+	    goto badarg;
+	}
+	bin_term = tp[2];
+    } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
 	goto badarg;
     }
-    if ((orig_size = binary_size(binary)) < pos ||
-	orig_size < (pos + len)) {
+    bfs.not_found_result = &do_split_not_found_result;
+    bfs.single_result = &do_split_single_result;
+    bfs.global_result = &do_split_global_result;
+    runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
+    if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
+	Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+	bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
+    } else if (bin_term == NIL) {
+	erts_bin_free(bin);
+    }
+    switch(runres) {
+    case DO_BIN_MATCH_OK:
+	BIF_RET(result);
+    case DO_BIN_MATCH_RESTART:
+	BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
+    default:
 	goto badarg;
     }
+ badarg:
+    BIF_ERROR(p, BADARG);
+}
 
+BIF_RETTYPE binary_split_2(BIF_ALIST_2)
+{
+    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
+}
 
+BIF_RETTYPE binary_split_3(BIF_ALIST_3)
+{
+    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
 
-    hp = HAlloc(p, ERL_SUB_BIN_SIZE);
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+{
+    if (bfs->flags & BINARY_FIND_ALL) {
+	return NIL;
+    } else {
+	return am_nomatch;
+    }
+}
 
-    ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
-    sb = (ErlSubBin *) hp;
-    sb->thing_word = HEADER_SUB_BIN;
-    sb->size = len;
-    sb->offs = offset + pos;
-    sb->orig = orig;
-    sb->bitoffs = bit_offset;
-    sb->bitsize = 0;
-    sb->is_writable = 0;
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    Sint pos, Sint len)
+{
+    Eterm erlen;
+    Eterm *hp;
+    Eterm ret;
 
-    BIF_RET(make_binary(sb));
+    erlen = erts_make_integer((Uint)(len), p);
+    ret = erts_make_integer(pos, p);
+    hp = HAlloc(p, 3);
+    ret = TUPLE2(hp, ret, erlen);
 
- badarg:
-    BIF_ERROR(p, BADARG);
+    return ret;
 }
 
-#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
-
-BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple)
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    FindallData *fad, Uint fad_sz)
 {
-    Uint pos;
-    Sint len;
-    size_t orig_size;
-    Eterm orig;
-    Uint offset;
-    Uint bit_offset;
-    Uint bit_size;
-    Eterm* hp;
-    ErlSubBin* sb;
-    Eterm binary;
-    Eterm *tp;
-    Eterm epos, elen;
-    int extra_args;
+    Sint i;
+    Eterm tpl;
+    Eterm *hp;
+    Eterm ret;
+
+    for (i = 0; i < fad_sz; ++i) {
+	fad[i].epos = erts_make_integer(fad[i].pos, p);
+	fad[i].elen = erts_make_integer(fad[i].len, p);
+    }
+    hp = HAlloc(p, fad_sz * (3 + 2));
+    ret = NIL;
+    for (i = fad_sz - 1; i >= 0; --i) {
+	tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
+	hp += 3;
+	ret = CONS(hp, tpl, ret);
+	hp += 2;
+    }
+
+    return ret;
+}
+
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+{
+    Eterm *hp;
+    Eterm ret;
+
+    hp = HAlloc(p, 2);
+    ret = CONS(hp, subject, NIL);
+
+    return ret;
+}
+
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    Sint pos, Sint len)
+{
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    ErlSubBin *sb1;
+    ErlSubBin *sb2;
+    Eterm *hp;
+    Eterm ret;
+
+    orig_size = binary_size(subject);
+
+    if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) &&
+	(orig_size - pos - len) == 0) {
+	if (pos == 0) {
+	    ret = NIL;
+	} else {
+	    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = (ErlSubBin *) hp;
+	    sb1->thing_word = HEADER_SUB_BIN;
+	    sb1->size = pos;
+	    sb1->offs = offset;
+	    sb1->orig = orig;
+	    sb1->bitoffs = bit_offset;
+	    sb1->bitsize = bit_size;
+	    sb1->is_writable = 0;
+	    hp += ERL_SUB_BIN_SIZE;
+
+	    ret = CONS(hp, make_binary(sb1), NIL);
+	    hp += 2;
+	}
+    } else {
+	if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+	    hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = NULL;
+	} else {
+	    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+	    sb1 = (ErlSubBin *) hp;
+	    sb1->thing_word = HEADER_SUB_BIN;
+	    sb1->size = pos;
+	    sb1->offs = offset;
+	    sb1->orig = orig;
+	    sb1->bitoffs = bit_offset;
+	    sb1->bitsize = 0;
+	    sb1->is_writable = 0;
+	    hp += ERL_SUB_BIN_SIZE;
+	}
+
+	sb2 = (ErlSubBin *) hp;
+	sb2->thing_word = HEADER_SUB_BIN;
+	sb2->size = orig_size - pos - len;
+	sb2->offs = offset + pos + len;
+	sb2->orig = orig;
+	sb2->bitoffs = bit_offset;
+	sb2->bitsize = bit_size;
+	sb2->is_writable = 0;
+	hp += ERL_SUB_BIN_SIZE;
+
+	ret = CONS(hp, make_binary(sb2), NIL);
+	hp += 2;
+	if (sb1 != NULL) {
+	    ret = CONS(hp, make_binary(sb1), ret);
+	    hp += 2;
+	}
+    }
+    return ret;
+}
+
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+				    FindallData *fad, Uint fad_sz)
+{
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    ErlSubBin *sb;
+    Sint i;
+    Sint tail;
+    Uint list_size;
+    Uint end_pos;
+    Uint do_trim = bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL);
+    Eterm *hp;
+    Eterm *hendp;
+    Eterm ret;
+
+    tail = fad_sz - 1;
+    list_size = fad_sz + 1;
+    orig_size = binary_size(subject);
+    end_pos = (Uint)(orig_size);
+
+    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+    hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2);
+    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+    ASSERT(bit_size == 0);
+
+    ret = NIL;
+
+    for (i = tail; i >= 0; --i) {
+	sb = (ErlSubBin *)(hp);
+	sb->size = end_pos - (fad[i].pos + fad[i].len);
+	if (!(sb->size == 0 && do_trim)) {
+	    sb->thing_word = HEADER_SUB_BIN;
+	    sb->offs = offset + fad[i].pos + fad[i].len;
+	    sb->orig = orig;
+	    sb->bitoffs = bit_offset;
+	    sb->bitsize = 0;
+	    sb->is_writable = 0;
+	    hp += ERL_SUB_BIN_SIZE;
+	    ret = CONS(hp, make_binary(sb), ret);
+	    hp += 2;
+	    do_trim &= ~BINARY_SPLIT_TRIM;
+	}
+	end_pos = fad[i].pos;
+    }
+
+    sb = (ErlSubBin *)(hp);
+    sb->size = fad[0].pos;
+    if (!(sb->size == 0 && do_trim)) {
+	sb->thing_word = HEADER_SUB_BIN;
+	sb->offs = offset;
+	sb->orig = orig;
+	sb->bitoffs = bit_offset;
+	sb->bitsize = 0;
+	sb->is_writable = 0;
+	hp += ERL_SUB_BIN_SIZE;
+	ret = CONS(hp, make_binary(sb), ret);
+	hp += 2;
+    }
+    HRelease(p, hendp, hp);
+    return ret;
+}
+
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3)
+{
+    int runres;
+    Eterm result;
+    Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+    runres = do_binary_find(BIF_P, BIF_ARG_1, THE_NON_VALUE, bin, BIF_ARG_2, &result);
+    if (runres == DO_BIN_MATCH_OK) {
+	BIF_RET(result);
+    } else {
+	BUMP_ALL_REDS(BIF_P);
+	BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3);
+    }
+}
+
+BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
+{
+    Uint pos;
+    Sint len;
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    Eterm* hp;
+    ErlSubBin* sb;
+
+    if (is_not_binary(binary)) {
+	goto badarg;
+    }
+    if (!term_to_Uint(epos, &pos)) {
+	goto badarg;
+    }
+    if (!term_to_Sint(elen, &len)) {
+	goto badarg;
+    }
+    if (len < 0) {
+	Uint lentmp = -(Uint)len;
+	/* overflow */
+	if ((Sint)lentmp < 0) {
+	    goto badarg;
+	}
+	len = lentmp;
+	if (len > pos) {
+	    goto badarg;
+	}
+	pos -= len;
+    }
+    /* overflow */
+    if ((pos + len) < pos || (len > 0 && (pos + len) == pos)){
+	goto badarg;
+    }
+    if ((orig_size = binary_size(binary)) < pos ||
+	orig_size < (pos + len)) {
+	goto badarg;
+    }
+
+
+
+    hp = HAlloc(p, ERL_SUB_BIN_SIZE);
+
+    ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
+    sb = (ErlSubBin *) hp;
+    sb->thing_word = HEADER_SUB_BIN;
+    sb->size = len;
+    sb->offs = offset + pos;
+    sb->orig = orig;
+    sb->bitoffs = bit_offset;
+    sb->bitsize = 0;
+    sb->is_writable = 0;
+
+    BIF_RET(make_binary(sb));
+
+ badarg:
+    BIF_ERROR(p, BADARG);
+}
+
+#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
+
+BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple)
+{
+    Uint pos;
+    Sint len;
+    size_t orig_size;
+    Eterm orig;
+    Uint offset;
+    Uint bit_offset;
+    Uint bit_size;
+    Eterm* hp;
+    ErlSubBin* sb;
+    Eterm binary;
+    Eterm *tp;
+    Eterm epos, elen;
+    int extra_args;
 
 
     if (range_is_tuple) {
@@ -2542,538 +2769,6 @@ BIF_RETTYPE binary_copy_2(BIF_ALIST_2)
     return do_binary_copy(BIF_P,BIF_ARG_1,BIF_ARG_2);
 }
 
-static Eterm do_split_single_result(Process*, Eterm subject,
-				    Sint pos, Sint len, Uint hsflags);
-static Eterm do_split_global_result(Process*, FindallData *fad, Uint fad_sz,
-				    Eterm subject, Uint hsflags);
-
-#define BINARY_SPLIT_GLOBAL	0x01
-#define BINARY_SPLIT_TRIM	0x02
-#define BINARY_SPLIT_TRIM_ALL	0x04
-
-static int do_binary_split(Process *p, Eterm subject, Uint hsstart,
-			   Uint hsend, Uint hsflags, Eterm type, Binary *bin,
-			   Eterm state_term, Eterm *res_term)
-{
-    byte *bytes;
-    Uint bitoffs, bitsize;
-    byte *temp_alloc = NULL;
-
-    ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
-    if (bitsize != 0) {
-	goto badarg;
-    }
-    if (bitoffs != 0) {
-	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
-    }
-    if (state_term != NIL) {
-	Eterm *ptr = big_val(state_term);
-	type = ptr[1];
-	hsflags = (Uint)(ptr[2]);
-    }
-
-    if (hsflags & BINARY_SPLIT_GLOBAL) {
-	if (type == am_bm) {
-	    BMData *bm;
-	    Sint pos;
-	    Eterm *hp;
-	    BMFindAllState state;
-	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
-	    Uint save_reds = reds;
-
-	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	    dump_bm_data(bm);
-#endif
-	    if (state_term == NIL) {
-		bm_init_find_all(&state, hsstart, hsend);
-	    } else {
-		Eterm *ptr = big_val(state_term);
-		bm_restore_find_all(&state, (char *)(ptr+3));
-	    }
-
-	    pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
-	    if (pos == BM_NOT_FOUND) {
-		hp = HAlloc(p, 2);
-		*res_term = CONS(hp, subject, NIL);
-	    } else if (pos == BM_RESTART) {
-		int x =
-		    (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
-		    !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-		erts_printf("Trap bm!\n");
-#endif
-		hp = HAlloc(p, x+3);
-		hp[0] = make_pos_bignum_header(x+2);
-		hp[1] = type;
-		hp[2] = (Eterm)(hsflags);
-		bm_serialize_find_all(&state, (char *)(hp+3));
-		*res_term = make_big(hp);
-		erts_free_aligned_binary_bytes(temp_alloc);
-		bm_clean_find_all(&state);
-		return DO_BIN_MATCH_RESTART;
-	    } else {
-                *res_term = do_split_global_result(p, state.out, state.m, subject, hsflags);
-	    }
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    bm_clean_find_all(&state);
-	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	    return DO_BIN_MATCH_OK;
-	} else if (type == am_ac) {
-	    ACTrie *act;
-	    int acr;
-	    ACFindAllState state;
-	    Eterm *hp;
-	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
-	    Uint save_reds = reds;
-
-	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	    dump_ac_trie(act);
-#endif
-	    if (state_term == NIL) {
-		ac_init_find_all(&state, act, hsstart, hsend);
-	    } else {
-		Eterm *ptr = big_val(state_term);
-		ac_restore_find_all(&state, (char *)(ptr+3));
-	    }
-	    acr = ac_find_all_non_overlapping(&state, bytes, &reds);
-	    if (acr == AC_NOT_FOUND) {
-		hp = HAlloc(p, 2);
-		*res_term = CONS(hp, subject, NIL);
-	    } else if (acr == AC_RESTART) {
-		int x = (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
-		    !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-		erts_printf("Trap ac!\n");
-#endif
-		hp = HAlloc(p, x+3);
-		hp[0] = make_pos_bignum_header(x+2);
-		hp[1] = type;
-		hp[2] = (Eterm)(hsflags);
-		ac_serialize_find_all(&state, (char *)(hp+3));
-		*res_term = make_big(hp);
-		erts_free_aligned_binary_bytes(temp_alloc);
-		ac_clean_find_all(&state);
-		return DO_BIN_MATCH_RESTART;
-	    } else {
-                *res_term = do_split_global_result(p, state.out, state.m, subject, hsflags);
-	    }
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    ac_clean_find_all(&state);
-	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	    return DO_BIN_MATCH_OK;
-	}
-    } else {
-	if (type == am_bm) {
-	    BMData *bm;
-	    Sint pos;
-	    Eterm *hp;
-	    BMFindFirstState state;
-	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
-	    Uint save_reds = reds;
-
-	    bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	    dump_bm_data(bm);
-#endif
-	    if (state_term == NIL) {
-		bm_init_find_first_match(&state, hsstart, hsend);
-	    } else {
-		Eterm *ptr = big_val(state_term);
-		memcpy((void *)(&state), (const void *)(ptr+3), sizeof(BMFindFirstState));
-	    }
-
-#ifdef HARDDEBUG
-	    erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
-			state.len);
-#endif
-	    pos = bm_find_first_match(&state, bm, bytes, &reds);
-	    if (pos == BM_NOT_FOUND) {
-		hp = HAlloc(p, 2);
-		*res_term = CONS(hp, subject, NIL);
-	    } else if (pos == BM_RESTART) {
-		int x =
-		    (sizeof(state) / sizeof(Eterm)) +
-		    !!(sizeof(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-		erts_printf("Trap bm!\n");
-#endif
-		hp = HAlloc(p, x+3);
-		hp[0] = make_pos_bignum_header(x+2);
-		hp[1] = type;
-		hp[2] = (Eterm)(hsflags);
-		memcpy((void *)(hp+3), (const void *)(&state), sizeof(state));
-		*res_term = make_big(hp);
-		erts_free_aligned_binary_bytes(temp_alloc);
-		return DO_BIN_MATCH_RESTART;
-	    } else {
-		*res_term = do_split_single_result(p, subject, pos, bm->len, hsflags);
-	    }
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
-	    return DO_BIN_MATCH_OK;
-	} else if (type == am_ac) {
-	    ACTrie *act;
-	    Uint pos, rlen;
-	    int acr;
-	    ACFindFirstState state;
-	    Eterm *hp;
-	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
-	    Uint save_reds = reds;
-
-	    act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
-	    dump_ac_trie(act);
-#endif
-	    if (state_term == NIL) {
-		ac_init_find_first_match(&state, act, hsstart, hsend);
-	    } else {
-		Eterm *ptr = big_val(state_term);
-		memcpy((void *)(&state), (const void *)(ptr+3), sizeof(ACFindFirstState));
-	    }
-	    acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
-	    if (acr == AC_NOT_FOUND) {
-		hp = HAlloc(p, 2);
-		*res_term = CONS(hp, subject, NIL);
-	    } else if (acr == AC_RESTART) {
-		int x =
-		    (sizeof(state) / sizeof(Eterm)) +
-		    !!(sizeof(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
-		erts_printf("Trap ac!\n");
-#endif
-		hp = HAlloc(p, x+3);
-		hp[0] = make_pos_bignum_header(x+2);
-		hp[1] = type;
-		hp[2] = (Eterm)(hsflags);
-		memcpy((void *)(hp+3), (const void *)(&state), sizeof(state));
-		*res_term = make_big(hp);
-		erts_free_aligned_binary_bytes(temp_alloc);
-		return DO_BIN_MATCH_RESTART;
-	    } else {
-		*res_term = do_split_single_result(p, subject, pos, rlen, hsflags);
-	    }
-	    erts_free_aligned_binary_bytes(temp_alloc);
-	    BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
-	    return DO_BIN_MATCH_OK;
-	}
-    }
- badarg:
-    return DO_BIN_MATCH_BADARG;
-}
-
-static Eterm do_split_single_result(Process* p, Eterm subject,
-				    Sint pos, Sint len, Uint hsflags)
-{
-    size_t orig_size;
-    Eterm orig;
-    Uint offset;
-    Uint bit_offset;
-    Uint bit_size;
-    ErlSubBin *sb1;
-    ErlSubBin *sb2;
-    Eterm* hp;
-    Eterm ret;
-
-    orig_size = binary_size(subject);
-
-    if ((hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && (orig_size - pos - len) == 0) {
-	if (pos != 0) {
-	    ret = NIL;
-	} else {
-	    hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
-	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-	    sb1 = (ErlSubBin *) hp;
-	    sb1->thing_word = HEADER_SUB_BIN;
-	    sb1->size = pos;
-	    sb1->offs = offset;
-	    sb1->orig = orig;
-	    sb1->bitoffs = bit_offset;
-	    sb1->bitsize = bit_size;
-	    sb1->is_writable = 0;
-	    hp += ERL_SUB_BIN_SIZE;
-
-	    ret = CONS(hp, make_binary(sb1), NIL);
-	    hp += 2;
-	}
-    } else {
-	if ((hsflags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
-	    hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
-	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-	    sb1 = NULL;
-	} else {
-	    hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
-	    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-	    sb1 = (ErlSubBin *) hp;
-	    sb1->thing_word = HEADER_SUB_BIN;
-	    sb1->size = pos;
-	    sb1->offs = offset;
-	    sb1->orig = orig;
-	    sb1->bitoffs = bit_offset;
-	    sb1->bitsize = 0;
-	    sb1->is_writable = 0;
-	    hp += ERL_SUB_BIN_SIZE;
-	}
-
-	sb2 = (ErlSubBin *) hp;
-	sb2->thing_word = HEADER_SUB_BIN;
-	sb2->size = orig_size - pos - len;
-	sb2->offs = offset + pos + len;
-	sb2->orig = orig;
-	sb2->bitoffs = bit_offset;
-	sb2->bitsize = bit_size;
-	sb2->is_writable = 0;
-	hp += ERL_SUB_BIN_SIZE;
-
-	ret = CONS(hp, make_binary(sb2), NIL);
-	hp += 2;
-	if (sb1 != NULL) {
-	    ret = CONS(hp, make_binary(sb1), ret);
-	    hp += 2;
-	}
-    }
-    return ret;
-}
-
-static Eterm do_split_global_result(Process* p, FindallData *fad, Uint fad_sz,
-				    Uint subject, Uint hsflags)
-{
-    size_t orig_size;
-    Eterm orig;
-    Uint offset;
-    Uint bit_offset;
-    Uint bit_size;
-    ErlSubBin *sb;
-    Sint i;
-    Sint tail;
-    Uint list_size;
-    Uint end_pos;
-    Uint do_trim = hsflags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL);
-    Eterm* hp;
-    Eterm* hendp;
-    Eterm ret;
-
-    tail = fad_sz - 1;
-    list_size = fad_sz + 1;
-    orig_size = binary_size(subject);
-    end_pos = (Uint)(orig_size);
-
-    hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
-    hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2);
-    ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
-    ASSERT(bit_size == 0);
-
-    ret = NIL;
-
-    for (i = tail; i >= 0; --i) {
-        sb = (ErlSubBin *)(hp);
-        sb->size = end_pos - (fad[i].pos + fad[i].len);
-        if (!(sb->size == 0 && do_trim)) {
-            sb->thing_word = HEADER_SUB_BIN;
-            sb->offs = offset + fad[i].pos + fad[i].len;
-            sb->orig = orig;
-            sb->bitoffs = bit_offset;
-            sb->bitsize = 0;
-            sb->is_writable = 0;
-            hp += ERL_SUB_BIN_SIZE;
-            ret = CONS(hp, make_binary(sb), ret);
-            hp += 2;
-            do_trim &= ~BINARY_SPLIT_TRIM;
-        }
-	end_pos = fad[i].pos;
-    }
-
-    sb = (ErlSubBin *)(hp);
-    sb->size = fad[0].pos;
-    if (!(sb->size == 0 && do_trim)) {
-        sb->thing_word = HEADER_SUB_BIN;
-        sb->offs = offset;
-        sb->orig = orig;
-        sb->bitoffs = bit_offset;
-        sb->bitsize = 0;
-        sb->is_writable = 0;
-        hp += ERL_SUB_BIN_SIZE;
-        ret = CONS(hp, make_binary(sb), ret);
-        hp += 2;
-    }
-    HRelease(p, hendp, hp);
-    return ret;
-}
-
-static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
-{
-    Eterm *tp;
-    Uint pos;
-    Sint len;
-    *optp = 0;
-    *posp = 0;
-    *endp = binary_size(bin);
-    if (l == THE_NON_VALUE || l == NIL) {
-	return 0;
-    } else if (is_list(l)) {
-	while(is_list(l)) {
-	    Eterm t = CAR(list_val(l));
-	    Uint orig_size;
-	    if (is_atom(t)) {
-		if (t == am_global) {
-		    *optp |= BINARY_SPLIT_GLOBAL;
-		    l = CDR(list_val(l));
-		    continue;
-		}
-		if (t == am_trim) {
-		    *optp |= BINARY_SPLIT_TRIM;
-		    l = CDR(list_val(l));
-		    continue;
-		}
-		if (t == am_trim_all) {
-		    *optp |= BINARY_SPLIT_TRIM_ALL;
-		    l = CDR(list_val(l));
-		    continue;
-		}
-	    }
-	    if (!is_tuple(t)) {
-		goto badarg;
-	    }
-	    tp = tuple_val(t);
-	    if (arityval(*tp) != 2) {
-		goto badarg;
-	    }
-	    if (tp[1] != am_scope || is_not_tuple(tp[2])) {
-		goto badarg;
-	    }
-	    tp = tuple_val(tp[2]);
-	    if (arityval(*tp) != 2) {
-		goto badarg;
-	    }
-	    if (!term_to_Uint(tp[1], &pos)) {
-		goto badarg;
-	    }
-	    if (!term_to_Sint(tp[2], &len)) {
-		goto badarg;
-	    }
-	    if (len < 0) {
-		Uint lentmp = -(Uint)len;
-		/* overflow */
-		if ((Sint)lentmp < 0) {
-		    goto badarg;
-		}
-		len = lentmp;
-		pos -= len;
-	    }
-	    /* overflow */
-	    if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
-		goto badarg;
-	    }
-	    *endp = len + pos;
-	    *posp = pos;
-	    if ((orig_size = binary_size(bin)) < pos ||
-		orig_size < (*endp)) {
-		goto badarg;
-	    }
-	    l = CDR(list_val(l));
-	}
-	return 0;
-    } else {
-    badarg:
-	return 1;
-    }
-}
-
-static BIF_RETTYPE binary_split_trap(BIF_ALIST_3)
-{
-    int runres;
-    Eterm result;
-    Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
-    runres = do_binary_split(BIF_P,BIF_ARG_1,0,0,0,NIL,bin,BIF_ARG_2,&result);
-    if (runres == DO_BIN_MATCH_OK) {
-	BIF_RET(result);
-    } else {
-	BUMP_ALL_REDS(BIF_P);
-	BIF_TRAP3(&binary_split_trap_export, BIF_P, BIF_ARG_1, result,
-		  BIF_ARG_3);
-    }
-}
-
-BIF_RETTYPE binary_split_3(BIF_ALIST_3)
-{
-    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
-}
-
-static BIF_RETTYPE
-binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
-{
-    Uint hsflags;
-    Uint hsstart;
-    Uint hsend;
-    Eterm *tp;
-    Eterm type;
-    Binary *bin;
-    Eterm bin_term = NIL;
-    int runres;
-    Eterm result;
-
-    if (is_not_binary(arg1)) {
-	goto badarg;
-    }
-    if (parse_split_opts_list(arg3, arg1, &hsstart, &hsend, &hsflags)) {
-	goto badarg;
-    }
-    if (hsend == 0) {
-	tp = HAlloc(p, 2);
-	result = NIL;
-	result = CONS(tp, arg1, result);
-	BIF_RET(result);
-    }
-    if (is_tuple(arg2)) {
-	tp = tuple_val(arg2);
-	if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
-	    goto badarg;
-	}
-	if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
-	    !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
-	    goto badarg;
-	}
-	type = tp[1];
-	bin = ((ProcBin *) binary_val(tp[2]))->val;
-	if (type == am_bm &&
-	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
-	    goto badarg;
-	}
-	if (type == am_ac &&
-	    ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
-	    goto badarg;
-	}
-	bin_term = tp[2];
-    } else if (do_binary_match_compile(arg2, &type, &bin)) {
-	goto badarg;
-    }
-    runres = do_binary_split(p, arg1, hsstart, hsend, hsflags, type, bin, NIL, &result);
-    if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
-	Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
-	bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
-    } else if (bin_term == NIL) {
-	erts_bin_free(bin);
-    }
-    switch(runres) {
-    case DO_BIN_MATCH_OK:
-	BIF_RET(result);
-    case DO_BIN_MATCH_RESTART:
-	BIF_TRAP3(&binary_split_trap_export, p, arg1, result, bin_term);
-    default:
-	goto badarg;
-    }
- badarg:
-    BIF_ERROR(p,BADARG);
-}
-
-
-BIF_RETTYPE binary_split_2(BIF_ALIST_2)
-{
-    return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
-}
-
-
 BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
 {
     ErlSubBin *sb;
-- 
cgit v1.2.3


From 8067992954f9b882ffd7332ee669a254c000f1b2 Mon Sep 17 00:00:00 2001
From: Andrew Bennett 
Date: Fri, 18 Sep 2015 09:38:46 -0600
Subject: erts: Minor refactor for binary find BIF backend

* Use NULL instead of THE_NON_VALUE for non-Eterm variable.
* Add BinaryFindState_bignum struct to avoid unnecessary type casting.
---
 erts/emulator/beam/erl_bif_binary.c | 109 ++++++++++++++++++------------------
 1 file changed, 55 insertions(+), 54 deletions(-)

diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 9f72b8c0ac..b1ebf0327e 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -531,21 +531,23 @@ static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos,
     state->out = NULL;
 }
 
-static void ac_restore_find_all(ACFindAllState *state, char *buff)
+static void ac_restore_find_all(ACFindAllState *state,
+                                const ACFindAllState *src)
 {
-    memcpy(state,buff,sizeof(ACFindAllState));
+    memcpy(state, src, sizeof(ACFindAllState));
     if (state->allocated > 0) {
 	state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated));
-	memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m);
+	memcpy(state->out, src+1, sizeof(FindallData)*state->m);
     } else {
 	state->out = NULL;
     }
 }
 
-static void ac_serialize_find_all(ACFindAllState *state, char *buff)
+static void ac_serialize_find_all(const ACFindAllState *state,
+                                  ACFindAllState *dst)
 {
-    memcpy(buff,state,sizeof(ACFindAllState));
-    memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m);
+    memcpy(dst, state, sizeof(ACFindAllState));
+    memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
 }
 
 static void ac_clean_find_all(ACFindAllState *state)
@@ -805,24 +807,24 @@ static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len)
     state->out = NULL;
 }
 
-static void bm_restore_find_all(BMFindAllState *state, char *buff)
+static void bm_restore_find_all(BMFindAllState *state,
+                                const BMFindAllState *src)
 {
-    memcpy(state,buff,sizeof(BMFindAllState));
+    memcpy(state, src, sizeof(BMFindAllState));
     if (state->allocated > 0) {
 	state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) *
 				(state->allocated));
-	memcpy(state->out,buff+sizeof(BMFindAllState),
-	       sizeof(FindallData)*state->m);
+	memcpy(state->out, src+1, sizeof(FindallData)*state->m);
     } else {
 	state->out = NULL;
     }
 }
 
-static void bm_serialize_find_all(BMFindAllState *state, char *buff)
+static void bm_serialize_find_all(const BMFindAllState *state,
+                                  BMFindAllState *dst)
 {
-    memcpy(buff,state,sizeof(BMFindAllState));
-    memcpy(buff+sizeof(BMFindAllState),state->out,
-	   sizeof(FindallData)*state->m);
+    memcpy(dst, state, sizeof(BMFindAllState));
+    memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
 }
 
 static void bm_clean_find_all(BMFindAllState *state)
@@ -1032,6 +1034,17 @@ typedef struct BinaryFindState {
     Eterm (*global_result)    (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint);
 } BinaryFindState;
 
+typedef struct BinaryFindState_bignum {
+    Eterm           bignum_hdr;
+    BinaryFindState bfs;
+    union {
+	BMFindFirstState bmffs;
+	BMFindAllState   bmfas;
+	ACFindFirstState acffs;
+	ACFindAllState   acfas;
+    } data;
+} BinaryFindState_bignum;
+
 #define SIZEOF_BINARY_FIND_STATE(S) \
 	  (sizeof(BinaryFindState)+sizeof(S))
 
@@ -1197,7 +1210,7 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
     byte *bytes;
     Uint bitoffs, bitsize;
     byte *temp_alloc = NULL;
-    char *state_ptr = NULL;
+    BinaryFindState_bignum *state_ptr = NULL;
 
     ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
     if (bitsize != 0) {
@@ -1207,17 +1220,14 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
     }
     if (state_term != NIL) {
-	state_ptr = (char *)(big_val(state_term));
-	state_ptr += sizeof(Eterm);
-	bfs = (BinaryFindState *)(state_ptr);
-	state_ptr += sizeof(BinaryFindState);
+	state_ptr = (BinaryFindState_bignum *)(big_val(state_term));
+	bfs = &(state_ptr->bfs);
     }
 
     if (bfs->flags & BINARY_FIND_ALL) {
 	if (bfs->type == am_bm) {
 	    BMData *bm;
 	    Sint pos;
-	    Eterm *hp;
 	    BMFindAllState state;
 	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
 	    Uint save_reds = reds;
@@ -1229,7 +1239,7 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    if (state_term == NIL) {
 		bm_init_find_all(&state, bfs->hsstart, bfs->hsend);
 	    } else {
-		bm_restore_find_all(&state, state_ptr);
+		bm_restore_find_all(&state, &(state_ptr->data.bmfas));
 	    }
 
 	    pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
@@ -1242,12 +1252,11 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 #ifdef HARDDEBUG
 		erts_printf("Trap bm!\n");
 #endif
-		hp = HAlloc(p, x+1);
-		hp[0] = make_pos_bignum_header(x);
-		state_ptr = (char *)(hp);
-		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
-		bm_serialize_find_all(&state, state_ptr+sizeof(Eterm)+sizeof(BinaryFindState));
-		*res_term = make_big(hp);
+		state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+		state_ptr->bignum_hdr = make_pos_bignum_header(x);
+		memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+		bm_serialize_find_all(&state, &state_ptr->data.bmfas);
+		*res_term = make_big(&state_ptr->bignum_hdr);
 		erts_free_aligned_binary_bytes(temp_alloc);
 		bm_clean_find_all(&state);
 		return DO_BIN_MATCH_RESTART;
@@ -1262,7 +1271,6 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    ACTrie *act;
 	    int acr;
 	    ACFindAllState state;
-	    Eterm *hp;
 	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
 	    Uint save_reds = reds;
 
@@ -1273,7 +1281,7 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    if (state_term == NIL) {
 		ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend);
 	    } else {
-		ac_restore_find_all(&state, state_ptr);
+		ac_restore_find_all(&state, &(state_ptr->data.acfas));
 	    }
 	    acr = ac_find_all_non_overlapping(&state, bytes, &reds);
 	    if (acr == AC_NOT_FOUND) {
@@ -1285,12 +1293,11 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 #ifdef HARDDEBUG
 		erts_printf("Trap ac!\n");
 #endif
-		hp = HAlloc(p, x+1);
-		hp[0] = make_pos_bignum_header(x);
-		state_ptr = (char *)(hp);
-		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
-		ac_serialize_find_all(&state, state_ptr+sizeof(Eterm)+sizeof(BinaryFindState));
-		*res_term = make_big(hp);
+                state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+		state_ptr->bignum_hdr = make_pos_bignum_header(x);
+		memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+		ac_serialize_find_all(&state, &state_ptr->data.acfas);
+		*res_term = make_big(&state_ptr->bignum_hdr);
 		erts_free_aligned_binary_bytes(temp_alloc);
 		ac_clean_find_all(&state);
 		return DO_BIN_MATCH_RESTART;
@@ -1306,7 +1313,6 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	if (bfs->type == am_bm) {
 	    BMData *bm;
 	    Sint pos;
-	    Eterm *hp;
 	    BMFindFirstState state;
 	    Uint reds = get_reds(p, BM_LOOP_FACTOR);
 	    Uint save_reds = reds;
@@ -1318,7 +1324,7 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    if (state_term == NIL) {
 		bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend);
 	    } else {
-		memcpy((void *)(&state), (const void *)(state_ptr), sizeof(BMFindFirstState));
+		memcpy(&state, &state_ptr->data.bmffs, sizeof(BMFindFirstState));
 	    }
 
 #ifdef HARDDEBUG
@@ -1335,13 +1341,11 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 #ifdef HARDDEBUG
 		erts_printf("Trap bm!\n");
 #endif
-		hp = HAlloc(p, x+1);
-		hp[0] = make_pos_bignum_header(x);
-		state_ptr = (char *)(hp);
-		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
-		memcpy((void *)(state_ptr+sizeof(Eterm)+sizeof(BinaryFindState)),
-		       (const void *)(&state), sizeof(BMFindFirstState));
-		*res_term = make_big(hp);
+                state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+                state_ptr->bignum_hdr = make_pos_bignum_header(x);
+		memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+		memcpy(&state_ptr->data.acffs, &state, sizeof(BMFindFirstState));
+		*res_term = make_big(&state_ptr->bignum_hdr);
 		erts_free_aligned_binary_bytes(temp_alloc);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
@@ -1355,7 +1359,6 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    Uint pos, rlen;
 	    int acr;
 	    ACFindFirstState state;
-	    Eterm *hp;
 	    Uint reds = get_reds(p, AC_LOOP_FACTOR);
 	    Uint save_reds = reds;
 
@@ -1366,7 +1369,7 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 	    if (state_term == NIL) {
 		ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend);
 	    } else {
-		memcpy((void *)(&state), (const void *)(state_ptr), sizeof(ACFindFirstState));
+		memcpy(&state, &state_ptr->data.acffs, sizeof(ACFindFirstState));
 	    }
 	    acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
 	    if (acr == AC_NOT_FOUND) {
@@ -1378,13 +1381,11 @@ static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binar
 #ifdef HARDDEBUG
 		erts_printf("Trap ac!\n");
 #endif
-		hp = HAlloc(p, x+1);
-		hp[0] = make_pos_bignum_header(x);
-		state_ptr = (char *)(hp);
-		memcpy((void *)(state_ptr+sizeof(Eterm)), bfs, sizeof(BinaryFindState));
-		memcpy((void *)(state_ptr+sizeof(Eterm)+sizeof(BinaryFindState)),
-		       (const void *)(&state), sizeof(ACFindFirstState));
-		*res_term = make_big(hp);
+		state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+		state_ptr->bignum_hdr = make_pos_bignum_header(x);
+		memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+		memcpy(&state_ptr->data.acffs, &state, sizeof(ACFindFirstState));
+		*res_term = make_big(&state_ptr->bignum_hdr);
 		erts_free_aligned_binary_bytes(temp_alloc);
 		return DO_BIN_MATCH_RESTART;
 	    } else {
@@ -1763,7 +1764,7 @@ static BIF_RETTYPE binary_find_trap(BIF_ALIST_3)
     int runres;
     Eterm result;
     Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
-    runres = do_binary_find(BIF_P, BIF_ARG_1, THE_NON_VALUE, bin, BIF_ARG_2, &result);
+    runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result);
     if (runres == DO_BIN_MATCH_OK) {
 	BIF_RET(result);
     } else {
-- 
cgit v1.2.3


From e59290283c595efa84c8ac7720eb128dedb98fce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 1 Sep 2015 17:37:04 +0200
Subject: io: Make a fast code path for i/o requests

Unicode support was introduced in R13. The backward compatible code
path in 'io' is unlikely to be used in practice. Therefore, make sure
that the common case of an i/o server supporting unicode requests is
as fast as possible, making sure to get rid of the mathing and
re-building of tuples in the current code. Make the backward
compatible code path work with a minimum of code.
---
 lib/stdlib/src/io.erl | 43 +++++++++++--------------------------------
 1 file changed, 11 insertions(+), 32 deletions(-)

diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index 284f2e5a2b..5dc8b4541e 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.erl
@@ -631,41 +631,20 @@ io_requests(Pid, [], [Rs|Cont], Tail) ->
 io_requests(_Pid, [], [], _Tail) -> 
     {false,[]}.
 
-
-bc_req(Pid,{Op,Enc,Param},MaybeConvert) ->
-    case net_kernel:dflag_unicode_io(Pid) of
-	true ->
-	    {false,{Op,Enc,Param}};
-	false ->
-	    {MaybeConvert,{Op,Param}}
-    end;
-bc_req(Pid,{Op,Enc,P,F},MaybeConvert) ->
-    case net_kernel:dflag_unicode_io(Pid) of
-	true ->
-	    {false,{Op,Enc,P,F}};
-	false ->
-	    {MaybeConvert,{Op,P,F}}
-    end;
-bc_req(Pid, {Op,Enc,M,F,A},MaybeConvert) ->
+bc_req(Pid, Req0, MaybeConvert) ->
     case net_kernel:dflag_unicode_io(Pid) of
 	true ->
-	    {false,{Op,Enc,M,F,A}};
+	    %% The most common case. A modern i/o server.
+	    {false,Req0};
 	false ->
-	    {MaybeConvert,{Op,M,F,A}}
-    end;
-bc_req(Pid, {Op,Enc,P,M,F,A},MaybeConvert) ->
-    case net_kernel:dflag_unicode_io(Pid) of
-	true ->
-	    {false,{Op,Enc,P,M,F,A}};
-	false ->
-	    {MaybeConvert,{Op,P,M,F,A}}
-    end;
-bc_req(Pid,{Op,Enc},MaybeConvert) ->
-    case net_kernel:dflag_unicode_io(Pid) of
-	true ->
-	    {false,{Op, Enc}};
-	false ->
-	    {MaybeConvert,Op}
+	    %% Backward compatibility only. Unlikely to ever happen.
+	    case tuple_to_list(Req0) of
+		[Op,_Enc] ->
+		    {MaybeConvert,Op};
+		[Op,_Enc|T] ->
+		    Req = list_to_tuple([Op|T]),
+		    {MaybeConvert,Req}
+	    end
     end.
 
 io_request(Pid, {write,Term}) ->
-- 
cgit v1.2.3


From bd60ac17406d0cd4c12cc92944dfc1fdc068a746 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Thu, 10 Sep 2015 16:38:05 +0200
Subject: sys_pre_expand: Remove unnecessary inclusion of erl_bits.hrl

---
 lib/compiler/src/sys_pre_expand.erl | 2 --
 1 file changed, 2 deletions(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index d9cc4b530c..bd37859bc2 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -32,8 +32,6 @@
 -import(ordsets, [from_list/1,union/2]).
 -import(lists,   [member/2,foldl/3,foldr/3]).
 
--include("../include/erl_bits.hrl").
-
 -type fa() :: {atom(), arity()}.
 
 -record(expand, {module=[],                     %Module name
-- 
cgit v1.2.3


From 765df80e59c6d5397483518f6770c0fd3f9f9412 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 06:43:05 +0100
Subject: sys_pre_expand: Remove imports of ordsets functions

Importing from_list/1 and union/2 from the 'ordsets', while at
the same time making calls explicit calls to the functions with
same name in the 'gb_sets' module is confusing.  Make all calls
to 'ordsets' explicit.
---
 lib/compiler/src/sys_pre_expand.erl | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index bd37859bc2..aa1b04b631 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -29,7 +29,6 @@
 %% Main entry point.
 -export([module/2]).
 
--import(ordsets, [from_list/1,union/2]).
 -import(lists,   [member/2,foldl/3,foldr/3]).
 
 -type fa() :: {atom(), arity()}.
@@ -127,7 +126,7 @@ module_predef_func_beh_info(#expand{callbacks=Callbacks,
     PreExp=PreDef,
     {[gen_beh_info(Callbacks, OptionalCallbacks)],
      St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
-	       exports=union(from_list(PreExp), Exports)}}.
+	       exports=ordsets:union(ordsets:from_list(PreExp), Exports)}}.
 
 gen_beh_info(Callbacks, OptionalCallbacks) ->
     List = make_list(Callbacks),
@@ -167,7 +166,8 @@ module_predef_funcs_mod_info(St) ->
           [{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
      St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef),
 				     St#expand.defined),
-               exports=union(from_list(PreExp), St#expand.exports)}}.
+               exports=ordsets:union(ordsets:from_list(PreExp),
+				     St#expand.exports)}}.
 
 %% forms(Forms, State) ->
 %%      {TransformedForms,State'}
@@ -194,7 +194,8 @@ attribute(module, Module, _L, St) ->
     true = is_atom(Module),
     St#expand{module=Module};
 attribute(export, Es, _L, St) ->
-    St#expand{exports=union(from_list(Es), St#expand.exports)};
+    St#expand{exports=ordsets:union(ordsets:from_list(Es),
+				    St#expand.exports)};
 attribute(import, Is, _L, St) ->
     import(Is, St);
 attribute(compile, _C, _L, St) ->
@@ -652,7 +653,7 @@ string_to_conses(Line, Cs, Tail) ->
 
 import({Mod,Fs}, St) ->
     true = is_atom(Mod),
-    Mfs = from_list(Fs),
+    Mfs = ordsets:from_list(Fs),
     St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}.
 
 add_imports(Mod, [F|Fs], Is) ->
-- 
cgit v1.2.3


From e28fdaaad1c367bd073116fa0468ae22303189c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 08:58:09 +0100
Subject: sys_pre_expand: Remove vestiges of variable usage tracking

Before the Core Erlang passes were introduced a long time ago,
sys_pre_expand used to track used and new variables in order to
do lambda lifting (i.e. transform funs into ordinary Erlang
functions). Lambda lifting is now done in v3_kernel.

Remove the few remaining vestiges of variable tracking in the
comments and the code.
---
 lib/compiler/src/sys_pre_expand.erl | 55 ++++++++-----------------------------
 1 file changed, 11 insertions(+), 44 deletions(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index aa1b04b631..e0c35d63e4 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -230,8 +230,6 @@ head(As, St) -> pattern_list(As, St).
 %%      {TransformedPattern,State'}
 %%
 
-pattern({var,_,'_'}=Var, St) ->                 %Ignore anonymous variable.
-    {Var,St};
 pattern({var,_,_}=Var, St) ->
     {Var,St};
 pattern({char,_,_}=Char, St) ->
@@ -384,19 +382,19 @@ expr({block,Line,Es0}, St0) ->
     {Es,St1} = exprs(Es0, St0),
     {{block,Line,Es},St1};
 expr({'if',Line,Cs0}, St0) ->
-    {Cs,St1} = icr_clauses(Cs0, St0),
+    {Cs,St1} = clauses(Cs0, St0),
     {{'if',Line,Cs},St1};
 expr({'case',Line,E0,Cs0}, St0) ->
     {E,St1} = expr(E0, St0),
-    {Cs,St2} = icr_clauses(Cs0, St1),
+    {Cs,St2} = clauses(Cs0, St1),
     {{'case',Line,E,Cs},St2};
 expr({'receive',Line,Cs0}, St0) ->
-    {Cs,St1} = icr_clauses(Cs0, St0),
+    {Cs,St1} = clauses(Cs0, St0),
     {{'receive',Line,Cs},St1};
 expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
     {To,St1} = expr(To0, St0),
     {ToEs,St2} = exprs(ToEs0, St1),
-    {Cs,St3} = icr_clauses(Cs0, St2),
+    {Cs,St3} = clauses(Cs0, St2),
     {{'receive',Line,Cs,To,ToEs},St3};
 expr({'fun',Line,Body}, St) ->
     fun_tq(Line, Body, St);
@@ -429,12 +427,11 @@ expr({call,Line,F,As0}, St0) ->
     {{call,Line,Fun1,As1},St1};
 expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
     {Es1,St1} = exprs(Es0, St0),
-    {Scs1,St2} = icr_clauses(Scs0, St1),
-    {Ccs1,St3} = icr_clauses(Ccs0, St2),
+    {Scs1,St2} = clauses(Scs0, St1),
+    {Ccs1,St3} = clauses(Ccs0, St2),
     {As1,St4} = exprs(As0, St3),
     {{'try',Line,Es1,Scs1,Ccs1,As1},St4};
 expr({'catch',Line,E0}, St0) ->
-    %% Catch exports no new variables.
     {E,St1} = expr(E0, St0),
     {{'catch',Line,E},St1};
 expr({match,Line,P0,E0}, St0) ->
@@ -455,21 +452,6 @@ expr_list([E0|Es0], St0) ->
     {[E|Es],St2};
 expr_list([], St) -> {[],St}.
 
-%% icr_clauses([Clause], State) -> {[TransformedClause],State'}
-%%  Be very careful here to return the variables that are really used
-%%  and really new.
-
-icr_clauses([], St) -> {[],St};
-icr_clauses(Clauses, St) -> icr_clauses2(Clauses, St).
-
-icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], St0) ->
-    {H,St1} = head(H0, St0),
-    {G,St2} = guard(G0, St1),
-    {B,St3} = exprs(B0, St2),
-    {Cs,St4} = icr_clauses2(Cs0, St3),
-    {[{clause,Line,H,G,B}|Cs],St4};
-icr_clauses2([], St) -> {[],St}.
-
 %% lc_tq(Line, Qualifiers, State) ->
 %%      {[TransQual],State'}
 
@@ -485,16 +467,9 @@ lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) ->
     {Qs1,St3} = lc_tq(Line, Qs0, St2),
     {[{b_generate,Lg,P1,G1}|Qs1],St3};
 lc_tq(Line, [F0 | Qs0], St0) ->
-    case erl_lint:is_guard_test(F0) of
-        true ->
-            {F1,St1} = guard_test(F0, St0),
-            {Qs1,St2} = lc_tq(Line, Qs0, St1),
-            {[F1|Qs1],St2};
-        false ->
-            {F1,St1} = expr(F0, St0),
-            {Qs1,St2} = lc_tq(Line, Qs0, St1),
-            {[F1 | Qs1],St2}
-    end;
+    {F1,St1} = expr(F0, St0),
+    {Qs1,St2} = lc_tq(Line, Qs0, St1),
+    {[F1|Qs1],St2};
 lc_tq(_Line, [], St0) ->
     {[],St0}.
 
@@ -526,7 +501,7 @@ fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) ->
 fun_tq(Lf, {function,_,_,_}=ExtFun, St) ->
     {{'fun',Lf,ExtFun},St};
 fun_tq(Lf, {clauses,Cs0}, St0) ->
-    {Cs1,St1} = fun_clauses(Cs0, St0),
+    {Cs1,St1} = clauses(Cs0, St0),
     {Fname,St2} = new_fun_name(St1),
     %% Set dummy values for Index and Uniq -- the real values will
     %% be assigned by beam_asm.
@@ -534,18 +509,10 @@ fun_tq(Lf, {clauses,Cs0}, St0) ->
     {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}.
 
 fun_tq(Line, Cs0, St0, Name) ->
-    {Cs1,St1} = fun_clauses(Cs0, St0),
+    {Cs1,St1} = clauses(Cs0, St0),
     {Fname,St2} = new_fun_name(St1, Name),
     {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}.
 
-fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) ->
-    {H,St1} = head(H0, St0),
-    {G,St2} = guard(G0, St1),
-    {B,St3} = exprs(B0, St2),
-    {Cs,St4} = fun_clauses(Cs0, St3),
-    {[{clause,L,H,G,B}|Cs],St4};
-fun_clauses([], St) -> {[],St}.
-
 %% new_fun_name(State) -> {FunName,State}.
 
 new_fun_name(St) ->
-- 
cgit v1.2.3


From f51512fadee8f9ef817bfc0af8ba92a532f8def2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Mon, 9 Nov 2015 16:14:16 +0100
Subject: sys_pre_expand: Clean up data structures

The handling of non-remote calls is messy, with several lookups
to determine whether the call is local or to some imported module.

We can simplify the code if we keep a map that immediately gives
us the answer. Here is an example of what the map entries look
like:

  {f,1} => local
  {foldl,3} => {imported,lists}

That is, there should be a local call to f/1 and a remote call
to lists:foldl/3.

Note that there is no longer any need to keep the set of all defined
functions in the state record.
---
 lib/compiler/src/sys_pre_expand.erl | 115 +++++++++++++++---------------------
 1 file changed, 48 insertions(+), 67 deletions(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index e0c35d63e4..21961bc020 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -35,21 +35,20 @@
 
 -record(expand, {module=[],                     %Module name
                  exports=[],                    %Exports
-                 imports=[],                    %Imports
                  attributes=[],                 %Attributes
                  callbacks=[],                  %Callbacks
                  optional_callbacks=[] :: [fa()],  %Optional callbacks
-                 defined,			%Defined functions (gb_set)
                  vcount=0,                      %Variable counter
                  func=[],                       %Current function
                  arity=[],                      %Arity for current function
-                 fcount=0			%Local fun count
+                 fcount=0,			%Local fun count
+		 ctype				%Call type map
                 }).
 
 %% module(Forms, CompileOptions)
 %%      {ModuleName,Exports,TransformedForms,CompileOptions'}
-%%  Expand the forms in one module. N.B.: the lists of predefined
-%%  exports and imports are really ordsets!
+%%  Expand the forms in one module.
+%%
 %%  CompileOptions is augmented with options from -compile attributes.
 
 module(Fs0, Opts0) ->
@@ -62,19 +61,28 @@ module(Fs0, Opts0) ->
     %% Set pre-defined exported functions.
     PreExp = [{module_info,0},{module_info,1}],
 
+    %% Build the set of defined functions and the initial call
+    %% type map.
+    Defined = defined_functions(Fs, PreExp),
+    Ctype = maps:from_list([{K,local} || K <- Defined]),
+
     %% Build initial expand record.
     St0 = #expand{exports=PreExp,
-                  defined=PreExp
+		  ctype=Ctype
                  },
+
     %% Expand the functions.
-    {Tfs,St1} = forms(Fs, define_functions(Fs, St0)),
+    {Tfs,St1} = forms(Fs, St0),
+
     %% Get the correct list of exported functions.
     Exports = case member(export_all, Opts) of
-                  true -> gb_sets:to_list(St1#expand.defined);
+                  true -> Defined;
                   false -> St1#expand.exports
               end,
+    St2 = St1#expand{exports=Exports,ctype=undefined},
+
     %% Generate all functions from stored info.
-    {Ats,St3} = module_attrs(St1#expand{exports = Exports}),
+    {Ats,St3} = module_attrs(St2),
     {Mfs,St4} = module_predef_funcs(St3),
     {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs,
      Opts}.
@@ -82,14 +90,14 @@ module(Fs0, Opts0) ->
 compiler_options(Forms) ->
     lists:flatten([C || {attribute,_,compile,C} <- Forms]).
     
-%% define_function(Form, State) -> State.
+%% defined_function(Forms, Predef) -> Functions.
 %%  Add function to defined if form is a function.
 
-define_functions(Forms, #expand{defined=Predef}=St) ->
+defined_functions(Forms, Predef) ->
     Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
                   (_, Acc) -> Acc
                end, Predef, Forms),
-    St#expand{defined=gb_sets:from_list(Fs)}.
+    ordsets:from_list(Fs).
 
 module_attrs(#expand{attributes=Attributes}=St) ->
     Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
@@ -110,23 +118,21 @@ is_fa_list([{FuncName, Arity}|L])
 is_fa_list([]) -> true;
 is_fa_list(_) -> false.
 
-module_predef_funcs(St) ->
-    {Mpf1,St1}=module_predef_func_beh_info(St),
-    {Mpf2,St2}=module_predef_funcs_mod_info(St1),
+module_predef_funcs(St0) ->
+    {Mpf1,St1} = module_predef_func_beh_info(St0),
+    Mpf2 = module_predef_funcs_mod_info(St1),
     Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2],
-    {Mpf,St2}.
+    {Mpf,St1}.
 
 module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
     {[], St};
 module_predef_func_beh_info(#expand{callbacks=Callbacks,
                                     optional_callbacks=OptionalCallbacks,
-                                    defined=Defined,
 				    exports=Exports}=St) ->
-    PreDef=[{behaviour_info,1}],
-    PreExp=PreDef,
+    PreDef0 = [{behaviour_info,1}],
+    PreDef = ordsets:from_list(PreDef0),
     {[gen_beh_info(Callbacks, OptionalCallbacks)],
-     St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
-	       exports=ordsets:union(ordsets:from_list(PreExp), Exports)}}.
+     St#expand{exports=ordsets:union(PreDef, Exports)}}.
 
 gen_beh_info(Callbacks, OptionalCallbacks) ->
     List = make_list(Callbacks),
@@ -153,21 +159,16 @@ make_optional_list([{Name,Arity}|Rest]) ->
        {integer,0,Arity}]},
      make_optional_list(Rest)}.
 
-module_predef_funcs_mod_info(St) ->
-    PreDef = [{module_info,0},{module_info,1}],
-    PreExp = PreDef,
-    {[{function,0,module_info,0,
-       [{clause,0,[],[],
+module_predef_funcs_mod_info(#expand{module=Mod}) ->
+    ModAtom = {atom,0,Mod},
+    [{function,0,module_info,0,
+      [{clause,0,[],[],
         [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
-          [{atom,0,St#expand.module}]}]}]},
-      {function,0,module_info,1,
-       [{clause,0,[{var,0,'X'}],[],
+          [ModAtom]}]}]},
+     {function,0,module_info,1,
+      [{clause,0,[{var,0,'X'}],[],
         [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
-          [{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
-     St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef),
-				     St#expand.defined),
-               exports=ordsets:union(ordsets:from_list(PreExp),
-				     St#expand.exports)}}.
+          [ModAtom,{var,0,'X'}]}]}]}].
 
 %% forms(Forms, State) ->
 %%      {TransformedForms,State'}
@@ -403,21 +404,15 @@ expr({named_fun,Line,Name,Cs}, St) ->
 expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
     {As,St1} = expr_list(As0, St0),
     Ar = length(As),
-    case defined(N,Ar,St1) of
-	true ->
+    Key = {N,Ar},
+    case St1#expand.ctype of
+	#{Key:=local} ->
 	    {{call,Line,Atom,As},St1};
+	#{Key:={imported,Mod}} ->
+	    {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
 	_ ->
-	    case imported(N, Ar, St1) of
-		{yes,Mod} ->
-		    {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
-		no ->
-		    case erl_internal:bif(N, Ar) of
-			true ->
-			    {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
-			false -> %% This should have been handled by erl_lint
-			    {{call,Line,Atom,As},St1}
-		    end
-	    end
+	    true = erl_internal:bif(N, Ar),
+	    {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}
     end;
 expr({call,Line,{remote,Lr,M0,F},As0}, St0) ->
     {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0),
@@ -613,25 +608,11 @@ string_to_conses(Line, Cs, Tail) ->
 
 %% import(Line, Imports, State) ->
 %%      State'
-%% imported(Name, Arity, State) ->
-%%      {yes,Module} | no
-%%  Handle import declarations and test for imported functions. No need to
-%%  check when building imports as code is correct.
+%%  Handle import declarations.
 
-import({Mod,Fs}, St) ->
+import({Mod,Fs}, #expand{ctype=Ctype0}=St) ->
     true = is_atom(Mod),
-    Mfs = ordsets:from_list(Fs),
-    St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}.
-
-add_imports(Mod, [F|Fs], Is) ->
-    add_imports(Mod, Fs, orddict:store(F, Mod, Is));
-add_imports(_, [], Is) -> Is.
-
-imported(F, A, St) ->
-    case orddict:find({F,A}, St#expand.imports) of
-        {ok,Mod} -> {yes,Mod};
-        error -> no
-    end.
-
-defined(F, A, St) ->
-    gb_sets:is_element({F,A}, St#expand.defined).
+    Ctype = foldl(fun(F, A) ->
+			  A#{F=>{imported,Mod}}
+		  end, Ctype0, Fs),
+    St#expand{ctype=Ctype}.
-- 
cgit v1.2.3


From 624638e6668dcf51f6b616de5fc7c9ff1aa77bcf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 12:50:08 +0100
Subject: sys_pre_expand: Remove uncovered clause in pat_bit_size/2

The atom 'all' can never occur in a size field before sys_pre_expand
has been run.
---
 lib/compiler/src/sys_pre_expand.erl | 1 -
 1 file changed, 1 deletion(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 21961bc020..150a453eec 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -532,7 +532,6 @@ pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) ->
     {[{bin_element,Line,Expr,Size,Type}|Es],St2}.
 
 pat_bit_size(default, St) -> {default,St};
-pat_bit_size({atom,_La,all}=All, St) -> {All,St};
 pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St};
 pat_bit_size(Size, St) ->
     Line = element(2, Size),
-- 
cgit v1.2.3


From f1c449d76e4dbe2f12de05ec08809e0a86cc63b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 10:28:15 +0100
Subject: Cover sys_pre_expand:pattern/2

---
 lib/compiler/test/match_SUITE.erl | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 67d668f650..9166726aa2 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -449,7 +449,10 @@ do_map_vars_used(X, Y, Map) ->
 coverage(Config) when is_list(Config) ->
     %% Cover beam_dead.
     ok = coverage_1(x, a),
-    ok = coverage_1(x, b).
+    ok = coverage_1(x, b),
+
+    %% Cover sys_pre_expand.
+    ok = coverage_3("abc").
 
 coverage_1(B, Tag) ->
     case Tag of
@@ -460,4 +463,6 @@ coverage_1(B, Tag) ->
 coverage_2(1, a, x) -> ok;
 coverage_2(2, b, x) -> ok.
 
+coverage_3([$a]++[]++"bc") -> ok.
+
 id(I) -> I.
-- 
cgit v1.2.3


From 488862ddb45a8949efe5d71b7eb4a4a5e6406a07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 10:46:21 +0100
Subject: Cover code for callbacks in sys_pre_expand

---
 lib/compiler/test/misc_SUITE.erl | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index b88abaf62d..c7c20fdbf2 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -38,7 +38,11 @@
 -compile({no_auto_import,[byte_size/1]}).
 -import(erlang,[byte_size/1]).
 
-
+%% Cover the code for callback handling.
+-callback must_define_this_one() -> 'ok'.
+-callback do_something_strange(atom()) -> 'ok'.
+-optional_callbacks([do_something_strange/1]).
+-optional_callbacks([ignore_me]).		%Invalid; ignored.
 
 %% Include an opaque declaration to cover the stripping of
 %% opaque types from attributes in v3_kernel.
-- 
cgit v1.2.3


From 7929fd383a90e1fbc47b6d0625cd8d889794a755 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 14:49:12 +0100
Subject: sys_pre_expand: Cover coerce_to_float/2

---
 lib/compiler/src/sys_pre_expand.erl  |  3 +--
 lib/compiler/test/bs_match_SUITE.erl | 13 ++++++++++---
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 150a453eec..7ab4e1845c 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -552,8 +552,7 @@ coerce_to_float({integer,L,I}=E, [float|_]) ->
     try
         {float,L,float(I)}
     catch
-        error:badarg -> E;
-        error:badarith -> E
+        error:badarg -> E
     end;
 coerce_to_float(E, _) -> E.
     
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index a19b152bc5..d8bef18a1a 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -116,9 +116,16 @@ fun_shadow_4(L) ->
 
 int_float(Config) when is_list(Config) ->
     %% OTP-5323
-    ?line <<103133.0:64/float>> = <<103133:64/float>>,
-    ?line <<103133:64/float>> = <<103133:64/float>>,
-    ok.
+    <<103133.0:64/float>> = <<103133:64/float>>,
+    <<103133:64/float>> = <<103133:64/float>>,
+
+    %% Coverage of error cases in sys_pre_expand:coerce_to_float/2.
+    case id(default) of
+	<<(1 bsl 1024):64/float>> ->
+	    ?t:fail();
+	default ->
+	    ok
+    end.
 
 %% Stolen from erl_eval_SUITE and modified.
 %% OTP-5269. Bugs in the bit syntax.
-- 
cgit v1.2.3


From 80f9c7d0650330d53a3c457d85916447abe17194 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 15:25:29 +0100
Subject: sys_core_dsetel: Use a map instead of a dict

For large modules, a map is significantly faster than a dict.
---
 lib/compiler/src/sys_core_dsetel.erl | 36 ++++++++++++++++++++----------------
 1 file changed, 20 insertions(+), 16 deletions(-)

diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index ac32db10fe..c6cfdbae7e 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -72,7 +72,7 @@ module(M0, _Options) ->
     {ok,M}.
 
 visit_module(#c_module{defs=Ds0}=R) ->
-    Env = dict:new(),
+    Env = #{},
     Ds = visit_module_1(Ds0, Env, []),
     R#c_module{defs=Ds}.
 
@@ -95,9 +95,11 @@ visit(Env, #c_var{name={_,_}}=R) ->
     {R, Env};
 visit(Env0, #c_var{name=X}=R) ->
     %% There should not be any free variables. If there are,
-    %% the next line will cause an exception.
-    {ok, N} = dict:find(X, Env0),
-    {R, dict:store(X, N+1, Env0)};
+    %% the case will fail with an exception.
+    case Env0 of
+	#{X:=N} ->
+	    {R, Env0#{X:=N+1}}
+    end;
 visit(Env, #c_literal{}=R) ->
     {R, Env};
 visit(Env0, #c_tuple{es=Es0}=R) ->
@@ -203,7 +205,7 @@ bind_vars(Vs, Env) ->
     bind_vars(Vs, Env, []).
 
 bind_vars([#c_var{name=X}|Vs], Env0, Xs)->
-    bind_vars(Vs, dict:store(X, 0, Env0), [X|Xs]);
+    bind_vars(Vs, Env0#{X=>0}, [X|Xs]);
 bind_vars([], Env,Xs) ->
     {Xs, Env}.
 
@@ -217,7 +219,7 @@ visit_pats([], Env, Vs) ->
     {Vs, Env}.
 
 visit_pat(Env0, #c_var{name=V}, Vs) ->
-    {[V|Vs], dict:store(V, 0, Env0)};
+    {[V|Vs], Env0#{V=>0}};
 visit_pat(Env0, #c_tuple{es=Es}, Vs) ->
     visit_pats(Es, Env0, Vs);
 visit_pat(Env0, #c_map{es=Es}, Vs) ->
@@ -235,23 +237,25 @@ visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) ->
 	case Sz of
 	    #c_var{name=V} ->
 		%% We don't tolerate free variables.
-		{ok, N} = dict:find(V, Env0),
-		{Vs0, dict:store(V, N+1, Env0)};
+		case Env0 of
+		    #{V:=N} ->
+			{Vs0, Env0#{V:=N+1}}
+		end;
 	    _ ->
 		visit_pat(Env0, Sz, Vs0)
 	end,
     visit_pat(Env1, Val, Vs1);
 visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) ->
-    visit_pat(dict:store(V, 0, Env0), P, [V|Vs]);
+    visit_pat(Env0#{V=>0}, P, [V|Vs]);
 visit_pat(Env, #c_literal{}, Vs) ->
     {Vs, Env}.
 
 restore_vars([V|Vs], Env0, Env1) ->
-    case dict:find(V, Env0) of
-	{ok, N} ->
-	    restore_vars(Vs, Env0, dict:store(V, N, Env1));
-	error ->
-	    restore_vars(Vs, Env0, dict:erase(V, Env1))
+    case Env0 of
+	#{V:=N} ->
+	    restore_vars(Vs, Env0, Env1#{V=>N});
+	_ ->
+	    restore_vars(Vs, Env0, maps:remove(V, Env1))
     end;
 restore_vars([], _, Env1) ->
     Env1.
@@ -349,8 +353,8 @@ is_safe(#c_literal{}) -> true;
 is_safe(_) -> false.
 
 is_single_use(V, Env) ->
-    case dict:find(V, Env) of
-	{ok, 1} ->
+    case Env of
+	#{V:=1} ->
 	    true;
 	_ ->
 	    false
-- 
cgit v1.2.3


From 9106490ce6fa3e21641ae0dc66f20b18f755fec3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 15:41:59 +0100
Subject: beam_asm: Speed up assembly for modules with many exports

Eliminate searching in the list of exported functions in favor of
using a map. For modules with a huge number of exported functions
(such as NBAP-PDU-Contents in the asn1 test suite), that will mean a
significant speed-up.
---
 lib/compiler/src/beam_asm.erl | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index a3201b0f4a..95be471de3 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -30,11 +30,12 @@
 module(Code, Abst, SourceFile, Opts) ->
     {ok,assemble(Code, Abst, SourceFile, Opts)}.
 
-assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
     {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
     {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
     NumFuncs = length(Asm0),
     {Asm,Attr} = on_load(Asm0, Attr0),
+    Exp = cerl_sets:from_list(Exp0),
     {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
     build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
 
@@ -61,7 +62,7 @@ insert_on_load_instruction(Is0, Entry) ->
     Bef ++ [El,on_load|Is].
 
 assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) ->
-    Dict1 = case member({Name,Arity}, Exp) of
+    Dict1 = case cerl_sets:is_element({Name,Arity}, Exp) of
 		true ->
 		    beam_dict:export(Name, Arity, Entry, Dict0);
 		false ->
-- 
cgit v1.2.3


From 30b70dbe78b8acc7a5450518cf89d9749ce6730d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 15:49:20 +0100
Subject: beam_dict: Speed up storage of funs

For huge modules with many funs (such as NBAP-PDU-Contents in the asn1
test suite), the call to length/1 in beam_dict:lambda/3 will dominate
the running time of the beam_asm pass.
---
 lib/compiler/src/beam_dict.erl | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 2b5f8c1b7f..654fb47dbd 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -44,7 +44,7 @@
 	 locals = []		    :: [{label(), arity(), label()}],
 	 imports = gb_trees:empty() :: import_tab(),
 	 strings = <<>>		    :: binary(),	%String pool
-	 lambdas = [],				%[{...}]
+	 lambdas = {0,[]},				%[{...}]
 	 literals = dict:new()	    :: literal_tab(),
 	 fnames = #{}               :: fname_tab(),
 	 lines = #{}                :: line_tab(),
@@ -145,15 +145,14 @@ string(Str, Dict) when is_list(Str) ->
 -spec lambda(label(), non_neg_integer(), bdict()) ->
         {non_neg_integer(), bdict()}.
 
-lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) ->
-    OldIndex = length(Lambdas0),
+lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
     %% Set Index the same as OldIndex.
     Index = OldIndex,
     %% Initialize OldUniq to 0. It will be set to an unique value
     %% based on the MD5 checksum of the BEAM code for the module.
     OldUniq = 0,
     Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
-    {OldIndex,Dict#asm{lambdas=Lambdas}}.
+    {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
 
 %% Returns the index for a literal (adding it to the literal table if necessary).
 %%    literal(Literal, Dict) -> {Index,Dict'}
@@ -236,13 +235,13 @@ string_table(#asm{strings=Strings,string_offset=Size}) ->
 
 -spec lambda_table(bdict()) -> {non_neg_integer(), [<<_:192>>]}.
 
-lambda_table(#asm{locals=Loc0,lambdas=Lambdas0}) ->
+lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) ->
     Lambdas1 = sofs:relation(Lambdas0),
     Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]),
     Lambdas2 = sofs:relative_product1(Lambdas1, Loc),
     Lambdas = [<> ||
 		  {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)],
-    {length(Lambdas),Lambdas}.
+    {NumLambdas,Lambdas}.
 
 %% Returns the literal table.
 %%    literal_table(Dict) -> {NumLiterals, [<>,TermInExternalFormat]}
-- 
cgit v1.2.3


From f9a3728566668a6ad54067fe347ab9055d351b7a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Tue, 10 Nov 2015 16:27:53 +0100
Subject: v3_kernel: Speed up compilation of modules with many funs

Using a map to store the number of free variables for funs instead of
an orddict will speed up the v3_kernel pass for modules with a huge
number of funs (such as NBAP-PDU-Contents in the asn1 test suite).
---
 lib/compiler/src/v3_kernel.erl | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 7ee564683b..011748df3a 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -117,7 +117,7 @@ copy_anno(Kdst, Ksrc) ->
 	       fcount=0,			%Fun counter
                ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables
 	       funs=[],				%Fun functions
-	       free=[],				%Free variables
+	       free=#{},			%Free variables
 	       ws=[]   :: [warning()],		%Warnings.
 	       guard_refc=0}).			%> 0 means in guard
 
@@ -1837,14 +1837,17 @@ handle_reuse_anno_1(V, _St) -> V.
 %% get_free(Name, Arity, State) -> [Free].
 %% store_free(Name, Arity, [Free], State) -> State.
 
-get_free(F, A, St) ->
-    case orddict:find({F,A}, St#kern.free) of
-	{ok,Val} -> Val;
-	error -> []
+get_free(F, A, #kern{free=FreeMap}) ->
+    Key = {F,A},
+    case FreeMap of
+	#{Key:=Val} -> Val;
+	_ -> []
     end.
 
-store_free(F, A, Free, St) ->
-    St#kern{free=orddict:store({F,A}, Free, St#kern.free)}.
+store_free(F, A, Free, #kern{free=FreeMap0}=St) ->
+    Key = {F,A},
+    FreeMap = FreeMap0#{Key=>Free},
+    St#kern{free=FreeMap}.
 
 break_rets({break,Rs}) -> Rs;
 break_rets(return) -> [].
-- 
cgit v1.2.3


From 05eee243c7e5fb8d501807a3b11065e1bf2c2b9a Mon Sep 17 00:00:00 2001
From: Magnus Henoch 
Date: Wed, 11 Nov 2015 15:33:39 +0000
Subject: Fix documentation of net_kernel:allow/1

Make the documentation reflect what the function actually does.
---
 lib/kernel/doc/src/net_kernel.xml | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml
index a0132db8db..311e0d8ea4 100644
--- a/lib/kernel/doc/src/net_kernel.xml
+++ b/lib/kernel/doc/src/net_kernel.xml
@@ -63,11 +63,16 @@
   
     
       
-      Limit access to a specified set of nodes
+      Permit access to a specified set of nodes
       
-        
Limits access to the specified set of nodes. Any access
-          attempts made from (or to) nodes not in Nodes will be
-          rejected.

+        
Permits access to the specified set of nodes.

+        
Before the first call to allow/1, any node with the correct
+          cookie can be connected. When allow/1 is called, a list
+          of allowed nodes is established. Any access attempts made from (or to)
+          nodes not in that list will be rejected.

+        
Subsequent calls to allow/1 will add the specified nodes
+          to the list of allowed nodes. It is not possible to remove nodes
+          from the list.

         
Returns error if any element in Nodes is not
           an atom.

       
-- 
cgit v1.2.3


From 63466c5522ed58b6e73e35dc29c7c7584f073768 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Wed, 2 Sep 2015 18:35:29 +0200
Subject: erts: Refactor erl_mmap to allow several mapper instances

---
 erts/emulator/beam/erl_alloc.c      |   5 +-
 erts/emulator/beam/erl_bif_info.c   |   2 +-
 erts/emulator/sys/common/erl_mmap.c | 550 ++++++++++++++++++------------------
 erts/emulator/sys/common/erl_mmap.h |  19 +-
 erts/emulator/sys/common/erl_mseg.c |  11 +-
 5 files changed, 299 insertions(+), 288 deletions(-)

diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index d83a2930d6..bb3998769c 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -2668,7 +2668,7 @@ erts_allocator_info(int to, void *arg)
 	    erts_mseg_info(i, &to, arg, 0, NULL, NULL);
 	}
 	erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n");
-	erts_mmap_info(&to, arg, NULL, NULL, &emis);
+	erts_mmap_info(&erts_dflt_mmapper, &to, arg, NULL, NULL, &emis);
     }
 #endif
 
@@ -3020,7 +3020,8 @@ reply_alloc_info(void *vair)
 
 		    ai_list = erts_bld_cons(hpp, szp,
 					    ainfo, ai_list);
-		    ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis));
+		    ainfo = (air->only_sz ? NIL :
+                             erts_mmap_info(&erts_dflt_mmapper, NULL, NULL, hpp, szp, &emis));
 		    ainfo = erts_bld_tuple3(hpp, szp,
                                             alloc_atom,
                                             erts_bld_atom(hpp,szp,"erts_mmap"),
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 79ccf8db64..a73ad826db 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -3441,7 +3441,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
 	    BIF_RET(res);
 	}
         else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
-            BIF_RET(erts_mmap_debug_info(BIF_P));
+            BIF_RET(erts_mmap_debug_info(&erts_dflt_mmapper, BIF_P));
         }
 	else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
 	    BIF_RET(erts_debug_get_unique_monotonic_integer_state(BIF_P));
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index eeaf96dd93..e8ff2bf752 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -51,21 +51,21 @@
 #endif
 
 /*
- * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after
+ * `mm->sa.bot` and `mm->sua.top` are read only after
  * initialization, but the other pointers are not; i.e., only
  * ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held.
  */
 #define ERTS_MMAP_IN_SUPERCARRIER(PTR)					\
-    (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot)			\
-     < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot))
+    (((UWord) (PTR)) - ((UWord) mm->sa.bot)			\
+     < ((UWord) mm->sua.top) - ((UWord) mm->sa.bot))
 #define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR)				\
-    (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)),	\
-     (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot)			\
-      < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot)))
+    (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)),	\
+     (((UWord) (PTR)) - ((UWord) mm->sa.bot)			\
+      < ((UWord) mm->sa.top) - ((UWord) mm->sa.bot)))
 #define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR)				\
-    (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)),	\
-     (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot)			\
-      < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot)))
+    (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)),	\
+     (((UWord) (PTR)) - ((UWord) mm->sua.bot)			\
+      < ((UWord) mm->sua.top) - ((UWord) mm->sua.bot)))
 
 UWord erts_page_inv_mask;
 
@@ -196,10 +196,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
 
 #define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ)			\
     do {							\
-	erts_smp_mtx_lock(&mmap_state.mtx);			\
+	erts_smp_mtx_lock(&mm->mtx);			\
 	ERTS_MMAP_OP_START((IN_SZ));				\
 	ERTS_MMAP_OP_END((RES), (OUT_SZ));			\
-	erts_smp_mtx_unlock(&mmap_state.mtx);			\
+	erts_smp_mtx_unlock(&mm->mtx);			\
     } while (0)
 
 #define ERTS_MUNMAP_OP(PTR, SZ)					\
@@ -218,9 +218,9 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
 
 #define ERTS_MUNMAP_OP_LCK(PTR, SZ)				\
     do {							\
-	erts_smp_mtx_lock(&mmap_state.mtx);			\
+	erts_smp_mtx_lock(&mm->mtx);			\
 	ERTS_MUNMAP_OP((PTR), (SZ));				\
-	erts_smp_mtx_unlock(&mmap_state.mtx);			\
+	erts_smp_mtx_unlock(&mm->mtx);			\
     } while (0)
 
 #define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ)		\
@@ -246,10 +246,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
 
 #define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ)	\
     do {							\
-	erts_smp_mtx_lock(&mmap_state.mtx);			\
+	erts_smp_mtx_lock(&mm->mtx);			\
 	ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ));	\
 	ERTS_MREMAP_OP_END((RES), (OUT_SZ));			\
-	erts_smp_mtx_unlock(&mmap_state.mtx);			\
+	erts_smp_mtx_unlock(&mm->mtx);			\
     } while (0)
 
 #define ERTS_MMAP_OP_ABORT()					\
@@ -293,7 +293,7 @@ typedef struct {
     Uint nseg;
 }ErtsFreeSegMap;
 
-static struct {
+struct ErtsMemMapper_ {
     int (*reserve_physical)(char *, UWord);
     void (*unreserve_physical)(char *, UWord);
     int supercarrier;
@@ -345,54 +345,56 @@ static struct {
 	    UWord used;
 	} os;
     } size;
-} mmap_state;
+};
+
+ErtsMemMapper erts_dflt_mmapper;
 
 #define ERTS_MMAP_SIZE_SC_SA_INC(SZ) 						\
     do {									\
-	mmap_state.size.supercarrier.used.total += (SZ);			\
-	mmap_state.size.supercarrier.used.sa += (SZ);				\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total		\
-			 <= mmap_state.size.supercarrier.total);		\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa			\
-			 <= mmap_state.size.supercarrier.used.total);		\
+	mm->size.supercarrier.used.total += (SZ);			\
+	mm->size.supercarrier.used.sa += (SZ);				\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total		\
+			 <= mm->size.supercarrier.total);		\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa			\
+			 <= mm->size.supercarrier.used.total);		\
     } while (0)
 #define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) 						\
     do {									\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ));	\
-	mmap_state.size.supercarrier.used.total -= (SZ);			\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ));		\
-	mmap_state.size.supercarrier.used.sa -= (SZ);				\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ));	\
+	mm->size.supercarrier.used.total -= (SZ);			\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa >= (SZ));		\
+	mm->size.supercarrier.used.sa -= (SZ);				\
     } while (0)
 #define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) 						\
     do {									\
-	mmap_state.size.supercarrier.used.total += (SZ);			\
-	mmap_state.size.supercarrier.used.sua += (SZ);				\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total		\
-			 <= mmap_state.size.supercarrier.total);		\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua			\
-			 <= mmap_state.size.supercarrier.used.total);		\
+	mm->size.supercarrier.used.total += (SZ);			\
+	mm->size.supercarrier.used.sua += (SZ);				\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total		\
+			 <= mm->size.supercarrier.total);		\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua			\
+			 <= mm->size.supercarrier.used.total);		\
     } while (0)
 #define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) 						\
     do {									\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ));	\
-	mmap_state.size.supercarrier.used.total -= (SZ);			\
-	ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ));	\
-	mmap_state.size.supercarrier.used.sua -= (SZ);				\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ));	\
+	mm->size.supercarrier.used.total -= (SZ);			\
+	ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua >= (SZ));	\
+	mm->size.supercarrier.used.sua -= (SZ);				\
     } while (0)
 #define ERTS_MMAP_SIZE_OS_INC(SZ)						\
     do {									\
-	ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ));		\
-	mmap_state.size.os.used += (SZ);					\
+	ERTS_MMAP_ASSERT(mm->size.os.used + (SZ) >= (SZ));		\
+	mm->size.os.used += (SZ);					\
     } while (0)
 #define ERTS_MMAP_SIZE_OS_DEC(SZ) 						\
     do {									\
-	ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ));			\
-	mmap_state.size.os.used -= (SZ);					\
+	ERTS_MMAP_ASSERT(mm->size.os.used >= (SZ));			\
+	mm->size.os.used -= (SZ);					\
     } while (0)
 
 
 static void
-add_free_desc_area(char *start, char *end)
+add_free_desc_area(ErtsMemMapper* mm, char *start, char *end)
 {
     ERTS_MMAP_ASSERT(end == (void *) 0 || end > start);
     if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) {
@@ -402,7 +404,7 @@ add_free_desc_area(char *start, char *end)
 
 	no = 1;
 	prev_desc = (ErtsFreeSegDesc *) start;
-	prev_desc->start = mmap_state.desc.free_list;
+	prev_desc->start = mm->desc.free_list;
 	desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc));
 	desc_end = start + 2*sizeof(ErtsFreeSegDesc);
 
@@ -413,59 +415,59 @@ add_free_desc_area(char *start, char *end)
 	    desc_end += sizeof(ErtsFreeSegDesc);
 	    no++;
 	}
-	mmap_state.desc.free_list = (char *) prev_desc;
-	mmap_state.no.free_seg_descs += no;
+	mm->desc.free_list = (char *) prev_desc;
+	mm->no.free_seg_descs += no;
     }
 }
 
 static ErtsFreeSegDesc *
-add_unused_free_desc_area(void)
+add_unused_free_desc_area(ErtsMemMapper* mm)
 {
     char *ptr;
-    if (!mmap_state.desc.unused_start)
+    if (!mm->desc.unused_start)
 	return NULL;
 
-    ERTS_MMAP_ASSERT(mmap_state.desc.unused_end);
+    ERTS_MMAP_ASSERT(mm->desc.unused_end);
     ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE
-		     <= mmap_state.desc.unused_end - mmap_state.desc.unused_start);
+		     <= mm->desc.unused_end - mm->desc.unused_start);
 
-    ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE;
-    add_free_desc_area(mmap_state.desc.unused_start, ptr);
+    ptr = mm->desc.unused_start + ERTS_PAGEALIGNED_SIZE;
+    add_free_desc_area(mm, mm->desc.unused_start, ptr);
 
-    if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
-	mmap_state.desc.unused_start = ptr;
+    if ((mm->desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
+	mm->desc.unused_start = ptr;
     else
-	mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL;
+	mm->desc.unused_end = mm->desc.unused_start = NULL;
 
-    ERTS_MMAP_ASSERT(mmap_state.desc.free_list);
-    return (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+    ERTS_MMAP_ASSERT(mm->desc.free_list);
+    return (ErtsFreeSegDesc *) mm->desc.free_list;
 }
 
 static ERTS_INLINE ErtsFreeSegDesc *
-alloc_desc(void)
+alloc_desc(ErtsMemMapper* mm)
 {
     ErtsFreeSegDesc *res;
-    res = (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+    res = (ErtsFreeSegDesc *) mm->desc.free_list;
     if (!res) {
-	res = add_unused_free_desc_area();
+	res = add_unused_free_desc_area(mm);
 	if (!res)
 	    return NULL;
     }
-    mmap_state.desc.free_list = res->start;
-    ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs);
-    mmap_state.no.free_segs.curr++;
-    if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr)
-	mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr;
+    mm->desc.free_list = res->start;
+    ASSERT(mm->no.free_segs.curr < mm->no.free_seg_descs);
+    mm->no.free_segs.curr++;
+    if (mm->no.free_segs.max < mm->no.free_segs.curr)
+	mm->no.free_segs.max = mm->no.free_segs.curr;
     return res;
 }
 
 static ERTS_INLINE void
-free_desc(ErtsFreeSegDesc *desc)
+free_desc(ErtsMemMapper* mm, ErtsFreeSegDesc *desc)
 {
-    desc->start = mmap_state.desc.free_list;
-    mmap_state.desc.free_list = (char *) desc;
-    ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0);
-    mmap_state.no.free_segs.curr--;
+    desc->start = mm->desc.free_list;
+    mm->desc.free_list = (char *) desc;
+    ERTS_MMAP_ASSERT(mm->no.free_segs.curr > 0);
+    mm->no.free_segs.curr--;
 }
 
 static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode)
@@ -1232,7 +1234,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
 #    define ERTS_MMAP_FD		(-1)
 #  else
 #    define ERTS_MMAP_FLAGS		(MAP_PRIVATE)
-#    define ERTS_MMAP_FD		mmap_state.mmap_fd
+#    define ERTS_MMAP_FD		mm->mmap_fd
 #  endif
 #endif
 
@@ -1377,11 +1379,12 @@ static void unreserve_noop(char *ptr, UWord size)
 }
 
 static UWord
-alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
+alloc_desc_insert_free_seg(ErtsMemMapper* mm,
+                           ErtsFreeSegMap *map, char* start, char* end)
 {
     char *ptr;
     ErtsFreeSegMap *da_map;
-    ErtsFreeSegDesc *desc = alloc_desc();
+    ErtsFreeSegDesc *desc = alloc_desc(mm);
     if (desc) {
 	insert_free_seg(map, desc, start, end);
 	return 0;
@@ -1394,13 +1397,13 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
      */
 
 #if ERTS_HAVE_OS_MMAP
-    if (!mmap_state.no_os_mmap) {
-        ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
+    if (!mm->no_os_mmap) {
+        ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
         if (ptr) {
-            mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
+            mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
             ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE);
-            add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE);
-            desc = alloc_desc();
+            add_free_desc_area(mm, ptr, ptr+ERTS_PAGEALIGNED_SIZE);
+            desc = alloc_desc(mm);
             ERTS_MMAP_ASSERT(desc);
             insert_free_seg(map, desc, start, end);
             return 0;
@@ -1411,20 +1414,20 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
     /*
      * ...then try to find a good place in the supercarrier...
      */
-    da_map = &mmap_state.sua.map;
+    da_map = &mm->sua.map;
     desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
     if (desc) {
-	if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+	if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
 	    ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE);
 	else
 	    desc = NULL;
 	
     }
     else {
-	da_map = &mmap_state.sa.map;
+	da_map = &mm->sa.map;
 	desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
 	if (desc) {
-	    if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+	    if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
 		ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
 	    else
 		desc = NULL;
@@ -1432,15 +1435,15 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
     }
     if (desc) {
 	char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE;
-	add_free_desc_area(desc->start, da_end);
+	add_free_desc_area(mm, desc->start, da_end);
 	if (da_end != desc->end)
 	    resize_free_seg(da_map, desc, da_end, desc->end);
 	else {
 	    delete_free_seg(da_map, desc);
-	    free_desc(desc);
+	    free_desc(mm, desc);
 	}
 
-	desc = alloc_desc();
+	desc = alloc_desc(mm);
 	ERTS_MMAP_ASSERT(desc);
 	insert_free_seg(map, desc, start, end);
 	return 0;
@@ -1453,10 +1456,10 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
     ptr = start + ERTS_PAGEALIGNED_SIZE;
     ERTS_MMAP_ASSERT(ptr <= end);
 
-    add_free_desc_area(start, ptr);
+    add_free_desc_area(mm, start, ptr);
 
     if (ptr != end) {
-	desc = alloc_desc();
+	desc = alloc_desc(mm);
 	ERTS_MMAP_ASSERT(desc);
 	insert_free_seg(map, desc, ptr, end);
     }
@@ -1465,46 +1468,46 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
 }
 
 void *
-erts_mmap(Uint32 flags, UWord *sizep)
+erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
 {
     char *seg;
     UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep);
 
     /* Map in premapped supercarrier */
-    if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
+    if (mm->supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
 	char *end;
 	ErtsFreeSegDesc *desc;
 	Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
 
-	erts_smp_mtx_lock(&mmap_state.mtx);
+	erts_smp_mtx_lock(&mm->mtx);
 
 	ERTS_MMAP_OP_START(*sizep);
 
 	if (!superaligned) {
-	    desc = lookup_free_seg(&mmap_state.sua.map, asize);
+	    desc = lookup_free_seg(&mm->sua.map, asize);
 	    if (desc) {
 		seg = desc->start;
 		end = seg+asize;
-		if (!mmap_state.reserve_physical(seg, asize))
+		if (!mm->reserve_physical(seg, asize))
 		    goto supercarrier_reserve_failure;
 		if (desc->end == end) {
-		    delete_free_seg(&mmap_state.sua.map, desc);
-		    free_desc(desc);
+		    delete_free_seg(&mm->sua.map, desc);
+		    free_desc(mm, desc);
 		}
 		else {
 		    ERTS_MMAP_ASSERT(end < desc->end);
-		    resize_free_seg(&mmap_state.sua.map, desc, end, desc->end);
+		    resize_free_seg(&mm->sua.map, desc, end, desc->end);
 		}
 		ERTS_MMAP_SIZE_SC_SUA_INC(asize);
 		goto supercarrier_success;
 	    }
 
-	    if (asize <= mmap_state.sua.bot - mmap_state.sa.top) {
-		if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize,
+	    if (asize <= mm->sua.bot - mm->sa.top) {
+		if (!mm->reserve_physical(mm->sua.bot - asize,
 						 asize))
 		    goto supercarrier_reserve_failure;
-		mmap_state.sua.bot -= asize;
-		seg = mmap_state.sua.bot;
+		mm->sua.bot -= asize;
+		seg = mm->sua.bot;
 		ERTS_MMAP_SIZE_SC_SUA_INC(asize);
 		goto supercarrier_success;
 	    }
@@ -1512,84 +1515,84 @@ erts_mmap(Uint32 flags, UWord *sizep)
 
 	asize = ERTS_SUPERALIGNED_CEILING(asize);
 
-	desc = lookup_free_seg(&mmap_state.sa.map, asize);
+	desc = lookup_free_seg(&mm->sa.map, asize);
 	if (desc) {
 	    char *start = seg = desc->start;
 	    seg = (char *) ERTS_SUPERALIGNED_CEILING(seg);
 	    end = seg+asize;
-	    if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+	    if (!mm->reserve_physical(start, (UWord) (end - start)))
 		goto supercarrier_reserve_failure;
 	    ERTS_MMAP_SIZE_SC_SA_INC(asize);
 	    if (desc->end == end) {
 		if (start != seg)
-		    resize_free_seg(&mmap_state.sa.map, desc, start, seg);
+		    resize_free_seg(&mm->sa.map, desc, start, seg);
 		else {
-		    delete_free_seg(&mmap_state.sa.map, desc);
-		    free_desc(desc);
+		    delete_free_seg(&mm->sa.map, desc);
+		    free_desc(mm, desc);
 		}
 	    }
 	    else {
 		ERTS_MMAP_ASSERT(end < desc->end);
-		resize_free_seg(&mmap_state.sa.map, desc, end, desc->end);
+		resize_free_seg(&mm->sa.map, desc, end, desc->end);
 		if (start != seg) {
 		    UWord ad_sz;
-		    ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+		    ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
 						       start, seg);
 		    start += ad_sz;
 		    if (start != seg)
-			mmap_state.unreserve_physical(start, (UWord) (seg - start));
+			mm->unreserve_physical(start, (UWord) (seg - start));
 		}
 	    }
 	    goto supercarrier_success;
 	}
 
 	if (superaligned) {
-	    char *start = mmap_state.sa.top;
+	    char *start = mm->sa.top;
 	    seg = (char *) ERTS_SUPERALIGNED_CEILING(start);
 
-	    if (asize + (seg - start) <= mmap_state.sua.bot - start) {
+	    if (asize + (seg - start) <= mm->sua.bot - start) {
 		end = seg + asize;
-		if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+		if (!mm->reserve_physical(start, (UWord) (end - start)))
 		    goto supercarrier_reserve_failure;
-		mmap_state.sa.top = end;
+		mm->sa.top = end;
 		ERTS_MMAP_SIZE_SC_SA_INC(asize);
 		if (start != seg) {
 		    UWord ad_sz;
-		    ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+		    ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
 						       start, seg);
 		    start += ad_sz;
 		    if (start != seg)
-			mmap_state.unreserve_physical(start, (UWord) (seg - start));
+			mm->unreserve_physical(start, (UWord) (seg - start));
 		}
 		goto supercarrier_success;
 	    }
 
-	    desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE);
+	    desc = lookup_free_seg(&mm->sua.map, asize + ERTS_SUPERALIGNED_SIZE);
 	    if (desc) {
 		char *org_start = desc->start;
 		char *org_end = desc->end;
 
 		seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start);
 		end = seg + asize;
-		if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg)))
+		if (!mm->reserve_physical(seg, (UWord) (org_end - seg)))
 		    goto supercarrier_reserve_failure;
 		ERTS_MMAP_SIZE_SC_SUA_INC(asize);
 		if (org_start != seg) {
 		    ERTS_MMAP_ASSERT(org_start < seg);
-		    resize_free_seg(&mmap_state.sua.map, desc, org_start, seg);
+		    resize_free_seg(&mm->sua.map, desc, org_start, seg);
 		    desc = NULL;
 		}
 		if (end != org_end) {
 		    UWord ad_sz = 0;
 		    ERTS_MMAP_ASSERT(end < org_end);
 		    if (desc)
-			resize_free_seg(&mmap_state.sua.map, desc, end, org_end);
+			resize_free_seg(&mm->sua.map, desc, end, org_end);
 		    else
-			ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+			ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
 							   end, org_end);
 		    end += ad_sz;
 		    if (end != org_end)
-			mmap_state.unreserve_physical(end,
+			mm->unreserve_physical(end,
 						      (UWord) (org_end - end));
 		}
 		goto supercarrier_success;
@@ -1597,12 +1600,12 @@ erts_mmap(Uint32 flags, UWord *sizep)
 	}
 
 	ERTS_MMAP_OP_ABORT();
-	erts_smp_mtx_unlock(&mmap_state.mtx);
+	erts_smp_mtx_unlock(&mm->mtx);
     }
 
 #if ERTS_HAVE_OS_MMAP
     /* Map using OS primitives */
-    if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) {
+    if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) {
 	if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) {
 	    seg = os_mmap(NULL, asize, 0);
 	    if (!seg)
@@ -1660,25 +1663,25 @@ supercarrier_success:
 #endif
 
     ERTS_MMAP_OP_END(seg, asize);
-    erts_smp_mtx_unlock(&mmap_state.mtx);
+    erts_smp_mtx_unlock(&mm->mtx);
 
     *sizep = asize;
     return (void *) seg;
 
 supercarrier_reserve_failure:
-    erts_smp_mtx_unlock(&mmap_state.mtx);
+    erts_smp_mtx_unlock(&mm->mtx);
     *sizep = 0;
     return NULL;
 }
 
 void
-erts_munmap(Uint32 flags, void *ptr, UWord size)
+erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size)
 {
     ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
     ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size));
 
     if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
-	ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+	ERTS_MMAP_ASSERT(!mm->no_os_mmap);
 #if ERTS_HAVE_OS_MMAP
 	ERTS_MUNMAP_OP_LCK(ptr, size);
 	ERTS_MMAP_SIZE_OS_DEC(size);
@@ -1691,45 +1694,45 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
 	ErtsFreeSegDesc *prev, *next, *desc;
 	UWord ad_sz = 0;
 
-	ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+	ERTS_MMAP_ASSERT(mm->supercarrier);
 
 	start = (char *) ptr;
 	end = start + size;
 
-	erts_smp_mtx_lock(&mmap_state.mtx);
+	erts_smp_mtx_lock(&mm->mtx);
 
 	ERTS_MUNMAP_OP(ptr, size);
 
 	if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
 
-	    map = &mmap_state.sa.map;
+	    map = &mm->sa.map;
 	    adjacent_free_seg(map, start, end, &prev, &next);
 
 	    ERTS_MMAP_SIZE_SC_SA_DEC(size);
-	    if (end == mmap_state.sa.top) {
+	    if (end == mm->sa.top) {
 		ERTS_MMAP_ASSERT(!next);
 		if (prev) {
 		    start = prev->start;
 		    delete_free_seg(map, prev);
-		    free_desc(prev);
+		    free_desc(mm, prev);
 		}
-		mmap_state.sa.top = start;
+		mm->sa.top = start;
 		goto supercarrier_success;
 	    }
 	}
 	else {
-	    map = &mmap_state.sua.map;
+	    map = &mm->sua.map;
 	    adjacent_free_seg(map, start, end, &prev, &next);
 
 	    ERTS_MMAP_SIZE_SC_SUA_DEC(size);
-	    if (start == mmap_state.sua.bot) {
+	    if (start == mm->sua.bot) {
 		ERTS_MMAP_ASSERT(!prev);
 		if (next) {
 		    end = next->end;
 		    delete_free_seg(map, next);
-		    free_desc(next);
+		    free_desc(mm, next);
 		}
-		mmap_state.sua.bot = end;
+		mm->sua.bot = end;
 		goto supercarrier_success;
 	    }
 	}
@@ -1741,7 +1744,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
 	    end = next->end;
 	    if (prev) {
 		delete_free_seg(map, next);
-		free_desc(next);
+		free_desc(mm, next);
 		goto save_prev;
 	    }
 	    desc = next;
@@ -1755,7 +1758,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
 	if (desc)
 	    resize_free_seg(map, desc, start, end);
 	else
-	    ad_sz = alloc_desc_insert_free_seg(map, start, end);
+	    ad_sz = alloc_desc_insert_free_seg(mm, map, start, end);
 	
     supercarrier_success: {
 	    UWord unres_sz;
@@ -1763,30 +1766,32 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
 	    ERTS_MMAP_ASSERT(size >= ad_sz);
 	    unres_sz = size - ad_sz;
 	    if (unres_sz)
-		mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
+		mm->unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
 
-            erts_smp_mtx_unlock(&mmap_state.mtx);
+            erts_smp_mtx_unlock(&mm->mtx);
 	}
     }
 }
 
 static void *
-remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+remap_move(ErtsMemMapper* mm,
+           Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 {
     UWord size = *sizep;
-    void *new_ptr = erts_mmap(flags, &size);
+    void *new_ptr = erts_mmap(mm, flags, &size);
     if (!new_ptr)
 	return NULL;
     *sizep = size;
     if (old_size < size)
 	size = old_size;
     sys_memcpy(new_ptr, ptr, (size_t) size);
-    erts_munmap(flags, ptr, old_size);
+    erts_munmap(mm, flags, ptr, old_size);
     return new_ptr;
 }
 
 void *
-erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+erts_mremap(ErtsMemMapper* mm,
+            Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 {
     void *new_ptr;
     Uint32 superaligned;
@@ -1798,11 +1803,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 
     if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
 
-	ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+	ERTS_MMAP_ASSERT(!mm->no_os_mmap);
 
-	if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) {
-	    new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
-				 old_size, sizep);
+	if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mm->supercarrier) {
+	    new_ptr = remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+                                 ptr, old_size, sizep);
 	    if (new_ptr)
 		return new_ptr;
 	}
@@ -1849,7 +1854,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 #endif
 #if ERTS_HAVE_OS_MREMAP
 	if (superaligned)
-	    return remap_move(flags, new_ptr, old_size, sizep);
+	    return remap_move(mm, flags, new_ptr, old_size, sizep);
 	else {
 	    new_ptr = os_mremap(ptr, old_size, asize, 0);
 	    if (!new_ptr)
@@ -1871,10 +1876,10 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	ErtsFreeSegDesc *prev, *next;
 	UWord ad_sz = 0;
 
-	ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+	ERTS_MMAP_ASSERT(mm->supercarrier);
 
 	if (ERTS_MMAPFLG_OS_ONLY & flags)
-	    return remap_move(flags, ptr, old_size, sizep);
+	    return remap_move(mm, flags, ptr, old_size, sizep);
 
 	superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
 
@@ -1882,19 +1887,19 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 		 ? ERTS_SUPERALIGNED_CEILING(*sizep)
 		 : ERTS_PAGEALIGNED_CEILING(*sizep));
 
-	erts_smp_mtx_lock(&mmap_state.mtx);
+	erts_smp_mtx_lock(&mm->mtx);
 
 	if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)
-	    ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize))
-	    : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) {
-	    erts_smp_mtx_unlock(&mmap_state.mtx);
+	    ? (!superaligned && lookup_free_seg(&mm->sua.map, asize))
+	    : (superaligned && lookup_free_seg(&mm->sa.map, asize))) {
+	    erts_smp_mtx_unlock(&mm->mtx);
 	    /*
 	     * Segment currently in wrong area (due to a previous memory
 	     * shortage), move it to the right area.
 	     * (remap_move() will succeed)
 	     */
-	    return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
-			      old_size, sizep);
+	    return remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+                              ptr, old_size, sizep);
 	}
 
 	ERTS_MREMAP_OP_START(ptr, old_size, *sizep);
@@ -1916,18 +1921,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	    UWord unres_sz;
 	    new_ptr = ptr;
 	    if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
-		map = &mmap_state.sua.map;
+		map = &mm->sua.map;
 		ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize);
 	    }
 	    else {
-		if (end == mmap_state.sa.top) {
-		    mmap_state.sa.top = new_end;
-		    mmap_state.unreserve_physical(((char *) ptr) + asize,
+		if (end == mm->sa.top) {
+		    mm->sa.top = new_end;
+		    mm->unreserve_physical(((char *) ptr) + asize,
 						  old_size - asize);
 		    goto supercarrier_resize_success;
 		}
 		ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize);
-		map = &mmap_state.sa.map;
+		map = &mm->sa.map;
 	    }
 	    
 	    adjacent_free_seg(map, start, end, &prev, &next);
@@ -1935,11 +1940,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	    if (next)
 		resize_free_seg(map, next, new_end, next->end);
 	    else
-		ad_sz = alloc_desc_insert_free_seg(map, new_end, end);
+		ad_sz = alloc_desc_insert_free_seg(mm, map, new_end, end);
 	    ERTS_MMAP_ASSERT(old_size - asize >= ad_sz);
 	    unres_sz = old_size - asize - ad_sz;
 	    if (unres_sz)
-		mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz,
+		mm->unreserve_physical(((char *) ptr) + asize + ad_sz,
 					      unres_sz);
 	    goto supercarrier_resize_success;
 	}
@@ -1949,17 +1954,17 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	    ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
 	    ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
 
-	    adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next);
+	    adjacent_free_seg(&mm->sua.map, start, end, &prev, &next);
 
 	    if (next && new_end <= next->end) {
-		if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+		if (!mm->reserve_physical(((char *) ptr) + old_size,
 						 asize - old_size))
 		    goto supercarrier_reserve_failure;
 		if (new_end < next->end)
-		    resize_free_seg(&mmap_state.sua.map, next, new_end, next->end);
+		    resize_free_seg(&mm->sua.map, next, new_end, next->end);
 		else {
-		    delete_free_seg(&mmap_state.sua.map, next);
-		    free_desc(next);
+		    delete_free_seg(&mm->sua.map, next);
+		    free_desc(mm, next);
 		}
 		new_ptr = ptr;
 		ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size);
@@ -1968,28 +1973,28 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	}
 	else { /* Superaligned area */
 
-	    if (end == mmap_state.sa.top) {
-		if (new_end <= mmap_state.sua.bot) {
-		    if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+	    if (end == mm->sa.top) {
+		if (new_end <= mm->sua.bot) {
+		    if (!mm->reserve_physical(((char *) ptr) + old_size,
 						     asize - old_size))
 			goto supercarrier_reserve_failure;
-		    mmap_state.sa.top = new_end;
+		    mm->sa.top = new_end;
 		    new_ptr = ptr;
 		    ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
 		    goto supercarrier_resize_success;
 		}
 	    }
 	    else {
-		adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next);
+		adjacent_free_seg(&mm->sa.map, start, end, &prev, &next);
 		if (next && new_end <= next->end) {
-		    if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+		    if (!mm->reserve_physical(((char *) ptr) + old_size,
 						     asize - old_size))
 			goto supercarrier_reserve_failure;
 		    if (new_end < next->end)
-			resize_free_seg(&mmap_state.sa.map, next, new_end, next->end);
+			resize_free_seg(&mm->sa.map, next, new_end, next->end);
 		    else {
-			delete_free_seg(&mmap_state.sa.map, next);
-			free_desc(next);
+			delete_free_seg(&mm->sa.map, next);
+			free_desc(mm, next);
 		    }
 		    new_ptr = ptr;
 		    ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
@@ -1999,12 +2004,12 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
 	}
 
 	ERTS_MMAP_OP_ABORT();
-	erts_smp_mtx_unlock(&mmap_state.mtx);
+	erts_smp_mtx_unlock(&mm->mtx);
 
 	/* Failed to resize... */
     }
 
-    return remap_move(flags, ptr, old_size, sizep);
+    return remap_move(mm, flags, ptr, old_size, sizep);
 
 supercarrier_resize_success:
 
@@ -2021,25 +2026,24 @@ supercarrier_resize_success:
 #endif
 
     ERTS_MREMAP_OP_END(new_ptr, asize);
-    erts_smp_mtx_unlock(&mmap_state.mtx);
+    erts_smp_mtx_unlock(&mm->mtx);
 
     *sizep = asize;
     return new_ptr;
 
 supercarrier_reserve_failure:
     ERTS_MREMAP_OP_END(NULL, old_size);
-    erts_smp_mtx_unlock(&mmap_state.mtx);
+    erts_smp_mtx_unlock(&mm->mtx);
     *sizep = old_size;
     return NULL;
     
 }
 
-int erts_mmap_in_supercarrier(void *ptr)
+int erts_mmap_in_supercarrier(ErtsMemMapper* mm, void *ptr)
 {
     return ERTS_MMAP_IN_SUPERCARRIER(ptr);
 }
 
-
 static struct {
     Eterm total;
     Eterm total_sa;
@@ -2102,7 +2106,7 @@ static void hard_dbg_mseg_init(void);
 #endif
 
 void
-erts_mmap_init(ErtsMMapInit *init)
+erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
 {
     int virtual_map = 0;
     char *start = NULL, *end = NULL;
@@ -2130,17 +2134,17 @@ erts_mmap_init(ErtsMMapInit *init)
 
     ERTS_MMAP_OP_RINGBUF_INIT();
 
-    mmap_state.supercarrier = 0;
-    mmap_state.reserve_physical = reserve_noop;
-    mmap_state.unreserve_physical = unreserve_noop;
+    mm->supercarrier = 0;
+    mm->reserve_physical = reserve_noop;
+    mm->unreserve_physical = unreserve_noop;
 
 #if HAVE_MMAP && !defined(MAP_ANON)
-    mmap_state.mmap_fd = open("/dev/zero", O_RDWR);
-    if (mmap_state.mmap_fd < 0)
+    mm->mmap_fd = open("/dev/zero", O_RDWR);
+    if (mm->mmap_fd < 0)
 	erl_exit(-1, "erts_mmap: Failed to open /dev/zero\n");
 #endif
 
-    erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap");
+    erts_smp_mtx_init(&mm->mtx, "erts_mmap");
     erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
 
 #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
@@ -2157,8 +2161,8 @@ erts_mmap_init(ErtsMMapInit *init)
 	sz = start - ptr;
 	if (sz)
 	    os_munmap(end, sz);
-	mmap_state.reserve_physical = os_reserve_physical;
-	mmap_state.unreserve_physical = os_unreserve_physical;
+	mm->reserve_physical = os_reserve_physical;
+	mm->unreserve_physical = os_unreserve_physical;
 	virtual_map = 1;
     }
     else
@@ -2176,8 +2180,8 @@ erts_mmap_init(ErtsMMapInit *init)
 #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
 	if (!init->scrpm) {
 	    start = os_mmap_virtual(NULL, sz);
-	    mmap_state.reserve_physical = os_reserve_physical;
-	    mmap_state.unreserve_physical = os_unreserve_physical;
+	    mm->reserve_physical = os_reserve_physical;
+	    mm->unreserve_physical = os_unreserve_physical;
 	    virtual_map = 1;
 	}
 	else
@@ -2205,30 +2209,30 @@ erts_mmap_init(ErtsMMapInit *init)
     }
 #endif
 
-    mmap_state.no.free_seg_descs = 0;
-    mmap_state.no.free_segs.curr = 0;
-    mmap_state.no.free_segs.max = 0;
+    mm->no.free_seg_descs = 0;
+    mm->no.free_segs.curr = 0;
+    mm->no.free_segs.max = 0;
 
-    mmap_state.size.supercarrier.total = 0;
-    mmap_state.size.supercarrier.used.total = 0;
-    mmap_state.size.supercarrier.used.sa = 0;
-    mmap_state.size.supercarrier.used.sua = 0;
-    mmap_state.size.os.used = 0;
+    mm->size.supercarrier.total = 0;
+    mm->size.supercarrier.used.total = 0;
+    mm->size.supercarrier.used.sa = 0;
+    mm->size.supercarrier.used.sua = 0;
+    mm->size.os.used = 0;
 
-    mmap_state.desc.new_area_hint = NULL;
+    mm->desc.new_area_hint = NULL;
 
     if (!start) {
-	mmap_state.sa.bot = NULL;
-	mmap_state.sua.top = NULL;
-	mmap_state.sa.bot = NULL;
-	mmap_state.sua.top = NULL;
-	mmap_state.no_os_mmap = 0;
-        mmap_state.supercarrier = 0;
+	mm->sa.bot = NULL;
+	mm->sua.top = NULL;
+	mm->sa.bot = NULL;
+	mm->sua.top = NULL;
+	mm->no_os_mmap = 0;
+        mm->supercarrier = 0;
     }
     else {
 	size_t desc_size;
 
-	mmap_state.no_os_mmap = init->sco;
+	mm->no_os_mmap = init->sco;
 
 	desc_size = init->scrfsd;
 	if (desc_size < 100)
@@ -2239,60 +2243,60 @@ erts_mmap_init(ErtsMMapInit *init)
 	     + ERTS_PAGEALIGNED_SIZE) > end - start)
 	    erl_exit(-1, "erts_mmap: No space for segments in super carrier\n");
 
-	mmap_state.sa.bot = start;
-	mmap_state.sa.bot += desc_size;
-	mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot);
-	mmap_state.sa.top = mmap_state.sa.bot;
-	mmap_state.sua.top = end;
-	mmap_state.sua.bot = mmap_state.sua.top;
+	mm->sa.bot = start;
+	mm->sa.bot += desc_size;
+	mm->sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mm->sa.bot);
+	mm->sa.top = mm->sa.bot;
+	mm->sua.top = end;
+	mm->sua.bot = mm->sua.top;
 
-	mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start);
+	mm->size.supercarrier.used.total += (UWord) (mm->sa.bot - start);
 
-	mmap_state.desc.free_list = NULL;
-        mmap_state.desc.reserved = 0;
+	mm->desc.free_list = NULL;
+        mm->desc.reserved = 0;
 
 	if (end == (void *) 0) {
 	    /*
 	     * Very unlikely, but we need a guarantee
-	     * that `mmap_state.sua.top` always will
+	     * that `mm->sua.top` always will
 	     * compare as larger than all segment pointers
 	     * into the super carrier...
 	     */
-	    mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE;
-	    mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
+	    mm->sua.top -= ERTS_PAGEALIGNED_SIZE;
+	    mm->size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
 #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
-	    if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE))
+	    if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE))
 #endif
-		add_free_desc_area(mmap_state.sua.top, end);
-            mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc);
+		add_free_desc_area(mm, mm->sua.top, end);
+            mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc);
 	}
 
-	mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start);
+	mm->size.supercarrier.total = (UWord) (mm->sua.top - start);
 
 	/*
 	 * Area before (and after) super carrier
 	 * will be used for free segment descritors.
 	 */
 #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
-	if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start))
+	if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start))
 	    erl_exit(-1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
 #endif
-	mmap_state.desc.unused_start = start;
-	mmap_state.desc.unused_end = mmap_state.sa.bot;
-        mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start)
+	mm->desc.unused_start = start;
+	mm->desc.unused_end = mm->sa.bot;
+        mm->desc.reserved += ((mm->desc.unused_end - start)
                                      / sizeof(ErtsFreeSegDesc));
 
-	init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER);
-	init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER);
+	init_free_seg_map(&mm->sa.map, SA_SZ_ADDR_ORDER);
+	init_free_seg_map(&mm->sua.map, SZ_REVERSE_ADDR_ORDER);
 
-	mmap_state.supercarrier = 1;
+	mm->supercarrier = 1;
 
-	mmap_state.desc.new_area_hint = end;
+	mm->desc.new_area_hint = end;
 
     }
 
 #if !ERTS_HAVE_OS_MMAP
-    mmap_state.no_os_mmap = 1;
+    mm->no_os_mmap = 1;
 #endif
 
 #ifdef HARD_DEBUG_MSEG
@@ -2307,7 +2311,8 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
     *lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp);
 }
 
-Eterm erts_mmap_info(int *print_to_p,
+Eterm erts_mmap_info(ErtsMemMapper* mm,
+                     int *print_to_p,
                      void *print_to_arg,
                      Eterm** hpp, Uint* szp,
                      struct erts_mmap_info_struct* emis)
@@ -2322,29 +2327,29 @@ Eterm erts_mmap_info(int *print_to_p,
     Eterm res = THE_NON_VALUE;
 
     if (!hpp) {
-        erts_smp_mtx_lock(&mmap_state.mtx);
-        emis->sizes[0] = mmap_state.size.supercarrier.total;
-        emis->sizes[1] = mmap_state.sa.top  - mmap_state.sa.bot;
-        emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot;
-        emis->sizes[3] = mmap_state.size.supercarrier.used.total;
-        emis->sizes[4] = mmap_state.size.supercarrier.used.sa;
-        emis->sizes[5] = mmap_state.size.supercarrier.used.sua;
+        erts_smp_mtx_lock(&mm->mtx);
+        emis->sizes[0] = mm->size.supercarrier.total;
+        emis->sizes[1] = mm->sa.top  - mm->sa.bot;
+        emis->sizes[2] = mm->sua.top - mm->sua.bot;
+        emis->sizes[3] = mm->size.supercarrier.used.total;
+        emis->sizes[4] = mm->size.supercarrier.used.sa;
+        emis->sizes[5] = mm->size.supercarrier.used.sua;
 
-        emis->segs[0] = mmap_state.no.free_segs.curr;
-        emis->segs[1] = mmap_state.no.free_segs.max;
-        emis->segs[2] = mmap_state.no.free_seg_descs;
-        emis->segs[3] = mmap_state.desc.reserved;
-        emis->segs[4] = mmap_state.sa.map.nseg;
-        emis->segs[5] = mmap_state.sua.map.nseg;
+        emis->segs[0] = mm->no.free_segs.curr;
+        emis->segs[1] = mm->no.free_segs.max;
+        emis->segs[2] = mm->no.free_seg_descs;
+        emis->segs[3] = mm->desc.reserved;
+        emis->segs[4] = mm->sa.map.nseg;
+        emis->segs[5] = mm->sua.map.nseg;
 
-        emis->os_used = mmap_state.size.os.used;
-        erts_smp_mtx_unlock(&mmap_state.mtx);
+        emis->os_used = mm->size.os.used;
+        erts_smp_mtx_unlock(&mm->mtx);
     }
 
     if (print_to_p) {
         int to = *print_to_p;
 	void *arg = print_to_arg;
-        if (mmap_state.supercarrier) {
+        if (mm->supercarrier) {
             const char* prefix = "supercarrier ";
             erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]);
             erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]);
@@ -2359,7 +2364,7 @@ Eterm erts_mmap_info(int *print_to_p,
             erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]);
             erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]);
         }
-        if (!mmap_state.no_os_mmap) {
+        if (!mm->no_os_mmap) {
             erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used);
         }
     }
@@ -2371,7 +2376,7 @@ Eterm erts_mmap_info(int *print_to_p,
         }
 
         lix = 0;
-        if (mmap_state.supercarrier) {
+        if (mm->supercarrier) {
             group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
                                                      sizeof(size_tags)/sizeof(Eterm),
                                                      size_tags, emis->sizes);
@@ -2383,7 +2388,7 @@ Eterm erts_mmap_info(int *print_to_p,
             lix++;
         }
 
-        if (!mmap_state.no_os_mmap) {
+        if (!mm->no_os_mmap) {
             group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
                                                       1, &am.used, &emis->os_used);
             list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group);
@@ -2395,25 +2400,26 @@ Eterm erts_mmap_info(int *print_to_p,
     return res;
 }
 
-Eterm erts_mmap_info_options(char *prefix,
+Eterm erts_mmap_info_options(ErtsMemMapper* mm,
+                             char *prefix,
                              int *print_to_p,
                              void *print_to_arg,
                              Uint **hpp,
                              Uint *szp)
 {
-    const UWord scs = mmap_state.sua.top - mmap_state.sa.bot;
-    const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false;
-    const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false;
+    const UWord scs = mm->sua.top - mm->sa.bot;
+    const Eterm sco = mm->no_os_mmap ? am_true : am_false;
+    const Eterm scrpm = (mm->reserve_physical == reserve_noop) ? am_true : am_false;
     Eterm res = THE_NON_VALUE;
 
     if (print_to_p) {
         int to = *print_to_p;
 	void *arg = print_to_arg;
         erts_print(to, arg, "%sscs: %bpu\n", prefix, scs);
-        if (mmap_state.supercarrier) {
+        if (mm->supercarrier) {
             erts_print(to, arg, "%ssco: %T\n", prefix, sco);
             erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm);
-            erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mmap_state.desc.reserved);
+            erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mm->desc.reserved);
         }
     }
 
@@ -2423,9 +2429,9 @@ Eterm erts_mmap_info_options(char *prefix,
         }
 
         res = NIL;
-        if (mmap_state.supercarrier) {
+        if (mm->supercarrier) {
             add_2tup(hpp, szp, &res, am.scrfsd,
-                     erts_bld_uint(hpp,szp, mmap_state.desc.reserved));
+                     erts_bld_uint(hpp,szp, mm->desc.reserved));
             add_2tup(hpp, szp, &res, am.scrpm, scrpm);
             add_2tup(hpp, szp, &res, am.sco, sco);
         }
@@ -2435,9 +2441,9 @@ Eterm erts_mmap_info_options(char *prefix,
 }
 
 
-Eterm erts_mmap_debug_info(Process* p)
+Eterm erts_mmap_debug_info(ErtsMemMapper* mm, Process* p)
 {
-    if (mmap_state.supercarrier) {
+    if (mm->supercarrier) {
         ERTS_DECL_AM(sabot);
         ERTS_DECL_AM(satop);
         ERTS_DECL_AM(suabot);
@@ -2448,14 +2454,14 @@ Eterm erts_mmap_debug_info(Process* p)
         Eterm *hp, *hp_end;
         Uint may_need;
 
-        erts_smp_mtx_lock(&mmap_state.mtx);
-        values[0] = (UWord)mmap_state.sa.bot;
-        values[1] = (UWord)mmap_state.sa.top;
-        values[2] = (UWord)mmap_state.sua.bot;
-        values[3] = (UWord)mmap_state.sua.top;
-        sa_list = build_free_seg_list(p, &mmap_state.sa.map);
-        sua_list = build_free_seg_list(p, &mmap_state.sua.map);
-        erts_smp_mtx_unlock(&mmap_state.mtx);
+        erts_smp_mtx_lock(&mm->mtx);
+        values[0] = (UWord)mm->sa.bot;
+        values[1] = (UWord)mm->sa.top;
+        values[2] = (UWord)mm->sua.bot;
+        values[3] = (UWord)mm->sua.top;
+        sa_list = build_free_seg_list(p, &mm->sa.map);
+        sua_list = build_free_seg_list(p, &mm->sua.map);
+        erts_smp_mtx_unlock(&mm->mtx);
 
         may_need = 4*(2+3+2) + 2*(2+3);
         hp = HAlloc(p, may_need);
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 51f830d045..8707c23527 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -50,23 +50,26 @@ typedef struct {
 #define ERTS_MMAP_INIT_DEFAULT_INITER \
     {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1}
 
-void *erts_mmap(Uint32 flags, UWord *sizep);
-void erts_munmap(Uint32 flags, void *ptr, UWord size);
-void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
-int erts_mmap_in_supercarrier(void *ptr);
-void erts_mmap_init(ErtsMMapInit*);
+typedef struct ErtsMemMapper_ ErtsMemMapper;
+extern ErtsMemMapper erts_dflt_mmapper;
+void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep);
+void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size);
+void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
+int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr);
+void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*);
 struct erts_mmap_info_struct
 {
     UWord sizes[6];
     UWord segs[6];
     UWord os_used;
 };
-Eterm erts_mmap_info(int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info(ErtsMemMapper*, int *print_to_p, void *print_to_arg,
                      Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*);
-Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info_options(ErtsMemMapper*,
+                             char *prefix, int *print_to_p, void *print_to_arg,
                              Uint **hpp, Uint *szp);
 struct process;
-Eterm erts_mmap_debug_info(struct process*);
+Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*);
 
 #define ERTS_SUPERALIGNED_SIZE \
     (1 << ERTS_MMAP_SUPERALIGNED_BITS)
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 7eb8a4a460..aadcc755c1 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -291,7 +291,7 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, UWord *sizep)
     if (MSEG_FLG_IS_2POW(flags))
 	mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
 
-    seg = erts_mmap(mmap_flags, sizep);
+    seg = erts_mmap(&erts_dflt_mmapper, mmap_flags, sizep);
 
 #ifdef ERTS_PRINT_ERTS_MMAP
     erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg,
@@ -311,7 +311,7 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, void *seg_p, UWord size) {
     if (MSEG_FLG_IS_2POW(flags))
 	 mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
 
-    erts_munmap(mmap_flags, seg_p, size);
+    erts_munmap(&erts_dflt_mmapper, mmap_flags, seg_p, size);
 #ifdef ERTS_PRINT_ERTS_MMAP
     erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n",
 		 (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
@@ -332,7 +332,7 @@ mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, U
     if (MSEG_FLG_IS_2POW(flags))
 	mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
 
-    new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep);
+    new_seg = erts_mremap(&erts_dflt_mmapper, mmap_flags, old_seg, old_size, sizep);
 
 #ifdef ERTS_PRINT_ERTS_MMAP
     erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n",
@@ -997,7 +997,8 @@ info_options(ErtsMsegAllctr_t *ma,
 {
     Eterm res;
 
-    res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp);
+    res = erts_mmap_info_options(&erts_dflt_mmapper,
+                                 prefix, print_to_p, print_to_arg, hpp, szp);
 
     if (print_to_p) {
 	int to = *print_to_p;
@@ -1401,7 +1402,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
 
     erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
 
-    erts_mmap_init(&init->mmap);
+    erts_mmap_init(&erts_dflt_mmapper, &init->mmap);
 
     if (!IS_2POW(GET_PAGE_SIZE))
 	erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
-- 
cgit v1.2.3


From b7f760cee119e1824de0cfc2b34ae6fe971bf505 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Fri, 11 Sep 2015 16:03:00 +0200
Subject: erts: Add support for fast erts_is_literal()

---
 erts/emulator/beam/beam_load.c      |   1 +
 erts/emulator/beam/erl_alloc.c      |  40 +++--
 erts/emulator/beam/erl_alloc.h      |  24 +++
 erts/emulator/beam/erl_alloc_util.c | 286 ++++++++++++++++++++++++++++++++----
 erts/emulator/beam/erl_alloc_util.h |  64 +++++++-
 erts/emulator/beam/sys.h            |   3 +
 erts/emulator/sys/common/erl_mmap.c |  19 ++-
 erts/emulator/sys/common/erl_mmap.h |  10 +-
 erts/emulator/sys/common/erl_mseg.c |   2 +-
 erts/emulator/sys/common/erl_mseg.h |   6 +-
 10 files changed, 407 insertions(+), 48 deletions(-)

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index f0b4be4c3d..a846e96204 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4431,6 +4431,7 @@ freeze_code(LoaderState* stp)
             if (stp->literals[i].heap_frags) {
                 move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags,
                                  &stp->literals[i].term, 1);
+                ASSERT(erts_is_literal(ptr_val(stp->literals[i].term)));
             }
             else ASSERT(is_immed(stp->literals[i].term));
 	}
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index bb3998769c..3e300f88ea 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -310,6 +310,25 @@ set_default_literal_alloc_opts(struct au_init *ip)
     ip->init.util.rsbcmt	= 0;
     ip->init.util.rmbcmt	= 0;
     ip->init.util.acul		= 0;
+
+#if defined(ARCH_32)
+# if HAVE_ERTS_MSEG
+    ip->init.util.mseg_alloc   = &erts_alcu_literal_32_mseg_alloc;
+    ip->init.util.mseg_realloc = &erts_alcu_literal_32_mseg_realloc;
+    ip->init.util.mseg_dealloc = &erts_alcu_literal_32_mseg_dealloc;
+# endif
+    ip->init.util.sys_alloc    = &erts_alcu_literal_32_sys_alloc;
+    ip->init.util.sys_realloc  = &erts_alcu_literal_32_sys_realloc;
+    ip->init.util.sys_dealloc  = &erts_alcu_literal_32_sys_dealloc;
+#elif defined(ARCH_64)
+# ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+    ip->init.util.mseg_alloc    = &erts_alcu_literal_64_mseg_alloc;
+    ip->init.util.mseg_realloc  = &erts_alcu_literal_64_mseg_realloc;
+    ip->init.util.mseg_dealloc  = &erts_alcu_literal_64_mseg_dealloc;
+# endif
+#else
+# error Unknown architecture
+#endif
 }
 
 static void
@@ -720,6 +739,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
 #if HAVE_ERTS_MSEG
     init.mseg.nos = erts_no_schedulers;
     erts_mseg_init(&init.mseg);
+# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+    erts_mmap_init(&erts_literal_mmapper, &init.mseg.literal_mmap);
+# endif
 #endif
 
     erts_alcu_init(&init.alloc_util);
@@ -991,7 +1013,7 @@ start_au_allocator(ErtsAlcType_t alctr_n,
     }
 
     for (i = 0; i < size; i++) {
-	void *as;
+	Allctr_t *as;
 	atype = init->atype;
 
 	if (!init->thr_spec)
@@ -1028,22 +1050,22 @@ start_au_allocator(ErtsAlcType_t alctr_n,
 
 	switch (atype) {
 	case GOODFIT:
-	    as = (void *) erts_gfalc_start((GFAllctr_t *) as0,
+	    as = erts_gfalc_start((GFAllctr_t *) as0,
 					   &init->init.gf,
 					   &init->init.util);
 	    break;
 	case BESTFIT:
-	    as = (void *) erts_bfalc_start((BFAllctr_t *) as0,
+	    as = erts_bfalc_start((BFAllctr_t *) as0,
 					   &init->init.bf,
 					   &init->init.util);
 	    break;
 	case AFIT:
-	    as = (void *) erts_afalc_start((AFAllctr_t *) as0,
+	    as = erts_afalc_start((AFAllctr_t *) as0,
 					   &init->init.af,
 					   &init->init.util);
 	    break;
     	case AOFIRSTFIT:
-	    as = (void *) erts_aoffalc_start((AOFFAllctr_t *) as0,
+	    as = erts_aoffalc_start((AOFFAllctr_t *) as0,
 					     &init->init.aoff,
 					     &init->init.util);
 	    break;
@@ -1445,25 +1467,25 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
 		    }
 		    else if (has_prefix("scs", argv[i]+3)) {
 #if HAVE_ERTS_MSEG
-			init->mseg.mmap.scs =
+			init->mseg.dflt_mmap.scs =
 #endif
 			    get_mb_value(argv[i]+6, argv, &i);
 		    }
 		    else if (has_prefix("sco", argv[i]+3)) {
 #if HAVE_ERTS_MSEG
-			init->mseg.mmap.sco =
+			init->mseg.dflt_mmap.sco =
 #endif
 			    get_bool_value(argv[i]+6, argv, &i);
 		    }
 		    else if (has_prefix("scrpm", argv[i]+3)) {
 #if HAVE_ERTS_MSEG
-			init->mseg.mmap.scrpm =
+			init->mseg.dflt_mmap.scrpm =
 #endif
 			    get_bool_value(argv[i]+8, argv, &i);
 		    }
 		    else if (has_prefix("scrfsd", argv[i]+3)) {
 #if HAVE_ERTS_MSEG
-			init->mseg.mmap.scrfsd =
+			init->mseg.dflt_mmap.scrfsd =
 #endif
 			    get_amount_value(argv[i]+9, argv, &i);
 		    }
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index f540bae20d..a0d8561e84 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -30,6 +30,7 @@
 #ifdef USE_THREADS
 #include "erl_threads.h"
 #endif
+#include "erl_mmap.h"
 
 #ifdef DEBUG
 #  undef ERTS_ALC_WANT_INLINE
@@ -204,6 +205,7 @@ void erts_free(ErtsAlcType_t type, void *ptr);
 void *erts_alloc_fnf(ErtsAlcType_t type, Uint size);
 void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size);
 int erts_is_allctr_wrapper_prelocked(void);
+int erts_is_literal(void* ptr);
 
 #endif /* #if !ERTS_ALC_DO_INLINE */
 
@@ -281,6 +283,28 @@ int erts_is_allctr_wrapper_prelocked(void)
 	&& !!erts_tsd_get(erts_allctr_prelock_tsd_key);  /* by me  */
 }
 
+ERTS_ALC_INLINE
+int erts_is_literal(void* ptr)
+{
+#if defined(ARCH_32)
+    Uint ix = (UWord)ptr >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+    return erts_literal_vspace_map[ix / ERTS_VSPACE_WORD_BITS]
+                  & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+
+#elif defined(ARCH_64)
+# if defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+    extern char* erts_literals_start;
+    extern UWord erts_literals_size;
+    return ErtsInArea(ptr, erts_literals_start, erts_literals_size);
+# else
+#  error Do the tag thing
+# endif
+#else
+# error No ARCH_xx
+#endif
+}
+
 #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */
 
 #define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id())
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 444d7055c8..f34916f1ab 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -751,12 +751,77 @@ internal_free(void *ptr)
 
 #endif
 
+#ifdef ARCH_32
+
+/*
+ * Bit vector for the entire 32-bit virtual address space
+ * with one bit for each super aligned memory segment.
+ */
+
+#define VSPACE_MAP_BITS  (1 << (32 - ERTS_MMAP_SUPERALIGNED_BITS))
+#define VSPACE_MAP_SZ    (VSPACE_MAP_BITS / ERTS_VSPACE_WORD_BITS)
+
+static ERTS_INLINE void set_bit(UWord* map, Uint ix)
+{
+    ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+    map[ix / ERTS_VSPACE_WORD_BITS]
+        |= ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE void clr_bit(UWord* map, Uint ix)
+{
+    ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+    map[ix / ERTS_VSPACE_WORD_BITS]
+        &= ~((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE int is_bit_set(UWord* map, Uint ix)
+{
+    ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+    return map[ix / ERTS_VSPACE_WORD_BITS]
+        & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+UWord erts_literal_vspace_map[VSPACE_MAP_SZ];
+
+static void set_literal_range(void* start, Uint size)
+{
+    Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+    Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+    ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+    ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+    ASSERT(n);
+    while (n--) {
+        ASSERT(!is_bit_set(erts_literal_vspace_map, ix));
+        set_bit(erts_literal_vspace_map, ix);
+        ix++;
+    }
+}
+
+static void clear_literal_range(void* start, Uint size)
+{
+    Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+    Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+    ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+    ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+    ASSERT(n);
+    while (n--) {
+        ASSERT(is_bit_set(erts_literal_vspace_map, ix));
+        clr_bit(erts_literal_vspace_map, ix);
+        ix++;
+    }
+}
+
+#endif /* ARCH_32 */
+
 /* mseg ... */
 
 #if HAVE_ERTS_MSEG
 
-static ERTS_INLINE void *
-alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+void*
+erts_alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
 {
     void *res;
     UWord size = (UWord) *size_p;
@@ -766,8 +831,9 @@ alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
     return res;
 }
 
-static ERTS_INLINE void *
-alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
+void*
+erts_alcu_mseg_realloc(Allctr_t *allctr, void *seg,
+                       Uint old_size, Uint *new_size_p)
 {
     void *res;
     UWord new_size = (UWord) *new_size_p;
@@ -778,17 +844,103 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
     return res;
 }
 
-static ERTS_INLINE void
-alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
+void
+erts_alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
 {
     erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt);
     INC_CC(allctr->calls.mseg_dealloc);
 }
 
-#endif
 
-static ERTS_INLINE void *
-alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+#if defined(ARCH_32)
+
+void*
+erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+    void* res;
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    res = erts_alcu_mseg_alloc(allctr, size_p, flags);
+    if (res)
+        set_literal_range(res, *size_p);
+    return res;
+}
+
+void*
+erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg,
+                               Uint old_size, Uint *new_size_p)
+{
+    void* res;
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    if (seg && old_size)
+        clear_literal_range(seg, old_size);
+    res = erts_alcu_mseg_realloc(allctr, seg, old_size, new_size_p);
+    if (res)
+        set_literal_range(res, *new_size_p);
+    return res;
+}
+
+void
+erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+                               Uint flags)
+{
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    erts_alcu_mseg_dealloc(allctr, seg, size, flags);
+
+    clear_literal_range(seg, size);
+}
+
+#elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+
+void*
+erts_alcu_literal_64_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+    void* res;
+    UWord size = (UWord) *size_p;
+    Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+    if (flags & ERTS_MSEG_FLG_2POW)
+        mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+    res = erts_mmap(&erts_literal_mmapper, mmap_flags, &size);
+    *size_p = (Uint)size;
+    INC_CC(allctr->calls.mseg_alloc);
+    return res;
+}
+
+void*
+erts_alcu_literal_64_mseg_realloc(Allctr_t *allctr, void *seg,
+                               Uint old_size, Uint *new_size_p)
+{
+    void *res;
+    UWord new_size = (UWord) *new_size_p;
+    res = erts_mremap(&erts_literal_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size);
+    *new_size_p = (Uint) new_size;
+    INC_CC(allctr->calls.mseg_realloc);
+    return res;
+}
+
+void
+erts_alcu_literal_64_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+                               Uint flags)
+{
+    Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+    if (flags & ERTS_MSEG_FLG_2POW)
+        mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+    erts_munmap(&erts_literal_mmapper, mmap_flags, seg, (UWord)size);
+    INC_CC(allctr->calls.mseg_dealloc);
+}
+#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
+
+#endif /* HAVE_ERTS_MSEG */
+
+void*
+erts_alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
 {
     void *res;
 #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
@@ -803,8 +955,8 @@ alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
     return res;
 }
 
-static ERTS_INLINE void *
-alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+void*
+erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
 {
     void *res;
 
@@ -824,8 +976,8 @@ alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int supe
     return res;
 }
 
-static ERTS_INLINE void
-alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
+void
+erts_alcu_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
 {
 #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
     if (superalign)
@@ -838,6 +990,49 @@ alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
 	erts_mtrace_crr_free(allctr->alloc_no, ERTS_ALC_A_SYSTEM, ptr);
 }
 
+#ifdef ARCH_32
+
+void*
+erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+{
+    void* res;
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    res = erts_alcu_sys_alloc(allctr, size, 1);
+    if (res)
+        set_literal_range(res, size);
+    return res;
+}
+
+void*
+erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+{
+    void* res;
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    if (ptr && old_size)
+        clear_literal_range(ptr, old_size);
+    res = erts_alcu_sys_realloc(allctr, ptr, size, old_size, 1);
+    if (res)
+        set_literal_range(res, size);
+    return res;
+}
+
+void
+erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
+{
+    ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+                   && !allctr->t && allctr->thread_safe);
+
+    erts_alcu_sys_dealloc(allctr, ptr, size, 1);
+
+    clear_literal_range(ptr, size);
+}
+
+#endif /* ARCH_32 */
+
 static Uint
 get_next_mbc_size(Allctr_t *allctr)
 {
@@ -3519,6 +3714,8 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
 	return NULL;
 #endif
     }
+    flags |= allctr->crr_set_flgs;
+    flags &= ~allctr->crr_clr_flgs;
 
     ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC))
 	   || (flags & CFLG_MBC && !(flags & CFLG_SBC)));
@@ -3602,7 +3799,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
         mseg_flags = ERTS_MSEG_FLG_2POW;
     }
 
-    crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags);
+    crr = (Carrier_t *) allctr->mseg_alloc(allctr, &crr_sz, mseg_flags);
     if (!crr) {
 	have_tried_mseg = 1;
 	if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG))
@@ -3644,12 +3841,12 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
 	      ? UNIT_CEILING(bcrr_sz)
 	      : SYS_ALLOC_CARRIER_CEILING(bcrr_sz));
 
-    crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+    crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
 	
     if (!crr) {
 	if (crr_sz > UNIT_CEILING(bcrr_sz)) {
 	    crr_sz = UNIT_CEILING(bcrr_sz);
-	    crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+	    crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
 	}
 	if (!crr) {
 #if HAVE_ERTS_MSEG
@@ -3748,7 +3945,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
 
 	    new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
 	    new_crr_sz = ERTS_SACRR_UNIT_CEILING(new_crr_sz);
-	    new_crr = (Carrier_t *) alcu_mseg_realloc(allctr,
+	    new_crr = (Carrier_t *) allctr->mseg_realloc(allctr,
 						      old_crr,
 						      old_crr_sz,
 						      &new_crr_sz);
@@ -3773,7 +3970,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
 		       (void *) BLK2UMEM(old_blk),
 		       MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
 	    unlink_carrier(&allctr->sbc_list, old_crr);
-	    alcu_mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
+            allctr->mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
 	}
 	else {
 	    /* Old carrier unchanged; restore stat */
@@ -3790,7 +3987,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
 			  ? UNIT_CEILING(new_bcrr_sz)
 			  : SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz));
 
-	    new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+	    new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
 						     (void *) old_crr,
 						     new_crr_sz,
 						     old_crr_sz,
@@ -3811,7 +4008,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
 	    else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) {
 		new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
 		new_crr_sz = UNIT_CEILING(new_crr_sz);
-		new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+		new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
 							 (void *) old_crr,
 							 new_crr_sz,
 							 old_crr_sz,
@@ -3834,7 +4031,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
 		       (void *) BLK2UMEM(old_blk),
 		       MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
 	    unlink_carrier(&allctr->sbc_list, old_crr);
-	    alcu_sys_free(allctr, old_crr, 0);
+	    allctr->sys_dealloc(allctr, old_crr, CARRIER_SZ(old_crr), 0);
 	}
 	else {
 	    /* Old carrier unchanged; restore... */
@@ -3850,13 +4047,13 @@ dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned)
 {
 #if HAVE_ERTS_MSEG
     if (IS_MSEG_CARRIER(crr))
-	alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
+	allctr->mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
 			  (superaligned
 			   ? ERTS_MSEG_FLG_2POW
 			   : ERTS_MSEG_FLG_NONE));
     else
 #endif
-	alcu_sys_free(allctr, crr, superaligned);
+	allctr->sys_dealloc(allctr, crr, CARRIER_SZ(crr), superaligned);
 }
 
 static void
@@ -5854,17 +6051,52 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
 					    + ABLK_HDR_SZ)
 			       - ABLK_HDR_SZ);
 
+    if (init->sys_alloc) {
+        ASSERT(init->sys_realloc && init->sys_dealloc);
+        allctr->sys_alloc   = init->sys_alloc;
+        allctr->sys_realloc = init->sys_realloc;
+        allctr->sys_dealloc = init->sys_dealloc;
+    }
+    else {
+        ASSERT(!init->sys_realloc && !init->sys_dealloc);
+        allctr->sys_alloc   = &erts_alcu_sys_alloc;
+        allctr->sys_realloc = &erts_alcu_sys_realloc;
+        allctr->sys_dealloc = &erts_alcu_sys_dealloc;
+    }
+#if HAVE_ERTS_MSEG
+    if (init->mseg_alloc) {
+        ASSERT(init->mseg_realloc && init->mseg_dealloc);
+        allctr->mseg_alloc   = init->mseg_alloc;
+        allctr->mseg_realloc = init->mseg_realloc;
+        allctr->mseg_dealloc = init->mseg_dealloc;
+    }
+    else {
+        ASSERT(!init->mseg_realloc && !init->mseg_dealloc);
+        allctr->mseg_alloc   = &erts_alcu_mseg_alloc;
+        allctr->mseg_realloc = &erts_alcu_mseg_realloc;
+        allctr->mseg_dealloc = &erts_alcu_mseg_dealloc;
+    }
+    /* If a custom carrier alloc function is specified, make sure it's used */
+    if (init->mseg_alloc && !init->sys_alloc) {
+        allctr->crr_set_flgs = CFLG_FORCE_MSEG;
+        allctr->crr_clr_flgs = CFLG_FORCE_SYS_ALLOC;
+    }
+    else if (!init->mseg_alloc && init->sys_alloc) {
+        allctr->crr_set_flgs = CFLG_FORCE_SYS_ALLOC;
+        allctr->crr_clr_flgs = CFLG_FORCE_MSEG;
+    }
+#endif
+
     if (allctr->main_carrier_size) {
 	Block_t *blk;
 
 	blk = create_carrier(allctr,
 			     allctr->main_carrier_size,
-			     CFLG_MBC
+                             (ERTS_SUPER_ALIGNED_MSEG_ONLY
+                              ? CFLG_FORCE_MSEG : CFLG_FORCE_SYS_ALLOC)
+                             | CFLG_MBC
 			     | CFLG_FORCE_SIZE
 			     | CFLG_NO_CPOOL
-#if !ERTS_SUPER_ALIGNED_MSEG_ONLY
-			     | CFLG_FORCE_SYS_ALLOC
-#endif
 			     | CFLG_MAIN_CARRIER);
 	if (!blk) {
 #ifdef USE_THREADS
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index f314eab4c2..16ad673d26 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -24,6 +24,12 @@
 #define ERTS_ALCU_VSN_STR "3.0"
 
 #include "erl_alloc_types.h"
+#ifdef USE_THREADS
+#define ERL_THREADS_EMU_INTERNAL__
+#include "erl_threads.h"
+#endif
+
+#include "erl_mseg.h"
 
 #define ERTS_AU_PREF_ALLOC_BITS 11
 #define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS)
@@ -60,6 +66,15 @@ typedef struct {
 
     void *fix;
     size_t *fix_type_size;
+
+#if HAVE_ERTS_MSEG
+    void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+    void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+    void  (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+    void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+    void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+    void  (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
 } AllctrInit_t;
 
 typedef struct {
@@ -173,20 +188,44 @@ void    erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal *
 #endif
 erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
 
+#ifdef ARCH_32
+extern UWord erts_literal_vspace_map[];
+# define ERTS_VSPACE_WORD_BITS (sizeof(UWord)*8)
+#endif
+
+void* erts_alcu_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void  erts_alcu_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+#if HAVE_ERTS_MSEG
+# if defined(ARCH_32)
+void* erts_alcu_literal_32_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_32_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void  erts_alcu_literal_32_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+# elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+void* erts_alcu_literal_64_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_64_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void  erts_alcu_literal_64_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+# endif
+#endif /* HAVE_ERTS_MSEG */
+
+void* erts_alcu_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void  erts_alcu_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
+#ifdef ARCH_32
+void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void  erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
 #endif
 
+#endif /* !ERL_ALLOC_UTIL__ */
+
 #if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
 #define ERL_ALLOC_UTIL_IMPL__
 
 #define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE		(((Uint32) 1) << 0)
 
-#ifdef USE_THREADS
-#define ERL_THREADS_EMU_INTERNAL__
-#include "erl_threads.h"
-#endif
-
-#include "erl_mseg.h"
-
 #undef ERTS_ALLOC_UTIL_HARD_DEBUG
 #ifdef DEBUG
 #  if 0
@@ -498,6 +537,8 @@ struct Allctr_t_ {
     Uint		min_mbc_size;
     Uint		min_mbc_first_free_size;
     Uint		min_block_size;
+    UWord               crr_set_flgs;
+    UWord               crr_clr_flgs;
 
     /* Carriers */
     CarrierList_t	mbc_list;
@@ -543,6 +584,15 @@ struct Allctr_t_ {
     void		(*remove_mbc)	        (Allctr_t *, Carrier_t *);
     UWord		(*largest_fblk_in_mbc)  (Allctr_t *, Carrier_t *);
 
+#if HAVE_ERTS_MSEG
+    void*               (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+    void*               (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+    void                (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+    void*               (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+    void*               (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+    void                (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
+
     void		(*init_atoms)		(void);
 
 #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 34011147d9..46577bd07f 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -1045,6 +1045,9 @@ extern int erts_use_kernel_poll;
 #define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0)
 
 
+#define ErtsInArea(PTR,START,NBYTES) \
+    ((UWord)((char*)(PTR) - (char*)(START)) < (NBYTES))
+
 /*
  * Use DEBUGF as you would use printf, but use double parentheses:
  *
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index e8ff2bf752..03ca080c14 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -349,6 +349,12 @@ struct ErtsMemMapper_ {
 
 ErtsMemMapper erts_dflt_mmapper;
 
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ErtsMemMapper erts_literal_mmapper;
+char* erts_literals_start;
+UWord erts_literals_size;
+#endif
+
 #define ERTS_MMAP_SIZE_SC_SA_INC(SZ) 						\
     do {									\
 	mm->size.supercarrier.used.total += (SZ);			\
@@ -2108,6 +2114,7 @@ static void hard_dbg_mseg_init(void);
 void
 erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
 {
+    static int is_first_call = 1;
     int virtual_map = 0;
     char *start = NULL, *end = NULL;
     UWord pagesize;
@@ -2145,7 +2152,9 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
 #endif
 
     erts_smp_mtx_init(&mm->mtx, "erts_mmap");
-    erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+    if (is_first_call) {
+        erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+    }
 
 #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
     if (init->virtual_range.start) {
@@ -2302,6 +2311,14 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
 #ifdef HARD_DEBUG_MSEG
     hard_dbg_mseg_init();
 #endif
+
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+   if (mm == &erts_literal_mmapper) {
+       erts_literals_start = erts_literal_mmapper.sa.bot;
+       erts_literals_size  = erts_literal_mmapper.sua.top - erts_literals_start;
+    }
+#endif
+    is_first_call = 0;
 }
 
 
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 8707c23527..61d912fd28 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -50,8 +50,11 @@ typedef struct {
 #define ERTS_MMAP_INIT_DEFAULT_INITER \
     {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1}
 
+#define ERTS_MMAP_INIT_LITERAL_INITER \
+    {{NULL, NULL}, {NULL, NULL}, 1024*1024*1024, 1, (1 << 16), 0}
+
 typedef struct ErtsMemMapper_ ErtsMemMapper;
-extern ErtsMemMapper erts_dflt_mmapper;
+
 void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep);
 void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size);
 void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
@@ -121,6 +124,11 @@ Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*);
 #  define ERTS_HAVE_OS_MMAP 1
 #endif
 
+extern ErtsMemMapper erts_dflt_mmapper;
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+extern ErtsMemMapper erts_literal_mmapper;
+#endif
+
 /*#define HARD_DEBUG_MSEG*/
 #ifdef HARD_DEBUG_MSEG
 #  define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index aadcc755c1..20695899eb 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1402,7 +1402,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
 
     erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
 
-    erts_mmap_init(&erts_dflt_mmapper, &init->mmap);
+    erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap);
 
     if (!IS_2POW(GET_PAGE_SIZE))
 	erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index 677f8ea4ed..2acd8f8505 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -59,7 +59,8 @@ typedef struct {
     Uint rmcbf;
     Uint mcs;
     Uint nos;
-    ErtsMMapInit mmap;
+    ErtsMMapInit dflt_mmap;
+    ErtsMMapInit literal_mmap;
 } ErtsMsegInit_t;
 
 #define ERTS_MSEG_INIT_DEFAULT_INITIALIZER				\
@@ -68,7 +69,8 @@ typedef struct {
     20,			/* rmcbf: Relative max cache bad fit	*/	\
     10,			/* mcs:   Max cache size		*/	\
     1000,		/* cci:   Cache check interval		*/	\
-    ERTS_MMAP_INIT_DEFAULT_INITER					\
+    ERTS_MMAP_INIT_DEFAULT_INITER,					\
+    ERTS_MMAP_INIT_LITERAL_INITER                                       \
 }
 
 typedef struct {
-- 
cgit v1.2.3


From 49d2f809cf8435b17d54f0fd2f37a8aa939ea457 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Thu, 10 Sep 2015 12:01:17 +0200
Subject: fix check_process_code for separate literal area

---
 erts/emulator/beam/beam_bif_load.c | 28 ++++++++++++----------------
 erts/emulator/beam/erl_gc.c        |  4 ++--
 2 files changed, 14 insertions(+), 18 deletions(-)

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 68689b8e7f..adc3bd37d9 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -728,8 +728,8 @@ static Eterm
 check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 {
     BeamInstr* start;
-    char* mod_start;
-    Uint mod_size;
+    char* literals;
+    Uint lit_bsize;
     BeamInstr* end;
     Eterm* sp;
     struct erl_off_heap_header* oh;
@@ -742,8 +742,6 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
      */
     start = modp->old.code;
     end = (BeamInstr *)((char *)start + modp->old.code_length);
-    mod_start = (char *) start;
-    mod_size = modp->old.code_length;
 
     /*
      * Check if current instruction or continuation pointer points into module.
@@ -834,22 +832,24 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
      * See if there are constants inside the module referenced by the process.
      */
     done_gc = 0;
+    literals = (char*) modp->old.code[MI_LITERALS_START];
+    lit_bsize = (char*) modp->old.code[MI_LITERALS_END] - literals;
     for (;;) {
 	ErlMessage* mp;
 
-	if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) {
+	if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
 	    rp->freason = EXC_NULL;
 	    rp->fvalue = NIL;
 	    rp->ftrace = NIL;
 	}
-	if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) {
+	if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) {
 	    goto need_gc;
 	}
-	if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
+	if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) {
 	    goto need_gc;
 	}
 
-	if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) {
+	if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) {
 	    goto need_gc;
 	}
 
@@ -857,13 +857,13 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	    Eterm* start = rp->dictionary->data;
 	    Eterm* end = start + rp->dictionary->used;
 
-	    if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
+	    if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) {
 		goto need_gc;
 	    }
 	}
 
 	for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
-	    if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) {
+	    if (any_heap_ref_ptrs(mp->m, mp->m+2, literals, lit_bsize)) {
 		goto need_gc;
 	    }
 	}
@@ -873,8 +873,6 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	if (done_gc) {
 	    return am_true;
 	} else {
-	    Eterm* literals;
-	    Uint lit_size;
 	    struct erl_off_heap_header* oh;
 
 	    if (!allow_gc)
@@ -890,12 +888,10 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	    done_gc = 1;
 	    FLAGS(rp) |= F_NEED_FULLSWEEP;
 	    *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
-	    literals = (Eterm *) modp->old.code[MI_LITERALS_START];
-	    lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals;
 	    oh = (struct erl_off_heap_header *)
 		modp->old.code[MI_LITERALS_OFF_HEAP];
-	    *redsp += lit_size / 10; /* Need, better value... */
-	    erts_garbage_collect_literals(rp, literals, lit_size, oh);
+	    *redsp += lit_bsize / 64; /* Need, better value... */
+	    erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
 	}
     }
     return am_false;
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 734f120e09..89fabde67c 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -645,10 +645,10 @@ erts_garbage_collect_hibernate(Process* p)
 
 void
 erts_garbage_collect_literals(Process* p, Eterm* literals,
-			      Uint lit_size,
+			      Uint byte_lit_size,
 			      struct erl_off_heap_header* oh)
 {
-    Uint byte_lit_size = sizeof(Eterm)*lit_size;
+    Uint lit_size = byte_lit_size / sizeof(Eterm);
     Uint old_heap_size;
     Eterm* temp_lit;
     Sint offs;
-- 
cgit v1.2.3


From b21b604137c5cb5f5039a40994e429871e5b707b Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Wed, 26 Aug 2015 19:47:10 +0200
Subject: Introduce literal tag

---
 erts/configure.in                 |  2 +-
 erts/emulator/beam/beam_emu.c     |  3 +++
 erts/emulator/beam/beam_load.c    | 11 +++++-----
 erts/emulator/beam/copy.c         | 29 +++++++++++++++++++-------
 erts/emulator/beam/erl_alloc.h    | 20 ++++++++++++------
 erts/emulator/beam/erl_bif_info.c | 17 +++++++++++++++
 erts/emulator/beam/erl_gc.c       | 42 ++++++++++++++++++++++++++++++++++---
 erts/emulator/beam/erl_gc.h       |  8 +++----
 erts/emulator/beam/erl_message.c  |  8 +++----
 erts/emulator/beam/erl_term.c     | 31 +++++++++++++++++++++++++++
 erts/emulator/beam/erl_term.h     | 44 ++++++++++++++++++++++++++++++++++++---
 erts/emulator/beam/global.h       | 25 ++++++++++++++++++++--
 erts/emulator/beam/sys.h          |  7 +++----
 erts/emulator/hipe/hipe_bif0.c    |  2 ++
 14 files changed, 209 insertions(+), 40 deletions(-)

diff --git a/erts/configure.in b/erts/configure.in
index 25256bcac9..a93d1af0bf 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -3702,7 +3702,7 @@ dnl crypto
 #
 #--------------------------------------------------------------------
 
-DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE"
+DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common"
 
 if test "X$ETHR_DEFS" = "X"; then
     DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT"
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 6e4c8ecee3..4d19f52a52 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -2963,6 +2963,9 @@ do {						\
 		     }
 		 }
 		 Op1 = small_to_big(ires, tmp_big);
+#ifdef TAG_LITERAL_PTR
+		 Op1 |= TAG_LITERAL_PTR;
+#endif
 
 	     big_shift:
 		 if (i > 0) {	/* Left shift. */
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 1c598601c6..7a1a563be2 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4439,12 +4439,13 @@ freeze_code(LoaderState* stp)
 	code_hdr->literals_start = ptr;
 	code_hdr->literals_end = ptr + stp->total_literal_size;
 	for (i = 0; i < stp->num_literals; i++) {
-            if (stp->literals[i].heap_frags) {
-                move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags,
-                                 &stp->literals[i].term, 1);
-                ASSERT(erts_is_literal(ptr_val(stp->literals[i].term)));
+            if (is_not_immed(stp->literals[i].term)) {
+                erts_move_multi_frags(&ptr, &code_off_heap,
+				      stp->literals[i].heap_frags,
+				      &stp->literals[i].term, 1, 1);
+                ASSERT(erts_is_literal(stp->literals[i].term,
+				       ptr_val(stp->literals[i].term)));
             }
-            else ASSERT(is_immed(stp->literals[i].term));
 	}
 	code_hdr->literals_off_heap = code_off_heap.first;
 	lp = stp->literal_patches;
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index ec769c3b49..b185758b1d 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -35,7 +35,7 @@
 #include "erl_bits.h"
 #include "dtrace-wrapper.h"
 
-static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*);
+static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int);
 
 /*
  *  Copy object "obj" to process p.
@@ -621,17 +621,24 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
  * move markers.
  * Typically used to copy a multi-fragmented message (from NIF).
  */
-void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
-		      Eterm* refs, unsigned nrefs)
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
+			   Eterm* refs, unsigned nrefs, int literals)
 {
     ErlHeapFragment* bp;
     Eterm* hp_start = *hpp;
     Eterm* hp_end;
     Eterm* hp;
     unsigned i;
+    Eterm literal_tag;
+
+#ifdef TAG_LITERAL_PTR
+    literal_tag = (Eterm) literals ? TAG_LITERAL_PTR : 0;
+#else
+    literal_tag = (Eterm) 0;
+#endif
 
     for (bp=first; bp!=NULL; bp=bp->next) {
-	move_one_frag(hpp, bp, off_heap);
+	move_one_frag(hpp, bp, off_heap, literals);
     }
     hp_end = *hpp;
     for (hp=hp_start; hpmem;
     Eterm* end = ptr + frag->used_size;
@@ -704,4 +718,3 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap)
     OH_OVERHEAD(off_heap, frag->off_heap.overhead);
     frag->off_heap.first = NULL;
 }
-
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index a0d8561e84..9da9c823f7 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -178,6 +178,12 @@ void  sys_free(void *)               __deprecated; /* erts_free()        */
 void *sys_alloc(Uint )               __deprecated; /* erts_alloc_fnf()   */
 void *sys_realloc(void *, Uint)      __deprecated; /* erts_realloc_fnf() */
 
+#undef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#if defined(ARCH_32) || defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+#  define ERTS_HAVE_IS_IN_LITERAL_RANGE
+#endif
+
+
 /*
  * erts_alloc[_fnf](), erts_realloc[_fnf](), erts_free() works as
  * malloc(), realloc(), and free() with the following exceptions:
@@ -205,7 +211,9 @@ void erts_free(ErtsAlcType_t type, void *ptr);
 void *erts_alloc_fnf(ErtsAlcType_t type, Uint size);
 void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size);
 int erts_is_allctr_wrapper_prelocked(void);
-int erts_is_literal(void* ptr);
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+int erts_is_in_literal_range(void* ptr);
+#endif
 
 #endif /* #if !ERTS_ALC_DO_INLINE */
 
@@ -283,8 +291,10 @@ int erts_is_allctr_wrapper_prelocked(void)
 	&& !!erts_tsd_get(erts_allctr_prelock_tsd_key);  /* by me  */
 }
 
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+
 ERTS_ALC_INLINE
-int erts_is_literal(void* ptr)
+int erts_is_in_literal_range(void* ptr)
 {
 #if defined(ARCH_32)
     Uint ix = (UWord)ptr >> ERTS_MMAP_SUPERALIGNED_BITS;
@@ -293,18 +303,16 @@ int erts_is_literal(void* ptr)
                   & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
 
 #elif defined(ARCH_64)
-# if defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
     extern char* erts_literals_start;
     extern UWord erts_literals_size;
     return ErtsInArea(ptr, erts_literals_start, erts_literals_size);
-# else
-#  error Do the tag thing
-# endif
 #else
 # error No ARCH_xx
 #endif
 }
 
+#endif /* ERTS_HAVE_IS_IN_LITERAL_RANGE */
+
 #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */
 
 #define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id())
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index a73ad826db..a684c81445 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -2766,6 +2766,20 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
     else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) {
 	BIF_RET(erts_eager_check_io ? am_true : am_false);
     }
+    else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) {
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#ifdef ARCH_64
+	DECL_AM(range);
+	BIF_RET(AM_range);
+#else /* ARCH_32 */
+	DECL_AM(range_bitmask);
+	BIF_RET(AM_range_bitmask);
+#endif /* ARCH_32 */
+#else  /* ! ERTS_HAVE_IS_IN_LITERAL_RANGE */
+	DECL_AM(tag);
+	BIF_RET(AM_tag);
+#endif
+    }
 
     BIF_ERROR(BIF_P, BADARG);
 }
@@ -4323,12 +4337,15 @@ static void os_info_init(void)
     erts_free(ERTS_ALC_T_TMP, (void *) buf);
     hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm));
     os_type_tuple = TUPLE2(hp, type, flav);
+    erts_set_literal_tag(&os_type_tuple, hp, 3);
+
     hp += 3;
     os_version(&major, &minor, &build);
     os_version_tuple = TUPLE3(hp,
 			      make_small(major),
 			      make_small(minor),
 			      make_small(build));
+    erts_set_literal_tag(&os_version_tuple, hp, 4);
 }
 
 void
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 89fabde67c..e316ab95ab 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1004,6 +1004,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
     Uint mature_size = (char *) HIGH_WATER(p) - heap;
     Eterm* old_htop = OLD_HTOP(p);
     Eterm* n_heap;
+    char* oh = (char *) OLD_HEAP(p);
+    Uint oh_size = (char *) OLD_HTOP(p) - oh;
 
     n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
 					       sizeof(Eterm)*new_sz);
@@ -1035,8 +1037,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
                 } else if (in_area(ptr, heap, mature_size)) {
                     MOVE_BOXED(ptr,val,old_htop,g_ptr++);
                 } else if (in_area(ptr, heap, heap_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr)
+			   && !in_area(ptr, oh, oh_size));
                     MOVE_BOXED(ptr,val,n_htop,g_ptr++);
                 } else {
+		    ASSERT(erts_is_literal(gval, ptr)
+			   || in_area(ptr, oh, oh_size));
 		    g_ptr++;
 		}
                 break;
@@ -1050,8 +1056,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
                 } else if (in_area(ptr, heap, mature_size)) {
                     MOVE_CONS(ptr,val,old_htop,g_ptr++);
                 } else if (in_area(ptr, heap, heap_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr)
+			   && !in_area(ptr, oh, oh_size));
                     MOVE_CONS(ptr,val,n_htop,g_ptr++);
                 } else {
+		    ASSERT(erts_is_literal(gval, ptr)
+			   || in_area(ptr, oh, oh_size));
 		    g_ptr++;
 		}
 		break;
@@ -1094,8 +1104,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 		} else if (in_area(ptr, heap, mature_size)) {
 		    MOVE_BOXED(ptr,val,old_htop,n_hp++);
 		} else if (in_area(ptr, heap, heap_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr)
+			   && !in_area(ptr, oh, oh_size));
 		    MOVE_BOXED(ptr,val,n_htop,n_hp++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr)
+			   || in_area(ptr, oh, oh_size));
 		    n_hp++;
 		}
 		break;
@@ -1108,8 +1122,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 		} else if (in_area(ptr, heap, mature_size)) {
 		    MOVE_CONS(ptr,val,old_htop,n_hp++);
 		} else if (in_area(ptr, heap, heap_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr)
+			   && !in_area(ptr, oh, oh_size));
 		    MOVE_CONS(ptr,val,n_htop,n_hp++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr)
+			   || in_area(ptr, oh, oh_size));
 		    n_hp++;
 		}
 		break;
@@ -1131,9 +1149,15 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 			    MOVE_BOXED(ptr,val,old_htop,origptr);
 			    mb->base = binary_bytes(mb->orig);
 			} else if (in_area(ptr, heap, heap_size)) {
+			    ASSERT(!erts_is_literal(*origptr, origptr)
+				   && !in_area(ptr, oh, oh_size));
 			    MOVE_BOXED(ptr,val,n_htop,origptr);
 			    mb->base = binary_bytes(mb->orig);
 			}
+			else {
+			    ASSERT(erts_is_literal(*origptr, origptr)
+				   || in_area(ptr, oh, oh_size));
+			}
 		    }
 		    n_hp += (thing_arityval(gval)+1);
 		}
@@ -1275,8 +1299,10 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		    ASSERT(is_boxed(val));
 		    *g_ptr++ = val;
 		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr));
 		    MOVE_BOXED(ptr,val,n_htop,g_ptr++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr));
 		    g_ptr++;
 		}
 		continue;
@@ -1288,8 +1314,10 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		if (IS_MOVED_CONS(val)) {
 		    *g_ptr++ = ptr[1];
 		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr));
 		    MOVE_CONS(ptr,val,n_htop,g_ptr++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr));
 		    g_ptr++;
 		}
 		continue;
@@ -1330,8 +1358,10 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		    ASSERT(is_boxed(val));
 		    *n_hp++ = val;
 		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr));
 		    MOVE_BOXED(ptr,val,n_htop,n_hp++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr));
 		    n_hp++;
 		}
 		break;
@@ -1342,8 +1372,10 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		if (IS_MOVED_CONS(val)) {
 		    *n_hp++ = ptr[1];
 		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+		    ASSERT(!erts_is_literal(gval, ptr));
 		    MOVE_CONS(ptr,val,n_htop,n_hp++);
 		} else {
+		    ASSERT(erts_is_literal(gval, ptr));
 		    n_hp++;
 		}
 		break;
@@ -1363,12 +1395,16 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 			    *origptr = val;
 			    mb->base = binary_bytes(*origptr);
 			} else if (in_area(ptr, src, src_size) ||
-				   in_area(ptr, oh, oh_size)) {
+-				   in_area(ptr, oh, oh_size)) {
+			    ASSERT(!erts_is_literal(*origptr, origptr));
 			    MOVE_BOXED(ptr,val,n_htop,origptr); 
 			    mb->base = binary_bytes(*origptr);
 			    ptr = boxed_val(*origptr);
 			    val = *ptr;
 			}
+			else {
+			    ASSERT(erts_is_literal(*origptr, origptr));
+			}
 		    }
 		    n_hp += (thing_arityval(gval)+1);
 		}
@@ -1985,7 +2021,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
     }
 
     ASSERT((is_nil(p->seq_trace_token) ||
-	    is_tuple(follow_moved(p->seq_trace_token)) ||
+	    is_tuple(follow_moved(p->seq_trace_token, (Eterm) 0)) ||
 	    is_atom(p->seq_trace_token)));
     if (is_not_immed(p->seq_trace_token)) {
 	roots[n].v = &p->seq_trace_token;
@@ -2003,7 +2039,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
 	   is_internal_pid(ERTS_TRACER_PROC(p)) ||
 	   is_internal_port(ERTS_TRACER_PROC(p)));
 
-    ASSERT(is_pid(follow_moved(p->group_leader)));
+    ASSERT(is_pid(follow_moved(p->group_leader, (Eterm) 0)));
     if (is_not_immed(p->group_leader)) {
 	roots[n].v  = &p->group_leader;
 	roots[n].sz = 1;
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index ecd1bf4d22..fdbf948f9d 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -76,10 +76,10 @@ do {                                                                    \
 int within(Eterm *ptr, Process *p);
 #endif
 
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term);
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag);
 
 #if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag)
 {
     Eterm* ptr;
     switch (primary_tag(term)) {
@@ -87,11 +87,11 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
 	break;
     case TAG_PRIMARY_BOXED:
 	ptr = boxed_val(term);
-	if (IS_MOVED_BOXED(*ptr)) term = *ptr;
+	if (IS_MOVED_BOXED(*ptr)) term = (*ptr) | xptr_tag;
 	break;
     case TAG_PRIMARY_LIST:
 	ptr = list_val(term);
-	if (IS_MOVED_CONS(ptr[0])) term = ptr[1];
+	if (IS_MOVED_CONS(ptr[0])) term = (ptr[1]) | xptr_tag;
 	break;
     default:
 	ASSERT(!"strange tag in follow_moved");
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index ef52823287..e23c79d301 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -642,13 +642,13 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
 #endif
 
     if (bp->next != NULL) {
-	move_multi_frags(hpp, off_heap, bp, msg->m, 
+	erts_move_multi_frags(hpp, off_heap, bp, msg->m, 
 #ifdef USE_VM_PROBES
-			 3
+			      3,
 #else
-			 2
+			      2,
 #endif
-			 );
+			      0);
 	goto copy_done;
     }
 
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index 3a5fbcc284..8efbb8c554 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -28,6 +28,37 @@
 #include 
 #include 
 
+void
+erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz)
+{
+#ifdef TAG_LITERAL_PTR
+    Eterm *hp_end, *hp;
+    
+    hp_end = hp_start + hsz;
+    hp = hp_start;
+
+    while (hp < hp_end) {
+	switch (primary_tag(*hp)) {
+	case TAG_PRIMARY_BOXED:
+	case TAG_PRIMARY_LIST:
+	    *hp |= TAG_LITERAL_PTR;
+	    break;
+	case TAG_PRIMARY_HEADER:
+	    if (header_is_thing(*hp)) {
+		hp += thing_arityval(*hp);
+	    }
+	    break;
+	default:
+	    break;
+	}
+	
+	hp++;
+    }
+    if (is_boxed(*term) || is_list(*term))
+	*term |= TAG_LITERAL_PTR;
+#endif
+}
+
 __decl_noreturn static void __noreturn
 et_abort(const char *expr, const char *file, unsigned line)
 {
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 089eecf024..a80716fb0f 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -21,6 +21,8 @@
 #ifndef __ERL_TERM_H
 #define __ERL_TERM_H
 
+#include "erl_mmap.h"
+
 typedef UWord Wterm;  /* Full word terms */
 
 struct erl_node_; /* Declared in erl_node_tables.h */
@@ -48,6 +50,24 @@ struct erl_node_; /* Declared in erl_node_tables.h */
 #define _ET_APPLY(F,X)	_unchecked_##F(X)
 #endif
 
+#if defined(ARCH_64)
+#  define TAG_PTR_MASK__	0x7
+#  if !defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+#    ifdef HIPE
+#      error Hipe on 64-bit needs a real mmap as it does not support the literal tag
+#    endif
+#    define TAG_LITERAL_PTR	0x4
+#  else
+#    undef TAG_LITERAL_PTR
+#  endif
+#elif defined(ARCH_32)
+#  define TAG_PTR_MASK__	0x3
+#  undef TAG_LITERAL_PTR
+#else
+#  error Not supported arch
+#endif
+
+
 #define _TAG_PRIMARY_SIZE	2
 #define _TAG_PRIMARY_MASK	0x3
 #define TAG_PRIMARY_HEADER	0x0
@@ -165,10 +185,11 @@ struct erl_node_; /* Declared in erl_node_tables.h */
 
 /* boxed object access methods */
 
-#define _is_taggable_pointer(x)	 (((Uint)(x) & 0x3) == 0)
+#define _is_taggable_pointer(x)	 (((Uint)(x) & TAG_PTR_MASK__) == 0)
+
 #define  _boxed_precond(x)       (is_boxed(x))
 
-#define _is_aligned(x)		(((Uint)(x) & 0x3) == 0)
+#define _is_aligned(x)		(((Uint)(x) & TAG_PTR_MASK__) == 0)
 #define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED)
 _ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*)
 #define make_boxed(x)		_ET_APPLY(make_boxed,(x))
@@ -180,7 +201,11 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm)
 #else
 #define is_boxed(x)		(((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED)
 #endif
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_boxed_val(x) _unchecked_ptr_val(x)
+#else
 #define _unchecked_boxed_val(x) ((Eterm*) ((x) - TAG_PRIMARY_BOXED))
+#endif
 _ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm)
 #define boxed_val(x)		_ET_APPLY(boxed_val,(x))
 
@@ -198,7 +223,11 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm)
 #define is_not_list(x)		(!is_list((x)))
 #endif
 #define _list_precond(x)        (is_list(x))
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_list_val(x) _unchecked_ptr_val(x)
+#else
 #define _unchecked_list_val(x) ((Eterm*) ((x) - TAG_PRIMARY_LIST))
+#endif
 _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
 #define list_val(x)		_ET_APPLY(list_val,(x))
 
@@ -209,13 +238,20 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
 #define CDR(x)  ((x)[1])
 
 /* generic tagged pointer (boxed or list) access methods */
-#define _unchecked_ptr_val(x)	((Eterm*) ((x) & ~((Uint) 0x3)))
+#define _unchecked_ptr_val(x)	((Eterm*) ((x) & ~((Uint) TAG_PTR_MASK__)))
 #define ptr_val(x)		_unchecked_ptr_val((x))	/*XXX*/
 #define _unchecked_offset_ptr(x,offs)	((x)+((offs)*sizeof(Eterm)))
 #define offset_ptr(x,offs)	_unchecked_offset_ptr(x,offs)	/*XXX*/
 #define _unchecked_byte_offset_ptr(x,byte_offs)	((x)+(offs))
 #define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs)  /*XXX*/
 
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_is_not_literal_ptr(x) (!((x) & TAG_LITERAL_PTR))
+#define is_not_literal_ptr(x) _unchecked_is_not_literal_ptr((x)) /*XXX*/
+#define is_literal_ptr(x) (!is_not_literal_ptr((x))) /*XXX*/
+#endif
+
+
 /* fixnum ("small") access methods */
 #if defined(ARCH_64)
 #define SMALL_BITS	(64-4)
@@ -1113,5 +1149,7 @@ extern unsigned tag_val_def(Wterm);
 
 #define is_same(A,B) ((A)==(B))
 
+void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz);
+
 #endif	/* __ERL_TERM_H */
 
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index b4d02dd1dd..052994b972 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -961,8 +961,8 @@ Uint size_object(Eterm);
 Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
 Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
 
-void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
-		      Eterm* refs, unsigned nrefs);
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
+			   Eterm* refs, unsigned nrefs, int literals);
 
 /* Utilities */
 extern void erts_delete_nodes_monitors(Process *, ErtsProcLocks);
@@ -1274,6 +1274,27 @@ int erts_print_system_version(int to, void *arg, Process *c_p);
 
 int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg);
 
+ERTS_GLB_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr)
+{
+    ASSERT(is_boxed(tptr) || is_list(tptr));
+    ASSERT(ptr == ptr_val(tptr));
+
+#if defined(ERTS_HAVE_IS_IN_LITERAL_RANGE)
+    return erts_is_in_literal_range(ptr);
+#elif defined(TAG_LITERAL_PTR)
+    return is_literal_ptr(tptr);
+#else
+#  error Not able to detect literals...
+#endif
+
+}
+
+#endif
+
 /*
 ** Call_trace uses this API for the parameter matching functions
 */
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 46577bd07f..d63e81cb5e 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -72,6 +72,9 @@
 
 #define ERTS_I64_LITERAL(X) X##LL
 
+#define ErtsInArea(ptr,start,nbytes) \
+    ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+
 #if defined (__WIN32__)
 #  include "erl_win_sys.h"
 #else
@@ -1044,10 +1047,6 @@ extern int erts_use_kernel_poll;
 
 #define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0)
 
-
-#define ErtsInArea(PTR,START,NBYTES) \
-    ((UWord)((char*)(PTR) - (char*)(START)) < (NBYTES))
-
 /*
  * Use DEBUGF as you would use printf, but use double parentheses:
  *
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index c6ea8a5132..00936b6b8a 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -497,6 +497,8 @@ static void *const_term_alloc(void *tmpl)
     hp = &p->mem[0];
     p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap);
 
+    erts_set_literal_tag(&p->val, &p->mem[0], size);
+
     return &p->bucket;
 }
 
-- 
cgit v1.2.3


From b9caedf093d0ccf268562656e28cdda6a02631cb Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Fri, 2 Oct 2015 19:05:57 +0200
Subject: erts: Refactor header of loaded beam code

to use a real C struct instead of array.
---
 erts/emulator/beam/beam_bif_load.c |  75 ++++----
 erts/emulator/beam/beam_bp.c       |  30 +--
 erts/emulator/beam/beam_debug.c    |   8 +-
 erts/emulator/beam/beam_emu.c      |   2 +-
 erts/emulator/beam/beam_load.c     | 384 +++++++++++++++++++------------------
 erts/emulator/beam/beam_load.h     | 112 +++++------
 erts/emulator/beam/beam_ranges.c   |  17 +-
 erts/emulator/beam/break.c         |  30 +--
 erts/emulator/beam/erl_nif.c       |  16 +-
 erts/emulator/beam/module.c        |   4 +-
 erts/emulator/beam/module.h        |   2 +-
 erts/emulator/hipe/hipe_bif0.c     |   8 +-
 12 files changed, 349 insertions(+), 339 deletions(-)

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index adc3bd37d9..2c275c4649 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -40,7 +40,7 @@
 static void set_default_trace_pattern(Eterm module);
 static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
 static void delete_code(Module* modp);
-static void decrement_refc(BeamInstr* code);
+static void decrement_refc(BeamCodeHeader*);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 
@@ -58,8 +58,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
 	return am_undefined;
     }
     erts_rlock_old_code(code_ix);
-    res = (erts_is_module_native(modp->curr.code) ||
-           erts_is_module_native(modp->old.code)) ?
+    res = (erts_is_module_native(modp->curr.code_hdr) ||
+           erts_is_module_native(modp->old.code_hdr)) ?
 		am_true : am_false;
     erts_runlock_old_code(code_ix);
     return res;
@@ -81,7 +81,7 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
     modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
 
     if (modp && modp->curr.num_breakpoints > 0) {
-	ASSERT(modp->curr.code != NULL);
+	ASSERT(modp->curr.code_hdr != NULL);
 	erts_clear_module_break(modp);
 	ASSERT(modp->curr.num_breakpoints == 0);
     }
@@ -281,7 +281,7 @@ finish_loading_1(BIF_ALIST_1)
     exceptions = 0;
     for (i = 0; i < n; i++) {
 	p[i].exception = 0;
-	if (p[i].modp->curr.code && p[i].modp->old.code) {
+	if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) {
 	    p[i].exception = 1;
 	    exceptions++;
 	}
@@ -417,7 +417,7 @@ check_old_code_1(BIF_ALIST_1)
     modp = erts_get_module(BIF_ARG_1, code_ix);
     if (modp != NULL) {
 	erts_rlock_old_code(code_ix);
-	if (modp->old.code != NULL) {
+	if (modp->old.code_hdr) {
 	    res = am_true;
 	}
 	erts_runlock_old_code(code_ix);
@@ -441,7 +441,7 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
     if (!modp)
 	return am_false;
     erts_rlock_old_code(code_ix);
-    res = modp->old.code ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
+    res = modp->old.code_hdr ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
     erts_runlock_old_code(code_ix);
 
     return res;
@@ -525,7 +525,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
 	if (!modp) {
 	    res = am_undefined;
 	}
-	else if (modp->old.code != 0) {
+	else if (modp->old.code_hdr) {
 	    erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
 	    erts_dsprintf(dsbufp, "Module %T must be purged before loading\n",
 			  BIF_ARG_1);
@@ -563,8 +563,8 @@ BIF_RETTYPE module_loaded_1(BIF_ALIST_1)
     }
     code_ix = erts_active_code_ix();
     if ((modp = erts_get_module(BIF_ARG_1, code_ix)) != NULL) {
-	if (modp->curr.code != NULL
-	    && modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] == 0) {
+	if (modp->curr.code_hdr
+	    && modp->curr.code_hdr->on_load_function_ptr == NULL) {
 	    res = am_true;
 	}
     }
@@ -611,8 +611,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1)
 {
     Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
 
-    if (modp && modp->curr.code) {
-	BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]);
+    if (modp && modp->curr.code_hdr) {
+	BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code_hdr->on_load_function_ptr);
     }
     else {
 	BIF_ERROR(BIF_P, BADARG);
@@ -623,7 +623,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
 {
     ErtsCodeIndex code_ix;
     Module* modp;
-    Eterm on_load;
 
     if (!erts_try_seize_code_write_permission(BIF_P)) {
 	ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2],
@@ -638,14 +637,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
     code_ix = erts_active_code_ix();
     modp = erts_get_module(BIF_ARG_1, code_ix);
 
-    if (!modp || modp->curr.code == 0) {
+    if (!modp || !modp->curr.code_hdr) {
     error:
 	erts_smp_thr_progress_unblock();
         erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
 	erts_release_code_write_permission();
 	BIF_ERROR(BIF_P, BADARG);
     }
-    if ((on_load = modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]) == 0) {
+    if (modp->curr.code_hdr->on_load_function_ptr == NULL) {
 	goto error;
     }
     if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
@@ -667,7 +666,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
 		ep->code[4] = 0;
 	    }
 	}
-	modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+	modp->curr.code_hdr->on_load_function_ptr = NULL;
 	set_default_trace_pattern(BIF_ARG_1);
     } else if (BIF_ARG_2 == am_false) {
 	BeamInstr* code;
@@ -679,16 +678,16 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
 	 * the current code; the old code is not touched.
 	 */
 	erts_total_code_size -= modp->curr.code_length;
-	code = modp->curr.code;
-	end = (BeamInstr *)((char *)code + modp->curr.code_length);
+	code = (BeamInstr*) modp->curr.code_hdr;
+	end = (BeamInstr *) ((char *)code + modp->curr.code_length);
 	erts_cleanup_funs_on_purge(code, end);
 	beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length,
 			    erts_active_code_ix());
-        if (code[MI_LITERALS_START]) {
-            erts_free(ERTS_ALC_T_LITERAL, (void *) code[MI_LITERALS_START]);
+        if (modp->curr.code_hdr->literals_start) {
+            erts_free(ERTS_ALC_T_LITERAL, modp->curr.code_hdr->literals_start);
         }
-	erts_free(ERTS_ALC_T_CODE, (void *) code);
-	modp->curr.code = NULL;
+	erts_free(ERTS_ALC_T_CODE, modp->curr.code_hdr);
+	modp->curr.code_hdr = NULL;
 	modp->curr.code_length = 0;
 	modp->curr.catches = BEAM_CATCHES_NIL;
 	erts_remove_from_ranges(code);
@@ -740,7 +739,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
     /*
      * Pick up limits for the module.
      */
-    start = modp->old.code;
+    start = (BeamInstr*) modp->old.code_hdr;
     end = (BeamInstr *)((char *)start + modp->old.code_length);
 
     /*
@@ -832,8 +831,8 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
      * See if there are constants inside the module referenced by the process.
      */
     done_gc = 0;
-    literals = (char*) modp->old.code[MI_LITERALS_START];
-    lit_bsize = (char*) modp->old.code[MI_LITERALS_END] - literals;
+    literals = (char*) modp->old.code_hdr->literals_start;
+    lit_bsize = (char*) modp->old.code_hdr->literals_end - literals;
     for (;;) {
 	ErlMessage* mp;
 
@@ -888,8 +887,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
 	    done_gc = 1;
 	    FLAGS(rp) |= F_NEED_FULLSWEEP;
 	    *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
-	    oh = (struct erl_off_heap_header *)
-		modp->old.code[MI_LITERALS_OFF_HEAP];
+	    oh = modp->old.code_hdr->literals_off_heap;
 	    *redsp += lit_bsize / 64; /* Need, better value... */
 	    erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
 	}
@@ -989,7 +987,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
 	/*
 	 * Any code to purge?
 	 */
-	if (modp->old.code == 0) {
+	if (!modp->old.code_hdr) {
 	    ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
 	}
 	else {
@@ -1012,17 +1010,17 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
 	     */
 	    ASSERT(erts_total_code_size >= modp->old.code_length);
 	    erts_total_code_size -= modp->old.code_length;
-	    code = modp->old.code;
+	    code = (BeamInstr*) modp->old.code_hdr;
 	    end = (BeamInstr *)((char *)code + modp->old.code_length);
 	    erts_cleanup_funs_on_purge(code, end);
 	    beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
 				code_ix);
-	    decrement_refc(code);
-            if (code[MI_LITERALS_START]) {
-                erts_free(ERTS_ALC_T_LITERAL, (void *) code[MI_LITERALS_START]);
+	    decrement_refc(modp->old.code_hdr);
+            if (modp->old.code_hdr->literals_start) {
+                erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start);
             }
 	    erts_free(ERTS_ALC_T_CODE, (void *) code);
-	    modp->old.code = NULL;
+	    modp->old.code_hdr = NULL;
 	    modp->old.code_length = 0;
 	    modp->old.catches = BEAM_CATCHES_NIL;
 	    erts_remove_from_ranges(code);
@@ -1039,10 +1037,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
 }
 
 static void
-decrement_refc(BeamInstr* code)
+decrement_refc(BeamCodeHeader* code_hdr)
 {
-    struct erl_off_heap_header* oh =
-	(struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+    struct erl_off_heap_header* oh = code_hdr->literals_off_heap;
 
     while (oh) {
 	Binary* bptr;
@@ -1091,7 +1088,7 @@ delete_code(Module* modp)
     ASSERT(modp->curr.num_breakpoints == 0);
     ASSERT(modp->curr.num_traced_exports == 0);
     modp->old = modp->curr;
-    modp->curr.code = NULL;
+    modp->curr.code_hdr = NULL;
     modp->curr.code_length = 0;
     modp->curr.catches = BEAM_CATCHES_NIL;
     modp->curr.nif = NULL;
@@ -1108,9 +1105,9 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
      * if not, delete old code; error if old code already exists.
      */
 
-    if (modp->curr.code != NULL && modp->old.code != NULL)  {
+    if (modp->curr.code_hdr && modp->old.code_hdr)  {
 	return am_not_purged;
-    } else if (modp->old.code == NULL) { /* Make the current version old. */
+    } else if (!modp->old.code_hdr) { /* Make the current version old. */
 	delete_code(modp);
     }
     return NIL;
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 016d0aaa32..2a8663d7ee 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -152,8 +152,8 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
     num_modules = 0;
     for (current = 0; current < max_modules; current++) {
 	modp = module_code(current, code_ix);
-	if (modp->curr.code) {
-	    max_funcs += modp->curr.code[MI_NUM_FUNCTIONS];
+	if (modp->curr.code_hdr) {
+	    max_funcs += modp->curr.code_hdr->num_functions;
 	    module[num_modules++] = modp;
 	}
     }
@@ -161,9 +161,9 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
     f->matching = (BpFunction *) Alloc(max_funcs*sizeof(BpFunction));
     i = 0;
     for (current = 0; current < num_modules; current++) {
-	BeamInstr** code_base = (BeamInstr **) module[current]->curr.code;
+	BeamCodeHeader* code_hdr = module[current]->curr.code_hdr;
 	BeamInstr* code;
-	Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+	Uint num_functions = (Uint)(UWord) code_hdr->num_functions;
 	Uint fi;
 
 	if (specified > 0) {
@@ -177,7 +177,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
 	    BeamInstr* pc;
 	    int wi;
 
-	    code = code_base[MI_FUNCTIONS+fi];
+	    code = code_hdr->functions[fi];
 	    ASSERT(code[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
 	    pc = code+5;
 	    if (erts_is_native_break(pc)) {
@@ -547,21 +547,21 @@ erts_clear_all_breaks(BpFunctions* f)
 
 int 
 erts_clear_module_break(Module *modp) {
-    BeamInstr** code_base;
+    BeamCodeHeader* code_hdr;
     Uint n;
     Uint i;
 
     ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
     ASSERT(modp);
-    code_base = (BeamInstr **) modp->curr.code;
-    if (code_base == NULL) {
+    code_hdr = modp->curr.code_hdr;
+    if (!code_hdr) {
 	return 0;
     }
-    n = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+    n = (Uint)(UWord) code_hdr->num_functions;
     for (i = 0; i < n; ++i) {
 	BeamInstr* pc;
 
-	pc = code_base[MI_FUNCTIONS+i] + 5;
+	pc = code_hdr->functions[i] + 5;
 	if (erts_is_native_break(pc)) {
 	    continue;
 	}
@@ -573,7 +573,7 @@ erts_clear_module_break(Module *modp) {
     for (i = 0; i < n; ++i) {
 	BeamInstr* pc;
 
-	pc = code_base[MI_FUNCTIONS+i] + 5;
+	pc = code_hdr->functions[i] + 5;
 	if (erts_is_native_break(pc)) {
 	    continue;
 	}
@@ -1204,17 +1204,17 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
 BeamInstr *
 erts_find_local_func(Eterm mfa[3]) {
     Module *modp;
-    BeamInstr** code_base;
+    BeamCodeHeader* code_hdr;
     BeamInstr* code_ptr;
     Uint i,n;
 
     if ((modp = erts_get_module(mfa[0], erts_active_code_ix())) == NULL)
 	return NULL;
-    if ((code_base = (BeamInstr **) modp->curr.code) == NULL)
+    if ((code_hdr = modp->curr.code_hdr) == NULL)
 	return NULL;
-    n = (BeamInstr) code_base[MI_NUM_FUNCTIONS];
+    n = (BeamInstr) code_hdr->num_functions;
     for (i = 0; i < n; ++i) {
-	code_ptr = code_base[MI_FUNCTIONS+i];
+	code_ptr = code_hdr->functions[i];
 	ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]);
 	ASSERT(mfa[0] == ((Eterm) code_ptr[2]) ||
 	       is_nil((Eterm) code_ptr[2]));
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 3a1d328bbd..e961989fca 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -208,7 +208,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
     Eterm bin;
     Eterm mfa;
     BeamInstr* funcinfo = NULL;	/* Initialized to eliminate warning. */
-    BeamInstr* code_base;
+    BeamCodeHeader* code_hdr;
     BeamInstr* code_ptr = NULL;	/* Initialized to eliminate warning. */
     BeamInstr instr;
     BeamInstr uaddr;
@@ -258,12 +258,12 @@ erts_debug_disassemble_1(BIF_ALIST_1)
 	     */
 	    code_ptr = ((BeamInstr *) ep->addressv[code_ix]) - 5;
 	    funcinfo = code_ptr+2;
-	} else if (modp == NULL || (code_base = modp->curr.code) == NULL) {
+	} else if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) {
 	    BIF_RET(am_undef);
 	} else {
-	    n = code_base[MI_NUM_FUNCTIONS];
+	    n = code_hdr->num_functions;
 	    for (i = 0; i < n; i++) {
-		code_ptr = (BeamInstr *) code_base[MI_FUNCTIONS+i];
+		code_ptr = code_hdr->functions[i];
 		if (code_ptr[3] == name && code_ptr[4] == arity) {
 		    funcinfo = code_ptr+2;
 		    break;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index a42ce1c9f1..6e4c8ecee3 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -6080,7 +6080,7 @@ call_fun(Process* p,		/* Current process. */
 		 */
 		module = fe->module;
 		if ((modp = erts_get_module(module, code_ix)) != NULL
-		    && modp->curr.code != NULL) {
+		    && modp->curr.code_hdr != NULL) {
 		    /*
 		     * There is a module loaded, but obviously the fun is not
 		     * defined in it. We must not call the error_handler
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index a846e96204..c56e6732a0 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -80,7 +80,7 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int);
 
 typedef struct {
     Uint value;			/* Value of label (NULL if not known yet). */
-    Uint patches;		/* Index (into code buffer) to first location
+    Sint patches;		/* Index (into code buffer) to first location
 				 * which must be patched with the value of this label.
 				 */
 #ifdef ERTS_SMP
@@ -284,9 +284,10 @@ typedef struct LoaderState {
     int specific_op;		/* Specific opcode (-1 if not found). */
     int num_functions;		/* Number of functions in module. */
     int num_labels;		/* Number of labels. */
-    int code_buffer_size;	/* Size of code buffer in words.  */
-    BeamInstr* code;		/* Loaded code. */
-    int ci;			/* Current index into loaded code. */
+    BeamCodeHeader* hdr;	/* Loaded code header */
+    BeamInstr* codev;	        /* Loaded code buffer */
+    int        codev_size;      /* Size of code buffer in words. */
+    int ci;			/* Current index into loaded code buffer. */
     Label* labels;
     StringPatch* string_patches; /* Linked list of position into string table to patch. */
     BeamInstr catches;		/* Linked list of catch_yf instructions. */
@@ -480,7 +481,7 @@ static void free_literal_fragment(ErlHeapFragment*);
 static void loader_state_dtor(Binary* magic);
 static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
 			     Eterm group_leader, Eterm module,
-			     BeamInstr* code, Uint size);
+			     BeamCodeHeader* code, Uint size);
 static int init_iff_file(LoaderState* stp, byte* code, Uint size);
 static int scan_iff_file(LoaderState* stp, Uint* chunk_types,
 			 Uint num_types, Uint num_mandatory);
@@ -526,15 +527,15 @@ static void new_string_patch(LoaderState* stp, int pos);
 static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size);
 static int genopargcompare(GenOpArg* a, GenOpArg* b);
 static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
-                             BeamInstr* code, Eterm module, Eterm what);
+                             BeamCodeHeader*, Eterm module, Eterm what);
 static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
                                   Eterm mod);
-static Eterm functions_in_module(Process* p, BeamInstr* code);
-static Eterm attributes_for_module(Process* p, BeamInstr* code);
-static Eterm compilation_info_for_module(Process* p, BeamInstr* code);
-static Eterm md5_of_module(Process* p, BeamInstr* code);
-static Eterm has_native(BeamInstr* code);
-static Eterm native_addresses(Process* p, BeamInstr* code);
+static Eterm functions_in_module(Process* p, BeamCodeHeader*);
+static Eterm attributes_for_module(Process* p, BeamCodeHeader*);
+static Eterm compilation_info_for_module(Process* p, BeamCodeHeader*);
+static Eterm md5_of_module(Process* p, BeamCodeHeader*);
+static Eterm has_native(BeamCodeHeader*);
+static Eterm native_addresses(Process* p, BeamCodeHeader*);
 int patch_funentries(Eterm Patchlist);
 int patch(Eterm Addresses, Uint fe);
 static int safe_mul(UWord a, UWord b, UWord* resp);
@@ -601,6 +602,7 @@ extern void check_allocated_block(Uint type, void *blk);
 #define CHKBLK(TYPE,BLK) /* nothing */
 #endif
 
+
 Eterm
 erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
 		     Eterm* modp, byte* code, Uint unloaded_size)
@@ -641,21 +643,27 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
     /*
      * Initialize code area.
      */
-    stp->code_buffer_size = 2048 + stp->num_functions;
-    stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
-				    sizeof(BeamInstr) * stp->code_buffer_size);
-
-    stp->code[MI_NUM_FUNCTIONS] = stp->num_functions;
-    stp->ci = MI_FUNCTIONS + stp->num_functions + 1;
-
-    stp->code[MI_ATTR_PTR] = 0;
-    stp->code[MI_ATTR_SIZE] = 0;
-    stp->code[MI_ATTR_SIZE_ON_HEAP] = 0;
-    stp->code[MI_COMPILE_PTR] = 0;
-    stp->code[MI_COMPILE_SIZE] = 0;
-    stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
-    stp->code[MI_LITERALS_START] = 0;
-    stp->code[MI_MD5_PTR] = 0;
+    stp->codev_size = 2048 + stp->num_functions;
+    stp->hdr = (BeamCodeHeader*) erts_alloc(ERTS_ALC_T_CODE,
+                                            (offsetof(BeamCodeHeader,functions)
+                                             + sizeof(BeamInstr) * stp->codev_size));
+
+    stp->hdr->num_functions = stp->num_functions;
+
+    /* Let the codev array start at functions[0] in order to index
+     * both function pointers and the loaded code itself that follows.
+     */
+    stp->codev = (BeamInstr*) &stp->hdr->functions;
+    stp->ci = stp->num_functions + 1;
+
+    stp->hdr->attr_ptr = NULL;
+    stp->hdr->attr_size = 0;
+    stp->hdr->attr_size_on_heap = 0;
+    stp->hdr->compile_ptr = NULL;
+    stp->hdr->compile_size = 0;
+    stp->hdr->compile_size_on_heap = 0;
+    stp->hdr->literals_start = NULL;
+    stp->hdr->md5_ptr = NULL;
 
     /*
      * Read the atom table.
@@ -777,7 +785,7 @@ erts_finish_loading(Binary* magic, Process* c_p,
 
     CHKBLK(ERTS_ALC_T_CODE,stp->code);
     retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module,
-			     stp->code, stp->loaded_size);
+			     stp->hdr, stp->loaded_size);
     if (retval != NIL) {
 	goto load_error;
     }
@@ -800,7 +808,8 @@ erts_finish_loading(Binary* magic, Process* c_p,
     debug_dump_code(stp->code,stp->ci);
 #endif
 #endif
-    stp->code = NULL;		/* Prevent code from being freed. */
+    stp->hdr = NULL;		/* Prevent code from being freed. */
+    stp->codev = NULL;
     *modp = stp->module;
 
     /*
@@ -832,7 +841,8 @@ erts_alloc_loader_state(void)
     stp->specific_op = -1;
     stp->genop = NULL;
     stp->atom = NULL;
-    stp->code = NULL;
+    stp->hdr = NULL;
+    stp->codev = NULL;
     stp->labels = NULL;
     stp->import = NULL;
     stp->export = NULL;
@@ -871,7 +881,7 @@ erts_module_for_prepared_code(Binary* magic)
 	return NIL;
     }
     stp = ERTS_MAGIC_BIN_DATA(magic);
-    if (stp->code != 0) {
+    if (stp->hdr != 0) {
 	return stp->module;
     } else {
 	return NIL;
@@ -921,12 +931,13 @@ loader_state_dtor(Binary* magic)
 	driver_free_binary(stp->bin);
 	stp->bin = 0;
     }
-    if (stp->code != 0) {
-        if (stp->code[MI_LITERALS_START]) {
-            erts_free(ERTS_ALC_T_LITERAL, (void*) stp->code[MI_LITERALS_START]);
+    if (stp->hdr != 0) {
+        if (stp->hdr->literals_start) {
+            erts_free(ERTS_ALC_T_LITERAL, stp->hdr->literals_start);
         }
-	erts_free(ERTS_ALC_T_CODE, stp->code);
-	stp->code = 0;
+	erts_free(ERTS_ALC_T_CODE, stp->hdr);
+	stp->hdr = 0;
+        stp->codev = 0;
     }
     if (stp->labels != 0) {
 	erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels);
@@ -999,7 +1010,7 @@ loader_state_dtor(Binary* magic)
 
 static Eterm
 insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
-		Eterm group_leader, Eterm module, BeamInstr* code,
+		Eterm group_leader, Eterm module, BeamCodeHeader* code_hdr,
 		Uint size)
 {
     Module* modp;
@@ -1020,7 +1031,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
 
     erts_total_code_size += size;
     modp = erts_put_module(module);
-    modp->curr.code = code;
+    modp->curr.code_hdr = code_hdr;
     modp->curr.code_length = size;
     modp->curr.catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
 
@@ -1028,7 +1039,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
      * Update ranges (used for finding a function from a PC value).
      */
 
-    erts_update_ranges(code, size);
+    erts_update_ranges((BeamInstr*)modp->curr.code_hdr, size);
     return NIL;
 }
 
@@ -1377,7 +1388,7 @@ read_export_table(LoaderState* stp)
 	if (value == 0) {
 	    LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
 	}
-	stp->export[i].address = address = stp->code + value;
+	stp->export[i].address = address = stp->codev + value;
 
 	/*
 	 * Find out if there is a BIF with the same name.
@@ -1396,7 +1407,7 @@ read_export_table(LoaderState* stp)
 	 * any other functions that walk through all local functions.
 	 */
 
-	if (stp->labels[n].patches) {
+	if (stp->labels[n].patches >= 0) {
 	    LoadError3(stp, "there are local calls to the stub for "
 		       "the BIF %T:%T/%d",
 		       stp->module, func, arity);
@@ -1739,7 +1750,7 @@ read_code_header(LoaderState* stp)
 				       stp->num_labels * sizeof(Label));
     for (i = 0; i < stp->num_labels; i++) {
 	stp->labels[i].value = 0;
-	stp->labels[i].patches = 0;
+	stp->labels[i].patches = -1;
 #ifdef ERTS_SMP
 	stp->labels[i].looprec_targeted = 0;
 #endif
@@ -1758,13 +1769,14 @@ read_code_header(LoaderState* stp)
     } else {}
 
 #define CodeNeed(w) do {						\
-    ASSERT(ci <= code_buffer_size);					\
-    if (code_buffer_size < ci+(w)) {					\
-        code_buffer_size = 2*ci+(w);					\
-	stp->code = code =						\
-	    (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE,			\
-				     (void *) code,			\
-				     code_buffer_size * sizeof(BeamInstr));	\
+    ASSERT(ci <= codev_size);					        \
+    if (codev_size < ci+(w)) {					        \
+        codev_size = 2*ci+(w);	                                        \
+	stp->hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE,	\
+            (void *) stp->hdr,	                                        \
+            (offsetof(BeamCodeHeader,functions)                         \
+             + codev_size * sizeof(BeamInstr)));                        \
+        code = stp->codev = (BeamInstr*) &stp->hdr->functions;          \
     } 									\
 } while (0)
     
@@ -1780,7 +1792,7 @@ load_code(LoaderState* stp)
     int arg;			/* Number of current argument. */
     int num_specific;		/* Number of specific ops for current. */
     BeamInstr* code;
-    int code_buffer_size;
+    int codev_size;
     int specific;
     Uint last_label = 0;	/* Number of last label. */
     Uint function_number = 0;
@@ -1797,15 +1809,15 @@ load_code(LoaderState* stp)
 	FUNC_INFO_SZ = 5
     };
 
-    code = stp->code;
-    code_buffer_size = stp->code_buffer_size;
+    code = stp->codev;
+    codev_size = stp->codev_size;
     ci = stp->ci;
 
     for (;;) {
 	int new_op;
 	GenOp* tmp_op;
 
-	ASSERT(ci <= code_buffer_size);
+	ASSERT(ci <= codev_size);
 
     get_next_instr:
 	GetByte(stp, new_op);
@@ -2420,8 +2432,7 @@ load_code(LoaderState* stp)
 	switch (stp->specific_op) {
 	case op_i_func_info_IaaI:
 	    {
-		Uint offset;
-
+		Sint offset;
 		if (function_number >= stp->num_functions) {
 		    LoadError1(stp, "too many functions in module (header said %d)",
 			       stp->num_functions); 
@@ -2463,15 +2474,15 @@ load_code(LoaderState* stp)
 		stp->arity = code[ci-1];
 
 		ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
-		offset = MI_FUNCTIONS + function_number;
-		code[offset] = stp->labels[last_label].patches;
+		stp->hdr->functions[function_number] = (BeamInstr*) stp->labels[last_label].patches;
+		offset = function_number;
 		stp->labels[last_label].patches = offset;
 		function_number++;
 		if (stp->arity > MAX_ARG) {
 		    LoadError1(stp, "too many arguments: %d", stp->arity);
 		}
 #ifdef DEBUG
-		ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */
+		ASSERT(stp->labels[0].patches < 0); /* Should not be referenced. */
 		for (i = 1; i < stp->num_labels; i++) {
 		    ASSERT(stp->labels[i].patches < ci);
 		}
@@ -2541,7 +2552,7 @@ load_code(LoaderState* stp)
 	     * End of code found.
 	     */
 	case op_int_code_end:
-	    stp->code_buffer_size = code_buffer_size;
+	    stp->codev_size = codev_size;
 	    stp->ci = ci;
 	    stp->function = THE_NON_VALUE;
 	    stp->genop = NULL;
@@ -4351,7 +4362,8 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
 static int
 freeze_code(LoaderState* stp)
 {
-    BeamInstr* code = stp->code;
+    BeamCodeHeader* code_hdr = stp->hdr;
+    BeamInstr* codev = (BeamInstr*) &stp->hdr->functions;
     int i;
     byte* str_table;
     unsigned strtab_size = stp->chunks[STR_CHUNK].size;
@@ -4380,53 +4392,50 @@ freeze_code(LoaderState* stp)
 		     (stp->current_li+1) + stp->num_fnames) *
 	    sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
     }
-    size = (stp->ci * sizeof(BeamInstr)) +
+    size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) +
 	strtab_size + attr_size + compile_size + MD5_SIZE + line_size;
 
     /*
      * Move the code to its final location.
      */
 
-    code = (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size);
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size);
+    codev = (BeamInstr*) &code_hdr->functions;
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
     /*
      * Place a pointer to the op_int_code_end instruction in the
      * function table in the beginning of the file.
      */
 
-    code[MI_FUNCTIONS+stp->num_functions] = (BeamInstr) (code + stp->ci - 1);
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    code_hdr->functions[stp->num_functions] = (codev + stp->ci - 1);
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
 
     /*
      * Store the pointer to the on_load function.
      */
 
     if (stp->on_load) {
-	code[MI_ON_LOAD_FUNCTION_PTR] = (BeamInstr) (code + stp->on_load);
+	code_hdr->on_load_function_ptr = codev + stp->on_load;
     } else {
-	code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+	code_hdr->on_load_function_ptr = NULL;
     }
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
 
     /*
      * Place the literals in their own allocated heap (for fast range check)
      * and fix up all instructions that refer to it.
      */
     {
-	Uint* ptr;
-	Uint* low;
-	Uint* high;
+	Eterm* ptr;
 	LiteralPatch* lp;
         ErlOffHeap code_off_heap;
 
         ERTS_INIT_OFF_HEAP(&code_off_heap);
 
-        low = erts_alloc(ERTS_ALC_T_LITERAL,
-                         stp->total_literal_size*sizeof(Eterm));
-	high = low + stp->total_literal_size;
-	code[MI_LITERALS_START] = (BeamInstr) low;
-	code[MI_LITERALS_END] = (BeamInstr) high;
-	ptr = low;
+        ptr = (Eterm*)erts_alloc(ERTS_ALC_T_LITERAL,
+                                 stp->total_literal_size*sizeof(Eterm));
+	code_hdr->literals_start = ptr;
+	code_hdr->literals_end = ptr + stp->total_literal_size;
 	for (i = 0; i < stp->num_literals; i++) {
             if (stp->literals[i].heap_frags) {
                 move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags,
@@ -4435,13 +4444,13 @@ freeze_code(LoaderState* stp)
             }
             else ASSERT(is_immed(stp->literals[i].term));
 	}
-        code[MI_LITERALS_OFF_HEAP] = (BeamInstr) code_off_heap.first;
+	code_hdr->literals_off_heap = code_off_heap.first;
 	lp = stp->literal_patches;
 	while (lp != 0) {
 	    BeamInstr* op_ptr;
 	    Literal* lit;
 
-	    op_ptr = code + lp->pos;
+	    op_ptr = codev + lp->pos;
 	    lit = &stp->literals[op_ptr[0]];
 	    op_ptr[0] = lit->term;
 	    lp = lp->next;
@@ -4453,16 +4462,16 @@ freeze_code(LoaderState* stp)
      * If there is line information, place it here.
      */
     if (stp->line_instr == 0) {
-	code[MI_LINE_TABLE] = (BeamInstr) 0;
-	str_table = (byte *) (code+stp->ci);
+	code_hdr->line_table = NULL;
+	str_table = (byte *) (codev + stp->ci);
     } else {
-	Eterm* line_tab = (Eterm *) (code+stp->ci);
+	Eterm* line_tab = (Eterm *) (codev+stp->ci);
 	Eterm* p;
 	int ftab_size = stp->num_functions;
 	int num_instrs = stp->current_li;
 	Eterm* first_line_item;
 
-	code[MI_LINE_TABLE] = (BeamInstr) line_tab;
+	code_hdr->line_table = line_tab;
 	p = line_tab + MI_LINE_FUNC_TAB;
 
 	first_line_item = (p + ftab_size + 1);
@@ -4472,9 +4481,9 @@ freeze_code(LoaderState* stp)
 	*p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
 	ASSERT(p == first_line_item);
 	for (i = 0; i < num_instrs; i++) {
-		*p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos);
+		*p++ = (Eterm) (BeamInstr) (codev + stp->line_instr[i].pos);
 	}
-	*p++ = (Eterm) (BeamInstr) (code + stp->ci - 1);
+	*p++ = (Eterm) (BeamInstr) (codev + stp->ci - 1);
 
 	line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
 	memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
@@ -4509,13 +4518,13 @@ freeze_code(LoaderState* stp)
     if (attr_size) {
 	byte* attr = str_table + strtab_size;
 	sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size);
-	code[MI_ATTR_PTR] = (BeamInstr) attr;
-	code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
+	code_hdr->attr_ptr = attr;
+	code_hdr->attr_size = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
 	decoded_size = erts_decode_ext_size(attr, attr_size);
 	if (decoded_size < 0) {
  	    LoadError0(stp, "bad external term representation of module attributes");
  	}
-	code[MI_ATTR_SIZE_ON_HEAP] = decoded_size;
+	code_hdr->attr_size_on_heap = decoded_size;
     }
     CHKBLK(ERTS_ALC_T_CODE,code);
     if (compile_size) {
@@ -4525,9 +4534,9 @@ freeze_code(LoaderState* stp)
 	       stp->chunks[COMPILE_CHUNK].size);
 
 	CHKBLK(ERTS_ALC_T_CODE,code);
-	code[MI_COMPILE_PTR] = (BeamInstr) compile_info;
+	code_hdr->compile_ptr = compile_info;
 	CHKBLK(ERTS_ALC_T_CODE,code);
-	code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
+	code_hdr->compile_size = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
 	CHKBLK(ERTS_ALC_T_CODE,code);
 	decoded_size = erts_decode_ext_size(compile_info, compile_size);
 	CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4535,7 +4544,7 @@ freeze_code(LoaderState* stp)
  	    LoadError0(stp, "bad external term representation of compilation information");
  	}
 	CHKBLK(ERTS_ALC_T_CODE,code);
-	code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size;
+	code_hdr->compile_size_on_heap = decoded_size;
     }
     CHKBLK(ERTS_ALC_T_CODE,code);
     {
@@ -4543,7 +4552,7 @@ freeze_code(LoaderState* stp)
 	CHKBLK(ERTS_ALC_T_CODE,code);
 	sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE);
 	CHKBLK(ERTS_ALC_T_CODE,code);
-	code[MI_MD5_PTR] = (BeamInstr) md5_sum;
+	code_hdr->md5_ptr = md5_sum;
 	CHKBLK(ERTS_ALC_T_CODE,code);
     }
     CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4552,7 +4561,7 @@ freeze_code(LoaderState* stp)
      * Make sure that we have not overflowed the allocated code space.
      */
     ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE ==
-	   ((byte *) code) + size);
+	   ((byte *) code_hdr) + size);
 
     /*
      * Patch all instructions that refer to the string table.
@@ -4564,46 +4573,47 @@ freeze_code(LoaderState* stp)
 	    BeamInstr* op_ptr;
 	    byte* strp;
 
-	    op_ptr = code + sp->pos;
+	    op_ptr = codev + sp->pos;
 	    strp = str_table + op_ptr[0];
 	    op_ptr[0] = (BeamInstr) strp;
 	    sp = sp->next;
 	}
     }
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
 
     /*
      * Resolve all labels.
      */
 
     for (i = 0; i < stp->num_labels; i++) {
-	Uint this_patch;
-	Uint next_patch;
+	Sint this_patch;
+	Sint next_patch;
 	Uint value = stp->labels[i].value;
 	
-	if (value == 0 && stp->labels[i].patches != 0) {
+	if (value == 0 && stp->labels[i].patches >= 0) {
 	    LoadError1(stp, "label %d not resolved", i);
 	}
 	ASSERT(value < stp->ci);
 	this_patch = stp->labels[i].patches;
-	while (this_patch != 0) {
+	while (this_patch >= 0) {
 	    ASSERT(this_patch < stp->ci);
-	    next_patch = code[this_patch];
+	    next_patch = codev[this_patch];
 	    ASSERT(next_patch < stp->ci);
-	    code[this_patch] = (BeamInstr) (code + value);
+	    codev[this_patch] = (BeamInstr) (codev + value);
 	    this_patch = next_patch;
 	}
     }
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
 
     /*
      * Save the updated code pointer and code size.
      */
 
-    stp->code = code;
+    stp->hdr = code_hdr;
+    stp->codev = codev;
     stp->loaded_size = size;
 
-    CHKBLK(ERTS_ALC_T_CODE,code);
+    CHKBLK(ERTS_ALC_T_CODE,code_hdr);
     return 1;
 
  load_error:
@@ -4611,7 +4621,8 @@ freeze_code(LoaderState* stp)
      * Make sure that the caller frees the newly reallocated block, and
      * not the old one (in case it has moved).
      */
-    stp->code = code;
+    stp->hdr = code_hdr;
+    stp->codev = codev;
     return 0;
 }
 
@@ -4622,7 +4633,7 @@ final_touch(LoaderState* stp)
     int on_load = stp->on_load;
     unsigned catches;
     Uint index;
-    BeamInstr* code = stp->code;
+    BeamInstr* codev = stp->codev;
     Module* modp;
 
     /*
@@ -4632,10 +4643,10 @@ final_touch(LoaderState* stp)
     index = stp->catches;
     catches = BEAM_CATCHES_NIL;
     while (index != 0) {
-	BeamInstr next = code[index];
-	code[index] = BeamOpCode(op_catch_yf);
-	catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
-	code[index+2] = make_catch(catches);
+	BeamInstr next = codev[index];
+	codev[index] = BeamOpCode(op_catch_yf);
+	catches = beam_catches_cons((BeamInstr *)codev[index+2], catches);
+	codev[index+2] = make_catch(catches);
 	index = next;
     }
     modp = erts_put_module(stp->module);
@@ -4686,8 +4697,8 @@ final_touch(LoaderState* stp)
 	current = stp->import[i].patches;
 	while (current != 0) {
 	    ASSERT(current < stp->ci);
-	    next = stp->code[current];
-	    stp->code[current] = import;
+	    next = stp->codev[current];
+	    stp->codev[current] = import;
 	    current = next;
 	}
     }
@@ -4700,7 +4711,7 @@ final_touch(LoaderState* stp)
 	for (i = 0; i < stp->num_lambdas; i++) {
 	    unsigned entry_label = stp->lambdas[i].label;
 	    ErlFunEntry* fe = stp->lambdas[i].fe;
-	    BeamInstr* code_ptr = (BeamInstr *) (stp->code + stp->labels[entry_label].value);
+	    BeamInstr* code_ptr = stp->codev + stp->labels[entry_label].value;
 
 	    if (fe->address[0] != 0) {
 		/*
@@ -5324,7 +5335,7 @@ new_label(LoaderState* stp)
 					 (void *) stp->labels,
 					 stp->num_labels * sizeof(Label));
     stp->labels[num].value = 0;
-    stp->labels[num].patches = 0;
+    stp->labels[num].patches = -1;
     return num;
 }
 
@@ -5384,7 +5395,7 @@ erts_module_info_0(Process* p, Eterm module)
 {
     Module* modp;
     ErtsCodeIndex code_ix = erts_active_code_ix();
-    BeamInstr* code;
+    BeamCodeHeader* code_hdr;
     Eterm *hp;
     Eterm list = NIL;
     Eterm tup;
@@ -5398,13 +5409,13 @@ erts_module_info_0(Process* p, Eterm module)
 	return THE_NON_VALUE;
     }
 
-    code = modp->curr.code;
-    if (code == NULL) {
+    code_hdr = modp->curr.code_hdr;
+    if (code_hdr == NULL) {
         return THE_NON_VALUE;
     }
 
 #define BUILD_INFO(What) \
-    tup = get_module_info(p, code_ix, code, module, What); \
+    tup = get_module_info(p, code_ix, code_hdr, module, What); \
     hp = HAlloc(p, 5); \
     tup = TUPLE2(hp, What, tup); \
     hp += 3; \
@@ -5427,7 +5438,7 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
 {
     Module* modp;
     ErtsCodeIndex code_ix = erts_active_code_ix();
-    BeamInstr* code;
+    BeamCodeHeader* code_hdr;
 
     if (is_not_atom(module)) {
         return THE_NON_VALUE;
@@ -5438,34 +5449,34 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
         return THE_NON_VALUE;
     }
 
-    code = modp->curr.code;
-    if (code == NULL) {
+    code_hdr = modp->curr.code_hdr;
+    if (code_hdr == NULL) {
         return THE_NON_VALUE;
     }
 
-    return get_module_info(p, code_ix, code, module, what);
+    return get_module_info(p, code_ix, code_hdr, module, what);
 }
 
 static Eterm
-get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
+get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader* code_hdr,
                 Eterm module, Eterm what)
 {
     if (what == am_module) {
 	return module;
     } else if (what == am_md5) {
-	return md5_of_module(p, code);
+	return md5_of_module(p, code_hdr);
     } else if (what == am_exports) {
 	return exported_from_module(p, code_ix, module);
     } else if (what == am_functions) {
-	return functions_in_module(p, code);
+	return functions_in_module(p, code_hdr);
     } else if (what == am_attributes) {
-	return attributes_for_module(p, code);
+	return attributes_for_module(p, code_hdr);
     } else if (what == am_compile) {
-	return compilation_info_for_module(p, code);
+	return compilation_info_for_module(p, code_hdr);
     } else if (what == am_native_addresses) {
-	return native_addresses(p, code);
+	return native_addresses(p, code_hdr);
     } else if (what == am_native) {
-	return has_native(code);
+	return has_native(code_hdr);
     }
     return THE_NON_VALUE;
 }
@@ -5477,7 +5488,7 @@ get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
 
 Eterm
 functions_in_module(Process* p, /* Process whose heap to use. */
-		    BeamInstr* code)
+		    BeamCodeHeader* code_hdr)
 {
     int i;
     Uint num_functions;
@@ -5486,12 +5497,12 @@ functions_in_module(Process* p, /* Process whose heap to use. */
     Eterm* hp_end;
     Eterm result = NIL;
 
-    num_functions = code[MI_NUM_FUNCTIONS];
+    num_functions = code_hdr->num_functions;
     need = 5*num_functions;
     hp = HAlloc(p, need);
     hp_end = hp + need;
     for (i = num_functions-1; i >= 0 ; i--) {
-	BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+	BeamInstr* func_info = code_hdr->functions[i];
 	Eterm name = (Eterm) func_info[3];
 	int arity = (int) func_info[4];
 	Eterm tuple;
@@ -5517,11 +5528,11 @@ functions_in_module(Process* p, /* Process whose heap to use. */
  */
 
 static Eterm
-has_native(BeamInstr *code)
+has_native(BeamCodeHeader *code_hdr)
 {
     Eterm result = am_false;
 #ifdef HIPE
-    if (erts_is_module_native(code)) {
+    if (erts_is_module_native(code_hdr)) {
         result = am_true;
     }
 #endif
@@ -5529,15 +5540,15 @@ has_native(BeamInstr *code)
 }
 
 int
-erts_is_module_native(BeamInstr* code)
+erts_is_module_native(BeamCodeHeader* code_hdr)
 {
     Uint i, num_functions;
 
     /* Check NativeAdress of first real function in module */
-    if (code != NULL) {
-        num_functions = code[MI_NUM_FUNCTIONS];
+    if (code_hdr != NULL) {
+        num_functions = code_hdr->num_functions;
         for (i=0; ifunctions[i];
             Eterm name = (Eterm) func_info[3];
             if (is_atom(name)) {
                 return func_info[1] != 0;
@@ -5554,7 +5565,7 @@ erts_is_module_native(BeamInstr* code)
  */
 
 static Eterm
-native_addresses(Process* p, BeamInstr* code)
+native_addresses(Process* p, BeamCodeHeader* code_hdr)
 {
     int i;
     Eterm* hp;
@@ -5563,12 +5574,12 @@ native_addresses(Process* p, BeamInstr* code)
     Eterm* hp_end;
     Eterm result = NIL;
 
-    num_functions = code[MI_NUM_FUNCTIONS];
+    num_functions = code_hdr->num_functions;
     need = (6+BIG_UINT_HEAP_SIZE)*num_functions;
     hp = HAlloc(p, need);
     hp_end = hp + need;
     for (i = num_functions-1; i >= 0 ; i--) {
-	BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+	BeamInstr* func_info = code_hdr->functions[i];
 	Eterm name = (Eterm) func_info[3];
 	int arity = (int) func_info[4];
 	Eterm tuple;
@@ -5634,15 +5645,15 @@ exported_from_module(Process* p, /* Process whose heap to use. */
 
 Eterm
 attributes_for_module(Process* p, /* Process whose heap to use. */
-                      BeamInstr* code)
+                      BeamCodeHeader* code_hdr)
 {
     byte* ext;
     Eterm result = NIL;
 
-    ext = (byte *) code[MI_ATTR_PTR];
+    ext = code_hdr->attr_ptr;
     if (ext != NULL) {
 	ErtsHeapFactory factory;
-	erts_factory_proc_prealloc_init(&factory, p, code[MI_ATTR_SIZE_ON_HEAP]);
+	erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap);
 	result = erts_decode_ext(&factory, &ext);
 	if (is_value(result)) {
 	    erts_factory_close(&factory);
@@ -5657,15 +5668,15 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
 
 Eterm
 compilation_info_for_module(Process* p, /* Process whose heap to use. */
-                            BeamInstr* code)
+                            BeamCodeHeader* code_hdr)
 {
     byte* ext;
     Eterm result = NIL;
 
-    ext = (byte *) code[MI_COMPILE_PTR];
+    ext = code_hdr->compile_ptr;
     if (ext != NULL) {
 	ErtsHeapFactory factory;
-	erts_factory_proc_prealloc_init(&factory, p, code[MI_COMPILE_SIZE_ON_HEAP]);
+	erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap);
 	result = erts_decode_ext(&factory, &ext);
 	if (is_value(result)) {
 	    erts_factory_close(&factory);
@@ -5680,9 +5691,9 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
 
 Eterm
 md5_of_module(Process* p, /* Process whose heap to use. */
-              BeamInstr* code)
+              BeamCodeHeader* code_hdr)
 {
-    return new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+    return new_binary(p, code_hdr->md5_ptr, MD5_SIZE);
 }
 
 /*
@@ -5893,7 +5904,7 @@ static byte*
 stub_copy_info(LoaderState* stp,
 	       int chunk,	/* Chunk: ATTR_CHUNK or COMPILE_CHUNK */
 	       byte* info,	/* Where to store info. */
-	       BeamInstr* ptr_word,	/* Where to store pointer into info. */
+	       byte** ptr_word,	/* Where to store pointer into info. */
 	       BeamInstr* size_word,	/* Where to store size into info. */
 	       BeamInstr* size_on_heap_word) /* Where to store size on heap. */
 {
@@ -5901,7 +5912,7 @@ stub_copy_info(LoaderState* stp,
     Uint size = stp->chunks[chunk].size;
     if (size != 0) {
 	memcpy(info, stp->chunks[chunk].start, size);
-	*ptr_word = (BeamInstr) info;
+	*ptr_word = info;
 	decoded_size = erts_decode_ext_size(info, size);
 	if (decoded_size < 0) {
  	    return 0;
@@ -6156,11 +6167,10 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     BeamInstr Patchlist;
     Eterm MD5Bin;
     Eterm* tp;
-    BeamInstr* code = NULL;
-    BeamInstr* ptrs;
+    BeamCodeHeader* code_hdr;
+    BeamInstr* code_base;
     BeamInstr* fp;
     byte* info;
-    Uint ci;
     int n;
     int code_size;
     int rval;
@@ -6238,39 +6248,39 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
      * Allocate memory for the stub module.
      */
 
-    code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
-    code_size += stp->chunks[ATTR_CHUNK].size;
-    code_size += stp->chunks[COMPILE_CHUNK].size;
-    code_size += MD5_SIZE;
-    code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
-    if (!code) {
+    code_size = (offsetof(BeamCodeHeader,functions)
+                 + ((n+1) * sizeof(BeamInstr*))
+                 + (WORDS_PER_FUNCTION*n + 1) * sizeof(BeamInstr)
+                 + stp->chunks[ATTR_CHUNK].size
+                 + stp->chunks[COMPILE_CHUNK].size
+                 + MD5_SIZE);
+    code_hdr = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
+    if (!code_hdr) {
 	goto error;
     }
 
     /*
-     * Initialize code area.
+     * Initialize code header.
      */
 
-    code[MI_NUM_FUNCTIONS] = n;
-    code[MI_ATTR_PTR] = 0;
-    code[MI_ATTR_SIZE] = 0;
-    code[MI_ATTR_SIZE_ON_HEAP] = 0;
-    code[MI_COMPILE_PTR] = 0;
-    code[MI_COMPILE_SIZE] = 0;
-    code[MI_COMPILE_SIZE_ON_HEAP] = 0;
-    code[MI_LITERALS_START] = 0;
-    code[MI_LITERALS_END] = 0;
-    code[MI_LITERALS_OFF_HEAP] = 0;
-    code[MI_ON_LOAD_FUNCTION_PTR] = 0;
-    code[MI_MD5_PTR] = 0;
-    ci = MI_FUNCTIONS + n + 1;
+    code_hdr->num_functions = n;
+    code_hdr->attr_ptr = NULL;
+    code_hdr->attr_size = 0;
+    code_hdr->attr_size_on_heap = 0;
+    code_hdr->compile_ptr = NULL;
+    code_hdr->compile_size = 0;
+    code_hdr->compile_size_on_heap = 0;
+    code_hdr->literals_start = NULL;
+    code_hdr->literals_end = NULL;
+    code_hdr->literals_off_heap = 0;
+    code_hdr->on_load_function_ptr = NULL;
+    code_hdr->md5_ptr = NULL;
 
     /*
      * Make stubs for all functions.
      */
 
-    ptrs = code + MI_FUNCTIONS;
-    fp = code + ci;
+    fp = code_base = (BeamInstr*) &code_hdr->functions[n+1];
     for (i = 0; i < n; i++) {
 	Eterm* listp;
 	Eterm tuple;
@@ -6313,7 +6323,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
 	 * Set the pointer and make the stub. Put a return instruction
 	 * as the body until we know what kind of trap we should put there.
 	 */
-	ptrs[i] = (BeamInstr) fp;
+	code_hdr->functions[i] = fp;
 #ifdef HIPE
 	op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */
 #else
@@ -6326,7 +6336,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
      * Insert the last pointer and the int_code_end instruction.
      */
 
-    ptrs[i] = (BeamInstr) fp;
+    code_hdr->functions[i] = fp;
     *fp++ = (BeamInstr) BeamOp(op_int_code_end);
 
     /*
@@ -6335,16 +6345,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
 
     info = (byte *) fp;
     info = stub_copy_info(stp, ATTR_CHUNK, info,
-			  code+MI_ATTR_PTR,
-			  code+MI_ATTR_SIZE,
-			  code+MI_ATTR_SIZE_ON_HEAP);
+			  &code_hdr->attr_ptr,
+			  &code_hdr->attr_size,
+			  &code_hdr->attr_size_on_heap);
     if (info == NULL) {
 	goto error;
     }
     info = stub_copy_info(stp, COMPILE_CHUNK, info,
-			  code+MI_COMPILE_PTR,
-			  code+MI_COMPILE_SIZE,
-			  code+MI_COMPILE_SIZE_ON_HEAP);
+			  &code_hdr->compile_ptr,
+			  &code_hdr->compile_size,
+			  &code_hdr->compile_size_on_heap);
     if (info == NULL) {
 	goto error;
     }
@@ -6353,7 +6363,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
       byte *md5 = NULL;
       if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) {
         sys_memcpy(info, md5, MD5_SIZE);
-        code[MI_MD5_PTR] = (BeamInstr) info;
+        code_hdr->md5_ptr = info;
       }
       erts_free_aligned_binary_bytes(tmp);
     }
@@ -6362,7 +6372,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
      * Insert the module in the module table.
      */
 
-    rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+    rval = insert_new_code(p, 0, p->group_leader, Mod, code_hdr, code_size);
     if (rval != NIL) {
 	goto error;
     }
@@ -6371,7 +6381,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
      * Export all stub functions and insert the correct type of HiPE trap.
      */
 
-    fp = code + ci;
+    fp = code_base;
     for (i = 0; i < n; i++) {
 	stub_final_touch(stp, fp);
 	fp += WORDS_PER_FUNCTION;
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index eedb5ee4cd..c86ac65521 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -24,7 +24,6 @@
 #include "beam_opcodes.h"
 #include "erl_process.h"
 
-int erts_is_module_native(BeamInstr* code);
 Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
 			    Eterm module);
 
@@ -61,63 +60,66 @@ extern BeamInstr* em_call_nif;
 
 /* Total code size in bytes */
 extern Uint erts_total_code_size;
-/*
- * Index into start of code chunks which contains additional information
- * about the loaded module.
- *
- * First number of functions.
- */
-
-#define MI_NUM_FUNCTIONS     0
-
-/*
- * The attributes retrieved by Mod:module_info(attributes).
- */
-
-#define MI_ATTR_PTR          1
-#define MI_ATTR_SIZE	     2
-#define MI_ATTR_SIZE_ON_HEAP 3
-
-/*
- * The compilation information retrieved by Mod:module_info(compile).
- */
-
-#define MI_COMPILE_PTR          4
-#define MI_COMPILE_SIZE         5
-#define MI_COMPILE_SIZE_ON_HEAP 6
-
-/*
- * Literal area (constant pool).
- */
-#define MI_LITERALS_START	7
-#define MI_LITERALS_END		8
-#define MI_LITERALS_OFF_HEAP	9
-
-/*
- * Pointer to the on_load function (or NULL if none).
- */
-#define MI_ON_LOAD_FUNCTION_PTR 10
-
-/*
- * Pointer to the line table (or NULL if none).
- */
-#define MI_LINE_TABLE 11
-
-/*
- * Pointer to the module MD5 sum (16 bytes)
- */
-#define MI_MD5_PTR 12
 
 /*
- * Start of function pointer table.  This table contains pointers to
- * all functions in the module plus an additional pointer just beyond
- * the end of the last function.
- *
- * The actual loaded code (for the first function) start just beyond
- * this table.
+ * Header of code chunks which contains additional information
+ * about the loaded module.
  */
-
-#define MI_FUNCTIONS         13
+typedef struct beam_code_header {
+    /*
+     * Number of functions.
+     */
+    UWord num_functions;
+
+    /*
+     * The attributes retrieved by Mod:module_info(attributes).
+     */
+    byte* attr_ptr;
+    UWord attr_size;
+    UWord attr_size_on_heap;
+
+    /*
+     * The compilation information retrieved by Mod:module_info(compile).
+     */
+    byte* compile_ptr;
+    UWord compile_size;
+    UWord compile_size_on_heap;
+
+    /*
+     * Literal area (constant pool).
+     */
+    Eterm* literals_start;
+    Eterm* literals_end;
+    struct erl_off_heap_header* literals_off_heap;
+
+    /*
+     * Pointer to the on_load function (or NULL if none).
+     */
+    BeamInstr* on_load_function_ptr;
+
+    /*
+     * Pointer to the line table (or NULL if none).
+     */
+    Eterm* line_table;
+
+    /*
+     * Pointer to the module MD5 sum (16 bytes)
+     */
+    byte* md5_ptr;
+
+    /*
+     * Start of function pointer table.  This table contains pointers to
+     * all functions in the module plus an additional pointer just beyond
+     * the end of the last function.
+     *
+     * The actual loaded code (for the first function) start just beyond
+     * this table.
+     */
+    BeamInstr* functions[1];
+
+}BeamCodeHeader;
+
+int erts_is_module_native(BeamCodeHeader* code);
 
 /*
  * Layout of the line table.
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index 19079ba150..e6cf43446e 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -38,7 +38,7 @@ typedef struct {
 
 static Range* find_range(BeamInstr* pc);
 static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
-		       BeamInstr* modp, int idx);
+		       BeamCodeHeader*, int idx);
 
 /*
  * The following variables keep a sorted list of address ranges for
@@ -241,6 +241,7 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
     BeamInstr** high;
     BeamInstr** mid;
     Range* rp;
+    BeamCodeHeader* hdr;
 
     fi->current = NULL;
     fi->needed = 5;
@@ -249,9 +250,10 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
     if (rp == 0) {
 	return;
     }
+    hdr = (BeamCodeHeader*) rp->start;
 
-    low = (BeamInstr **) (rp->start + MI_FUNCTIONS);
-    high = low + rp->start[MI_NUM_FUNCTIONS];
+    low = hdr->functions;
+    high = low + hdr->num_functions;
     while (low < high) {
 	mid = low + (high-low) / 2;
 	if (pc < mid[0]) {
@@ -259,10 +261,9 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
 	} else if (pc < mid[1]) {
 	    fi->current = mid[0]+2;
 	    if (full_info) {
-		BeamInstr** fp = (BeamInstr **) (rp->start +
-						 MI_FUNCTIONS);
+		BeamInstr** fp = hdr->functions;
 		int idx = mid - fp;
-		lookup_loc(fi, pc, rp->start, idx);
+		lookup_loc(fi, pc, hdr, idx);
 	    }
 	    return;
 	} else {
@@ -295,9 +296,9 @@ find_range(BeamInstr* pc)
 }
 
 static void
-lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
+lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamCodeHeader* code_hdr, int idx)
 {
-    Eterm* line = (Eterm *) modp[MI_LINE_TABLE];
+    Eterm* line = code_hdr->line_table;
     Eterm* low;
     Eterm* high;
     Eterm* mid;
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 64c8bc5e58..c7e7411935 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -381,7 +381,7 @@ loaded(int to, void *to_arg)
     int i;
     int old = 0;
     int cur = 0;
-    BeamInstr* code;
+    BeamCodeHeader* code;
     Module* modp;
     ErtsCodeIndex code_ix;
 
@@ -439,30 +439,30 @@ loaded(int to, void *to_arg)
 		erts_print(to, to_arg, "\n");
 		erts_print(to, to_arg, "Current size: %d\n",
 			   modp->curr.code_length);
-		code = modp->curr.code;
-		if (code != NULL && code[MI_ATTR_PTR]) {
+		code = modp->curr.code_hdr;
+		if (code != NULL && code->attr_ptr) {
 		    erts_print(to, to_arg, "Current attributes: ");
-		    dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
-				    code[MI_ATTR_SIZE]);
+		    dump_attributes(to, to_arg, code->attr_ptr,
+				    code->attr_size);
 		}
-		if (code != NULL && code[MI_COMPILE_PTR]) {
+		if (code != NULL && code->compile_ptr) {
 		    erts_print(to, to_arg, "Current compilation info: ");
-		    dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
-				    code[MI_COMPILE_SIZE]);
+		    dump_attributes(to, to_arg, code->compile_ptr,
+				    code->compile_size);
 		}
 
 		if (modp->old.code_length != 0) {
 		    erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length);
-		    code = modp->old.code;
-		    if (code[MI_ATTR_PTR]) {
+		    code = modp->old.code_hdr;
+		    if (code->attr_ptr) {
 			erts_print(to, to_arg, "Old attributes: ");
-			dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
-					code[MI_ATTR_SIZE]);
+			dump_attributes(to, to_arg, code->attr_ptr,
+					code->attr_size);
 		    }
-		    if (code[MI_COMPILE_PTR]) {
+		    if (code->compile_ptr) {
 			erts_print(to, to_arg, "Old compilation info: ");
-			dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
-					code[MI_COMPILE_SIZE]);
+			dump_attributes(to, to_arg, code->compile_ptr,
+					code->compile_size);
 		    }
 		}
 	    }
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index add4a66f90..01414f326d 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -2230,17 +2230,17 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
  ***************************************************************************/
 
 
-static BeamInstr** get_func_pp(BeamInstr* mod_code, Eterm f_atom, unsigned arity)
+static BeamInstr** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsigned arity)
 {
-    int n = (int) mod_code[MI_NUM_FUNCTIONS];
+    int n = (int) mod_code->num_functions;
     int j;
     for (j = 0; j < n; ++j) {
-	BeamInstr* code_ptr = (BeamInstr*) mod_code[MI_FUNCTIONS+j];
+	BeamInstr* code_ptr = (BeamInstr*) mod_code->functions[j];
 	ASSERT(code_ptr[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
 	if (f_atom == ((Eterm) code_ptr[3])
 	    && arity == ((unsigned) code_ptr[4])) {
 
-	    return (BeamInstr**) &mod_code[MI_FUNCTIONS+j];
+	    return (BeamInstr**) &mod_code->functions[j];
 	}
     }
     return NULL;
@@ -2423,8 +2423,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
     if (init_func != NULL)
       handle = init_func;
 
-    if (!in_area(caller, mod->curr.code, mod->curr.code_length)) {
-	ASSERT(in_area(caller, mod->old.code, mod->old.code_length));
+    if (!in_area(caller, mod->curr.code_hdr, mod->curr.code_length)) {
+	ASSERT(in_area(caller, mod->old.code_hdr, mod->old.code_length));
 
 	ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old "
 			     "module '%T' not allowed", mod_atom);
@@ -2478,7 +2478,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
 	for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
 	    BeamInstr** code_pp;
 	    if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1)
-		|| (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) {
+		|| (code_pp = get_func_pp(mod->curr.code_hdr, f_atom, f->arity))==NULL) {
 		ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u",
 				     mod_atom, f->name, f->arity);
 	    }
@@ -2621,7 +2621,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
 	{
 	    BeamInstr* code_ptr;
 	    erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1);
-	    code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity);
+	    code_ptr = *get_func_pp(mod->curr.code_hdr, f_atom, f->arity);
 
 	    if (code_ptr[1] == 0) {
 		code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif);
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index 86dd3b5aac..f6794c012f 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -74,8 +74,8 @@ static Module* module_alloc(Module* tmpl)
     erts_smp_atomic_add_nob(&tot_module_bytes, sizeof(Module));
 
     obj->module = tmpl->module;
-    obj->curr.code = 0;
-    obj->old.code = 0;
+    obj->curr.code_hdr = 0;
+    obj->old.code_hdr = 0;
     obj->curr.code_length = 0;
     obj->old.code_length = 0;
     obj->slot.index = -1;
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index c8a6351b04..e66d628ca9 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -26,7 +26,7 @@
 #endif
 
 struct erl_module_instance {
-    BeamInstr* code;
+    BeamCodeHeader* code_hdr;
     int code_length;		/* Length of loaded code in bytes. */
     unsigned catches;
     struct erl_module_nif* nif;
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index 7193c3d301..c6ea8a5132 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -574,15 +574,15 @@ static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
 static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
 {
     Module *modp;
-    Uint *code_base;
+    BeamCodeHeader* code_hdr;
     int i, n;
 
     modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL || (code_base = modp->curr.code) == NULL)
+    if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL)
 	return NULL;
-    n = code_base[MI_NUM_FUNCTIONS];
+    n = code_hdr->num_functions;
     for (i = 0; i < n; ++i) {
-	Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i];
+	Uint *code_ptr = (Uint*)code_hdr->functions[i];
 	ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
 	if (code_ptr[3] == name && code_ptr[4] == arity)
 	    return code_ptr+5;
-- 
cgit v1.2.3


From ec4a7e7150c47523a553cac806c86ec08ab2dae7 Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Wed, 16 Sep 2015 15:02:19 +0200
Subject: Refactor GC

---
 erts/emulator/beam/erl_gc.c | 620 ++++++++++++++++++++++----------------------
 erts/emulator/beam/sys.h    |  37 ++-
 2 files changed, 334 insertions(+), 323 deletions(-)

diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index e316ab95ab..2d7b7cafa4 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -42,11 +42,76 @@
 #include "dtrace-wrapper.h"
 #include "erl_bif_unique.h"
 
+#define ERTS_CONTINUOUS_NEW_HEAP
+
 #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1
 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20
 #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10
 #define ERTS_INACT_WR_PB_LEAVE_PERCENTAGE 10
 
+#if defined(DEBUG) || 0
+#define ERTS_GC_DEBUG
+#else
+#undef ERTS_GC_DEBUG
+#endif
+#ifdef ERTS_GC_DEBUG
+#  define ERTS_GC_ASSERT ASSERT
+#else
+#  define ERTS_GC_ASSERT(B) ((void) 1)
+#endif
+
+#ifdef ERTS_CONTINUOUS_NEW_HEAP
+#define ERTS_IS_NEW_HEAP_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    ErtsInArea((Ptr), (NhPtr), (NhSz))
+#define ERTS_IS_LITERAL_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (!ErtsInArea((Ptr), (NhPtr), (NhSz))				\
+     && !ErtsInArea((Ptr), (OhPtr), (OhSz)))
+
+#ifdef ERTS_GC_DEBUG
+#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \
+     ? (ERTS_GC_ASSERT(!erts_is_literal((TPtr), (Ptr))			\
+		       && !ErtsInArea((Ptr), (OhPtr), (OhSz))), 1)	\
+     : (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr))			\
+		       || ErtsInArea((Ptr), (OhPtr), (OhSz))), 0))
+#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \
+     ? (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr))), 1)		\
+     : (ERTS_GC_ASSERT(!erts_is_literal((TPtr), (Ptr))), 0))
+#endif
+
+#else
+
+#define ERTS_IS_NEW_HEAP_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (!erts_is_literal((TPtr), (Ptr)) && !ErtsInArea((Ptr), (OhPtr), (OhSz)))
+#define ERTS_IS_LITERAL_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (erts_is_literal((TPtr), (Ptr)))
+
+#ifdef ERTS_GC_DEBUG
+#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \
+     ? (ERTS_GC_ASSERT(ErtsInArea((Ptr), (NhPtr), (NhSz))), 1)		\
+     : (ERTS_GC_ASSERT(!ErtsInArea((Ptr), (NhPtr), (NhSz))), 0))
+#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    (ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \
+     ? (ERTS_GC_ASSERT(!ErtsInArea((Ptr), (NhPtr), (NhSz))		\
+		       && !ErtsInArea((Ptr), (OhPtr), (OhSz))), 1)	\
+     : (ERTS_GC_ASSERT(ErtsInArea((Ptr), (NhPtr), (NhSz))		\
+		       || ErtsInArea((Ptr), (OhPtr), (OhSz))), 0))
+#endif
+
+#endif
+
+#ifndef ERTS_IS_NEW_HEAP_PTR
+#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz))
+#endif
+
+#ifndef ERTS_IS_LITERAL_PTR
+#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz)	\
+    ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz))
+#endif
+
 /*
  * Returns number of elements in an array.
  */
@@ -100,13 +165,27 @@ static Uint setup_rootset(Process*, Eterm*, int, Rootset*);
 static void cleanup_rootset(Rootset *rootset);
 static Uint combined_message_size(Process* p);
 static void remove_message_buffers(Process* p);
+static Eterm *full_sweep_heaps(Process *p,
+			       int hibernate,
+			       Eterm *n_heap, Eterm* n_htop,
+			       char *h, Uint h_size,
+			       char *oh, Uint oh_size,
+			       Eterm *objv, int nobj);
 static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
 static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
 static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj);
-static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size);
-static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size);
-static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
-			     char* src, Uint src_size);
+static Eterm *sweep_new_heap(Eterm *n_hp, Eterm *n_htop,
+			     char* new_heap, Uint new_heap_size,
+			     char* old_heap, Uint old_heap_size);
+static Eterm *sweep_heaps(Eterm *n_hp, Eterm *n_htop,
+			  char* new_heap, Uint new_heap_size,
+			  char* old_heap, Uint old_heap_size);
+static Eterm* sweep_literal_area(Eterm* n_hp, Eterm* n_htop,
+				    char* new_heap, Uint new_heap_size,
+				    char* old_heap, Uint old_heap_size,
+				    char* src, Uint src_size);
+static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+					 char* src, Uint src_size);
 static Eterm* collect_heap_frags(Process* p, Eterm* heap,
 				 Eterm* htop, Eterm* objv, int nobj);
 static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj);
@@ -514,9 +593,6 @@ erts_garbage_collect_hibernate(Process* p)
     Uint heap_size;
     Eterm* heap;
     Eterm* htop;
-    Rootset rootset;
-    char* src;
-    Uint src_size;
     Uint actual_size;
     char* area;
     Uint area_size;
@@ -544,41 +620,16 @@ erts_garbage_collect_hibernate(Process* p)
 				    sizeof(Eterm)*heap_size);
     htop = heap;
 
-    (void) setup_rootset(p, p->arg_reg, p->arity, &rootset);
-#if HIPE
-    hipe_empty_nstack(p);
-#endif
-
-    src = (char *) p->heap;
-    src_size = (char *) p->htop - src;
-    htop = sweep_rootset(&rootset, htop, src, src_size);
-    htop = sweep_one_area(heap, htop, src, src_size);
-
-    if (p->old_heap) {
-	src = (char *) p->old_heap;
-	src_size = (char *) p->old_htop - src;
-	htop = sweep_rootset(&rootset, htop, src, src_size);
-	htop = sweep_one_area(heap, htop, src, src_size);
-    }
-
-    cleanup_rootset(&rootset);
-
-    if (MSO(p).first) {
-        sweep_off_heap(p, 1);
-    }
-
-    /*
-     *  Update all pointers.
-     */
-    ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
-		   (void*)HEAP_START(p),
-		   HEAP_SIZE(p) * sizeof(Eterm));
-    if (p->old_heap) {
-	ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP,
-		       (void*)p->old_heap,
-		       (p->old_hend - p->old_heap) * sizeof(Eterm));
-	p->old_heap = p->old_htop = p->old_hend = 0;
-    }
+    htop = full_sweep_heaps(p,
+			    1,
+			    heap,
+			    htop,
+			    (char *) p->heap,
+			    (char *) p->htop - (char *) p->heap,
+			    (char *) p->old_heap,
+			    (char *) p->old_htop - (char *) p->old_heap,
+			    p->arg_reg,
+			    p->arity);
 
     p->heap = heap;
     p->high_water = htop;
@@ -724,7 +775,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
                 if (IS_MOVED_BOXED(val)) {
 		    ASSERT(is_boxed(val));
                     *g_ptr++ = val;
-		} else if (in_area(ptr, area, area_size)) {
+		} else if (ErtsInArea(ptr, area, area_size)) {
                     MOVE_BOXED(ptr,val,old_htop,g_ptr++);
 		} else {
 		    g_ptr++;
@@ -735,7 +786,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
                 val = *ptr;
                 if (IS_MOVED_CONS(val)) { /* Moved */
                     *g_ptr++ = ptr[1];
-		} else if (in_area(ptr, area, area_size)) {
+		} else if (ErtsInArea(ptr, area, area_size)) {
                     MOVE_CONS(ptr,val,old_htop,g_ptr++);
                 } else {
 		    g_ptr++;
@@ -755,8 +806,11 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
      * Now we'll have to go through all heaps updating all other references.
      */
 
-    old_htop = sweep_one_heap(p->heap, p->htop, old_htop, area, area_size);
-    old_htop = sweep_one_area(p->old_heap, old_htop, area, area_size);
+    old_htop = sweep_literals_to_old_heap(p->heap, p->htop, old_htop, area, area_size);
+    old_htop = sweep_literal_area(p->old_heap, old_htop,
+				  (char *) p->heap, sizeof(Eterm)*p->heap_sz,
+				  (char *) p->old_heap, sizeof(Eterm)*old_heap_size,
+				  area, area_size);
     ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend);
     p->old_htop = old_htop;
 
@@ -1034,15 +1088,13 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
                 if (IS_MOVED_BOXED(val)) {
 		    ASSERT(is_boxed(val));
                     *g_ptr++ = val;
-                } else if (in_area(ptr, heap, mature_size)) {
+                } else if (ErtsInArea(ptr, heap, mature_size)) {
                     MOVE_BOXED(ptr,val,old_htop,g_ptr++);
-                } else if (in_area(ptr, heap, heap_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr)
-			   && !in_area(ptr, oh, oh_size));
+                } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr,
+						heap, heap_size,
+						oh, oh_size)) {
                     MOVE_BOXED(ptr,val,n_htop,g_ptr++);
                 } else {
-		    ASSERT(erts_is_literal(gval, ptr)
-			   || in_area(ptr, oh, oh_size));
 		    g_ptr++;
 		}
                 break;
@@ -1053,15 +1105,13 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
                 val = *ptr;
                 if (IS_MOVED_CONS(val)) { /* Moved */
                     *g_ptr++ = ptr[1];
-                } else if (in_area(ptr, heap, mature_size)) {
+                } else if (ErtsInArea(ptr, heap, mature_size)) {
                     MOVE_CONS(ptr,val,old_htop,g_ptr++);
-                } else if (in_area(ptr, heap, heap_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr)
-			   && !in_area(ptr, oh, oh_size));
+                } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr,
+						heap, heap_size,
+						oh, oh_size)) {
                     MOVE_CONS(ptr,val,n_htop,g_ptr++);
                 } else {
-		    ASSERT(erts_is_literal(gval, ptr)
-			   || in_area(ptr, oh, oh_size));
 		    g_ptr++;
 		}
 		break;
@@ -1084,7 +1134,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
      */
 
     if (mature_size == 0) {
-	n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size);
+	n_htop = sweep_new_heap(n_heap, n_htop, heap, heap_size,
+				oh, oh_size);
     } else {
 	Eterm* n_hp = n_heap;
 	Eterm* ptr;
@@ -1101,15 +1152,13 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 		if (IS_MOVED_BOXED(val)) {
 		    ASSERT(is_boxed(val));
 		    *n_hp++ = val;
-		} else if (in_area(ptr, heap, mature_size)) {
+		} else if (ErtsInArea(ptr, heap, mature_size)) {
 		    MOVE_BOXED(ptr,val,old_htop,n_hp++);
-		} else if (in_area(ptr, heap, heap_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr)
-			   && !in_area(ptr, oh, oh_size));
+		} else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr,
+						heap, heap_size,
+						oh, oh_size)) {
 		    MOVE_BOXED(ptr,val,n_htop,n_hp++);
 		} else {
-		    ASSERT(erts_is_literal(gval, ptr)
-			   || in_area(ptr, oh, oh_size));
 		    n_hp++;
 		}
 		break;
@@ -1119,15 +1168,13 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 		val = *ptr;
 		if (IS_MOVED_CONS(val)) {
 		    *n_hp++ = ptr[1];
-		} else if (in_area(ptr, heap, mature_size)) {
+		} else if (ErtsInArea(ptr, heap, mature_size)) {
 		    MOVE_CONS(ptr,val,old_htop,n_hp++);
-		} else if (in_area(ptr, heap, heap_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr)
-			   && !in_area(ptr, oh, oh_size));
+		} else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr,
+						heap, heap_size,
+						oh, oh_size)) {
 		    MOVE_CONS(ptr,val,n_htop,n_hp++);
 		} else {
-		    ASSERT(erts_is_literal(gval, ptr)
-			   || in_area(ptr, oh, oh_size));
 		    n_hp++;
 		}
 		break;
@@ -1145,19 +1192,15 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 			if (IS_MOVED_BOXED(val)) {
 			    *origptr = val;
 			    mb->base = binary_bytes(val);
-			} else if (in_area(ptr, heap, mature_size)) {
+			} else if (ErtsInArea(ptr, heap, mature_size)) {
 			    MOVE_BOXED(ptr,val,old_htop,origptr);
 			    mb->base = binary_bytes(mb->orig);
-			} else if (in_area(ptr, heap, heap_size)) {
-			    ASSERT(!erts_is_literal(*origptr, origptr)
-				   && !in_area(ptr, oh, oh_size));
+			} else if (ERTS_IS_NEW_HEAP_PTR(*origptr, ptr,
+							heap, heap_size,
+							oh, oh_size)) {
 			    MOVE_BOXED(ptr,val,n_htop,origptr);
 			    mb->base = binary_bytes(mb->orig);
 			}
-			else {
-			    ASSERT(erts_is_literal(*origptr, origptr)
-				   || in_area(ptr, oh, oh_size));
-			}
 		    }
 		    n_hp += (thing_arityval(gval)+1);
 		}
@@ -1176,7 +1219,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
      */
 
     if (OLD_HTOP(p) < old_htop) {
-	old_htop = sweep_one_area(OLD_HTOP(p), old_htop, heap, heap_size);
+	old_htop = sweep_new_heap(OLD_HTOP(p), old_htop,
+				  heap, heap_size,
+				  oh, oh_size);
     }
     OLD_HTOP(p) = old_htop;
     HIGH_WATER(p) = n_htop;
@@ -1229,8 +1274,6 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
 static int
 major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 {
-    Rootset rootset;
-    Roots* roots;
     const Uint size_before = ((HEAP_TOP(p) - HEAP_START(p))
                               + (OLD_HTOP(p) - OLD_HEAP(p))
                               + MBUF_SIZE(p));
@@ -1240,8 +1283,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
     Uint src_size = (char *) HEAP_TOP(p) - src;
     char* oh = (char *) OLD_HEAP(p);
     Uint oh_size = (char *) OLD_HTOP(p) - oh;
-    Uint n;
-    Uint new_sz;
+    Uint new_sz, stk_sz;
 
     /*
      * Do a fullsweep GC. First figure out the size of the heap
@@ -1272,13 +1314,93 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 	n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
     }
 
+    n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, src, src_size,
+			      oh, oh_size, objv, nobj);
+
+    /* Move the stack to the end of the heap */
+    stk_sz = HEAP_END(p) - p->stop;
+    sys_memcpy(n_heap + new_sz - stk_sz, p->stop, stk_sz * sizeof(Eterm));
+    p->stop = n_heap + new_sz - stk_sz;
+
+#ifdef USE_VM_PROBES
+    if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
+        DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
+
+        dtrace_proc_str(p, pidbuf);
+        DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
+    }
+#endif
+
+    ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
+		   (void *) HEAP_START(p),
+		   (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm));
+    HEAP_START(p) = n_heap;
+    HEAP_TOP(p) = n_htop;
+    HEAP_SIZE(p) = new_sz;
+    HEAP_END(p) = n_heap + new_sz;
+    GEN_GCS(p) = 0;
+
+    HIGH_WATER(p) = HEAP_TOP(p);
+
+    ErtsGcQuickSanityCheck(p);
+
+    *recl += size_before - (HEAP_TOP(p) - HEAP_START(p));
+
+    {
+	ErlMessage *msgp;
+
+	/*
+	 * Copy newly received message onto the end of the new heap.
+	 */
+        for (msgp = p->msg.first; msgp; msgp = msgp->next) {
+	    if (msgp->data.attached) {
+                ErtsHeapFactory factory;
+                erts_factory_proc_prealloc_init(&factory, p,
+                                                erts_msg_attached_data_size(msgp));
+		erts_move_msg_attached_data_to_heap(&factory, msgp);
+                erts_factory_close(&factory);
+		ErtsGcQuickSanityCheck(p);
+	    }
+	}
+    }
+
+    adjust_after_fullsweep(p, need, objv, nobj);
+
+#ifdef HARDDEBUG
+    disallow_heap_frag_ref_in_heap(p);
+#endif
+    remove_message_buffers(p);
+
+    ErtsGcQuickSanityCheck(p);
+    return 1;			/* We are done. */
+}
+
+static Eterm *
+full_sweep_heaps(Process *p,
+		 int hibernate,
+		 Eterm *n_heap, Eterm* n_htop,
+		 char *h, Uint h_size,
+		 char *oh, Uint oh_size,
+		 Eterm *objv, int nobj)
+{
+    Rootset rootset;
+    Roots *roots;
+    Uint n;
+
     /*
      * Copy all top-level terms directly referenced by the rootset to
      * the new new_heap.
      */
 
     n = setup_rootset(p, objv, nobj, &rootset);
-    n_htop = fullsweep_nstack(p, n_htop);
+
+#ifdef HIPE
+    if (hibernate)
+	hipe_empty_nstack(p);
+    else
+	n_htop = fullsweep_nstack(p, n_htop);
+#endif
+
     roots = rootset.roots;
     while (n--) {
 	Eterm* g_ptr = roots->v;
@@ -1298,11 +1420,11 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		if (IS_MOVED_BOXED(val)) {
 		    ASSERT(is_boxed(val));
 		    *g_ptr++ = val;
-		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr));
+		} else if (!ERTS_IS_LITERAL_PTR(gval, ptr,
+						h, h_size,
+						oh, oh_size)) {
 		    MOVE_BOXED(ptr,val,n_htop,g_ptr++);
 		} else {
-		    ASSERT(erts_is_literal(gval, ptr));
 		    g_ptr++;
 		}
 		continue;
@@ -1313,11 +1435,11 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 		val = *ptr;
 		if (IS_MOVED_CONS(val)) {
 		    *g_ptr++ = ptr[1];
-		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr));
+		} else if (!ERTS_IS_LITERAL_PTR(gval, ptr,
+						h, h_size,
+						oh, oh_size)) {
 		    MOVE_CONS(ptr,val,n_htop,g_ptr++);
 		} else {
-		    ASSERT(erts_is_literal(gval, ptr));
 		    g_ptr++;
 		}
 		continue;
@@ -1340,82 +1462,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
      * until all is copied.
      */
 
-    if (oh_size == 0) {
-	n_htop = sweep_one_area(n_heap, n_htop, src, src_size);
-    } else {
-	Eterm* n_hp = n_heap;
-
-	while (n_hp != n_htop) {
-	    Eterm* ptr;
-	    Eterm val;
-	    Eterm gval = *n_hp;
-
-	    switch (primary_tag(gval)) {
-	    case TAG_PRIMARY_BOXED: {
-		ptr = boxed_val(gval);
-		val = *ptr;
-		if (IS_MOVED_BOXED(val)) {
-		    ASSERT(is_boxed(val));
-		    *n_hp++ = val;
-		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr));
-		    MOVE_BOXED(ptr,val,n_htop,n_hp++);
-		} else {
-		    ASSERT(erts_is_literal(gval, ptr));
-		    n_hp++;
-		}
-		break;
-	    }
-	    case TAG_PRIMARY_LIST: {
-		ptr = list_val(gval);
-		val = *ptr;
-		if (IS_MOVED_CONS(val)) {
-		    *n_hp++ = ptr[1];
-		} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
-		    ASSERT(!erts_is_literal(gval, ptr));
-		    MOVE_CONS(ptr,val,n_htop,n_hp++);
-		} else {
-		    ASSERT(erts_is_literal(gval, ptr));
-		    n_hp++;
-		}
-		break;
-	    }
-	    case TAG_PRIMARY_HEADER: {
-		if (!header_is_thing(gval))
-		    n_hp++;
-		else {
-		    if (header_is_bin_matchstate(gval)) {
-			ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
-			ErlBinMatchBuffer *mb = &(ms->mb);
-			Eterm* origptr;	
-			origptr = &(mb->orig);
-			ptr = boxed_val(*origptr);
-			val = *ptr;
-			if (IS_MOVED_BOXED(val)) {
-			    *origptr = val;
-			    mb->base = binary_bytes(*origptr);
-			} else if (in_area(ptr, src, src_size) ||
--				   in_area(ptr, oh, oh_size)) {
-			    ASSERT(!erts_is_literal(*origptr, origptr));
-			    MOVE_BOXED(ptr,val,n_htop,origptr); 
-			    mb->base = binary_bytes(*origptr);
-			    ptr = boxed_val(*origptr);
-			    val = *ptr;
-			}
-			else {
-			    ASSERT(erts_is_literal(*origptr, origptr));
-			}
-		    }
-		    n_hp += (thing_arityval(gval)+1);
-		}
-		break;
-	    }
-	    default:
-		n_hp++;
-		break;
-	    }
-	}
-    }
+    n_htop = sweep_heaps(n_heap, n_htop, h, h_size, oh, oh_size);
 
     if (MSO(p).first) {
 	sweep_off_heap(p, 1);
@@ -1428,62 +1475,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
 	OLD_HEAP(p) = OLD_HTOP(p) = OLD_HEND(p) = NULL;
     }
 
-    /* Move the stack to the end of the heap */
-    n = HEAP_END(p) - p->stop;
-    sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm));
-    p->stop = n_heap + new_sz - n;
-
-#ifdef USE_VM_PROBES
-    if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
-        DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
-
-        dtrace_proc_str(p, pidbuf);
-        DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
-    }
-#endif
-
-    ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
-		   (void *) HEAP_START(p),
-		   (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm));
-    HEAP_START(p) = n_heap;
-    HEAP_TOP(p) = n_htop;
-    HEAP_SIZE(p) = new_sz;
-    HEAP_END(p) = n_heap + new_sz;
-    GEN_GCS(p) = 0;
-
-    HIGH_WATER(p) = HEAP_TOP(p);
-
-    ErtsGcQuickSanityCheck(p);
-
-    *recl += size_before - (HEAP_TOP(p) - HEAP_START(p));
-
-    {
-	ErlMessage *msgp;
-
-	/*
-	 * Copy newly received message onto the end of the new heap.
-	 */
-        for (msgp = p->msg.first; msgp; msgp = msgp->next) {
-	    if (msgp->data.attached) {
-                ErtsHeapFactory factory;
-                erts_factory_proc_prealloc_init(&factory, p,
-                                                erts_msg_attached_data_size(msgp));
-		erts_move_msg_attached_data_to_heap(&factory, msgp);
-                erts_factory_close(&factory);
-		ErtsGcQuickSanityCheck(p);
-	    }
-	}
-    }
-
-    adjust_after_fullsweep(p, need, objv, nobj);
-
-#ifdef HARDDEBUG
-    disallow_heap_frag_ref_in_heap(p);
-#endif
-    remove_message_buffers(p);
-
-    ErtsGcQuickSanityCheck(p);
-    return 1;			/* We are done. */
+    return n_htop;
 }
 
 static void
@@ -1585,7 +1577,7 @@ disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
 		objv++;
 	    } else {
  		for (qb = mbuf; qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1601,7 +1593,7 @@ disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
 		objv++;
 	    } else {
 		for (qb = mbuf; qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1644,9 +1636,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
 	switch (primary_tag(val)) {
 	case TAG_PRIMARY_BOXED:
 	    ptr = _unchecked_boxed_val(val);
-	    if (!in_area(ptr, heap, heap_size)) {
+	    if (!ErtsInArea(ptr, heap, heap_size)) {
 		for (qb = MBUF(p); qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1654,9 +1646,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
 	    break;
 	case TAG_PRIMARY_LIST:
 	    ptr = _unchecked_list_val(val);
-	    if (!in_area(ptr, heap, heap_size)) {
+	    if (!ErtsInArea(ptr, heap, heap_size)) {
 		for (qb = MBUF(p); qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1699,12 +1691,12 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
 	switch (primary_tag(val)) {
 	case TAG_PRIMARY_BOXED:
 	    ptr = (Eterm *) val;
-	    if (!in_area(ptr, old_heap, old_heap_size)) {
-		if (in_area(ptr, new_heap, new_heap_size)) {
+	    if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+		if (ErtsInArea(ptr, new_heap, new_heap_size)) {
 		    abort();
 		}
 		for (qb = MBUF(p); qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1712,12 +1704,12 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
 	    break;
 	case TAG_PRIMARY_LIST:
 	    ptr = (Eterm *) val;
-	    if (!in_area(ptr, old_heap, old_heap_size)) {
-		if (in_area(ptr, new_heap, new_heap_size)) {
+	    if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+		if (ErtsInArea(ptr, new_heap, new_heap_size)) {
 		    abort();
 		}
 		for (qb = MBUF(p); qb != NULL; qb = qb->next) {
-		    if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+		    if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
 			abort();
 		    }
 		}
@@ -1726,7 +1718,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
 	case TAG_PRIMARY_HEADER:
 	    if (header_is_thing(val)) {
 		hp += _unchecked_thing_arityval(val);
-		if (!in_area(hp, old_heap, old_heap_size+1)) {
+		if (!ErtsInArea(hp, old_heap, old_heap_size+1)) {
 		    abort();
 		}
 	    }
@@ -1736,66 +1728,35 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
 }
 #endif
 
-static Eterm*
-sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
+typedef enum {
+    ErtsSweepNewHeap,
+    ErtsSweepHeaps,
+    ErtsSweepLiteralArea
+} ErtsSweepType;
+
+static ERTS_FORCE_INLINE Eterm *
+sweep(Eterm *n_hp, Eterm *n_htop,
+      ErtsSweepType type,
+      char *h, Uint hsz,
+      char *oh, Uint ohsz,
+      char *src, Uint src_size)
 {
-    Roots* roots = rootset->roots;
-    Uint n = rootset->num_roots;
     Eterm* ptr;
-    Eterm gval;
     Eterm val;
+    Eterm gval;
 
-    while (n--) {
-        Eterm* g_ptr = roots->v;
-        Uint g_sz = roots->sz;
-
-	roots++;
-        while (g_sz--) {
-            gval = *g_ptr;
-
-            switch (primary_tag(gval)) {
-	    case TAG_PRIMARY_BOXED: {
-		ptr = boxed_val(gval);
-                val = *ptr;
-                if (IS_MOVED_BOXED(val)) {
-		    ASSERT(is_boxed(val));
-                    *g_ptr++ = val;
-                } else if (in_area(ptr, src, src_size)) {
-                    MOVE_BOXED(ptr,val,htop,g_ptr++);
-                } else {
-		    g_ptr++;
-		}
-                break;
-	    }
-	    case TAG_PRIMARY_LIST: {
-                ptr = list_val(gval);
-                val = *ptr;
-                if (IS_MOVED_CONS(val)) {
-                    *g_ptr++ = ptr[1];
-                } else if (in_area(ptr, src, src_size)) {
-                    MOVE_CONS(ptr,val,htop,g_ptr++);
-                } else {
-		    g_ptr++;
-		}
-		break;
-	    }
-
-	    default:
-                g_ptr++;
-		break;
-            }
-        }
-    }
-    return htop;
-}
-
+#undef ERTS_IS_IN_SWEEP_AREA
 
-static Eterm*
-sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
-{
-    Eterm* ptr;
-    Eterm val;
-    Eterm gval;
+#define ERTS_IS_IN_SWEEP_AREA(TPtr, Ptr)				\
+    (type == ErtsSweepHeaps						\
+     ? !ERTS_IS_LITERAL_PTR((TPtr), (Ptr), h, hsz, oh, ohsz)		\
+     : (type == ErtsSweepNewHeap					\
+	? ERTS_IS_NEW_HEAP_PTR((TPtr), (Ptr), h, hsz, oh, ohsz)		\
+	: (ErtsInArea((Ptr), src, src_size)				\
+	   ? (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr))		\
+			     && !ErtsInArea((Ptr), h, hsz)		\
+			     && !ErtsInArea((Ptr), oh, ohsz)), 1)	\
+	   : 0)))
 
     while (n_hp != n_htop) {
 	ASSERT(n_hp < n_htop);
@@ -1807,7 +1768,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
 	    if (IS_MOVED_BOXED(val)) {
 		ASSERT(is_boxed(val));
 		*n_hp++ = val;
-	    } else if (in_area(ptr, src, src_size)) {
+	    } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
 		MOVE_BOXED(ptr,val,n_htop,n_hp++);
 	    } else {
 		n_hp++;
@@ -1819,7 +1780,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
 	    val = *ptr;
 	    if (IS_MOVED_CONS(val)) {
 		*n_hp++ = ptr[1];
-	    } else if (in_area(ptr, src, src_size)) {
+	    } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
 		MOVE_CONS(ptr,val,n_htop,n_hp++);
 	    } else {
 		n_hp++;
@@ -1840,7 +1801,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
 		    if (IS_MOVED_BOXED(val)) {
 			*origptr = val;
 			mb->base = binary_bytes(*origptr);
-		    } else if (in_area(ptr, src, src_size)) {
+		    } else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) {
 			MOVE_BOXED(ptr,val,n_htop,origptr); 
 			mb->base = binary_bytes(*origptr);
 		    }
@@ -1855,10 +1816,49 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
 	}
     }
     return n_htop;
+#undef ERTS_IS_IN_SWEEP_AREA
+}
+
+static Eterm *
+sweep_new_heap(Eterm *n_hp, Eterm *n_htop,
+	       char* new_heap, Uint new_heap_size,
+	       char* old_heap, Uint old_heap_size)
+{
+    return sweep(n_hp, n_htop,
+		 ErtsSweepNewHeap,
+		 new_heap, new_heap_size,
+		 old_heap, old_heap_size,
+		 NULL, 0);
+}
+
+static Eterm *
+sweep_heaps(Eterm *n_hp, Eterm *n_htop,
+	    char* new_heap, Uint new_heap_size,
+	    char* old_heap, Uint old_heap_size)
+{
+    return sweep(n_hp, n_htop,
+		 ErtsSweepHeaps,
+		 new_heap, new_heap_size,
+		 old_heap, old_heap_size,
+		 NULL, 0);
+}
+
+static Eterm *
+sweep_literal_area(Eterm *n_hp, Eterm *n_htop,
+		   char* new_heap, Uint new_heap_size,
+		   char* old_heap, Uint old_heap_size,
+		   char* src, Uint src_size)
+{
+    return sweep(n_hp, n_htop,
+		 ErtsSweepLiteralArea,
+		 new_heap, new_heap_size,
+		 old_heap, old_heap_size,
+		 src, src_size);
 }
 
 static Eterm*
-sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size)
+sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+			   char* src, Uint src_size)
 {
     while (heap_ptr < heap_end) {
 	Eterm* ptr;
@@ -1872,7 +1872,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
 	    if (IS_MOVED_BOXED(val)) {
 		ASSERT(is_boxed(val));
 		*heap_ptr++ = val;
-	    } else if (in_area(ptr, src, src_size)) {
+	    } else if (ErtsInArea(ptr, src, src_size)) {
 		MOVE_BOXED(ptr,val,htop,heap_ptr++);
 	    } else {
 		heap_ptr++;
@@ -1884,7 +1884,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
 	    val = *ptr;
 	    if (IS_MOVED_CONS(val)) {
 		*heap_ptr++ = ptr[1];
-	    } else if (in_area(ptr, src, src_size)) {
+	    } else if (ErtsInArea(ptr, src, src_size)) {
 		MOVE_CONS(ptr,val,htop,heap_ptr++);
 	    } else {
 		heap_ptr++;
@@ -1905,7 +1905,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
 		    if (IS_MOVED_BOXED(val)) {
 			*origptr = val;
 			mb->base = binary_bytes(*origptr);
-		    } else if (in_area(ptr, src, src_size)) {
+		    } else if (ErtsInArea(ptr, src, src_size)) {
 			MOVE_BOXED(ptr,val,htop,origptr);
 			mb->base = binary_bytes(*origptr);
 		    }
@@ -2340,11 +2340,11 @@ sweep_off_heap(Process *p, int fullsweep)
      */
     while (ptr) {
 	if (IS_MOVED_BOXED(ptr->thing_word)) {
-	    ASSERT(!in_area(ptr, oheap, oheap_sz));
+	    ASSERT(!ErtsInArea(ptr, oheap, oheap_sz));
 	    *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word);
 	    ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
 	    if (ptr->thing_word == HEADER_PROC_BIN) {
-		int to_new_heap = !in_area(ptr, oheap, oheap_sz);
+		int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz);
 		ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1)));
 		if (to_new_heap) {
 		    bin_vheap += ptr->size / sizeof(Eterm);
@@ -2358,7 +2358,7 @@ sweep_off_heap(Process *p, int fullsweep)
 		ptr = ptr->next;
 	    }
 	}
-	else if (!in_area(ptr, oheap, oheap_sz)) {
+	else if (!ErtsInArea(ptr, oheap, oheap_sz)) {
 	    /* garbage */
 	    switch (thing_subtag(ptr->thing_word)) {
 	    case REFC_BINARY_SUBTAG:
@@ -2390,7 +2390,7 @@ sweep_off_heap(Process *p, int fullsweep)
      * generational collection - keep objects in list.
      */
     while (ptr) {
-	ASSERT(in_area(ptr, oheap, oheap_sz));
+	ASSERT(ErtsInArea(ptr, oheap, oheap_sz));
 	ASSERT(!IS_MOVED_BOXED(ptr->thing_word));       
 	if (ptr->thing_word == HEADER_PROC_BIN) {
 	    BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/
@@ -2480,7 +2480,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
 	switch (primary_tag(val)) {
 	  case TAG_PRIMARY_LIST:
 	  case TAG_PRIMARY_BOXED:
-	      if (in_area(ptr_val(val), area, area_size)) {
+	      if (ErtsInArea(ptr_val(val), area, area_size)) {
 		  *hp = offset_ptr(val, offs);
 	      }
 	      hp++;
@@ -2502,7 +2502,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
 		  {
 		      struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp;
 
-		      if (in_area(oh->next, area, area_size)) {
+		      if (ErtsInArea(oh->next, area, area_size)) {
 			  Eterm** uptr = (Eterm **) (void *) &oh->next;
 			  *uptr += offs; /* Patch the mso chain */
 		      }
@@ -2512,7 +2512,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
 		{	
 		  ErlBinMatchState *ms = (ErlBinMatchState*) hp;
 		  ErlBinMatchBuffer *mb = &(ms->mb);
-		  if (in_area(ptr_val(mb->orig), area, area_size)) {
+		  if (ErtsInArea(ptr_val(mb->orig), area, area_size)) {
 		      mb->orig = offset_ptr(mb->orig, offs);
 		      mb->base = binary_bytes(mb->orig);
 		  }
@@ -2542,7 +2542,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
 	switch (primary_tag(val)) {
 	case TAG_PRIMARY_LIST:
 	case TAG_PRIMARY_BOXED:
-	    if (in_area(ptr_val(val), area, area_size)) {
+	    if (ErtsInArea(ptr_val(val), area, area_size)) {
 		*hp = offset_ptr(val, offs);
 	    }
 	    hp++;
@@ -2557,7 +2557,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
 static void
 offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
 {
-    if (MSO(p).first && in_area((Eterm *)MSO(p).first, area, area_size)) {
+    if (MSO(p).first && ErtsInArea((Eterm *)MSO(p).first, area, area_size)) {
         Eterm** uptr = (Eterm**) (void *) &MSO(p).first;
         *uptr += offs;
     }
@@ -2577,19 +2577,19 @@ offset_mqueue(Process *p, Sint offs, char* area, Uint area_size)
 	    switch (primary_tag(mesg)) {
 	    case TAG_PRIMARY_LIST:
 	    case TAG_PRIMARY_BOXED:
-		if (in_area(ptr_val(mesg), area, area_size)) {
+		if (ErtsInArea(ptr_val(mesg), area, area_size)) {
 		    ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
 		}
 		break;
 	    }
 	}
 	mesg = ERL_MESSAGE_TOKEN(mp);
-	if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
+	if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
 	    ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
         }
 #ifdef USE_VM_PROBES
 	mesg = ERL_MESSAGE_DT_UTAG(mp);
-	if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
+	if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
 	    ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
         }
 #endif	
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index d63e81cb5e..5db7ee6d7c 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -21,6 +21,19 @@
 #ifndef __SYS_H__
 #define __SYS_H__
 
+#if !defined(__GNUC__)
+#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
+#elif !defined(__GNUC_MINOR__)
+#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+  ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#elif !defined(__GNUC_PATCHLEVEL__)
+#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+  (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#else
+#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+  (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#endif
+
 #ifdef ERTS_INLINE
 #  ifndef ERTS_CAN_INLINE
 #    define ERTS_CAN_INLINE 1
@@ -38,6 +51,17 @@
 #  endif
 #endif
 
+#ifndef ERTS_FORCE_INLINE
+#  if ERTS_AT_LEAST_GCC_VSN__(3,1,1)
+#    define ERTS_FORCE_INLINE __inline__ __attribute__((__always_inline__))
+#  elif defined(__WIN32__)
+#    define ERTS_FORCE_INLINE __forceinline
+#  endif
+#  ifndef ERTS_FORCE_INLINE
+#    define ERTS_FORCE_INLINE ERTS_INLINE
+#  endif
+#endif
+
 #if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
 #  undef ERTS_CAN_INLINE
 #  define ERTS_CAN_INLINE 0
@@ -112,19 +136,6 @@ typedef int ErtsSysFdType;
 typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
 #endif
 
-#if !defined(__GNUC__)
-#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
-#elif !defined(__GNUC_MINOR__)
-#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
-  ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#elif !defined(__GNUC_PATCHLEVEL__)
-#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
-  (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#else
-#  define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
-  (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#endif
-
 #if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
 #  define ERTS_LIKELY(BOOL)   __builtin_expect((BOOL), !0)
 #  define ERTS_UNLIKELY(BOOL) __builtin_expect((BOOL), 0)
-- 
cgit v1.2.3


From 7858ca939f8bf2db918396616fee13364d150a1e Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Mon, 5 Oct 2015 16:13:37 +0200
Subject: erts: Refactor line table in loaded beam code

to use real C struct with correct types
---
 erts/emulator/beam/beam_load.c   | 52 ++++++++++++++++++++--------------------
 erts/emulator/beam/beam_load.h   | 18 +++++++++-----
 erts/emulator/beam/beam_ranges.c | 37 +++++++++++++---------------
 3 files changed, 54 insertions(+), 53 deletions(-)

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index c56e6732a0..1c598601c6 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4388,9 +4388,11 @@ freeze_code(LoaderState* stp)
     if (stp->line_instr == 0) {
 	line_size = 0;
     } else {
-	line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) +
-		     (stp->current_li+1) + stp->num_fnames) *
-	    sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
+	line_size = (offsetof(BeamCodeLineTab,func_tab)
+                     + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */
+                     + (stp->current_li + 1) * sizeof(BeamInstr*)     /* line items */
+                     + stp->num_fnames * sizeof(Eterm)                /* fname table */
+                     + (stp->current_li + 1) * stp->loc_size);        /* loc_tab */
     }
     size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) +
 	strtab_size + attr_size + compile_size + MD5_SIZE + line_size;
@@ -4465,42 +4467,40 @@ freeze_code(LoaderState* stp)
 	code_hdr->line_table = NULL;
 	str_table = (byte *) (codev + stp->ci);
     } else {
-	Eterm* line_tab = (Eterm *) (codev+stp->ci);
-	Eterm* p;
-	int ftab_size = stp->num_functions;
-	int num_instrs = stp->current_li;
-	Eterm* first_line_item;
+	BeamCodeLineTab* const line_tab = (BeamCodeLineTab *) (codev+stp->ci);
+	const int ftab_size = stp->num_functions;
+        const int num_instrs = stp->current_li;
+        const BeamInstr** const line_items =
+            (const BeamInstr**) &line_tab->func_tab[ftab_size + 1];
 
 	code_hdr->line_table = line_tab;
-	p = line_tab + MI_LINE_FUNC_TAB;
 
-	first_line_item = (p + ftab_size + 1);
 	for (i = 0; i < ftab_size; i++) {
-	     *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]);
+            line_tab->func_tab[i] = line_items + stp->func_line[i];
 	}
-	*p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
-	ASSERT(p == first_line_item);
+	line_tab->func_tab[i] = line_items + num_instrs;
+
 	for (i = 0; i < num_instrs; i++) {
-		*p++ = (Eterm) (BeamInstr) (codev + stp->line_instr[i].pos);
+            line_items[i] = codev + stp->line_instr[i].pos;
 	}
-	*p++ = (Eterm) (BeamInstr) (codev + stp->ci - 1);
+	line_items[i] = codev + stp->ci - 1;
 
-	line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
-	memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
-	p += stp->num_fnames;
+	line_tab->fname_ptr = (Eterm*) &line_items[i + 1];
+	memcpy(line_tab->fname_ptr, stp->fname, stp->num_fnames*sizeof(Eterm));
 
-	line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p;
-	line_tab[MI_LINE_LOC_SIZE] = stp->loc_size;
+	line_tab->loc_size = stp->loc_size;
 	if (stp->loc_size == 2) {
-	    Uint16* locp = (Uint16 *) p;
-	    for (i = 0; i < num_instrs; i++) {
+            Uint16* locp = (Uint16 *) &line_tab->fname_ptr[stp->num_fnames];
+            line_tab->loc_tab.p2 = locp;
+            for (i = 0; i < num_instrs; i++) {
 		*locp++ = (Uint16) stp->line_instr[i].loc;
-	    }
-	    *locp++ = LINE_INVALID_LOCATION;
+            }
+            *locp++ = LINE_INVALID_LOCATION;
             str_table = (byte *) locp;
 	} else {
-	    Uint32* locp = (Uint32 *) p;
-	    ASSERT(stp->loc_size == 4);
+	    Uint32* locp = (Uint32 *) &line_tab->fname_ptr[stp->num_fnames];
+            ASSERT(stp->loc_size == 4);
+            line_tab->loc_tab.p4 = locp;
 	    for (i = 0; i < num_instrs; i++) {
 		*locp++ = stp->line_instr[i].loc;
 	    }
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index c86ac65521..22ab71c868 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -61,6 +61,8 @@ extern BeamInstr* em_call_nif;
 /* Total code size in bytes */
 extern Uint erts_total_code_size;
 
+typedef struct BeamCodeLineTab_ BeamCodeLineTab;
+
 /*
  * Header of code chunks which contains additional information
  * about the loaded module.
@@ -100,7 +102,7 @@ typedef struct beam_code_header {
     /*
      * Pointer to the line table (or NULL if none).
      */
-    Eterm* line_table;
+    BeamCodeLineTab* line_table;
 
     /*
      * Pointer to the module MD5 sum (16 bytes)
@@ -124,11 +126,15 @@ int erts_is_module_native(BeamCodeHeader* code);
 /*
  * Layout of the line table.
  */
-
-#define MI_LINE_FNAME_PTR 0
-#define MI_LINE_LOC_TAB 1
-#define MI_LINE_LOC_SIZE 2
-#define MI_LINE_FUNC_TAB 3
+struct BeamCodeLineTab_ {
+    Eterm* fname_ptr;
+    int loc_size;
+    union {
+        Uint16* p2;
+        Uint32* p4;
+    }loc_tab;
+    const BeamInstr** func_tab[1];
+};
 
 #define LINE_INVALID_LOCATION (0)
 
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index e6cf43446e..5a2b66727a 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -37,7 +37,7 @@ typedef struct {
 #define RANGE_END(R) ((BeamInstr*)erts_smp_atomic_read_nob(&(R)->end))
 
 static Range* find_range(BeamInstr* pc);
-static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
+static void lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
 		       BeamCodeHeader*, int idx);
 
 /*
@@ -296,39 +296,34 @@ find_range(BeamInstr* pc)
 }
 
 static void
-lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamCodeHeader* code_hdr, int idx)
+lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
+           BeamCodeHeader* code_hdr, int idx)
 {
-    Eterm* line = code_hdr->line_table;
-    Eterm* low;
-    Eterm* high;
-    Eterm* mid;
-    Eterm pc;
+    BeamCodeLineTab* lt = code_hdr->line_table;
+    const BeamInstr** low;
+    const BeamInstr** high;
+    const BeamInstr** mid;
 
-    if (line == 0) {
+    if (lt == NULL) {
 	return;
     }
 
-    pc = (Eterm) (BeamInstr) orig_pc;
-    fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR];
-    low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx];
-    high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1];
+    fi->fname_ptr = lt->fname_ptr;
+    low = lt->func_tab[idx];
+    high = lt->func_tab[idx+1];
     while (high > low) {
 	mid = low + (high-low) / 2;
 	if (pc < mid[0]) {
 	    high = mid;
 	} else if (pc < mid[1]) {
 	    int file;
-	    int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB];
+	    int index = mid - lt->func_tab[0];
 
-	    if (line[MI_LINE_LOC_SIZE] == 2) {
-		Uint16* loc_table =
-		    (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB];
-		fi->loc = loc_table[index];
+	    if (lt->loc_size == 2) {
+		fi->loc = lt->loc_tab.p2[index];
 	    } else {
-		Uint32* loc_table =
-		    (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB];
-		ASSERT(line[MI_LINE_LOC_SIZE] == 4);
-		fi->loc = loc_table[index];
+		ASSERT(lt->loc_size == 4);
+		fi->loc = lt->loc_tab.p4[index];
 	    }
 	    if (fi->loc == LINE_INVALID_LOCATION) {
 		return;
-- 
cgit v1.2.3


From 3ac08f9b668613a4292436979eacc61863c2ab94 Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Wed, 16 Sep 2015 15:02:50 +0200
Subject: Fragmented young heap generation and off_heap_message_queue option

* The youngest generation of the heap can now consist of multiple
  blocks. Heap fragments and message fragments are added to the
  youngest generation when needed without triggering a GC. After
  a GC the youngest generation is contained in one single block.
* The off_heap_message_queue process flag has been added. When
  enabled all message data in the queue is kept off heap. When
  a message is selected from the queue, the message fragment (or
  heap fragment) containing the actual message is attached to the
  youngest generation. Messages stored off heap is not part of GC.
---
 erts/doc/src/erl.xml                  |   15 +
 erts/doc/src/erlang.xml               |   77 +-
 erts/emulator/beam/atom.names         |    1 +
 erts/emulator/beam/beam_bif_load.c    |  216 +++--
 erts/emulator/beam/beam_emu.c         |  142 ++--
 erts/emulator/beam/beam_load.c        |    6 +-
 erts/emulator/beam/bif.c              |   39 +-
 erts/emulator/beam/bif.h              |   48 +-
 erts/emulator/beam/break.c            |    4 +-
 erts/emulator/beam/copy.c             |    4 +-
 erts/emulator/beam/dist.c             |   34 +-
 erts/emulator/beam/erl_alloc.c        |   21 +-
 erts/emulator/beam/erl_alloc.h        |    4 +-
 erts/emulator/beam/erl_alloc.types    |    2 +
 erts/emulator/beam/erl_bif_ddll.c     |   17 +-
 erts/emulator/beam/erl_bif_info.c     |  270 +++---
 erts/emulator/beam/erl_debug.c        |    6 +-
 erts/emulator/beam/erl_gc.c           |  688 ++++++++-------
 erts/emulator/beam/erl_gc.h           |   27 +-
 erts/emulator/beam/erl_hl_timer.c     |   85 +-
 erts/emulator/beam/erl_init.c         |   26 +-
 erts/emulator/beam/erl_message.c      | 1509 ++++++++++++++++++++-------------
 erts/emulator/beam/erl_message.h      |  277 ++++--
 erts/emulator/beam/erl_nif.c          |    7 +-
 erts/emulator/beam/erl_node_tables.c  |   68 +-
 erts/emulator/beam/erl_process.c      |  346 ++++----
 erts/emulator/beam/erl_process.h      |  106 ++-
 erts/emulator/beam/erl_process_dump.c |   13 +-
 erts/emulator/beam/erl_process_lock.h |    6 -
 erts/emulator/beam/erl_time_sup.c     |    7 +-
 erts/emulator/beam/erl_trace.c        |   68 +-
 erts/emulator/beam/global.h           |  123 +--
 erts/emulator/beam/io.c               |  113 +--
 erts/emulator/beam/sys.h              |    2 +
 erts/emulator/beam/utils.c            |   17 +-
 erts/emulator/hipe/hipe_gc.c          |   36 +-
 erts/emulator/hipe/hipe_native_bif.c  |   34 +-
 erts/etc/common/erlexec.c             |   22 +-
 erts/preloaded/ebin/erlang.beam       |  Bin 101840 -> 101544 bytes
 erts/preloaded/src/erlang.erl         |   44 +-
 40 files changed, 2549 insertions(+), 1981 deletions(-)

diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index b0322b7d43..8c1be4dff5 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1335,6 +1335,21 @@
           error_logger(3)
           for further information.

       
+      
+      
+        
Default process flag settings.

+        
+          +xohmq true|false
+          

+	    Sets the default value for the process flag
+	    off_heap_message_queue. If +xohmq is not
+	    passed, false will be the default. For more information,
+	    see the documentation of
+            process_flag(off_heap_message_queue,
+	    OHMQ).
+	  

+	
+      
       
       
         
Miscellaneous flags.

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index e77532463e..9426d30390 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4058,8 +4058,46 @@ os_prompt%
process.

Returns the old value of the flag.

 + + Set process flag off_heap_message_queue for the calling process + +

This flag determines how messages in the message queue + are stored. When the flag is:

+ + true +

+ All messages in the message queue will be stored + outside of the process heap. This implies that no + messages in the message queue will be part of a garbage + collection of the process. +

+ false +

+ Messages may be placed either on the heap or outside + of the heap. +

+ +

+ If the process potentially may get a hugh amount of messages, + you are recommended to set the flag to true. This since + a garbage collection with lots of messages placed on the heap + may become extremly expensive. Performance of the actual + message passing is however generally better when setting the + flag to false. +

+

+ When changing this flag from false to true, + all messages in the message queue are moved off heap. This + work has been initiated but not completed when this function + call returns. +

+

Returns the old value of the flag.

+ + + + Set process flag priority for the calling process @@ -4138,7 +4176,7 @@ os_prompt% - + Set process flag save_calls for the calling process

N must be an integer in the interval 0..10000. @@ -4162,7 +4200,7 @@ os_prompt% - + Set process flag sensitive for the calling process

Set or clear the sensitive flag for the current process. @@ -4408,6 +4446,14 @@ os_prompt% monitor by name, the list item is {process, {RegName, Node}}.

+ {off_heap_message_queue, OHMQ} + +

Returns the current state of the off_heap_message_queue + process flag. OHMQ is either true, or + false. For more information, see the documentation of + process_flag(off_heap_message_queue, + OHMQ).

+ {priority, Level}

Level is the current priority level for @@ -5067,6 +5113,7 @@ true + Create a new process with a fun as entry point

Returns the pid of a new process started by the application @@ -5081,6 +5128,7 @@ true + Create a new process with a fun as entry point on a given node

Returns the pid of a new process started by the application @@ -5093,6 +5141,7 @@ true + Create a new process with a function as entry point

Works exactly like @@ -5188,6 +5237,18 @@ true fine-tuning an application and to measure the execution time with various VSize values.

 + {off_heap_message_queue, OHMQ} + +

Sets the state of the off_heap_message_queue process + flag. OHMQ should be either true, or + false. The default off_heap_message_queue process + flag is determined by the + +xohmq erl + command line argument. For more information, see the + documentation of + process_flag(off_heap_message_queue, + OHMQ).

+ @@ -5195,6 +5256,7 @@ true + Create a new process with a function as entry point on a given node

Returns the pid of a new process started by the application @@ -6224,6 +6286,7 @@ ok + Information about the system

Returns various information about the current system @@ -6614,6 +6677,16 @@ ok

Returns a string containing the erlang NIF version used by the runtime system. It will be on the form "<major ver>.<minor ver>".

+ off_heap_message_queue + +

Returns the default value of the off_heap_message_queue + process flag which is either true or false. This + default is set by the erl command line argument + +xohmq. For more information on the + off_heap_message_queue process flag, see documentation of + process_flag(off_heap_message_queue, + OHMQ).

+ otp_release

Returns a string containing the OTP release number of the diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 6328b3d18f..f142cf1142 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -423,6 +423,7 @@ atom notify atom notsup atom nouse_stdio atom objects +atom off_heap_message_queue atom offset atom ok atom old_heap_block_size diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 2c275c4649..22b4e26c77 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -723,29 +723,50 @@ set_default_trace_pattern(Eterm module) } } +static ERTS_INLINE int +check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) +{ + struct erl_off_heap_header* oh; + for (oh = off_heap->first; oh; oh = oh->next) { + if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { + ErlFunThing* funp = (ErlFunThing*) oh; + if (ErtsInArea(funp->fe->address, area, area_size)) + return !0; + } + } + return 0; +} + + static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) { BeamInstr* start; char* literals; Uint lit_bsize; - BeamInstr* end; + char* mod_start; + Uint mod_size; Eterm* sp; - struct erl_off_heap_header* oh; int done_gc = 0; + int need_gc = 0; + ErtsMessage *msgp; + ErlHeapFragment *hfrag; -#define INSIDE(a) (start <= (a) && (a) < end) +#define ERTS_ORDINARY_GC__ (1 << 0) +#define ERTS_LITERAL_GC__ (1 << 1) /* * Pick up limits for the module. */ start = (BeamInstr*) modp->old.code_hdr; - end = (BeamInstr *)((char *)start + modp->old.code_length); + mod_start = (char *) start; + mod_size = modp->old.code_length; /* * Check if current instruction or continuation pointer points into module. */ - if (INSIDE(rp->i) || INSIDE(rp->cp)) { + if (ErtsInArea(rp->i, mod_start, mod_size) + || ErtsInArea(rp->cp, mod_start, mod_size)) { return am_true; } @@ -753,7 +774,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) * Check all continuation pointers stored on the stack. */ for (sp = rp->stop; sp < STACK_START(rp); sp++) { - if (is_CP(*sp) && INSIDE(cp_val(*sp))) { + if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) { return am_true; } } @@ -767,15 +788,15 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) struct StackTrace *s; ASSERT(is_list(rp->ftrace)); s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); - if ((s->pc && INSIDE(s->pc)) || - (s->current && INSIDE(s->current))) { + if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) || + (s->current && ErtsInArea(s->current, mod_start, mod_size))) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } else { int i; for (i = 0; i < s->depth; i++) { - if (INSIDE(s->trace[i])) { + if (ErtsInArea(s->trace[i], mod_start, mod_size)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; @@ -796,108 +817,141 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) } /* - * See if there are funs that refer to the old version of the module. + * Message queue can contains funs, but (at least currently) no + * constants. If we got references to this module from the message + * queue, a GC cannot remove these... */ - rescan: - for (oh = MSO(rp).first; oh; oh = oh->next) { - if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { - ErlFunThing* funp = (ErlFunThing*) oh; + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); - if (INSIDE((BeamInstr *) funp->fe->address)) { - if (done_gc) { - return am_true; - } else { - if (!allow_gc) - return am_aborted; - /* - * Try to get rid of this fun by garbage collecting. - * Clear both fvalue and ftrace to make sure they - * don't hold any funs. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; - FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); - goto rescan; - } - } + for (msgp = rp->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfrag = &msgp->hfrag; + else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag) + hfrag = msgp->data.heap_frag; + else + continue; + for (; hfrag; hfrag = hfrag->next) { + if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) + return am_true; + /* Should not contain any constants... */ + ASSERT(!any_heap_ref_ptrs(&hfrag->mem[0], + &hfrag->mem[hfrag->used_size], + mod_start, + mod_size)); } } - /* - * See if there are constants inside the module referenced by the process. - */ - done_gc = 0; literals = (char*) modp->old.code_hdr->literals_start; lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; - for (;;) { - ErlMessage* mp; + while (1) { + + /* Check heap, stack etc... */ + if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) + goto try_gc; if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } - if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) { - goto need_gc; - } - if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) { - goto need_gc; - } + if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) + goto try_literal_gc; + + /* Check dictionary */ + if (rp->dictionary) { + Eterm* start = rp->dictionary->data; + Eterm* end = start + rp->dictionary->used; - if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) { - goto need_gc; + if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) + goto try_literal_gc; } - if (rp->dictionary != NULL) { - Eterm* start = rp->dictionary->data; - Eterm* end = start + rp->dictionary->used; + /* Check heap fragments */ + for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + /* Off heap lists should already have been moved into process */ + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); - if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) { - goto need_gc; - } + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; + if (any_heap_ref_ptrs(hp, hp_end, mod_start, lit_bsize)) + goto try_literal_gc; } - for (mp = rp->msg.first; mp != NULL; mp = mp->next) { - if (any_heap_ref_ptrs(mp->m, mp->m+2, literals, lit_bsize)) { - goto need_gc; +#ifdef DEBUG + /* + * Message buffer fragments should not have any references + * to constants, and off heap lists should already have + * been moved into process off heap structure. + */ + for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfrag = &msgp->hfrag; + else + hfrag = msgp->data.heap_frag; + for (; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); + + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; + ASSERT(!any_heap_ref_ptrs(hp, hp_end, mod_start, lit_bsize)); } } - break; - need_gc: - if (done_gc) { +#endif + + return am_false; + + try_literal_gc: + need_gc |= ERTS_LITERAL_GC__; + + try_gc: + need_gc |= ERTS_ORDINARY_GC__; + + if ((done_gc & need_gc) == need_gc) return am_true; - } else { - struct erl_off_heap_header* oh; - if (!allow_gc) - return am_aborted; + if (!allow_gc) + return am_aborted; - /* - * Try to get rid of constants by by garbage collecting. - * Clear both fvalue and ftrace. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; + need_gc &= ~done_gc; + + /* + * Try to get rid of constants by by garbage collecting. + * Clear both fvalue and ftrace. + */ + + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + + if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); + done_gc |= ERTS_ORDINARY_GC__; + } + if (need_gc & ERTS_LITERAL_GC__) { + struct erl_off_heap_header* oh; oh = modp->old.code_hdr->literals_off_heap; *redsp += lit_bsize / 64; /* Need, better value... */ erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh); + done_gc |= ERTS_LITERAL_GC__; } + need_gc = 0; } - return am_false; -#undef INSIDE -} -#define in_area(ptr,start,nbytes) \ - ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) +#undef ERTS_ORDINARY_GC__ +#undef ERTS_LITERAL_GC__ + +} static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) @@ -910,7 +964,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(val, mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; @@ -930,7 +984,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(val, mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; @@ -940,7 +994,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) if (header_is_bin_matchstate(val)) { ErlBinMatchState *ms = (ErlBinMatchState*) p; ErlBinMatchBuffer *mb = &(ms->mb); - if (in_area(mb->orig, mod_start, mod_size)) { + if (ErtsInArea(mb->orig, mod_start, mod_size)) { return 1; } } @@ -953,8 +1007,6 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) return 0; } -#undef in_area - BIF_RETTYPE purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4d19f52a52..1dd56ff989 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1654,10 +1654,6 @@ void process_main(void) ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); - if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { - result = erts_gc_after_bif_call(c_p, result, reg, 2); - E = c_p->stop; - } HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -1745,8 +1741,7 @@ void process_main(void) SWAPIN; } /* only x(2) is included in the rootset here */ - if (E - HTOP < 3 || c_p->mbuf) { /* Force GC in case add_stacktrace() - * created heap fragments */ + if (E - HTOP < 3) { SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); @@ -1833,10 +1828,17 @@ void process_main(void) OpCase(i_loop_rec_f): { BeamInstr *next; - ErlMessage* msgp; + ErtsMessage* msgp; - loop_rec__: + /* + * We need to disable GC while matching messages + * in the queue. This since messages with data outside + * the heap will be corrupted by a GC. + */ + ASSERT(!(c_p->flags & F_DISABLE_GC)); + c_p->flags |= F_DISABLE_GC; + loop_rec__: PROCESS_MAIN_CHK_LOCKS(c_p); msgp = PEEK_MESSAGE(c_p); @@ -1848,6 +1850,7 @@ void process_main(void) if (ERTS_PROC_PENDING_EXIT(c_p)) { erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); SWAPOUT; + c_p->flags &= ~F_DISABLE_GC; goto do_schedule; /* Will be rescheduled for exit */ } ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); @@ -1857,30 +1860,27 @@ void process_main(void) else #endif { + c_p->flags &= ~F_DISABLE_GC; SET_I((BeamInstr *) Arg(0)); Goto(*I); /* Jump to a wait or wait_timeout instruction */ } } - ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS, - { - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - }, - { - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - }); if (is_non_value(ERL_MESSAGE_TERM(msgp))) { - /* - * A corrupt distribution message that we weren't able to decode; - * remove it... - */ - ASSERT(!msgp->data.attached); - /* TODO: Add DTrace probe for this bad message situation? */ - UNLINK_MESSAGE(c_p, msgp); - free_message(msgp); - goto loop_rec__; + SWAPOUT; /* erts_decode_dist_message() may write to heap... */ + if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + /* No swapin should be needed */ + ASSERT(HTOP == c_p->htop && E == c_p->stop); + /* TODO: Add DTrace probe for this bad message situation? */ + UNLINK_MESSAGE(c_p, msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); + goto loop_rec__; + } + SWAPIN; } PreFetch(1, next); r(0) = ERL_MESSAGE_TERM(msgp); @@ -1892,8 +1892,7 @@ void process_main(void) */ OpCase(remove_message): { BeamInstr *next; - ErlMessage* msgp; - + ErtsMessage* msgp; PROCESS_MAIN_CHK_LOCKS(c_p); PreFetch(0, next); @@ -1988,11 +1987,21 @@ void process_main(void) UNLINK_MESSAGE(c_p, msgp); JOIN_MESSAGE(c_p); CANCEL_TIMER(c_p); - free_message(msgp); + + erts_save_message_in_proc(c_p, msgp); + c_p->flags &= ~F_DISABLE_GC; + + if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); + } ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); - NextPF(0, next); } @@ -2001,9 +2010,22 @@ void process_main(void) * message didn't match), then jump to the loop_rec instruction. */ OpCase(loop_rec_end_f): { + + ASSERT(c_p->flags & F_DISABLE_GC); + SET_I((BeamInstr *) Arg(0)); SAVE_MESSAGE(c_p); - goto loop_rec__; + if (FCALLS > 0 || FCALLS > neg_o_reds) { + FCALLS--; + goto loop_rec__; + } + + c_p->flags &= ~F_DISABLE_GC; + c_p->i = I; + SWAPOUT; + c_p->arity = 0; + c_p->current = NULL; + goto do_schedule; } /* * Prepare to wait for a message or a timeout, whichever occurs first. @@ -2733,6 +2755,7 @@ do { \ Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); Eterm result; BeamInstr *next; + ErlHeapFragment *live_hf_end; PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; @@ -2742,17 +2765,18 @@ do { \ PreFetch(1, next); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + live_hf_end = c_p->mbuf; result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_HOLE_CHECK(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + if (ERTS_IS_GC_DESIRED(c_p)) { Uint arity = ((Export *)Arg(0))->code[2]; - result = erts_gc_after_bif_call(c_p, result, reg, arity); + result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity); E = c_p->stop; } + PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -3414,9 +3438,6 @@ do { \ goto do_schedule; } else { ASSERT(!is_value(r(0))); - if (c_p->mbuf) { - erts_garbage_collect(c_p, 0, reg+1, 3); - } SWAPIN; Goto(*I); } @@ -3440,6 +3461,7 @@ do { \ * I[3]: Function pointer to dirty NIF */ BifFunction vbf; + ErlHeapFragment *live_hf_end; DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); c_p->current = I-3; /* current and vbf set to please handle_error */ @@ -3455,6 +3477,7 @@ do { \ NifF* fp = vbf = (NifF*) I[1]; struct enif_environment_t env; erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); + live_hf_end = c_p->mbuf; nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) nif_bif_result = THE_NON_VALUE; @@ -3497,6 +3520,7 @@ do { \ { Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + live_hf_end = c_p->mbuf; nif_bif_result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); @@ -3509,9 +3533,17 @@ do { \ apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); - if (c_p->mbuf) { - nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result, - reg, bif_nif_arity); + /* + * We want to test with ERTS_IS_GC_DESIRED(c_p) in order + * to trigger gc due to binaries based on same conditions + * regardless of how the bif is called. This change will + * however be introduced in a separate commit in order to + * easier identify why the characteristics changed. + */ + if (c_p->stop - c_p->htop < c_p->mbuf_sz) { + nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, + nif_bif_result, + reg, bif_nif_arity); } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; @@ -6340,13 +6372,6 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) erts_factory_proc_init(&factory, p); res = erts_hashmap_from_array(&factory, thp, n/2, 0); erts_factory_close(&factory); - if (p->mbuf) { - Uint live = Arg(2); - reg[live] = res; - erts_garbage_collect(p, 0, reg, live+1); - res = reg[live]; - E = p->stop; - } return res; } @@ -6412,13 +6437,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) hx = hashmap_make_hash(new_key); res = erts_hashmap_insert(p, hx, new_key, val, res, 0); - if (p->mbuf) { - Uint live = Arg(3); - reg[live] = res; - erts_garbage_collect(p, 0, reg, live+1); - res = reg[live]; - E = p->stop; - } new_p += 2; } @@ -6578,12 +6596,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) /* The expensive case, need to build a hashmap */ if (n > MAP_SMALL_MAP_LIMIT) { res = erts_hashmap_from_ks_and_vs(p,flatmap_get_keys(mp),flatmap_get_values(mp),n); - if (p->mbuf) { - Uint live = Arg(3); - reg[live] = res; - erts_garbage_collect(p, 0, reg, live+1); - res = reg[live]; - } } return res; } @@ -6639,14 +6651,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) return res; } - if (p->mbuf) { - Uint live = Arg(3); - reg[live] = res; - erts_garbage_collect(p, 0, reg, live+1); - res = reg[live]; - E = p->stop; - } - new_p += 2; } return res; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 7a1a563be2..5db971b6af 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -902,7 +902,7 @@ static ErlHeapFragment* new_literal_fragment(Uint size) ErlHeapFragment* bp; bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_PREPARED_CODE, ERTS_HEAP_FRAG_SIZE(size)); - ERTS_INIT_HEAP_FRAG(bp, size); + ERTS_INIT_HEAP_FRAG(bp, size, size); return bp; } @@ -1528,8 +1528,8 @@ read_literal_table(LoaderState* stp) } if (heap_size > 0) { - erts_factory_message_init(&factory, NULL, NULL, - new_literal_fragment(heap_size)); + erts_factory_heap_frag_init(&factory, + new_literal_fragment(heap_size)); factory.alloc_type = ERTS_ALC_T_PREPARED_CODE; val = erts_decode_ext(&factory, &p); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5ec1840c7b..e4283ac945 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -72,7 +72,7 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3) ErlSpawnOpts so; Eterm pid; - so.flags = 0; + so.flags = erts_default_spo_flags; pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); if (is_non_value(pid)) { BIF_ERROR(BIF_P, so.error_code); @@ -589,7 +589,7 @@ erts_queue_monitor_message(Process *p, Eterm reason_copy, ref_copy, item_copy; Uint reason_size, ref_size, item_size, heap_size; ErlOffHeap *ohp; - ErlHeapFragment *bp; + ErtsMessage *msgp; reason_size = IS_CONST(reason) ? 0 : size_object(reason); item_size = IS_CONST(item) ? 0 : size_object(item); @@ -597,11 +597,8 @@ erts_queue_monitor_message(Process *p, heap_size = 6+reason_size+ref_size+item_size; - hp = erts_alloc_message_heap(heap_size, - &bp, - &ohp, - p, - p_locksp); + msgp = erts_alloc_message_heap(p, p_locksp, heap_size, + &hp, &ohp); reason_copy = (IS_CONST(reason) ? reason @@ -612,7 +609,7 @@ erts_queue_monitor_message(Process *p, ref_copy = copy_struct(ref, ref_size, &hp, ohp); tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy); - erts_queue_message(p, p_locksp, bp, tup, NIL); + erts_queue_message(p, p_locksp, msgp, tup, NIL); } static BIF_RETTYPE @@ -841,7 +838,7 @@ BIF_RETTYPE spawn_link_3(BIF_ALIST_3) ErlSpawnOpts so; Eterm pid; - so.flags = SPO_LINK; + so.flags = erts_default_spo_flags|SPO_LINK; pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); if (is_non_value(pid)) { BIF_ERROR(BIF_P, so.error_code); @@ -878,7 +875,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) /* * Store default values for options. */ - so.flags = SPO_USE_ARGS; + so.flags = erts_default_spo_flags|SPO_USE_ARGS; so.min_heap_size = H_MIN_SIZE; so.min_vheap_size = BIN_VH_MIN_SIZE; so.priority = PRIORITY_NORMAL; @@ -913,6 +910,13 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) so.priority = PRIORITY_LOW; else goto error; + } else if (arg == am_off_heap_message_queue) { + if (val == am_true) + so.flags |= SPO_OFF_HEAP_MSGQ; + else if (val == am_false) + so.flags &= ~SPO_OFF_HEAP_MSGQ; + else + goto error; } else if (arg == am_min_heap_size && is_small(val)) { Sint min_heap_size = signed_val(val); if (min_heap_size < 0) { @@ -1691,6 +1695,17 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) } BIF_RET(old_value); } + else if (BIF_ARG_1 == am_off_heap_message_queue) { + int enable; + if (BIF_ARG_2 == am_true) + enable = 1; + else if (BIF_ARG_2 == am_false) + enable = 0; + else + goto error; + old_value = erts_change_off_heap_message_queue_state(BIF_P, enable); + BIF_RET(old_value); + } else if (BIF_ARG_1 == am_sensitive) { Uint is_sensitive; if (BIF_ARG_2 == am_true) { @@ -1931,7 +1946,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) } else if (is_atom(to)) { Eterm id = erts_whereis_name_to_id(p, to); - rp = erts_proc_lookup(id); + rp = erts_proc_lookup_raw(id); if (rp) { if (IS_TRACED(p)) trace_send(p, to, msg); @@ -4479,7 +4494,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } } else if (BIF_ARG_1 == make_small(1)) { int i, max; - ErlMessage* mp; + ErtsMessage* mp; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index c6ed60376a..a62eddf36b 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -54,22 +54,24 @@ extern Export *erts_convert_time_unit_trap; (p)->fcalls = -CONTEXT_REDS; \ } while(0) - -#define ERTS_VBUMP_ALL_REDS(p) \ +#define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \ do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \ - if ((p)->fcalls > 0) \ - ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls; \ - (p)->fcalls = 0; \ + if ((fcalls) > 0) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (fcalls); \ + (fcalls) = 0; \ } \ else { \ - if ((p)->fcalls > -CONTEXT_REDS) \ + if ((fcalls) > -CONTEXT_REDS) \ ERTS_PROC_GET_SCHDATA((p))->virtual_reds \ - += ((p)->fcalls - (-CONTEXT_REDS)); \ - (p)->fcalls = -CONTEXT_REDS; \ + += ((fcalls) - (-CONTEXT_REDS)); \ + (fcalls) = -CONTEXT_REDS; \ } \ } while(0) +#define ERTS_VBUMP_ALL_REDS(p) \ + ERTS_VBUMP_ALL_REDS_INTERNAL((p), (p)->fcalls) + #define BUMP_REDS(p, gc) do { \ ASSERT(p); \ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\ @@ -110,10 +112,34 @@ do { \ } \ } while(0) -#define ERTS_BIF_REDS_LEFT(p) \ +#define ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, FCalls) \ + do { \ + if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \ + int nreds__ = ((int)(Reds)) - CONTEXT_REDS; \ + if ((FCalls) > nreds__) { \ + ERTS_PROC_GET_SCHDATA((P))->virtual_reds \ + += (FCalls) - nreds__; \ + (FCalls) = nreds__; \ + } \ + } \ + else { \ + if ((FCalls) > (Reds)) { \ + ERTS_PROC_GET_SCHDATA((P))->virtual_reds \ + += (FCalls) - (Reds); \ + (FCalls) = (Reds); \ + } \ + } \ + } while (0) + +#define ERTS_VBUMP_LEAVE_REDS(P, Reds) \ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, (P)->fcalls) + +#define ERTS_REDS_LEFT(p, FCalls) \ (ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ - ? ((p)->fcalls > -CONTEXT_REDS ? ((p)->fcalls - (-CONTEXT_REDS)) : 0)\ - : ((p)->fcalls > 0 ? (p)->fcalls : 0)) + ? ((FCalls) > -CONTEXT_REDS ? ((FCalls) - (-CONTEXT_REDS)) : 0) \ + : ((FCalls) > 0 ? (FCalls) : 0)) + +#define ERTS_BIF_REDS_LEFT(p) ERTS_REDS_LEFT(p, p->fcalls) #define BIF_RET2(x, gc) do { \ BUMP_REDS(BIF_P, (gc)); \ diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index c7e7411935..aa5ec123a7 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -252,7 +252,7 @@ print_process_info(int to, void *to_arg, Process *p) /* display the message queue only if there is anything in it */ if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) { - ErlMessage* mp; + ErtsMessage* mp; erts_print(to, to_arg, "Message queue: ["); for (mp = p->msg.first; mp; mp = mp->next) erts_print(to, to_arg, mp->next ? "%T," : "%T", ERL_MESSAGE_TERM(mp)); @@ -323,7 +323,7 @@ print_process_info(int to, void *to_arg, Process *p) erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop)); erts_print(to, to_arg, "OldHeap unused: %bpu\n", (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) ); - erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p)); + erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p, !0)); if (garbing) { print_garb_info(to, to_arg, p); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index b185758b1d..f27c526413 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -279,7 +279,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) break; case TAG_PRIMARY_LIST: objp = list_val(obj); - if (in_area(objp,hstart,hsize)) { + if (ErtsInArea(objp,hstart,hsize)) { hp++; break; } @@ -318,7 +318,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - if (in_area(boxed_val(obj),hstart,hsize)) { + if (ErtsInArea(boxed_val(obj),hstart,hsize)) { hp++; break; } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index efd5109269..bfddcadca3 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -373,10 +373,11 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) ASSERT(lnk->type == LINK_NODE); if (is_internal_pid(lnk->pid)) { ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; - rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); - if (!rp) { + ErlOffHeap *ohp; + rp = erts_proc_lookup(lnk->pid); + if (!rp) goto done; - } + erts_smp_proc_lock(rp, rp_locks); rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name); if (rlnk != NULL) { ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE)); @@ -384,12 +385,14 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) } n = ERTS_LINK_REFC(lnk); for (i = 0; i < n; ++i) { - ErlHeapFragment* bp; - ErlOffHeap *ohp; Eterm tup; - Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks); + Eterm *hp; + ErtsMessage *msgp; + + msgp = erts_alloc_message_heap(rp, &rp_locks, + 3, &hp, &ohp); tup = TUPLE2(hp, am_nodedown, name); - erts_queue_message(rp, &rp_locks, bp, tup, NIL); + erts_queue_message(rp, &rp_locks, msgp, tup, NIL); } erts_smp_proc_unlock(rp, rp_locks); } @@ -1458,7 +1461,7 @@ int erts_net_message(Port *prt, ErlOffHeap *ohp; ASSERT(xsize); heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); hp = heap_frag->mem; ohp = &heap_frag->off_heap; token = tuple[5]; @@ -1507,7 +1510,7 @@ int erts_net_message(Port *prt, ErlOffHeap *ohp; ASSERT(xsize); heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); hp = heap_frag->mem; ohp = &heap_frag->off_heap; token = tuple[4]; @@ -3267,11 +3270,16 @@ send_nodes_mon_msg(Process *rp, Uint sz) { Eterm msg; - ErlHeapFragment* bp; + Eterm *hp; + ErtsMessage *mp; ErlOffHeap *ohp; - Eterm *hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, rp_locksp); #ifdef DEBUG - Eterm *hend = hp + sz; + Eterm *hend; +#endif + + mp = erts_alloc_message_heap(rp, rp_locksp, sz, &hp, &ohp); +#ifdef DEBUG + hend = hp + sz; #endif if (!nmp->opts) { @@ -3317,7 +3325,7 @@ send_nodes_mon_msg(Process *rp, } ASSERT(hend == hp); - erts_queue_message(rp, rp_locksp, bp, msg, NIL); + erts_queue_message(rp, rp_locksp, mp, msg, NIL); } static void diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 3e300f88ea..019aa0f16c 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -582,7 +582,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)] = sizeof(ErtsDrvSelectDataState); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)] - = sizeof(ErlMessage); + = sizeof(ErtsMessageRef); #ifdef ERTS_SMP fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)] = sizeof(ErtsThrQElement_t); @@ -2916,12 +2916,12 @@ reply_alloc_info(void *vair) int global_instances = air->req_sched == sched_id; ErtsProcLocks rp_locks; Process *rp = air->proc; - Eterm ref_copy = NIL, ai_list, msg; - Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL; + Eterm ref_copy = NIL, ai_list, msg = NIL; + Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL; Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; struct erts_mmap_info_struct emis; int i; Eterm (*info_func)(Allctr_t *, @@ -3123,20 +3123,17 @@ reply_alloc_info(void *vair) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); hp_start = hp; hp_end = hp + sz; szp = NULL; hpp = &hp; } - if (bp) - bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1); - else { - ASSERT(hp); - HRelease(rp, hp_end, hp); - } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + if (hp != hp_end) + erts_shrink_message_heap(&mp, rp, hp_start, hp, hp_end, &msg, 1); + + erts_queue_message(rp, &rp_locks, mp, msg, NIL); if (air->req_sched == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 9da9c823f7..14e80960f5 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -44,9 +44,11 @@ #if ERTS_CAN_INLINE && ERTS_ALC_WANT_INLINE # define ERTS_ALC_DO_INLINE 1 # define ERTS_ALC_INLINE static ERTS_INLINE +# define ERTS_ALC_FORCE_INLINE static ERTS_FORCE_INLINE #else # define ERTS_ALC_DO_INLINE 0 # define ERTS_ALC_INLINE +# define ERTS_ALC_FORCE_INLINE #endif #define ERTS_ALC_NO_FIXED_SIZES \ @@ -293,7 +295,7 @@ int erts_is_allctr_wrapper_prelocked(void) #ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE -ERTS_ALC_INLINE +ERTS_ALC_FORCE_INLINE int erts_is_in_literal_range(void* ptr) { #if defined(ARCH_32) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 7d519c1be4..75b4913012 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -152,6 +152,8 @@ type OLD_HEAP EHEAP PROCESSES old_heap type HEAP_FRAG EHEAP PROCESSES heap_frag type TMP_HEAP TEMPORARY PROCESSES tmp_heap type MSG_REF FIXED_SIZE PROCESSES msg_ref +type MSG EHEAP PROCESSES message +type MSGQ_CHNG SHORT_LIVED PROCESSES messages_queue_change type MSG_ROOTS TEMPORARY PROCESSES msg_roots type ROOTSET TEMPORARY PROCESSES root_set type LOADER_TMP TEMPORARY CODE loader_tmp diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 28bec6325c..2b1d875bfe 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1707,18 +1707,19 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, Eterm mess; Eterm r; Eterm *hp; - ErlHeapFragment *bp; - ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks = 0; + ErlOffHeap *ohp; ERTS_SMP_CHK_NO_PROC_LOCKS; assert_drv_list_rwlocked(); if (errcode != 0) { int need = load_error_need(errcode); Eterm e; - hp = erts_alloc_message_heap(6 /* tuple */ + 3 /* Error tuple */ + - REF_THING_SIZE + need, &bp, &ohp, - proc, &rp_locks); + mp = erts_alloc_message_heap(proc, &rp_locks, + (6 /* tuple */ + 3 /* Error tuple */ + + REF_THING_SIZE + need), + &hp, &ohp); r = copy_ref(ref,hp); hp += REF_THING_SIZE; e = build_load_error_hp(hp, errcode); @@ -1727,12 +1728,14 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, hp += 3; mess = TUPLE5(hp,type,r,am_driver,driver_name,mess); } else { - hp = erts_alloc_message_heap(6 /* tuple */ + REF_THING_SIZE, &bp, &ohp, proc, &rp_locks); + mp = erts_alloc_message_heap(proc, &rp_locks, + 6 /* tuple */ + REF_THING_SIZE, + &hp, &ohp); r = copy_ref(ref,hp); hp += REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } - erts_queue_message(proc, &rp_locks, bp, mess, am_undefined); + erts_queue_message(proc, &rp_locks, mp, mess, am_undefined); erts_smp_proc_unlock(proc, rp_locks); ERTS_SMP_CHK_NO_PROC_LOCKS; } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index a684c81445..1eb106a551 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -589,6 +589,7 @@ static Eterm pi_args[] = { am_min_bin_vheap_size, am_current_location, am_current_stacktrace, + am_off_heap_message_queue }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -636,6 +637,7 @@ pi_arg2ix(Eterm arg) case am_min_bin_vheap_size: return 28; case am_current_location: return 29; case am_current_stacktrace: return 30; + case am_off_heap_message_queue: return 31; default: return -1; } } @@ -718,9 +720,10 @@ pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks) -BIF_RETTYPE +static BIF_RETTYPE process_info_aux(Process *BIF_P, Process *rp, + ErtsProcLocks rp_locks, Eterm rpid, Eterm item, int always_wrap); @@ -811,10 +814,31 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, *fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT; goto done; } - else if (!(locks & ERTS_PROC_LOCK_STATUS)) { - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + else { + ErtsProcLocks unlock_locks = 0; + + if (c_p == rp) + locks |= ERTS_PROC_LOCK_MAIN; + + if (!(locks & ERTS_PROC_LOCK_STATUS)) + unlock_locks |= ERTS_PROC_LOCK_STATUS; + + if (locks & ERTS_PROC_LOCK_MSGQ) { + /* + * Move in queue into private queue and + * release msgq lock, enabling others to + * send messages to the process while it + * is being inspected... + */ + ASSERT(locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + locks &= ~ERTS_PROC_LOCK_MSGQ; + unlock_locks |= ERTS_PROC_LOCK_MSGQ; + } + + if (unlock_locks) + erts_smp_proc_unlock(rp, unlock_locks); } - /* * We always handle 'messages' first if it should be part @@ -826,7 +850,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, if (want_messages) { ix = pi_arg2ix(am_messages); ASSERT(part_res[ix] == THE_NON_VALUE); - part_res[ix] = process_info_aux(c_p, rp, pid, am_messages, always_wrap); + part_res[ix] = process_info_aux(c_p, rp, locks, pid, am_messages, always_wrap); ASSERT(part_res[ix] != THE_NON_VALUE); } @@ -834,7 +858,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, ix = res_elem_ix[res_elem_ix_ix]; if (part_res[ix] == THE_NON_VALUE) { arg = pi_ix2arg(ix); - part_res[ix] = process_info_aux(c_p, rp, pid, arg, always_wrap); + part_res[ix] = process_info_aux(c_p, rp, locks, pid, arg, always_wrap); ASSERT(part_res[ix] != THE_NON_VALUE); } } @@ -965,9 +989,31 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2) ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined); } else { + ErtsProcLocks unlock_locks = 0; + + if (BIF_P == rp) + info_locks |= ERTS_PROC_LOCK_MAIN; + if (!(info_locks & ERTS_PROC_LOCK_STATUS)) - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - res = process_info_aux(BIF_P, rp, pid, BIF_ARG_2, 0); + unlock_locks |= ERTS_PROC_LOCK_STATUS; + + if (info_locks & ERTS_PROC_LOCK_MSGQ) { + /* + * Move in queue into private queue and + * release msgq lock, enabling others to + * send messages to the process while it + * is being inspected... + */ + ASSERT(info_locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + info_locks &= ~ERTS_PROC_LOCK_MSGQ; + unlock_locks |= ERTS_PROC_LOCK_MSGQ; + } + + if (unlock_locks) + erts_smp_proc_unlock(rp, unlock_locks); + + res = process_info_aux(BIF_P, rp, info_locks, pid, BIF_ARG_2, 0); } ASSERT(is_value(res)); @@ -985,6 +1031,7 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2) Eterm process_info_aux(Process *BIF_P, Process *rp, + ErtsProcLocks rp_locks, Eterm rpid, Eterm item, int always_wrap) @@ -1056,171 +1103,55 @@ process_info_aux(Process *BIF_P, break; case am_messages: { - ErlMessage* mp; - int n; - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - n = rp->msg.len; - - if (n == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) { + if (rp->msg.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) { hp = HAlloc(BIF_P, 3); } else { - int remove_bad_messages = 0; - struct { - Uint copy_struct_size; - ErlMessage* msgp; - } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq)); - Sint i = 0; - Uint heap_need = 3; + ErtsMessageInfo *mip; + Sint i; + Uint heap_need; +#ifdef DEBUG Eterm *hp_end; +#endif - for (mp = rp->msg.first; mp; mp = mp->next) { - heap_need += 2; - mq[i].msgp = mp; - if (rp != BIF_P) { - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - if (is_value(msg)) { - mq[i].copy_struct_size = (is_immed(msg)? 0 : - size_object(msg)); - } - else if (mq[i].msgp->data.attached) { - mq[i].copy_struct_size - = erts_msg_attached_data_size(mq[i].msgp); - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - mq[i].copy_struct_size = 0; - } - heap_need += mq[i].copy_struct_size; - } - else { - mq[i].copy_struct_size = mp->data.attached ? - erts_msg_attached_data_size(mp) : 0; - } - i++; - } + mip = erts_alloc(ERTS_ALC_T_TMP, + rp->msg.len*sizeof(ErtsMessageInfo)); - if (rp != BIF_P) { - hp = HAlloc(BIF_P, heap_need); - hp_end = hp + heap_need; - ASSERT(i == n); - for (i--; i >= 0; i--) { - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - if (is_value(msg)) { - if (mq[i].copy_struct_size) - msg = copy_struct(msg, - mq[i].copy_struct_size, - &hp, - &MSO(BIF_P)); - } - else if (mq[i].msgp->data.attached) { - ErlHeapFragment *hfp; - /* - * Decode it into a message buffer and attach it - * to the message instead of the attached external - * term. - * - * Note that we may not pass a process pointer - * to erts_msg_distext2heap(), since it would then - * try to alter locks on that process. - */ - msg = erts_msg_distext2heap( - NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp), - mq[i].msgp->data.dist_ext); - - ERL_MESSAGE_TERM(mq[i].msgp) = msg; - mq[i].msgp->data.heap_frag = hfp; - - if (is_non_value(msg)) { - ASSERT(!mq[i].msgp->data.heap_frag); - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - else { - /* Make our copy of the message */ - ASSERT(size_object(msg) == erts_used_frag_sz(hfp)); - msg = copy_struct(msg, - erts_used_frag_sz(hfp), - &hp, - &MSO(BIF_P)); - } - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - res = CONS(hp, msg, res); - hp += 2; - } - HRelease(BIF_P, hp_end, hp+3); - } - else { - for (i--; i >= 0; i--) { - ErtsHeapFactory factory; - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - - erts_factory_proc_prealloc_init(&factory, BIF_P, - mq[i].copy_struct_size+2); - if (mq[i].msgp->data.attached) { - /* Decode it on the heap */ - erts_move_msg_attached_data_to_heap(&factory, - mq[i].msgp); - msg = ERL_MESSAGE_TERM(mq[i].msgp); - ASSERT(!mq[i].msgp->data.attached); - } - if (is_value(msg)) { - hp = erts_produce_heap(&factory, 2, 0); - res = CONS(hp, msg, res); - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - erts_factory_close(&factory); - } - hp = HAlloc(BIF_P, 3); - } - erts_free(ERTS_ALC_T_TMP, mq); - if (remove_bad_messages) { - ErlMessage **mpp; - /* - * We need to remove bad distribution messages from - * the queue, so that the value returned for - * 'message_queue_len' is consistent with the value - * returned for 'messages'. - */ - mpp = &rp->msg.first; - mp = rp->msg.first; - while (mp) { - if (is_value(ERL_MESSAGE_TERM(mp))) { - mpp = &mp->next; - mp = mp->next; - } - else { - ErlMessage* bad_mp = mp; - ASSERT(!mp->data.attached); - if (rp->msg.save == &mp->next) - rp->msg.save = mpp; - if (rp->msg.last == &mp->next) - rp->msg.last = mpp; - *mpp = mp->next; - mp = mp->next; - rp->msg.len--; - free_message(bad_mp); - } - } + /* + * Note that message queue may shrink when calling + * erts_prep_msgq_for_inspection() since it removes + * corrupt distribution messages. + */ + heap_need = erts_prep_msgq_for_inspection(BIF_P, rp, rp_locks, mip); + heap_need += 3; /* top 2-tuple */ + heap_need += rp->msg.len*2; /* Cons cells */ + + hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */ +#ifdef DEBUG + hp_end = hp + heap_need; +#endif + + /* Build list of messages... */ + for (i = rp->msg.len - 1, res = NIL; i >= 0; i--) { + Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp); + Uint sz = mip[i].size; + + if (sz != 0) + msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap); + + res = CONS(hp, msg, res); + hp += 2; } + + ASSERT(hp_end == hp + 3); + + erts_free(ERTS_ALC_T_TMP, mip); } break; } case am_message_queue_len: hp = HAlloc(BIF_P, 3); - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); res = make_small(rp->msg.len); break; @@ -1408,7 +1339,7 @@ process_info_aux(Process *BIF_P, } case am_total_heap_size: { - ErlMessage *mp; + ErtsMessage *mp; Uint total_heap_size; Uint hsz = 3; @@ -1418,8 +1349,6 @@ process_info_aux(Process *BIF_P, total_heap_size += rp->mbuf_sz; - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - for (mp = rp->msg.first; mp; mp = mp->next) if (mp->data.attached) total_heap_size += erts_msg_attached_data_size(mp); @@ -1441,7 +1370,7 @@ process_info_aux(Process *BIF_P, case am_memory: { /* Memory consumed in bytes */ Uint hsz = 3; - Uint size = erts_process_memory(rp); + Uint size = erts_process_memory(rp, 0); (void) erts_bld_uint(NULL, &hsz, size); hp = HAlloc(BIF_P, hsz); res = erts_bld_uint(&hp, NULL, size); @@ -1567,6 +1496,11 @@ process_info_aux(Process *BIF_P, break; } + case am_off_heap_message_queue: + res = BIF_P->flags & F_OFF_HEAP_MSGQ ? am_true : am_false; + hp = HAlloc(BIF_P, 3); + break; + default: return THE_NON_VALUE; /* will produce badarg */ @@ -2728,6 +2662,10 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_true); } #endif + else if (BIF_ARG_1 == am_off_heap_message_queue) { + BIF_RET(erts_default_spo_flags & SPO_OFF_HEAP_MSGQ + ? am_true : am_false); + } else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) { Uint sz; Eterm res = NIL, tup, text; @@ -3865,9 +3803,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_false); } else { - FLAGS(rp) |= F_FORCE_GC; - if (BIF_P != rp) - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + ERTS_FORCE_GC(BIF_P); BIF_RET(am_true); } } diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 434b6c6d7a..6652ef9bb3 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -309,6 +309,8 @@ void erts_check_for_holes(Process* p) p->last_htop = HEAP_TOP(p); for (hf = MBUF(p); hf != 0; hf = hf->next) { + if (hf == p->heap_hfrag) + continue; if (hf == p->last_mbuf) { break; } @@ -399,7 +401,7 @@ void verify_process(Process *p) erl_exit(1,"Wild pointer found in " name " of %T!\n",p->common.id); } - ErlMessage* mp = p->msg.first; + ErtsMessage* mp = p->msg.first; VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id)); @@ -528,7 +530,7 @@ static void print_process_memory(Process *p) PTR_SIZE, "PCB", dashes, dashes, dashes, dashes); if (p->msg.first != NULL) { - ErlMessage* mp; + ErtsMessage* mp; erts_printf(" Message Queue:\n"); mp = p->msg.first; while (mp != NULL) { diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 2d7b7cafa4..6a52e1a890 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -42,8 +42,6 @@ #include "dtrace-wrapper.h" #include "erl_bif_unique.h" -#define ERTS_CONTINUOUS_NEW_HEAP - #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 @@ -60,58 +58,6 @@ # define ERTS_GC_ASSERT(B) ((void) 1) #endif -#ifdef ERTS_CONTINUOUS_NEW_HEAP -#define ERTS_IS_NEW_HEAP_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - ErtsInArea((Ptr), (NhPtr), (NhSz)) -#define ERTS_IS_LITERAL_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (!ErtsInArea((Ptr), (NhPtr), (NhSz)) \ - && !ErtsInArea((Ptr), (OhPtr), (OhSz))) - -#ifdef ERTS_GC_DEBUG -#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \ - ? (ERTS_GC_ASSERT(!erts_is_literal((TPtr), (Ptr)) \ - && !ErtsInArea((Ptr), (OhPtr), (OhSz))), 1) \ - : (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr)) \ - || ErtsInArea((Ptr), (OhPtr), (OhSz))), 0)) -#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \ - ? (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr))), 1) \ - : (ERTS_GC_ASSERT(!erts_is_literal((TPtr), (Ptr))), 0)) -#endif - -#else - -#define ERTS_IS_NEW_HEAP_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (!erts_is_literal((TPtr), (Ptr)) && !ErtsInArea((Ptr), (OhPtr), (OhSz))) -#define ERTS_IS_LITERAL_PTR__(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (erts_is_literal((TPtr), (Ptr))) - -#ifdef ERTS_GC_DEBUG -#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \ - ? (ERTS_GC_ASSERT(ErtsInArea((Ptr), (NhPtr), (NhSz))), 1) \ - : (ERTS_GC_ASSERT(!ErtsInArea((Ptr), (NhPtr), (NhSz))), 0)) -#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - (ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) \ - ? (ERTS_GC_ASSERT(!ErtsInArea((Ptr), (NhPtr), (NhSz)) \ - && !ErtsInArea((Ptr), (OhPtr), (OhSz))), 1) \ - : (ERTS_GC_ASSERT(ErtsInArea((Ptr), (NhPtr), (NhSz)) \ - || ErtsInArea((Ptr), (OhPtr), (OhSz))), 0)) -#endif - -#endif - -#ifndef ERTS_IS_NEW_HEAP_PTR -#define ERTS_IS_NEW_HEAP_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - ERTS_IS_NEW_HEAP_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) -#endif - -#ifndef ERTS_IS_LITERAL_PTR -#define ERTS_IS_LITERAL_PTR(TPtr, Ptr, NhPtr, NhSz, OhPtr, OhSz) \ - ERTS_IS_LITERAL_PTR__((TPtr), (Ptr), (NhPtr), (NhSz), (OhPtr), (OhSz)) -#endif - /* * Returns number of elements in an array. */ @@ -132,10 +78,10 @@ #define ErtsGcQuickSanityCheck(P) \ do { \ ASSERT((P)->heap < (P)->hend); \ - ASSERT((P)->heap_sz == (P)->hend - (P)->heap); \ + ASSERT((p)->abandoned_heap || (P)->heap_sz == (P)->hend - (P)->heap); \ ASSERT((P)->heap <= (P)->htop && (P)->htop <= (P)->hend); \ ASSERT((P)->heap <= (P)->stop && (P)->stop <= (P)->hend); \ - ASSERT((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend);\ + ASSERT((p)->abandoned_heap || ((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend)); \ OverRunCheck((P)); \ } while (0) #else @@ -163,31 +109,32 @@ typedef struct { static Uint setup_rootset(Process*, Eterm*, int, Rootset*); static void cleanup_rootset(Rootset *rootset); -static Uint combined_message_size(Process* p); static void remove_message_buffers(Process* p); static Eterm *full_sweep_heaps(Process *p, int hibernate, Eterm *n_heap, Eterm* n_htop, - char *h, Uint h_size, char *oh, Uint oh_size, Eterm *objv, int nobj); -static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); -static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); -static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj); +static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj); +static int major_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl); +static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl); +static void do_minor(Process *p, ErlHeapFragment *live_hf_end, + char *mature, Uint mature_size, + Uint new_sz, Eterm* objv, int nobj); static Eterm *sweep_new_heap(Eterm *n_hp, Eterm *n_htop, - char* new_heap, Uint new_heap_size, char* old_heap, Uint old_heap_size); static Eterm *sweep_heaps(Eterm *n_hp, Eterm *n_htop, - char* new_heap, Uint new_heap_size, char* old_heap, Uint old_heap_size); static Eterm* sweep_literal_area(Eterm* n_hp, Eterm* n_htop, - char* new_heap, Uint new_heap_size, - char* old_heap, Uint old_heap_size, - char* src, Uint src_size); + char* old_heap, Uint old_heap_size, + char* src, Uint src_size); static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size); -static Eterm* collect_heap_frags(Process* p, Eterm* heap, - Eterm* htop, Eterm* objv, int nobj); +static Eterm* collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, + Eterm* heap, Eterm* htop, Eterm* objv, int nobj); static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj); static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj); static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj); @@ -204,7 +151,6 @@ static void init_gc_info(ErtsGCInfo *gcip); #ifdef HARDDEBUG static void disallow_heap_frag_ref_in_heap(Process* p); static void disallow_heap_frag_ref_in_old_heap(Process* p); -static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj); #endif #if defined(ARCH_64) @@ -411,10 +357,19 @@ erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high) #undef ptr_within Eterm -erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) +erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, + Eterm result, Eterm* regs, Uint arity) { int cost; + if (p->flags & F_HIBERNATE_SCHED) { + /* + * We just hibernated. We do *not* want to mess + * up the hibernation by an ordinary GC... + */ + return result; + } + if (is_non_value(result)) { if (p->freason == TRAP) { #if HIPE @@ -422,21 +377,28 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; } #endif - cost = erts_garbage_collect(p, 0, regs, p->arity); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity); } else { - cost = erts_garbage_collect(p, 0, regs, arity); + cost = garbage_collect(p, live_hf_end, 0, regs, arity); } } else { Eterm val[1]; val[0] = result; - cost = erts_garbage_collect(p, 0, val, 1); + cost = garbage_collect(p, live_hf_end, 0, val, 1); result = val[0]; } BUMP_REDS(p, cost); return result; } +Eterm +erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) +{ + return erts_gc_after_bif_call_lhf(p, ERTS_INVALID_HFRAG_PTR, + result, regs, arity); +} + static ERTS_INLINE void reset_active_writer(Process *p) { struct erl_off_heap_header* ptr; @@ -450,6 +412,117 @@ static ERTS_INLINE void reset_active_writer(Process *p) } } +#define ERTS_DELAY_GC_EXTRA_FREE 40 + +static int +delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) +{ + ErlHeapFragment *hfrag; + Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop; + Eterm *stop, *hend; + Uint hsz, ssz; + + ERTS_HOLE_CHECK(p); + + if (p->live_hf_end == ERTS_INVALID_HFRAG_PTR) + p->live_hf_end = live_hf_end; + + if (need == 0) + return 1; + + /* + * Satisfy need in a heap fragment... + */ + ASSERT(need > 0); + + orig_heap = p->heap; + orig_hend = p->hend; + orig_htop = p->htop; + orig_stop = p->stop; + + ssz = orig_hend - orig_stop; + hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE; + + hfrag = new_message_buffer(hsz); + hfrag->next = p->mbuf; + p->mbuf = hfrag; + p->mbuf_sz += hsz; + p->heap = p->htop = &hfrag->mem[0]; + p->hend = hend = &hfrag->mem[hsz]; + p->stop = stop = hend - ssz; + sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm)); + + if (p->abandoned_heap) { + /* Active heap already in a fragment; adjust it... */ + ErlHeapFragment *hfrag = ((ErlHeapFragment *) + (((char *) orig_heap) + - offsetof(ErlHeapFragment, mem))); + Uint unused = orig_hend - orig_htop; + ASSERT(hfrag->used_size == hfrag->alloc_size); + ASSERT(hfrag->used_size >= unused); + hfrag->used_size -= unused; + p->mbuf_sz -= unused; + } + else { + /* Do not leave a hole in the abandoned heap... */ + if (orig_htop < orig_hend) { + *orig_htop = make_pos_bignum_header(orig_hend-orig_htop-1); + if (orig_htop + 1 < orig_hend) { + orig_hend[-1] = (Uint) (orig_htop - orig_heap); + p->flags |= F_ABANDONED_HEAP_USE; + } + } + p->abandoned_heap = orig_heap; + } + +#ifdef CHECK_FOR_HOLES + p->last_htop = p->htop; + p->heap_hfrag = hfrag; +#endif + + /* Make sure that we do a proper GC as soon as possible... */ + p->flags |= F_FORCE_GC; + return CONTEXT_REDS; +} + +static ERTS_FORCE_INLINE Uint +young_gen_usage(Process *p) +{ + Uint hsz; + Eterm *aheap; + + hsz = p->mbuf_sz; + aheap = p->abandoned_heap; + if (!aheap) + hsz += p->htop - p->heap; + else { + /* used in orig heap */ + if (p->flags & F_ABANDONED_HEAP_USE) + hsz += aheap[p->heap_sz-1]; + else + hsz += p->heap_sz; + /* Remove unused part in latest fragment */ + hsz -= p->hend - p->htop; + } + return hsz; +} + +#define ERTS_GET_ORIG_HEAP(Proc, Heap, HTop) \ + do { \ + Eterm *aheap__ = (Proc)->abandoned_heap; \ + if (!aheap__) { \ + (Heap) = (Proc)->heap; \ + (HTop) = (Proc)->htop; \ + } \ + else { \ + (Heap) = aheap__; \ + if ((Proc)->flags & F_ABANDONED_HEAP_USE) \ + (HTop) = aheap__ + aheap__[(Proc)->heap_sz-1]; \ + else \ + (HTop) = aheap__ + (Proc)->heap_sz; \ + } \ + } while (0) + /* * Garbage collect a process. * @@ -458,8 +531,9 @@ static ERTS_INLINE void reset_active_writer(Process *p) * objv: Array of terms to add to rootset; that is to preserve. * nobj: Number of objects in objv. */ -int -erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +static int +garbage_collect(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj) { Uint reclaimed_now = 0; int done = 0; @@ -469,10 +543,11 @@ 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) { - ASSERT(need == 0); - return 1; - } + if (p->flags & F_DISABLE_GC) + return delay_garbage_collection(p, live_hf_end, need); + + if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) + live_hf_end = p->live_hf_end; esdp = erts_get_scheduler_data(); @@ -480,7 +555,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) trace_gc(p, am_gc_start); } - (void) erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); + erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); if (erts_system_monitor_long_gc != 0) start_time = erts_get_monotonic_time(esdp); @@ -505,11 +580,11 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) while (!done) { if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { DTRACE2(gc_major_start, pidbuf, need); - done = major_collection(p, need, objv, nobj, &reclaimed_now); + done = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); DTRACE2(gc_major_end, pidbuf, reclaimed_now); } else { DTRACE2(gc_minor_start, pidbuf, need); - done = minor_collection(p, need, objv, nobj, &reclaimed_now); + done = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); DTRACE2(gc_minor_end, pidbuf, reclaimed_now); } } @@ -551,6 +626,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) esdp->gc_info.reclaimed += reclaimed_now; FLAGS(p) &= ~F_FORCE_GC; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; #ifdef CHECK_FOR_HOLES /* @@ -583,6 +659,12 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) } } +int +erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +{ + return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); +} + /* * Place all living data on a the new heap; deallocate any old heap. * Meant to be used by hibernate/3. @@ -606,16 +688,16 @@ erts_garbage_collect_hibernate(Process* p) */ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); ErtsGcQuickSanityCheck(p); - ASSERT(p->mbuf_sz == 0); - ASSERT(p->mbuf == 0); + ASSERT(p->mbuf == NULL); ASSERT(p->stop == p->hend); /* Stack must be empty. */ + ASSERT(!p->abandoned_heap); /* * Do it. */ - heap_size = p->heap_sz + (p->old_htop - p->old_heap); + heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, sizeof(Eterm)*heap_size); htop = heap; @@ -624,8 +706,6 @@ erts_garbage_collect_hibernate(Process* p) 1, heap, htop, - (char *) p->heap, - (char *) p->htop - (char *) p->heap, (char *) p->old_heap, (char *) p->old_htop - (char *) p->old_heap, p->arg_reg, @@ -644,6 +724,7 @@ erts_garbage_collect_hibernate(Process* p) } FLAGS(p) &= ~F_FORCE_GC; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; /* * Move the heap to its final destination. @@ -663,6 +744,8 @@ erts_garbage_collect_hibernate(Process* p) sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); + remove_message_buffers(p); + p->stop = p->hend = heap + heap_size; offs = heap - p->heap; @@ -808,7 +891,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, old_htop = sweep_literals_to_old_heap(p->heap, p->htop, old_htop, area, area_size); old_htop = sweep_literal_area(p->old_heap, old_htop, - (char *) p->heap, sizeof(Eterm)*p->heap_sz, (char *) p->old_heap, sizeof(Eterm)*old_heap_size, area, area_size); ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend); @@ -869,15 +951,18 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, } static int -minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +minor_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl) { - Uint mature = HIGH_WATER(p) - HEAP_START(p); + Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap; + Uint mature_size = p->high_water - mature; + Uint size_before = young_gen_usage(p); /* * Allocate an old heap if we don't have one and if we'll need one. */ - if (OLD_HEAP(p) == NULL && mature != 0) { + if (OLD_HEAP(p) == NULL && mature_size != 0) { Eterm* n_old; /* Note: We choose a larger heap size than strictly needed, @@ -885,7 +970,7 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * This improved Estone by more than 1200 estones on my computer * (Ultra Sparc 10). */ - Uint new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1); + Uint new_sz = erts_next_heap_size(size_before, 1); /* Create new, empty old_heap */ n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP, @@ -901,41 +986,25 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) */ if (OLD_HEAP(p) && - ((mature <= OLD_HEND(p) - OLD_HTOP(p)) && - ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && - ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { - ErlMessage *msgp; - Uint size_after; - Uint need_after; - const Uint stack_size = STACK_SZ_ON_HEAP(p); - const Uint size_before = MBUF_SIZE(p) + (HEAP_TOP(p) - HEAP_START(p)); - Uint new_sz = HEAP_SIZE(p) + MBUF_SIZE(p) + combined_message_size(p); + ((mature_size <= OLD_HEND(p) - OLD_HTOP(p)) && + ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && + ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { + Uint stack_size, size_after, need_after, new_sz; + + stack_size = p->hend - p->stop; + new_sz = stack_size + size_before; new_sz = next_heap_size(p, new_sz, 0); - do_minor(p, new_sz, objv, nobj); + do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm), + new_sz, objv, nobj); size_after = HEAP_TOP(p) - HEAP_START(p); *recl += (size_before - size_after); - /* - * Copy newly received message onto the end of the new heap. - */ - ErtsGcQuickSanityCheck(p); - for (msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) { - ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, - erts_msg_attached_data_size(msgp)); - erts_move_msg_attached_data_to_heap(&factory, msgp); - erts_factory_close(&factory); - ErtsGcQuickSanityCheck(p); - } - } ErtsGcQuickSanityCheck(p); GEN_GCS(p)++; need_after = ((HEAP_TOP(p) - HEAP_START(p)) - + erts_used_frag_sz(MBUF(p)) + need + stack_size); @@ -984,10 +1053,13 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) ASSERT(MBUF(p) == NULL); return 1; } + + grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj); + return 1; } /* - * Still not enough room after minor collection. Must force a major collection. + * Not enough room for a minor collection. Must force a major collection. */ FLAGS(p) |= F_NEED_FULLSWEEP; return 0; @@ -1044,7 +1116,9 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs, #endif /* HIPE */ static void -do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) +do_minor(Process *p, ErlHeapFragment *live_hf_end, + char *mature, Uint mature_size, + Uint new_sz, Eterm* objv, int nobj) { Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */ Roots* roots; @@ -1053,9 +1127,6 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) Eterm* ptr; Eterm val; Eterm gval; - char* heap = (char *) HEAP_START(p); - Uint heap_size = (char *) HEAP_TOP(p) - heap; - Uint mature_size = (char *) HIGH_WATER(p) - heap; Eterm* old_htop = OLD_HTOP(p); Eterm* n_heap; char* oh = (char *) OLD_HEAP(p); @@ -1064,8 +1135,13 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); - if (MBUF(p) != NULL) { - n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + if (live_hf_end != ERTS_INVALID_HFRAG_PTR) { + /* + * Move heap frags that we know are completely live + * directly into the new young heap generation. + */ + n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop, + objv, nobj); } n = setup_rootset(p, objv, nobj, &rootset); @@ -1088,11 +1164,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *g_ptr++ = val; - } else if (ErtsInArea(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,g_ptr++); - } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr, - heap, heap_size, - oh, oh_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1105,11 +1179,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) val = *ptr; if (IS_MOVED_CONS(val)) { /* Moved */ *g_ptr++ = ptr[1]; - } else if (ErtsInArea(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr,val,old_htop,g_ptr++); - } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr, - heap, heap_size, - oh, oh_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_CONS(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1134,8 +1206,7 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) */ if (mature_size == 0) { - n_htop = sweep_new_heap(n_heap, n_htop, heap, heap_size, - oh, oh_size); + n_htop = sweep_new_heap(n_heap, n_htop, oh, oh_size); } else { Eterm* n_hp = n_heap; Eterm* ptr; @@ -1152,11 +1223,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *n_hp++ = val; - } else if (ErtsInArea(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,n_hp++); - } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr, - heap, heap_size, - oh, oh_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1168,11 +1237,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) val = *ptr; if (IS_MOVED_CONS(val)) { *n_hp++ = ptr[1]; - } else if (ErtsInArea(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr,val,old_htop,n_hp++); - } else if (ERTS_IS_NEW_HEAP_PTR(gval, ptr, - heap, heap_size, - oh, oh_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_CONS(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1192,12 +1259,10 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { *origptr = val; mb->base = binary_bytes(val); - } else if (ErtsInArea(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,origptr); mb->base = binary_bytes(mb->orig); - } else if (ERTS_IS_NEW_HEAP_PTR(*origptr, ptr, - heap, heap_size, - oh, oh_size)) { + } else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,origptr); mb->base = binary_bytes(mb->orig); } @@ -1218,11 +1283,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) * may point to the old (soon to be deleted) new_heap. */ - if (OLD_HTOP(p) < old_htop) { - old_htop = sweep_new_heap(OLD_HTOP(p), old_htop, - heap, heap_size, - oh, oh_size); - } + if (OLD_HTOP(p) < old_htop) + old_htop = sweep_new_heap(OLD_HTOP(p), old_htop, oh, oh_size); OLD_HTOP(p) = old_htop; HIGH_WATER(p) = n_htop; @@ -1254,8 +1316,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) #endif ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (void*)HEAP_START(p), + (p->abandoned_heap + ? p->abandoned_heap + : HEAP_START(p)), HEAP_SIZE(p) * sizeof(Eterm)); + p->abandoned_heap = NULL; + p->flags &= ~F_ABANDONED_HEAP_USE; HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; @@ -1272,15 +1338,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) */ static int -major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +major_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl) { - const Uint size_before = ((HEAP_TOP(p) - HEAP_START(p)) - + (OLD_HTOP(p) - OLD_HEAP(p)) - + MBUF_SIZE(p)); + Uint size_before, stack_size; Eterm* n_heap; Eterm* n_htop; - char* src = (char *) HEAP_START(p); - Uint src_size = (char *) HEAP_TOP(p) - src; char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; Uint new_sz, stk_sz; @@ -1290,9 +1353,11 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * to receive all live data. */ - new_sz = (HEAP_SIZE(p) + MBUF_SIZE(p) - + combined_message_size(p) - + (OLD_HTOP(p) - OLD_HEAP(p))); + size_before = young_gen_usage(p); + size_before += p->old_htop - p->old_heap; + stack_size = p->hend - p->stop; + + new_sz = stack_size + size_before; new_sz = next_heap_size(p, new_sz, 0); /* @@ -1306,16 +1371,16 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) n_htop = n_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); - /* - * Get rid of heap fragments. - */ - - if (MBUF(p) != NULL) { - n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + if (live_hf_end != ERTS_INVALID_HFRAG_PTR) { + /* + * Move heap frags that we know are completely live + * directly into the heap. + */ + n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop, + objv, nobj); } - n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, src, src_size, - oh, oh_size, objv, nobj); + n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, oh, oh_size, objv, nobj); /* Move the stack to the end of the heap */ stk_sz = HEAP_END(p) - p->stop; @@ -1332,8 +1397,12 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) #endif ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (void *) HEAP_START(p), + (p->abandoned_heap + ? p->abandoned_heap + : HEAP_START(p)), (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm)); + p->abandoned_heap = NULL; + p->flags &= ~F_ABANDONED_HEAP_USE; HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; @@ -1346,24 +1415,6 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) *recl += size_before - (HEAP_TOP(p) - HEAP_START(p)); - { - ErlMessage *msgp; - - /* - * Copy newly received message onto the end of the new heap. - */ - for (msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) { - ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, - erts_msg_attached_data_size(msgp)); - erts_move_msg_attached_data_to_heap(&factory, msgp); - erts_factory_close(&factory); - ErtsGcQuickSanityCheck(p); - } - } - } - adjust_after_fullsweep(p, need, objv, nobj); #ifdef HARDDEBUG @@ -1379,7 +1430,6 @@ static Eterm * full_sweep_heaps(Process *p, int hibernate, Eterm *n_heap, Eterm* n_htop, - char *h, Uint h_size, char *oh, Uint oh_size, Eterm *objv, int nobj) { @@ -1420,9 +1470,7 @@ full_sweep_heaps(Process *p, if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *g_ptr++ = val; - } else if (!ERTS_IS_LITERAL_PTR(gval, ptr, - h, h_size, - oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_BOXED(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1435,9 +1483,7 @@ full_sweep_heaps(Process *p, val = *ptr; if (IS_MOVED_CONS(val)) { *g_ptr++ = ptr[1]; - } else if (!ERTS_IS_LITERAL_PTR(gval, ptr, - h, h_size, - oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_CONS(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1462,7 +1508,7 @@ full_sweep_heaps(Process *p, * until all is copied. */ - n_htop = sweep_heaps(n_heap, n_htop, h, h_size, oh, oh_size); + n_htop = sweep_heaps(n_heap, n_htop, oh, oh_size); if (MSO(p).first) { sweep_off_heap(p, 1); @@ -1513,23 +1559,6 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) } } -/* - * Return the size of all message buffers that are NOT linked in the - * mbuf list. - */ -static Uint -combined_message_size(Process* p) -{ - Uint sz; - ErlMessage *msgp; - - for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) - sz += erts_msg_attached_data_size(msgp); - } - return sz; -} - /* * Remove all message buffers. */ @@ -1540,6 +1569,10 @@ remove_message_buffers(Process* p) free_message_buffer(MBUF(p)); MBUF(p) = NULL; } + if (p->msg_frag) { + erts_cleanup_messages(p->msg_frag); + p->msg_frag = NULL; + } MBUF_SIZE(p) = 0; } #ifdef HARDDEBUG @@ -1551,64 +1584,6 @@ remove_message_buffers(Process* p) * For performance reasons, we use _unchecked_list_val(), _unchecked_boxed_val(), * and so on to avoid a function call. */ - -static void -disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj) -{ - ErlHeapFragment* mbuf; - ErlHeapFragment* qb; - Eterm gval; - Eterm* ptr; - Eterm val; - - ASSERT(p->htop != NULL); - mbuf = MBUF(p); - - while (nobj--) { - gval = *objv; - - switch (primary_tag(gval)) { - - case TAG_PRIMARY_BOXED: { - ptr = _unchecked_boxed_val(gval); - val = *ptr; - if (IS_MOVED_BOXED(val)) { - ASSERT(is_boxed(val)); - objv++; - } else { - for (qb = mbuf; qb != NULL; qb = qb->next) { - if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { - abort(); - } - } - objv++; - } - break; - } - - case TAG_PRIMARY_LIST: { - ptr = _unchecked_list_val(gval); - val = *ptr; - if (IS_MOVED_CONS(val)) { - objv++; - } else { - for (qb = mbuf; qb != NULL; qb = qb->next) { - if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { - abort(); - } - } - objv++; - } - break; - } - - default: { - objv++; - break; - } - } - } -} static void disallow_heap_frag_ref_in_heap(Process* p) @@ -1737,7 +1712,6 @@ typedef enum { static ERTS_FORCE_INLINE Eterm * sweep(Eterm *n_hp, Eterm *n_htop, ErtsSweepType type, - char *h, Uint hsz, char *oh, Uint ohsz, char *src, Uint src_size) { @@ -1749,14 +1723,10 @@ sweep(Eterm *n_hp, Eterm *n_htop, #define ERTS_IS_IN_SWEEP_AREA(TPtr, Ptr) \ (type == ErtsSweepHeaps \ - ? !ERTS_IS_LITERAL_PTR((TPtr), (Ptr), h, hsz, oh, ohsz) \ + ? !erts_is_literal((TPtr), (Ptr)) \ : (type == ErtsSweepNewHeap \ - ? ERTS_IS_NEW_HEAP_PTR((TPtr), (Ptr), h, hsz, oh, ohsz) \ - : (ErtsInArea((Ptr), src, src_size) \ - ? (ERTS_GC_ASSERT(erts_is_literal((TPtr), (Ptr)) \ - && !ErtsInArea((Ptr), h, hsz) \ - && !ErtsInArea((Ptr), oh, ohsz)), 1) \ - : 0))) + ? ErtsInYoungGen((TPtr), (Ptr), oh, ohsz) \ + : ErtsInArea((Ptr), src, src_size))) while (n_hp != n_htop) { ASSERT(n_hp < n_htop); @@ -1820,38 +1790,30 @@ sweep(Eterm *n_hp, Eterm *n_htop, } static Eterm * -sweep_new_heap(Eterm *n_hp, Eterm *n_htop, - char* new_heap, Uint new_heap_size, - char* old_heap, Uint old_heap_size) +sweep_new_heap(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size) { return sweep(n_hp, n_htop, ErtsSweepNewHeap, - new_heap, new_heap_size, old_heap, old_heap_size, NULL, 0); } static Eterm * -sweep_heaps(Eterm *n_hp, Eterm *n_htop, - char* new_heap, Uint new_heap_size, - char* old_heap, Uint old_heap_size) +sweep_heaps(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size) { return sweep(n_hp, n_htop, ErtsSweepHeaps, - new_heap, new_heap_size, old_heap, old_heap_size, NULL, 0); } static Eterm * sweep_literal_area(Eterm *n_hp, Eterm *n_htop, - char* new_heap, Uint new_heap_size, char* old_heap, Uint old_heap_size, char* src, Uint src_size) { return sweep(n_hp, n_htop, ErtsSweepLiteralArea, - new_heap, new_heap_size, old_heap, old_heap_size, src, src_size); } @@ -1956,32 +1918,21 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size) */ static Eterm* -collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, - Eterm* objv, int nobj) +collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, + Eterm* n_hstart, Eterm* n_htop, + Eterm* objv, int nobj) { ErlHeapFragment* qb; char* frag_begin; Uint frag_size; - /* - * We don't allow references to a heap fragments from the stack, heap, - * or process dictionary. - */ -#ifdef HARDDEBUG - disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop); - if (p->dictionary != NULL) { - disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used); - } - disallow_heap_frag_ref_in_heap(p); -#endif - /* * Move the heap fragments to the new heap. Note that no GC is done on * the heap fragments. Any garbage will thus be moved as well and survive * until next GC. */ qb = MBUF(p); - while (qb != NULL) { + while (qb != live_hf_end) { ASSERT(!qb->off_heap.first); /* process fragments use the MSO(p) list */ frag_size = qb->used_size * sizeof(Eterm); if (frag_size != 0) { @@ -1996,9 +1947,7 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, static Uint setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) { - Uint avail; Roots* roots; - ErlMessage* mp; Uint n; n = 0; @@ -2076,31 +2025,48 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ASSERT(n <= rootset->size); - mp = p->msg.first; - avail = rootset->size - n; - while (mp != NULL) { - if (avail == 0) { - Uint new_size = 2*rootset->size; - if (roots == rootset->def) { - roots = erts_alloc(ERTS_ALC_T_ROOTSET, - new_size*sizeof(Roots)); - sys_memcpy(roots, rootset->def, sizeof(rootset->def)); - } else { - roots = erts_realloc(ERTS_ALC_T_ROOTSET, - (void *) roots, - new_size*sizeof(Roots)); - } + switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) { + case F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG: + (void) erts_move_messages_off_heap(p); + case F_OFF_HEAP_MSGQ: + break; + case F_OFF_HEAP_MSGQ_CHNG: + case 0: { + /* + * Off heap message queue disabled, i.e. we may + * have references from the message queue to the + * heap... + */ + ErtsMessage *mp; + + /* Ensure large enough rootset... */ + if (n + p->msg.len > rootset->size) { + Uint new_size = n + p->msg.len; + ERTS_GC_ASSERT(roots == rootset->def); + roots = erts_alloc(ERTS_ALC_T_ROOTSET, + new_size*sizeof(Roots)); + sys_memcpy(roots, rootset->def, n*sizeof(Roots)); rootset->size = new_size; - avail = new_size - n; } - if (mp->data.attached == NULL) { - roots[n].v = mp->m; - roots[n].sz = 2; - n++; - avail--; + + for (mp = p->msg.first; mp; mp = mp->next) { + + if (!mp->data.attached) { + /* + * Message may refer data on heap; + * add it to rootset... + */ + roots[n].v = mp->m; + roots[n].sz = ERL_MESSAGE_REF_ARRAY_SZ; + n++; + } } - mp = mp->next; + break; + } } + + ASSERT(rootset->size >= n); + rootset->roots = roots; rootset->num_roots = n; return n; @@ -2569,7 +2535,7 @@ offset_off_heap(Process* p, Sint offs, char* area, Uint area_size) static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size) { - ErlMessage* mp = p->msg.first; + ErtsMessage* mp = p->msg.first; while (mp != NULL) { Eterm mesg = ERL_MESSAGE_TERM(mp); @@ -2656,7 +2622,7 @@ reply_gc_info(void *vgcirp) Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; ASSERT(esdp); @@ -2682,12 +2648,13 @@ reply_gc_info(void *vgcirp) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg, NIL); if (gcirp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2739,36 +2706,49 @@ erts_gc_info_request(Process *c_p) static int within2(Eterm *ptr, Process *p, Eterm *real_htop) { - ErlHeapFragment* bp = MBUF(p); - ErlMessage* mp = p->msg.first; - Eterm *htop = real_htop ? real_htop : HEAP_TOP(p); + ErlHeapFragment* bp; + ErtsMessage* mp; + Eterm *htop, *heap; + + if (p->abandoned_heap) + ERTS_GET_ORIG_HEAP(p, heap, htop); + else { + heap = p->heap; + htop = real_htop ? real_htop : HEAP_TOP(p); + } if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) { return 1; } - if (HEAP_START(p) <= ptr && ptr < htop) { + if (heap <= ptr && ptr < htop) { return 1; } - while (bp != NULL) { - if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) { - return 1; - } - bp = bp->next; - } + + mp = p->msg_frag; + bp = p->mbuf; + + if (bp) + goto search_heap_frags; + while (mp) { - if (mp->data.attached) { - ErlHeapFragment *hfp; - if (is_value(ERL_MESSAGE_TERM(mp))) - hfp = mp->data.heap_frag; - else if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) - hfp = erts_dist_ext_trailer(mp->data.dist_ext); - else - hfp = NULL; - if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->used_size) + + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &mp->hfrag; + else + bp = mp->data.heap_frag; + + mp = mp->next; + + search_heap_frags: + + while (bp) { + if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) { return 1; + } + bp = bp->next; } - mp = mp->next; } + return 0; } @@ -2790,11 +2770,11 @@ do { \ __FILE__, __LINE__, #EXP); \ } while (0) + #ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST # define ERTS_OFFHEAP_VISITED_BIT ((Eterm) 1 << 31) #endif - void erts_check_off_heap2(Process *p, Eterm *htop) { @@ -2823,7 +2803,7 @@ erts_check_off_heap2(Process *p, Eterm *htop) } ERTS_CHK_OFFHEAP_ASSERT(refc >= 1); #ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST - ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_EXTERNAL_VISITED_BIT)); + ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_OFFHEAP_VISITED_BIT)); u.hdr->thing_word |= ERTS_OFFHEAP_VISITED_BIT; #endif if (old) { @@ -2836,7 +2816,7 @@ erts_check_off_heap2(Process *p, Eterm *htop) } } -#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST for (u.hdr = MSO(p).first; u.hdr; u.hdr = u.hdr->next) u.hdr->thing_word &= ~ERTS_OFFHEAP_VISITED_BIT; #endif diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index fdbf948f9d..a496c5f008 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -69,13 +69,14 @@ do { \ while (nelts--) *HTOP++ = *PTR++; \ } while(0) -#define in_area(ptr,start,nbytes) \ - ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) - #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) int within(Eterm *ptr, Process *p); #endif +#define ErtsInYoungGen(TPtr, Ptr, OldHeap, OldHeapSz) \ + (!erts_is_literal((TPtr), (Ptr)) \ + & !ErtsInArea((Ptr), (OldHeap), (OldHeapSz))) + ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -98,6 +99,7 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag) } return term; } + #endif #endif /* ERL_GC_C__ || HIPE_GC_C__ */ @@ -106,6 +108,23 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag) * Global exported */ +#define ERTS_IS_GC_DESIRED_INTERNAL(Proc, HTop, STop) \ + ((((STop) - (HTop) < (Proc)->mbuf_sz)) \ + | ((Proc)->off_heap.overhead > (Proc)->bin_vheap_sz) \ + | !!((Proc)->flags & F_FORCE_GC)) + +#define ERTS_IS_GC_DESIRED(Proc) \ + ERTS_IS_GC_DESIRED_INTERNAL((Proc), (Proc)->htop, (Proc)->stop) + +#define ERTS_FORCE_GC_INTERNAL(Proc, FCalls) \ + do { \ + (Proc)->flags |= F_FORCE_GC; \ + ERTS_VBUMP_ALL_REDS_INTERNAL((Proc), (FCalls)); \ + } while (0) + +#define ERTS_FORCE_GC(Proc) \ + ERTS_FORCE_GC_INTERNAL((Proc), (Proc)->fcalls) + extern Uint erts_test_long_gc_sleep; typedef struct { @@ -117,6 +136,8 @@ void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); int erts_garbage_collect(struct process*, int, Eterm*, int); void erts_garbage_collect_hibernate(struct process* p); +Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, + Eterm result, Eterm* regs, Uint arity); Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); void erts_garbage_collect_literals(struct process* p, Eterm* literals, Uint lit_size, diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 51a0d68247..6853278828 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1245,7 +1245,9 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) * the middle of tree destruction). */ if (!ERTS_PROC_IS_EXITING(proc)) { - erts_queue_message(proc, &proc_locks, tmr->btm.bp, + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = tmr->btm.bp; + erts_queue_message(proc, &proc_locks, mp, tmr->btm.message, NIL); erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND); queued_message = 1; @@ -1926,36 +1928,31 @@ access_sched_local_btm(Process *c_p, Eterm pid, if (proc) { Uint hsz; - ErlOffHeap *ohp; - ErlHeapFragment* bp; + ErtsMessage *mp; Eterm *hp, msg, ref, result; + ErlOffHeap *ohp; + Uint32 *refn; #ifdef ERTS_HLT_DEBUG Eterm *hp_end; #endif - hsz = 3; /* 2-tuple */ - if (!async) - hsz += REF_THING_SIZE; + hsz = REF_THING_SIZE; + if (async) { + refn = trefn; /* timer ref */ + hsz += 4; /* 3-tuple */ + } else { - if (is_non_value(tref) || proc != c_p) - hsz += REF_THING_SIZE; - hsz += 1; /* upgrade to 3-tuple */ + refn = rrefn; /* request ref */ + hsz += 3; /* 2-tuple */ } + + ERTS_HLT_ASSERT(refn); + if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); - if (proc == c_p) { - bp = NULL; - ohp = NULL; - hp = HAlloc(c_p, hsz); - } - else { - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - proc, - &proc_locks); - } + mp = erts_alloc_message_heap(proc, &proc_locks, + hsz, &hp, &ohp); #ifdef ERTS_HLT_DEBUG hp_end = hp + hsz; @@ -1968,35 +1965,22 @@ access_sched_local_btm(Process *c_p, Eterm pid, else result = erts_sint64_to_big(time_left, &hp); - if (!async) { - write_ref_thing(hp, - rrefn[0], - rrefn[1], - rrefn[2]); - ref = make_internal_ref(hp); - hp += REF_THING_SIZE; - msg = TUPLE2(hp, ref, result); + write_ref_thing(hp, + refn[0], + refn[1], + refn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; - ERTS_HLT_ASSERT(hp + 3 == hp_end); - } - else { - Eterm tag = cancel ? am_cancel_timer : am_read_timer; - if (is_value(tref) && proc == c_p) - ref = tref; - else { - write_ref_thing(hp, - trefn[0], - trefn[1], - trefn[2]); - ref = make_internal_ref(hp); - hp += REF_THING_SIZE; - } - msg = TUPLE3(hp, tag, ref, result); + msg = (async + ? TUPLE3(hp, (cancel + ? am_cancel_timer + : am_read_timer), ref, result) + : TUPLE2(hp, ref, result)); - ERTS_HLT_ASSERT(hp + 4 == hp_end); + ERTS_HLT_ASSERT(hp + (async ? 4 : 3) == hp_end); - } - erts_queue_message(proc, &proc_locks, bp, msg, NIL); + erts_queue_message(proc, &proc_locks, mp, msg, NIL); if (c_p) proc_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2093,16 +2077,19 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, } } else { + ErtsMessage *mp; Eterm tag, res, msg; Uint hsz; Eterm *hp; ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; + ErlOffHeap *ohp; hsz = 4; if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); - hp = HAlloc(c_p, hsz); + mp = erts_alloc_message_heap(c_p, &proc_locks, + hsz, &hp, &ohp); if (cancel) tag = am_cancel_timer; else @@ -2117,7 +2104,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, msg = TUPLE3(hp, tag, tref, res); - erts_queue_message(c_p, &proc_locks, NULL, msg, NIL); + erts_queue_message(c_p, &proc_locks, mp, msg, NIL); proc_locks &= ~ERTS_PROC_LOCK_MAIN; if (proc_locks) diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 5c209a4af2..f396a0a156 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -431,7 +431,7 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** hp += 2; args = CONS(hp, env, args); - so.flags = SPO_SYSTEM_PROC; + so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC; res = erl_create_process(&parent, start_mod, am_start, args, &so); erts_smp_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN); erts_cleanup_empty_process(&parent); @@ -630,6 +630,7 @@ void erts_usage(void) erts_fprintf(stderr, "-W set error logger warnings mapping,\n"); erts_fprintf(stderr, " see error_logger documentation for details\n"); + erts_fprintf(stderr, "-xohmq bool set default off_heap_message_queue flag for processes\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n"); @@ -2015,6 +2016,26 @@ erl_start(int argc, char **argv) } break; + case 'x': { + char *sub_param = argv[i]+2; + if (has_prefix("ohmq", sub_param)) { + arg = get_arg(sub_param+4, argv[i+1], &i); + if (sys_strcmp(arg, "true") == 0) + erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; + else if (sys_strcmp(arg, "false") == 0) + erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; + else { + erts_fprintf(stderr, + "Invalid off_heap_message_queue flag: %s\n", arg); + erts_usage(); + } + } else { + erts_fprintf(stderr, "bad -x option %s\n", argv[i]); + erts_usage(); + } + break; + } + case 'z': { char *sub_param = argv[i]+2; @@ -2068,7 +2089,8 @@ erl_start(int argc, char **argv) "Invalid ets busy wait threshold: %s\n", arg); erts_usage(); } - } else { + } + else { erts_fprintf(stderr, "bad -z option %s\n", argv[i]); erts_usage(); } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index e23c79d301..79739501a8 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -33,8 +33,8 @@ #include "erl_binary.h" #include "dtrace-wrapper.h" -ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, - ErlMessage, +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message_ref, + ErtsMessageRef, ERL_MESSAGE_BUF_SZ, ERTS_ALC_T_MSG_REF) @@ -44,27 +44,20 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, #undef HARD_DEBUG #endif - - - -#ifdef DEBUG -static ERTS_INLINE int in_heapfrag(const Eterm* ptr, const ErlHeapFragment *bp) +void +init_message(void) { - return ((unsigned)(ptr - bp->mem) < bp->used_size); + init_message_ref_alloc(); } -#endif - -void -init_message(void) +void *erts_alloc_message_ref(void) { - init_message_alloc(); + return (void *) message_ref_alloc(); } -void -free_message(ErlMessage* mp) +void erts_free_message_ref(void *mp) { - message_free(mp); + message_ref_free((ErtsMessageRef *) mp); } /* Allocate message buffer (size in words) */ @@ -74,7 +67,7 @@ new_message_buffer(Uint size) ErlHeapFragment* bp; bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(size)); - ERTS_INIT_HEAP_FRAG(bp, size); + ERTS_INIT_HEAP_FRAG(bp, size, size); return bp; } @@ -203,83 +196,87 @@ free_message_buffer(ErlHeapFragment* bp) }while (bp != NULL); } -static ERTS_INLINE void -link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp) +void +erts_cleanup_messages(ErtsMessage *msgp) { - if (bp) { - /* Link the message buffer */ - bp->next = MBUF(proc); - MBUF(proc) = bp; - MBUF_SIZE(proc) += bp->used_size; - FLAGS(proc) |= F_FORCE_GC; - - /* Move any off_heap's into the process */ - if (bp->off_heap.first != NULL) { - struct erl_off_heap_header** next_p = &bp->off_heap.first; - while (*next_p != NULL) { - next_p = &((*next_p)->next); + ErtsMessage *mp = msgp; + while (mp) { + ErtsMessage *fmp; + ErlHeapFragment *bp; + if (is_non_value(ERL_MESSAGE_TERM(mp))) { + if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) { + bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; + erts_cleanup_offheap(&bp->off_heap); } - *next_p = MSO(proc).first; - MSO(proc).first = bp->off_heap.first; - bp->off_heap.first = NULL; - OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); + if (mp->data.dist_ext) + erts_free_dist_ext_copy(mp->data.dist_ext); } + else { + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) + bp = mp->data.heap_frag; + else { + bp = mp->hfrag.next; + erts_cleanup_offheap(&mp->hfrag.off_heap); + } + if (bp) + free_message_buffer(bp); + } + fmp = mp; + mp = mp->next; + erts_free_message(fmp); } } -Eterm -erts_msg_distext2heap(Process *pp, - ErtsProcLocks *plcksp, - ErlHeapFragment **bpp, - Eterm *tokenp, - ErtsDistExternal *dist_extp) +ErtsMessage * +erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size) { - Eterm msg; - Uint tok_sz = 0; - Eterm *hp = NULL; - ErtsHeapFactory factory; - Sint sz; - - *bpp = NULL; - sz = erts_decode_dist_ext_size(dist_extp); - if (sz < 0) - goto decode_error; - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - tok_sz = heap_frag->used_size; - sz += tok_sz; - } - if (pp) { - ErlOffHeap *ohp; - hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp); - } - else { - *bpp = new_message_buffer(sz); - hp = (*bpp)->mem; - } - erts_factory_message_init(&factory, pp, hp, *bpp); - msg = erts_decode_dist_ext(&factory, dist_extp); - if (is_non_value(msg)) - goto decode_error; - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - hp = erts_produce_heap(&factory, tok_sz, 0); - *tokenp = copy_struct(*tokenp, tok_sz, &hp, factory.off_heap); - erts_cleanup_offheap(&heap_frag->off_heap); + ErtsMessage *nmp = erts_realloc(ERTS_ALC_T_MSG, mp, + sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm)); + if (nmp != mp) { + Eterm *sp = &mp->hfrag.mem[0]; + Eterm *ep = sp + sz; + Sint offs = &nmp->hfrag.mem[0] - sp; + erts_offset_off_heap(&nmp->hfrag.off_heap, offs, sp, ep); + erts_offset_heap(&nmp->hfrag.mem[0], sz, offs, sp, ep); + if (brefs && brefs_size) + erts_offset_heap_ptr(brefs, brefs_size, offs, sp, ep); } - erts_free_dist_ext_copy(dist_extp); - erts_factory_close(&factory); - return msg; - decode_error: - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - erts_cleanup_offheap(&heap_frag->off_heap); + nmp->hfrag.used_size = sz; + nmp->hfrag.alloc_size = sz; + + return nmp; +} + +void +erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) +{ + if (first_bp) { + ErlHeapFragment *bp = first_bp; + + while (1) { + /* Move any off_heap's into the process */ + if (bp->off_heap.first != NULL) { + struct erl_off_heap_header** next_p = &bp->off_heap.first; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).first; + MSO(proc).first = bp->off_heap.first; + bp->off_heap.first = NULL; + OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); + } + MBUF_SIZE(proc) += bp->used_size; + if (!bp->next) + break; + bp = bp->next; + } + + /* Link the message buffer */ + bp->next = MBUF(proc); + MBUF(proc) = first_bp; } - erts_free_dist_ext_copy(dist_extp); - *bpp = NULL; - return THE_NON_VALUE; - } +} void erts_queue_dist_message(Process *rcvr, @@ -287,7 +284,7 @@ erts_queue_dist_message(Process *rcvr, ErtsDistExternal *dist_ext, Eterm token) { - ErlMessage* mp; + ErtsMessage* mp; #ifdef USE_VM_PROBES Sint tok_label = 0; Sint tok_lastcnt = 0; @@ -299,7 +296,17 @@ erts_queue_dist_message(Process *rcvr, ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr)); - mp = message_alloc(); + mp = erts_alloc_message(0, NULL); + mp->data.dist_ext = dist_ext; + + ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; +#ifdef USE_VM_PROBES + ERL_MESSAGE_DT_UTAG(mp) = NIL; + if (token == am_have_dt_utag) + ERL_MESSAGE_TOKEN(mp) = NIL; + else +#endif + ERL_MESSAGE_TOKEN(mp) = token; #ifdef ERTS_SMP if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) { @@ -318,58 +325,40 @@ erts_queue_dist_message(Process *rcvr, if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); /* Drop message if receiver is exiting or has a pending exit ... */ - if (is_not_nil(token)) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(mp->data.dist_ext); - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(dist_ext); - message_free(mp); + erts_cleanup_messages(mp); } else #endif if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) { /* Ahh... need to decode it in order to trace it... */ - ErlHeapFragment *mbuf; - Eterm msg; if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); - message_free(mp); - msg = erts_msg_distext2heap(rcvr, rcvr_locks, &mbuf, &token, dist_ext); - if (is_value(msg)) + if (!erts_decode_dist_message(rcvr, *rcvr_locks, mp, 0)) + erts_free_message(mp); + else { + Eterm msg = ERL_MESSAGE_TERM(mp); + token = ERL_MESSAGE_TOKEN(mp); #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_queued)) { - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - - dtrace_proc_str(rcvr, receiver_name); - 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)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); - } - DTRACE6(message_queued, - receiver_name, size_object(msg), rcvr->msg.len, - tok_label, tok_lastcnt, tok_serial); - } + if (DTRACE_ENABLED(message_queued)) { + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + + dtrace_proc_str(rcvr, receiver_name); + 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)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); + } + DTRACE6(message_queued, + receiver_name, size_object(msg), rcvr->msg.len, + tok_label, tok_lastcnt, tok_serial); + } #endif - erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token); + erts_queue_message(rcvr, rcvr_locks, mp, msg, token); + } } else { /* Enqueue message on external format */ - ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; - if (token == am_have_dt_utag) { - ERL_MESSAGE_TOKEN(mp) = NIL; - } else { -#endif - ERL_MESSAGE_TOKEN(mp) = token; -#ifdef USE_VM_PROBES - } -#endif - mp->next = NULL; - #ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_queued)) { DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); @@ -388,7 +377,7 @@ erts_queue_dist_message(Process *rcvr, tok_label, tok_lastcnt, tok_serial); } #endif - mp->data.dist_ext = dist_ext; + LINK_MESSAGE(rcvr, mp); if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) @@ -408,9 +397,9 @@ erts_queue_dist_message(Process *rcvr, static Sint queue_message(Process *c_p, Process* receiver, - ErtsProcLocks *receiver_locks, erts_aint32_t *receiver_state, - ErlHeapFragment* bp, + ErtsProcLocks *receiver_locks, + ErtsMessage* mp, Eterm message, Eterm seq_trace_token #ifdef USE_VM_PROBES @@ -419,31 +408,24 @@ queue_message(Process *c_p, ) { Sint res; - ErlMessage* mp; int locked_msgq = 0; - erts_aint_t state; - -#ifndef ERTS_SMP - ASSERT(bp != NULL || receiver->mbuf == NULL); -#endif + erts_aint32_t state; ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver)); - mp = message_alloc(); - - if (receiver_state) - state = *receiver_state; - else - state = erts_smp_atomic32_read_acqb(&receiver->state); - #ifdef ERTS_SMP - if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) - goto exiting; - if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) { if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) { ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; + + if (receiver_state) + state = *receiver_state; + else + state = erts_smp_atomic32_read_nob(&receiver->state); + if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + goto exiting; + if (*receiver_locks & ERTS_PROC_LOCK_STATUS) { erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); need_locks |= ERTS_PROC_LOCK_STATUS; @@ -451,13 +433,12 @@ queue_message(Process *c_p, erts_smp_proc_lock(receiver, need_locks); } locked_msgq = 1; - state = erts_smp_atomic32_read_nob(&receiver->state); - if (receiver_state) - *receiver_state = state; } #endif + state = erts_smp_atomic32_read_nob(&receiver->state); + if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) { #ifdef ERTS_SMP exiting: @@ -465,9 +446,7 @@ queue_message(Process *c_p, /* Drop message if receiver is exiting or has a pending exit... */ if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - if (bp) - free_message_buffer(bp); - message_free(mp); + erts_cleanup_messages(mp); return 0; } @@ -476,13 +455,9 @@ queue_message(Process *c_p, #ifdef USE_VM_PROBES ERL_MESSAGE_DT_UTAG(mp) = dt_utag; #endif - mp->next = NULL; - mp->data.heap_frag = bp; -#ifndef ERTS_SMP res = receiver->msg.len; -#else - res = receiver->msg_inq.len; +#ifdef ERTS_SMP if (*receiver_locks & ERTS_PROC_LOCK_MAIN) { /* * We move 'in queue' to 'private queue' and place @@ -492,7 +467,7 @@ queue_message(Process *c_p, * we don't need to include the 'in queue' in * the root set when garbage collecting. */ - res += receiver->msg.len; + res += receiver->msg_inq.len; ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); LINK_MESSAGE_PRIVQ(receiver, mp); } @@ -544,19 +519,19 @@ queue_message(Process *c_p, void #ifdef USE_VM_PROBES erts_queue_message_probe(Process* receiver, ErtsProcLocks *receiver_locks, - ErlHeapFragment* bp, + ErtsMessage* mp, Eterm message, Eterm seq_trace_token, Eterm dt_utag) #else erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, - ErlHeapFragment* bp, + ErtsMessage* mp, Eterm message, Eterm seq_trace_token) #endif { queue_message(NULL, receiver, - receiver_locks, NULL, - bp, + receiver_locks, + mp, message, seq_trace_token #ifdef USE_VM_PROBES @@ -565,246 +540,8 @@ erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, ); } -void -erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp) -{ - Eterm* htop = HEAP_TOP(proc); - - link_mbuf_to_proc(proc, bp); - if (htop < HEAP_LIMIT(proc)) { - *htop = make_pos_bignum_header(HEAP_LIMIT(proc)-htop-1); - HEAP_TOP(proc) = HEAP_LIMIT(proc); - } -} - -/* - * Moves content of message buffer attached to a message into a heap. - * The message buffer is deallocated. - */ -void -erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg) -{ - struct erl_off_heap_header* oh; - Eterm term, token, *fhp, *hp; - Sint offs; - Uint sz; - ErlHeapFragment *bp; -#ifdef USE_VM_PROBES - Eterm utag; -#endif - -#ifdef HARD_DEBUG - struct erl_off_heap_header* dbg_oh_start = off_heap->first; - Eterm dbg_term, dbg_token; - ErlHeapFragment *dbg_bp; - Uint *dbg_hp, *dbg_thp_start; - Uint dbg_term_sz, dbg_token_sz; -#ifdef USE_VM_PROBES - Eterm dbg_utag; - Uint dbg_utag_sz; -#endif -#endif - - bp = msg->data.heap_frag; - term = ERL_MESSAGE_TERM(msg); - token = ERL_MESSAGE_TOKEN(msg); -#ifdef USE_VM_PROBES - utag = ERL_MESSAGE_DT_UTAG(msg); -#endif - if (!bp) { -#ifdef USE_VM_PROBES - ASSERT(is_immed(term) && is_immed(token) && is_immed(utag)); -#else - ASSERT(is_immed(term) && is_immed(token)); -#endif - return; - } - -#ifdef HARD_DEBUG - dbg_term_sz = size_object(term); - dbg_token_sz = size_object(token); - dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz); -#ifdef USE_VM_PROBES - dbg_utag_sz = size_object(utag); - dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz ); -#endif - /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg)); - Copied size may be smaller due to removed SubBins's or garbage. - Copied size may be larger due to duplicated shared terms. - */ - dbg_hp = dbg_bp->mem; - dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap); - dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap); -#ifdef USE_VM_PROBES - dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap); -#endif - dbg_thp_start = *hpp; -#endif - - if (bp->next != NULL) { - erts_move_multi_frags(hpp, off_heap, bp, msg->m, -#ifdef USE_VM_PROBES - 3, -#else - 2, -#endif - 0); - goto copy_done; - } - - OH_OVERHEAD(off_heap, bp->off_heap.overhead); - sz = bp->used_size; - - ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp)); - ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp)); - - fhp = bp->mem; - hp = *hpp; - offs = hp - fhp; - - oh = NULL; - while (sz--) { - Uint cpy_sz; - Eterm val = *fhp++; - - switch (primary_tag(val)) { - case TAG_PRIMARY_IMMED1: - *hp++ = val; - break; - case TAG_PRIMARY_LIST: - case TAG_PRIMARY_BOXED: - ASSERT(in_heapfrag(ptr_val(val), bp)); - *hp++ = offset_ptr(val, offs); - break; - case TAG_PRIMARY_HEADER: - *hp++ = val; - switch (val & _HEADER_SUBTAG_MASK) { - case ARITYVAL_SUBTAG: - break; - case REFC_BINARY_SUBTAG: - case FUN_SUBTAG: - case EXTERNAL_PID_SUBTAG: - case EXTERNAL_PORT_SUBTAG: - case EXTERNAL_REF_SUBTAG: - oh = (struct erl_off_heap_header*) (hp-1); - cpy_sz = thing_arityval(val); - goto cpy_words; - default: - cpy_sz = header_arity(val); - - cpy_words: - ASSERT(sz >= cpy_sz); - sz -= cpy_sz; - while (cpy_sz >= 8) { - cpy_sz -= 8; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - } - switch (cpy_sz) { - case 7: *hp++ = *fhp++; - case 6: *hp++ = *fhp++; - case 5: *hp++ = *fhp++; - case 4: *hp++ = *fhp++; - case 3: *hp++ = *fhp++; - case 2: *hp++ = *fhp++; - case 1: *hp++ = *fhp++; - default: break; - } - if (oh) { - /* Add to offheap list */ - oh->next = off_heap->first; - off_heap->first = oh; - ASSERT(*hpp <= (Eterm*)oh); - ASSERT(hp > (Eterm*)oh); - oh = NULL; - } - break; - } - break; - } - } - - ASSERT(bp->used_size == hp - *hpp); - *hpp = hp; - - if (is_not_immed(token)) { - ASSERT(in_heapfrag(ptr_val(token), bp)); - ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg))); -#endif - } - - if (is_not_immed(term)) { - ASSERT(in_heapfrag(ptr_val(term),bp)); - ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg))); -#endif - } -#ifdef USE_VM_PROBES - if (is_not_immed(utag)) { - ASSERT(in_heapfrag(ptr_val(utag), bp)); - ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg))); -#endif - } -#endif - -copy_done: - -#ifdef HARD_DEBUG - { - int i, j; - ErlHeapFragment* frag; - { - struct erl_off_heap_header* dbg_oh = off_heap->first; - i = j = 0; - while (dbg_oh != dbg_oh_start) { - dbg_oh = dbg_oh->next; - i++; - } - for (frag=bp; frag; frag=frag->next) { - dbg_oh = frag->off_heap.first; - while (dbg_oh) { - dbg_oh = dbg_oh->next; - j++; - } - } - ASSERT(i == j); - } - } -#endif - - - bp->off_heap.first = NULL; - free_message_buffer(bp); - msg->data.heap_frag = NULL; - -#ifdef HARD_DEBUG - ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term)); - ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token)); -#ifdef USE_VM_PROBES - ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag)); -#endif - free_message_buffer(dbg_bp); -#endif - -} - - Uint -erts_msg_attached_data_size_aux(ErlMessage *msg) +erts_msg_attached_data_size_aux(ErtsMessage *msg) { Sint sz; ASSERT(is_non_value(ERL_MESSAGE_TERM(msg))); @@ -833,29 +570,72 @@ erts_msg_attached_data_size_aux(ErlMessage *msg) return sz; } -void -erts_move_msg_attached_data_to_heap(ErtsHeapFactory* factory, - ErlMessage *msg) +ErtsMessage * +erts_try_alloc_message_on_heap(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp, + int *on_heap_p) { - if (is_value(ERL_MESSAGE_TERM(msg))) - erts_move_msg_mbuf_to_heap(&factory->hp, factory->off_heap, msg); - else if (msg->data.dist_ext) { - ASSERT(msg->data.dist_ext->heap_size >= 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); - ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg), - heap_frag->used_size, - &factory->hp, - factory->off_heap); - erts_cleanup_offheap(&heap_frag->off_heap); +#ifdef ERTS_SMP + int locked_main = 0; +#endif + ErtsMessage *mp; + + ASSERT(!(*psp & ERTS_PSFLG_OFF_HEAP_MSGQ)); + + if ( +#if defined(ERTS_SMP) + *plp & ERTS_PROC_LOCK_MAIN +#else + 1 +#endif + ) { +#ifdef ERTS_SMP + try_on_heap: +#endif + if ((*psp & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + || (pp->flags & F_DISABLE_GC) + || HEAP_LIMIT(pp) - HEAP_TOP(pp) <= sz) { + /* + * The heap is either potentially in an inconsistent + * state, or not large enough. + */ +#ifdef ERTS_SMP + if (locked_main) { + *plp &= ~ERTS_PROC_LOCK_MAIN; + erts_smp_proc_unlock(pp, ERTS_PROC_LOCK_MAIN); + } +#endif + goto in_message_fragment; } - ERL_MESSAGE_TERM(msg) = erts_decode_dist_ext(factory, - msg->data.dist_ext); - erts_free_dist_ext_copy(msg->data.dist_ext); - msg->data.dist_ext = NULL; + + *hpp = HEAP_TOP(pp); + HEAP_TOP(pp) = *hpp + sz; + *ohpp = &MSO(pp); + mp = erts_alloc_message(0, NULL); + mp->data.attached = NULL; + *on_heap_p = !0; + } +#ifdef ERTS_SMP + else if (erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) { + locked_main = 1; + *psp = erts_smp_atomic32_read_nob(&pp->state); + *plp |= ERTS_PROC_LOCK_MAIN; + goto try_on_heap; + } +#endif + else { + in_message_fragment: + + mp = erts_alloc_message(sz, hpp); + *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + *on_heap_p = 0; } - /* else: bad external detected when calculating size */ + + return mp; } /* @@ -870,7 +650,8 @@ erts_send_message(Process* sender, unsigned flags) { Uint msize; - ErlHeapFragment* bp = NULL; + ErtsMessage* mp; + ErlOffHeap *ohp; Eterm token = NIL; Sint res = 0; #ifdef USE_VM_PROBES @@ -879,27 +660,31 @@ erts_send_message(Process* sender, Sint tok_label = 0; Sint tok_lastcnt = 0; Sint tok_serial = 0; + Eterm utag = NIL; #endif + erts_aint32_t receiver_state; BM_STOP_TIMER(system); BM_MESSAGE(message,sender,receiver); BM_START_TIMER(send); #ifdef USE_VM_PROBES *sender_name = *receiver_name = '\0'; - if (DTRACE_ENABLED(message_send)) { + 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); } #endif + + receiver_state = erts_smp_atomic32_read_nob(&receiver->state); + if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { Eterm* hp; Eterm stoken = SEQ_TRACE_TOKEN(sender); Uint seq_trace_size = 0; #ifdef USE_VM_PROBES Uint dt_utag_size = 0; - Eterm utag = NIL; #endif BM_SWAP_TIMER(send,size); @@ -923,23 +708,32 @@ erts_send_message(Process* sender, } #endif - bp = new_message_buffer(msize + seq_trace_size + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + (msize #ifdef USE_VM_PROBES - + dt_utag_size + + dt_utag_size #endif - ); - hp = bp->mem; + + seq_trace_size), + &hp, + &ohp); BM_SWAP_TIMER(send,copy); - token = copy_struct(stoken, - seq_trace_size, - &hp, - &bp->off_heap); + if (is_immed(stoken)) + token = stoken; + else + token = copy_struct(stoken, seq_trace_size, &hp, ohp); + + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); - message = copy_struct(message, msize, &hp, &bp->off_heap); #ifdef USE_VM_PROBES if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { - utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, &bp->off_heap); + if (is_immed(DT_UTAG(sender))) + utag = DT_UTAG(sender); + else + utag = copy_struct(DT_UTAG(sender), dt_utag_size, ohp); #ifdef DTRACE_TAG_HARDDEBUG erts_fprintf(stderr, "Dtrace -> (%T) Spreading tag (%T) with " @@ -961,101 +755,49 @@ erts_send_message(Process* sender, msize, tok_label, tok_lastcnt, tok_serial); } #endif - res = queue_message(NULL, - receiver, - receiver_locks, - NULL, - bp, - message, - token -#ifdef USE_VM_PROBES - , utag -#endif - ); - BM_SWAP_TIMER(send,system); - } else if (sender == receiver) { - /* Drop message if receiver has a pending exit ... */ -#ifdef ERTS_SMP - ErtsProcLocks need_locks = (~(*receiver_locks) - & (ERTS_PROC_LOCK_MSGQ - | ERTS_PROC_LOCK_STATUS)); - if (need_locks) { - *receiver_locks |= need_locks; - if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) { - if (need_locks == ERTS_PROC_LOCK_MSGQ) { - erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); - need_locks = ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS; - } - erts_smp_proc_lock(receiver, need_locks); - } - } - if (!ERTS_PROC_PENDING_EXIT(receiver)) -#endif - { - ErlMessage* mp = message_alloc(); - - DTRACE6(message_send, sender_name, receiver_name, - size_object(message), tok_label, tok_lastcnt, tok_serial); - mp->data.attached = NULL; - ERL_MESSAGE_TERM(mp) = message; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif - mp->next = NULL; - /* - * We move 'in queue' to 'private queue' and place - * message at the end of 'private queue' in order - * to ensure that the 'in queue' doesn't contain - * references into the heap. By ensuring this, - * we don't need to include the 'in queue' in - * the root set when garbage collecting. - */ - - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); - LINK_MESSAGE_PRIVQ(receiver, mp); - - res = receiver->msg.len; - - if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { - trace_receive(receiver, message); - } - } - BM_SWAP_TIMER(send,system); } else { - ErlOffHeap *ohp; Eterm *hp; - erts_aint32_t state; - BM_SWAP_TIMER(send,size); - msize = size_object(message); - BM_SWAP_TIMER(size,send); - hp = erts_alloc_message_heap_state(msize, - &bp, - &ohp, - receiver, - receiver_locks, - &state); - BM_SWAP_TIMER(send,copy); - message = copy_struct(message, msize, &hp, ohp); - BM_MESSAGE_COPIED(msz); - BM_SWAP_TIMER(copy,send); + if (receiver == sender && !(receiver_state & ERTS_PSFLG_OFF_HEAP_MSGQ)) { + mp = erts_alloc_message(0, NULL); + msize = 0; + } + else { + BM_SWAP_TIMER(send,size); + msize = size_object(message); + BM_SWAP_TIMER(size,send); + + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + msize, + &hp, + &ohp); + BM_SWAP_TIMER(send,copy); + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); + BM_MESSAGE_COPIED(msz); + BM_SWAP_TIMER(copy,send); + } DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = queue_message(sender, - receiver, - receiver_locks, - &state, - bp, - message, - token + } + + res = queue_message(sender, + receiver, + &receiver_state, + receiver_locks, + mp, + message, + token #ifdef USE_VM_PROBES - , NIL + , utag #endif - ); - BM_SWAP_TIMER(send,system); - } - return res; + ); + + BM_SWAP_TIMER(send,system); + + return res; } /* @@ -1075,7 +817,8 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, Uint sz_from; Eterm* hp; Eterm temptoken; - ErlHeapFragment* bp = NULL; + ErtsMessage* mp; + ErlOffHeap *ohp; if (token != NIL #ifdef USE_VM_PROBES @@ -1087,36 +830,483 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, sz_reason = size_object(reason); sz_token = size_object(token); sz_from = size_object(from); - bp = new_message_buffer(sz_reason + sz_from + sz_token + 4); - hp = bp->mem; - mess = copy_struct(reason, sz_reason, &hp, &bp->off_heap); - from_copy = copy_struct(from, sz_from, &hp, &bp->off_heap); + mp = erts_alloc_message_heap(to, to_locksp, + sz_reason + sz_from + sz_token + 4, + &hp, &ohp); + mess = copy_struct(reason, sz_reason, &hp, ohp); + from_copy = copy_struct(from, sz_from, &hp, ohp); save = TUPLE3(hp, am_EXIT, from_copy, mess); hp += 4; /* the trace token must in this case be updated by the caller */ seq_trace_output(token, save, SEQ_TRACE_SEND, to->common.id, NULL); - temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap); - erts_queue_message(to, to_locksp, bp, save, temptoken); + temptoken = copy_struct(token, sz_token, &hp, ohp); + erts_queue_message(to, to_locksp, mp, save, temptoken); } else { - ErlOffHeap *ohp; sz_reason = size_object(reason); sz_from = IS_CONST(from) ? 0 : size_object(from); - hp = erts_alloc_message_heap(sz_reason+sz_from+4, - &bp, - &ohp, - to, - to_locksp); + mp = erts_alloc_message_heap(to, to_locksp, + sz_reason+sz_from+4, &hp, &ohp); mess = copy_struct(reason, sz_reason, &hp, ohp); from_copy = (IS_CONST(from) ? from : copy_struct(from, sz_from, &hp, ohp)); save = TUPLE3(hp, am_EXIT, from_copy, mess); - erts_queue_message(to, to_locksp, bp, save, NIL); + erts_queue_message(to, to_locksp, mp, save, NIL); } } +void erts_save_message_in_proc(Process *p, ErtsMessage *msgp) +{ + ErlHeapFragment *hfp; + + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfp = &msgp->hfrag; + else if (msgp->data.attached) { + hfp = msgp->data.heap_frag; + } + else { + erts_free_message(msgp); + return; /* Nothing to save */ + } + + while (1) { + struct erl_off_heap_header *ohhp = hfp->off_heap.first; + if (ohhp) { + for ( ; ohhp->next; ohhp = ohhp->next) + ; + ohhp->next = p->off_heap.first; + p->off_heap.first = hfp->off_heap.first; + hfp->off_heap.first = NULL; + } + p->off_heap.overhead += hfp->off_heap.overhead; + hfp->off_heap.overhead = 0; + p->mbuf_sz += hfp->used_size; + + if (!hfp->next) + break; + hfp = hfp->next; + } + + msgp->next = p->msg_frag; + p->msg_frag = msgp; +} + +Sint +erts_move_messages_off_heap(Process *c_p) +{ + int reds = 1; + /* + * Move all messages off heap. This *only* occurs when the + * process had off heap message disabled and just enabled + * it... + */ + ErtsMessage *mp; + + reds += c_p->msg.len / 10; + + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG); + + for (mp = c_p->msg.first; mp; mp = mp->next) { + Uint msg_sz, token_sz; +#ifdef USE_VM_PROBES + Uint utag_sz; +#endif + Eterm *hp; + ErlHeapFragment *hfrag; + + if (mp->data.attached) + continue; + + if (is_immed(ERL_MESSAGE_TERM(mp)) +#ifdef USE_VM_PROBES + && is_immed(ERL_MESSAGE_DT_UTAG(mp)) +#endif + && is_not_immed(ERL_MESSAGE_TOKEN(mp))) + continue; + + /* + * The message refers into the heap. Copy the message + * from the heap into a heap fragment and attach + * it to the message... + */ + msg_sz = size_object(ERL_MESSAGE_TERM(mp)); +#ifdef USE_VM_PROBES + utag_sz = size_object(ERL_MESSAGE_DT_UTAG(mp)); +#endif + token_sz = size_object(ERL_MESSAGE_TOKEN(mp)); + + hfrag = new_message_buffer(msg_sz +#ifdef USE_VM_PROBES + + utag_sz +#endif + + token_sz); + hp = hfrag->mem; + if (is_not_immed(ERL_MESSAGE_TERM(mp))) + ERL_MESSAGE_TERM(mp) = copy_struct(ERL_MESSAGE_TERM(mp), + msg_sz, &hp, + &hfrag->off_heap); + if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) + ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp), + token_sz, &hp, + &hfrag->off_heap); +#ifdef USE_VM_PROBES + if (is_not_immed(ERL_MESSAGE_DT_UTAG(mp))) + ERL_MESSAGE_DT_UTAG(mp) = copy_struct(ERL_MESSAGE_DT_UTAG(mp), + utag_sz, &hp, + &hfrag->off_heap); +#endif + mp->data.heap_frag = hfrag; + reds += 1; + } + + return reds; +} + +Sint +erts_complete_off_heap_message_queue_change(Process *c_p) +{ + int reds = 1; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); + ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG); + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ); + + /* + * This job was first initiated when the process changed + * "off heap message queue" state from false to true. Since + * then ERTS_PSFLG_OFF_HEAP_MSGQ has been set. However, the + * state change might have been changed again (multiple times) + * since then. Check users last requested state (the flag + * F_OFF_HEAP_MSGQ), and make the state consistent with that. + */ + + if (!(c_p->flags & F_OFF_HEAP_MSGQ)) + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_OFF_HEAP_MSGQ); + else { + reds += 2; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); + reds += erts_move_messages_off_heap(c_p); + } + c_p->flags &= ~F_OFF_HEAP_MSGQ_CHNG; + return reds; +} + +typedef struct { + Eterm pid; + ErtsThrPrgrLaterOp lop; +} ErtsChangeOffHeapMessageQueue; + +static void +change_off_heap_msgq(void *vcohmq) +{ + ErtsChangeOffHeapMessageQueue *cohmq; + /* + * Now we've waited thread progress which ensures that all + * messages to the process are enqueued off heap. Schedule + * completion of this change as a system task on the process + * itself. This in order to avoid lock contention on its + * main lock. We will be called in + * erts_complete_off_heap_message_queue_change() (above) when + * the system task has been selected for execution. + */ + cohmq = (ErtsChangeOffHeapMessageQueue *) vcohmq; + erts_schedule_complete_off_heap_message_queue_change(cohmq->pid); + erts_free(ERTS_ALC_T_MSGQ_CHNG, vcohmq); +} + +Eterm +erts_change_off_heap_message_queue_state(Process *c_p, int enable) +{ + +#ifdef DEBUG + if (c_p->flags & F_OFF_HEAP_MSGQ) { + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + } + else { + if (c_p->flags & F_OFF_HEAP_MSGQ_CHNG) { + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + } + else { + ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ)); + } + } +#endif + + if (c_p->flags & F_OFF_HEAP_MSGQ) { + /* Off heap message queue is enabled */ + + if (!enable) { + c_p->flags &= ~F_OFF_HEAP_MSGQ; + /* + * We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ + * if a change is ongoing. It will be adjusted when the + * change completes... + */ + if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { + /* Safe to clear ERTS_PSFLG_OFF_HEAP_MSGQ... */ + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_OFF_HEAP_MSGQ); + } + } + + return am_true; /* Old state */ + } + + /* Off heap message queue is disabled */ + + if (enable) { + c_p->flags |= F_OFF_HEAP_MSGQ; + /* + * We do not have to schedule a change if + * we have an ongoing change... + */ + if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { + ErtsChangeOffHeapMessageQueue *cohmq; + /* + * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait + * thread progress before completing the change in + * order to ensure that all senders observe that + * messages should be passed off heap. When the + * change has completed, GC does not need to inspect + * the message queue at all. + */ + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_OFF_HEAP_MSGQ); + c_p->flags |= F_OFF_HEAP_MSGQ_CHNG; + cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG, + sizeof(ErtsChangeOffHeapMessageQueue)); + cohmq->pid = c_p->common.id; + erts_schedule_thr_prgr_later_op(change_off_heap_msgq, + (void *) cohmq, + &cohmq->lop); + } + } + + return am_false; /* Old state */ +} + +int +erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks, + ErtsMessage *msgp, int force_off_heap) +{ + ErtsHeapFactory factory; + Eterm msg; + ErlHeapFragment *bp; + Sint need; + int decode_in_heap_frag; + + decode_in_heap_frag = (force_off_heap + || !(proc_locks & ERTS_PROC_LOCK_MAIN) + || (proc->flags & F_OFF_HEAP_MSGQ)); + + if (msgp->data.dist_ext->heap_size >= 0) + need = msgp->data.dist_ext->heap_size; + else { + need = erts_decode_dist_ext_size(msgp->data.dist_ext); + if (need < 0) { + /* bad msg; remove it... */ + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + bp = erts_dist_ext_trailer(msgp->data.dist_ext); + erts_cleanup_offheap(&bp->off_heap); + } + erts_free_dist_ext_copy(msgp->data.dist_ext); + msgp->data.dist_ext = NULL; + return 0; + } + + msgp->data.dist_ext->heap_size = need; + } + + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + bp = erts_dist_ext_trailer(msgp->data.dist_ext); + need += bp->used_size; + } + + if (decode_in_heap_frag) + erts_factory_heap_frag_init(&factory, new_message_buffer(need)); + else + erts_factory_proc_prealloc_init(&factory, proc, need); + + ASSERT(msgp->data.dist_ext->heap_size >= 0); + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext); + ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp), + heap_frag->used_size, + &factory.hp, + factory.off_heap); + erts_cleanup_offheap(&heap_frag->off_heap); + } + + msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext); + ERL_MESSAGE_TERM(msgp) = msg; + erts_free_dist_ext_copy(msgp->data.dist_ext); + msgp->data.attached = NULL; + + if (is_non_value(msg)) { + erts_factory_undo(&factory); + return 0; + } + + erts_factory_trim_and_close(&factory, msgp->m, + ERL_MESSAGE_REF_ARRAY_SZ); + + ASSERT(!msgp->data.heap_frag); + + if (decode_in_heap_frag) + msgp->data.heap_frag = factory.heap_frags; + + return 1; +} + +/* + * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages + * into the heap of the inspected process if off_heap_message_queue + * is false when process_info(_, messages) is called. That is, the + * following GC will have more data in the rootset compared to the + * scenario when process_info(_, messages) had not been called. + * + * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages + * off heap when process_info(_, messages) is called regardless of + * the off_heap_message_queue setting of the process. That is, it + * will change the following execution of the process as little as + * possible. + */ +#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1 + +Uint +erts_prep_msgq_for_inspection(Process *c_p, Process *rp, + ErtsProcLocks rp_locks, ErtsMessageInfo *mip) +{ + Uint tot_heap_size; + ErtsMessage* mp; + Sint i; + int self_on_heap; + + /* + * Prepare the message queue for inspection + * by process_info(). + * + * + * - Decode all messages on external format + * - Remove all corrupt dist messages from queue + * - Save pointer to, and heap size need of each + * message in the mip array. + * - Return total heap size need for all messages + * that needs to be copied. + * + * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0: + * - In case off heap messages is disabled and + * we are inspecting our own queue, move all + * off heap data into the heap. + */ + + self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ); + + tot_heap_size = 0; + i = 0; + mp = rp->msg.first; + while (mp) { + Eterm msg = ERL_MESSAGE_TERM(mp); + + mip[i].size = 0; + + if (is_non_value(msg)) { + /* Dist message on external format; decode it... */ + if (mp->data.attached) + erts_decode_dist_message(rp, rp_locks, mp, + ERTS_INSPECT_MSGQ_KEEP_OH_MSGS); + + msg = ERL_MESSAGE_TERM(mp); + + if (is_non_value(msg)) { + ErtsMessage **mpp; + ErtsMessage *bad_mp = mp; + /* + * Bad distribution message; remove + * it from the queue... + */ + ASSERT(!mp->data.attached); + + mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next; + + if (rp->msg.save == &bad_mp->next) + rp->msg.save = mpp; + if (rp->msg.last == &bad_mp->next) + rp->msg.last = mpp; + mp = mp->next; + *mpp = mp; + rp->msg.len--; + bad_mp->next = NULL; + erts_cleanup_messages(bad_mp); + continue; + } + } + + ASSERT(is_value(msg)); + +#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS + if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) { + Uint sz = size_object(msg); + mip[i].size = sz; + tot_heap_size += sz; + } +#else + if (self_on_heap) { + if (mp->data.attached) { + ErtsMessage *tmp = NULL; + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { + erts_link_mbuf_to_proc(rp, mp->data.heap_frag); + mp->data.attached = NULL; + } + else { + /* + * Need to replace the message reference since + * we will get references to the message data + * from the heap... + */ + ErtsMessage **mpp; + tmp = erts_alloc_message(0, NULL); + sys_memcpy((void *) tmp->m, (void *) mp->m, + sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ); + mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next; + tmp->next = mp->next; + if (rp->msg.save == &mp->next) + rp->msg.save = &tmp->next; + if (rp->msg.last == &mp->next) + rp->msg.last = &tmp->next; + *mpp = tmp; + erts_save_message_in_proc(rp, mp); + mp = tmp; + } + } + } + else if (is_not_immed(msg)) { + Uint sz = size_object(msg); + mip[i].size = sz; + tot_heap_size += sz; + } + +#endif + + mip[i].msgp = mp; + i++; + mp = mp->next; + } + + return tot_heap_size; +} + void erts_factory_proc_init(ErtsHeapFactory* factory, Process* p) { @@ -1127,47 +1317,138 @@ void erts_factory_proc_prealloc_init(ErtsHeapFactory* factory, Process* p, Sint size) { + ErlHeapFragment *bp = p->mbuf; factory->mode = FACTORY_HALLOC; factory->p = p; factory->hp_start = HAlloc(p, size); factory->hp = factory->hp_start; factory->hp_end = factory->hp_start + size; factory->off_heap = &p->off_heap; + factory->message = NULL; factory->off_heap_saved.first = p->off_heap.first; factory->off_heap_saved.overhead = p->off_heap.overhead; - factory->heap_frags_saved = p->mbuf; + factory->heap_frags_saved = bp; + factory->heap_frags_saved_used = bp ? bp->used_size : 0; factory->heap_frags = NULL; /* not used */ factory->alloc_type = 0; /* not used */ } -void erts_factory_message_init(ErtsHeapFactory* factory, - Process* rp, - Eterm* hp, - ErlHeapFragment* bp) +void erts_factory_heap_frag_init(ErtsHeapFactory* factory, + ErlHeapFragment* bp) +{ + factory->mode = FACTORY_HEAP_FRAGS; + factory->p = NULL; + factory->hp_start = bp->mem; + factory->hp = bp->mem; + factory->hp_end = bp->mem + bp->alloc_size; + factory->off_heap = &bp->off_heap; + factory->message = NULL; + factory->heap_frags = bp; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + ASSERT(!bp->next); + factory->off_heap_saved.first = factory->off_heap->first; + factory->off_heap_saved.overhead = factory->off_heap->overhead; + + ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end); +} + + +ErtsMessage * +erts_factory_message_create(ErtsHeapFactory* factory, + Process *proc, + ErtsProcLocks *proc_locksp, + Uint sz) +{ + Eterm *hp; + ErlOffHeap *ohp; + ErtsMessage *msgp; + int on_heap; + erts_aint32_t state; + + state = erts_smp_atomic32_read_nob(&proc->state); + + if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) { + msgp = erts_alloc_message(sz, &hp); + ohp = sz == 0 ? NULL : &msgp->hfrag.off_heap; + on_heap = 0; + } + else { + msgp = erts_try_alloc_message_on_heap(proc, &state, + proc_locksp, + sz, &hp, &ohp, + &on_heap); + } + + if (on_heap) { + ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); + ASSERT(ohp == &proc->off_heap); + factory->mode = FACTORY_HALLOC; + factory->p = proc; + factory->heap_frags_saved = proc->mbuf; + factory->heap_frags_saved_used = proc->mbuf ? proc->mbuf->used_size : 0; + } + else { + factory->mode = FACTORY_MESSAGE; + factory->p = NULL; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + ASSERT(!msgp->hfrag.next); + factory->heap_frags = NULL; + } + else { + ASSERT(!msgp->data.heap_frag + || !msgp->data.heap_frag->next); + factory->heap_frags = msgp->data.heap_frag; + } + } + factory->hp_start = hp; + factory->hp = hp; + factory->hp_end = hp + sz; + factory->message = msgp; + factory->off_heap = ohp; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + if (ohp) { + factory->off_heap_saved.first = ohp->first; + factory->off_heap_saved.overhead = ohp->overhead; + } + else { + factory->off_heap_saved.first = NULL; + factory->off_heap_saved.overhead = 0; + } + + ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end); + + return msgp; +} + +void erts_factory_selfcontained_message_init(ErtsHeapFactory* factory, + ErtsMessage *msgp, + Eterm *hp) { - if (bp) { - factory->mode = FACTORY_HEAP_FRAGS; - factory->p = NULL; - factory->hp_start = bp->mem; - factory->hp = hp ? hp : bp->mem; - factory->hp_end = bp->mem + bp->alloc_size; - factory->off_heap = &bp->off_heap; - factory->heap_frags = bp; - factory->heap_frags_saved = bp; - factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; - ASSERT(!bp->next); + ErlHeapFragment* bp; + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + bp = &msgp->hfrag; + factory->heap_frags = NULL; } else { - factory->mode = FACTORY_HALLOC; - factory->p = rp; - factory->hp_start = hp; - factory->hp = hp; - factory->hp_end = HEAP_TOP(rp); - factory->off_heap = &rp->off_heap; - factory->heap_frags_saved = rp->mbuf; - factory->heap_frags = NULL; /* not used */ - factory->alloc_type = 0; /* not used */ + bp = msgp->data.heap_frag; + factory->heap_frags = bp; } + factory->mode = FACTORY_MESSAGE; + factory->p = NULL; + factory->hp_start = bp->mem; + factory->hp = hp; + factory->hp_end = bp->mem + bp->alloc_size; + factory->message = msgp; + factory->off_heap = &bp->off_heap; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + ASSERT(!bp->next); factory->off_heap_saved.first = factory->off_heap->first; factory->off_heap_saved.overhead = factory->off_heap->overhead; @@ -1230,8 +1511,16 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra) factory->hp_end = factory->hp + need; return; - case FACTORY_HEAP_FRAGS: - bp = factory->heap_frags; + case FACTORY_MESSAGE: + if (!factory->heap_frags) { + ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG); + bp = &factory->message->hfrag; + } + else { + /* Fall through */ + case FACTORY_HEAP_FRAGS: + bp = factory->heap_frags; + } if (bp) { ASSERT(factory->hp > bp->mem); @@ -1269,8 +1558,23 @@ void erts_factory_close(ErtsHeapFactory* factory) HRelease(factory->p, factory->hp_end, factory->hp); break; - case FACTORY_HEAP_FRAGS: - bp = factory->heap_frags; + case FACTORY_MESSAGE: + if (!factory->heap_frags) { + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &factory->message->hfrag; + else + bp = NULL; + } + else { + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + factory->message->hfrag.next = factory->heap_frags; + else + factory->message->data.heap_frag = factory->heap_frags; + + /* Fall through */ + case FACTORY_HEAP_FRAGS: + bp = factory->heap_frags; + } if (bp) { ASSERT(factory->hp >= bp->mem); @@ -1291,17 +1595,47 @@ void erts_factory_close(ErtsHeapFactory* factory) void erts_factory_trim_and_close(ErtsHeapFactory* factory, Eterm *brefs, Uint brefs_size) { - if (factory->mode == FACTORY_HEAP_FRAGS) { - ErlHeapFragment* bp = factory->heap_frags; + ErlHeapFragment *bp; + + switch (factory->mode) { + case FACTORY_MESSAGE: { + ErtsMessage *mp = factory->message; + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + if (!mp->hfrag.next) { + Uint sz = factory->hp - factory->hp_start; + mp = erts_shrink_message(mp, sz, brefs, brefs_size); + factory->message = mp; + factory->mode = FACTORY_CLOSED; + return; + } + /*else we don't trim multi fragmented messages for now (off_heap...) */ + break; + } + /* Fall through... */ + } + case FACTORY_HEAP_FRAGS: + bp = factory->heap_frags; + if (!bp) + break; if (bp->next == NULL) { Uint used_sz = factory->hp - bp->mem; ASSERT(used_sz <= bp->alloc_size); - factory->heap_frags = erts_resize_message_buffer(bp, used_sz, - brefs, brefs_size); + if (used_sz > 0) + bp = erts_resize_message_buffer(bp, used_sz, + brefs, brefs_size); + else { + free_message_buffer(bp); + bp = NULL; + } + factory->heap_frags = bp; + if (factory->mode == FACTORY_MESSAGE) + factory->message->data.heap_frag = bp; factory->mode = FACTORY_CLOSED; return; } - /*else we don't trim multi fragmented messages for now */ + /*else we don't trim multi fragmented messages for now (off_heap...) */ + default: + break; } erts_factory_close(factory); } @@ -1349,38 +1683,35 @@ void erts_factory_undo(ErtsHeapFactory* factory) /* Rollback heap top */ - if (factory->heap_frags_saved == NULL) { /* No heap frags when we started */ - ASSERT(factory->hp_start >= HEAP_START(factory->p)); - ASSERT(factory->hp_start <= HEAP_LIMIT(factory->p)); - HEAP_TOP(factory->p) = factory->hp_start; - } - else { + if (HEAP_START(factory->p) <= factory->hp_start + && factory->hp_start <= HEAP_LIMIT(factory->p)) { + HEAP_TOP(factory->p) = factory->hp_start; + } + + /* Fix last heap frag */ + if (factory->heap_frags_saved) { ASSERT(factory->heap_frags_saved == factory->p->mbuf); - if (factory->hp_start == factory->heap_frags_saved->mem) { + if (factory->hp_start != factory->heap_frags_saved->mem) + factory->heap_frags_saved->used_size = factory->heap_frags_saved_used; + else { factory->p->mbuf = factory->p->mbuf->next; ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, factory->heap_frags_saved, ERTS_HEAP_FRAG_SIZE(factory->heap_frags_saved->alloc_size)); } - else if (factory->hp_start != factory->hp_end) { - unsigned remains = factory->hp_start - factory->heap_frags_saved->mem; - ASSERT(remains > 0 && remains < factory->heap_frags_saved->used_size); - factory->heap_frags_saved->used_size = remains; - } } } break; + case FACTORY_MESSAGE: + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + factory->message->hfrag.next = factory->heap_frags; + else + factory->message->data.heap_frag = factory->heap_frags; + erts_cleanup_messages(factory->message); + break; case FACTORY_HEAP_FRAGS: - bp = factory->heap_frags; - do { - ErlHeapFragment* next_bp = bp->next; - - erts_cleanup_offheap(&bp->off_heap); - ERTS_HEAP_FREE(factory->alloc_type, (void *) bp, - ERTS_HEAP_FRAG_SIZE(bp->size)); - bp = next_bp; - }while (bp != NULL); + free_message_buffer(factory->heap_frags); break; case FACTORY_CLOSED: break; diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index f37b430d27..740ae46a0f 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -24,6 +24,8 @@ struct proc_bin; struct external_thing_; +typedef struct erl_mesg ErtsMessage; + /* * This struct represents data that must be updated by structure copy, * but is stored outside of any heap. @@ -54,6 +56,7 @@ typedef struct { enum { FACTORY_CLOSED = 0, FACTORY_HALLOC, + FACTORY_MESSAGE, FACTORY_HEAP_FRAGS, FACTORY_STATIC } mode; @@ -61,8 +64,10 @@ typedef struct { Eterm* hp_start; Eterm* hp; Eterm* hp_end; + ErtsMessage *message; struct erl_heap_fragment* heap_frags; struct erl_heap_fragment* heap_frags_saved; + Uint heap_frags_saved_used; ErlOffHeap* off_heap; ErlOffHeap off_heap_saved; Uint32 alloc_type; @@ -70,7 +75,10 @@ typedef struct { void erts_factory_proc_init(ErtsHeapFactory*, Process*); void erts_factory_proc_prealloc_init(ErtsHeapFactory*, Process*, Sint size); -void erts_factory_message_init(ErtsHeapFactory*, Process*, Eterm* hp, struct erl_heap_fragment*); +void erts_factory_heap_frag_init(ErtsHeapFactory*, struct erl_heap_fragment*); +ErtsMessage *erts_factory_message_create(ErtsHeapFactory *, Process *, + ErtsProcLocks *, Uint sz); +void erts_factory_selfcontained_message_init(ErtsHeapFactory*, ErtsMessage *, Eterm *); void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap*); void erts_factory_dummy_init(ErtsHeapFactory*); @@ -91,6 +99,8 @@ void erts_factory_undo(ErtsHeapFactory*); #include "external.h" #include "erl_process.h" +#define ERTS_INVALID_HFRAG_PTR ((ErlHeapFragment *) ~((UWord) 7)) + /* * This struct represents a heap fragment, which is used when there * isn't sufficient room in the process heap and we can't do a GC. @@ -105,33 +115,46 @@ struct erl_heap_fragment { Eterm mem[1]; /* Data */ }; -typedef struct erl_mesg { - struct erl_mesg* next; /* Next message */ - union { - ErtsDistExternal *dist_ext; - ErlHeapFragment *heap_frag; - void *attached; - } data; -#ifdef USE_VM_PROBES - Eterm m[3]; /* m[0] = message, m[1] = seq trace token, m[3] = dynamic trace user tag */ -#else - Eterm m[2]; /* m[0] = message, m[1] = seq trace token */ -#endif -} ErlMessage; - +/* m[0] = message, m[1] = seq trace token */ +#define ERL_MESSAGE_REF_ARRAY_SZ 2 #define ERL_MESSAGE_TERM(mp) ((mp)->m[0]) #define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1]) + #ifdef USE_VM_PROBES +/* m[2] = dynamic trace user tag */ +#undef ERL_MESSAGE_REF_ARRAY_SZ +#define ERL_MESSAGE_REF_ARRAY_SZ 3 #define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2]) +#else #endif +#define ERL_MESSAGE_REF_FIELDS__ \ + ErtsMessage *next; /* Next message */ \ + union { \ + ErtsDistExternal *dist_ext; \ + ErlHeapFragment *heap_frag; \ + void *attached; \ + } data; \ + Eterm m[ERL_MESSAGE_REF_ARRAY_SZ] + + +typedef struct erl_msg_ref__ { + ERL_MESSAGE_REF_FIELDS__; +} ErtsMessageRef; + +struct erl_mesg { + ERL_MESSAGE_REF_FIELDS__; + + ErlHeapFragment hfrag; +}; + /* Size of default message buffer (erl_message.c) */ #define ERL_MESSAGE_BUF_SZ 500 typedef struct { - ErlMessage* first; - ErlMessage** last; /* point to the last next pointer */ - ErlMessage** save; + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ + ErtsMessage** save; Sint len; /* queue length */ /* @@ -139,14 +162,14 @@ typedef struct { * recv_set/1 instructions. */ BeamInstr* mark; /* address to rec_loop/2 instruction */ - ErlMessage** saved_last; /* saved last pointer */ + ErtsMessage** saved_last; /* saved last pointer */ } ErlMessageQueue; #ifdef ERTS_SMP typedef struct { - ErlMessage* first; - ErlMessage** last; /* point to the last next pointer */ + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ Sint len; /* queue length */ } ErlMessageInQueue; @@ -197,7 +220,7 @@ do { \ /* Unlink current message */ #define UNLINK_MESSAGE(p,msgp) do { \ - ErlMessage* __mp = (msgp)->next; \ + ErtsMessage* __mp = (msgp)->next; \ *(p)->msg.save = __mp; \ (p)->msg.len--; \ if (__mp == NULL) \ @@ -213,76 +236,33 @@ do { \ #define SAVE_MESSAGE(p) \ (p)->msg.save = &(*(p)->msg.save)->next -/* - * ErtsMoveMsgAttachmentIntoProc() moves data attached to a message - * onto the heap of a process. The attached data is the content of - * the the message either on the internal format or on the external - * format, and also possibly a seq trace token on the internal format. - * If the message content is on the external format, the decode might - * fail. If the decoding fails, ERL_MESSAGE_TERM(M) will contain - * THE_NON_VALUE. That is, ERL_MESSAGE_TERM(M) *has* to be checked - * afterwards and taken care of appropriately. - * - * ErtsMoveMsgAttachmentIntoProc() will shallow copy to heap if - * possible; otherwise, move to heap via garbage collection. - * - * ErtsMoveMsgAttachmentIntoProc() is used when receiveing messages - * in process_main() and in hipe_check_get_msg(). - */ - -#define ErtsMoveMsgAttachmentIntoProc(M, P, ST, HT, FC, SWPO, SWPI) \ -do { \ - if ((M)->data.attached) { \ - Uint need__ = erts_msg_attached_data_size((M)); \ - { SWPO ; } \ - if ((ST) - (HT) >= need__) { \ - ErtsHeapFactory factory__; \ - erts_factory_proc_prealloc_init(&factory__, (P), need__); \ - erts_move_msg_attached_data_to_heap(&factory__, (M)); \ - erts_factory_close(&factory__); \ - if ((P)->mbuf != NULL) { \ - /* Heap was exhausted by messages. This is a rare case */ \ - /* that can currently (OTP 18) only happen if hamts are */ \ - /* far exceeding the estimated heap size. Do GC. */ \ - (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ - } \ - } \ - else { \ - (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ - } \ - { SWPI ; } \ - ASSERT(!(M)->data.attached); \ - } \ -} while (0) - #define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) -#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \ -do { \ - (HEAP_FRAG_P)->next = NULL; \ - (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \ - (HEAP_FRAG_P)->used_size = (DATA_WORDS); \ - (HEAP_FRAG_P)->off_heap.first = NULL; \ - (HEAP_FRAG_P)->off_heap.overhead = 0; \ -} while (0) +#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, USED_WORDS, DATA_WORDS) \ + do { \ + (HEAP_FRAG_P)->next = NULL; \ + (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \ + (HEAP_FRAG_P)->used_size = (USED_WORDS); \ + (HEAP_FRAG_P)->off_heap.first = NULL; \ + (HEAP_FRAG_P)->off_heap.overhead = 0; \ + } while (0) void init_message(void); -void free_message(ErlMessage *); ErlHeapFragment* new_message_buffer(Uint); ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, Eterm *, Uint); void free_message_buffer(ErlHeapFragment *); void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm); #ifdef USE_VM_PROBES -void erts_queue_message_probe(Process*, ErtsProcLocks*, ErlHeapFragment*, +void erts_queue_message_probe(Process*, ErtsProcLocks*, ErtsMessage*, Eterm message, Eterm seq_trace_token, Eterm dt_utag); #define erts_queue_message(RP,RL,BP,Msg,SEQ) \ erts_queue_message_probe((RP),(RL),(BP),(Msg),(SEQ),NIL) #else -void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, +void erts_queue_message(Process*, ErtsProcLocks*, ErtsMessage*, Eterm message, Eterm seq_trace_token); #define erts_queue_message_probe(RP,RL,BP,Msg,SEQ,TAG) \ erts_queue_message((RP),(RL),(BP),(Msg),(SEQ)) @@ -291,20 +271,141 @@ void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm); Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned); void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp); -void erts_move_msg_mbuf_to_heap(Eterm**, ErlOffHeap*, ErlMessage *); - -Uint erts_msg_attached_data_size_aux(ErlMessage *msg); -void erts_move_msg_attached_data_to_heap(ErtsHeapFactory*, ErlMessage *); -Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **, - Eterm *, ErtsDistExternal *); +Uint erts_msg_attached_data_size_aux(ErtsMessage *msg); void erts_cleanup_offheap(ErlOffHeap *offheap); +void erts_save_message_in_proc(Process *p, ErtsMessage *msg); +Sint erts_move_messages_off_heap(Process *c_p); +Sint erts_complete_off_heap_message_queue_change(Process *c_p); +Eterm erts_change_off_heap_message_queue_state(Process *c_p, int enable); + +int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int); + +void erts_cleanup_messages(ErtsMessage *mp); + +typedef struct { + Uint size; + ErtsMessage *msgp; +} ErtsMessageInfo; + +Uint erts_prep_msgq_for_inspection(Process *c_p, + Process *rp, + ErtsProcLocks rp_locks, + ErtsMessageInfo *mip); +void *erts_alloc_message_ref(void); +void erts_free_message_ref(void *); +#define ERTS_SMALL_FIX_MSG_SZ 10 +#define ERTS_MEDIUM_FIX_MSG_SZ 20 +#define ERTS_LARGE_FIX_MSG_SZ 30 + +void *erts_alloc_small_message(void); +void erts_free_small_message(void *mp); + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_SMALL_FIX_MSG_SZ-1]; +} ErtsSmallFixSzMessage; + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_MEDIUM_FIX_MSG_SZ-1]; +} ErtsMediumFixSzMessage; + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_LARGE_FIX_MSG_SZ-1]; +} ErtsLargeFixSzMessage; + +ErtsMessage *erts_try_alloc_message_on_heap(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp, + int *on_heap_p); +ErtsMessage *erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, + Eterm *brefs, Uint brefs_size); + +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp); +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_shrink_message(ErtsMessage *mp, Uint sz, + Eterm *brefs, Uint brefs_size); +ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp); ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment*); -ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg); +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg); + +#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1) #if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp) +{ + ErtsMessage *mp; + + if (sz == 0) { + mp = erts_alloc_message_ref(); + mp->next = NULL; + ERL_MESSAGE_TERM(mp) = NIL; + mp->data.attached = NULL; + if (hpp) + *hpp = NULL; + return mp; + } + + mp = erts_alloc(ERTS_ALC_T_MSG, + sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm)); + + mp->next = NULL; + ERL_MESSAGE_TERM(mp) = NIL; + mp->data.attached = ERTS_MSG_COMBINED_HFRAG; + ERTS_INIT_HEAP_FRAG(&mp->hfrag, sz, sz); + + if (hpp) + *hpp = &mp->hfrag.mem[0]; + + return mp; +} + +ERTS_GLB_FORCE_INLINE ErtsMessage * +erts_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size) +{ + if (sz == 0) { + ErtsMessage *nmp; + if (!mp->data.attached) + return mp; + ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG); + nmp = erts_alloc_message_ref(); +#ifdef DEBUG + if (brefs && brefs_size) { + int i; + for (i = 0; i < brefs_size; i++) + ASSERT(is_non_value(brefs[i]) || is_immed(brefs[i])); + } +#endif + erts_free(ERTS_ALC_T_MSG, mp); + return nmp; + } + + ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG); + ASSERT(mp->hfrag.used_size >= sz); + + if (sz >= (mp->hfrag.alloc_size - mp->hfrag.alloc_size / 16)) { + mp->hfrag.used_size = sz; + return mp; + } + + return erts_realloc_shrink_message(mp, sz, brefs, brefs_size); +} + +ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp) +{ + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) + erts_free_message_ref(mp); + else + erts_free(ERTS_ALC_T_MSG, mp); +} + ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp) { Uint sz = 0; @@ -314,11 +415,17 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp) return sz; } -ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg) +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg) { ASSERT(msg->data.attached); - if (is_value(ERL_MESSAGE_TERM(msg))) - return erts_used_frag_sz(msg->data.heap_frag); + if (is_value(ERL_MESSAGE_TERM(msg))) { + ErlHeapFragment *bp; + if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &msg->hfrag; + else + bp = msg->data.heap_frag; + return erts_used_frag_sz(bp); + } else if (msg->data.dist_ext->heap_size < 0) return erts_msg_attached_data_size_aux(msg); else { diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 01414f326d..a37cda93ef 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -314,6 +314,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ErtsProcLocks rp_locks = 0; Process* rp; Process* c_p; + ErtsMessage *mp; ErlHeapFragment* frags; Eterm receiver = to_pid->pid; int flush_me = 0; @@ -347,7 +348,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ASSERT(frags == MBUF(&menv->phony_proc)); if (frags != NULL) { /* Move all offheap's from phony proc to the first fragment. - Quick and dirty, but erts_move_msg_mbuf_to_heap doesn't care. */ + Quick and dirty... */ ASSERT(!is_offheap(&frags->off_heap)); frags->off_heap = MSO(&menv->phony_proc); clear_offheap(&MSO(&menv->phony_proc)); @@ -359,7 +360,9 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, if (flush_me) { flush_env(env); /* Needed for ERTS_HOLE_CHECK */ } - erts_queue_message(rp, &rp_locks, frags, msg, am_undefined); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = frags; + erts_queue_message(rp, &rp_locks, mp, msg, am_undefined); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; if (rp_locks) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 62a44f7129..a4da288e79 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1401,56 +1401,50 @@ setup_reference_table(void) for (i = 0; i < max; i++) { Process *proc = erts_pix2proc(i); if (proc) { - ErlMessage *msg; + int mli; + ErtsMessage *msg_list[] = { + proc->msg.first, +#ifdef ERTS_SMP + proc->msg_inq.first, +#endif + proc->msg_frag}; /* Insert Heap */ insert_offheap(&(proc->off_heap), HEAP_REF, proc->common.id); - /* Insert message buffers */ + /* Insert heap fragments buffers */ for(hfp = proc->mbuf; hfp; hfp = hfp->next) insert_offheap(&(hfp->off_heap), HEAP_REF, proc->common.id); - /* Insert msg msg buffers */ - for (msg = proc->msg.first; msg; msg = msg->next) { - ErlHeapFragment *heap_frag = NULL; - if (msg->data.attached) { - if (is_value(ERL_MESSAGE_TERM(msg))) - heap_frag = msg->data.heap_frag; - else { - if (msg->data.dist_ext->dep) - insert_dist_entry(msg->data.dist_ext->dep, - HEAP_REF, proc->common.id, 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + + /* Insert msg buffers */ + for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) { + ErtsMessage *msg; + for (msg = msg_list[mli]; msg; msg = msg->next) { + ErlHeapFragment *heap_frag = NULL; + if (msg->data.attached) { + if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG) + heap_frag = &msg->hfrag; + else if (is_value(ERL_MESSAGE_TERM(msg))) + heap_frag = msg->data.heap_frag; + else { + if (msg->data.dist_ext->dep) + insert_dist_entry(msg->data.dist_ext->dep, + HEAP_REF, proc->common.id, 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + } } - } - if (heap_frag) - insert_offheap(&(heap_frag->off_heap), - HEAP_REF, - proc->common.id); - } -#ifdef ERTS_SMP - for (msg = proc->msg_inq.first; msg; msg = msg->next) { - ErlHeapFragment *heap_frag = NULL; - if (msg->data.attached) { - if (is_value(ERL_MESSAGE_TERM(msg))) - heap_frag = msg->data.heap_frag; - else { - if (msg->data.dist_ext->dep) - insert_dist_entry(msg->data.dist_ext->dep, - HEAP_REF, proc->common.id, 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + while (heap_frag) { + insert_offheap(&(heap_frag->off_heap), + HEAP_REF, + proc->common.id); + heap_frag = heap_frag->next; } } - if (heap_frag) - insert_offheap(&(heap_frag->off_heap), - HEAP_REF, - proc->common.id); } -#endif /* Insert links */ if (ERTS_P_LINKS(proc)) insert_links(ERTS_P_LINKS(proc), proc->common.id); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index bad9da90ea..e490ffea5a 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -148,6 +148,7 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; +int erts_default_spo_flags = 0; int erts_eager_check_io = 1; int erts_sched_compact_load; int erts_sched_balance_util = 0; @@ -351,7 +352,8 @@ struct erts_system_profile_flags_t erts_system_profile_flags; typedef enum { ERTS_PSTT_GC, /* Garbage Collect */ - ERTS_PSTT_CPC /* Check Process Code */ + ERTS_PSTT_CPC, /* Check Process Code */ + ERTS_PSTT_COHMQ /* Change off heap message queue */ } ErtsProcSysTaskType; #define ERTS_MAX_PROC_SYS_TASK_ARGS 2 @@ -982,7 +984,7 @@ reply_sched_wall_time(void *vswtrp) Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; ASSERT(esdp); #ifdef ERTS_DIRTY_SCHEDULERS @@ -1038,12 +1040,12 @@ reply_sched_wall_time(void *vswtrp) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); szp = NULL; hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg, NIL); if (swtrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -6294,22 +6296,99 @@ erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks) schedule_process(p, state, locks); } -static void -schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) +static int +schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st) { - /* - * Expects status lock to be locked when called, and - * returns with status lock unlocked... - */ - erts_aint32_t a = state, n, enq_prio = -1; + int res; + int locked; + ErtsProcSysTaskQs *stqs, *free_stqs; + erts_aint32_t state, a, n, enq_prio; int enqueue; /* < 0 -> use proxy */ - unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + unsigned int prof_runnable_procs; + + res = 1; /* prepare for success */ + st->next = st->prev = st; /* Prep for empty prio queue */ + state = erts_smp_atomic32_read_nob(&p->state); + prof_runnable_procs = erts_system_profile_flags.runnable_procs; + locked = 0; + free_stqs = NULL; + if (state & ERTS_PSFLG_ACTIVE_SYS) + stqs = NULL; + else { + alloc_qs: + stqs = proc_sys_task_queues_alloc(); + stqs->qmask = 1 << prio; + stqs->ncount = 0; + stqs->q[PRIORITY_MAX] = NULL; + stqs->q[PRIORITY_HIGH] = NULL; + stqs->q[PRIORITY_NORMAL] = NULL; + stqs->q[PRIORITY_LOW] = NULL; + stqs->q[prio] = st; + } + + if (!locked) { + locked = 1; + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + + state = erts_smp_atomic32_read_nob(&p->state); + if (state & ERTS_PSFLG_EXITING) { + free_stqs = stqs; + res = 0; + goto cleanup; + } + } + + if (!p->sys_task_qs) { + if (stqs) + p->sys_task_qs = stqs; + else + goto alloc_qs; + } + else { + free_stqs = stqs; + stqs = p->sys_task_qs; + if (!stqs->q[prio]) { + stqs->q[prio] = st; + stqs->qmask |= 1 << prio; + } + else { + st->next = stqs->q[prio]; + st->prev = stqs->q[prio]->prev; + st->next->prev = st; + st->prev->next = st; + ASSERT(stqs->qmask & (1 << prio)); + } + } + + if (ERTS_PSFLGS_GET_ACT_PRIO(state) > prio) { + erts_aint32_t n, a, e; + /* Need to elevate actual prio */ + + a = state; + do { + if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) { + n = a; + break; + } + n = e = a; + n &= ~ERTS_PSFLGS_ACT_PRIO_MASK; + n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET); + a = erts_smp_atomic32_cmpxchg_nob(&p->state, n, e); + } while (a != e); + state = n; + } + + + a = state; + enq_prio = -1; /* Status lock prevents out of order "runnable proc" trace msgs */ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); - if (!prof_runnable_procs) + if (!prof_runnable_procs) { erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + locked = 0; + } ASSERT(!(state & ERTS_PSFLG_PROXY)); @@ -6317,8 +6396,10 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) erts_aint32_t e; n = e = a; - if (a & ERTS_PSFLG_FREE) + if (a & ERTS_PSFLG_FREE) { + res = 0; goto cleanup; /* We don't want to schedule free processes... */ + } enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -6342,29 +6423,24 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - prof_runnable_procs = 0; + locked = 0; } - if (enqueue != ERTS_ENQUEUE_NOT) { - Process *sched_p; - if (enqueue > 0) - sched_p = p; - else { - sched_p = make_proxy_proc(proxy, p, enq_prio); - proxy = NULL; - } - add2runq(sched_p, n, enq_prio); - } + if (enqueue != ERTS_ENQUEUE_NOT) + add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), + n, enq_prio); cleanup: - if (prof_runnable_procs) + if (locked) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - if (proxy) - free_proxy_proc(proxy); + if (free_stqs) + proc_sys_task_queues_free(free_stqs); ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p))); + + return res; } static ERTS_INLINE int @@ -9696,13 +9772,13 @@ Process *schedule(Process *p, int calls) } } - if (!(state & ERTS_PSFLG_EXITING) - && ((FLAGS(p) & F_FORCE_GC) - || (MSO(p).overhead > BIN_VHEAP_SZ(p)))) { - reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity); - if (reds <= 0) { - p->fcalls = reds; - goto sched_out_proc; + if (ERTS_IS_GC_DESIRED(p)) { + if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & F_DISABLE_GC)) { + reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity); + if (reds <= 0) { + p->fcalls = reds; + goto sched_out_proc; + } } } @@ -9742,7 +9818,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) if (rp) { ErtsProcLocks rp_locks; ErlOffHeap *ohp; - ErlHeapFragment* bp; + ErtsMessage *mp; Eterm *hp, msg, req_id, result; Uint st_result_sz, hsz; #ifdef DEBUG @@ -9754,11 +9830,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) st_result_sz = is_immed(st_result) ? 0 : size_object(st_result); hsz = st->req_id_sz + st_result_sz + 4 /* 3-tuple */; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp); #ifdef DEBUG hp_start = hp; @@ -9783,7 +9855,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) ASSERT(hp_start + hsz == hp); #endif - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg, NIL); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -10005,6 +10077,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) st = NULL; } break; + case ERTS_PSTT_COHMQ: + reds += erts_complete_off_heap_message_queue_change(c_p); + st_res = am_true; + break; default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10047,6 +10123,9 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) case ERTS_PSTT_CPC: st_res = am_false; break; + case ERTS_PSTT_COHMQ: + st_res = am_false; + break; default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10065,10 +10144,8 @@ BIF_RETTYPE erts_internal_request_system_task_3(BIF_ALIST_3) { Process *rp = erts_proc_lookup(BIF_ARG_1); - ErtsProcSysTaskQs *stqs, *free_stqs = NULL; ErtsProcSysTask *st = NULL; - erts_aint32_t prio, rp_state; - int rp_locked; + erts_aint32_t prio; Eterm noproc_res, req_type; if (!rp && !is_internal_pid(BIF_ARG_1)) { @@ -10125,7 +10202,6 @@ erts_internal_request_system_task_3(BIF_ALIST_3) } st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK, ERTS_PROC_SYS_TASK_SIZE(tot_sz)); - st->next = st->prev = st; /* Prep for empty prio queue */ ERTS_INIT_OFF_HEAP(&st->off_heap); hp = &st->heap[0]; @@ -10169,95 +10245,11 @@ erts_internal_request_system_task_3(BIF_ALIST_3) goto badarg; } - rp_state = erts_smp_atomic32_read_nob(&rp->state); - - rp_locked = 0; - - free_stqs = NULL; - if (rp_state & ERTS_PSFLG_ACTIVE_SYS) - stqs = NULL; - else { - alloc_qs: - stqs = proc_sys_task_queues_alloc(); - stqs->qmask = 1 << prio; - stqs->ncount = 0; - stqs->q[PRIORITY_MAX] = NULL; - stqs->q[PRIORITY_HIGH] = NULL; - stqs->q[PRIORITY_NORMAL] = NULL; - stqs->q[PRIORITY_LOW] = NULL; - stqs->q[prio] = st; - } - - if (!rp_locked) { - rp_locked = 1; - erts_smp_proc_lock(rp, ERTS_PROC_LOCK_STATUS); - - rp_state = erts_smp_atomic32_read_nob(&rp->state); - if (rp_state & ERTS_PSFLG_EXITING) { - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - rp = NULL; - free_stqs = stqs; - goto noproc; - } + if (!schedule_process_sys_task(rp, prio, st)) { + noproc: + notify_sys_task_executed(BIF_P, st, noproc_res); } - if (!rp->sys_task_qs) { - if (stqs) - rp->sys_task_qs = stqs; - else - goto alloc_qs; - } - else { - if (stqs) - free_stqs = stqs; - stqs = rp->sys_task_qs; - if (!stqs->q[prio]) { - stqs->q[prio] = st; - stqs->qmask |= 1 << prio; - } - else { - st->next = stqs->q[prio]; - st->prev = stqs->q[prio]->prev; - st->next->prev = st; - st->prev->next = st; - ASSERT(stqs->qmask & (1 << prio)); - } - } - - if (ERTS_PSFLGS_GET_ACT_PRIO(rp_state) > prio) { - erts_aint32_t n, a, e; - /* Need to elevate actual prio */ - - a = rp_state; - do { - if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) { - n = a; - break; - } - n = e = a; - n &= ~ERTS_PSFLGS_ACT_PRIO_MASK; - n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET); - a = erts_smp_atomic32_cmpxchg_nob(&rp->state, n, e); - } while (a != e); - rp_state = n; - } - - /* - * schedule_process_sys_task() unlocks status - * lock on process. - */ - schedule_process_sys_task(rp, rp_state, NULL); - - if (free_stqs) - proc_sys_task_queues_free(free_stqs); - - BIF_RET(am_ok); - -noproc: - - notify_sys_task_executed(BIF_P, st, noproc_res); - if (free_stqs) - proc_sys_task_queues_free(free_stqs); BIF_RET(am_ok); badarg: @@ -10266,11 +10258,35 @@ badarg: erts_cleanup_offheap(&st->off_heap); erts_free(ERTS_ALC_T_PROC_SYS_TSK, st); } - if (free_stqs) - proc_sys_task_queues_free(free_stqs); BIF_ERROR(BIF_P, BADARG); } +void +erts_schedule_complete_off_heap_message_queue_change(Eterm pid) +{ + Process *rp = erts_proc_lookup(pid); + if (rp) { + ErtsProcSysTask *st; + erts_aint32_t state; + int i; + + st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK, + ERTS_PROC_SYS_TASK_SIZE(0)); + st->type = ERTS_PSTT_COHMQ; + st->requester = NIL; + st->reply_tag = NIL; + st->req_id = NIL; + st->req_id_sz = 0; + for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++) + st->arg[i] = NIL; + ERTS_INIT_OFF_HEAP(&st->off_heap); + state = erts_smp_atomic32_read_nob(&rp->state); + + if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state), st)) + erts_free(ERTS_ALC_T_PROC_SYS_TSK, st); + } +} + static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) { @@ -10716,6 +10732,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm args, /* Arguments for function (must be well-formed list). */ ErlSpawnOpts* so) /* Options for spawn. */ { + Uint flags = erts_default_process_flags; ErtsRunQueue *rq = NULL; Process *p; Sint arity; /* Number of arguments. */ @@ -10753,6 +10770,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). state |= (((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_ACT_PRIO_OFFSET) | ((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_USR_PRIO_OFFSET)); + if (so->flags & SPO_OFF_HEAP_MSGQ) { + state |= ERTS_PSFLG_OFF_HEAP_MSGQ; + flags |= F_OFF_HEAP_MSGQ; + } + if (!rq) rq = erts_get_runq_proc(parent); @@ -10775,7 +10797,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_SWAP_TIMER(size,system); heap_need = arg_size; - p->flags = erts_default_process_flags; + p->flags = flags; p->static_flags = 0; if (so->flags & SPO_SYSTEM_PROC) @@ -10824,6 +10846,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->stop = p->hend = p->heap + sz; p->htop = p->heap; p->heap_sz = sz; + p->abandoned_heap = NULL; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; p->catches = 0; p->bin_vheap_sz = p->min_vheap_size; @@ -10894,6 +10918,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->accessor_bif_timers = NULL; #endif p->mbuf = NULL; + p->msg_frag = NULL; p->mbuf_sz = 0; p->psd = NULL; p->dictionary = NULL; @@ -11029,6 +11054,8 @@ void erts_init_empty_process(Process *p) p->stop = NULL; p->hend = NULL; p->heap = NULL; + p->abandoned_heap = NULL; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; p->gen_gcs = 0; p->max_gen_gcs = 0; p->min_heap_size = 0; @@ -11061,6 +11088,7 @@ void erts_init_empty_process(Process *p) p->old_htop = NULL; p->old_heap = NULL; p->mbuf = NULL; + p->msg_frag = NULL; p->mbuf_sz = 0; p->psd = NULL; ERTS_P_MONITORS(p) = NULL; @@ -11149,6 +11177,8 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->htop == NULL); ASSERT(p->stop == NULL); ASSERT(p->hend == NULL); + ASSERT(p->abandoned_heap == NULL); + ASSERT(p->live_hf_end == ERTS_INVALID_HFRAG_PTR); ASSERT(p->heap == NULL); ASSERT(p->common.id == ERTS_INVALID_PID); ASSERT(ERTS_TRACER_PROC(p) == NIL); @@ -11226,8 +11256,6 @@ erts_cleanup_empty_process(Process* p) static void delete_process(Process* p) { - ErlMessage* mp; - VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); /* Cleanup psd */ @@ -11283,24 +11311,8 @@ delete_process(Process* p) erts_erase_dicts(p); /* free all pending messages */ - mp = p->msg.first; - while(mp != NULL) { - ErlMessage* next_mp = mp->next; - if (mp->data.attached) { - if (is_value(mp->m[0])) - free_message_buffer(mp->data.heap_frag); - else { - if (is_not_nil(mp->m[1])) { - ErlHeapFragment *heap_frag; - heap_frag = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(mp->data.dist_ext); - } - } - free_message(mp); - mp = next_mp; - } + erts_cleanup_messages(p->msg.first); + p->msg.first = NULL; ASSERT(!p->nodes_monitors); ASSERT(!p->suspend_monitors); @@ -11488,6 +11500,9 @@ static ERTS_INLINE void send_exit_message(Process *to, ErtsProcLocks *to_locksp, Eterm exit_term, Uint term_size, Eterm token) { + ErtsMessage *mp; + ErlOffHeap *ohp; + if (token == NIL #ifdef USE_VM_PROBES || token == am_have_dt_utag @@ -11495,14 +11510,12 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, ) { Eterm* hp; Eterm mess; - ErlHeapFragment* bp; - ErlOffHeap *ohp; - hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp); + mp = erts_alloc_message_heap(to, to_locksp, + term_size, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); - erts_queue_message(to, to_locksp, bp, mess, NIL); + erts_queue_message(to, to_locksp, mp, mess, NIL); } else { - ErlHeapFragment* bp; Eterm* hp; Eterm mess; Eterm temp_token; @@ -11510,13 +11523,14 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, ASSERT(is_tuple(token)); sz_token = size_object(token); - bp = new_message_buffer(term_size+sz_token); - hp = bp->mem; - mess = copy_struct(exit_term, term_size, &hp, &bp->off_heap); + + mp = erts_alloc_message_heap(to, to_locksp, + term_size+sz_token, &hp, &ohp); + mess = copy_struct(exit_term, term_size, &hp, ohp); /* the trace token must in this case be updated by the caller */ seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL); - temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap); - erts_queue_message(to, to_locksp, bp, mess, temp_token); + temp_token = copy_struct(token, sz_token, &hp, ohp); + erts_queue_message(to, to_locksp, mp, mess, temp_token); } } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 65422b8c15..c6376c0166 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -916,6 +916,7 @@ struct process { Eterm* stop; /* Stack top */ Eterm* heap; /* Heap start */ Eterm* hend; /* Heap end */ + Eterm* abandoned_heap; Uint heap_sz; /* Size of heap in words */ Uint min_heap_size; /* Minimum size of heap (in words). */ Uint min_vheap_size; /* Minimum size of virtual heap (in words). */ @@ -1012,8 +1013,10 @@ struct process { Uint16 gen_gcs; /* Number of (minor) generational GCs. */ Uint16 max_gen_gcs; /* Max minor gen GCs before fullsweep. */ ErlOffHeap off_heap; /* Off-heap data updated by copy_struct(). */ - ErlHeapFragment* mbuf; /* Pointer to message buffer list */ - Uint mbuf_sz; /* Size of all message buffers */ + ErlHeapFragment* mbuf; /* Pointer to heap fragment list */ + ErlHeapFragment* live_hf_end; + ErtsMessage *msg_frag; /* Pointer to message fragment list */ + Uint mbuf_sz; /* Total size of heap fragments and message fragments */ ErtsPSD *psd; /* Rarely used process specific data */ Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */ @@ -1041,6 +1044,7 @@ struct process { #ifdef CHECK_FOR_HOLES Eterm* last_htop; /* No need to scan the heap below this point. */ ErlHeapFragment* last_mbuf; /* No need to scan beyond this mbuf. */ + ErlHeapFragment* heap_hfrag; /* Heap abandoned, htop now lives in this frag */ #endif #ifdef DEBUG @@ -1064,6 +1068,7 @@ extern const Process erts_invalid_process; do { \ (p)->last_htop = 0; \ (p)->last_mbuf = 0; \ + (p)->heap_hfrag = NULL; \ } while (0) # define ERTS_HOLE_CHECK(p) erts_check_for_holes((p)) @@ -1141,14 +1146,15 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15) #define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16) #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) +#define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18) #ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18) -#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21) -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22) +#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(19) +#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(20) +#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(22) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 23) #else -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 19) #endif #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ @@ -1196,12 +1202,15 @@ void erts_check_for_holes(Process* p); #define SPO_USE_ARGS 2 #define SPO_MONITOR 4 #define SPO_SYSTEM_PROC 8 +#define SPO_OFF_HEAP_MSGQ 16 + +extern int erts_default_spo_flags; /* * The following struct contains options for a process to be spawned. */ typedef struct { - Uint flags; + int flags; int error_code; /* Error code returned from create_process(). */ Eterm mref; /* Monitor ref returned (if SPO_MONITOR was given). */ @@ -1283,6 +1292,9 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC */ +#define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ +#define F_OFF_HEAP_MSGQ_CHNG (1 << 13) /* Off heap msg queue changing */ +#define F_ABANDONED_HEAP_USE (1 << 14) /* Have usage of abandoned heap */ /* process trace_flags */ #define F_SENSITIVE (1 << 0) @@ -1616,6 +1628,7 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *), void *, ErtsThrPrgrLaterOp *, UWord); +void erts_schedule_complete_off_heap_message_queue_change(Eterm pid); #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) int erts_dbg_check_halloc_lock(Process *p); @@ -1743,7 +1756,7 @@ Uint erts_debug_nbalance(void); int erts_debug_wait_completed(Process *c_p, int flags); -Uint erts_process_memory(Process *c_p); +Uint erts_process_memory(Process *c_p, int incl_msg_inq); #ifdef ERTS_SMP # define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data) @@ -2058,6 +2071,22 @@ ERTS_GLB_INLINE void erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq); ERTS_GLB_INLINE void erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); ERTS_GLB_INLINE void erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); +ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap_state(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp); +ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap(Process *pp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp); + +ERTS_GLB_INLINE void erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp, + Eterm *start_hp, Eterm *used_hp, Eterm *end_hp, + Eterm *brefs, Uint brefs_size); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE @@ -2206,6 +2235,63 @@ erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2) #endif } +ERTS_GLB_INLINE ErtsMessage * +erts_alloc_message_heap_state(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp) +{ + int on_heap; + + if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) { + ErtsMessage *mp = erts_alloc_message(sz, hpp); + *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + return mp; + } + + return erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap); +} + +ERTS_GLB_INLINE ErtsMessage * +erts_alloc_message_heap(Process *pp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp) +{ + erts_aint32_t state = erts_smp_atomic32_read_nob(&pp->state); + return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp); +} + +ERTS_GLB_INLINE void +erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp, + Eterm *start_hp, Eterm *used_hp, Eterm *end_hp, + Eterm *brefs, Uint brefs_size) +{ + ASSERT(start_hp <= used_hp && used_hp <= end_hp); + if ((*msgpp)->data.attached == ERTS_MSG_COMBINED_HFRAG) + *msgpp = erts_shrink_message(*msgpp, used_hp - start_hp, + brefs, brefs_size); + else if (!(*msgpp)->data.attached) { + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN + & erts_proc_lc_my_proc_locks(pp)); + HRelease(pp, end_hp, used_hp); + } + else { + ErlHeapFragment *hfrag = (*msgpp)->data.heap_frag; + if (start_hp != used_hp) + hfrag = erts_resize_message_buffer(hfrag, used_hp - start_hp, + brefs, brefs_size); + else { + free_message_buffer(hfrag); + hfrag = NULL; + } + (*msgpp)->data.heap_frag = hfrag; + } +} + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ ERTS_GLB_INLINE ErtsAtomCacheMap *erts_get_atom_cache_map(Process *c_p); diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 3b8ae11e94..71396561a3 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -78,13 +78,14 @@ erts_deep_process_dump(int to, void *to_arg) dump_binaries(to, to_arg, all_binaries); } -Uint erts_process_memory(Process *p) { - ErlMessage *mp; +Uint erts_process_memory(Process *p, int incl_msg_inq) { + ErtsMessage *mp; Uint size = 0; struct saved_calls *scb; size += sizeof(Process); - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + if (incl_msg_inq) + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size); erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size); @@ -92,7 +93,7 @@ Uint erts_process_memory(Process *p) { if (p->old_hend && p->old_heap) size += (p->old_hend - p->old_heap) * sizeof(Eterm); - size += p->msg.len * sizeof(ErlMessage); + size += p->msg.len * sizeof(ErtsMessage); for (mp = p->msg.first; mp; mp = mp->next) if (mp->data.attached) @@ -119,7 +120,7 @@ static void dump_process_info(int to, void *to_arg, Process *p) { Eterm* sp; - ErlMessage* mp; + ErtsMessage* mp; int yreg = -1; ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); @@ -657,6 +658,8 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { erts_print(to, to_arg, "PROXY"); break; case ERTS_PSFLG_DELAYED_SYS: erts_print(to, to_arg, "DELAYED_SYS"); break; + case ERTS_PSFLG_OFF_HEAP_MSGQ: + erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break; #ifdef ERTS_DIRTY_SCHEDULERS case ERTS_PSFLG_DIRTY_CPU_PROC: erts_print(to, to_arg, "DIRTY_CPU_PROC"); break; diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 788348e613..a64c993e8f 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -854,9 +854,6 @@ ERTS_GLB_INLINE void erts_proc_dec_refc(Process *p) #endif if (!referred) { ASSERT(ERTS_PROC_IS_EXITING(p)); - ASSERT(ERTS_AINT_NULL - == erts_ptab_pix2intptr_ddrb(&erts_proc, - internal_pid_index(p->common.id))); erts_free_proc(p); } } @@ -872,9 +869,6 @@ ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc) #endif if (!referred) { ASSERT(ERTS_PROC_IS_EXITING(p)); - ASSERT(ERTS_AINT_NULL - == erts_ptab_pix2intptr_ddrb(&erts_proc, - internal_pid_index(p->common.id))); erts_free_proc(p); } } diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 7327e0b48c..7ec64506e8 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -1919,15 +1919,16 @@ send_time_offset_changed_notifications(void *new_offsetp) ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK); if (erts_lookup_monitor(ERTS_P_MONITORS(rp), ref)) { - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; Eterm message; - hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, + hsz, &hp, &ohp); *patch_refp = ref; ASSERT(hsz == size_object(message_template)); message = copy_struct(message_template, hsz, &hp, ohp); - erts_queue_message(rp, &rp_locks, bp, message, NIL); + erts_queue_message(rp, &rp_locks, mp, message, NIL); } erts_smp_proc_unlock(rp, rp_locks); } diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index e9dd96efc4..d02f1f7213 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -114,15 +114,10 @@ void erts_init_trace(void) { static Eterm system_seq_tracer; -#ifdef ERTS_SMP #define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \ (*(BPP) = new_message_buffer((SZ)), \ *(OHPP) = &(*(BPP))->off_heap, \ (*(BPP))->mem) -#else -#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, RPP) \ - erts_alloc_message_heap((SZ), (BPP), (OHPP), (RPP), 0) -#endif #ifdef ERTS_SMP #define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \ @@ -131,8 +126,12 @@ do { \ enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \ } while(0) #else -#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ - erts_queue_message((TPROC), NULL, (BP), (MSG), NIL) +#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ + do { \ + ErtsMessage *mp__ = erts_alloc_message(0, NULL); \ + mp__->data.heap_frag = (BP); \ + erts_queue_message((TPROC), NULL, mp__, (MSG), NIL); \ + } while (0) #endif /* @@ -591,11 +590,9 @@ send_to_port(Process *c_p, Eterm message, static void profile_send(Eterm from, Eterm message) { Uint sz = 0; - ErlHeapFragment *bp = NULL; Uint *hp = NULL; Eterm msg = NIL; Process *profile_p = NULL; - ErlOffHeap *off_heap = NULL; Eterm profiler = erts_get_system_profile(); @@ -621,6 +618,7 @@ profile_send(Eterm from, Eterm message) { } } else { + ErtsMessage *mp; ASSERT(is_internal_pid(profiler)); profile_p = erts_proc_lookup(profiler); @@ -629,10 +627,13 @@ profile_send(Eterm from, Eterm message) { return; sz = size_object(message); - hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0); - msg = copy_struct(message, sz, &hp, &bp->off_heap); - - erts_queue_message(profile_p, NULL, bp, msg, NIL); + mp = erts_alloc_message(sz, &hp); + if (sz == 0) + msg = message; + else + msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap); + + erts_queue_message(profile_p, NULL, mp, msg, NIL); } } @@ -1233,7 +1234,11 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, erts_smp_mtx_unlock(&smq_mtx); #else /* trace_token must be NIL here */ - erts_queue_message(tracer, NULL, bp, mess, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(tracer, NULL, mp, mess, NIL); + } #endif } } @@ -2308,7 +2313,11 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg, NIL); + } #endif } void @@ -2369,7 +2378,11 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg, NIL); + } #endif } @@ -2440,7 +2453,11 @@ monitor_long_gc(Process *p, Uint time) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg, NIL); + } #endif } @@ -2511,7 +2528,11 @@ monitor_large_heap(Process *p) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg, NIL); + } #endif } @@ -2539,7 +2560,11 @@ monitor_generic(Process *p, Eterm type, Eterm spec) { #ifdef ERTS_SMP enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); #else - erts_queue_message(monitor_p, NULL, bp, msg, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg, NIL); + } #endif } @@ -3331,8 +3356,11 @@ sys_msg_dispatcher_func(void *unused) goto failure; } else { + ErtsMessage *mp; queue_proc_msg: - erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = smqp->bp; + erts_queue_message(proc,&proc_locks,mp,smqp->msg,NIL); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "delivered\n"); #endif diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 052994b972..594c0ccf94 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1274,11 +1274,11 @@ int erts_print_system_version(int to, void *arg, Process *c_p); int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg); -ERTS_GLB_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr); +ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr) +ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr) { ASSERT(is_boxed(tptr) || is_list(tptr)); ASSERT(ptr == ptr_val(tptr)); @@ -1347,124 +1347,6 @@ extern erts_driver_t fd_driver; int erts_beam_jump_table(void); -/* Should maybe be placed in erl_message.h, but then we get an include mess. */ -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap_state(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks, - erts_aint32_t *statep); - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -/* - * NOTE: erts_alloc_message_heap() releases msg q and status - * lock on receiver without ensuring that other locks are - * held. User is responsible to ensure that the receiver - * pointer cannot become invalid until after message has - * been passed. This is normal done either by increasing - * reference count on process (preferred) or by holding - * main or link lock over the whole message passing - * operation. - */ - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap_state(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks, - erts_aint32_t *statep) -{ - Eterm *hp; - erts_aint32_t state; -#ifdef ERTS_SMP - int locked_main = 0; - state = erts_smp_atomic32_read_acqb(&receiver->state); - if (statep) - *statep = state; - if (state & (ERTS_PSFLG_EXITING - | ERTS_PSFLG_PENDING_EXIT)) - goto allocate_in_mbuf; -#endif - - if (size > (Uint) INT_MAX) - erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size); - - if ( -#if defined(ERTS_SMP) - *receiver_locks & ERTS_PROC_LOCK_MAIN -#else - 1 -#endif - ) { -#ifdef ERTS_SMP - try_allocate_on_heap: -#endif - state = erts_smp_atomic32_read_nob(&receiver->state); - if (statep) - *statep = state; - if ((state & (ERTS_PSFLG_EXITING - | ERTS_PSFLG_PENDING_EXIT)) - || (receiver->flags & F_DISABLE_GC) - || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) { - /* - * The heap is either potentially in an inconsistent - * state, or not large enough. - */ -#ifdef ERTS_SMP - if (locked_main) { - *receiver_locks &= ~ERTS_PROC_LOCK_MAIN; - erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MAIN); - } -#endif - goto allocate_in_mbuf; - } - hp = HEAP_TOP(receiver); - HEAP_TOP(receiver) = hp + size; - *bpp = NULL; - *ohpp = &MSO(receiver); - } -#ifdef ERTS_SMP - else if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MAIN) == 0) { - locked_main = 1; - *receiver_locks |= ERTS_PROC_LOCK_MAIN; - goto try_allocate_on_heap; - } -#endif - else { - ErlHeapFragment *bp; - allocate_in_mbuf: - bp = new_message_buffer(size); - hp = bp->mem; - *bpp = bp; - *ohpp = &bp->off_heap; - } - - return hp; -} - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks) -{ - return erts_alloc_message_heap_state(size, bpp, ohpp, receiver, - receiver_locks, NULL); -} - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - #define DeclareTmpHeap(VariableName,Size,Process) \ Eterm VariableName[Size] #define DeclareTypedTmpHeap(Type,VariableName,Process) \ @@ -1522,6 +1404,7 @@ dtrace_fun_decode(Process *process, erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%T/%d", module, function, arity); } + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ #endif /* !__GLOBAL_H__ */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index fdd26fcc4b..1b0c617632 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1410,7 +1410,7 @@ queue_port_sched_op_reply(Process *rp, erts_factory_trim_and_close(factory, &msg, 1); - erts_queue_message(rp, rp_locksp, factory->heap_frags, msg, NIL); + erts_queue_message(rp, rp_locksp, factory->message, msg, NIL); } static void @@ -1418,12 +1418,9 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg) { Process *rp = erts_proc_lookup_raw(to); if (rp) { - ErlOffHeap *ohp; - ErlHeapFragment* bp; ErtsHeapFactory factory; Eterm msg_copy; Uint hsz, msg_sz; - Eterm *hp; ErtsProcLocks rp_locks = 0; hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; @@ -1434,18 +1431,13 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg) hsz += msg_sz; } - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); - if (is_immed(msg)) - msg_copy = msg; - else { - msg_copy = copy_struct(msg, msg_sz, &hp, ohp); - factory.hp = hp; - } + (void) erts_factory_message_create(&factory, rp, + &rp_locks, hsz); + msg_copy = (is_immed(msg) + ? msg + : copy_struct(msg, msg_sz, + &factory.hp, + factory.off_heap)); queue_port_sched_op_reply(rp, &rp_locks, @@ -3050,16 +3042,17 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) if (rp) { Eterm tuple; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; Eterm* hp; Uint sz_res; sz_res = size_object(res); - hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, + sz_res + 3, &hp, &ohp); res = copy_struct(res, sz_res, &hp, ohp); tuple = TUPLE2(hp, sender, res); - erts_queue_message(rp, &rp_locks, bp, tuple, NIL); + erts_queue_message(rp, &rp_locks, mp, tuple, NIL); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); @@ -3087,7 +3080,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, Eterm tuple; Process* rp; Eterm* hp; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; @@ -3113,7 +3106,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if (!rp) return; - hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp); listp = NIL; if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) { @@ -3155,7 +3148,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -3229,7 +3222,7 @@ deliver_vec_message(Port* prt, /* Port */ Eterm tuple; Process* rp; Eterm* hp; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; @@ -3261,7 +3254,7 @@ deliver_vec_message(Port* prt, /* Port */ need += (hlen+csize)*2; } - hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp); listp = NIL; iov += vsize; @@ -3322,7 +3315,7 @@ deliver_vec_message(Port* prt, /* Port */ tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) erts_proc_dec_refc(rp); @@ -3813,7 +3806,6 @@ write_port_control_result(int control_flags, ErlDrvSizeT resp_size, char *pre_alloc_buf, Eterm **hpp, - ErlHeapFragment *bp, ErlOffHeap *ohp) { Eterm res; @@ -3887,9 +3879,6 @@ port_sig_control(Port *prt, if (res == ERTS_PORT_OP_DONE) { Eterm msg; - Eterm *hp; - ErlHeapFragment *bp; - ErlOffHeap *ohp; ErtsHeapFactory factory; Process *rp; ErtsProcLocks rp_locks = 0; @@ -3909,22 +3898,15 @@ port_sig_control(Port *prt, hsz = rsz + ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); + (void) erts_factory_message_create(&factory, rp, + &rp_locks, hsz); msg = write_port_control_result(control_flags, resp_bufp, resp_size, &resp_buf[0], - &hp, - bp, - ohp); - factory.hp = hp; - + &factory.hp, + factory.off_heap); queue_port_sched_op_reply(rp, &rp_locks, &factory, @@ -4065,7 +4047,6 @@ erts_port_control(Process* c_p, resp_size, &resp_buf[0], &hp, - NULL, &c_p->off_heap); BUMP_REDS(c_p, ERTS_PORT_REDS_CONTROL); return ERTS_PORT_OP_DONE; @@ -4224,21 +4205,14 @@ port_sig_call(Port *prt, hsz = erts_decode_ext_size((byte *) resp_bufp, resp_size); if (hsz >= 0) { - ErlHeapFragment* bp; - ErlOffHeap* ohp; ErtsHeapFactory factory; byte *endp; hsz += 3; /* ok tuple */ hsz += ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); + (void) erts_factory_message_create(&factory, rp, &rp_locks, hsz); endp = (byte *) resp_bufp; - erts_factory_message_init(&factory, rp, hp, bp); msg = erts_decode_ext(&factory, &endp); if (is_value(msg)) { hp = erts_produce_heap(&factory, @@ -4499,7 +4473,9 @@ port_sig_info(Port *prt, sigdp->u.info.item); if (is_value(value)) { ErtsHeapFactory factory; - erts_factory_message_init(&factory, NULL, hp, bp); + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_factory_selfcontained_message_init(&factory, mp, hp); queue_port_sched_op_reply(rp, &rp_locks, &factory, @@ -4587,8 +4563,8 @@ reply_io_bytes(void *vreq) rp = erts_proc_lookup(req->pid); if (rp) { - ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks; Eterm ref, msg, ein, eout, *hp; Uint64 in, out; @@ -4610,7 +4586,7 @@ reply_io_bytes(void *vreq) erts_bld_uint64(NULL, &hsz, in); erts_bld_uint64(NULL, &hsz, out); - hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp); ref = make_internal_ref(hp); write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]); @@ -4620,7 +4596,7 @@ reply_io_bytes(void *vreq) eout = erts_bld_uint64(&hp, NULL, out); msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout); - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg, NIL); if (req->sched_id == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -5065,11 +5041,11 @@ ErlDrvTermData driver_mk_term_nil(void) void driver_report_exit(ErlDrvPort ix, int status) { Eterm* hp; + ErlOffHeap *ohp; Eterm tuple; Process *rp; Eterm pid; - ErlHeapFragment *bp = NULL; - ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; Port* prt = erts_drvport2port(ix); @@ -5089,13 +5065,13 @@ void driver_report_exit(ErlDrvPort ix, int status) if (!rp) return; - hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, 3+3, &hp, &ohp); tuple = TUPLE2(hp, am_exit_status, make_small(status)); hp += 3; tuple = TUPLE2(hp, prt->common.id, tuple); - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -5205,7 +5181,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ErtsProcLocks rp_locks = 0; struct b2t_states__ b2t; int scheduler; - int is_heap_need_limited = 1; ErtsSchedulerData *esdp = erts_get_scheduler_data(); ERTS_UNDEF(mess,NIL); @@ -5374,9 +5349,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) need += hsz; ptr += 2; depth++; - if (size > MAP_SMALL_MAP_LIMIT*3) { /* may contain big map */ - is_heap_need_limited = 0; - } break; } case ERL_DRV_MAP: { /* int */ @@ -5384,7 +5356,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) if ((int) ptr[0] < 0) ERTS_DDT_FAIL; if (ptr[0] > MAP_SMALL_MAP_LIMIT) { need += HASHMAP_ESTIMATED_HEAP_SIZE(ptr[0]); - is_heap_need_limited = 0; } else { need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0]; } @@ -5423,17 +5394,7 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) goto done; } - /* Try copy directly to destination heap if we know there are no big maps */ - if (is_heap_need_limited) { - ErlOffHeap *ohp; - ErlHeapFragment* bp; - Eterm* hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); - } - else { - erts_factory_message_init(&factory, NULL, NULL, - new_message_buffer(need)); - } + (void) erts_factory_message_create(&factory, rp, &rp_locks, need); /* * Interpret the instructions and build the term. @@ -5702,9 +5663,9 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) if (res > 0) { mess = ESTACK_POP(stack); /* get resulting value */ - erts_factory_close(&factory); + erts_factory_trim_and_close(&factory, &mess, 1); /* send message */ - erts_queue_message(rp, &rp_locks, factory.heap_frags, mess, am_undefined); + erts_queue_message(rp, &rp_locks, factory.message, mess, am_undefined); } else { if (b2t.ix > b2t.used) diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 5db7ee6d7c..90e16ca14f 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -70,8 +70,10 @@ #endif #if ERTS_CAN_INLINE +#define ERTS_GLB_FORCE_INLINE static ERTS_FORCE_INLINE #define ERTS_GLB_INLINE static ERTS_INLINE #else +#define ERTS_GLB_FORCE_INLINE #define ERTS_GLB_INLINE #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index a741e2e2e6..e03113b8cc 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -110,7 +110,6 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra) { ErlHeapFragment* bp; - Eterm* htop; Uint n; #if defined(DEBUG) || defined(CHECK_FOR_HOLES) Uint i; @@ -156,16 +155,6 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra) n--; #endif - /* - * When we have created a heap fragment, we are no longer allowed - * to store anything more on the heap. - */ - htop = HEAP_TOP(p); - if (htop < HEAP_LIMIT(p)) { - *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1); - HEAP_TOP(p) = HEAP_LIMIT(p); - } - bp->next = MBUF(p); MBUF(p) = bp; bp->alloc_size = n; @@ -2285,7 +2274,11 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment * erts_queue_error_logger_message(from, message, bp); } #else - erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(p, NULL /* only used for smp build */, mp, message, NIL); + } #endif } diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 2c747771ac..2e19bf88bf 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -46,10 +46,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) /* arch-specific nstack walk state */ struct nstack_walk_state walk_state; - /* fullsweep-specific state */ - char *src, *oh; - Uint src_size, oh_size; - if (!p->hipe.nstack) { ASSERT(!p->hipe.nsp && !p->hipe.nstend); return n_htop; @@ -66,11 +62,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) sdesc = nstack_walk_init_sdesc(p, &walk_state); - src = (char*)HEAP_START(p); - src_size = (char*)HEAP_TOP(p) - src; - oh = (char*)OLD_HEAP(p); - oh_size = (char*)OLD_HTOP(p) - oh; - for (;;) { if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { if (nsp == nsp_end) { @@ -97,8 +88,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *nsp_i = val; - } else if (in_area(ptr, src, src_size) || - in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_BOXED(ptr, val, n_htop, nsp_i); } } else if (is_list(gval)) { @@ -106,8 +96,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) Eterm val = *ptr; if (IS_MOVED_CONS(val)) { *nsp_i = ptr[1]; - } else if (in_area(ptr, src, src_size) || - in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { ASSERT(within(ptr, p)); MOVE_CONS(ptr, val, n_htop, nsp_i); } @@ -139,11 +128,13 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) unsigned int mask; /* arch-specific nstack walk state */ struct nstack_walk_state walk_state; + char *oh; + Uint oh_size; /* gensweep-specific state */ Eterm *old_htop, *n_htop; - char *heap; - Uint heap_size, mature_size; + char *mature; + Uint mature_size; if (!p->hipe.nstack) { ASSERT(!p->hipe.nsp && !p->hipe.nstend); @@ -168,9 +159,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) old_htop = *ptr_old_htop; n_htop = *ptr_n_htop; - heap = (char*)HEAP_START(p); - heap_size = (char*)HEAP_TOP(p) - heap; - mature_size = (char*)HIGH_WATER(p) - heap; + mature = (char *) (p->abandoned_heap ? p->abandoned_heap : p->heap); + mature_size = (char*)HIGH_WATER(p) - mature; + oh = (char*)OLD_HEAP(p); + oh_size = (char*)OLD_HTOP(p) - oh; for (;;) { if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { @@ -209,9 +201,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *nsp_i = val; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr, val, old_htop, nsp_i); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { ASSERT(within(ptr, p)); MOVE_BOXED(ptr, val, n_htop, nsp_i); } @@ -220,9 +212,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) Eterm val = *ptr; if (IS_MOVED_CONS(val)) { *nsp_i = ptr[1]; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr, val, old_htop, nsp_i); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { ASSERT(within(ptr, p)); MOVE_CONS(ptr, val, n_htop, nsp_i); } diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 98bda43f0e..ceae3497c5 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -160,13 +160,22 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) */ void hipe_select_msg(Process *p) { - ErlMessage *msgp; + ErtsMessage *msgp; msgp = PEEK_MESSAGE(p); UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */ JOIN_MESSAGE(p); CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */ - free_message(msgp); + erts_save_message_in_proc(p, msgp); + p->flags &= ~F_DISABLE_GC; + if (ERTS_IS_GC_DESIRED(p)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS(p, 5); + } } void hipe_fclearerror_error(Process *p) @@ -511,8 +520,9 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) */ Eterm hipe_check_get_msg(Process *c_p) { - Eterm ret; - ErlMessage *msgp; + ErtsMessage *msgp; + + c_p->flags |= F_DISABLE_GC; next_message: @@ -534,25 +544,29 @@ Eterm hipe_check_get_msg(Process *c_p) /* XXX: BEAM doesn't need this */ c_p->hipe_smp.have_receive_locks = 1; #endif + c_p->flags &= ~F_DISABLE_GC; return THE_NON_VALUE; #ifdef ERTS_SMP } #endif } - ErtsMoveMsgAttachmentIntoProc(msgp, c_p, c_p->stop, HEAP_TOP(c_p), - c_p->fcalls, (void) 0, (void) 0); - ret = ERL_MESSAGE_TERM(msgp); - if (is_non_value(ret)) { + + if (is_non_value(ERL_MESSAGE_TERM(msgp)) + && !erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { /* * A corrupt distribution message that we weren't able to decode; * remove it... */ ASSERT(!msgp->data.attached); UNLINK_MESSAGE(c_p, msgp); - free_message(msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); goto next_message; } - return ret; + + ASSERT(is_value(ERL_MESSAGE_TERM(msgp))); + + return ERL_MESSAGE_TERM(msgp); } /* diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index cde0b25a2a..461957be10 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -155,6 +155,12 @@ static char *plusr_val_switches[] = { NULL }; +/* +x arguments with values */ +static char *plusx_val_switches[] = { + "ohmq", + NULL +}; + /* +z arguments with values */ static char *plusz_val_switches[] = { "dbbl", @@ -975,6 +981,20 @@ int main(int argc, char **argv) add_Eargs(argv[i+1]); i++; break; + case 'x': + if (!is_one_of_strings(&argv[i][2], plusx_val_switches)) { + goto the_default; + } else { + if (i+1 >= argc + || argv[i+1][0] == '-' + || argv[i+1][0] == '+') + usage(argv[i]); + argv[i][0] = '-'; + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + } + break; case 'z': if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) { goto the_default; @@ -1175,7 +1195,7 @@ usage_aux(void) "[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] " "[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] " "[+T LEVEL] [+V] [+v] " - "[+W] [+z MISC_OPTION] [args ...]\n"); + "[+W] [+x DEFAULT_PROC_FLAGS] [+z MISC_OPTION] [args ...]\n"); exit(1); } diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 863a5e61ef..641fac2d26 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 291356c7b1..e46d64eb0a 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2044,6 +2044,9 @@ open_port(_PortName,_PortSettings) -> (min_bin_vheap_size, MinBinVHeapSize) -> OldMinBinVHeapSize when MinBinVHeapSize :: non_neg_integer(), OldMinBinVHeapSize :: non_neg_integer(); + (off_heap_message_queue, OHMQ) -> OldOHMQ when + OHMQ :: boolean(), + OldOHMQ :: boolean(); (priority, Level) -> OldLevel when Level :: priority_level(), OldLevel :: priority_level(); @@ -2082,6 +2085,7 @@ process_flag(_Flag, _Value) -> min_bin_vheap_size | monitored_by | monitors | + off_heap_message_queue | priority | reductions | registered_name | @@ -2123,6 +2127,7 @@ process_flag(_Flag, _Value) -> {monitors, Monitors :: [{process, Pid :: pid() | {RegName :: atom(), Node :: node()}}]} | + {off_heap_message_queue, OHMQ :: boolean()} | {priority, Level :: priority_level()} | {reductions, Number :: non_neg_integer()} | {registered_name, Atom :: atom()} | @@ -2425,6 +2430,7 @@ tuple_to_list(_Tuple) -> (multi_scheduling) -> disabled | blocked | enabled; (multi_scheduling_blockers) -> [PID :: pid()]; (nif_version) -> string(); + (off_heap_message_queue) -> boolean(); (otp_release) -> string(); (os_monotonic_time_source) -> [{atom(),term()}]; (os_system_time_source) -> [{atom(),term()}]; @@ -2552,14 +2558,19 @@ spawn_monitor(M, F, A) when erlang:is_atom(M), spawn_monitor(M, F, A) -> erlang:error(badarg, [M,F,A]). + +-type spawn_opt_option() :: + link + | monitor + | {priority, Level :: priority_level()} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()} + | {off_heap_message_queue, OHMQ :: boolean()}. + -spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when Fun :: function(), - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(F, O) when erlang:is_function(F) -> spawn_opt(erlang, apply, [F, []], O); spawn_opt({M,F}=MF, O) when erlang:is_atom(M), erlang:is_atom(F) -> @@ -2572,12 +2583,7 @@ spawn_opt(F, O) -> -spec spawn_opt(Node, Fun, Options) -> pid() | {pid(), reference()} when Node :: node(), Fun :: function(), - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(N, F, O) when N =:= erlang:node() -> spawn_opt(F, O); spawn_opt(N, F, O) when erlang:is_function(F) -> @@ -2664,12 +2670,7 @@ spawn_link(N,M,F,A) -> Module :: module(), Function :: atom(), Args :: [term()], - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(M, F, A, Opts) -> case catch erlang:spawn_opt({M,F,A,Opts}) of {'EXIT',{Reason,_}} -> @@ -2684,12 +2685,7 @@ spawn_opt(M, F, A, Opts) -> Module :: module(), Function :: atom(), Args :: [term()], - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(N, M, F, A, O) when N =:= erlang:node(), erlang:is_atom(M), erlang:is_atom(F), erlang:is_list(A), erlang:is_list(O) -> -- cgit v1.2.3 From b56f5a163555181dceb79cbfd0d69d3cb5015e9c Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 10 Nov 2015 12:06:30 +0100 Subject: Use the same conditions when triggering GC after BIF --- erts/emulator/beam/beam_emu.c | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 1dd56ff989..9521997987 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3533,14 +3533,7 @@ do { \ apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); - /* - * We want to test with ERTS_IS_GC_DESIRED(c_p) in order - * to trigger gc due to binaries based on same conditions - * regardless of how the bif is called. This change will - * however be introduced in a separate commit in order to - * easier identify why the characteristics changed. - */ - if (c_p->stop - c_p->htop < c_p->mbuf_sz) { + if (ERTS_IS_GC_DESIRED(c_p)) { nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, nif_bif_result, reg, bif_nif_arity); -- cgit v1.2.3 From 9c6f45b901ee701553afe34c0b33b7d931d73fd9 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 11 Nov 2015 11:39:32 +0100 Subject: Bump reductions on GC --- erts/emulator/beam/beam_bif_load.c | 2 +- erts/emulator/beam/beam_emu.c | 108 ++++++++++++++++------------- erts/emulator/beam/bif.c | 6 +- erts/emulator/beam/erl_gc.c | 126 ++++++++++++++++++++++------------ erts/emulator/beam/erl_gc.h | 3 +- erts/emulator/beam/erl_process.c | 10 +-- erts/emulator/beam/erl_process_dict.c | 6 +- erts/emulator/hipe/hipe_mode_switch.c | 2 +- erts/emulator/hipe/hipe_mode_switch.h | 2 +- erts/emulator/hipe/hipe_native_bif.c | 2 +- 10 files changed, 159 insertions(+), 108 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 22b4e26c77..c3ebf71a01 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -935,7 +935,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); + *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity); done_gc |= ERTS_ORDINARY_GC__; } if (need_gc & ERTS_LITERAL_GC__) { diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 9521997987..f74f182863 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -237,6 +237,14 @@ void** beam_ops; HEAP_TOP(c_p) = HTOP; \ c_p->stop = E +#define HEAVY_SWAPIN \ + SWAPIN; \ + FCALLS = c_p->fcalls + +#define HEAVY_SWAPOUT \ + SWAPOUT; \ + c_p->fcalls = FCALLS + /* * Use LIGHT_SWAPOUT when the called function * will call HeapOnlyAlloc() (and never HAlloc()). @@ -297,7 +305,7 @@ void** beam_ops; if (E - HTOP < (needed + (HeapNeed))) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -349,7 +357,7 @@ void** beam_ops; if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -370,7 +378,7 @@ void** beam_ops; if (E - HTOP < need) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -391,7 +399,7 @@ void** beam_ops; SWAPOUT; \ reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ Extra = reg[Live]; \ @@ -415,9 +423,9 @@ void** beam_ops; #define MakeFun(FunP, NumFree) \ do { \ - SWAPOUT; \ + HEAVY_SWAPOUT; \ r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \ - SWAPIN; \ + HEAVY_SWAPIN; \ } while (0) #define PutTuple(Dst, Arity) \ @@ -1402,11 +1410,11 @@ void process_main(void) } live = Arg(2); - SWAPOUT; + HEAVY_SWAPOUT; reg[live] = increment_reg_val; reg[live+1] = make_small(increment_val); result = erts_gc_mixed_plus(c_p, reg, live); - SWAPIN; + HEAVY_SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_value(result)) { StoreBifResult(3, result); @@ -1420,11 +1428,11 @@ void process_main(void) Eterm result; \ Uint live = Arg(1); \ \ - SWAPOUT; \ + HEAVY_SWAPOUT; \ reg[live] = Op1; \ reg[live+1] = Op2; \ result = erts_gc_##name(c_p, reg, live); \ - SWAPIN; \ + HEAVY_SWAPIN; \ ERTS_HOLE_CHECK(c_p); \ if (is_value(result)) { \ StoreBifResult(4, result); \ @@ -1744,7 +1752,7 @@ void process_main(void) if (E - HTOP < 3) { SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2382,9 +2390,9 @@ void process_main(void) OpCase(new_map_dII): { Eterm res; - SWAPOUT; + HEAVY_SWAPOUT; res = new_map(c_p, reg, I-1); - SWAPIN; + HEAVY_SWAPIN; StoreResult(res, Arg(0)); Next(3+Arg(2)); } @@ -2472,9 +2480,9 @@ do { \ Eterm map; GetArg1(1, map); - SWAPOUT; + HEAVY_SWAPOUT; res = update_map_assoc(c_p, reg, map, I); - SWAPIN; + HEAVY_SWAPIN; if (is_value(res)) { StoreResult(res, Arg(2)); Next(5+Arg(4)); @@ -2494,9 +2502,9 @@ do { \ Eterm map; GetArg1(1, map); - SWAPOUT; + HEAVY_SWAPOUT; res = update_map_exact(c_p, reg, map, I); - SWAPIN; + HEAVY_SWAPIN; if (is_value(res)) { StoreResult(res, Arg(2)); Next(5+Arg(4)); @@ -3072,10 +3080,10 @@ do { \ bnot_val = make_small(~signed_val(bnot_val)); } else { Uint live = Arg(2); - SWAPOUT; + HEAVY_SWAPOUT; reg[live] = bnot_val; bnot_val = erts_gc_bnot(c_p, reg, live); - SWAPIN; + HEAVY_SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_nil(bnot_val)) { goto lb_Cl_error; @@ -3090,9 +3098,9 @@ do { \ OpCase(i_apply): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+1); SET_I(next); @@ -3104,9 +3112,9 @@ do { \ OpCase(i_apply_last_P): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); @@ -3119,9 +3127,9 @@ do { \ OpCase(i_apply_only): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_I(next); Dispatch(); @@ -3133,9 +3141,9 @@ do { \ OpCase(apply_I): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+2); SET_I(next); @@ -3148,9 +3156,9 @@ do { \ OpCase(apply_last_IP): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); @@ -3164,9 +3172,9 @@ do { \ OpCase(i_apply_fun): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+1); SET_I(next); @@ -3178,9 +3186,9 @@ do { \ OpCase(i_apply_fun_last_P): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); @@ -3193,9 +3201,9 @@ do { \ OpCase(i_apply_fun_only): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_I(next); Dispatchfun(); @@ -3206,9 +3214,9 @@ do { \ OpCase(i_call_fun_I): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+2); SET_I(next); @@ -3220,9 +3228,9 @@ do { \ OpCase(i_call_fun_last_IP): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); @@ -3421,9 +3429,9 @@ do { \ * code[3]: &&call_error_handler * code[4]: Not used */ - SWAPOUT; + HEAVY_SWAPOUT; I = call_error_handler(c_p, I-3, reg, am_undefined_function); - SWAPIN; + HEAVY_SWAPIN; if (I) { Goto(*I); } @@ -3977,10 +3985,10 @@ do { \ Eterm Size; GetArg1(4, Size); - SWAPOUT; + HEAVY_SWAPOUT; reg[live] = x(SCRATCH_X_REG); res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3)); - SWAPIN; + HEAVY_SWAPIN; if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ goto lb_Cl_error; @@ -4005,9 +4013,9 @@ do { \ } OpCase(bs_init_writable): { - SWAPOUT; + HEAVY_SWAPOUT; r(0) = erts_bs_init_writable(c_p, r(0)); - SWAPIN; + HEAVY_SWAPIN; Next(0); } @@ -4835,7 +4843,7 @@ do { \ BeamInstr *next; next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { SET_I(next); Dispatchfun(); @@ -4884,20 +4892,22 @@ do { \ } OpCase(i_hibernate): { - SWAPOUT; + HEAVY_SWAPOUT; if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { + FCALLS = c_p->fcalls; c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } else { + HEAVY_SWAPIN; I = handle_error(c_p, I, reg, hibernate_3); goto post_error_handling; } } OpCase(i_debug_breakpoint): { - SWAPOUT; + HEAVY_SWAPOUT; I = call_error_handler(c_p, I-3, reg, am_breakpoint); - SWAPIN; + HEAVY_SWAPIN; if (I) { Goto(*I); } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index e4283ac945..57dd045193 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -3839,11 +3839,9 @@ BIF_RETTYPE now_0(BIF_ALIST_0) BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) { - int reds; - FLAGS(BIF_P) |= F_NEED_FULLSWEEP; - reds = erts_garbage_collect(BIF_P, 0, NULL, 0); - BIF_RET2(am_true, reds); + erts_garbage_collect(BIF_P, 0, NULL, 0); + BIF_RET(am_true); } /**********************************************************************/ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6a52e1a890..7163b4839d 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -135,7 +135,7 @@ static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm char* src, Uint src_size); static Eterm* collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, Eterm* heap, Eterm* htop, Eterm* objv, int nobj); -static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj); +static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj); static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj); static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj); static void sweep_off_heap(Process *p, int fullsweep); @@ -172,6 +172,20 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; +static ERTS_INLINE int +gc_cost(Uint gc_moved_live_words, Uint resize_moved_words) +{ + Sint reds; + + reds = gc_moved_live_words/10; + reds += resize_moved_words/100; + if (reds < 1) + return 1; + if (reds > INT_MAX) + return INT_MAX; + return (int) reds; +} + ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, ErtsGCInfoReq, 5, @@ -413,6 +427,7 @@ static ERTS_INLINE void reset_active_writer(Process *p) } #define ERTS_DELAY_GC_EXTRA_FREE 40 +#define ERTS_ABANDON_HEAP_COST 10 static int delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) @@ -421,6 +436,7 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop; Eterm *stop, *hend; Uint hsz, ssz; + int reds_left; ERTS_HOLE_CHECK(p); @@ -482,7 +498,12 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) /* Make sure that we do a proper GC as soon as possible... */ p->flags |= F_FORCE_GC; - return CONTEXT_REDS; + reds_left = ERTS_BIF_REDS_LEFT(p); + if (reds_left > ERTS_ABANDON_HEAP_COST) { + int vreds = reds_left - ERTS_ABANDON_HEAP_COST; + ERTS_VBUMP_REDS(p, vreds); + } + return ERTS_ABANDON_HEAP_COST; } static ERTS_FORCE_INLINE Uint @@ -536,7 +557,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, int need, Eterm* objv, int nobj) { Uint reclaimed_now = 0; - int done = 0; + int reds; ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; #ifdef USE_VM_PROBES @@ -562,9 +583,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, ERTS_CHK_OFFHEAP(p); ErtsGcQuickSanityCheck(p); - if (GEN_GCS(p) >= MAX_GEN_GCS(p)) { - FLAGS(p) |= F_NEED_FULLSWEEP; - } + #ifdef USE_VM_PROBES *pidbuf = '\0'; if (DTRACE_ENABLED(gc_major_start) @@ -577,17 +596,21 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, /* * Test which type of GC to do. */ - while (!done) { - if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { - DTRACE2(gc_major_start, pidbuf, need); - done = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_major_end, pidbuf, reclaimed_now); - } else { - DTRACE2(gc_minor_start, pidbuf, need); - done = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_minor_end, pidbuf, reclaimed_now); - } + + if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) { + DTRACE2(gc_minor_start, pidbuf, need); + reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_minor_end, pidbuf, reclaimed_now); + if (reds < 0) + goto do_major_collection; + } + else { + do_major_collection: + DTRACE2(gc_major_start, pidbuf, need); + reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_major_end, pidbuf, reclaimed_now); } + reset_active_writer(p); /* @@ -648,23 +671,22 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, p->last_old_htop = p->old_htop; #endif - /* FIXME: This function should really return an Sint, i.e., a possibly - 64 bit wide signed integer, but that requires updating all the code - that calls it. For now, we just return INT_MAX if the result is too - large for an int. */ - { - Sint result = (HEAP_TOP(p) - HEAP_START(p)) / 10; - if (result >= INT_MAX) return INT_MAX; - else return (int) result; - } + return reds; } int -erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj) { return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); } +void +erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +{ + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + BUMP_REDS(p, reds); +} + /* * Place all living data on a the new heap; deallocate any old heap. * Meant to be used by hibernate/3. @@ -679,6 +701,7 @@ erts_garbage_collect_hibernate(Process* p) char* area; Uint area_size; Sint offs; + int reds; if (p->flags & F_DISABLE_GC) ERTS_INTERNAL_ERROR("GC disabled"); @@ -774,6 +797,9 @@ erts_garbage_collect_hibernate(Process* p) ErtsGcQuickSanityCheck(p); erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); + + reds = gc_cost(actual_size, actual_size); + BUMP_REDS(p, reds); } @@ -989,16 +1015,21 @@ minor_collection(Process* p, ErlHeapFragment *live_hf_end, ((mature_size <= OLD_HEND(p) - OLD_HTOP(p)) && ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { - Uint stack_size, size_after, need_after, new_sz; + Eterm *prev_old_htop; + Uint stack_size, size_after, adjust_size, need_after, new_sz, new_mature; stack_size = p->hend - p->stop; new_sz = stack_size + size_before; new_sz = next_heap_size(p, new_sz, 0); + prev_old_htop = p->old_htop; do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm), new_sz, objv, nobj); - size_after = HEAP_TOP(p) - HEAP_START(p); + new_mature = p->old_htop - prev_old_htop; + + size_after = new_mature; + size_after += HEAP_TOP(p) - HEAP_START(p); *recl += (size_before - size_after); ErtsGcQuickSanityCheck(p); @@ -1017,6 +1048,8 @@ minor_collection(Process* p, ErlHeapFragment *live_hf_end, * the heap size is substantial, we don't want to shrink. */ + adjust_size = 0; + if ((HEAP_SIZE(p) > 3000) && (4 * need_after < HEAP_SIZE(p)) && ((HEAP_SIZE(p) > 8000) || (HEAP_SIZE(p) > (OLD_HEND(p) - OLD_HEAP(p))))) { @@ -1038,31 +1071,33 @@ minor_collection(Process* p, ErlHeapFragment *live_hf_end, : next_heap_size(p, wanted, 0); if (wanted < HEAP_SIZE(p)) { shrink_new_heap(p, wanted, objv, nobj); + adjust_size = p->htop - p->heap; } - ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); - ASSERT(MBUF(p) == NULL); - return 1; /* We are done. */ + goto done; } if (HEAP_SIZE(p) >= need_after) { /* * The heap size turned out to be just right. We are done. */ - ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); - ASSERT(MBUF(p) == NULL); - return 1; + goto done; } grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj); - return 1; + adjust_size = p->htop - p->heap; + + done: + ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); + ASSERT(MBUF(p) == NULL); + + return gc_cost(size_after, adjust_size); } /* * Not enough room for a minor collection. Must force a major collection. */ - FLAGS(p) |= F_NEED_FULLSWEEP; - return 0; + return -1; } /* @@ -1341,12 +1376,13 @@ static int major_collection(Process* p, ErlHeapFragment *live_hf_end, int need, Eterm* objv, int nobj, Uint *recl) { - Uint size_before, stack_size; + Uint size_before, size_after, stack_size; Eterm* n_heap; Eterm* n_htop; char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; Uint new_sz, stk_sz; + int adjusted; /* * Do a fullsweep GC. First figure out the size of the heap @@ -1413,9 +1449,10 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, ErtsGcQuickSanityCheck(p); - *recl += size_before - (HEAP_TOP(p) - HEAP_START(p)); + size_after = HEAP_TOP(p) - HEAP_START(p); + *recl += size_before - size_after; - adjust_after_fullsweep(p, need, objv, nobj); + adjusted = adjust_after_fullsweep(p, need, objv, nobj); #ifdef HARDDEBUG disallow_heap_frag_ref_in_heap(p); @@ -1423,7 +1460,8 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, remove_message_buffers(p); ErtsGcQuickSanityCheck(p); - return 1; /* We are done. */ + + return gc_cost(size_after, adjusted ? size_after : 0); } static Eterm * @@ -1524,9 +1562,10 @@ full_sweep_heaps(Process *p, return n_htop; } -static void +static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) { + int adjusted = 0; Uint wanted, sz, need_after; Uint stack_size = STACK_SZ_ON_HEAP(p); @@ -1539,6 +1578,7 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) /* Too small - grow to match requested need */ sz = next_heap_size(p, need_after, 0); grow_new_heap(p, sz, objv, nobj); + adjusted = 1; } else if (3 * HEAP_SIZE(p) < 4 * need_after){ /* Need more than 75% of current, postpone to next GC.*/ FLAGS(p) |= F_HEAP_GROW; @@ -1555,8 +1595,10 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) if (sz < HEAP_SIZE(p)) { shrink_new_heap(p, sz, objv, nobj); + adjusted = 1; } } + return adjusted; } /* diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index a496c5f008..d603866cbf 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -134,7 +134,8 @@ typedef struct { void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); -int erts_garbage_collect(struct process*, int, Eterm*, int); +int erts_garbage_collect_nobump(struct process*, int, Eterm*, int); +void erts_garbage_collect(struct process*, int, Eterm*, int); void erts_garbage_collect_hibernate(struct process* p); Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, Eterm result, Eterm* regs, Uint arity); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index e490ffea5a..5e7ed0d151 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9774,7 +9774,7 @@ Process *schedule(Process *p, int calls) if (ERTS_IS_GC_DESIRED(p)) { if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & F_DISABLE_GC)) { - reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity); + reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity); if (reds <= 0) { p->fcalls = reds; goto sched_out_proc; @@ -10057,10 +10057,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) else { if (!garbage_collected) { FLAGS(c_p) |= F_NEED_FULLSWEEP; - reds += erts_garbage_collect(c_p, - 0, - c_p->arg_reg, - c_p->arity); + reds += erts_garbage_collect_nobump(c_p, + 0, + c_p->arg_reg, + c_p->arity); garbage_collected = 1; } st_res = am_true; diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 8606371bdf..f82cad745a 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -583,7 +583,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) root[0] = id; root[1] = value; root[2] = old; - BUMP_REDS(p, erts_garbage_collect(p, needed, root, 3)); + erts_garbage_collect(p, needed, root, 3); id = root[0]; value = root[1]; old = root[2]; @@ -715,7 +715,7 @@ static void shrink(Process *p, Eterm* ret) needed = 2*erts_list_length(hi); } if (HeapWordsLeft(p) < needed) { - BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1)); + erts_garbage_collect(p, needed, ret, 1); hi = pd->data[(pd->splitPosition + pd->homeSize)]; lo = pd->data[pd->splitPosition]; } @@ -811,7 +811,7 @@ static void grow(Process *p) } } if (HeapWordsLeft(p) < needed) { - BUMP_REDS(p, erts_garbage_collect(p, needed, 0, 0)); + erts_garbage_collect(p, needed, 0, 0); } #ifdef DEBUG hp_limit = p->htop + needed; diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 968452a641..976180cc30 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -196,7 +196,7 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) ASSERT(!(p->flags & F_DISABLE_GC)); if ((p->stop - 2) < p->htop) { DPRINTF("calling gc to increase BEAM stack size"); - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + erts_garbage_collect(p, 2, reg, arity); ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index bc863a4f36..620cc6356b 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -95,7 +95,7 @@ ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsig /* ensure that at least 2 words are available on the BEAM stack */ if ((p->stop - 2) < p->htop) { - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + erts_garbage_collect(p, 2, reg, arity); ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index ceae3497c5..aa81008b12 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -80,7 +80,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1) void hipe_gc(Process *p, Eterm need) { hipe_set_narity(p, 1); - p->fcalls -= erts_garbage_collect(p, unsigned_val(need), NULL, 0); + erts_garbage_collect(p, unsigned_val(need), NULL, 0); hipe_set_narity(p, 0); } -- cgit v1.2.3 From 3e490ee1b43140ffcd8cb3fc3ccfe4339c08584e Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 11 Nov 2015 10:20:18 +0100 Subject: Improve yield strategy for list_to_binary()/binary_to_list() Avoid yield in the BIF when input is small. This either yielding before beginning to work in the BIF, or by allowing some more reductions before yielding. --- erts/emulator/beam/binary.c | 81 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 74 insertions(+), 7 deletions(-) diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index e670fbf31c..d3e481c7f9 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -34,6 +34,9 @@ #include "erl_binary.h" #include "erl_bits.h" +#define L2B_B2L_MIN_EXEC_REDS (CONTEXT_REDS/4) +#define L2B_B2L_RESCHED_REDS (CONTEXT_REDS/40) + static Export binary_to_list_continue_export; static Export list_to_binary_continue_export; @@ -415,10 +418,10 @@ binary_to_list_chunk(Process *c_p, } static ERTS_INLINE BIF_RETTYPE -binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs) +binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, + Uint size, Uint bitoffs, int reds_left, int one_chunk) { - int reds_left = ERTS_BIF_REDS_LEFT(c_p); - if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) { + if (one_chunk) { Eterm res; BIF_RETTYPE ret; int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1; @@ -472,11 +475,29 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) Uint size; Uint bitsize; Uint bitoffs; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { goto error; } + size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD1(bif_export[BIF_binary_to_list_1], + BIF_P, BIF_ARG_1); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); if (bitsize != 0) { goto error; @@ -486,7 +507,8 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) } else { Eterm* hp = HAlloc(BIF_P, 2 * size); byte* bytes = binary_bytes(real_bin)+offset; - return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs); + return binary_to_list(BIF_P, hp, NIL, bytes, size, + bitoffs, reds_left, one_chunk); } error: @@ -505,6 +527,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) Uint start; Uint stop; Eterm* hp; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { goto error; @@ -513,6 +537,21 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) goto error; } size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD3(bif_export[BIF_binary_to_list_3], + BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); if (start < 1 || start > size || stop < 1 || stop > size || stop < start ) { @@ -520,7 +559,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) } i = stop-start+1; hp = HAlloc(BIF_P, 2*i); - return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs); + return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, + bitoffs, reds_left, one_chunk); error: BIF_ERROR(BIF_P, BADARG); } @@ -537,11 +577,27 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) byte* bytes; Eterm previous = NIL; Eterm* hp; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD1(bif_export[BIF_bitstring_to_list_1], + BIF_P, BIF_ARG_1); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); bytes = binary_bytes(real_bin)+offset; if (bitsize == 0) { @@ -566,7 +622,8 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) hp += 2; } - return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs); + return binary_to_list(BIF_P, hp, previous, bytes, size, + bitoffs, reds_left, one_chunk); } @@ -795,8 +852,19 @@ static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1) BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif) { + int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p); BIF_RETTYPE ret; + if (orig_reds_left < L2B_B2L_MIN_EXEC_REDS) { + if (orig_reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_PREP_YIELD1(ret, bif, c_p, arg); + return ret; + } + /* Allow a bit more reductions... */ + orig_reds_left = L2B_B2L_MIN_EXEC_REDS; + } + if (is_nil(arg)) ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0)); else if (is_not_list(arg)) @@ -818,7 +886,6 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif) bif, erts_iolist_size_yielding, erts_iolist_to_buf_yielding); - int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p); /* * First try to do it all at once without having to use -- cgit v1.2.3 From fd1e6b2b2623395512ea0450c3b4e656cb354f42 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 13 Nov 2015 19:13:03 +0100 Subject: stdlib: Fix bug in binary:split for empty binary Bug introduced om master branch at b93e9b611056828a and reported in ERL-43. --- erts/emulator/beam/erl_bif_binary.c | 4 ++++ lib/stdlib/test/binary_module_SUITE.erl | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index b9640e211d..aec72bd61a 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1614,6 +1614,10 @@ static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindStat Eterm *hp; Eterm ret; + if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL) + && binary_size(subject) == 0) { + return NIL; + } hp = HAlloc(p, 2); ret = CONS(hp, subject, NIL); diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 70c946bdb9..933c3ce5a9 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -536,6 +536,12 @@ do_interesting(Module) -> ?line [<<3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, [<<1>>,<<2>>,<<4>>,<<5>>,<<7>>,<<8>>], [global,trim_all]), + [<<>>] = binary:split(<<>>, <<",">>, []), + [] = binary:split(<<>>, <<",">>, [trim]), + [] = binary:split(<<>>, <<",">>, [trim_all]), + [] = binary:split(<<>>, <<",">>, [global,trim]), + [] = binary:split(<<>>, <<",">>, [global,trim_all]), + ?line badarg = ?MASK_ERROR( Module:replace(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>],<<99>>, -- cgit v1.2.3 From 0a1150e85bd23b2dbf116454d4d0207b7c54974a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 10 Nov 2015 18:19:45 +0100 Subject: beam_validator: Remove obsolete DEBUG support No one has used the debug support in many years. Also, the debug support is not free. There are calls to lists:foreach/2 that will be executed even when debug support is turned off. --- lib/compiler/src/beam_validator.erl | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index cdace42a68..5944746edc 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -31,13 +31,6 @@ -import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -%%-define(DEBUG, 1). --ifdef(DEBUG). --define(DBG_FORMAT(F, D), (io:format((F), (D)))). --else. --define(DBG_FORMAT(F, D), ok). --endif. - %% To be called by the compiler. module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> @@ -168,27 +161,16 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> % in the module (those that start with bs_start_match2). }). --ifdef(DEBUG). -print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) -> - io:format(" #st{x=~p~n" - " y=~p~n" - " numy=~p,h=~p,ct=~w~n", - [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]). --endif. - validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]}, Name, Arity, Entry, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls1), - ?DBG_FORMAT(" ~p.~n", [_F]), validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1, Ft); validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}). validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [{label,_L}]) end, Ls2), Offset = 1 + length(Ls1) + 1 + length(Ls2), EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2), if @@ -258,7 +240,6 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> error({MFA,Error}) end; valfun([I|Is], MFA, Offset, Vst0) -> - ?DBG_FORMAT(" ~p.\n", [I]), valfun(Is, MFA, Offset+1, try Vst = val_dsetel(I, Vst0), @@ -276,7 +257,6 @@ valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) -> valfun_1(_I, #vst{current=none}=Vst) -> %% Ignore instructions after erlang:error/1,2, which %% the original R10B compiler thought would return. - ?DBG_FORMAT("Ignoring ~p\n", [_I]), Vst; valfun_1({badmatch,Src}, Vst) -> assert_term(Src, Vst), @@ -1626,8 +1606,4 @@ min(A, B) when is_integer(A), is_integer(B) -> B. gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). --ifdef(DEBUG). -error(Error) -> exit(Error). --else. error(Error) -> throw(Error). --endif. -- cgit v1.2.3 From 0a94d155e0197121fac63c8fb8ae0f7bc942dcc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 10 Nov 2015 18:29:32 +0100 Subject: beam_validator: Don't allow an 'undefined' entry label in a function Before 912fea0b beam_validator could validate disassembled files. That's probably why the entry label was allowed to be 'undefined'. --- lib/compiler/src/beam_validator.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 5944746edc..fd38fc0095 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -172,7 +172,7 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = (Entry =:= undefined) orelse lists:member(Entry, Ls2), + EntryOK = lists:member(Entry, Ls2), if EntryOK -> St = init_state(Arity), -- cgit v1.2.3 From 9bdd69a560765931cdd5dac50c8c8389263a2f6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 16 Nov 2015 13:59:23 +0100 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11456 -> 11524 bytes bootstrap/lib/compiler/ebin/beam_dict.beam | Bin 5248 -> 5292 bytes bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 30160 -> 29988 bytes bootstrap/lib/compiler/ebin/cerl_trees.beam | Bin 20360 -> 20360 bytes bootstrap/lib/compiler/ebin/sys_core_dsetel.beam | Bin 7308 -> 7184 bytes bootstrap/lib/compiler/ebin/sys_pre_expand.beam | Bin 14764 -> 13472 bytes bootstrap/lib/compiler/ebin/v3_kernel.beam | Bin 46896 -> 46856 bytes bootstrap/lib/kernel/ebin/inet_db.beam | Bin 26652 -> 27044 bytes bootstrap/lib/stdlib/ebin/beam_lib.beam | Bin 18532 -> 18520 bytes bootstrap/lib/stdlib/ebin/io.beam | Bin 6680 -> 6284 bytes 10 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index 3656edb0a0..0e05b1474a 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam index 1576d1bb8f..4e12260e65 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dict.beam and b/bootstrap/lib/compiler/ebin/beam_dict.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index 03582d94c3..73fa117755 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam index 76b19363e9..7233eee9de 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_trees.beam and b/bootstrap/lib/compiler/ebin/cerl_trees.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam index 10df50e1e5..0c2d05286a 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam and b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam index d82f802bd7..71d381b5b3 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam and b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam index d451819f19..b3f927ab3c 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel.beam and b/bootstrap/lib/compiler/ebin/v3_kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam index 8b6273610c..1b7450f0d3 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_db.beam and b/bootstrap/lib/kernel/ebin/inet_db.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index 67aeb1a587..9ad11640b5 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam index 1f2a113fdd..283c912800 100644 Binary files a/bootstrap/lib/stdlib/ebin/io.beam and b/bootstrap/lib/stdlib/ebin/io.beam differ -- cgit v1.2.3 From dad527f55b51d60e75a0d19aa0f4f42c1065777f Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Fri, 8 Jun 2012 22:21:02 +0300 Subject: An implementation of lightweight unbounded queues --- erts/emulator/beam/global.h | 84 ++++++++++++++++++++++++++++++++++++++++++++- erts/emulator/beam/utils.c | 25 ++++++++++++++ 2 files changed, 108 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 594c0ccf94..20f100b427 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -380,7 +380,7 @@ extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */ extern int stackdump_on_exit; /* - * Here is an implementation of a lightweiht stack. + * Here is an implementation of a lightweight stack. * * Use it like this: * @@ -845,6 +845,88 @@ do {\ } while(0) +/* + * An implementation of lightweight unbounded queues, + * using a circular dynamic array. + * It does not include support for change_allocator. + * + * Use it like this: + * + * DECLARE_EQUEUE(Queue) (At the start of a block) + * ... + * EQUEUE_PUT(Queue, Term) + * ... + * if (EQUEUE_ISEMPTY(Queue)) { + * Queue is empty + * } else { + * Term = EQUEUE_GET(Stack); + * Process popped Term here + * } + * ... + * DESTROY_EQUEUE(Queue) + */ + +typedef struct { + Eterm* start; + Eterm* front; + Eterm* back; + int possibly_empty; + Eterm* end; + ErtsAlcType_t alloc_type; +}ErtsEQueue; + +#define DEF_EQUEUE_SIZE (16) + +void erl_grow_equeue(ErtsEQueue*, Eterm* def_queue); +#define EQUE_CONCAT(a,b) a##b +#define EQUE_DEF_QUEUE(q) EQUE_CONCAT(q,_default_equeue) + +#define DECLARE_EQUEUE(q) \ + UWord EQUE_DEF_QUEUE(q)[DEF_EQUEUE_SIZE]; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DESTROY_EQUEUE(q) \ +do { \ + if (q.start != EQUE_DEF_QUEUE(q)) { \ + erts_free(q.alloc_type, q.start); \ + } \ +} while(0) + +#define EQUEUE_PUT_UNCHECKED(q, x) \ +do { \ + q.possibly_empty = 0; \ + *(q.back) = (x); \ + if (++(q.back) == q.end) { \ + q.back = q.start; \ + } \ +} while(0) + +#define EQUEUE_PUT(q, x) \ +do { \ + if (q.back == q.front && !q.possibly_empty) { \ + erl_grow_equeue(&q, EQUE_DEF_QUEUE(q)); \ + } \ + EQUEUE_PUT_UNCHECKED(q, x); \ +} while(0) + +#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty) + +#define EQUEUE_GET(q) ({ \ + q.possibly_empty = 1; \ + UWord x = *(q.front); \ + if (++(q.front) == q.end) { \ + q.front = q.start; \ + } \ + x; \ +}) + /* binary.c */ void erts_emasculate_writable_binary(ProcBin* pb); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index c3735683bb..184477c36b 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -258,6 +258,31 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes) s->psp = s->pstart + sp_offs; } +/* + * Helper function for the EQUEUE macros defined in global.h. + */ + +void +erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue) +{ + Uint old_size = (q->end - q->start); + Uint new_size = old_size * 2; + Uint first_part = (q->end - q->front); + Uint second_part = (q->back - q->start); + Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm)); + ASSERT(q->back == q->front); // of course the queue is full now! + if (first_part > 0) + sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm)); + if (second_part > 0) + sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm)); + if (q->start != default_equeue) + erts_free(q->alloc_type, q->start); + q->start = new_ptr; + q->end = q->start + new_size; + q->front = q->start; + q->back = q->start + old_size; +} + /* CTYPE macros */ #define LATIN1 -- cgit v1.2.3 From 9d0a5bf2c1cc564fd38268cbb5313cd8813ea138 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 16 Nov 2015 14:57:12 +0100 Subject: erts: Add garbage_collection_info to process_info/2 This info request returns greater details about the current gc state. This info is not included in the default process_info/1 as it would clutter the default printout with too much information. --- erts/doc/src/erlang.xml | 11 +++++++ erts/emulator/beam/atom.names | 1 + erts/emulator/beam/erl_bif_info.c | 30 ++++++++++++++++++- erts/emulator/beam/erl_gc.c | 51 ++++++++++++++++++++++++++++++++ erts/emulator/beam/erl_gc.h | 5 ++++ erts/emulator/beam/erl_trace.c | 57 ++++-------------------------------- erts/emulator/test/process_SUITE.erl | 47 ++++++++++++++++++++++++++++- erts/preloaded/src/erlang.erl | 2 ++ 8 files changed, 151 insertions(+), 53 deletions(-) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 2e82bb62a9..e4d3533c75 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4621,6 +4621,17 @@ os_prompt% The content of GCInfo can be changed without prior notice.

 + {garbage_collection_info, GCInfo} + +

GCInfo is a list containing miscellaneous + detailed information about garbage collection for this process. + The content of GCInfo can be changed without + prior notice. + See gc_start in + erlang:trace/3 for details about + what each item means. +

+ {group_leader, GroupLeader}

GroupLeader is group leader for the I/O of diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index ea04495574..4ad989cac1 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -256,6 +256,7 @@ atom functions atom function_clause atom garbage_collecting atom garbage_collection +atom garbage_collection_info atom gc_end atom gc_start atom Ge='>=' diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 1eb106a551..855ef8742a 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -589,7 +589,8 @@ static Eterm pi_args[] = { am_min_bin_vheap_size, am_current_location, am_current_stacktrace, - am_off_heap_message_queue + am_off_heap_message_queue, + am_garbage_collection_info }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -638,6 +639,7 @@ pi_arg2ix(Eterm arg) case am_current_location: return 29; case am_current_stacktrace: return 30; case am_off_heap_message_queue: return 31; + case am_garbage_collection_info: return 32; default: return -1; } } @@ -1395,6 +1397,32 @@ process_info_aux(Process *BIF_P, break; } + case am_garbage_collection_info: { + Uint sz = 0, actual_sz = 0; + + if (rp == BIF_P) { + sz += ERTS_PROCESS_GC_INFO_MAX_SIZE; + } else { + erts_process_gc_info(rp, &sz, NULL); + sz += 3; + } + + hp = HAlloc(BIF_P, sz); + res = erts_process_gc_info(rp, &actual_sz, &hp); + + /* We may have some extra space, fill with 0 tuples */ + if (actual_sz <= sz - 3) { + for (; actual_sz < sz - 3; hp++, actual_sz++) + hp[0] = make_arityval(0); + } else { + for (; actual_sz < sz; hp++, actual_sz++) + hp[0] = make_arityval(0); + hp = HAlloc(BIF_P, 3); + } + + break; + } + case am_group_leader: { int sz = NC_HEAP_SIZE(rp->group_leader); hp = HAlloc(BIF_P, 3 + sz); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6cb37752bc..3399b1a9f2 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -2741,6 +2741,57 @@ erts_gc_info_request(Process *c_p) return ref; } +Eterm +erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp) +{ + ERTS_DECL_AM(bin_vheap_size); + ERTS_DECL_AM(bin_vheap_block_size); + ERTS_DECL_AM(bin_old_vheap_size); + ERTS_DECL_AM(bin_old_vheap_block_size); + Eterm tags[] = { + /* If you increase the number of elements here, make sure to update + any call sites as they may have stack allocations that depend + on the number of elements here. */ + am_old_heap_block_size, + am_heap_block_size, + am_mbuf_size, + am_recent_size, + am_stack_size, + am_old_heap_size, + am_heap_size, + AM_bin_vheap_size, + AM_bin_vheap_block_size, + AM_bin_old_vheap_size, + AM_bin_old_vheap_block_size + }; + UWord values[] = { + OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, + HEAP_SIZE(p), + MBUF_SIZE(p), + HIGH_WATER(p) - HEAP_START(p), + STACK_START(p) - p->stop, + OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, + HEAP_TOP(p) - HEAP_START(p), + MSO(p).overhead, + BIN_VHEAP_SZ(p), + BIN_OLD_VHEAP(p), + BIN_OLD_VHEAP_SZ(p) + }; + + Eterm res = THE_NON_VALUE; + + ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags)); + ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS); + + res = erts_bld_atom_uword_2tup_list(hpp, + sizep, + sizeof(values)/sizeof(*values), + tags, + values); + + return res; +} + #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) static int diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index d603866cbf..2cedd9361f 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -132,6 +132,11 @@ typedef struct { Uint64 garbage_cols; } ErtsGCInfo; +#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/ +#define ERTS_PROCESS_GC_INFO_MAX_SIZE \ + (ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE)) +Eterm erts_process_gc_info(struct process*, Uint *, Eterm **); + void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); int erts_garbage_collect_nobump(struct process*, int, Eterm*, int); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index d02f1f7213..e47b1e4edc 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2144,11 +2144,6 @@ void save_calls(Process *p, Export *e) void trace_gc(Process *p, Eterm what) { - ERTS_DECL_AM(bin_vheap_size); - ERTS_DECL_AM(bin_vheap_block_size); - ERTS_DECL_AM(bin_old_vheap_size); - ERTS_DECL_AM(bin_old_vheap_block_size); - ErlHeapFragment *bp = NULL; ErlOffHeap *off_heap; ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized @@ -2159,55 +2154,22 @@ trace_gc(Process *p, Eterm what) Eterm msg = NIL; Uint size; - Eterm tags[] = { - am_old_heap_block_size, - am_heap_block_size, - am_mbuf_size, - am_recent_size, - am_stack_size, - am_old_heap_size, - am_heap_size, - AM_bin_vheap_size, - AM_bin_vheap_block_size, - AM_bin_old_vheap_size, - AM_bin_old_vheap_block_size - }; - - UWord values[] = { - OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, - HEAP_SIZE(p), - MBUF_SIZE(p), - HIGH_WATER(p) - HEAP_START(p), - STACK_START(p) - p->stop, - OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, - HEAP_TOP(p) - HEAP_START(p), - MSO(p).overhead, - BIN_VHEAP_SZ(p), - BIN_OLD_VHEAP(p), - BIN_OLD_VHEAP_SZ(p) - }; #define LOCAL_HEAP_SIZE \ - (sizeof(values)/sizeof(*values)) * \ - (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \ + (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \ 5/*4-tuple */ + TS_HEAP_WORDS DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); #ifdef DEBUG Eterm* limit; #endif - ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm)); - UseTmpHeap(LOCAL_HEAP_SIZE,p); if (is_internal_port(ERTS_TRACER_PROC(p))) { hp = local_heap; #ifdef DEBUG size = 0; - (void) erts_bld_atom_uword_2tup_list(NULL, - &size, - sizeof(values)/sizeof(*values), - tags, - values); + (void) erts_process_gc_info(p, &size, NULL); + size += 5/*4-tuple*/ + TS_SIZE(p); #endif } else { @@ -2218,11 +2180,8 @@ trace_gc(Process *p, Eterm what) ERTS_TRACE_FLAGS(p)); size = 0; - (void) erts_bld_atom_uword_2tup_list(NULL, - &size, - sizeof(values)/sizeof(*values), - tags, - values); + (void) erts_process_gc_info(p, &size, NULL); + size += 5/*4-tuple*/ + TS_SIZE(p); hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); @@ -2233,11 +2192,7 @@ trace_gc(Process *p, Eterm what) ASSERT(size <= LOCAL_HEAP_SIZE); #endif - msg = erts_bld_atom_uword_2tup_list(&hp, - NULL, - sizeof(values)/sizeof(*values), - tags, - values); + msg = erts_process_gc_info(p, NULL, &hp); msg = TUPLE4(hp, am_trace, p->common.id, what, msg); hp += 5; diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 97aa5e573e..bfd1e78bf0 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -41,6 +41,7 @@ process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, process_info_lock_reschedule3/1, + process_info_garbage_collection/1, bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, process_status_exiting/1, otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, @@ -75,7 +76,9 @@ all() -> process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, process_info_lock_reschedule2, - process_info_lock_reschedule3, process_status_exiting, + process_info_lock_reschedule3, + process_info_garbage_collection, + process_status_exiting, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, @@ -932,6 +935,48 @@ start_spawner() -> stop_spawner() -> ok. +%% Tests erlang:process_info(Pid, garbage_collection_info) +process_info_garbage_collection(_Config) -> + Parent = self(), + Pid = spawn_link( + fun() -> + receive go -> ok end, + (fun F(0) -> + Parent ! deep, + receive ok -> ok end, + []; + F(N) -> + timer:sleep(1), + [lists:seq(1,100) | F(N-1)] + end)(1000), + Parent ! shallow, + receive done -> ok end + end), + {garbage_collection_info, Before} = + erlang:process_info(Pid, garbage_collection_info), + Pid ! go, receive deep -> ok end, + {_, Deep} = erlang:process_info(Pid, garbage_collection_info), + Pid ! ok, receive shallow -> ok end, + {_, After} = erlang:process_info(Pid, garbage_collection_info), + Pid ! done, + + %% Do some general checks to see if everything seems to be roughly correct + ct:log("Before: ~p",[Before]), + ct:log("Deep: ~p",[Deep]), + ct:log("After: ~p",[After]), + + %% Check stack_size + true = proplists:get_value(stack_size, Before) < proplists:get_value(stack_size, Deep), + true = proplists:get_value(stack_size, After) < proplists:get_value(stack_size, Deep), + + %% Check used heap size + true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before) + < proplists:get_value(heap_size, Deep) + proplists:get_value(old_heap_size, Deep), + true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before) + < proplists:get_value(heap_size, After) + proplists:get_value(old_heap_size, After), + + ok. + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> erlang:garbage_collect(), diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 6a9ec9c915..cb607a7730 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2074,6 +2074,7 @@ process_flag(_Flag, _Value) -> dictionary | error_handler | garbage_collection | + garbage_collection_info | group_leader | heap_size | initial_call | @@ -2114,6 +2115,7 @@ process_flag(_Flag, _Value) -> {dictionary, Dictionary :: [{Key :: term(), Value :: term()}]} | {error_handler, Module :: module()} | {garbage_collection, GCInfo :: [{atom(),non_neg_integer()}]} | + {garbage_collection_info, GCInfo :: [{atom(),non_neg_integer()}]} | {group_leader, GroupLeader :: pid()} | {heap_size, Size :: non_neg_integer()} | {initial_call, mfa()} | -- cgit v1.2.3 From 7fc200b2f54d0c4b1dbc9edaee1fa6005a230d35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 16 Nov 2015 15:34:32 +0100 Subject: epp_SUITE: Add test of -extends() --- lib/stdlib/test/epp_SUITE.erl | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 199d2f193d..d2715216d3 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -27,7 +27,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, encoding/1]). + otp_11728/1, encoding/1, extends/1]). -export([epp_parse_erl_form/2]). @@ -70,7 +70,7 @@ all() -> 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, - encoding]. + encoding, extends]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -1476,6 +1476,20 @@ encoding(Config) when is_list(Config) -> epp_parse_file(ErlFile, [{default_encoding,utf8},extra]), ok. +extends(Config) -> + Cs = [{extends_c1, + <<"-extends(some.other.module).\n">>, + {errors,[{1,erl_parse,["syntax error before: ","'.'"]}],[]}}], + [] = compile(Config, Cs), + + Ts = [{extends_1, + <<"-extends(some_other_module).\n" + "t() -> {?BASE_MODULE,?BASE_MODULE_STRING}.\n">>, + {some_other_module,"some_other_module"}}], + + [] = run(Config, Ts), + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). -- cgit v1.2.3 From 7bfba5dfb5ec581880290b3fea8645504064dd5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Nov 2015 07:42:24 +0100 Subject: epp_SUITE: Extend smoke and cover test of format_error/1 30a4adb7 added smoke and cover test of format_error/1, but did not catch calls that went through check/2. --- lib/stdlib/test/epp_SUITE.erl | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index d2715216d3..abd2501ce7 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1518,15 +1518,17 @@ eval_tests(Config, Fun, Tests) -> check_test(Config, Test) -> Filename = "epp_test.erl", - ?line PrivDir = ?config(priv_dir, Config), - ?line File = filename:join(PrivDir, Filename), - ?line ok = file:write_file(File, Test), - ?line case epp:parse_file(File, [PrivDir], []) of - {ok,Forms} -> - [E || E={error,_} <- Forms]; - {error,Error} -> - Error - end. + PrivDir = ?config(priv_dir, Config), + File = filename:join(PrivDir, Filename), + ok = file:write_file(File, Test), + case epp:parse_file(File, [PrivDir], []) of + {ok,Forms} -> + Errors = [E || E={error,_} <- Forms], + call_format_error([E || {error,E} <- Errors]), + Errors; + {error,Error} -> + Error + end. compile_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], -- cgit v1.2.3 From a1a45183b4c88dd2f68a010cbe537d387d364aa1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Nov 2015 07:44:17 +0100 Subject: epp_SUITE: Improve coverage of epp --- lib/stdlib/test/epp_SUITE.erl | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index abd2501ce7..90642b2dca 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -621,6 +621,10 @@ otp_8130(Config) when is_list(Config) -> " 2 end,\n" " 7),\n" " {2,7} =\n" + " ?M1(begin 1 = fun _Name () -> 1 end(),\n" + " 2 end,\n" + " 7),\n" + " {2,7} =\n" " ?M1(begin 1 = fun t0/0(),\n" " 2 end,\n" " 7),\n" @@ -645,6 +649,9 @@ otp_8130(Config) when is_list(Config) -> " ?M1(begin yes = try 1 of 1 -> yes after foo end,\n" " 2 end,\n" " 7),\n" + " {[42],7} =\n" + " ?M1([42],\n" + " 7),\n" "ok.\n">>, ok}, @@ -728,11 +735,16 @@ otp_8130(Config) when is_list(Config) -> {errors,[{{2,2},epp,{include,lib,"$apa/foo.hrl"}}],[]}}, - {otp_8130_c9, + {otp_8130_c9a, <<"-define(S, ?S).\n" "t() -> ?S.\n">>, {errors,[{{2,9},epp,{circular,'S', none}}],[]}}, + {otp_8130_c9b, + <<"-define(S(), ?S()).\n" + "t() -> ?S().\n">>, + {errors,[{{2,9},epp,{circular,'S', 0}}],[]}}, + {otp_8130_c10, <<"\n-file.">>, {errors,[{{2,2},epp,{bad,file}}],[]}}, -- cgit v1.2.3 From c1a6beef36bd89b7e50efa8df1ef71f33272de12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 16 Nov 2015 15:37:27 +0100 Subject: epp: Remove vestigial support for packages Packages were removed in 34d865a7dfdb33 (R16), but the 'epp' module was forgotten. --- lib/stdlib/src/epp.erl | 41 ++++++++++++++++------------------------- 1 file changed, 16 insertions(+), 25 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index c8bba579cc..46c23fd0e0 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -797,35 +797,26 @@ scan_toks(Toks0, From, St) -> end. scan_module([{'-',_Lh},{atom,_Lm,module},{'(',_Ll}|Ts], Ms) -> - scan_module_1(Ts, [], Ms); + scan_module_1(Ts, Ms); scan_module([{'-',_Lh},{atom,_Lm,extends},{'(',_Ll}|Ts], Ms) -> - scan_extends(Ts, [], Ms); + scan_extends(Ts, Ms); scan_module(_Ts, Ms) -> Ms. -scan_module_1([{atom,_,_}=A,{',',L}|Ts], As, Ms) -> +scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) -> %% Parameterized modules. - scan_module_1([A,{')',L}|Ts], As, Ms); -scan_module_1([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_module_1([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, [".",A|As], Ms); -scan_module_1([{'.',_Lr}|Ts], As, Ms) -> - scan_module_1(Ts, As, Ms); -scan_module_1(_Ts, _As, Ms) -> Ms. - -scan_extends([{atom,Ln,A},{')',_Lr}|_Ts], As, Ms0) -> - Mod = lists:concat(lists:reverse([A|As])), - Ms = dict:store({atom,'BASE_MODULE'}, - {none,[{atom,Ln,list_to_atom(Mod)}]}, Ms0), - dict:store({atom,'BASE_MODULE_STRING'}, {none,[{string,Ln,Mod}]}, Ms); -scan_extends([{atom,_Ln,A},{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, [".",A|As], Ms); -scan_extends([{'.',_Lr}|Ts], As, Ms) -> - scan_extends(Ts, As, Ms); -scan_extends(_Ts, _As, Ms) -> Ms. + scan_module_1([A,{')',L}|Ts], Ms); +scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = dict:store({atom,'MODULE'}, {none,[ModAtom]}, Ms0), + dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,ModString}]}, Ms); +scan_module_1(_Ts, Ms) -> Ms. + +scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> + ModString = atom_to_list(A), + Ms = dict:store({atom,'BASE_MODULE'}, {none,[ModAtom]}, Ms0), + dict:store({atom,'BASE_MODULE_STRING'}, + {none,[{string,Ln,ModString}]}, Ms); +scan_extends(_Ts, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) -- cgit v1.2.3 From 57c53b4918bafc72097315d980fea2d0f296b1bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 16 Nov 2015 14:38:15 +0100 Subject: epp: Refactor scan_define() Refactor scan_define() in order to share more between macros without any arguments and macros with arguments. --- lib/stdlib/src/epp.erl | 79 ++++++++++++++++++------------------------- lib/stdlib/test/epp_SUITE.erl | 4 +++ 2 files changed, 37 insertions(+), 46 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 46c23fd0e0..d9a579ebc6 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -820,59 +820,26 @@ scan_extends(_Ts, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St) when Type =:= atom; Type =:= var -> + scan_define_1(Toks, Mac, Def, From, St); +scan_define(_Toks, Def, From, St) -> + epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), + wait_req_scan(St). + +scan_define_1([{',',_}=Comma|Toks], Mac,_Def, From, St) -> case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,Expansion}}) - end; + scan_define_2(none, {none,Expansion}, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St) end; -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) - when Type =:= atom; Type =:= var -> +scan_define_1([{'(',_Lc}|Toks], Mac, Def, From, St) -> case catch macro_pars(Toks, []) of - {ok, {As,Me}} -> + {ok,{As,_}=MacroDef} -> Len = length(As), - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(Len, Defs) of - true -> - epp_reply(From,{error,{loc(Mac),epp,{redefine,M}}}), - wait_req_scan(St); - false -> - scan_define_cont(From, St, {atom, M}, - {Len, {As, Me}}) - end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - %% (There are currently no predefined F(...) macros.) - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) - end; + scan_define_2(Len, MacroDef, Mac, From, St); {error,ErrL,What} -> epp_reply(From, {error,{ErrL,epp,What}}), wait_req_scan(St); @@ -880,10 +847,30 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) end; -scan_define(_Toks, Def, From, St) -> +scan_define_1(_Toks, _Mac, Def, From, St) -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St). +scan_define_2(Arity, Def, {_,_,M}=Mac, From, St) -> + Key = {atom,M}, + case dict:find(Key, St#epp.macs) of + {ok,Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(Arity, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, Key, Arity, Def) + end; + {ok,_PreDef} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), + wait_req_scan(St); + error -> + scan_define_cont(From, St, Key, Arity, Def) + end. + %%% Detection of circular macro expansions (which would either keep %%% the compiler looping forever, or run out of memory): %%% When a macro is defined, we store the names of other macros it @@ -893,7 +880,7 @@ scan_define(_Toks, Def, From, St) -> %%% the information from St#epp.uses is traversed, and if a circularity %%% is detected, an error message is thrown. -scan_define_cont(F, St, M, {Arity, Def}) -> +scan_define_cont(F, St, M, Arity, Def) -> Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs), try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of U -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 90642b2dca..4c007e76ad 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -811,6 +811,10 @@ otp_8130(Config) when is_list(Config) -> <<"\n-include(\"no such file.erl\").\n">>, {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}}, + {otp_8130_c25, + <<"\n-define(A.\n">>, + {errors,[{{2,2},epp,{bad,define}}],[]}}, + {otp_8130_7, <<"-record(b, {b}).\n" "-define(A, {{a,#b.b.\n" -- cgit v1.2.3 From da6d480a65cce9392d4da80d142600f941d52881 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Nov 2015 09:16:24 +0100 Subject: epp: Refactor user_predef/2 to share more code --- lib/stdlib/src/epp.erl | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d9a579ebc6..87cffc9e16 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -593,16 +593,7 @@ user_predef([{M,Val}|Pdm], Ms) when is_atom(M) -> user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms)) end; user_predef([M|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros - {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros - {error,{redefine_predef,M}}; - error -> - A = line1(), - user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms)) - end; + user_predef([{M,true}|Pdm], Ms); user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. -- cgit v1.2.3 From b6bbd00d6cdcc8418ee2385d719b0f12b7586198 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Nov 2015 09:47:20 +0100 Subject: epp: Eliminate the Type argument from expand_macros/5 The Type argument is always 'atom', so there is no need for the argument. --- lib/stdlib/src/epp.erl | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 87cffc9e16..1d9762cfc7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1160,25 +1160,24 @@ macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). %% Expand the macros in a list of tokens, making sure that an expansion %% gets the same location as the macro call. -expand_macros(Type, MacT, M, Toks, Ms0) -> - %% (Type will always be 'atom') +expand_macros(MacT, M, Toks, Ms0) -> {Ms, U} = Ms0, Lm = loc(MacT), Tinfo = element(2, MacT), - case expand_macro1(Type, Lm, M, Toks, Ms) of + case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> - check_uses([{{Type,M}, none}], [], U, Lm), + check_uses([{{atom,M}, none}], [], U, Lm), Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0), expand_macros(Toks1++Toks, Ms0); {ok,{As,Exp}} -> - check_uses([{{Type,M}, length(As)}], [], U, Lm), + check_uses([{{atom,M}, length(As)}], [], U, Lm), {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()), expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) end. -expand_macro1(Type, Lm, M, Toks, Ms) -> +expand_macro1(Lm, M, Toks, Ms) -> Arity = count_args(Toks, Lm, M), - case dict:find({Type,M}, Ms) of + case dict:find({atom,M}, Ms) of error -> %% macro not found throw({error,Lm,{undefined,M,Arity}}); {ok, undefined} -> %% Predefined macro without definition @@ -1220,13 +1219,13 @@ get_macro_uses({M,Arity}, U) -> %% Macro expansion %% Note: io:scan_erl_form() does not return comments or white spaces. expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); + expand_macros(MacT, M, Toks, Ms); %% Special macros expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> Line = erl_scan:line(Tok), [{integer,Lm,Line}|expand_macros(Toks, Ms)]; expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(atom, MacT, M, Toks, Ms); + expand_macros(MacT, M, Toks, Ms); %% Illegal macros expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> T = case erl_scan:text(Token) of -- cgit v1.2.3 From cfc8f82f1f39da114574a28c57f5d4a29ebbafaf Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 16 Nov 2015 19:40:24 +0100 Subject: crypto: Refactor nif code to use EVP interface MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Using the generic EVP_* API makes it possible to unify algorithm-specific nif functions to a single generic function. Effectively the same change that took place on the Erlang API in R16B01 is now applied to the C code. The old implementation using the low-level API is kept for compiling against old OpenSSL, as parts of the EVP API were introduced in OpenSSL 1.0.0. There are various minor improvements as well: - supported algorithms are now provided by the nif code (not a mix of the C and Erlang code) - remove unnecessary variables and macro definitions Most of the changes in this commit comes from Dániel Szoboszlay https://github.com/dszoboszlay/otp/commit/07f7056f955b324df4ace which is part of his 'fips' branch. Now also rebased on master branch. --- lib/crypto/c_src/crypto.c | 2532 +++++++++++++----------------------- lib/crypto/c_src/crypto_callback.c | 4 +- lib/crypto/src/crypto.erl | 849 ++++-------- 3 files changed, 1123 insertions(+), 2262 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index e9cac30c9c..595ee65415 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -193,57 +193,20 @@ static void unload(ErlNifEnv* env, void* priv_data); /* The NIFs: */ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -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[]); -static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -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[]); -static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -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[]); -static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -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[]); -static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -252,13 +215,10 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -270,10 +230,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -291,32 +247,7 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER /* helpers */ static void init_algorithms_types(ErlNifEnv*); static void init_digest_types(ErlNifEnv* env); -static void hmac_md5(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -static void hmac_sha1(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#ifdef HAVE_SHA224 -static void hmac_sha224(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA256 -static void hmac_sha256(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA384 -static void hmac_sha384(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif -#ifdef HAVE_SHA512 -static void hmac_sha512(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf); -#endif +static void init_cipher_types(ErlNifEnv* env); #ifdef HAVE_EC static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg); static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, @@ -328,60 +259,25 @@ static int library_refc = 0; /* number of users of this dynamic library */ static ErlNifFunc nif_funcs[] = { {"info_lib", 0, info_lib}, {"algorithms", 0, algorithms}, - {"md5", 1, md5}, - {"md5_init", 0, md5_init}, - {"md5_update", 2, md5_update}, - {"md5_final", 1, md5_final}, - {"ripemd160", 1, ripemd160}, - {"ripemd160_init", 0, ripemd160_init}, - {"ripemd160_update", 2, ripemd160_update}, - {"ripemd160_final", 1, ripemd160_final}, - {"sha", 1, sha}, - {"sha_init", 0, sha_init}, - {"sha_update", 2, sha_update}, - {"sha_final", 1, sha_final}, - {"sha224_nif", 1, sha224_nif}, - {"sha224_init_nif", 0, sha224_init_nif}, - {"sha224_update_nif", 2, sha224_update_nif}, - {"sha224_final_nif", 1, sha224_final_nif}, - {"sha256_nif", 1, sha256_nif}, - {"sha256_init_nif", 0, sha256_init_nif}, - {"sha256_update_nif", 2, sha256_update_nif}, - {"sha256_final_nif", 1, sha256_final_nif}, - {"sha384_nif", 1, sha384_nif}, - {"sha384_init_nif", 0, sha384_init_nif}, - {"sha384_update_nif", 2, sha384_update_nif}, - {"sha384_final_nif", 1, sha384_final_nif}, - {"sha512_nif", 1, sha512_nif}, - {"sha512_init_nif", 0, sha512_init_nif}, - {"sha512_update_nif", 2, sha512_update_nif}, - {"sha512_final_nif", 1, sha512_final_nif}, - {"md4", 1, md4}, - {"md4_init", 0, md4_init}, - {"md4_update", 2, md4_update}, - {"md4_final", 1, md4_final}, - {"md5_mac_n", 3, md5_mac_n}, - {"sha_mac_n", 3, sha_mac_n}, - {"sha224_mac_nif", 3, sha224_mac_nif}, - {"sha256_mac_nif", 3, sha256_mac_nif}, - {"sha384_mac_nif", 3, sha384_mac_nif}, - {"sha512_mac_nif", 3, sha512_mac_nif}, - {"hmac_init", 2, hmac_init}, - {"hmac_update", 2, hmac_update}, - {"hmac_final", 1, hmac_final}, - {"hmac_final_n", 2, hmac_final}, - {"des_cbc_crypt", 4, des_cbc_crypt}, - {"des_cfb_crypt", 4, des_cfb_crypt}, - {"des_ecb_crypt", 3, des_ecb_crypt}, - {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, - {"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif}, - {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt}, - {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, + {"hash_nif", 2, hash_nif}, + {"hash_init_nif", 1, hash_init_nif}, + {"hash_update_nif", 2, hash_update_nif}, + {"hash_final_nif", 1, hash_final_nif}, + {"hmac_nif", 3, hmac_nif}, + {"hmac_nif", 4, hmac_nif}, + {"hmac_init_nif", 2, hmac_init_nif}, + {"hmac_update_nif", 2, hmac_update_nif}, + {"hmac_final_nif", 1, hmac_final_nif}, + {"hmac_final_nif", 2, hmac_final_nif}, + {"block_crypt_nif", 5, block_crypt_nif}, + {"block_crypt_nif", 4, block_crypt_nif}, + {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, + {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, + {"aes_ctr_stream_init", 2, aes_ctr_stream_init}, {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt}, {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, - {"aes_ecb_crypt", 3, aes_ecb_crypt}, {"rand_bytes", 1, rand_bytes_1}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, {"rand_bytes", 3, rand_bytes_3}, @@ -390,13 +286,10 @@ static ErlNifFunc nif_funcs[] = { {"mod_exp_nif", 4, mod_exp_nif}, {"dss_verify_nif", 4, dss_verify_nif}, {"rsa_verify_nif", 4, rsa_verify_nif}, - {"aes_cbc_crypt", 4, aes_cbc_crypt}, - {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, {"do_exor", 2, do_exor}, {"rc4_encrypt", 2, rc4_encrypt}, {"rc4_set_key", 1, rc4_set_key}, {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, - {"rc2_cbc_crypt", 4, rc2_cbc_crypt}, {"rsa_sign_nif", 3, rsa_sign_nif}, {"dss_sign_nif", 3, dss_sign_nif}, {"rsa_public_crypt", 4, rsa_public_crypt}, @@ -408,10 +301,6 @@ static ErlNifFunc nif_funcs[] = { {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, {"srp_host_secret_nif", 5, srp_host_secret_nif}, - {"bf_cfb64_crypt", 4, bf_cfb64_crypt}, - {"bf_cbc_crypt", 4, bf_cbc_crypt}, - {"bf_ecb_crypt", 3, bf_ecb_crypt}, - {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt}, {"ec_key_generate", 2, ec_key_generate}, {"ecdsa_sign_nif", 4, ecdsa_sign_nif}, @@ -432,37 +321,14 @@ static ErlNifFunc nif_funcs[] = { ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) -#define MD5_CTX_LEN (sizeof(MD5_CTX)) -#define MD5_LEN 16 -#define MD5_LEN_96 12 -#define MD4_CTX_LEN (sizeof(MD4_CTX)) -#define MD4_LEN 16 +#define MD5_CTX_LEN (sizeof(MD5_CTX)) +#define MD4_CTX_LEN (sizeof(MD4_CTX)) #define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX)) -#define RIPEMD160_LEN 20 -#define SHA_CTX_LEN (sizeof(SHA_CTX)) -#define SHA_LEN 20 -#define SHA_LEN_96 12 -#define SHA224_LEN (224/8) -#define SHA256_LEN (256/8) -#define SHA384_LEN (384/8) -#define SHA512_LEN (512/8) -#define HMAC_INT_LEN 64 -#define HMAC_INT2_LEN 128 - -#define HMAC_IPAD 0x36 -#define HMAC_OPAD 0x5c static ERL_NIF_TERM atom_true; static ERL_NIF_TERM atom_false; static ERL_NIF_TERM atom_sha; -static ERL_NIF_TERM atom_sha224; -static ERL_NIF_TERM atom_sha256; -static ERL_NIF_TERM atom_sha384; -static ERL_NIF_TERM atom_sha512; -static ERL_NIF_TERM atom_md5; -static ERL_NIF_TERM atom_md4; -static ERL_NIF_TERM atom_ripemd160; static ERL_NIF_TERM atom_error; static ERL_NIF_TERM atom_rsa_pkcs1_padding; static ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; @@ -489,6 +355,9 @@ static ERL_NIF_TERM atom_ppbasis; static ERL_NIF_TERM atom_onbasis; #endif +static ERL_NIF_TERM atom_aes_cfb8; +static ERL_NIF_TERM atom_aes_cfb128; + static ErlNifResourceType* hmac_context_rtype; struct hmac_context { @@ -498,6 +367,87 @@ struct hmac_context }; static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); +struct digest_type_t { + const char* type_str; + const EVP_MD* (*md_func)(void); /* NULL if notsup */ + ERL_NIF_TERM type_atom; +}; + +struct digest_type_t digest_types[] = +{ + {"md4", &EVP_md4}, + {"md5", &EVP_md5}, + {"ripemd160", &EVP_ripemd160}, + {"sha", &EVP_sha1}, + {"sha224", +#ifdef HAVE_SHA224 + &EVP_sha224 +#else + NULL +#endif + }, + {"sha256", +#ifdef HAVE_SHA256 + &EVP_sha256 +#else + NULL +#endif + }, + {"sha384", +#ifdef HAVE_SHA384 + &EVP_sha384 +#else + NULL +#endif + }, + {"sha512", +#ifdef HAVE_SHA512 + &EVP_sha512 +#else + NULL +#endif + }, + {NULL} +}; + +static struct digest_type_t* get_digest_type(ERL_NIF_TERM type); + +struct cipher_type_t { + const char* type_str; + const EVP_CIPHER* (*cipher_func)(void); /* NULL if notsup */ + const size_t key_len; /* != 0 to also match on key_len */ + ERL_NIF_TERM type_atom; +}; + +struct cipher_type_t cipher_types[] = +{ + {"rc2_cbc", &EVP_rc2_cbc}, + {"des_cbc", &EVP_des_cbc}, + {"des_cfb", &EVP_des_cfb8}, + {"des_ecb", &EVP_des_ecb}, + {"des_ede3_cbc", &EVP_des_ede3_cbc}, + {"des_ede3_cbf", +#ifdef HAVE_DES_ede3_cfb_encrypt + &EVP_des_ede3_cfb8 +#else + NULL +#endif + }, + {"blowfish_cbc", &EVP_bf_cbc}, + {"blowfish_cfb64", &EVP_bf_cfb64}, + {"blowfish_ofb64", &EVP_bf_ofb}, + {"blowfish_ecb", &EVP_bf_ecb}, + {"aes_cbc128", &EVP_aes_128_cbc}, + {"aes_cbc256", &EVP_aes_256_cbc}, + {"aes_cfb8", &EVP_aes_128_cfb8}, + {"aes_cfb128", &EVP_aes_128_cfb128}, + {"aes_ecb", &EVP_aes_128_ecb, 16}, + {"aes_ecb", &EVP_aes_256_ecb, 32}, + {NULL} +}; + +static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -507,6 +457,19 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); #define PRINTF_ERR1(FMT,A1) #define PRINTF_ERR2(FMT,A1,A2) +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +/* Define resource types for OpenSSL context structures. */ +static ErlNifResourceType* evp_md_ctx_rtype; +static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) { + EVP_MD_CTX_cleanup(ctx); +} + +static ErlNifResourceType* evp_cipher_ctx_rtype; +static void evp_cipher_ctx_dtor(ErlNifEnv* env, EVP_CIPHER_CTX* ctx) { + EVP_CIPHER_CTX_cleanup(ctx); +} +#endif + static int verify_lib_version(void) { const unsigned long libv = SSLeay(); @@ -522,7 +485,6 @@ static int verify_lib_version(void) return 1; } - #ifdef HAVE_DYNAMIC_CRYPTO_LIB # if defined(DEBUG) @@ -558,7 +520,9 @@ static void error_handler(void* null, const char* errstr) static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) { +#ifdef OPENSSL_THREADS ErlNifSysInfo sys_info; +#endif get_crypto_callbacks_t* funcp; struct crypto_callbacks* ccb; int nlocks = 0; @@ -590,7 +554,24 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); return 0; } - +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + evp_md_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_MD_CTX", + (ErlNifResourceDtor*) evp_md_ctx_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!evp_md_ctx_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'"); + return 0; + } + evp_cipher_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_CIPHER_CTX", + (ErlNifResourceDtor*) evp_cipher_ctx_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!evp_cipher_ctx_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'"); + return 0; + } +#endif if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. @@ -598,16 +579,9 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) return 1; } - atom_true = enif_make_atom(env,"true"); + atom_true = enif_make_atom(env,"true"); atom_false = enif_make_atom(env,"false"); atom_sha = enif_make_atom(env,"sha"); - atom_sha224 = enif_make_atom(env,"sha224"); - atom_sha256 = enif_make_atom(env,"sha256"); - atom_sha384 = enif_make_atom(env,"sha384"); - atom_sha512 = enif_make_atom(env,"sha512"); - atom_md4 = enif_make_atom(env,"md4"); - atom_md5 = enif_make_atom(env,"md5"); - atom_ripemd160 = enif_make_atom(env,"ripemd160"); atom_error = enif_make_atom(env,"error"); atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding"); atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding"); @@ -632,8 +606,11 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_ppbasis = enif_make_atom(env,"ppbasis"); atom_onbasis = enif_make_atom(env,"onbasis"); #endif + atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); + atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); init_digest_types(env); + init_cipher_types(env); init_algorithms_types(env); #ifdef HAVE_DYNAMIC_CRYPTO_LIB @@ -718,46 +695,66 @@ static void unload(ErlNifEnv* env, void* priv_data) static int algo_hash_cnt; static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt; -static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */ +static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */ static int algo_cipher_cnt; -static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[20]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { algo_hash_cnt = 0; - algo_hash[algo_hash_cnt++] = atom_md4; - algo_hash[algo_hash_cnt++] = atom_md5; algo_hash[algo_hash_cnt++] = atom_sha; - algo_hash[algo_hash_cnt++] = atom_ripemd160; #ifdef HAVE_SHA224 - algo_hash[algo_hash_cnt++] = atom_sha224; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha224"); #endif #ifdef HAVE_SHA256 - algo_hash[algo_hash_cnt++] = atom_sha256; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha256"); #endif #ifdef HAVE_SHA384 - algo_hash[algo_hash_cnt++] = atom_sha384; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha384"); #endif #ifdef HAVE_SHA512 - algo_hash[algo_hash_cnt++] = atom_sha512; + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha512"); #endif + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4"); + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md5"); + algo_hash[algo_hash_cnt++] = enif_make_atom(env, "ripemd160"); algo_pubkey_cnt = 0; + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dss"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dh"); #if defined(HAVE_EC) #if !defined(OPENSSL_NO_EC2M) - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ec_gf2m"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ec_gf2m"); #endif - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdsa"); - algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env,"ecdh"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdsa"); + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ecdh"); #endif + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp"); algo_cipher_cnt = 0; + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des_ede3"); #ifdef HAVE_DES_ede3_cfb_encrypt algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbf"); #endif + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc256"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ctr"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ecb"); #ifdef HAVE_AES_IGE algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256"); #endif + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cfb"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cfb64"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ofb64"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ecb"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc2_cbc"); + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4"); #if defined(HAVE_GCM) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); #endif @@ -772,10 +769,13 @@ static void init_algorithms_types(ErlNifEnv* env) static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + int hash_cnt = algo_hash_cnt; + int pubkey_cnt = algo_pubkey_cnt; + int cipher_cnt = algo_cipher_cnt; return enif_make_tuple3(env, - enif_make_list_from_array(env, algo_hash, algo_hash_cnt), - enif_make_list_from_array(env, algo_pubkey, algo_pubkey_cnt), - enif_make_list_from_array(env, algo_cipher, algo_cipher_cnt)); + enif_make_list_from_array(env, algo_hash, hash_cnt), + enif_make_list_from_array(env, algo_pubkey, pubkey_cnt), + enif_make_list_from_array(env, algo_cipher, cipher_cnt)); } static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -805,564 +805,383 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ver_term)); } -static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - MD5((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,MD5_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - MD5_Init((MD5_CTX *) enif_make_new_binary(env, MD5_CTX_LEN, &ret)); - return ret; -} -static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - MD5_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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)) { +static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data) */ + struct digest_type_t *digp = NULL; + const EVP_MD *md; + ErlNifBinary data; + ERL_NIF_TERM ret; + unsigned ret_size; + + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); } - new_ctx = (MD5_CTX*) enif_make_new_binary(env,MD5_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, MD5_CTX_LEN); - MD5_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -} -static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - MD5_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, MD5_CTX_LEN); /* writable */ - MD5_Final(enif_make_new_binary(env, MD5_LEN, &ret), &ctx_clone); - return ret; -} -static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + md = digp->md_func(); + ret_size = (unsigned)EVP_MD_size(md); + ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); + if (!EVP_Digest(data.data, data.size, + enif_make_new_binary(env, ret_size, &ret), &ret_size, + md, NULL)) { + return atom_notsup; } - RIPEMD160((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,RIPEMD160_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - RIPEMD160_Init((RIPEMD160_CTX *) enif_make_new_binary(env, RIPEMD160_CTX_LEN, &ret)); + ASSERT(ret_size == (unsigned)EVP_MD_size(md)); + + CONSUME_REDS(env, data); return ret; } -static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - RIPEMD160_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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)) { + +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type) */ + struct digest_type_t *digp = NULL; + EVP_MD_CTX *ctx; + ERL_NIF_TERM ret; + + digp = get_digest_type(argv[0]); + if (!digp) { return enif_make_badarg(env); } - new_ctx = (RIPEMD160_CTX*) enif_make_new_binary(env,RIPEMD160_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, RIPEMD160_CTX_LEN); - RIPEMD160_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env, data_bin); - return ret; -} -static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - RIPEMD160_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, RIPEMD160_CTX_LEN); /* writable */ - RIPEMD160_Final(enif_make_new_binary(env, RIPEMD160_LEN, &ret), &ctx_clone); - return ret; -} - -static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); + if (!EVP_DigestInit(ctx, digp->md_func())) { + enif_release_resource(ctx); + return atom_notsup; } - SHA1((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - SHA1_Init((SHA_CTX *) enif_make_new_binary(env, SHA_CTX_LEN, &ret)); + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); return ret; } -static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - SHA_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; + EVP_MD_CTX *ctx, *new_ctx; + ErlNifBinary data; ERL_NIF_TERM ret; - 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); + + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx) || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); } - new_ctx = (SHA_CTX*) enif_make_new_binary(env,SHA_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, SHA_CTX_LEN); - SHA1_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); + + new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); + if (!EVP_MD_CTX_copy(new_ctx, ctx) || + !EVP_DigestUpdate(new_ctx, data.data, data.size)) { + enif_release_resource(new_ctx); + return atom_notsup; + } + + ret = enif_make_resource(env, new_ctx); + enif_release_resource(new_ctx); + CONSUME_REDS(env, data); return ret; } -static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) */ - ErlNifBinary ctx_bin; - SHA_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN) { - return enif_make_badarg(env); + EVP_MD_CTX *ctx, new_ctx; + ERL_NIF_TERM ret; + unsigned ret_size; + + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) { + return enif_make_badarg(env); } - memcpy(&ctx_clone, ctx_bin.data, SHA_CTX_LEN); /* writable */ - SHA1_Final(enif_make_new_binary(env, SHA_LEN, &ret), &ctx_clone); - return ret; -} -static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA224 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ret_size = (unsigned)EVP_MD_CTX_size(ctx); + ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); + + if (!EVP_MD_CTX_copy(&new_ctx, ctx) || + !EVP_DigestFinal(&new_ctx, + enif_make_new_binary(env, ret_size, &ret), + &ret_size)) { + return atom_notsup; } - SHA224((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA224_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha224_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA224 - ERL_NIF_TERM ret; - SHA224_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); + ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx)); + return ret; -#else - return atom_notsup; -#endif } -static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA224 - SHA256_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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)) { + +#else /* if OPENSSL_VERSION_NUMBER < 1.0 */ + +static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type) */ + typedef int (*init_fun)(unsigned char*); + struct digest_type_t *digp = NULL; + ERL_NIF_TERM ctx; + size_t ctx_size = 0; + init_fun ctx_init = 0; + + digp = get_digest_type(argv[0]); + if (!digp) { return enif_make_badarg(env); } - new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); - SHA224_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha224_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ -#ifdef HAVE_SHA224 - ErlNifBinary ctx_bin; - SHA256_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { - return enif_make_badarg(env); + if (!digp->md_func) { + return atom_notsup; } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */ - SHA224_Final(enif_make_new_binary(env, SHA224_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA256 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - SHA256((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA256_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + switch (EVP_MD_type(digp->md_func())) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_init = (init_fun)(&MD4_Init); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_init = (init_fun)(&MD5_Init); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_init = (init_fun)(&RIPEMD160_Init); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_init = (init_fun)(&SHA1_Init); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_init = (init_fun)(&SHA224_Init); + break; #endif -} -static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ #ifdef HAVE_SHA256 - ERL_NIF_TERM ret; - SHA256_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); - return ret; -#else - return atom_notsup; + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_init = (init_fun)(&SHA256_Init); + break; #endif -} -static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA256 - SHA256_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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); +#ifdef HAVE_SHA384 + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_init = (init_fun)(&SHA384_Init); + break; +#endif +#ifdef HAVE_SHA512 + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_init = (init_fun)(&SHA512_Init); + break; +#endif + default: + return atom_notsup; + } + ASSERT(ctx_size); + ASSERT(ctx_init); + + ctx_init(enif_make_new_binary(env, ctx_size, &ctx)); + return enif_make_tuple2(env, argv[0], ctx); +} +static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* ({Type, Context}, Data) */ + typedef int (*update_fun)(unsigned char*, const unsigned char*, size_t); + ERL_NIF_TERM new_ctx; + ErlNifBinary ctx, data; + const ERL_NIF_TERM *tuple; + int arity; + struct digest_type_t *digp = NULL; + unsigned char *ctx_buff; + size_t ctx_size = 0; + update_fun ctx_update = 0; + + if (!enif_get_tuple(env, argv[0], &arity, &tuple) || + arity != 2 || + !(digp = get_digest_type(tuple[0])) || + !enif_inspect_binary(env, tuple[1], &ctx) || + !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); } - new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); - SHA256_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; + if (!digp->md_func) { + return atom_notsup; + } + + switch (EVP_MD_type(digp->md_func())) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_update = (update_fun)(&MD4_Update); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_update = (update_fun)(&MD5_Update); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_update = (update_fun)(&RIPEMD160_Update); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_update = (update_fun)(&SHA1_Update); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_update = (update_fun)(&SHA224_Update); + break; #endif -} -static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ #ifdef HAVE_SHA256 - ErlNifBinary ctx_bin; - SHA256_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */ - SHA256_Final(enif_make_new_binary(env, SHA256_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_update = (update_fun)(&SHA256_Update); + break; #endif -} - -static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ #ifdef HAVE_SHA384 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); - } - SHA384((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA384_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_update = (update_fun)(&SHA384_Update); + break; #endif -} -static ERL_NIF_TERM sha384_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA384 - ERL_NIF_TERM ret; - SHA384_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA512 + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_update = (update_fun)(&SHA512_Update); + break; #endif -} -static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA384 - SHA512_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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); + default: + return atom_notsup; } - new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); - SHA384_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha384_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ -#ifdef HAVE_SHA384 - ErlNifBinary ctx_bin; - SHA512_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { - return enif_make_badarg(env); + ASSERT(ctx_size); + ASSERT(ctx_update); + + if (ctx.size != ctx_size) { + return enif_make_badarg(env); } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */ - SHA384_Final(enif_make_new_binary(env, SHA384_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; -#endif -} -static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ -#ifdef HAVE_SHA512 - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx); + memcpy(ctx_buff, ctx.data, ctx_size); + ctx_update(ctx_buff, data.data, data.size); + + CONSUME_REDS(env, data); + return enif_make_tuple2(env, tuple[0], new_ctx); +} +static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* ({Type, Context}) */ + typedef int (*final_fun)(unsigned char*, void*); + ERL_NIF_TERM ret; + ErlNifBinary ctx; + const ERL_NIF_TERM *tuple; + int arity; + struct digest_type_t *digp = NULL; + const EVP_MD *md; + void *new_ctx; + size_t ctx_size = 0; + final_fun ctx_final = 0; + + if (!enif_get_tuple(env, argv[0], &arity, &tuple) || + arity != 2 || + !(digp = get_digest_type(tuple[0])) || + !enif_inspect_binary(env, tuple[1], &ctx)) { + return enif_make_badarg(env); } - SHA512((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,SHA512_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -#else - return atom_notsup; + if (!digp->md_func) { + return atom_notsup; + } + + md = digp->md_func(); + + switch (EVP_MD_type(md)) + { + case NID_md4: + ctx_size = MD4_CTX_LEN; + ctx_final = (final_fun)(&MD4_Final); + break; + case NID_md5: + ctx_size = MD5_CTX_LEN; + ctx_final = (final_fun)(&MD5_Final); + break; + case NID_ripemd160: + ctx_size = RIPEMD160_CTX_LEN; + ctx_final = (final_fun)(&RIPEMD160_Final); + break; + case NID_sha1: + ctx_size = sizeof(SHA_CTX); + ctx_final = (final_fun)(&SHA1_Final); + break; +#ifdef HAVE_SHA224 + case NID_sha224: + ctx_size = sizeof(SHA256_CTX); + ctx_final = (final_fun)(&SHA224_Final); + break; #endif -} -static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ -#ifdef HAVE_SHA512 - ERL_NIF_TERM ret; - SHA512_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA256 + case NID_sha256: + ctx_size = sizeof(SHA256_CTX); + ctx_final = (final_fun)(&SHA256_Final); + break; #endif -} -static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ -#ifdef HAVE_SHA512 - SHA512_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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); - } - new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); - memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); - SHA512_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; +#ifdef HAVE_SHA384 + case NID_sha384: + ctx_size = sizeof(SHA512_CTX); + ctx_final = (final_fun)(&SHA384_Final); + break; #endif -} -static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ #ifdef HAVE_SHA512 - ErlNifBinary ctx_bin; - SHA512_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */ - SHA512_Final(enif_make_new_binary(env, SHA512_LEN, &ret), &ctx_clone); - return ret; -#else - return atom_notsup; + case NID_sha512: + ctx_size = sizeof(SHA512_CTX); + ctx_final = (final_fun)(&SHA512_Final); + break; #endif -} - - -static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Data) */ - ErlNifBinary ibin; - ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + default: + return atom_notsup; } - MD4((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,MD4_LEN, &ret)); - CONSUME_REDS(env,ibin); - return ret; -} -static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* () */ - ERL_NIF_TERM ret; - MD4_Init((MD4_CTX *) enif_make_new_binary(env, MD4_CTX_LEN, &ret)); - return ret; -} -static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - MD4_CTX* new_ctx; - ErlNifBinary ctx_bin, data_bin; - ERL_NIF_TERM ret; - 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); - } - new_ctx = (MD4_CTX*) enif_make_new_binary(env,MD4_CTX_LEN, &ret); - memcpy(new_ctx, ctx_bin.data, MD4_CTX_LEN); - MD4_Update(new_ctx, data_bin.data, data_bin.size); - CONSUME_REDS(env,data_bin); - return ret; -} -static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context) */ - ErlNifBinary ctx_bin; - MD4_CTX ctx_clone; - ERL_NIF_TERM ret; - if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN) { - return enif_make_badarg(env); - } - memcpy(&ctx_clone, ctx_bin.data, MD4_CTX_LEN); /* writable */ - MD4_Final(enif_make_new_binary(env, MD4_LEN, &ret), &ctx_clone); - return ret; -} + ASSERT(ctx_size); + ASSERT(ctx_final); -static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); + if (ctx.size != ctx_size) { + return enif_make_badarg(env); } - hmac_md5(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -} -static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); - } - hmac_sha1(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -} + new_ctx = enif_alloc(ctx_size); + memcpy(new_ctx, ctx.data, ctx_size); + ctx_final(enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret), + new_ctx); + enif_free(new_ctx); -static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA224 - unsigned char hmacbuf[SHA224_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); - } - hmac_sha224(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); return ret; -#else - return atom_notsup; -#endif } +#endif /* OPENSSL_VERSION_NUMBER < 1.0 */ -static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA256 - unsigned char hmacbuf[SHA256_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); - } - hmac_sha256(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -#else - return atom_notsup; -#endif -} +static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Key, Data) or (Type, Key, Data, MacSize) */ + struct digest_type_t *digp = NULL; + ErlNifBinary key, data; + unsigned char buff[EVP_MAX_MD_SIZE]; + unsigned size = 0, req_size = 0; + ERL_NIF_TERM ret; -static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA384 - unsigned char hmacbuf[SHA384_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &key) || + !enif_inspect_iolist_as_binary(env, argv[2], &data) || + (argc == 4 && !enif_get_uint(env, argv[3], &req_size))) { + return enif_make_badarg(env); } - hmac_sha384(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); - return ret; -#else - return atom_notsup; -#endif -} + if (!digp->md_func || + !HMAC(digp->md_func(), + key.data, key.size, + data.data, data.size, + buff, &size)) { + return atom_notsup; + } + ASSERT(0 < size && size <= EVP_MAX_MD_SIZE); + CONSUME_REDS(env, data); -static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, MacSize) */ -#ifdef HAVE_SHA512 - unsigned char hmacbuf[SHA512_DIGEST_LENGTH]; - ErlNifBinary key, data; - unsigned mac_sz; - ERL_NIF_TERM ret; - 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) { - return enif_make_badarg(env); + if (argc == 4) { + if (req_size <= size) { + size = req_size; + } + else { + return enif_make_badarg(env); + } } - hmac_sha512(key.data, key.size, data.data, data.size, hmacbuf); - memcpy(enif_make_new_binary(env, mac_sz, &ret), - hmacbuf, mac_sz); - CONSUME_REDS(env,data); + memcpy(enif_make_new_binary(env, size, &ret), buff, size); return ret; -#else - return atom_notsup; -#endif } static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) @@ -1374,53 +1193,46 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) enif_mutex_destroy(obj->mtx); } -static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Key) */ - ErlNifBinary key; - struct hmac_context* obj; - const EVP_MD *md; - ERL_NIF_TERM ret; - + struct digest_type_t *digp = NULL; + ErlNifBinary key; + ERL_NIF_TERM ret; + struct hmac_context *obj; - if (argv[0] == atom_sha) md = EVP_sha1(); -#ifdef HAVE_SHA224 - else if (argv[0] == atom_sha224) md = EVP_sha224(); -#endif -#ifdef HAVE_SHA256 - else if (argv[0] == atom_sha256) md = EVP_sha256(); -#endif -#ifdef HAVE_SHA384 - else if (argv[0] == atom_sha384) md = EVP_sha384(); -#endif -#ifdef HAVE_SHA512 - else if (argv[0] == atom_sha512) md = EVP_sha512(); -#endif - else if (argv[0] == atom_md5) md = EVP_md5(); - else if (argv[0] == atom_ripemd160) md = EVP_ripemd160(); - else goto badarg; - - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) { - badarg: - return enif_make_badarg(env); + digp = get_digest_type(argv[0]); + if (!digp || + !enif_inspect_iolist_as_binary(env, argv[1], &key)) { + return enif_make_badarg(env); + } + if (!digp->md_func) { + return atom_notsup; } obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); obj->mtx = enif_mutex_create("crypto.hmac"); obj->alive = 1; - HMAC_CTX_init(&obj->ctx); - HMAC_Init(&obj->ctx, key.data, key.size, md); +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + // Check the return value of HMAC_Init: it may fail in FIPS mode + // for disabled algorithms + if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func())) { + enif_release_resource(obj); + return atom_notsup; + } +#else + HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func()); +#endif ret = enif_make_resource(env, obj); enif_release_resource(obj); return ret; } -static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ ErlNifBinary data; struct hmac_context* obj; - 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); @@ -1437,7 +1249,7 @@ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return argv[0]; } -static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) or (Context, HashLen) */ ERL_NIF_TERM ret; struct hmac_context* obj; @@ -1446,7 +1258,6 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv unsigned int req_len = 0; unsigned int mac_len; - if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { return enif_make_badarg(env); @@ -1473,199 +1284,185 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv return ret; } -static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Text, IsEncrypt) */ - ErlNifBinary key, ivec, text; - DES_key_schedule schedule; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; - +static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */ + struct cipher_type_t *cipherp = NULL; + const EVP_CIPHER *cipher; + ErlNifBinary key, ivec, text; + EVP_CIPHER_CTX ctx; + ERL_NIF_TERM ret; + unsigned char *out; + int ivec_size, out_size = 0; - 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) - || text.size % 8 != 0) { - return enif_make_badarg(env); + if (!enif_inspect_iolist_as_binary(env, argv[1], &key) + || !(cipherp = get_cipher_type(argv[0], key.size)) + || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) { + return enif_make_badarg(env); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_ncbc_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), - text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - -static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Text, IsEncrypt) */ - ErlNifBinary key, ivec, text; - DES_key_schedule schedule; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; - - - 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)) { - return enif_make_badarg(env); + if (!cipherp->cipher_func) { + return enif_raise_exception(env, atom_notsup); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), - 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} -static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Text/Cipher, IsEncrypt) */ - ErlNifBinary key, text; - DES_key_schedule schedule; - ERL_NIF_TERM ret; - 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); + if ((argv[0] == atom_aes_cfb8 || argv[0] == atom_aes_cfb128) + && (key.size == 24 || key.size == 32)) { + /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? + * Fall back on low level API + */ + return aes_cfb_8_crypt(env, argc-1, argv+1); } - DES_set_key((const_DES_cblock*)key.data, &schedule); - DES_ecb_encrypt((const_DES_cblock*)text.data, - (DES_cblock*)enif_make_new_binary(env, 8, &ret), - &schedule, (argv[2] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - -static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ - ErlNifBinary key1, key2, key3, ivec, text; - DES_key_schedule schedule1, schedule2, schedule3; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; + cipher = cipherp->cipher_func(); + ivec_size = EVP_CIPHER_iv_length(cipher); - 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 - || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[4], &text) - || text.size % 8 != 0) { - return enif_make_badarg(env); + if (text.size % EVP_CIPHER_block_size(cipher) != 0 || + (ivec_size == 0 ? argc != 4 + : (argc != 5 || + !enif_inspect_iolist_as_binary(env, argv[2], &ivec) || + ivec.size != ivec_size))) { + return enif_make_badarg(env); } - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key1.data, &schedule1); - DES_set_key((const_DES_cblock*)key2.data, &schedule2); - DES_set_key((const_DES_cblock*)key3.data, &schedule3); - DES_ede3_cbc_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), - text.size, &schedule1, &schedule2, &schedule3, - &ivec_clone, (argv[5] == atom_true)); - CONSUME_REDS(env,text); - return ret; -} - -static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ -#ifdef HAVE_DES_ede3_cfb_encrypt - ErlNifBinary key1, key2, key3, ivec, text; - DES_key_schedule schedule1, schedule2, schedule3; - DES_cblock ivec_clone; /* writable copy */ - ERL_NIF_TERM ret; - + out = enif_make_new_binary(env, text.size, &ret); - 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 - || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[4], &text)) { - return enif_make_badarg(env); - } + EVP_CIPHER_CTX_init(&ctx); + if (!EVP_CipherInit_ex(&ctx, cipher, NULL, NULL, NULL, + (argv[argc - 1] == atom_true)) || + !EVP_CIPHER_CTX_set_key_length(&ctx, key.size) || + !(EVP_CIPHER_type(cipher) != NID_rc2_cbc || + EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || + !EVP_CipherInit_ex(&ctx, NULL, NULL, + key.data, ivec_size ? ivec.data : NULL, -1) || + !EVP_CIPHER_CTX_set_padding(&ctx, 0) || + !EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size) || + (ASSERT(out_size == text.size), 0) || + !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size)) { + + EVP_CIPHER_CTX_cleanup(&ctx); + return enif_raise_exception(env, atom_notsup); + } + ASSERT(out_size == 0); + EVP_CIPHER_CTX_cleanup(&ctx); + CONSUME_REDS(env, text); - memcpy(&ivec_clone, ivec.data, 8); - DES_set_key((const_DES_cblock*)key1.data, &schedule1); - DES_set_key((const_DES_cblock*)key2.data, &schedule2); - DES_set_key((const_DES_cblock*)key3.data, &schedule3); - DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), - 8, text.size, &schedule1, &schedule2, &schedule3, - &ivec_clone, (argv[5] == atom_true)); - CONSUME_REDS(env,text); return ret; -#else - return atom_notsup; -#endif } static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; - ERL_NIF_TERM ret; - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } - - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb8_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); - return ret; +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + int new_ivlen = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !(key.size == 16 || key.size == 24 || key.size == 32) + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + + memcpy(ivec_clone, ivec.data, 16); + AES_set_encrypt_key(key.data, key.size * 8, &aes_key); + AES_cfb8_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, &new_ivlen, + (argv[3] == atom_true)); + CONSUME_REDS(env,text); + return ret; } -static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key, ivec, text; +static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ +#ifdef HAVE_AES_IGE + ErlNifBinary key_bin, ivec_bin, data_bin; AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - int new_ivlen = 0; + unsigned char ivec[32]; + int i; + unsigned char* ret_ptr; ERL_NIF_TERM ret; + 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) + || ivec_bin.size != 32 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) + || data_bin.size % 16 != 0) { - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); + return enif_make_badarg(env); } - memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); - AES_cfb128_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, &new_ivlen, - (argv[3] == atom_true)); - CONSUME_REDS(env,text); + if (argv[3] == atom_true) { + i = AES_ENCRYPT; + AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + else { + i = AES_DECRYPT; + AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + + ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); + memcpy(ivec, ivec_bin.data, 32); /* writable copy */ + AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); + CONSUME_REDS(env,data_bin); return ret; +#else + return atom_notsup; +#endif } /* Common for both encrypt and decrypt */ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data) */ - ErlNifBinary key, ivec, text; - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - unsigned char ecount_buf[AES_BLOCK_SIZE]; - unsigned int num = 0; - ERL_NIF_TERM ret; - + ErlNifBinary key, ivec, text; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + const EVP_CIPHER *cipher; + EVP_CIPHER_CTX ctx; + unsigned char *out; + int outl = 0; +#else + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + unsigned char ecount_buf[AES_BLOCK_SIZE]; + unsigned int num = 0; +#endif + ERL_NIF_TERM ret; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) +#if OPENSSL_VERSION_NUMBER < 0x1000000fL || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 +#endif || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { return enif_make_badarg(env); } +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + switch (key.size) + { + case 16: cipher = EVP_aes_128_ctr(); break; + case 24: cipher = EVP_aes_192_ctr(); break; + case 32: cipher = EVP_aes_256_ctr(); break; + default: return enif_make_badarg(env); + } + + out = enif_make_new_binary(env,text.size,&ret); + EVP_CIPHER_CTX_init(&ctx); + EVP_CipherInit_ex(&ctx, cipher, NULL, + key.data, ivec.data, (argv[3] == atom_true)); + EVP_CIPHER_CTX_set_padding(&ctx, 0); + EVP_CipherUpdate(&ctx, out, &outl, text.data, text.size); + ASSERT(outl == text.size); + EVP_CipherFinal_ex(&ctx, out + outl, &outl); + ASSERT(outl == 0); + EVP_CIPHER_CTX_cleanup(&ctx); +#else memcpy(ivec_clone, ivec.data, 16); memset(ecount_buf, 0, sizeof(ecount_buf)); AES_ctr128_encrypt((unsigned char *) text.data, enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, ecount_buf, &num); +#endif CONSUME_REDS(env,text); /* To do an incremental {en|de}cryption, the state to to keep between calls @@ -1675,6 +1472,81 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM /* Initializes state for ctr streaming (de)encryption */ +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec) */ + ErlNifBinary key_bin, ivec_bin; + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 16) { + return enif_make_badarg(env); + } + + switch (key_bin.size) + { + case 16: cipher = EVP_aes_128_ctr(); break; + case 24: cipher = EVP_aes_192_ctr(); break; + case 32: cipher = EVP_aes_256_ctr(); break; + default: return enif_make_badarg(env); + } + + ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX)); + EVP_CIPHER_CTX_init(ctx); + EVP_CipherInit_ex(ctx, cipher, NULL, + key_bin.data, ivec_bin.data, 1); + EVP_CIPHER_CTX_set_padding(ctx, 0); + ret = enif_make_resource(env, ctx); + enif_release_resource(ctx); + return ret; +} +static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ + EVP_CIPHER_CTX *ctx, *new_ctx; + ErlNifBinary data_bin; + ERL_NIF_TERM ret, cipher_term; + unsigned char *out; + int outl = 0; + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(EVP_CIPHER_CTX)); + EVP_CIPHER_CTX_init(new_ctx); + EVP_CIPHER_CTX_copy(new_ctx, ctx); + out = enif_make_new_binary(env, data_bin.size, &cipher_term); + EVP_CipherUpdate(new_ctx, out, &outl, data_bin.data, data_bin.size); + ASSERT(outl == data_bin.size); + + ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); + enif_release_resource(new_ctx); + CONSUME_REDS(env,data_bin); + return ret; +} + +#else /* if OPENSSL_VERSION_NUMBER < 1.0 */ + +static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec) */ + ErlNifBinary key_bin, ivec_bin; + ERL_NIF_TERM ecount_bin; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || !(key_bin.size == 16 || key_bin.size == 24 || key_bin.size ==32) + || ivec_bin.size != 16) { + return enif_make_badarg(env); + } + + memset(enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin), + 0, AES_BLOCK_SIZE); + return enif_make_tuple4(env, argv[0], argv[1], ecount_bin, enif_make_int(env, 0)); +} + static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* ({Key, IVec, ECount, Num}, Data) */ ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin; @@ -1686,7 +1558,6 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N unsigned char * ivec2_buf; unsigned char * ecount2_buf; - 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) @@ -1714,6 +1585,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N CONSUME_REDS(env,text_bin); return ret; } +#endif /* OPENSSL_VERSION_NUMBER < 1.0 */ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ @@ -1724,7 +1596,6 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char *outp; ERL_NIF_TERM out, out_tag; - 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], &iv) || iv.size == 0 @@ -1760,7 +1631,7 @@ out_err: return atom_error; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } @@ -1773,7 +1644,6 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char *outp; ERL_NIF_TERM out; - 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], &iv) || iv.size == 0 @@ -1810,7 +1680,7 @@ out_err: CRYPTO_gcm128_release(ctx); return atom_error; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } @@ -1843,7 +1713,6 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER unsigned char poly1305_key[32]; poly1305_state poly1305; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN || !enif_inspect_iolist_as_binary(env, argv[2], &aad) @@ -1881,7 +1750,7 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, out, out_tag); #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } @@ -1896,7 +1765,6 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER unsigned char mac[POLY1305_TAG_LEN]; poly1305_state poly1305; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN || !enif_inspect_iolist_as_binary(env, argv[2], &aad) @@ -1937,46 +1805,16 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER return out; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } -static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, IsEncrypt) */ - ErlNifBinary key_bin, data_bin; - AES_KEY aes_key; - int i; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 16 && key_bin.size != 32) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin) - || data_bin.size % 16 != 0) { - return enif_make_badarg(env); - } - - if (argv[2] == atom_true) { - i = AES_ENCRYPT; - AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - else { - i = AES_DECRYPT; - AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - - ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - AES_ecb_encrypt(data_bin.data, ret_ptr, &aes_key, i); - CONSUME_REDS(env,data_bin); - return ret; -} - static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; unsigned char* data; ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -1990,6 +1828,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; + if (!enif_get_uint(env, argv[0], &bytes)) { return enif_make_badarg(env); } @@ -2007,6 +1846,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; + if (!enif_get_uint(env, argv[0], &bytes) || !enif_get_uint(env, argv[1], &top_mask) || !enif_get_uint(env, argv[2], &bot_mask)) { @@ -2030,7 +1870,6 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI unsigned dlen; ERL_NIF_TERM ret; - if (!enif_get_uint(env, argv[0], &bits) || !enif_get_int(env, argv[1], &top) || !enif_get_int(env, argv[2], &bottom)) { @@ -2099,7 +1938,6 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER unsigned dlen; ERL_NIF_TERM ret; - 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); @@ -2131,7 +1969,6 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg unsigned extra_byte; ERL_NIF_TERM ret; - 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) @@ -2163,45 +2000,17 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg } static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (DigestType|none, Data|{digest,Digest}, Signature,Key=[P, Q, G, Y]) */ - ErlNifBinary data_bin, sign_bin; +{/* (sha, Digest, Signature,Key=[P, Q, G, Y]) */ + ErlNifBinary digest_bin, sign_bin; BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; - unsigned char* digest; ERL_NIF_TERM head, tail; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; DSA *dsa; int i; - - 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 - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != SHA_DIGEST_LENGTH) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - SHA1(data_bin.data, data_bin.size, hmacbuf); - digest = hmacbuf; - } - } - else if (argv[0] == atom_none && enif_inspect_binary(env, argv[1], &data_bin) - && data_bin.size == SHA_DIGEST_LENGTH) { - digest = data_bin.data; - } - else { - return enif_make_badarg(env); - } - - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!argv[0] == atom_sha + || !enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != SHA_DIGEST_LENGTH + || !enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) || !get_bn_from_bin(env, head, &dsa_p) || !enif_get_list_cell(env, tail, &head, &tail) @@ -2225,94 +2034,27 @@ static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM dsa->g = dsa_g; dsa->priv_key = NULL; dsa->pub_key = dsa_y; - i = DSA_verify(0, digest, SHA_DIGEST_LENGTH, + i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH, sign_bin.data, sign_bin.size, dsa); DSA_free(dsa); return(i > 0) ? atom_true : atom_false; } - -static void md5_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - MD5(in, in_len, out); -} -static void sha1_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA1(in, in_len, out); -} -#ifdef HAVE_SHA224 -static void sha224_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA224(in, in_len, out); -} -#endif -#ifdef HAVE_SHA256 -static void sha256_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA256(in, in_len, out); -} -#endif -#ifdef HAVE_SHA384 -static void sha384_digest(unsigned char* in, unsigned int in_len, unsigned char* out) -{ - SHA384(in, in_len, out); -} -#endif -#ifdef HAVE_SHA512 -static void sha512_digest(unsigned char* in, unsigned int in_len, unsigned char* out) +static void init_digest_types(ErlNifEnv* env) { - SHA512(in, in_len, out); -} -#endif + struct digest_type_t* p = digest_types; -struct digest_type_t { - const char* type_str; - unsigned len; /* 0 if notsup */ - int NID_type; - void (*funcp)(unsigned char* in, unsigned int in_len, unsigned char* out); - ERL_NIF_TERM type_atom; -}; + for (p = digest_types; p->type_str; p++) { + p->type_atom = enif_make_atom(env, p->type_str); + } -struct digest_type_t digest_types[] = -{ - {"md5", MD5_DIGEST_LENGTH, NID_md5, md5_digest}, - {"sha", SHA_DIGEST_LENGTH, NID_sha1, sha1_digest}, - {"sha224", -#ifdef HAVE_SHA224 - SHA224_LEN, NID_sha224, sha224_digest -#else - 0 -#endif - }, - {"sha256", -#ifdef HAVE_SHA256 - SHA256_LEN, NID_sha256, sha256_digest -#else - 0 -#endif - }, - {"sha384", -#ifdef HAVE_SHA384 - SHA384_LEN, NID_sha384, sha384_digest -#else - 0 -#endif - }, - {"sha512", -#ifdef HAVE_SHA512 - SHA512_LEN, NID_sha512, sha512_digest -#else - 0 -#endif - }, - {NULL} -}; +} -static void init_digest_types(ErlNifEnv* env) +static void init_cipher_types(ErlNifEnv* env) { - struct digest_type_t* p = digest_types; + struct cipher_type_t* p = cipher_types; - for (p = digest_types; p->type_str; p++) { + for (p = cipher_types; p->type_str; p++) { p->type_atom = enif_make_atom(env, p->type_str); } @@ -2329,31 +2071,45 @@ static struct digest_type_t* get_digest_type(ERL_NIF_TERM type) return NULL; } -static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Signature, Key=[E,N]) */ - ErlNifBinary data_bin, sign_bin; - unsigned char hmacbuf[SHA512_LEN]; - ERL_NIF_TERM head, tail, ret; - int i; - RSA* rsa; - const ERL_NIF_TERM type = argv[0]; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - struct digest_type_t* digp = NULL; - unsigned char* digest = NULL; +static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len) +{ + struct cipher_type_t* p = NULL; + for (p = cipher_types; p->type_str; p++) { + if (type == p->type_atom && (!p->key_len || key_len == p->key_len)) { + return p; + } + } + return NULL; +} +static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Digest, Signature, Key=[E,N]) */ + ErlNifBinary digest_bin, sign_bin; + ERL_NIF_TERM head, tail, ret; + int i; + RSA *rsa; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + EVP_PKEY *pkey; + EVP_PKEY_CTX *ctx; +#endif + const EVP_MD *md; + const ERL_NIF_TERM type = argv[0]; + struct digest_type_t *digp = NULL; digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } rsa = RSA_new(); + md = digp->md_func(); - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != EVP_MD_size(md) + || !enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) || !get_bn_from_bin(env, head, &rsa->e) || !enif_get_list_cell(env, tail, &head, &tail) @@ -2363,27 +2119,24 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret = enif_make_badarg(env); goto done; } - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - ret = enif_make_badarg(env); - goto done; - } - digest = data_bin.data; - } - else if (enif_inspect_binary(env, argv[1], &data_bin)) { - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - else { - ret = enif_make_badarg(env); - goto done; - } - i = RSA_verify(digp->NID_type, digest, digp->len, +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + pkey = EVP_PKEY_new(); + EVP_PKEY_set1_RSA(pkey, rsa); + + ctx = EVP_PKEY_CTX_new(pkey, NULL); + EVP_PKEY_verify_init(ctx); + EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING); + EVP_PKEY_CTX_set_signature_md(ctx, md); + + i = EVP_PKEY_verify(ctx, sign_bin.data, sign_bin.size, + digest_bin.data, digest_bin.size); + EVP_PKEY_CTX_free(ctx); + EVP_PKEY_free(pkey); +#else + i = RSA_verify(md->type, digest_bin.data, EVP_MD_size(md), sign_bin.data, sign_bin.size, rsa); +#endif ret = (i==1 ? atom_true : atom_false); @@ -2392,107 +2145,6 @@ done: return ret; } - -static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - unsigned char ivec[16]; - int enc, i = 0, outlen = 0; - EVP_CIPHER_CTX ctx; - const EVP_CIPHER *cipher = NULL; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - - 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) - || ivec_bin.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 16 != 0) { - - return enif_make_badarg(env); - } - - if (argv[3] == atom_true) - enc = 1; - else - enc = 0; - - EVP_CIPHER_CTX_init(&ctx); - - if (key_bin.size == 16) - cipher = EVP_aes_128_cbc(); - else if (key_bin.size == 32) - cipher = EVP_aes_256_cbc(); - - memcpy(ivec, ivec_bin.data, 16); /* writeable copy */ - - /* openssl docs say we need to leave at least 3 blocks available - at the end of the buffer for EVP calls. let's be safe */ - ret_ptr = enif_make_new_binary(env, data_bin.size + 16*3, &ret); - - if (EVP_CipherInit_ex(&ctx, cipher, NULL, key_bin.data, ivec, enc) != 1) - return enif_make_badarg(env); - - /* disable padding, we only handle whole blocks */ - EVP_CIPHER_CTX_set_padding(&ctx, 0); - - if (EVP_CipherUpdate(&ctx, ret_ptr, &i, data_bin.data, data_bin.size) != 1) - return enif_make_badarg(env); - outlen += i; - if (EVP_CipherFinal_ex(&ctx, ret_ptr + outlen, &i) != 1) - return enif_make_badarg(env); - outlen += i; - - EVP_CIPHER_CTX_cleanup(&ctx); - - CONSUME_REDS(env,data_bin); - - /* the garbage collector is going to love this */ - return enif_make_sub_binary(env, ret, 0, outlen); -} - -static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data, IsEncrypt) */ -#ifdef HAVE_AES_IGE - ErlNifBinary key_bin, ivec_bin, data_bin; - AES_KEY aes_key; - unsigned char ivec[32]; - int i; - unsigned char* ret_ptr; - ERL_NIF_TERM ret; - - - 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) - || ivec_bin.size != 32 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 16 != 0) { - - return enif_make_badarg(env); - } - - if (argv[3] == atom_true) { - i = AES_ENCRYPT; - AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - else { - i = AES_DECRYPT; - AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); - } - - ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - memcpy(ivec, ivec_bin.data, 32); /* writable copy */ - AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); - CONSUME_REDS(env,data_bin); - return ret; -#else - return atom_notsup; -#endif -} - static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data1, Data2) */ ErlNifBinary d1, d2; @@ -2500,7 +2152,6 @@ static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) int i; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env,argv[0], &d1) || !enif_inspect_iolist_as_binary(env,argv[1], &d2) || d1.size != d2.size) { @@ -2521,7 +2172,6 @@ static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg RC4_KEY rc4_key; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env,argv[0], &key) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { return enif_make_badarg(env); @@ -2538,7 +2188,6 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ErlNifBinary key; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) { return enif_make_badarg(env); } @@ -2554,7 +2203,6 @@ 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; - if (!enif_inspect_iolist_as_binary(env,argv[0], &state) || state.size != sizeof(RC4_KEY) || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { @@ -2568,34 +2216,6 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N return enif_make_tuple2(env,new_state,new_data); } -static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key,IVec,Data,IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - RC2_KEY rc2_key; - ERL_NIF_TERM ret; - unsigned char iv_copy[8]; - - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 8 != 0) { - return enif_make_badarg(env); - } - - RC2_set_key(&rc2_key, key_bin.size, key_bin.data, key_bin.size*8); - memcpy(iv_copy, ivec_bin.data, 8); - RC2_cbc_encrypt(data_bin.data, - enif_make_new_binary(env, data_bin.size, &ret), - data_bin.size, &rc2_key, - iv_copy, - (argv[3] == atom_true)); - CONSUME_REDS(env,data_bin); - return ret; -} - static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) { /* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */ @@ -2625,41 +2245,32 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) } static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ - ErlNifBinary data_bin, ret_bin; - unsigned char hmacbuf[SHA512_LEN]; - unsigned rsa_s_len; - RSA* rsa; - int i; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; +{/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */ + ErlNifBinary digest_bin, ret_bin; +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + EVP_PKEY *pkey; + EVP_PKEY_CTX *ctx; + size_t rsa_s_len; +#else + unsigned rsa_s_len, len; +#endif + RSA *rsa; + int i; struct digest_type_t *digp; - unsigned char* digest; - + const EVP_MD *md; digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - return enif_make_badarg(env); - } - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); + if (!enif_inspect_binary(env,argv[1],&digest_bin) + || digest_bin.size != EVP_MD_size(md)) { + return enif_make_badarg(env); } rsa = RSA_new(); @@ -2669,14 +2280,33 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL + pkey = EVP_PKEY_new(); + EVP_PKEY_set1_RSA(pkey, rsa); + rsa_s_len=(size_t)EVP_PKEY_size(pkey); + enif_alloc_binary(rsa_s_len, &ret_bin); + + ctx = EVP_PKEY_CTX_new(pkey, NULL); + EVP_PKEY_sign_init(ctx); + EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING); + EVP_PKEY_CTX_set_signature_md(ctx, md); + + i = EVP_PKEY_sign(ctx, ret_bin.data, &rsa_s_len, + digest_bin.data, digest_bin.size); + ASSERT(i<=0 || rsa_s_len <= ret_bin.size); + EVP_PKEY_CTX_free(ctx); + EVP_PKEY_free(pkey); +#else enif_alloc_binary(RSA_size(rsa), &ret_bin); + len = EVP_MD_size(md); - ERL_VALGRIND_ASSERT_MEM_DEFINED(digest, digp->len); - i = RSA_sign(digp->NID_type, digest, digp->len, + ERL_VALGRIND_ASSERT_MEM_DEFINED(digest_bin.data, len); + i = RSA_sign(md->type, digest_bin.data, len, ret_bin.data, &rsa_s_len, rsa); +#endif RSA_free(rsa); - if (i) { + if (i > 0) { ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len); if (rsa_s_len != ret_bin.size) { enif_realloc_binary(&ret_bin, rsa_s_len); @@ -2692,43 +2322,16 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (DigesType|none, Data|{digest,Digest}, Key=[P,Q,G,PrivKey]) */ - ErlNifBinary data_bin, ret_bin; +{/* (sha, Digest, Key=[P,Q,G,PrivKey]) */ + ErlNifBinary digest_bin, ret_bin; ERL_NIF_TERM head, tail; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; unsigned int dsa_s_len; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - unsigned char* digest = NULL; DSA* dsa; int i; - - 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 - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != SHA_DIGEST_LENGTH) { - - return enif_make_badarg(env); - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - return enif_make_badarg(env); - } - SHA1(data_bin.data, data_bin.size, hmacbuf); - digest = hmacbuf; - } - } - else if (argv[0] == atom_none - && enif_inspect_binary(env,argv[1],&data_bin) - && data_bin.size == SHA_DIGEST_LENGTH) { - - digest = data_bin.data; - } - else { + if (!argv[0] == atom_sha + || !enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != SHA_DIGEST_LENGTH) { return enif_make_badarg(env); } @@ -2749,7 +2352,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } enif_alloc_binary(DSA_size(dsa), &ret_bin); - i = DSA_sign(NID_sha1, digest, SHA_DIGEST_LENGTH, + i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH, ret_bin.data, &dsa_s_len, dsa); DSA_free(dsa); if (i) { @@ -2789,7 +2392,6 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER int padding, i; RSA* rsa; - rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -2838,7 +2440,6 @@ static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE int padding, i; RSA* rsa; - rsa = RSA_new(); if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -2885,7 +2486,6 @@ 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; - if (!enif_get_int(env, argv[0], &prime_len) || !enif_get_int(env, argv[1], &generator)) { @@ -2913,7 +2513,6 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] int i; ERL_NIF_TERM ret, head, tail; - dh_params = DH_new(); if (!enif_get_list_cell(env, argv[0], &head, &tail) @@ -2948,7 +2547,6 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ - dh_params = DH_new(); if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key) @@ -2993,7 +2591,6 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; - dh_params = DH_new(); if (!get_bn_from_bin(env, argv[0], &pubkey) @@ -3016,7 +2613,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = enif_make_binary(env, &ret_bin); } else { - enif_release_binary(&ret_bin); + enif_release_binary(&ret_bin); ret = atom_error; } } @@ -3034,7 +2631,6 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned dlen; ERL_NIF_TERM ret; - 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) @@ -3095,7 +2691,6 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; - 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) @@ -3175,7 +2770,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ unsigned dlen; ERL_NIF_TERM ret; - 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) @@ -3228,99 +2822,6 @@ static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_ return ret; } -static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n = 0; /* blowfish ivec pos */ - ERL_NIF_TERM ret; - - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_cfb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, &bf_n, - (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Ivec, Data, IsEncrypt) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - ERL_NIF_TERM ret; - - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 8 != 0) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_cbc_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, - (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data, IsEncrypt) */ - ErlNifBinary key_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - ERL_NIF_TERM ret; - - - 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) { - return enif_make_badarg(env); - } - BF_set_key(&bf_key, key_bin.size, key_bin.data); - BF_ecb_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - &bf_key, (argv[2] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); - CONSUME_REDS(env,data_bin); - return ret; -} - -static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data) */ - ErlNifBinary key_bin, ivec_bin, data_bin; - BF_KEY bf_key; /* blowfish key 8 */ - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n = 0; /* blowfish ivec pos */ - ERL_NIF_TERM ret; - - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 8 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { - return enif_make_badarg(env); - } - - BF_set_key(&bf_key, key_bin.size, key_bin.data); - memcpy(bf_tkey, ivec_bin.data, 8); - BF_ofb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), - data_bin.size, &bf_key, bf_tkey, &bf_n); - CONSUME_REDS(env,data_bin); - return ret; -} - #if defined(HAVE_EC) static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) { @@ -3629,7 +3130,6 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM priv_key; ERL_NIF_TERM pub_key = atom_undefined; - if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key)) goto badarg; @@ -3659,50 +3159,33 @@ badarg: } static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Curve, Key) */ +{/* (Type, Digest, Curve, Key) */ #if defined(HAVE_EC) - ErlNifBinary data_bin, ret_bin; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ErlNifBinary digest_bin, ret_bin; unsigned int dsa_s_len; EC_KEY* key = NULL; - int i; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; + int i, len; struct digest_type_t *digp; - unsigned char* digest; - + const EVP_MD *md; digp = get_digest_type(argv[0]); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); + len = EVP_MD_size(md); - if (!get_ec_key(env, argv[2], argv[3], atom_undefined, &key)) + if (!enif_inspect_binary(env,argv[1],&digest_bin) + || digest_bin.size != len + || !get_ec_key(env, argv[2], argv[3], atom_undefined, &key)) goto badarg; - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - goto badarg; - } - digest = data_bin.data; - } - else { - if (!enif_inspect_binary(env,argv[1],&data_bin)) { - goto badarg; - } - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - enif_alloc_binary(ECDSA_size(key), &ret_bin); - i = ECDSA_sign(digp->NID_type, digest, digp->len, + i = ECDSA_sign(md->type, digest_bin.data, len, ret_bin.data, &dsa_s_len, key); EC_KEY_free(key); @@ -3727,49 +3210,32 @@ badarg: } static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Data|{digest,Digest}, Signature, Curve, Key) */ +{/* (Type, Digest, Signature, Curve, Key) */ #if defined(HAVE_EC) - ErlNifBinary data_bin, sign_bin; - unsigned char hmacbuf[SHA512_LEN]; - int i; + ErlNifBinary digest_bin, sign_bin; + int i, len; EC_KEY* key = NULL; const ERL_NIF_TERM type = argv[0]; - const ERL_NIF_TERM* tpl_terms; - int tpl_arity; - struct digest_type_t* digp = NULL; - unsigned char* digest = NULL; - + struct digest_type_t *digp = NULL; + const EVP_MD *md; digp = get_digest_type(type); if (!digp) { return enif_make_badarg(env); } - if (!digp->len) { + if (!digp->md_func) { return atom_notsup; } + md = digp->md_func(); + len = EVP_MD_size(md); - if (!enif_inspect_binary(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[1], &digest_bin) + || digest_bin.size != len + || !enif_inspect_binary(env, argv[2], &sign_bin) || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key)) goto badarg; - if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &data_bin) - || data_bin.size != digp->len) { - - goto badarg; - } - digest = data_bin.data; - } - else if (enif_inspect_binary(env, argv[1], &data_bin)) { - digest = hmacbuf; - digp->funcp(data_bin.data, data_bin.size, digest); - } - else { - goto badarg; - } - - i = ECDSA_verify(digp->NID_type, digest, digp->len, + i = ECDSA_verify(md->type, digest_bin.data, len, sign_bin.data, sign_bin.size, key); EC_KEY_free(key); @@ -3803,7 +3269,6 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF EC_POINT *my_ecpoint; EC_KEY *other_ecdh = NULL; - if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) return enif_make_badarg(env); @@ -3847,252 +3312,9 @@ out_err: static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary seed_bin; + 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 */ - -static void hmac_md5(unsigned char *key, int klen, unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - MD5_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[MD5_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - MD5(key, klen, nkey); - key = nkey; - klen = MD5_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, ipad, HMAC_INT_LEN); - MD5_Update(&ctx, dbuf, dlen); - MD5_Final((unsigned char *) hmacbuf, &ctx); - /* outer MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, opad, HMAC_INT_LEN); - MD5_Update(&ctx, hmacbuf, MD5_LEN); - MD5_Final((unsigned char *) hmacbuf, &ctx); -} - -static void hmac_sha1(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA1(key, klen, nkey); - key = nkey; - klen = SHA_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, ipad, HMAC_INT_LEN); - SHA1_Update(&ctx, dbuf, dlen); - SHA1_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, opad, HMAC_INT_LEN); - SHA1_Update(&ctx, hmacbuf, SHA_LEN); - SHA1_Final((unsigned char *) hmacbuf, &ctx); -} - -#ifdef HAVE_SHA224 -static void hmac_sha224(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA256_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA224_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA224(key, klen, nkey); - key = nkey; - klen = SHA224_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA224_Init(&ctx); - SHA224_Update(&ctx, ipad, HMAC_INT_LEN); - SHA224_Update(&ctx, dbuf, dlen); - SHA224_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA224_Init(&ctx); - SHA224_Update(&ctx, opad, HMAC_INT_LEN); - SHA224_Update(&ctx, hmacbuf, SHA224_DIGEST_LENGTH); - SHA224_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA256 -static void hmac_sha256(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA256_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA256_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA256(key, klen, nkey); - key = nkey; - klen = SHA256_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA256_Init(&ctx); - SHA256_Update(&ctx, ipad, HMAC_INT_LEN); - SHA256_Update(&ctx, dbuf, dlen); - SHA256_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA256_Init(&ctx); - SHA256_Update(&ctx, opad, HMAC_INT_LEN); - SHA256_Update(&ctx, hmacbuf, SHA256_DIGEST_LENGTH); - SHA256_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA384 -static void hmac_sha384(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA512_CTX ctx; - char ipad[HMAC_INT2_LEN]; - char opad[HMAC_INT2_LEN]; - unsigned char nkey[SHA384_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT2_LEN) { - SHA384(key, klen, nkey); - key = nkey; - klen = SHA384_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT2_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA384_Init(&ctx); - SHA384_Update(&ctx, ipad, HMAC_INT2_LEN); - SHA384_Update(&ctx, dbuf, dlen); - SHA384_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA384_Init(&ctx); - SHA384_Update(&ctx, opad, HMAC_INT2_LEN); - SHA384_Update(&ctx, hmacbuf, SHA384_DIGEST_LENGTH); - SHA384_Final((unsigned char *) hmacbuf, &ctx); -} -#endif - -#ifdef HAVE_SHA512 -static void hmac_sha512(unsigned char *key, int klen, - unsigned char *dbuf, int dlen, - unsigned char *hmacbuf) -{ - SHA512_CTX ctx; - char ipad[HMAC_INT2_LEN]; - char opad[HMAC_INT2_LEN]; - unsigned char nkey[SHA512_DIGEST_LENGTH]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT2_LEN) { - SHA512(key, klen, nkey); - key = nkey; - klen = SHA512_DIGEST_LENGTH; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT2_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA512_Init(&ctx); - SHA512_Update(&ctx, ipad, HMAC_INT2_LEN); - SHA512_Update(&ctx, dbuf, dlen); - SHA512_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA512_Init(&ctx); - SHA512_Update(&ctx, opad, HMAC_INT2_LEN); - SHA512_Update(&ctx, hmacbuf, SHA512_DIGEST_LENGTH); - SHA512_Final((unsigned char *) hmacbuf, &ctx); -} -#endif diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index e0de16074c..aab43232c9 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -51,8 +51,6 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks); -static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ - static void nomem(size_t size, const char* op) { fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n", @@ -84,6 +82,8 @@ static void crypto_free(void* ptr) #ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */ +static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ + #include static INLINE void locking(int mode, ErlNifRWLock* lock) diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 38e71591f3..8722e801a6 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -210,10 +210,8 @@ supports()-> {Hashs, PubKeys, Ciphers} = algorithms(), [{hashs, Hashs}, - {ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc, - blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128, - aes_cbc256, rc2_cbc, aes_ctr, rc4, aes_ecb] ++ Ciphers}, - {public_keys, [rsa, dss, dh, srp] ++ PubKeys} + {ciphers, Ciphers}, + {public_keys, PubKeys} ]. info_lib() -> ?nif_stub. @@ -222,20 +220,14 @@ info_lib() -> ?nif_stub. hash(Hash, Data0) -> Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - hash(Hash, Data, erlang:byte_size(Data), MaxByts, initial). + MaxBytes = max_bytes(), + hash(Hash, Data, erlang:byte_size(Data), MaxBytes). -spec hash_init('md5'|'md4'|'ripemd160'| 'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any(). -hash_init(md5) -> {md5, md5_init()}; -hash_init(md4) -> {md4, md4_init()}; -hash_init(sha) -> {sha, sha_init()}; -hash_init(ripemd160) -> {ripemd160, ripemd160_init()}; -hash_init(sha224) -> {sha224, sha224_init()}; -hash_init(sha256) -> {sha256, sha256_init()}; -hash_init(sha384) -> {sha384, sha384_init()}; -hash_init(sha512) -> {sha512, sha512_init()}. +hash_init(Hash) -> + notsup_to_error(hash_init_nif(Hash)). -spec hash_update(_, iodata()) -> any(). @@ -246,14 +238,8 @@ hash_update(State, Data0) -> -spec hash_final(_) -> binary(). -hash_final({md5,Context}) -> md5_final(Context); -hash_final({md4,Context}) -> md4_final(Context); -hash_final({sha,Context}) -> sha_final(Context); -hash_final({ripemd160,Context}) -> ripemd160_final(Context); -hash_final({sha224,Context}) -> sha224_final(Context); -hash_final({sha256,Context}) -> sha256_final(Context); -hash_final({sha384,Context}) -> sha384_final(Context); -hash_final({sha512,Context}) -> sha512_final(Context). +hash_final(State) -> + notsup_to_error(hash_final_nif(State)). -spec hmac(_, iodata(), iodata()) -> binary(). @@ -265,151 +251,128 @@ hash_final({sha512,Context}) -> sha512_final(Context). hmac(Type, Key, Data0) -> Data = iolist_to_binary(Data0), - hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes(), initial). + hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes()). hmac(Type, Key, Data0, MacSize) -> Data = iolist_to_binary(Data0), - hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes(), initial). + hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes()). - -hmac_init(_Type, _Key) -> ?nif_stub. +hmac_init(Type, Key) -> + notsup_to_error(hmac_init_nif(Type, Key)). hmac_update(State, Data0) -> Data = iolist_to_binary(Data0), hmac_update(State, Data, erlang:byte_size(Data), max_bytes()). -hmac_final(_Context) -> ? nif_stub. -hmac_final_n(_Context, _HashLen) -> ? nif_stub. + +hmac_final(Context) -> + notsup_to_error(hmac_final_nif(Context)). +hmac_final_n(Context, HashLen) -> + notsup_to_error(hmac_final_nif(Context, HashLen)). %% Ecrypt/decrypt %%% --spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc, +-spec block_encrypt(des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | + blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | + aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. -block_encrypt(des_cbc, Key, Ivec, Data) -> - des_cbc_encrypt(Key, Ivec, Data); -block_encrypt(des_cfb, Key, Ivec, Data) -> - des_cfb_encrypt(Key, Ivec, Data); -block_encrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> - des3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> - des3_cfb_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> - des_ede3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); -block_encrypt(blowfish_cbc, Key, Ivec, Data) -> - blowfish_cbc_encrypt(Key, Ivec, Data); -block_encrypt(blowfish_cfb64, Key, Ivec, Data) -> - blowfish_cfb64_encrypt(Key, Ivec, Data); -block_encrypt(blowfish_ofb64, Key, Ivec, Data) -> - blowfish_ofb64_encrypt(Key, Ivec, Data); -block_encrypt(aes_cbc128, Key, Ivec, Data) -> - aes_cbc_128_encrypt(Key, Ivec, Data); -block_encrypt(aes_cbc256, Key, Ivec, Data) -> - aes_cbc_256_encrypt(Key, Ivec, Data); +block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; + Type =:= des_cfb; + Type =:= blowfish_cbc; + Type =:= blowfish_cfb64; + Type =:= blowfish_ofb64; + Type =:= aes_cbc128; + Type =:= aes_cfb8; + Type =:= aes_cfb128; + Type =:= aes_cbc256; + Type =:= rc2_cbc -> + block_crypt_nif(Type, Key, Ivec, Data, true); +block_encrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc; + Type =:= des_ede3 -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, true); +block_encrypt(des3_cbf, Key0, Ivec, Data) -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, true); block_encrypt(aes_ige256, Key, Ivec, Data) -> - aes_ige_256_encrypt(Key, Ivec, Data); -block_encrypt(aes_cfb8, Key, Ivec, Data) -> - aes_cfb_8_encrypt(Key, Ivec, Data); -block_encrypt(aes_cfb128, Key, Ivec, Data) -> - aes_cfb_128_encrypt(Key, Ivec, Data); + aes_ige_crypt_nif(Key, Ivec, Data, true); block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) -> - case aes_gcm_encrypt(Key, Ivec, AAD, Data) of - notsup -> erlang:error(notsup); - Return -> Return - end; + aes_gcm_encrypt(Key, Ivec, AAD, Data); block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> - case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of - notsup -> erlang:error(notsup); - Return -> Return - end; -block_encrypt(rc2_cbc, Key, Ivec, Data) -> - rc2_cbc_encrypt(Key, Ivec, Data). + chacha20_poly1305_encrypt(Key, Ivec, AAD, Data). --spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | - aes_cfb8 | aes_cfb128 | rc2_cbc, +-spec block_decrypt(des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | + blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | + aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error. -block_decrypt(des_cbc, Key, Ivec, Data) -> - des_cbc_decrypt(Key, Ivec, Data); -block_decrypt(des_cfb, Key, Ivec, Data) -> - des_cfb_decrypt(Key, Ivec, Data); -block_decrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> - des3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> - des3_cfb_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> - des_ede3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); -block_decrypt(blowfish_cbc, Key, Ivec, Data) -> - blowfish_cbc_decrypt(Key, Ivec, Data); -block_decrypt(blowfish_cfb64, Key, Ivec, Data) -> - blowfish_cfb64_decrypt(Key, Ivec, Data); -block_decrypt(blowfish_ofb64, Key, Ivec, Data) -> - blowfish_ofb64_decrypt(Key, Ivec, Data); -block_decrypt(aes_cbc128, Key, Ivec, Data) -> - aes_cbc_128_decrypt(Key, Ivec, Data); -block_decrypt(aes_cbc256, Key, Ivec, Data) -> - aes_cbc_256_decrypt(Key, Ivec, Data); +block_decrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; + Type =:= des_cfb; + Type =:= blowfish_cbc; + Type =:= blowfish_cfb64; + Type =:= blowfish_ofb64; + Type =:= aes_cbc128; + Type =:= aes_cfb8; + Type =:= aes_cfb128; + Type =:= aes_cbc256; + Type =:= rc2_cbc -> + block_crypt_nif(Type, Key, Ivec, Data, false); +block_decrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc; + Type =:= des_ede3 -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, false); +block_decrypt(des3_cbf, Key0, Ivec, Data) -> + Key = check_des3_key(Key0), + block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, false); block_decrypt(aes_ige256, Key, Ivec, Data) -> - aes_ige_256_decrypt(Key, Ivec, Data); -block_decrypt(aes_cfb8, Key, Ivec, Data) -> - aes_cfb_8_decrypt(Key, Ivec, Data); -block_decrypt(aes_cfb128, Key, Ivec, Data) -> - aes_cfb_128_decrypt(Key, Ivec, Data); + notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false)); block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) -> - case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of - notsup -> erlang:error(notsup); - Return -> Return - end; + aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag); block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) -> - case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of - notsup -> erlang:error(notsup); - Return -> Return - end; -block_decrypt(rc2_cbc, Key, Ivec, Data) -> - rc2_cbc_decrypt(Key, Ivec, Data). + chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag). -spec block_encrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary(). -block_encrypt(des_ecb, Key, Data) -> - des_ecb_encrypt(Key, Data); -block_encrypt(blowfish_ecb, Key, Data) -> - blowfish_ecb_encrypt(Key, Data); -block_encrypt(aes_ecb, Key, Data) -> - aes_ecb_encrypt(Key, Data). +block_encrypt(Type, Key, Data) -> + block_crypt_nif(Type, Key, Data, true). -spec block_decrypt(des_ecb | blowfish_ecb | aes_ecb, Key::iodata(), Data::iodata()) -> binary(). -block_decrypt(des_ecb, Key, Data) -> - des_ecb_decrypt(Key, Data); -block_decrypt(blowfish_ecb, Key, Data) -> - blowfish_ecb_decrypt(Key, Data); -block_decrypt(aes_ecb, Key, Data) -> - aes_ecb_decrypt(Key, Data). +block_decrypt(Type, Key, Data) -> + block_crypt_nif(Type, Key, Data, false). -spec next_iv(des_cbc | des3_cbc | aes_cbc | aes_ige, Data::iodata()) -> binary(). -next_iv(des_cbc, Data) -> - des_cbc_ivec(Data); -next_iv(des3_cbc, Data) -> - des_cbc_ivec(Data); -next_iv(aes_cbc, Data) -> - aes_cbc_ivec(Data); -next_iv(aes_ige, Data) -> - aes_ige_ivec(Data). +next_iv(Type, Data) when is_binary(Data) -> + IVecSize = case Type of + des_cbc -> 8; + des3_cbc -> 8; + aes_cbc -> 16; + aes_ige -> 32 + end, + {_, IVec} = split_binary(Data, size(Data) - IVecSize), + IVec; +next_iv(Type, Data) when is_list(Data) -> + next_iv(Type, list_to_binary(Data)). -spec next_iv(des_cfb, Data::iodata(), Ivec::binary()) -> binary(). -next_iv(des_cfb, Data, Ivec) -> - des_cfb_ivec(Ivec, Data); +next_iv(des_cfb, Data, IVec) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec; next_iv(Type, Data, _Ivec) -> next_iv(Type, Data). stream_init(aes_ctr, Key, Ivec) -> {aes_ctr, aes_ctr_stream_init(Key, Ivec)}. stream_init(rc4, Key) -> - {rc4, rc4_set_key(Key)}. + {rc4, notsup_to_error(rc4_set_key(Key))}. stream_encrypt(State, Data0) -> Data = iolist_to_binary(Data0), @@ -485,35 +448,31 @@ verify(dss, none, Data, Signature, Key) when is_binary(Data) -> verify(dss, sha, {digest, Data}, Signature, Key); verify(Alg, Type, Data, Signature, Key) when is_binary(Data) -> verify(Alg, Type, {digest, hash(Type, Data)}, Signature, Key); -verify(dss, Type, Data, Signature, Key) -> - dss_verify_nif(Type, Data, Signature, map_ensure_int_as_bin(Key)); -verify(rsa, Type, DataOrDigest, Signature, Key) -> - case rsa_verify_nif(Type, DataOrDigest, Signature, map_ensure_int_as_bin(Key)) of - notsup -> erlang:error(notsup); - Bool -> Bool - end; -verify(ecdsa, Type, DataOrDigest, Signature, [Key, Curve]) -> - case ecdsa_verify_nif(Type, DataOrDigest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key)) of - notsup -> erlang:error(notsup); - Bool -> Bool - end. +verify(dss, Type, {digest, Digest}, Signature, Key) -> + dss_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key)); +verify(rsa, Type, {digest, Digest}, Signature, Key) -> + notsup_to_error( + rsa_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key))); +verify(ecdsa, Type, {digest, Digest}, Signature, [Key, Curve]) -> + notsup_to_error( + ecdsa_verify_nif(Type, Digest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key))). sign(dss, none, Data, Key) when is_binary(Data) -> sign(dss, sha, {digest, Data}, Key); sign(Alg, Type, Data, Key) when is_binary(Data) -> sign(Alg, Type, {digest, hash(Type, Data)}, Key); -sign(rsa, Type, DataOrDigest, Key) -> - case rsa_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [Type,DataOrDigest,Key]); +sign(rsa, Type, {digest, Digest}, Key) -> + case rsa_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,Digest,Key]); Sign -> Sign end; -sign(dss, Type, DataOrDigest, Key) -> - case dss_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [DataOrDigest, Key]); +sign(dss, Type, {digest, Digest}, Key) -> + case dss_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Digest, Key]); Sign -> Sign end; -sign(ecdsa, Type, DataOrDigest, [Key, Curve]) -> - case ecdsa_sign_nif(Type, DataOrDigest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of - error -> erlang:error(badkey, [Type,DataOrDigest,Key]); +sign(ecdsa, Type, {digest, Digest}, [Key, Curve]) -> + case ecdsa_sign_nif(Type, Digest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,Digest,Key]); Sign -> Sign end. @@ -618,8 +577,9 @@ compute_key(srp, HostPublic, {UserPublic, UserPrivate}, HostPubBin, Prime); [S] -> S end, + notsup_to_error( srp_user_secret_nif(ensure_int_as_bin(UserPrivate), Scrambler, HostPubBin, - Multiplier, Generator, DerivedKey, Prime); + Multiplier, Generator, DerivedKey, Prime)); compute_key(srp, UserPublic, {HostPublic, HostPrivate}, {host,[Verifier, Prime, Version | ScramblerArg]}) when @@ -631,8 +591,9 @@ compute_key(srp, UserPublic, {HostPublic, HostPrivate}, [] -> srp_scrambler(Version, UserPubBin, ensure_int_as_bin(HostPublic), Prime); [S] -> S end, + notsup_to_error( srp_host_secret_nif(Verifier, ensure_int_as_bin(HostPrivate), Scrambler, - UserPubBin, Prime); + UserPubBin, Prime)); compute_key(ecdh, Others, My, Curve) -> ecdh_compute_key_nif(ensure_int_as_bin(Others), @@ -677,7 +638,8 @@ on_load() -> end end, Lib = filename:join([PrivDir, "lib", LibName]), - Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,path2bin(Lib)}) of + LibBin = path2bin(Lib), + Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,LibBin}) of ok -> ok; {error, {load_failed, _}}=Error1 -> ArchLibDir = @@ -689,7 +651,8 @@ on_load() -> [] -> Error1; _ -> ArchLib = filename:join([ArchLibDir, LibName]), - erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,path2bin(ArchLib)}) + ArchBin = path2bin(ArchLib), + erlang:load_nif(ArchLib, {?CRYPTO_NIF_VSN,ArchBin}) end; Error1 -> Error1 end, @@ -714,46 +677,30 @@ path2bin(Path) when is_list(Path) -> max_bytes() -> ?MAX_BYTES_TO_NIF. +notsup_to_error(notsup) -> + erlang:error(notsup); +notsup_to_error(Other) -> + Other. + %% HASH -------------------------------------------------------------------- -hash(Hash, Data, Size, Max, initial) when Size =< Max -> - do_hash(Hash, Data); -hash(State0, Data, Size, Max, continue) when Size =< Max -> - State = do_hash_update(State0, Data), - hash_final(State); -hash(Hash, Data, _Size, Max, initial) -> - <> = Data, +hash(Hash, Data, Size, Max) when Size =< Max -> + notsup_to_error(hash_nif(Hash, Data)); +hash(Hash, Data, Size, Max) -> State0 = hash_init(Hash), - State = do_hash_update(State0, Increment), - hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue); -hash(State0, Data, _Size, MaxByts, continue) -> - <> = Data, - State = do_hash_update(State0, Increment), - hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue). - -do_hash(md5, Data) -> md5(Data); -do_hash(md4, Data) -> md4(Data); -do_hash(sha, Data) -> sha(Data); -do_hash(ripemd160, Data) -> ripemd160(Data); -do_hash(sha224, Data) -> sha224(Data); -do_hash(sha256, Data) -> sha256(Data); -do_hash(sha384, Data) -> sha384(Data); -do_hash(sha512, Data) -> sha512(Data). + State1 = hash_update(State0, Data, Size, Max), + hash_final(State1). hash_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> - do_hash_update(State, Data); + notsup_to_error(hash_update_nif(State, Data)); hash_update(State0, Data, _, MaxBytes) -> <> = Data, - State = do_hash_update(State0, Increment), + State = notsup_to_error(hash_update_nif(State0, Increment)), hash_update(State, Rest, erlang:byte_size(Rest), MaxBytes). -do_hash_update({md5,Context}, Data) -> {md5, md5_update(Context,Data)}; -do_hash_update({md4,Context}, Data) -> {md4, md4_update(Context,Data)}; -do_hash_update({sha,Context}, Data) -> {sha, sha_update(Context,Data)}; -do_hash_update({ripemd160,Context}, Data) -> {ripemd160, ripemd160_update(Context,Data)}; -do_hash_update({sha224,Context}, Data) -> {sha224, sha224_update(Context,Data)}; -do_hash_update({sha256,Context}, Data) -> {sha256, sha256_update(Context,Data)}; -do_hash_update({sha384,Context}, Data) -> {sha384, sha384_update(Context,Data)}; -do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data)}. +hash_nif(_Hash, _Data) -> ?nif_stub. +hash_init_nif(_Hash) -> ?nif_stub. +hash_update_nif(_State, _Data) -> ?nif_stub. +hash_final_nif(_State) -> ?nif_stub. %% @@ -765,10 +712,14 @@ do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data -spec md5_update(binary(), iodata()) -> binary(). -spec md5_final(binary()) -> binary(). -md5(_Data) -> ?nif_stub. -md5_init() -> ?nif_stub. -md5_update(_Context, _Data) -> ?nif_stub. -md5_final(_Context) -> ?nif_stub. +md5(Data) -> + hash(md5, Data). +md5_init() -> + hash_init(md5). +md5_update(Context, Data) -> + hash_update(Context, Data). +md5_final(Context) -> + hash_final(Context). %% %% MD4 @@ -778,24 +729,14 @@ md5_final(_Context) -> ?nif_stub. -spec md4_update(binary(), iodata()) -> binary(). -spec md4_final(binary()) -> binary(). -md4(_Data) -> ?nif_stub. -md4_init() -> ?nif_stub. -md4_update(_Context, _Data) -> ?nif_stub. -md4_final(_Context) -> ?nif_stub. - -%% -%% RIPEMD160 -%% - --spec ripemd160(iodata()) -> binary(). --spec ripemd160_init() -> binary(). --spec ripemd160_update(binary(), iodata()) -> binary(). --spec ripemd160_final(binary()) -> binary(). - -ripemd160(_Data) -> ?nif_stub. -ripemd160_init() -> ?nif_stub. -ripemd160_update(_Context, _Data) -> ?nif_stub. -ripemd160_final(_Context) -> ?nif_stub. +md4(Data) -> + hash(md4, Data). +md4_init() -> + hash_init(md4). +md4_update(Context, Data) -> + hash_update(Context, Data). +md4_final(Context) -> + hash_final(Context). %% %% SHA @@ -805,196 +746,44 @@ ripemd160_final(_Context) -> ?nif_stub. -spec sha_update(binary(), iodata()) -> binary(). -spec sha_final(binary()) -> binary(). -sha(_Data) -> ?nif_stub. -sha_init() -> ?nif_stub. -sha_update(_Context, _Data) -> ?nif_stub. -sha_final(_Context) -> ?nif_stub. - -% -%% SHA224 -%% --spec sha224(iodata()) -> binary(). --spec sha224_init() -> binary(). --spec sha224_update(binary(), iodata()) -> binary(). --spec sha224_final(binary()) -> binary(). - -sha224(Data) -> - case sha224_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_init() -> - case sha224_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_update(Context, Data) -> - case sha224_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha224_final(Context) -> - case sha224_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha224_nif(_Data) -> ?nif_stub. -sha224_init_nif() -> ?nif_stub. -sha224_update_nif(_Context, _Data) -> ?nif_stub. -sha224_final_nif(_Context) -> ?nif_stub. - -% -%% SHA256 -%% --spec sha256(iodata()) -> binary(). --spec sha256_init() -> binary(). --spec sha256_update(binary(), iodata()) -> binary(). --spec sha256_final(binary()) -> binary(). - -sha256(Data) -> - case sha256_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_init() -> - case sha256_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_update(Context, Data) -> - case sha256_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha256_final(Context) -> - case sha256_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha256_nif(_Data) -> ?nif_stub. -sha256_init_nif() -> ?nif_stub. -sha256_update_nif(_Context, _Data) -> ?nif_stub. -sha256_final_nif(_Context) -> ?nif_stub. - -% -%% SHA384 -%% --spec sha384(iodata()) -> binary(). --spec sha384_init() -> binary(). --spec sha384_update(binary(), iodata()) -> binary(). --spec sha384_final(binary()) -> binary(). - -sha384(Data) -> - case sha384_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_init() -> - case sha384_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_update(Context, Data) -> - case sha384_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha384_final(Context) -> - case sha384_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha384_nif(_Data) -> ?nif_stub. -sha384_init_nif() -> ?nif_stub. -sha384_update_nif(_Context, _Data) -> ?nif_stub. -sha384_final_nif(_Context) -> ?nif_stub. - -% -%% SHA512 -%% --spec sha512(iodata()) -> binary(). --spec sha512_init() -> binary(). --spec sha512_update(binary(), iodata()) -> binary(). --spec sha512_final(binary()) -> binary(). - -sha512(Data) -> - case sha512_nif(Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_init() -> - case sha512_init_nif() of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_update(Context, Data) -> - case sha512_update_nif(Context, Data) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. -sha512_final(Context) -> - case sha512_final_nif(Context) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha512_nif(_Data) -> ?nif_stub. -sha512_init_nif() -> ?nif_stub. -sha512_update_nif(_Context, _Data) -> ?nif_stub. -sha512_final_nif(_Context) -> ?nif_stub. +sha(Data) -> + hash(sha, Data). +sha_init() -> + hash_init(sha). +sha_update(Context, Data) -> + hash_update(Context, Data). +sha_final(Context) -> + hash_final(Context). %% HMAC -------------------------------------------------------------------- -hmac(Type, Key, Data, MacSize, Size, MaxBytes, initial) when Size =< MaxBytes -> +hmac(Type, Key, Data, MacSize, Size, MaxBytes) when Size =< MaxBytes -> + notsup_to_error( case MacSize of - undefined -> - do_hmac(Type, Key, Data); - _ -> - do_hmac(Type, Key, Data, MacSize) - end; -hmac(Type, Key, Data, MacSize, _, MaxBytes, initial) -> - <> = Data, + undefined -> hmac_nif(Type, Key, Data); + _ -> hmac_nif(Type, Key, Data, MacSize) + end); +hmac(Type, Key, Data, MacSize, Size, MaxBytes) -> State0 = hmac_init(Type, Key), - State = hmac_update(State0, Increment), - hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). -hmac(State0, Data, MacSize, Size, MaxBytes, continue) when Size =< MaxBytes -> - State = hmac_update(State0, Data), + State1 = hmac_update(State0, Data, Size, MaxBytes), case MacSize of - undefined -> - hmac_final(State); - _ -> - hmac_final_n(State, MacSize) - end; -hmac(State0, Data, MacSize, _Size, MaxBytes, continue) -> - <> = Data, - State = hmac_update(State0, Increment), - hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). + undefined -> hmac_final(State1); + _ -> hmac_final_n(State1, MacSize) + end. hmac_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> - do_hmac_update(State, Data); + notsup_to_error(hmac_update_nif(State, Data)); hmac_update(State0, Data, _, MaxBytes) -> <> = Data, - State = do_hmac_update(State0, Increment), + State = notsup_to_error(hmac_update_nif(State0, Increment)), hmac_update(State, Rest, erlang:byte_size(Rest), MaxBytes). -do_hmac(md5, Key, Data) -> md5_mac(Key, Data); -do_hmac(sha, Key, Data) -> sha_mac(Key, Data); -do_hmac(sha224, Key, Data) -> sha224_mac(Key, Data); -do_hmac(sha256, Key, Data) -> sha256_mac(Key, Data); -do_hmac(sha384, Key, Data) -> sha384_mac(Key, Data); -do_hmac(sha512, Key, Data) -> sha512_mac(Key, Data). - -do_hmac(md5, Key, Data, Size) -> md5_mac_n(Key, Data, Size); -do_hmac(sha, Key, Data, Size) -> sha_mac_n(Key, Data, Size); -do_hmac(sha224, Key, Data, Size) -> sha224_mac(Key, Data, Size); -do_hmac(sha256, Key, Data, Size) -> sha256_mac(Key, Data, Size); -do_hmac(sha384, Key, Data, Size) -> sha384_mac(Key, Data, Size); -do_hmac(sha512, Key, Data, Size) -> sha512_mac(Key, Data, Size). - -do_hmac_update(_Context, _Data) -> ? nif_stub. +hmac_nif(_Type, _Key, _Data) -> ?nif_stub. +hmac_nif(_Type, _Key, _Data, _MacSize) -> ?nif_stub. +hmac_init_nif(_Type, _Key) -> ?nif_stub. +hmac_update_nif(_Context, _Data) -> ?nif_stub. +hmac_final_nif(_Context) -> ?nif_stub. +hmac_final_nif(_Context, _MacSize) -> ?nif_stub. %% %% MD5_MAC @@ -1002,97 +791,37 @@ do_hmac_update(_Context, _Data) -> ? nif_stub. -spec md5_mac(iodata(), iodata()) -> binary(). -spec md5_mac_96(iodata(), iodata()) -> binary(). -md5_mac(Key, Data) -> - md5_mac_n(Key,Data,16). +md5_mac(Key, Data) -> hmac(md5, Key, Data). -md5_mac_96(Key, Data) -> - md5_mac_n(Key,Data,12). +md5_mac_96(Key, Data) -> hmac(md5, Key, Data, 12). -md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. - %% %% SHA_MAC %% -spec sha_mac(iodata(), iodata()) -> binary(). -spec sha_mac_96(iodata(), iodata()) -> binary(). -sha_mac(Key, Data) -> - sha_mac_n(Key,Data,20). - -sha_mac(Key, Data, Size) -> - sha_mac_n(Key, Data, Size). - -sha_mac_96(Key, Data) -> - sha_mac_n(Key,Data,12). - -sha_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA224_MAC -%% --spec sha224_mac(iodata(), iodata()) -> binary(). - -sha224_mac(Key, Data) -> - sha224_mac(Key, Data, 224 div 8). - -sha224_mac(Key, Data, Size) -> - case sha224_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha224_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA256_MAC -%% --spec sha256_mac(iodata(), iodata()) -> binary(). - -sha256_mac(Key, Data) -> - sha256_mac(Key, Data, 256 div 8). - -sha256_mac(Key, Data, Size) -> - case sha256_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha256_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% -%% SHA384_MAC -%% --spec sha384_mac(iodata(), iodata()) -> binary(). - -sha384_mac(Key, Data) -> - sha384_mac(Key, Data, 384 div 8). +sha_mac(Key, Data) -> hmac(sha, Key, Data). -sha384_mac(Key, Data, Size) -> - case sha384_mac_nif(Key, Data, Size) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -sha384_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. +sha_mac(Key, Data, Size) -> hmac(sha, Key, Data, Size). -%% -%% SHA512_MAC -%% --spec sha512_mac(iodata(), iodata()) -> binary(). +sha_mac_96(Key, Data) -> hmac(sha, Key, Data, 12). -sha512_mac(Key, Data) -> - sha512_mac(Key, Data, 512 div 8). +%% CIPHERS -------------------------------------------------------------------- -sha512_mac(Key, Data, MacSz) -> - case sha512_mac_nif(Key, Data, MacSz) of - notsup -> erlang:error(notsup); - Bin -> Bin +block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. +block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub. + +check_des3_key(Key) -> + case lists:map(fun erlang:iolist_to_binary/1, Key) of + ValidKey = [B1, B2, B3] when byte_size(B1) =:= 8, + byte_size(B2) =:= 8, + byte_size(B3) =:= 8 -> + ValidKey; + _ -> + error(badarg) end. -sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. - -%% CIPHERS -------------------------------------------------------------------- - %% %% DES - in electronic codebook mode (ECB) %% @@ -1100,10 +829,9 @@ sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. -spec des_ecb_decrypt(iodata(), iodata()) -> binary(). des_ecb_encrypt(Key, Data) -> - des_ecb_crypt(Key, Data, true). + block_encrypt(des_ecb, Key, Data). des_ecb_decrypt(Key, Data) -> - des_ecb_crypt(Key, Data, false). -des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_ecb, Key, Data). %% %% DES3 - in cipher block chaining mode (CBC) @@ -1114,16 +842,14 @@ des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). + block_decrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). - -des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). %% %% DES3 - in 8-bits cipher feedback mode (CFB) @@ -1134,18 +860,10 @@ des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). + block_encrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data). des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). - -des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, IsEncrypt) -> - case des_ede3_cfb_crypt_nif(Key1,Key2,Key3,IVec,Data,IsEncrypt) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - -des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des3_cbf, [Key1, Key2, Key3], IVec, Data). %% %% Blowfish @@ -1159,49 +877,27 @@ des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_st -spec blowfish_ofb64_encrypt(iodata(), binary(), iodata()) -> binary(). blowfish_ecb_encrypt(Key, Data) -> - bf_ecb_crypt(Key,Data, true). + block_encrypt(blowfish_ecb, Key, Data). blowfish_ecb_decrypt(Key, Data) -> - bf_ecb_crypt(Key,Data, false). - -bf_ecb_crypt(_Key,_Data,_IsEncrypt) -> ?nif_stub. + block_decrypt(blowfish_ecb, Key, Data). blowfish_cbc_encrypt(Key, IVec, Data) -> - bf_cbc_crypt(Key,IVec,Data,true). + block_encrypt(blowfish_cbc, Key, IVec, Data). blowfish_cbc_decrypt(Key, IVec, Data) -> - bf_cbc_crypt(Key,IVec,Data,false). - -bf_cbc_crypt(_Key,_IVec,_Data,_IsEncrypt) -> ?nif_stub. + block_decrypt(blowfish_cbc, Key, IVec, Data). blowfish_cfb64_encrypt(Key, IVec, Data) -> - bf_cfb64_crypt(Key, IVec, Data, true). + block_encrypt(blowfish_cfb64, Key, IVec, Data). blowfish_cfb64_decrypt(Key, IVec, Data) -> - bf_cfb64_crypt(Key, IVec, Data, false). - -bf_cfb64_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -blowfish_ofb64_decrypt(Key, Ivec, Data) -> - blowfish_ofb64_encrypt(Key, Ivec, Data). + block_decrypt(blowfish_cfb64, Key, IVec, Data). -blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub. +blowfish_ofb64_encrypt(Key, IVec, Data) -> + block_encrypt(blowfish_ofb64, Key, IVec, Data). -%% -%% AES in cipher feedback mode (CFB) - 8 bit shift -%% --spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary(). --spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary(). - -aes_cfb_8_encrypt(Key, IVec, Data) -> - aes_cfb_8_crypt(Key, IVec, Data, true). - -aes_cfb_8_decrypt(Key, IVec, Data) -> - aes_cfb_8_crypt(Key, IVec, Data, false). - -aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - %% %% AES in cipher feedback mode (CFB) - 128 bit shift %% @@ -1209,12 +905,10 @@ aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary(). aes_cfb_128_encrypt(Key, IVec, Data) -> - aes_cfb_128_crypt(Key, IVec, Data, true). + block_encrypt(aes_cfb128, Key, IVec, Data). aes_cfb_128_decrypt(Key, IVec, Data) -> - aes_cfb_128_crypt(Key, IVec, Data, false). - -aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(aes_cfb128, Key, IVec, Data). %% %% AES - in Galois/Counter Mode (GCM) @@ -1235,12 +929,10 @@ chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. -spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). des_cbc_encrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, true). + block_encrypt(des_cbc, Key, IVec, Data). des_cbc_decrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, false). - -des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_cbc, Key, IVec, Data). %% %% dec_cbc_ivec(Data) -> binary() @@ -1250,11 +942,8 @@ des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% -spec des_cbc_ivec(iodata()) -> binary(). -des_cbc_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 8), - IVec; -des_cbc_ivec(Data) when is_list(Data) -> - des_cbc_ivec(list_to_binary(Data)). +des_cbc_ivec(Data) -> + next_iv(des_cbc, Data). %% %% DES - in 8-bits cipher feedback mode (CFB) @@ -1263,12 +952,10 @@ des_cbc_ivec(Data) when is_list(Data) -> -spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). des_cfb_encrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, true). + block_encrypt(des_cfb, Key, IVec, Data). des_cfb_decrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, false). - -des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(des_cfb, Key, IVec, Data). %% %% dec_cfb_ivec(IVec, Data) -> binary() @@ -1280,9 +967,7 @@ des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -spec des_cfb_ivec(iodata(), iodata()) -> binary(). des_cfb_ivec(IVec, Data) -> - IVecAndData = list_to_binary([IVec, Data]), - {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), - NewIVec. + next_iv(des_cfb, Data, IVec). %% @@ -1298,18 +983,16 @@ des_cfb_ivec(IVec, Data) -> binary(). aes_cbc_128_encrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, true). + block_encrypt(aes_cbc128, Key, IVec, Data). aes_cbc_128_decrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, false). + block_decrypt(aes_cbc128, Key, IVec, Data). aes_cbc_256_encrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, true). + block_encrypt(aes_cbc256, Key, IVec, Data). aes_cbc_256_decrypt(Key, IVec, Data) -> - aes_cbc_crypt(Key, IVec, Data, false). - -aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(aes_cbc256, Key, IVec, Data). %% %% aes_cbc_ivec(Data) -> binary() @@ -1318,47 +1001,15 @@ aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% aes_cbc_*_[encrypt|decrypt]. %% IVec size: 16 bytes %% -aes_cbc_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 16), - IVec; -aes_cbc_ivec(Data) when is_list(Data) -> - aes_cbc_ivec(list_to_binary(Data)). - +aes_cbc_ivec(Data) -> + next_iv(aes_cbc, Data). %% %% AES - with 256 bit key in infinite garble extension mode (IGE) %% --spec aes_ige_256_decrypt(iodata(), binary(), iodata()) -> - binary(). - -aes_ige_256_encrypt(Key, IVec, Data) -> - aes_ige_crypt(Key, IVec, Data, true). - -aes_ige_256_decrypt(Key, IVec, Data) -> - aes_ige_crypt(Key, IVec, Data, false). - -aes_ige_crypt(Key, IVec, Data, IsEncrypt) -> - case aes_ige_crypt_nif(Key,IVec,Data,IsEncrypt) of - notsup -> erlang:error(notsup); - Bin -> Bin - end. - aes_ige_crypt_nif(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -%% -%% aes_ige_ivec(Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% aes_ige_*_[encrypt|decrypt]. -%% IVec size: 32 bytes -%% -aes_ige_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 32), - IVec; -aes_ige_ivec(Data) when is_list(Data) -> - aes_ige_ivec(list_to_binary(Data)). - %% Stream ciphers -------------------------------------------------------------------- @@ -1397,22 +1048,11 @@ do_stream_decrypt({rc4, State0}, Data) -> aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub. aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub. -%% -%% AES - in electronic codebook mode (ECB) -%% -aes_ecb_encrypt(Key, Data) -> - aes_ecb_crypt(Key, Data, true). - -aes_ecb_decrypt(Key, Data) -> - aes_ecb_crypt(Key, Data, false). - -aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub. - %% %% AES - in counter mode (CTR) with state maintained for multi-call streaming %% --type ctr_state() :: { iodata(), binary(), binary(), integer() }. +-type ctr_state() :: { iodata(), binary(), binary(), integer() } | binary(). -spec aes_ctr_stream_init(iodata(), binary()) -> ctr_state(). -spec aes_ctr_stream_encrypt(ctr_state(), binary()) -> @@ -1420,10 +1060,9 @@ aes_ecb_crypt(_Key, __Data, _IsEncrypt) -> ?nif_stub. -spec aes_ctr_stream_decrypt(ctr_state(), binary()) -> { ctr_state(), binary() }. -aes_ctr_stream_init(Key, IVec) -> - {Key, IVec, << 0:128 >>, 0}. -aes_ctr_stream_encrypt({_Key, _IVec, _ECount, _Num}=_State, _Data) -> ?nif_stub. -aes_ctr_stream_decrypt({_Key, _IVec, _ECount, _Num}=_State, _Cipher) -> ?nif_stub. +aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub. +aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub. +aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. %% %% RC4 - symmetric stream cipher @@ -1438,21 +1077,19 @@ rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. %% RC2 block cipher rc2_cbc_encrypt(Key, IVec, Data) -> - rc2_cbc_crypt(Key,IVec,Data,true). + block_encrypt(rc2_cbc, Key, IVec, Data). rc2_cbc_decrypt(Key, IVec, Data) -> - rc2_cbc_crypt(Key,IVec,Data,false). - -rc2_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + block_decrypt(rc2_cbc, Key, IVec, Data). %% %% RC2 - 40 bits block cipher - Backwards compatibility not documented. %% rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - rc2_cbc_crypt(Key,IVec,Data,true). + block_encrypt(rc2_cbc, Key, IVec, Data). rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - rc2_cbc_crypt(Key,IVec,Data,false). + block_decrypt(rc2_cbc, Key, IVec, Data). %% Secure remote password ------------------------------------------------------------------- @@ -1470,16 +1107,18 @@ host_srp_gen_key(Private, Verifier, Generator, Prime, Version) -> case srp_value_B_nif(Multiplier, Verifier, Generator, Private, Prime) of error -> error; + notsup -> + erlang:error(notsup); Public -> {Public, Private} end. srp_multiplier('6a', Generator, Prime) -> %% k = SHA1(N | PAD(g)) from http://srp.stanford.edu/design.html - C0 = sha_init(), - C1 = sha_update(C0, Prime), - C2 = sha_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), - sha_final(C2); + C0 = hash_init(sha), + C1 = hash_update(C0, Prime), + C2 = hash_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), + hash_final(C2); srp_multiplier('6', _, _) -> <<3/integer>>; srp_multiplier('3', _, _) -> @@ -1488,10 +1127,10 @@ srp_multiplier('3', _, _) -> srp_scrambler(Version, UserPublic, HostPublic, Prime) when Version == '6'; Version == '6a'-> %% SHA1(PAD(A) | PAD(B)) from http://srp.stanford.edu/design.html PadLength = erlang:byte_size(Prime), - C0 = sha_init(), - C1 = sha_update(C0, srp_pad_to(PadLength, UserPublic)), - C2 = sha_update(C1, srp_pad_to(PadLength, HostPublic)), - sha_final(C2); + C0 = hash_init(sha), + C1 = hash_update(C0, srp_pad_to(PadLength, UserPublic)), + C2 = hash_update(C1, srp_pad_to(PadLength, HostPublic)), + hash_final(C2); srp_scrambler('3', _, HostPublic, _Prime) -> %% The parameter u is a 32-bit unsigned integer which takes its value %% from the first 32 bits of the SHA1 hash of B, MSB first. @@ -1515,13 +1154,13 @@ srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_s %% Digital signatures -------------------------------------------------------------------- -rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. -dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub. -ecdsa_sign_nif(_Type, _DataOrDigest, _Curve, _Key) -> ?nif_stub. +rsa_sign_nif(_Type,_Digest,_Key) -> ?nif_stub. +dss_sign_nif(_Type,_Digest,_Key) -> ?nif_stub. +ecdsa_sign_nif(_Type, _Digest, _Curve, _Key) -> ?nif_stub. -dss_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. -rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. -ecdsa_verify_nif(_Type, _DataOrDigest, _Signature, _Curve, _Key) -> ?nif_stub. +dss_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub. +rsa_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub. +ecdsa_verify_nif(_Type, _Digest, _Signature, _Curve, _Key) -> ?nif_stub. %% Public Keys -------------------------------------------------------------------- %% DH Diffie-Hellman functions -- cgit v1.2.3 From 5e40dfbf957df2b64dc7e713c5c8fc83ea538f52 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 9 Jul 2015 16:41:53 +0200 Subject: Fix bug for aes_cfb_128_encrypt with empty binary causing OpenSSL 0.9.8h to crash with evp_enc.c(282): OpenSSL internal error, assertion failed: inl > 0 --- lib/crypto/c_src/crypto.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 595ee65415..3add54bcd3 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1332,10 +1332,15 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || !EVP_CipherInit_ex(&ctx, NULL, NULL, key.data, ivec_size ? ivec.data : NULL, -1) || - !EVP_CIPHER_CTX_set_padding(&ctx, 0) || - !EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size) || - (ASSERT(out_size == text.size), 0) || - !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size)) { + !EVP_CIPHER_CTX_set_padding(&ctx, 0)) { + + return enif_raise_exception(env, atom_notsup); + } + + if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */ + (!EVP_CipherUpdate(&ctx, out, &out_size, text.data, text.size) + || (ASSERT(out_size == text.size), 0) + || !EVP_CipherFinal_ex(&ctx, out + out_size, &out_size))) { EVP_CIPHER_CTX_cleanup(&ctx); return enif_raise_exception(env, atom_notsup); -- cgit v1.2.3 From 929e12e6ed27f03cf91a6310bb996b87bc00e9b5 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 18 Aug 2015 16:47:19 +0200 Subject: Fix EVP_aes_???_ctr to demand OpenSSL 1.0.1 or later. --- lib/crypto/c_src/crypto.c | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 3add54bcd3..18aa8f19ed 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -91,6 +91,7 @@ #endif #if OPENSSL_VERSION_NUMBER >= 0x1000100fL +# define HAVE_EVP_AES_CTR # define HAVE_GCM #endif @@ -463,7 +464,9 @@ static ErlNifResourceType* evp_md_ctx_rtype; static void evp_md_ctx_dtor(ErlNifEnv* env, EVP_MD_CTX* ctx) { EVP_MD_CTX_cleanup(ctx); } +#endif +#ifdef HAVE_EVP_AES_CTR static ErlNifResourceType* evp_cipher_ctx_rtype; static void evp_cipher_ctx_dtor(ErlNifEnv* env, EVP_CIPHER_CTX* ctx) { EVP_CIPHER_CTX_cleanup(ctx); @@ -563,6 +566,8 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'"); return 0; } +#endif +#ifdef HAVE_EVP_AES_CTR evp_cipher_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_CIPHER_CTX", (ErlNifResourceDtor*) evp_cipher_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, @@ -1421,7 +1426,7 @@ static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data) */ ErlNifBinary key, ivec, text; -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#ifdef HAVE_EVP_AES_CTR const EVP_CIPHER *cipher; EVP_CIPHER_CTX ctx; unsigned char *out; @@ -1435,14 +1440,14 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM ret; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) -#if OPENSSL_VERSION_NUMBER < 0x1000000fL +#ifndef HAVE_EVP_AES_CTR || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 #endif || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { return enif_make_badarg(env); } -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#ifdef HAVE_EVP_AES_CTR switch (key.size) { case 16: cipher = EVP_aes_128_ctr(); break; @@ -1477,7 +1482,7 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM /* Initializes state for ctr streaming (de)encryption */ -#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#ifdef HAVE_EVP_AES_CTR static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec) */ ErlNifBinary key_bin, ivec_bin; @@ -1533,7 +1538,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N return ret; } -#else /* if OPENSSL_VERSION_NUMBER < 1.0 */ +#else /* if not HAVE_EVP_AES_CTR */ static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec) */ @@ -1590,7 +1595,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N CONSUME_REDS(env,text_bin); return ret; } -#endif /* OPENSSL_VERSION_NUMBER < 1.0 */ +#endif /* !HAVE_EVP_AES_CTR */ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ -- cgit v1.2.3 From d5711cb70be9ad2e5c78839e8a368900ba248a4a Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Fri, 8 Jun 2012 23:13:50 +0300 Subject: Add all the main machinery Add functions size_shared, copy_shared_calculate and copy_shared_perform. Add the infrastructure for making these communicate with each other. Add debug information to other places in the VM, to watch interaction with the sharing-preserving copy. CAUTION: If you define the SHCOPY_DEBUG macro (after SHCOPY is actually used in the VM) and make the whole OTP, there will be a lot of debugging messages during make (it will also be enabled in erlc). You have been warned... --- erts/emulator/beam/copy.c | 1131 +++++++++++++++++++++++++++++++++++++++++++ erts/emulator/beam/erl_gc.c | 10 + erts/emulator/beam/global.h | 56 ++- 3 files changed, 1196 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index f27c526413..b31e043f08 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -75,8 +75,17 @@ Uint size_object(Eterm obj) Uint sum = 0; Eterm* ptr; int arity; +#ifdef SHCOPY_DEBUG + Eterm mypid; +#endif DECLARE_ESTACK(s); + +#ifdef SHCOPY_DEBUG + mypid = erts_get_current_pid(); + VERBOSE_DEBUG("[pid=%T] size_object %p\n", mypid, obj); +#endif + for (;;) { switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: @@ -211,6 +220,7 @@ Uint size_object(Eterm obj) pop_next: if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); + VERBOSE_DEBUG("[pid=%T] size was: %u\n", mypid, sum); return sum; } obj = ESTACK_POP(s); @@ -221,6 +231,350 @@ Uint size_object(Eterm obj) } } +/* + * Machinery for sharing preserving information + * Using a WSTACK but not very transparently; consider refactoring + */ + +#define DECLARE_BITSTORE(s) \ + DECLARE_WSTACK(s); \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s) +#define BITSTORE_PUT(s,i) \ +do { \ + WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \ + WSTK_CONCAT(s,_bitoffs) += 2; \ + if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + WSTK_CONCAT(s,_buffer) = 0; \ + } \ +} while(0) +#define BITSTORE_CLOSE(s) \ +do { \ + if (WSTK_CONCAT(s,_bitoffs) > 0) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + } \ +} while(0) + +#define BITSTORE_GET(s) ({ \ + UWord result; \ + if (WSTK_CONCAT(s,_bitoffs) <= 0) { \ + WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \ + WSTK_CONCAT(s,_offset)++; \ + WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \ + } \ + WSTK_CONCAT(s,_bitoffs) -= 2; \ + result = WSTK_CONCAT(s,_buffer) & 3; \ + WSTK_CONCAT(s,_buffer) >>= 2; \ + result; \ +}) + +#define BOXED_VISITED_MASK ((Eterm) 3) +#define BOXED_VISITED ((Eterm) 1) +#define BOXED_SHARED_UNPROCESSED ((Eterm) 2) +#define BOXED_SHARED_PROCESSED ((Eterm) 3) + + +/* + * Is an object in the local heap of a process? + */ + +#define INHEAP_SIMPLE(p, ptr) ( \ + (OLD_HEAP(p) && OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p)) || \ + (HEAP_START(p) <= ptr && ptr < HEAP_END(p)) \ + ) +#define INHEAP(p, ptr) ( \ + INHEAP_SIMPLE(p, ptr) || \ + (force_local ? (force_local = 0, 1) : 0) \ + ) +#define COUNT_OFF_HEAP 0 + + +/* + * Return the real size of an object and find sharing information + * This currently returns the same as erts_debug:size/1. + * It is argued whether the size of subterms in constant pools + * should be counted or not. + */ +#if HALFWORD_HEAP +Uint size_shared_rel(Eterm obj, Eterm* base) +#else +Uint size_shared(Eterm obj) +#endif +{ + Eterm saved_obj = obj; + Uint sum = 0; + Eterm* ptr; + Process* myself; + + DECLARE_EQUEUE(s); + DECLARE_BITSTORE(b); + + myself = erts_get_current_process(); + if (myself == NULL) + return size_object(obj); + + for (;;) { + VERBOSE_DEBUG("[size] visiting: %x ", obj); + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + VERBOSE_DEBUG("L"); + ptr = list_val_rel(obj, base); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("!"); + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + VERBOSE_DEBUG("/L"); + ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + VERBOSE_DEBUG("/I"); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + VERBOSE_DEBUG("/B saved %d", primary_tag(head)); + BITSTORE_PUT(b, primary_tag(head)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + VERBOSE_DEBUG("B"); + ptr = boxed_val_rel(obj, base); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("!"); + goto pop_next; + } + /* else make it visited now */ + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + VERBOSE_DEBUG("/T"); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + VERBOSE_DEBUG("e"); + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + VERBOSE_DEBUG("/F"); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Uint extra_bytes; + Eterm hdr; + ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN); + if (sb->bitsize + sb->bitoffs > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (sb->bitsize + sb->bitoffs > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ptr = binary_val_rel(sb->orig, base); + hdr = (*ptr) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { + sum += PROC_BIN_SIZE; + } else { + ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG); + sum += heap_bin_size(binary_size_rel(obj, base) + extra_bytes); + } + goto pop_next; + } + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + VERBOSE_DEBUG("/D"); + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + VERBOSE_DEBUG("I"); + pop_next: + if (EQUEUE_ISEMPTY(s)) { + goto cleanup; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + VERBOSE_DEBUG("\n"); + } + +cleanup: + VERBOSE_DEBUG("\n"); + obj = saved_obj; + BITSTORE_CLOSE(b); + for (;;) { + VERBOSE_DEBUG("[size] revisiting: %x ", obj); + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + VERBOSE_DEBUG("L"); + ptr = list_val_rel(obj, base); + if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if not already clean, clean it up */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved = BITSTORE_GET(b); + VERBOSE_DEBUG("/B restoring %d", saved); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED; + } else { + VERBOSE_DEBUG("/L"); + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("/I"); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + VERBOSE_DEBUG("!"); + goto cleanup_next; + } + /* and its children too */ + if (!IS_CONST(head)) { + EQUEUE_PUT_UNCHECKED(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + VERBOSE_DEBUG("B"); + ptr = boxed_val_rel(obj, base); + if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + goto cleanup_next; + } + hdr = *ptr; + /* if not already clean, clean it up */ + if (primary_tag(hdr) == TAG_PRIMARY_HEADER) { + goto cleanup_next; + } + else { + ASSERT(primary_tag(hdr) == BOXED_VISITED); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + if (arity == 0) { /* Empty tuple -- unusual. */ + goto cleanup_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + default: + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + VERBOSE_DEBUG("\n"); + } + + all_clean: + VERBOSE_DEBUG("\n"); + /* Return the result */ + DESTROY_EQUEUE(s); + DESTROY_BITSTORE(b); + return sum; +} + + /* * Copy a structure to a heap. */ @@ -244,10 +598,18 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) Eterm org_obj = obj; Uint org_sz = sz; #endif +#ifdef SHCOPY_DEBUG + Eterm mypid; +#endif if (IS_CONST(obj)) return obj; +#ifdef SHCOPY_DEBUG + mypid = erts_get_current_pid(); + VERBOSE_DEBUG("[pid=%T] copy_struct %p\n", mypid, obj); +#endif + DTRACE1(copy_struct, (int32_t)sz); hp = htop = *hpp; @@ -529,9 +891,778 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } #endif *hpp = (Eterm *) (hstart+hsize); + VERBOSE_DEBUG("[pid=%T] result is at %p\n", mypid, res); return res; } + +/* + * Machinery for the table used by the sharing preserving copier + * Using an ESTACK but not very transparently; consider refactoring + */ + +#define DECLARE_SHTABLE(s) \ + DECLARE_ESTACK(s); \ + Uint ESTK_CONCAT(s,_offset) = 0 +#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s) +#define SHTABLE_INCR 4 +#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset) +#define SHTABLE_PUSH(s,x,y,b) \ +do { \ + if (s.sp > s.end - SHTABLE_INCR) { \ + erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + } \ + *s.sp++ = (x); \ + *s.sp++ = (y); \ + *s.sp++ = (Eterm) NULL; \ + *s.sp++ = (Eterm) (b); /* bad in HALF_WORD */ \ + ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \ +} while(0) +#define SHTABLE_X(s,e) (s.start[e]) +#define SHTABLE_Y(s,e) (s.start[(e)+1]) +#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2])) +#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p)) +#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3])) + +#define LIST_SHARED_UNPROCESSED ((Eterm) 0) +#define LIST_SHARED_PROCESSED ((Eterm) 1) + +#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL) + + +/* + * Specialized macros for using/reusing the persistent state + */ + +#define DECLARE_EQUEUE_INIT_INFO(q, info) \ + UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DECLARE_EQUEUE_FROM_INFO(q, info) \ + /* no EQUE_DEF_QUEUE(q), read-only */ \ + ErtsEQueue q = { \ + info->queue_start, /* start */ \ + info->queue_start, /* front */ \ + info->queue_start, /* back */ \ + 1, /* possibly_empty */ \ + info->queue_end, /* end */ \ + info->queue_alloc_type /* alloc_type */ \ + } + +#define DECLARE_BITSTORE_INIT_INFO(s, info) \ + UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \ + ErtsWStack s = { \ + WSTK_DEF_STACK(s), /* wstart */ \ + WSTK_DEF_STACK(s), /* wsp */ \ + WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + /* no WSTK_CONCAT(s,_offset), write-only */ \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_BITSTORE_FROM_INFO(s, info) \ + /* no WSTK_DEF_STACK(s), read-only */ \ + ErtsWStack s = { \ + info->bitstore_start, /* wstart */ \ + NULL, /* wsp, read-only */ \ + NULL, /* wend, read-only */ \ + info->bitstore_alloc_type /* alloc_type */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_SHTABLE_INIT_INFO(s, info) \ + Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \ + ErtsEStack s = { \ + ESTK_DEF_STACK(s), /* start */ \ + ESTK_DEF_STACK(s), /* sp */ \ + ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + }; \ + Uint ESTK_CONCAT(s,_offset) = 0 + +#define DECLARE_SHTABLE_FROM_INFO(s, info) \ + /* no ESTK_DEF_STACK(s), read-only */ \ + ErtsEStack s = { \ + info->shtable_start, /* start */ \ + NULL, /* sp, read-only */ \ + NULL, /* end, read-only */ \ + info->shtable_alloc_type /* alloc_type */ \ + }; \ + /* no ESTK_CONCAT(s,_offset), read-only */ + +/* + * Copy object "obj" preserving sharing. + * First half: count size and calculate sharing. + * NOTE: We do not support HALF_WORD (yet?). + */ +Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) +{ + Uint sum; + Uint e; + unsigned sz; + Eterm* ptr; + Process* myself; + int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF; + + DECLARE_EQUEUE_INIT_INFO(s, info); + DECLARE_BITSTORE_INIT_INFO(b, info); + DECLARE_SHTABLE_INIT_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return 0; + + myself = erts_get_current_process(); + if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) + return size_object(obj); + + VERBOSE_DEBUG("[pid=%T] copy_shared_calculate %p\n", myself->common.id, obj); + VERBOSE_DEBUG("[pid=%T] message is %T\n", myself->common.id, obj); + + /* step #1: + ------------------------------------------------------- + traverse the term and calculate the size; + when traversing, transform as you do in size_shared + but when you find shared objects: + + a. add entry in the table, indexed by i + b. mark them: + b1. boxed terms, set header to (i | 11) + store (old header, NONV, NULL, backptr) in the entry + b2. cons cells, set CDR to NONV, set CAR to i + store (old CAR, old CDR, NULL, backptr) in the entry + */ + + sum = 0; + + for (;;) { + VERBOSE_DEBUG("[copy] visiting: %x ", obj); + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + VERBOSE_DEBUG("L"); + ptr = list_val_rel(obj, base); + /* off heap list pointers are copied verbatim */ + if (!INHEAP(myself, ptr)) { + VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj); + if (myself->mbuf != NULL) + VERBOSE_DEBUG("[pid=%T] BUT !!! there are message buffers!\n", myself->common.id); + VERBOSE_DEBUG("#"); + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("!"); + if (tail != THE_NON_VALUE) { + e = SHTABLE_NEXT(t); + VERBOSE_DEBUG("[pid=%T] tabling L %p\n", myself->common.id, ptr); + SHTABLE_PUSH(t, head, tail, ptr); + CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED; + CDR(ptr) = THE_NON_VALUE; + } + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + VERBOSE_DEBUG("/L"); + VERBOSE_DEBUG("[pid=%T] mangling L/L %p\n", myself->common.id, ptr); + CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + VERBOSE_DEBUG("/I"); + VERBOSE_DEBUG("[pid=%T] mangling L/I %p\n", myself->common.id, ptr); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + VERBOSE_DEBUG("/B saved %d", primary_tag(head)); + BITSTORE_PUT(b, primary_tag(head)); + VERBOSE_DEBUG("[pid=%T] mangling L/B %p\n", myself->common.id, ptr); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + VERBOSE_DEBUG("B"); + ptr = boxed_val_rel(obj, base); + /* off heap pointers to boxes are copied verbatim */ + if (!INHEAP(myself, ptr)) { + VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj); + VERBOSE_DEBUG("#"); + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("!"); + if (primary_tag(hdr) == BOXED_VISITED) { + e = SHTABLE_NEXT(t); + VERBOSE_DEBUG("[pid=%T] tabling B %p\n", myself->common.id, ptr); + SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr); + *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED; + } + goto pop_next; + } + /* else make it visited now */ + VERBOSE_DEBUG("[pid=%T] mangling B %p\n", myself->common.id, ptr); + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + VERBOSE_DEBUG("/T"); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + VERBOSE_DEBUG("e"); + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + VERBOSE_DEBUG("/F"); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + size_t size = sb->size; + Uint extra_bytes; + Eterm hdr; + if (bit_size + bit_offset > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (bit_size + bit_offset > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ASSERT(is_boxed(rterm2wterm(real_bin, base)) && + (((*boxed_val(rterm2wterm(real_bin, base))) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + hdr = *_unchecked_binary_val(rterm2wterm(real_bin, base)) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { + sum += heap_bin_size(size+extra_bytes); + } else { + ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG); + sum += PROC_BIN_SIZE; + } + goto pop_next; + } + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + VERBOSE_DEBUG("/D"); + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + VERBOSE_DEBUG("I"); + pop_next: + if (EQUEUE_ISEMPTY(s)) { + VERBOSE_DEBUG("\n"); + // add sentinel to the table + SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); + // store persistent info + BITSTORE_CLOSE(b); + info->queue_start = s.start; + info->queue_end = s.end; + info->queue_alloc_type = s.alloc_type; + info->bitstore_start = b.wstart; + info->bitstore_alloc_type = b.alloc_type; + info->shtable_start = t.start; + info->shtable_alloc_type = t.alloc_type; + // single point of return: the size of the object + VERBOSE_DEBUG("[pid=%T] size was: %u\n", myself->common.id, sum); + return sum; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj); + } + VERBOSE_DEBUG("\n"); + } +} + + +/* + * Copy object "obj" preserving sharing. + * Second half: copy and restore the object. + * NOTE: We do not support HALF_WORD (yet?). + */ +Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, ErlOffHeap* off_heap, unsigned flags) +{ + Uint e; + unsigned sz; + Eterm* ptr; + Eterm* hp; + Eterm* hscan; + Eterm result; + Eterm* resp; + unsigned remaining; + Process* myself; + int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF; +#if defined(DEBUG) || defined(SHCOPY_DEBUG) + Eterm saved_obj = obj; +#endif + + DECLARE_EQUEUE_FROM_INFO(s, info); + DECLARE_BITSTORE_FROM_INFO(b, info); + DECLARE_SHTABLE_FROM_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return obj; + + myself = erts_get_current_process(); + if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) + return copy_struct(obj, size, hpp, off_heap); + + VERBOSE_DEBUG("[pid=%T] copy_shared_perform %p\n", myself->common.id, obj); + + /* step #2: was performed before this function was called + ------------------------------------------------------- + allocate new space + */ + + hscan = hp = *hpp; + + /* step #3: + ------------------------------------------------------- + traverse the term a second time and when traversing: + a. if the object is marked as shared + a1. if the entry contains a forwarding ptr, use that + a2. otherwise, copy it to the new space and store the + forwarding ptr to the entry + b. otherwise, reverse-transform as you do in size_shared + and copy to the new space + */ + + resp = &result; + remaining = 0; + for (;;) { + VERBOSE_DEBUG("[copy] revisiting: %x ", obj); + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + VERBOSE_DEBUG("L"); + ptr = list_val_rel(obj, base); + /* off heap list pointers are copied verbatim */ + if (!INHEAP(myself, ptr)) { + VERBOSE_DEBUG("#"); + *resp = obj; + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it is shared */ + if (tail == THE_NON_VALUE) { + e = head >> _TAG_PRIMARY_SIZE; + /* if it has been processed, just use the forwarding pointer */ + if (primary_tag(head) == LIST_SHARED_PROCESSED) { + VERBOSE_DEBUG("!"); + *resp = make_list(SHTABLE_FWD(t, e)); + goto cleanup_next; + } + /* else, let's process it now, + copy it and keep the forwarding pointer */ + else { + VERBOSE_DEBUG("$"); + CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED; + head = SHTABLE_X(t, e); + tail = SHTABLE_Y(t, e); + ptr = &(SHTABLE_X(t, e)); + VERBOSE_DEBUG("[pid=%T] tabled L %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e)); + SHTABLE_FWD_UPD(t, e, hp); + } + } + /* if not already clean, clean it up and copy it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved = BITSTORE_GET(b); + VERBOSE_DEBUG("/B restoring %d", saved); + VERBOSE_DEBUG("[pid=%T] unmangling L/B %p\n", myself->common.id, ptr); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; + } else { + VERBOSE_DEBUG("/L"); + VERBOSE_DEBUG("[pid=%T] unmangling L/L %p\n", myself->common.id, ptr); + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE_DEBUG("/I"); + VERBOSE_DEBUG("[pid=%T] unmangling L/I %p\n", myself->common.id, ptr); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + ASSERT(0 && "cannot come here"); + goto cleanup_next; + } + /* and its children too */ + if (IS_CONST(head)) { + CAR(hp) = head; + } else { + EQUEUE_PUT_UNCHECKED(s, head); + CAR(hp) = HEAP_ELEM_TO_BE_FILLED; + } + *resp = make_list(hp); + resp = &(CDR(hp)); + hp += 2; + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + VERBOSE_DEBUG("B"); + ptr = boxed_val_rel(obj, base); + /* off heap pointers to boxes are copied verbatim */ + if (!INHEAP(myself, ptr)) { + VERBOSE_DEBUG("#"); + *resp = obj; + goto cleanup_next; + } + hdr = *ptr; + /* clean it up, unless it's already clean or shared and processed */ + switch (primary_tag(hdr)) { + case TAG_PRIMARY_HEADER: + ASSERT(0 && "cannot come here"); + /* if it is shared and has been processed, + just use the forwarding pointer */ + case BOXED_SHARED_PROCESSED: + VERBOSE_DEBUG("!"); + e = hdr >> _TAG_PRIMARY_SIZE; + *resp = make_boxed(SHTABLE_FWD(t, e)); + goto cleanup_next; + /* if it is shared but has not been processed yet, let's process + it now: copy it and keep the forwarding pointer */ + case BOXED_SHARED_UNPROCESSED: + e = hdr >> _TAG_PRIMARY_SIZE; + VERBOSE_DEBUG("$"); + *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED; + hdr = SHTABLE_X(t, e); + ASSERT(primary_tag(hdr) == BOXED_VISITED); + VERBOSE_DEBUG("[pid=%T] tabled B %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e)); + VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr); + SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + SHTABLE_FWD_UPD(t, e, hp); + break; + case BOXED_VISITED: + VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + break; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + while (arity-- > 0) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + funp = (ErlFunThing *) hp; + *resp = make_fun(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + while (eterms-- > 0) { + obj = *ptr++; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + funp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) funp; + erts_refc_inc(&funp->fe->refc, 2); + goto cleanup_next; + } + case REFC_BINARY_SUBTAG: { + ProcBin* pb = (ProcBin *) ptr; + sz = thing_arityval(hdr); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + pb = (ProcBin *) hp; + *resp = make_binary(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + erts_refc_inc(&pb->val->refc, 2); + pb->next = off_heap->first; + pb->flags = 0; + off_heap->first = (struct erl_off_heap_header*) pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); + goto cleanup_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + Uint offset = sb->offs; + size_t size = sb->size; + Uint extra_bytes; + Uint real_size; + if ((bit_size + bit_offset) > 8) { + extra_bytes = 2; + } else if ((bit_size + bit_offset) > 0) { + extra_bytes = 1; + } else { + extra_bytes = 0; + } + real_size = size+extra_bytes; + ASSERT(is_boxed(rterm2wterm(real_bin, base)) && + (((*boxed_val(rterm2wterm(real_bin, base))) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + ptr = _unchecked_binary_val(rterm2wterm(real_bin, base)); + *resp = make_binary(hp); + if (extra_bytes != 0) { + ErlSubBin* res = (ErlSubBin *) hp; + hp += ERL_SUB_BIN_SIZE; + res->thing_word = HEADER_SUB_BIN; + res->size = size; + res->bitsize = bit_size; + res->bitoffs = bit_offset; + res->offs = 0; + res->is_writable = 0; + res->orig = make_binary(hp); + } + if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) { + ErlHeapBin* from = (ErlHeapBin *) ptr; + ErlHeapBin* to = (ErlHeapBin *) hp; + hp += heap_bin_size(real_size); + to->thing_word = header_heap_bin(real_size); + to->size = real_size; + sys_memcpy(to->data, ((byte *)from->data)+offset, real_size); + } else { + ProcBin* from = (ProcBin *) ptr; + ProcBin* to = (ProcBin *) hp; + ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG); + if (from->flags) { + erts_emasculate_writable_binary(from); + } + hp += PROC_BIN_SIZE; + to->thing_word = HEADER_PROC_BIN; + to->size = real_size; + to->val = from->val; + erts_refc_inc(&to->val->refc, 2); + to->bytes = from->bytes + offset; + to->next = off_heap->first; + to->flags = 0; + off_heap->first = (struct erl_off_heap_header*) to; + OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); + } + goto cleanup_next; + } + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: { + ExternalThing *etp = (ExternalThing *) hp; + sz = thing_arityval(hdr); + *resp = make_external(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + etp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) etp; + erts_refc_inc(&etp->node->refc, 2); + goto cleanup_next; + } + default: + sz = thing_arityval(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + *resp = obj; + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + for (;;) { + ASSERT(hscan < hp); + if (remaining == 0) { + if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan; + hscan += 2; + break; /* scanning loop */ + } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) { + switch (*hscan & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + remaining = header_arity(*hscan); + hscan++; + break; + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) hscan; + hscan += 1 + thing_arityval(*hscan); + remaining = 1 + funp->num_free; + break; + } + case SUB_BINARY_SUBTAG: + ASSERT(((ErlSubBin *) hscan)->bitoffs + + ((ErlSubBin *) hscan)->bitsize > 0); + hscan += ERL_SUB_BIN_SIZE; + break; + default: + hscan += 1 + thing_arityval(*hscan); + break; + } + } else { + hscan++; + } + } else if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan++; + remaining--; + break; /* scanning loop */ + } else { + hscan++; + remaining--; + } + } + ASSERT(resp < hp); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + VERBOSE_DEBUG("\n"); + } + + /* step #4: + ------------------------------------------------------- + traverse the table and reverse-transform all stored entries + */ + +all_clean: + VERBOSE_DEBUG("\n"); + for (e = 0; ; e += SHTABLE_INCR) { + ptr = SHTABLE_REV(t, e); + if (ptr == NULL) + break; + VERBOSE_DEBUG("[copy] restoring shared: %x\n", ptr); + /* entry was a list */ + if (SHTABLE_Y(t, e) != THE_NON_VALUE) { + VERBOSE_DEBUG("[pid=%T] untabling L %p\n", myself->common.id, ptr); + CAR(ptr) = SHTABLE_X(t, e); + CDR(ptr) = SHTABLE_Y(t, e); + } + /* entry was boxed */ + else { + VERBOSE_DEBUG("[pid=%T] untabling B %p\n", myself->common.id, ptr); + *ptr = SHTABLE_X(t, e); + ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER); + } + } + +#ifdef DEBUG + if (eq(saved_obj, result) == 0) { + erts_fprintf(stderr, "original = %T\n", saved_obj); + erts_fprintf(stderr, "copy = %T\n", result); + erl_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n"); + } +#endif + + VERBOSE_DEBUG("[pid=%T] original was %T\n", myself->common.id, saved_obj); + VERBOSE_DEBUG("[pid=%T] copy is %T\n", myself->common.id, result); + VERBOSE_DEBUG("[pid=%T] result is at %p\n", myself->common.id, result); + + ASSERT(hp == *hpp + size); + *hpp = hp; + return result; +} + + /* * Copy a term that is guaranteed to be contained in a single * heap block. The heap block is copied word by word, and any diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6cb37752bc..ec96a7563a 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -42,6 +42,8 @@ #include "dtrace-wrapper.h" #include "erl_bif_unique.h" +#undef SHCOPY_DEBUG + #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 @@ -1166,6 +1168,10 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; +#ifdef SHCOPY_DEBUG + VERBOSE_DEBUG("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); +#endif + n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); @@ -1383,6 +1389,10 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, Uint new_sz, stk_sz; int adjusted; +#ifdef SHCOPY_DEBUG + VERBOSE_DEBUG("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); +#endif + /* * Do a fullsweep GC. First figure out the size of the heap * to receive all live data. diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 20f100b427..d99f6548f9 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -919,8 +919,9 @@ do { \ #define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty) #define EQUEUE_GET(q) ({ \ + UWord x; \ q.possibly_empty = 1; \ - UWord x = *(q.front); \ + x = *(q.front); \ if (++(q.front) == q.end) { \ q.front = q.start; \ } \ @@ -1035,11 +1036,64 @@ __decl_noreturn void __noreturn erl_exit(int n, char*, ...); __decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...); void erl_error(char*, va_list); +/* This controls whether sharing-preserving copy is used by Erlang */ + +#define SHCOPY_SEND +#define SHCOPY_SPAWN + +#if defined(SHCOPY_SEND) \ + || defined(SHCOPY_SPAWN) +#define SHCOPY +/* Use this with care, it is *very* verbose! */ +#undef SHCOPY_DEBUG +#endif + +#define VERBOSE_DEBUG(...) do { \ + erts_fprintf(stderr, __VA_ARGS__); \ + } while(0) + +#define ERTS_SHCOPY_FLG_MASK (((unsigned) 3) << 0) +#define ERTS_SHCOPY_FLG_NONE (((unsigned) 1) << 0) +#define ERTS_SHCOPY_FLG_TMP_BUF (((unsigned) 1) << 1) + +/* The persistent state while the sharing-preserving copier works */ + +typedef struct shcopy_info { + Eterm queue_default[DEF_EQUEUE_SIZE]; + Eterm* queue_start; + Eterm* queue_end; + ErtsAlcType_t queue_alloc_type; + UWord bitstore_default[DEF_WSTACK_SIZE]; + UWord* bitstore_start; + ErtsAlcType_t bitstore_alloc_type; + Eterm shtable_default[DEF_ESTACK_SIZE]; + Eterm* shtable_start; + ErtsAlcType_t shtable_alloc_type; +} shcopy_info; + +#define DESTROY_INFO(info) \ +do { \ + if (info.queue_start != info.queue_default) { \ + erts_free(info.queue_alloc_type, info.queue_start); \ + } \ + if (info.bitstore_start != info.bitstore_default) { \ + erts_free(info.bitstore_alloc_type, info.bitstore_start); \ + } \ + if (info.shtable_start != info.shtable_default) { \ + erts_free(info.shtable_alloc_type, info.shtable_start); \ + } \ +} while(0) + /* copy.c */ Eterm copy_object_x(Eterm, Process*, Uint); #define copy_object(Term, Proc) copy_object_x(Term,Proc,0) Uint size_object(Eterm); +Uint copy_shared_calculate(Eterm, shcopy_info*, unsigned); +Eterm copy_shared_perform(Eterm, Uint, shcopy_info*, Eterm**, ErlOffHeap*, unsigned); + +Uint size_shared(Eterm); + Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); -- cgit v1.2.3 From cfe998988c942bed0fbf026c00a2531fdf5aba7c Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Sat, 9 Jun 2012 00:19:28 +0300 Subject: Add the BIF size_shared/1 and debug cleanup --- erts/emulator/beam/beam_debug.c | 14 ++++++++++++++ erts/emulator/beam/bif.tab | 12 +++++++----- erts/emulator/beam/erl_gc.c | 2 -- erts/emulator/beam/global.h | 4 ++++ lib/kernel/src/erts_debug.erl | 9 ++++++++- 5 files changed, 33 insertions(+), 8 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index e989310789..40e3f4db4e 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -73,6 +73,20 @@ erts_debug_flat_size_1(BIF_ALIST_1) } } +BIF_RETTYPE +erts_debug_size_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size = size_shared(term); + + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} BIF_RETTYPE erts_debug_breakpoint_2(BIF_ALIST_2) diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 65f8d6f1f5..f45f886395 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -639,14 +639,16 @@ bif ets:update_counter/4 bif erts_debug:map_info/1 # -# Obsolete +# New in 19.0 # -bif erlang:hash/2 +bif binary:split/2 +bif binary:split/3 +bif erts_debug:size_shared/1 +bif 'erl.system.debug':size_shared/1 ebif_erts_debug_size_shared_1 # -# New in 19.0 +# Obsolete # -bif binary:split/2 -bif binary:split/3 +bif erlang:hash/2 diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index ec96a7563a..1cf6509012 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -42,8 +42,6 @@ #include "dtrace-wrapper.h" #include "erl_bif_unique.h" -#undef SHCOPY_DEBUG - #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index d99f6548f9..c2056dafaa 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1048,9 +1048,13 @@ void erl_error(char*, va_list); #undef SHCOPY_DEBUG #endif +#ifdef SHCOPY_DEBUG #define VERBOSE_DEBUG(...) do { \ erts_fprintf(stderr, __VA_ARGS__); \ } while(0) +#else +#define VERBOSE_DEBUG(...) +#endif #define ERTS_SHCOPY_FLG_MASK (((unsigned) 3) << 0) #define ERTS_SHCOPY_FLG_NONE (((unsigned) 1) << 0) diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 39308c0043..5e1cc09e7d 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -34,7 +34,8 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, - map_info/1, same/2, set_internal_state/2]). + map_info/1, same/2, set_internal_state/2, + size_shared/1]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -86,6 +87,12 @@ dump_links(_) -> flat_size(_) -> erlang:nif_error(undef). +-spec size_shared(Term) -> non_neg_integer() when + Term :: term(). + +size_shared(_) -> + erlang:nif_error(undef). + -spec get_internal_state(W) -> term() when W :: reds_left | node_and_dist_references | monitoring_nodes | next_pid | 'DbTable_words' | check_io_debug -- cgit v1.2.3 From f3ae60838a5e8c83cfdd3000e25562dfcbbd438d Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Sat, 9 Jun 2012 01:12:50 +0300 Subject: Enable shcopy for sending messages --- erts/emulator/beam/erl_db.c | 4 +- erts/emulator/beam/erl_message.c | 114 +++++++++++++++++++++++++-------------- erts/emulator/beam/erl_message.h | 5 ++ erts/emulator/beam/global.h | 7 +++ 4 files changed, 87 insertions(+), 43 deletions(-) diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 9ec14ab5ae..6119a9225f 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1832,7 +1832,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) tb->common.id, from_pid, BIF_ARG_3), - 0); + ERTS_SND_FLG_SHCOPY_TMP_BUF); erts_smp_proc_unlock(to_proc, to_locks); UnUseTmpHeap(5,BIF_P); BIF_RET(am_true); @@ -3211,7 +3211,7 @@ retry: tb->common.id, p->common.id, heir_data), - 0); + ERTS_SND_FLG_SHCOPY_TMP_BUF); erts_smp_proc_unlock(to_proc, to_locks); return !0; } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 79739501a8..b1fca1df0c 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -68,6 +68,9 @@ new_message_buffer(Uint size) bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(size)); ERTS_INIT_HEAP_FRAG(bp, size, size); +#ifdef SHCOPY_DEBUG + VERBOSE_DEBUG("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem); +#endif return bp; } @@ -248,36 +251,6 @@ erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_s return nmp; } -void -erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) -{ - if (first_bp) { - ErlHeapFragment *bp = first_bp; - - while (1) { - /* Move any off_heap's into the process */ - if (bp->off_heap.first != NULL) { - struct erl_off_heap_header** next_p = &bp->off_heap.first; - while (*next_p != NULL) { - next_p = &((*next_p)->next); - } - *next_p = MSO(proc).first; - MSO(proc).first = bp->off_heap.first; - bp->off_heap.first = NULL; - OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); - } - MBUF_SIZE(proc) += bp->used_size; - if (!bp->next) - break; - bp = bp->next; - } - - /* Link the message buffer */ - bp->next = MBUF(proc); - MBUF(proc) = first_bp; - } -} - void erts_queue_dist_message(Process *rcvr, ErtsProcLocks *rcvr_locks, @@ -540,6 +513,36 @@ erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, ); } +void +erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) +{ + if (first_bp) { + ErlHeapFragment *bp = first_bp; + + while (1) { + /* Move any off_heap's into the process */ + if (bp->off_heap.first != NULL) { + struct erl_off_heap_header** next_p = &bp->off_heap.first; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).first; + MSO(proc).first = bp->off_heap.first; + bp->off_heap.first = NULL; + OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); + } + MBUF_SIZE(proc) += bp->used_size; + if (!bp->next) + break; + bp = bp->next; + } + + /* Link the message buffer */ + bp->next = MBUF(proc); + MBUF(proc) = first_bp; + } +} + Uint erts_msg_attached_data_size_aux(ErtsMessage *msg) { @@ -663,11 +666,15 @@ erts_send_message(Process* sender, Eterm utag = NIL; #endif erts_aint32_t receiver_state; +#ifdef SHCOPY_SEND + unsigned shflags = (flags & ERTS_SND_FLG_SHCOPY_MASK) >> ERTS_SND_FLG_SHCOPY_SHIFT; + erts_shcopy_t info; +#endif BM_STOP_TIMER(system); BM_MESSAGE(message,sender,receiver); BM_START_TIMER(send); - #ifdef USE_VM_PROBES +#ifdef USE_VM_PROBES *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send)) { erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), @@ -686,15 +693,23 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES Uint dt_utag_size = 0; #endif - +#ifdef SHCOPY_SEND + unsigned shflags = (flags & ERTS_SND_FLG_SHCOPY_MASK) >> ERTS_SND_FLG_SHCOPY_SHIFT; + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); +#endif BM_SWAP_TIMER(send,size); - msize = size_object(message); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info, shflags); +#else + msize = size_object(message); +#endif BM_SWAP_TIMER(size,send); #ifdef USE_VM_PROBES if (stoken != am_have_dt_utag) { #endif - seq_trace_update_send(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); @@ -720,14 +735,20 @@ erts_send_message(Process* sender, &ohp); BM_SWAP_TIMER(send,copy); + +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp, shflags); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); +#endif if (is_immed(stoken)) token = stoken; else token = copy_struct(stoken, seq_trace_size, &hp, ohp); - if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); - #ifdef USE_VM_PROBES if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { if (is_immed(DT_UTAG(sender))) @@ -764,7 +785,12 @@ erts_send_message(Process* sender, } else { BM_SWAP_TIMER(send,size); - msize = size_object(message); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info, shflags); +#else + msize = size_object(message); +#endif BM_SWAP_TIMER(size,send); mp = erts_alloc_message_heap_state(receiver, @@ -774,8 +800,14 @@ erts_send_message(Process* sender, &hp, &ohp); BM_SWAP_TIMER(send,copy); - if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp, shflags); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); +#endif BM_MESSAGE_COPIED(msz); BM_SWAP_TIMER(copy,send); } @@ -800,6 +832,7 @@ erts_send_message(Process* sender, return res; } + /* * This function delivers an EXIT message to a process * which is trapping EXITs. @@ -1725,4 +1758,3 @@ void erts_factory_undo(ErtsHeapFactory* factory) factory->heap_frags = NULL; #endif } - diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 740ae46a0f..0de36c3199 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -238,6 +238,11 @@ do { \ #define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) +#define ERTS_SND_FLG_SHCOPY_SHIFT 1 +#define ERTS_SND_FLG_SHCOPY_MASK (ERTS_SHCOPY_FLG_MASK << ERTS_SND_FLG_SHCOPY_SHIFT) +#define ERTS_SND_FLG_SHCOPY_NONE (ERTS_SHCOPY_FLG_NONE << ERTS_SND_FLG_SHCOPY_SHIFT) +#define ERTS_SND_FLG_SHCOPY_TMP_BUF (ERTS_SHCOPY_FLG_TMP_BUF << ERTS_SND_FLG_SHCOPY_SHIFT) + #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index c2056dafaa..a5e6ff6f1c 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1075,6 +1075,13 @@ typedef struct shcopy_info { ErtsAlcType_t shtable_alloc_type; } shcopy_info; +#define INITIALIZE_INFO(info) \ +do { \ + info.queue_start = info.queue_default; \ + info.bitstore_start = info.bitstore_default; \ + info.shtable_start = info.shtable_default; \ +} while(0) + #define DESTROY_INFO(info) \ do { \ if (info.queue_start != info.queue_default) { \ -- cgit v1.2.3 From 7141fa8e4534ab7e4dcc3cad6c46872efa0e6e66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 17 Nov 2015 14:44:52 +0100 Subject: Remove DTrace Harddebug clutter --- erts/emulator/beam/beam_emu.c | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 208a16dfd0..af97cba61c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1914,20 +1914,7 @@ void process_main(void) if (DT_UTAG(c_p) != NIL) { if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; -#ifdef DTRACE_TAG_HARDDEBUG - if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) - erts_fprintf(stderr, - "Dtrace -> (%T) stop spreading " - "tag %T with message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif } else { -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) kill tag %T with " - "message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif DT_UTAG(c_p) = NIL; SEQ_TRACE_TOKEN(c_p) = NIL; } @@ -1947,12 +1934,6 @@ void process_main(void) DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); } DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) receive tag (%T) " - "with message %T\r\n", - c_p->common.id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp)); -#endif } else { #endif ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); -- cgit v1.2.3 From 8d02ad60c88aa060ff83ff3179bc8c0ab66868ee Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Fri, 14 Mar 2014 11:32:46 +0200 Subject: Add machinery to enable SHCOPY dynamically This commit is just for debugging purposes, will probably be reverted. It comes with a the erts_debug:copy_shared/1 BIF. If SHCOPY_DISABLE is defined, SHCOPY starts disabled and is dynamically enabled the first time that the BIF is called. --- erts/emulator/beam/beam_debug.c | 26 ++++++++++++++++++++++++++ erts/emulator/beam/copy.c | 12 ++++++++++++ erts/emulator/beam/global.h | 2 ++ lib/kernel/src/erts_debug.erl | 8 +++++++- 4 files changed, 47 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 40e3f4db4e..36f3cfabbc 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -88,6 +88,32 @@ erts_debug_size_shared_1(BIF_ALIST_1) } } +BIF_RETTYPE +erts_debug_copy_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size; + Eterm* hp; + Eterm copy; + shcopy_info info; +#ifdef SHCOPY_DISABLE + extern int disable_copy_shared; +#endif + INITIALIZE_INFO(info); + + size = copy_shared_calculate(term, &info, 0); + if (size > 0) { + hp = HAlloc(p, size); + } + copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap, 0); + DESTROY_INFO(info); +#ifdef SHCOPY_DISABLE + disable_copy_shared = 0; +#endif + BIF_RET(copy); +} + BIF_RETTYPE erts_debug_breakpoint_2(BIF_ALIST_2) { diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index b31e043f08..2566707717 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -901,6 +901,10 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) * Using an ESTACK but not very transparently; consider refactoring */ +#ifdef SHCOPY_DISABLE +int disable_copy_shared = ERTS_SHCOPY_FLG_NONE; +#endif + #define DECLARE_SHTABLE(s) \ DECLARE_ESTACK(s); \ Uint ESTK_CONCAT(s,_offset) = 0 @@ -1028,6 +1032,10 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) if (IS_CONST(obj)) return 0; +#ifdef SHCOPY_DISABLE + flags |= disable_copy_shared; +#endif + myself = erts_get_current_process(); if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) return size_object(obj); @@ -1276,6 +1284,10 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E if (IS_CONST(obj)) return obj; +#ifdef SHCOPY_DISABLE + flags |= disable_copy_shared; +#endif + myself = erts_get_current_process(); if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) return copy_struct(obj, size, hpp, off_heap); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index a5e6ff6f1c..3e1f3664bc 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1044,6 +1044,8 @@ void erl_error(char*, va_list); #if defined(SHCOPY_SEND) \ || defined(SHCOPY_SPAWN) #define SHCOPY +/* Use this if you want sharing-preserving copy to be initially disabled */ +#undef SHCOPY_DISABLE /* Use this with care, it is *very* verbose! */ #undef SHCOPY_DEBUG #endif diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 5e1cc09e7d..87f001fdf4 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -35,7 +35,7 @@ dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, map_info/1, same/2, set_internal_state/2, - size_shared/1]). + size_shared/1, copy_shared/1]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -93,6 +93,12 @@ flat_size(_) -> size_shared(_) -> erlang:nif_error(undef). +-spec copy_shared(Term) -> term() when + Term :: term(). + +copy_shared(_) -> + erlang:nif_error(undef). + -spec get_internal_state(W) -> term() when W :: reds_left | node_and_dist_references | monitoring_nodes | next_pid | 'DbTable_words' | check_io_debug -- cgit v1.2.3 From 244e9d5855d1b1f160d667b5cf369defee72829d Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Sat, 9 Jun 2012 01:37:29 +0300 Subject: Enable shcopy for spawning processes --- erts/emulator/beam/erl_process.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9acce8acb6..f2da5289d3 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10747,6 +10747,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm res = THE_NON_VALUE; erts_aint32_t state = 0; erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; +#ifdef SHCOPY_SPAWN + unsigned shflags = 0; /* could be taken from so->flags, if necessary */ + shcopy_info info; + INITIALIZE_INFO(info); +#endif #ifdef ERTS_SMP erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); @@ -10798,7 +10803,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_COUNT(processes_spawned); BM_SWAP_TIMER(system,size); +#ifdef SHCOPY_SPAWN + arg_size = copy_shared_calculate(args, &info, shflags); +#else arg_size = size_object(args); +#endif BM_SWAP_TIMER(size,system); heap_need = arg_size; @@ -10876,7 +10885,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_MESSAGE(args,p,parent); BM_START_TIMER(system); BM_SWAP_TIMER(system,copy); +#ifdef SHCOPY_SPAWN + p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap, shflags); + DESTROY_INFO(info); +#else p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); +#endif BM_MESSAGE_COPIED(arg_size); BM_SWAP_TIMER(copy,system); p->arity = 3; @@ -11260,6 +11274,8 @@ static void delete_process(Process* p) { VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); + VERBOSE_DEBUG("[pid=%T] delete process: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); /* Cleanup psd */ -- cgit v1.2.3 From 277e8e77384ed6628009243e63d62f0555d10c69 Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Mon, 11 Jun 2012 15:17:01 +0300 Subject: Add -debug +vc flag for debuging SHCOPY This is very verbose, you have been warned. It should work with the copy-spy.py script, which may be a bit outdated. --- erts/emulator/beam/copy.c | 131 ++++++++++----------------------------- erts/emulator/beam/erl_debug.h | 1 + erts/emulator/beam/erl_gc.c | 10 ++- erts/emulator/beam/erl_init.c | 2 + erts/emulator/beam/erl_message.c | 4 +- erts/emulator/beam/erl_process.c | 4 +- erts/emulator/beam/global.h | 10 --- 7 files changed, 43 insertions(+), 119 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 2566707717..f74c6b1c89 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -75,16 +75,13 @@ Uint size_object(Eterm obj) Uint sum = 0; Eterm* ptr; int arity; -#ifdef SHCOPY_DEBUG - Eterm mypid; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); #endif DECLARE_ESTACK(s); -#ifdef SHCOPY_DEBUG - mypid = erts_get_current_pid(); - VERBOSE_DEBUG("[pid=%T] size_object %p\n", mypid, obj); -#endif + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size_object %p\n", mypid, obj)); for (;;) { switch (primary_tag(obj)) { @@ -220,7 +217,7 @@ Uint size_object(Eterm obj) pop_next: if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); - VERBOSE_DEBUG("[pid=%T] size was: %u\n", mypid, sum); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); return sum; } obj = ESTACK_POP(s); @@ -320,11 +317,9 @@ Uint size_shared(Eterm obj) return size_object(obj); for (;;) { - VERBOSE_DEBUG("[size] visiting: %x ", obj); switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - VERBOSE_DEBUG("L"); ptr = list_val_rel(obj, base); /* we're not counting anything that's outside our heap */ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { @@ -335,22 +330,18 @@ Uint size_shared(Eterm obj) /* if it's visited, don't count it */ if (primary_tag(tail) == TAG_PRIMARY_HEADER || primary_tag(head) == TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("!"); goto pop_next; } /* else make it visited now */ switch (primary_tag(tail)) { case TAG_PRIMARY_LIST: - VERBOSE_DEBUG("/L"); ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; break; case TAG_PRIMARY_IMMED1: - VERBOSE_DEBUG("/I"); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); break; case TAG_PRIMARY_BOXED: - VERBOSE_DEBUG("/B saved %d", primary_tag(head)); BITSTORE_PUT(b, primary_tag(head)); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; @@ -366,7 +357,6 @@ Uint size_shared(Eterm obj) } case TAG_PRIMARY_BOXED: { Eterm hdr; - VERBOSE_DEBUG("B"); ptr = boxed_val_rel(obj, base); /* we're not counting anything that's outside our heap */ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { @@ -375,7 +365,6 @@ Uint size_shared(Eterm obj) hdr = *ptr; /* if it's visited, don't count it */ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("!"); goto pop_next; } /* else make it visited now */ @@ -385,10 +374,8 @@ Uint size_shared(Eterm obj) switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int arity = header_arity(hdr); - VERBOSE_DEBUG("/T"); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ - VERBOSE_DEBUG("e"); goto pop_next; } while (arity-- > 0) { @@ -403,7 +390,6 @@ Uint size_shared(Eterm obj) ErlFunThing* funp = (ErlFunThing *) ptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); - VERBOSE_DEBUG("/F"); sum += 1 /* header */ + sz + eterms; ptr += 1 /* header */ + sz; while (eterms-- > 0) { @@ -442,14 +428,12 @@ Uint size_shared(Eterm obj) erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); default: - VERBOSE_DEBUG("/D"); sum += thing_arityval(hdr) + 1; goto pop_next; } break; } case TAG_PRIMARY_IMMED1: - VERBOSE_DEBUG("I"); pop_next: if (EQUEUE_ISEMPTY(s)) { goto cleanup; @@ -459,19 +443,15 @@ Uint size_shared(Eterm obj) default: erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); } - VERBOSE_DEBUG("\n"); } cleanup: - VERBOSE_DEBUG("\n"); obj = saved_obj; BITSTORE_CLOSE(b); for (;;) { - VERBOSE_DEBUG("[size] revisiting: %x ", obj); switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - VERBOSE_DEBUG("L"); ptr = list_val_rel(obj, base); if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto cleanup_next; @@ -482,19 +462,15 @@ cleanup: if (primary_tag(tail) == TAG_PRIMARY_HEADER) { if (primary_tag(head) == TAG_PRIMARY_HEADER) { Eterm saved = BITSTORE_GET(b); - VERBOSE_DEBUG("/B restoring %d", saved); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved; CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED; } else { - VERBOSE_DEBUG("/L"); CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST; } } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("/I"); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; } else { - VERBOSE_DEBUG("!"); goto cleanup_next; } /* and its children too */ @@ -506,7 +482,6 @@ cleanup: } case TAG_PRIMARY_BOXED: { Eterm hdr; - VERBOSE_DEBUG("B"); ptr = boxed_val_rel(obj, base); if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto cleanup_next; @@ -563,11 +538,9 @@ cleanup: default: erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); } - VERBOSE_DEBUG("\n"); } all_clean: - VERBOSE_DEBUG("\n"); /* Return the result */ DESTROY_EQUEUE(s); DESTROY_BITSTORE(b); @@ -597,18 +570,13 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) #ifdef DEBUG Eterm org_obj = obj; Uint org_sz = sz; -#endif -#ifdef SHCOPY_DEBUG - Eterm mypid; + Eterm mypid = erts_get_current_pid(); #endif if (IS_CONST(obj)) return obj; -#ifdef SHCOPY_DEBUG - mypid = erts_get_current_pid(); - VERBOSE_DEBUG("[pid=%T] copy_struct %p\n", mypid, obj); -#endif + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj)); DTRACE1(copy_struct, (int32_t)sz); @@ -891,7 +859,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } #endif *hpp = (Eterm *) (hstart+hsize); - VERBOSE_DEBUG("[pid=%T] result is at %p\n", mypid, res); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res)); return res; } @@ -1040,8 +1008,8 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) return size_object(obj); - VERBOSE_DEBUG("[pid=%T] copy_shared_calculate %p\n", myself->common.id, obj); - VERBOSE_DEBUG("[pid=%T] message is %T\n", myself->common.id, obj); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", myself->common.id, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", myself->common.id, obj)); /* step #1: ------------------------------------------------------- @@ -1060,18 +1028,13 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) sum = 0; for (;;) { - VERBOSE_DEBUG("[copy] visiting: %x ", obj); switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - VERBOSE_DEBUG("L"); ptr = list_val_rel(obj, base); /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { - VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj); - if (myself->mbuf != NULL) - VERBOSE_DEBUG("[pid=%T] BUT !!! there are message buffers!\n", myself->common.id); - VERBOSE_DEBUG("#"); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); goto pop_next; } head = CAR(ptr); @@ -1080,10 +1043,9 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) if not already shared, make it shared and store it in the table */ if (primary_tag(tail) == TAG_PRIMARY_HEADER || primary_tag(head) == TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("!"); if (tail != THE_NON_VALUE) { e = SHTABLE_NEXT(t); - VERBOSE_DEBUG("[pid=%T] tabling L %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", myself->common.id, ptr)); SHTABLE_PUSH(t, head, tail, ptr); CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED; CDR(ptr) = THE_NON_VALUE; @@ -1093,20 +1055,17 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) /* else make it visited now */ switch (primary_tag(tail)) { case TAG_PRIMARY_LIST: - VERBOSE_DEBUG("/L"); - VERBOSE_DEBUG("[pid=%T] mangling L/L %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", myself->common.id, ptr)); CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; break; case TAG_PRIMARY_IMMED1: - VERBOSE_DEBUG("/I"); - VERBOSE_DEBUG("[pid=%T] mangling L/I %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", myself->common.id, ptr)); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); break; case TAG_PRIMARY_BOXED: - VERBOSE_DEBUG("/B saved %d", primary_tag(head)); BITSTORE_PUT(b, primary_tag(head)); - VERBOSE_DEBUG("[pid=%T] mangling L/B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", myself->common.id, ptr)); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; break; @@ -1121,39 +1080,34 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } case TAG_PRIMARY_BOXED: { Eterm hdr; - VERBOSE_DEBUG("B"); ptr = boxed_val_rel(obj, base); /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { - VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj); - VERBOSE_DEBUG("#"); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); goto pop_next; } hdr = *ptr; /* if it's visited, don't count it; if not already shared, make it shared and store it in the table */ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("!"); if (primary_tag(hdr) == BOXED_VISITED) { e = SHTABLE_NEXT(t); - VERBOSE_DEBUG("[pid=%T] tabling B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", myself->common.id, ptr)); SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr); *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED; } goto pop_next; } /* else make it visited now */ - VERBOSE_DEBUG("[pid=%T] mangling B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", myself->common.id, ptr)); *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; /* and count it */ ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int arity = header_arity(hdr); - VERBOSE_DEBUG("/T"); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ - VERBOSE_DEBUG("e"); goto pop_next; } while (arity-- > 0) { @@ -1168,7 +1122,6 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) ErlFunThing* funp = (ErlFunThing *) ptr; unsigned eterms = 1 /* creator */ + funp->num_free; sz = thing_arityval(hdr); - VERBOSE_DEBUG("/F"); sum += 1 /* header */ + sz + eterms; ptr += 1 /* header */ + sz; while (eterms-- > 0) { @@ -1213,17 +1166,14 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); default: - VERBOSE_DEBUG("/D"); sum += thing_arityval(hdr) + 1; goto pop_next; } break; } case TAG_PRIMARY_IMMED1: - VERBOSE_DEBUG("I"); pop_next: if (EQUEUE_ISEMPTY(s)) { - VERBOSE_DEBUG("\n"); // add sentinel to the table SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); // store persistent info @@ -1236,7 +1186,7 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) info->shtable_start = t.start; info->shtable_alloc_type = t.alloc_type; // single point of return: the size of the object - VERBOSE_DEBUG("[pid=%T] size was: %u\n", myself->common.id, sum); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", myself->common.id, sum)); return sum; } obj = EQUEUE_GET(s); @@ -1244,7 +1194,6 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) default: erl_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj); } - VERBOSE_DEBUG("\n"); } } @@ -1266,7 +1215,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E unsigned remaining; Process* myself; int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF; -#if defined(DEBUG) || defined(SHCOPY_DEBUG) +#ifdef DEBUG Eterm saved_obj = obj; #endif @@ -1292,7 +1241,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) return copy_struct(obj, size, hpp, off_heap); - VERBOSE_DEBUG("[pid=%T] copy_shared_perform %p\n", myself->common.id, obj); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", myself->common.id, obj)); /* step #2: was performed before this function was called ------------------------------------------------------- @@ -1315,15 +1264,12 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E resp = &result; remaining = 0; for (;;) { - VERBOSE_DEBUG("[copy] revisiting: %x ", obj); switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - VERBOSE_DEBUG("L"); ptr = list_val_rel(obj, base); /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { - VERBOSE_DEBUG("#"); *resp = obj; goto cleanup_next; } @@ -1334,19 +1280,17 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E e = head >> _TAG_PRIMARY_SIZE; /* if it has been processed, just use the forwarding pointer */ if (primary_tag(head) == LIST_SHARED_PROCESSED) { - VERBOSE_DEBUG("!"); *resp = make_list(SHTABLE_FWD(t, e)); goto cleanup_next; } /* else, let's process it now, copy it and keep the forwarding pointer */ else { - VERBOSE_DEBUG("$"); CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED; head = SHTABLE_X(t, e); tail = SHTABLE_Y(t, e); ptr = &(SHTABLE_X(t, e)); - VERBOSE_DEBUG("[pid=%T] tabled L %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e))); SHTABLE_FWD_UPD(t, e, hp); } } @@ -1354,18 +1298,15 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E if (primary_tag(tail) == TAG_PRIMARY_HEADER) { if (primary_tag(head) == TAG_PRIMARY_HEADER) { Eterm saved = BITSTORE_GET(b); - VERBOSE_DEBUG("/B restoring %d", saved); - VERBOSE_DEBUG("[pid=%T] unmangling L/B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", myself->common.id, ptr)); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; } else { - VERBOSE_DEBUG("/L"); - VERBOSE_DEBUG("[pid=%T] unmangling L/L %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", myself->common.id, ptr)); CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; } } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { - VERBOSE_DEBUG("/I"); - VERBOSE_DEBUG("[pid=%T] unmangling L/I %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", myself->common.id, ptr)); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; } else { @@ -1387,11 +1328,9 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E } case TAG_PRIMARY_BOXED: { Eterm hdr; - VERBOSE_DEBUG("B"); ptr = boxed_val_rel(obj, base); /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { - VERBOSE_DEBUG("#"); *resp = obj; goto cleanup_next; } @@ -1403,7 +1342,6 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E /* if it is shared and has been processed, just use the forwarding pointer */ case BOXED_SHARED_PROCESSED: - VERBOSE_DEBUG("!"); e = hdr >> _TAG_PRIMARY_SIZE; *resp = make_boxed(SHTABLE_FWD(t, e)); goto cleanup_next; @@ -1411,17 +1349,16 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E it now: copy it and keep the forwarding pointer */ case BOXED_SHARED_UNPROCESSED: e = hdr >> _TAG_PRIMARY_SIZE; - VERBOSE_DEBUG("$"); *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED; hdr = SHTABLE_X(t, e); ASSERT(primary_tag(hdr) == BOXED_VISITED); - VERBOSE_DEBUG("[pid=%T] tabled B %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e)); - VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e))); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", myself->common.id, ptr)); SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; SHTABLE_FWD_UPD(t, e, hp); break; case BOXED_VISITED: - VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", myself->common.id, ptr)); *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; break; } @@ -1628,7 +1565,6 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E default: erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); } - VERBOSE_DEBUG("\n"); } /* step #4: @@ -1637,21 +1573,20 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E */ all_clean: - VERBOSE_DEBUG("\n"); for (e = 0; ; e += SHTABLE_INCR) { ptr = SHTABLE_REV(t, e); if (ptr == NULL) break; - VERBOSE_DEBUG("[copy] restoring shared: %x\n", ptr); + VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr)); /* entry was a list */ if (SHTABLE_Y(t, e) != THE_NON_VALUE) { - VERBOSE_DEBUG("[pid=%T] untabling L %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", myself->common.id, ptr)); CAR(ptr) = SHTABLE_X(t, e); CDR(ptr) = SHTABLE_Y(t, e); } /* entry was boxed */ else { - VERBOSE_DEBUG("[pid=%T] untabling B %p\n", myself->common.id, ptr); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", myself->common.id, ptr)); *ptr = SHTABLE_X(t, e); ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER); } @@ -1665,9 +1600,9 @@ all_clean: } #endif - VERBOSE_DEBUG("[pid=%T] original was %T\n", myself->common.id, saved_obj); - VERBOSE_DEBUG("[pid=%T] copy is %T\n", myself->common.id, result); - VERBOSE_DEBUG("[pid=%T] result is at %p\n", myself->common.id, result); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", myself->common.id, saved_obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", myself->common.id, result)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", myself->common.id, result)); ASSERT(hp == *hpp + size); *hpp = hp; diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h index f4259e7dae..029320691d 100644 --- a/erts/emulator/beam/erl_debug.h +++ b/erts/emulator/beam/erl_debug.h @@ -48,6 +48,7 @@ #define DEBUG_THREADS 0x0010 /* Thread-related stuff */ #define DEBUG_PROCESSES 0x0020 /* Process creation and removal */ #define DEBUG_MEMORY 0x0040 /* Display results of memory checks */ +#define DEBUG_SHCOPY 0x0080 /* Sharing-preserving copying of terms */ extern Uint32 verbose; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 1cf6509012..c50756d56b 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1166,9 +1166,8 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; -#ifdef SHCOPY_DEBUG - VERBOSE_DEBUG("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); -#endif + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); @@ -1387,9 +1386,8 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, Uint new_sz, stk_sz; int adjusted; -#ifdef SHCOPY_DEBUG - VERBOSE_DEBUG("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); -#endif + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); /* * Do a fullsweep GC. First figure out the size of the heap diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index f396a0a156..296cfdabc3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -1401,6 +1401,7 @@ erl_start(int argc, char **argv) case 't': verbose |= DEBUG_THREADS; break; case 'p': verbose |= DEBUG_PROCESSES; break; case 'm': verbose |= DEBUG_MESSAGES; break; + case 'c': verbose |= DEBUG_SHCOPY; break; default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch); } } @@ -1413,6 +1414,7 @@ erl_start(int argc, char **argv) if (verbose & DEBUG_THREADS) erts_printf("THREADS "); if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES "); if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES "); + if (verbose & DEBUG_SHCOPY) erts_printf("SHCOPY "); erts_printf("\n"); #else erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n"); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index b1fca1df0c..11890a756d 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -68,9 +68,7 @@ new_message_buffer(Uint size) bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(size)); ERTS_INIT_HEAP_FRAG(bp, size, size); -#ifdef SHCOPY_DEBUG - VERBOSE_DEBUG("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem); -#endif + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem)); return bp; } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f2da5289d3..96d17306a5 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11274,8 +11274,8 @@ static void delete_process(Process* p) { VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); - VERBOSE_DEBUG("[pid=%T] delete process: %p %p %p %p\n", p->common.id, - HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); /* Cleanup psd */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3e1f3664bc..303b9ee51b 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1046,16 +1046,6 @@ void erl_error(char*, va_list); #define SHCOPY /* Use this if you want sharing-preserving copy to be initially disabled */ #undef SHCOPY_DISABLE -/* Use this with care, it is *very* verbose! */ -#undef SHCOPY_DEBUG -#endif - -#ifdef SHCOPY_DEBUG -#define VERBOSE_DEBUG(...) do { \ - erts_fprintf(stderr, __VA_ARGS__); \ - } while(0) -#else -#define VERBOSE_DEBUG(...) #endif #define ERTS_SHCOPY_FLG_MASK (((unsigned) 3) << 0) -- cgit v1.2.3 From eebdde01b149ea45966c7412bc2a062136457b54 Mon Sep 17 00:00:00 2001 From: Yiannis Tsiouris Date: Tue, 22 Jan 2013 18:16:33 +0200 Subject: Add --enable-sharing-preserving configure flag --- configure.in | 4 ++++ erts/configure.in | 12 ++++++++++++ erts/emulator/beam/erl_bif_info.c | 3 +++ erts/emulator/beam/global.h | 5 +---- 4 files changed, 20 insertions(+), 4 deletions(-) diff --git a/configure.in b/configure.in index e8c8680e19..51728a847e 100644 --- a/configure.in +++ b/configure.in @@ -278,6 +278,10 @@ AC_ARG_ENABLE(builtin-zlib, AS_HELP_STRING([--enable-builtin-zlib], [force use of our own built-in zlib])) +AC_ARG_ENABLE(sharing-preserving, +AS_HELP_STRING([--enable-sharing-preserving], + [enable copying of terms without destroying sharing])) + dnl This functionality has been lost along the way... :( dnl It could perhaps be nice to reintroduce some day; therefore, dnl it is not removed just commented out. diff --git a/erts/configure.in b/erts/configure.in index 2419925c33..9ad1588b6c 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -788,6 +788,18 @@ esac AC_SUBST(LIBCARBON) +dnl Check if we should/can build a sharing-preserving emulator + +AC_MSG_CHECKING(if we are building a sharing-preserving emulator) +if test "$enable_sharing_preserving" = "yes"; then + AC_DEFINE(SHCOPY, [1], + [Define if building a sharing-preserving emulator]) + AC_MSG_RESULT([yes]) +else + AC_MSG_RESULT([no]) +fi + + dnl some tests below will call this if we haven't already - and autoconf dnl can't handle those tests being done conditionally at runtime AC_PROG_CPP diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 1eb106a551..82c2aa4b9e 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -129,6 +129,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #endif #ifdef USE_SYSTEMTAP " [systemtap]" +#endif +#ifdef SHCOPY + " [sharing-preserving]" #endif "\n"); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 303b9ee51b..3c59df5f41 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1038,12 +1038,9 @@ void erl_error(char*, va_list); /* This controls whether sharing-preserving copy is used by Erlang */ +#ifdef SHCOPY #define SHCOPY_SEND #define SHCOPY_SPAWN - -#if defined(SHCOPY_SEND) \ - || defined(SHCOPY_SPAWN) -#define SHCOPY /* Use this if you want sharing-preserving copy to be initially disabled */ #undef SHCOPY_DISABLE #endif -- cgit v1.2.3 From bcdf32795a3f5a6aad95567cffba78fcecb9f40f Mon Sep 17 00:00:00 2001 From: "Nikolaos S. Papaspyrou" Date: Thu, 24 Apr 2014 12:59:39 +0300 Subject: Add support for maps in preserved copy --- erts/emulator/beam/copy.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index f74c6b1c89..cb1f38429a 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -424,6 +424,19 @@ Uint size_shared(Eterm obj) } goto pop_next; } + case MAP_SUBTAG: { + map_t *mp = (map_t *) ptr; + Uint n = map_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); @@ -523,6 +536,18 @@ cleanup: } goto cleanup_next; } + case MAP_SUBTAG: { + map_t *mp = (map_t *) ptr; + Uint n = map_get_size(mp) + 1; + ptr += 2; /* hdr + size words */ + while (n-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } default: goto cleanup_next; } @@ -1162,6 +1187,19 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } goto pop_next; } + case MAP_SUBTAG: { + map_t *mp = (map_t *) ptr; + Uint n = map_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); @@ -1404,6 +1442,23 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E erts_refc_inc(&funp->fe->refc, 2); goto cleanup_next; } + case MAP_SUBTAG: { + map_t *mp = (map_t *) ptr; + Uint n = map_get_size(mp) + 1; + *resp = make_map(hp); + *hp++ = hdr; + *hp++ = *++ptr; + while (n-- > 0) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } case REFC_BINARY_SUBTAG: { ProcBin* pb = (ProcBin *) ptr; sz = thing_arityval(hdr); @@ -1539,6 +1594,12 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E remaining = 1 + funp->num_free; break; } + case MAP_SUBTAG: { + map_t *mp = (map_t *) hscan; + remaining = map_get_size(mp) + 1; + hscan += 2; + break; + } case SUB_BINARY_SUBTAG: ASSERT(((ErlSubBin *) hscan)->bitoffs + ((ErlSubBin *) hscan)->bitsize > 0); -- cgit v1.2.3 From 99de9eb01d8884ac293fdda20ab65c045d215d46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 15 Sep 2015 17:47:36 +0200 Subject: Fix internal stacks The internal stacks has changed between releases. --- erts/emulator/beam/copy.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index cb1f38429a..added85b46 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -907,7 +907,7 @@ int disable_copy_shared = ERTS_SHCOPY_FLG_NONE; #define SHTABLE_PUSH(s,x,y,b) \ do { \ if (s.sp > s.end - SHTABLE_INCR) { \ - erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + erl_grow_estack(&(s), SHTABLE_INCR); \ } \ *s.sp++ = (x); \ *s.sp++ = (y); \ @@ -959,6 +959,7 @@ do { \ WSTK_DEF_STACK(s), /* wstart */ \ WSTK_DEF_STACK(s), /* wsp */ \ WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \ + WSTK_DEF_STACK(s), /* wdflt */ \ ERTS_ALC_T_ESTACK /* alloc_type */ \ }; \ int WSTK_CONCAT(s,_bitoffs) = 0; \ @@ -969,8 +970,9 @@ do { \ /* no WSTK_DEF_STACK(s), read-only */ \ ErtsWStack s = { \ info->bitstore_start, /* wstart */ \ - NULL, /* wsp, read-only */ \ + NULL, /* wsp, read-only */ \ NULL, /* wend, read-only */ \ + NULL, /* wdef, read-only */ \ info->bitstore_alloc_type /* alloc_type */ \ }; \ int WSTK_CONCAT(s,_bitoffs) = 0; \ @@ -983,6 +985,7 @@ do { \ ESTK_DEF_STACK(s), /* start */ \ ESTK_DEF_STACK(s), /* sp */ \ ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \ + ESTK_DEF_STACK(s), /* default */ \ ERTS_ALC_T_ESTACK /* alloc_type */ \ }; \ Uint ESTK_CONCAT(s,_offset) = 0 @@ -991,8 +994,9 @@ do { \ /* no ESTK_DEF_STACK(s), read-only */ \ ErtsEStack s = { \ info->shtable_start, /* start */ \ - NULL, /* sp, read-only */ \ + NULL, /* sp, read-only */ \ NULL, /* end, read-only */ \ + NULL, /* def, read-only */ \ info->shtable_alloc_type /* alloc_type */ \ }; \ /* no ESTK_CONCAT(s,_offset), read-only */ -- cgit v1.2.3 From 2ab76f7f1fe6ec4c94541ba5a2f0cd9dc1b9c79a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 15 Sep 2015 16:49:28 +0200 Subject: Fix Halfword removal Halfword is no longer present in the runtime system. --- erts/emulator/beam/copy.c | 40 +++++++++++++++++----------------------- 1 file changed, 17 insertions(+), 23 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index added85b46..42b4bee29d 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -298,11 +298,7 @@ do { \ * It is argued whether the size of subterms in constant pools * should be counted or not. */ -#if HALFWORD_HEAP -Uint size_shared_rel(Eterm obj, Eterm* base) -#else Uint size_shared(Eterm obj) -#endif { Eterm saved_obj = obj; Uint sum = 0; @@ -320,7 +316,7 @@ Uint size_shared(Eterm obj) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - ptr = list_val_rel(obj, base); + ptr = list_val(obj); /* we're not counting anything that's outside our heap */ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto pop_next; @@ -357,7 +353,7 @@ Uint size_shared(Eterm obj) } case TAG_PRIMARY_BOXED: { Eterm hdr; - ptr = boxed_val_rel(obj, base); + ptr = boxed_val(obj); /* we're not counting anything that's outside our heap */ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto pop_next; @@ -414,13 +410,13 @@ Uint size_shared(Eterm obj) } else { extra_bytes = 0; } - ptr = binary_val_rel(sb->orig, base); + ptr = binary_val(sb->orig); hdr = (*ptr) & ~BOXED_VISITED_MASK; if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG); - sum += heap_bin_size(binary_size_rel(obj, base) + extra_bytes); + sum += heap_bin_size(binary_size(obj) + extra_bytes); } goto pop_next; } @@ -465,7 +461,7 @@ cleanup: switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - ptr = list_val_rel(obj, base); + ptr = list_val(obj); if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto cleanup_next; } @@ -495,7 +491,7 @@ cleanup: } case TAG_PRIMARY_BOXED: { Eterm hdr; - ptr = boxed_val_rel(obj, base); + ptr = boxed_val(obj); if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { goto cleanup_next; } @@ -912,7 +908,7 @@ do { \ *s.sp++ = (x); \ *s.sp++ = (y); \ *s.sp++ = (Eterm) NULL; \ - *s.sp++ = (Eterm) (b); /* bad in HALF_WORD */ \ + *s.sp++ = (Eterm) (b); \ ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \ } while(0) #define SHTABLE_X(s,e) (s.start[e]) @@ -1004,7 +1000,6 @@ do { \ /* * Copy object "obj" preserving sharing. * First half: count size and calculate sharing. - * NOTE: We do not support HALF_WORD (yet?). */ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) { @@ -1060,7 +1055,7 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - ptr = list_val_rel(obj, base); + ptr = list_val(obj); /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); @@ -1109,7 +1104,7 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } case TAG_PRIMARY_BOXED: { Eterm hdr; - ptr = boxed_val_rel(obj, base); + ptr = boxed_val(obj); /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); @@ -1178,11 +1173,11 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } else { extra_bytes = 0; } - ASSERT(is_boxed(rterm2wterm(real_bin, base)) && - (((*boxed_val(rterm2wterm(real_bin, base))) & + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) == _TAG_HEADER_REFC_BIN)); - hdr = *_unchecked_binary_val(rterm2wterm(real_bin, base)) & ~BOXED_VISITED_MASK; + hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK; if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { sum += heap_bin_size(size+extra_bytes); } else { @@ -1243,7 +1238,6 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) /* * Copy object "obj" preserving sharing. * Second half: copy and restore the object. - * NOTE: We do not support HALF_WORD (yet?). */ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, ErlOffHeap* off_heap, unsigned flags) { @@ -1309,7 +1303,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; - ptr = list_val_rel(obj, base); + ptr = list_val(obj); /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { *resp = obj; @@ -1370,7 +1364,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E } case TAG_PRIMARY_BOXED: { Eterm hdr; - ptr = boxed_val_rel(obj, base); + ptr = boxed_val(obj); /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { *resp = obj; @@ -1500,11 +1494,11 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E extra_bytes = 0; } real_size = size+extra_bytes; - ASSERT(is_boxed(rterm2wterm(real_bin, base)) && - (((*boxed_val(rterm2wterm(real_bin, base))) & + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) == _TAG_HEADER_REFC_BIN)); - ptr = _unchecked_binary_val(rterm2wterm(real_bin, base)); + ptr = _unchecked_binary_val(real_bin); *resp = make_binary(hp); if (extra_bytes != 0) { ErlSubBin* res = (ErlSubBin *) hp; -- cgit v1.2.3 From 95b25f7a3a33c43912079af713bf1f386a764071 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 15 Sep 2015 17:36:22 +0200 Subject: Fix Map preserved sharing copy implementation The Map implementation has changed since initial preserved copy implementation. --- erts/emulator/beam/copy.c | 135 +++++++++++++++++++++++++++++----------------- 1 file changed, 85 insertions(+), 50 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 42b4bee29d..c7806ed8ff 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -420,19 +420,28 @@ Uint size_shared(Eterm obj) } goto pop_next; } - case MAP_SUBTAG: { - map_t *mp = (map_t *) ptr; - Uint n = map_get_size(mp) + 1; - sum += n + 2; - ptr += 2; /* hdr + size words */ - while (n-- > 0) { - obj = *ptr++; - if (!IS_CONST(obj)) { - EQUEUE_PUT(s, obj); + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t*)flatmap_val(obj); + Uint n = flatmap_get_size(mp) + 1; + ptr = (Eterm *)mp; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } - goto pop_next; - } case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); @@ -533,10 +542,10 @@ cleanup: goto cleanup_next; } case MAP_SUBTAG: { - map_t *mp = (map_t *) ptr; - Uint n = map_get_size(mp) + 1; + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; ptr += 2; /* hdr + size words */ - while (n-- > 0) { + while (n--) { obj = *ptr++; if (!IS_CONST(obj)) { EQUEUE_PUT_UNCHECKED(s, obj); @@ -1186,20 +1195,28 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } goto pop_next; } - case MAP_SUBTAG: { - map_t *mp = (map_t *) ptr; - Uint n = map_get_size(mp) + 1; - sum += n + 2; - ptr += 2; /* hdr + size words */ - while (n-- > 0) { - obj = *ptr++; - if (!IS_CONST(obj)) { - EQUEUE_PUT(s, obj); + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + default: + erl_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } - goto pop_next; - } - case BIN_MATCHSTATE_SUBTAG: + case BIN_MATCHSTATE_SUBTAG: erl_exit(ERTS_ABORT_EXIT, "size_shared: matchstate term not allowed"); default: @@ -1234,7 +1251,6 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } } - /* * Copy object "obj" preserving sharing. * Second half: copy and restore the object. @@ -1440,23 +1456,31 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E erts_refc_inc(&funp->fe->refc, 2); goto cleanup_next; } - case MAP_SUBTAG: { - map_t *mp = (map_t *) ptr; - Uint n = map_get_size(mp) + 1; - *resp = make_map(hp); - *hp++ = hdr; - *hp++ = *++ptr; - while (n-- > 0) { - obj = *++ptr; - if (IS_CONST(obj)) { - *hp++ = obj; - } else { - EQUEUE_PUT_UNCHECKED(s, obj); - *hp++ = HEAP_ELEM_TO_BE_FILLED; - } - } - goto cleanup_next; - } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + *resp = make_flatmap(hp); + *hp++ = hdr; + *hp++ = *++ptr; + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + default: + erl_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } case REFC_BINARY_SUBTAG: { ProcBin* pb = (ProcBin *) ptr; sz = thing_arityval(hdr); @@ -1592,12 +1616,23 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E remaining = 1 + funp->num_free; break; } - case MAP_SUBTAG: { - map_t *mp = (map_t *) hscan; - remaining = map_get_size(mp) + 1; - hscan += 2; - break; - } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(*hscan)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) hscan; + remaining = flatmap_get_size(mp) + 1; + hscan += 2; + break; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + default: + erl_exit(ERTS_ABORT_EXIT, + "copy_shared_perform: bad hashmap type %d\n", + MAP_HEADER_TYPE(*hscan)); + } + break; case SUB_BINARY_SUBTAG: ASSERT(((ErlSubBin *) hscan)->bitoffs + ((ErlSubBin *) hscan)->bitsize > 0); -- cgit v1.2.3 From 2e10fe29f61bbe3246902e8eaf1636dd6457979f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 16 Sep 2015 16:21:43 +0200 Subject: Add support for HAMT maps in preserved copy --- erts/emulator/beam/copy.c | 115 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 88 insertions(+), 27 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index c7806ed8ff..aa17713d07 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -438,7 +438,18 @@ Uint size_shared(Eterm obj) } case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : - case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } default: erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } @@ -541,18 +552,37 @@ cleanup: } goto cleanup_next; } - case MAP_SUBTAG: { - flatmap_t *mp = (flatmap_t *) ptr; - Uint n = flatmap_get_size(mp) + 1; - ptr += 2; /* hdr + size words */ - while (n--) { - obj = *ptr++; - if (!IS_CONST(obj)) { - EQUEUE_PUT_UNCHECKED(s, obj); + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; } + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } - goto cleanup_next; - } default: goto cleanup_next; } @@ -1212,7 +1242,22 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) } case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : - case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + + if (n == 0) { + goto pop_next; + } + while(n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } default: erl_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } @@ -1228,20 +1273,20 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) case TAG_PRIMARY_IMMED1: pop_next: if (EQUEUE_ISEMPTY(s)) { - // add sentinel to the table - SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); - // store persistent info - BITSTORE_CLOSE(b); - info->queue_start = s.start; - info->queue_end = s.end; + /* add sentinel to the table */ + SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); + /* store persistent info */ + BITSTORE_CLOSE(b); + info->queue_start = s.start; + info->queue_end = s.end; info->queue_alloc_type = s.alloc_type; - info->bitstore_start = b.wstart; + info->bitstore_start = b.wstart; info->bitstore_alloc_type = b.alloc_type; - info->shtable_start = t.start; + info->shtable_start = t.start; info->shtable_alloc_type = t.alloc_type; - // single point of return: the size of the object - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", myself->common.id, sum)); - return sum; + /* single point of return: the size of the object */ + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", myself->common.id, sum)); + return sum; } obj = EQUEUE_GET(s); break; @@ -1457,13 +1502,13 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E goto cleanup_next; } case MAP_SUBTAG: + *resp = make_flatmap(hp); + *hp++ = hdr; switch (MAP_HEADER_TYPE(hdr)) { case MAP_HEADER_TAG_FLATMAP_HEAD : { flatmap_t *mp = (flatmap_t *) ptr; Uint n = flatmap_get_size(mp) + 1; - *resp = make_flatmap(hp); - *hp++ = hdr; - *hp++ = *++ptr; + *hp++ = *++ptr; /* keys */ while (n--) { obj = *++ptr; if (IS_CONST(obj)) { @@ -1477,7 +1522,20 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E } case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : - case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + *hp++ = *++ptr; /* total map size */ + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } default: erl_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); } @@ -1627,6 +1685,9 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan)); + hscan += MAP_HEADER_ARITY(*hscan) + 1; + break; default: erl_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", -- cgit v1.2.3 From 748c73f1687b2375d4c607487f40036ba990c4c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 17 Sep 2015 16:17:10 +0200 Subject: Refactor copy sharing --- erts/emulator/beam/beam_debug.c | 6 +++--- erts/emulator/beam/copy.c | 10 ++++----- erts/emulator/beam/erl_db.c | 4 ++-- erts/emulator/beam/erl_message.h | 6 +++--- erts/emulator/beam/erl_process.c | 6 +++--- erts/emulator/beam/global.h | 46 ++++++++++++++++++++-------------------- 6 files changed, 39 insertions(+), 39 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 36f3cfabbc..b007d000bf 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -96,18 +96,18 @@ erts_debug_copy_shared_1(BIF_ALIST_1) Uint size; Eterm* hp; Eterm copy; - shcopy_info info; + erts_shcopy_t info; #ifdef SHCOPY_DISABLE extern int disable_copy_shared; #endif - INITIALIZE_INFO(info); + INITIALIZE_SHCOPY(info); size = copy_shared_calculate(term, &info, 0); if (size > 0) { hp = HAlloc(p, size); } copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap, 0); - DESTROY_INFO(info); + DESTROY_SHCOPY(info); #ifdef SHCOPY_DISABLE disable_copy_shared = 0; #endif diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index aa17713d07..f2dd73d862 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -1040,14 +1040,14 @@ do { \ * Copy object "obj" preserving sharing. * First half: count size and calculate sharing. */ -Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) +Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) { Uint sum; Uint e; unsigned sz; Eterm* ptr; Process* myself; - int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF; + int force_local = flags & ERTS_SHCOPY_FLG_TMPBUF; DECLARE_EQUEUE_INIT_INFO(s, info); DECLARE_BITSTORE_INIT_INFO(b, info); @@ -1300,8 +1300,8 @@ Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags) * Copy object "obj" preserving sharing. * Second half: copy and restore the object. */ -Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, ErlOffHeap* off_heap, unsigned flags) -{ +Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, + Eterm** hpp, ErlOffHeap* off_heap, Uint32 flags) { Uint e; unsigned sz; Eterm* ptr; @@ -1311,7 +1311,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, E Eterm* resp; unsigned remaining; Process* myself; - int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF; + int force_local = flags & ERTS_SHCOPY_FLG_TMPBUF; #ifdef DEBUG Eterm saved_obj = obj; #endif diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 6119a9225f..59a0c0b808 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1832,7 +1832,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) tb->common.id, from_pid, BIF_ARG_3), - ERTS_SND_FLG_SHCOPY_TMP_BUF); + ERTS_SND_FLG_SHCOPY_TMPBUF); erts_smp_proc_unlock(to_proc, to_locks); UnUseTmpHeap(5,BIF_P); BIF_RET(am_true); @@ -3211,7 +3211,7 @@ retry: tb->common.id, p->common.id, heir_data), - ERTS_SND_FLG_SHCOPY_TMP_BUF); + ERTS_SND_FLG_SHCOPY_TMPBUF); erts_smp_proc_unlock(to_proc, to_locks); return !0; } diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 0de36c3199..52a648fe0b 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -239,9 +239,9 @@ do { \ #define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) #define ERTS_SND_FLG_SHCOPY_SHIFT 1 -#define ERTS_SND_FLG_SHCOPY_MASK (ERTS_SHCOPY_FLG_MASK << ERTS_SND_FLG_SHCOPY_SHIFT) -#define ERTS_SND_FLG_SHCOPY_NONE (ERTS_SHCOPY_FLG_NONE << ERTS_SND_FLG_SHCOPY_SHIFT) -#define ERTS_SND_FLG_SHCOPY_TMP_BUF (ERTS_SHCOPY_FLG_TMP_BUF << ERTS_SND_FLG_SHCOPY_SHIFT) +#define ERTS_SND_FLG_SHCOPY_MASK (ERTS_SHCOPY_FLG_MASK << ERTS_SND_FLG_SHCOPY_SHIFT) +#define ERTS_SND_FLG_SHCOPY_NONE (ERTS_SHCOPY_FLG_NONE << ERTS_SND_FLG_SHCOPY_SHIFT) +#define ERTS_SND_FLG_SHCOPY_TMPBUF (ERTS_SHCOPY_FLG_TMPBUF << ERTS_SND_FLG_SHCOPY_SHIFT) #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 96d17306a5..a691a3c773 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10749,8 +10749,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; #ifdef SHCOPY_SPAWN unsigned shflags = 0; /* could be taken from so->flags, if necessary */ - shcopy_info info; - INITIALIZE_INFO(info); + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); #endif #ifdef ERTS_SMP @@ -10887,7 +10887,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_SWAP_TIMER(system,copy); #ifdef SHCOPY_SPAWN p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap, shflags); - DESTROY_INFO(info); + DESTROY_SHCOPY(info); #else p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); #endif diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3c59df5f41..bdee20969d 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1045,13 +1045,13 @@ void erl_error(char*, va_list); #undef SHCOPY_DISABLE #endif -#define ERTS_SHCOPY_FLG_MASK (((unsigned) 3) << 0) -#define ERTS_SHCOPY_FLG_NONE (((unsigned) 1) << 0) -#define ERTS_SHCOPY_FLG_TMP_BUF (((unsigned) 1) << 1) +#define ERTS_SHCOPY_FLG_MASK (((Uint32) 3) << 0) +#define ERTS_SHCOPY_FLG_NONE (((Uint32) 1) << 0) +#define ERTS_SHCOPY_FLG_TMPBUF (((Uint32) 1) << 1) /* forces INHEAP to true */ /* The persistent state while the sharing-preserving copier works */ -typedef struct shcopy_info { +typedef struct { Eterm queue_default[DEF_EQUEUE_SIZE]; Eterm* queue_start; Eterm* queue_end; @@ -1062,26 +1062,26 @@ typedef struct shcopy_info { Eterm shtable_default[DEF_ESTACK_SIZE]; Eterm* shtable_start; ErtsAlcType_t shtable_alloc_type; -} shcopy_info; +} erts_shcopy_t; -#define INITIALIZE_INFO(info) \ -do { \ - info.queue_start = info.queue_default; \ - info.bitstore_start = info.bitstore_default; \ - info.shtable_start = info.shtable_default; \ +#define INITIALIZE_SHCOPY(info) \ +do { \ + info.queue_start = info.queue_default; \ + info.bitstore_start = info.bitstore_default; \ + info.shtable_start = info.shtable_default; \ } while(0) -#define DESTROY_INFO(info) \ -do { \ - if (info.queue_start != info.queue_default) { \ - erts_free(info.queue_alloc_type, info.queue_start); \ - } \ - if (info.bitstore_start != info.bitstore_default) { \ - erts_free(info.bitstore_alloc_type, info.bitstore_start); \ - } \ - if (info.shtable_start != info.shtable_default) { \ - erts_free(info.shtable_alloc_type, info.shtable_start); \ - } \ +#define DESTROY_SHCOPY(info) \ +do { \ + if (info.queue_start != info.queue_default) { \ + erts_free(info.queue_alloc_type, info.queue_start); \ + } \ + if (info.bitstore_start != info.bitstore_default) { \ + erts_free(info.bitstore_alloc_type, info.bitstore_start); \ + } \ + if (info.shtable_start != info.shtable_default) { \ + erts_free(info.shtable_alloc_type, info.shtable_start); \ + } \ } while(0) /* copy.c */ @@ -1089,8 +1089,8 @@ Eterm copy_object_x(Eterm, Process*, Uint); #define copy_object(Term, Proc) copy_object_x(Term,Proc,0) Uint size_object(Eterm); -Uint copy_shared_calculate(Eterm, shcopy_info*, unsigned); -Eterm copy_shared_perform(Eterm, Uint, shcopy_info*, Eterm**, ErlOffHeap*, unsigned); +Uint copy_shared_calculate(Eterm, erts_shcopy_t*, Uint32); +Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*, Uint32); Uint size_shared(Eterm); -- cgit v1.2.3 From 5d2d888f368ba8ca0098d8bd9936ca9d67df7d3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 17 Sep 2015 19:30:08 +0200 Subject: Copy literals in copy sharing --- erts/emulator/beam/copy.c | 49 +++++++++++++++++++++++++++++---------------- erts/emulator/beam/global.h | 6 +++++- 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index f2dd73d862..4f4d20cb83 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -611,7 +611,7 @@ cleanup: /* * Copy a structure to a heap. */ -Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz) { char* hstart; Uint hsize; @@ -626,6 +626,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) Eterm* argp; Eterm* const_tuple; Eterm hdr; + Eterm *hend; int i; #ifdef DEBUG Eterm org_obj = obj; @@ -641,7 +642,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) DTRACE1(copy_struct, (int32_t)sz); hp = htop = *hpp; - hbot = htop + sz; + hbot = hend = htop + sz; hstart = (char *)htop; hsize = (char*) hbot - hstart; const_tuple = 0; @@ -906,19 +907,24 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } + if (bsz) { + *hpp = htop; + *bsz = hend - hbot; + } else { #ifdef DEBUG - if (htop != hbot) - erl_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct() when copying %T:" - " htop=%p != hbot=%p (sz=%beu)\n", - org_obj, htop, hbot, org_sz); + if (htop != hbot) + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct() when copying %T:" + " htop=%p != hbot=%p (sz=%beu)\n", + org_obj, htop, hbot, org_sz); #else - if (htop > hbot) { - erl_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct(): htop, hbot overrun\n"); - } + if (htop > hbot) { + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct(): htop, hbot overrun\n"); + } #endif - *hpp = (Eterm *) (hstart+hsize); + *hpp = (Eterm *) (hstart+hsize); + } VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res)); return res; } @@ -1098,6 +1104,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); + info->literal_size += size_object(obj); goto pop_next; } head = CAR(ptr); @@ -1147,6 +1154,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); + info->literal_size += size_object(obj); goto pop_next; } hdr = *ptr; @@ -1286,7 +1294,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) info->shtable_alloc_type = t.alloc_type; /* single point of return: the size of the object */ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", myself->common.id, sum)); - return sum; + return sum + info->literal_size; } obj = EQUEUE_GET(s); break; @@ -1309,6 +1317,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, Eterm* hscan; Eterm result; Eterm* resp; + Eterm *hbot, *hend; unsigned remaining; Process* myself; int force_local = flags & ERTS_SHCOPY_FLG_TMPBUF; @@ -1346,6 +1355,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, */ hscan = hp = *hpp; + hbot = hend = hp + size; /* step #3: ------------------------------------------------------- @@ -1367,7 +1377,9 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, ptr = list_val(obj); /* off heap list pointers are copied verbatim */ if (!INHEAP(myself, ptr)) { - *resp = obj; + Uint bsz; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; goto cleanup_next; } head = CAR(ptr); @@ -1428,7 +1440,9 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, ptr = boxed_val(obj); /* off heap pointers to boxes are copied verbatim */ if (!INHEAP(myself, ptr)) { - *resp = obj; + Uint bsz; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; goto cleanup_next; } hdr = *ptr; @@ -1759,8 +1773,9 @@ all_clean: VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", myself->common.id, result)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", myself->common.id, result)); - ASSERT(hp == *hpp + size); - *hpp = hp; + ASSERT(hbot == hp); + ASSERT(size == ((hp - *hpp) + (hend - hbot))); + *hpp = hend; return result; } diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index bdee20969d..f106b941ef 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1062,6 +1062,7 @@ typedef struct { Eterm shtable_default[DEF_ESTACK_SIZE]; Eterm* shtable_start; ErtsAlcType_t shtable_alloc_type; + Uint literal_size; } erts_shcopy_t; #define INITIALIZE_SHCOPY(info) \ @@ -1069,6 +1070,7 @@ do { \ info.queue_start = info.queue_default; \ info.bitstore_start = info.bitstore_default; \ info.shtable_start = info.shtable_default; \ + info.literal_size = 0; \ } while(0) #define DESTROY_SHCOPY(info) \ @@ -1094,7 +1096,9 @@ Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*, Uin Uint size_shared(Eterm); -Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); +Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint* bsz); +#define copy_struct(Obj,Sz,HPP,OH) \ + copy_struct_x(Obj,Sz,HPP,OH,NULL) Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, -- cgit v1.2.3 From 8f8aa9c5c4e26e563c935e06f8346175fa15d876 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 18 Sep 2015 19:20:19 +0200 Subject: Add BIF for setting internal copy literal range --- erts/emulator/beam/beam_bif_load.c | 104 ++++++++++++++++++++++++++++++++++--- erts/emulator/beam/bif.tab | 1 + 2 files changed, 99 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index c3ebf71a01..e61d9ab0a6 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -154,7 +154,7 @@ static struct /* Protected by code_write_permission */ { Process* stager; ErtsThrPrgrLaterOp lop; -}commiter_state; +} committer_state; #endif static Eterm @@ -367,9 +367,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, * schedulers to read active code_ix in a safe way while executing * without any memory barriers at all. */ - ASSERT(commiter_state.stager == NULL); - commiter_state.stager = c_p; - erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); + ASSERT(committer_state.stager == NULL); + committer_state.stager = c_p; + erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop); erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* @@ -385,11 +385,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, #ifdef ERTS_SMP static void smp_code_ix_commiter(void* null) { - Process* p = commiter_state.stager; + Process* p = committer_state.stager; erts_commit_staging_code_ix(); #ifdef DEBUG - commiter_state.stager = NULL; + committer_state.stager = NULL; #endif erts_release_code_write_permission(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); @@ -1007,6 +1007,98 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) return 0; } +#undef in_area + +#ifdef ERTS_SMP +static void copy_literals_commit(void*); +#endif + +typedef struct { + Eterm *ptr; + Uint sz; +} copy_literals_t; + +copy_literals_t erts_clrange = {NULL, 0}; + +/* copy literals + * + * copy_literals.ptr = LitPtr + * copy_literals.sz = LitSz + * ------ THR PROG COMMIT ----- + * + * - check process code + * - check process code + * ... + * copy_literals.ptr = NULL + * copy_literals.sz = 0 + * ------ THR PROG COMMIT ----- + * ... + */ + + +BIF_RETTYPE copy_literals_2(BIF_ALIST_2) +{ + Module* modp; + ErtsCodeIndex code_ix; + Eterm res = am_true; + + if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!erts_try_seize_code_write_permission(BIF_P)) { + ERTS_BIF_YIELD2(bif_export[BIF_copy_literals_2], BIF_P, BIF_ARG_1, BIF_ARG_2); + } + + code_ix = erts_active_code_ix(); + + if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL || !modp->old.code_hdr) { + res = am_false; + goto done; + } + + if (BIF_ARG_2 == am_true) { + if (erts_clrange.ptr != NULL) { + res = am_aborted; + goto done; + } + erts_clrange.ptr = (Eterm*) modp->old.code_hdr->literals_start; + erts_clrange.sz = (Eterm*) modp->old.code_hdr->literals_end - erts_clrange.ptr; + } else if (BIF_ARG_2 == am_false) { + erts_clrange.ptr = NULL; + erts_clrange.sz = 0; + } + +#ifdef ERTS_SMP + ASSERT(committer_state.stager == NULL); + committer_state.stager = BIF_P; + erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop); + erts_proc_inc_refc(BIF_P); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); +#endif +done: + erts_release_code_write_permission(); + BIF_RET(res); +} + +#ifdef ERTS_SMP +static void copy_literals_commit(void* null) { + Process* p = committer_state.stager; +#ifdef DEBUG + committer_state.stager = NULL; +#endif + erts_release_code_write_permission(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); +} +#endif /* ERTS_SMP */ + + BIF_RETTYPE purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index f45f886395..63a0d0b1f0 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -642,6 +642,7 @@ bif erts_debug:map_info/1 # New in 19.0 # +bif erlang:copy_literals/2 bif binary:split/2 bif binary:split/3 bif erts_debug:size_shared/1 -- cgit v1.2.3 From 1993f0c858c2274c431c5f025c89e18d34282a8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Nov 2015 10:38:07 +0100 Subject: epp: Modernize the internal data structures Use maps instead of 'dict'. Remove the {atom,MacroName} wrappers that were used for historical reasons. --- lib/stdlib/src/epp.erl | 211 +++++++++++++++++++++++++------------------------ 1 file changed, 107 insertions(+), 104 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 1d9762cfc7..0d3f725afe 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -40,7 +40,7 @@ -type ifdef() :: 'ifdef' | 'ifndef' | 'else'. --type name() :: {'atom', atom()}. +-type name() :: atom(). -type argspec() :: 'none' %No arguments | non_neg_integer(). %Number of arguments -type tokens() :: [erl_scan:token()]. @@ -58,21 +58,14 @@ 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()]}]), + macs = #{} %Macros (don't care locations) + :: #{name() => {argspec(), tokens()}}, + uses = #{} %Macro use structure + :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), pre_opened = false :: boolean() }). -%%% Note on representation: as tokens, both {var, Location, Name} and -%%% {atom, Location, Name} can occur as macro identifiers. However, keeping -%%% this distinction here is done for historical reasons only: previously, -%%% ?FOO and ?'FOO' were not the same, but now they are. Removing the -%%% distinction in the internal representation would simplify the code -%%% a little. - %% open(Options) %% open(FileName, IncludePath) %% open(FileName, IncludePath, PreDefMacros) @@ -561,18 +554,18 @@ init_server(Pid, Name, Options, St0) -> %% FILE, LINE, MODULE as undefined, MACHINE and MACHINE value. predef_macros(File) -> - Machine = list_to_atom(erlang:system_info(machine)), - Anno = line1(), - dict:from_list([ - {{atom,'FILE'}, {none,[{string,Anno,File}]}}, - {{atom,'LINE'}, {none,[{integer,Anno,1}]}}, - {{atom,'MODULE'}, undefined}, - {{atom,'MODULE_STRING'}, undefined}, - {{atom,'BASE_MODULE'}, undefined}, - {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}}, - {{atom,Machine}, {none,[{atom,Anno,true}]}} - ]). + Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), + Defs = [{'FILE', {none,[{string,Anno,File}]}}, + {'LINE', {none,[{integer,Anno,1}]}}, + {'MODULE', undefined}, + {'MODULE_STRING', undefined}, + {'BASE_MODULE', undefined}, + {'BASE_MODULE_STRING', undefined}, + {'MACHINE', {none,[{atom,Anno,Machine}]}}, + {Machine, {none,[{atom,Anno,true}]}} + ], + maps:from_list(Defs). %% user_predef(PreDefMacros, Macros) -> %% {ok,MacroDict} | {error,E} @@ -581,16 +574,18 @@ predef_macros(File) -> user_predef([{M,Val,redefine}|Pdm], Ms) when is_atom(M) -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, {none,Exp}, Ms)); + user_predef(Pdm, Ms#{M=>{none,Exp}}); user_predef([{M,Val}|Pdm], Ms) when is_atom(M) -> - case dict:find({atom,M}, Ms) of - {ok,_Defs} when is_list(_Defs) -> %% User defined macros + case Ms of + #{M:=Defs} when is_list(Defs) -> + %% User defined macros. {error,{redefine,M}}; - {ok,_Def} -> %% Predefined macros + #{M:=_Defs} -> + %% Predefined macros. {error,{redefine_predef,M}}; - error -> + _ -> Exp = erl_parse:tokens(erl_parse:abstract(Val)), - user_predef(Pdm, dict:store({atom,M}, [{none, {none,Exp}}], Ms)) + user_predef(Pdm, Ms#{M=>[{none,{none,Exp}}]}) end; user_predef([M|Pdm], Ms) when is_atom(M) -> user_predef([{M,true}|Pdm], Ms); @@ -607,7 +602,9 @@ wait_request(St) -> receive {epp_request,From,scan_erl_form} -> From; {epp_request,From,macro_defs} -> - epp_reply(From, dict:to_list(St#epp.macs)), + %% Return the old format to avoid any incompability issues. + Defs = [{{atom,K},V} || {K,V} <- maps:to_list(St#epp.macs)], + epp_reply(From, Defs), wait_request(St); {epp_request,From,close} -> close_file(St), @@ -659,7 +656,8 @@ enter_file(NewName, Inc, From, St) -> enter_file2(NewF, Pname, From, St0, AtLocation) -> Anno = erl_anno:new(AtLocation), enter_file_reply(From, Pname, Anno, AtLocation, code), - Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs), + Ms0 = St0#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,Pname}]}}, %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note @@ -711,9 +709,8 @@ leave_file(From, St) -> name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), Anno = erl_anno:new(CurrLoc), - Ms = dict:store({atom,'FILE'}, - {none,[{string,Anno,OldName2}]}, - St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,Anno,OldName2}]}}, NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of @@ -798,15 +795,14 @@ scan_module_1([{atom,_,_}=A,{',',L}|Ts], Ms) -> scan_module_1([A,{')',L}|Ts], Ms); scan_module_1([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> ModString = atom_to_list(A), - Ms = dict:store({atom,'MODULE'}, {none,[ModAtom]}, Ms0), - dict:store({atom,'MODULE_STRING'}, {none,[{string,Ln,ModString}]}, Ms); + Ms = Ms0#{'MODULE':={none,[ModAtom]}}, + Ms#{'MODULE_STRING':={none,[{string,Ln,ModString}]}}; scan_module_1(_Ts, Ms) -> Ms. scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> ModString = atom_to_list(A), - Ms = dict:store({atom,'BASE_MODULE'}, {none,[ModAtom]}, Ms0), - dict:store({atom,'BASE_MODULE_STRING'}, - {none,[{string,Ln,ModString}]}, Ms); + Ms = Ms0#{'BASE_MODULE':={none,[ModAtom]}}, + Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}}; scan_extends(_Ts, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) @@ -842,24 +838,23 @@ scan_define_1(_Toks, _Mac, Def, From, St) -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St). -scan_define_2(Arity, Def, {_,_,M}=Mac, From, St) -> - Key = {atom,M}, - case dict:find(Key, St#epp.macs) of - {ok,Defs} when is_list(Defs) -> +scan_define_2(Arity, Def, {_,_,Key}=Mac, From, #epp{macs=Ms}=St) -> + case Ms of + #{Key:=Defs} when is_list(Defs) -> %% User defined macros: can be overloaded case proplists:is_defined(Arity, Defs) of true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + epp_reply(From, {error,{loc(Mac),epp,{redefine,Key}}}), wait_req_scan(St); false -> - scan_define_cont(From, St, Key, Arity, Def) + scan_define_cont(From, St, Key, Defs, Arity, Def) end; - {ok,_PreDef} -> + #{Key:=_} -> %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,Key}}}), wait_req_scan(St); - error -> - scan_define_cont(From, St, Key, Arity, Def) + _ -> + scan_define_cont(From, St, Key, [], Arity, Def) end. %%% Detection of circular macro expansions (which would either keep @@ -871,11 +866,17 @@ scan_define_2(Arity, Def, {_,_,M}=Mac, From, St) -> %%% the information from St#epp.uses is traversed, and if a circularity %%% is detected, an error message is thrown. -scan_define_cont(F, St, M, Arity, Def) -> - Ms = dict:append_list(M, [{Arity, Def}], St#epp.macs), - try dict:append_list(M, [{Arity, macro_uses(Def)}], St#epp.uses) of +scan_define_cont(F, #epp{macs=Ms0}=St, M, Defs, Arity, Def) -> + Ms = Ms0#{M=>[{Arity,Def}|Defs]}, + try macro_uses(Def) of U -> - scan_toks(F, St#epp{uses=U, macs=Ms}) + Uses0 = St#epp.uses, + Val = [{Arity,U}|case Uses0 of + #{M:=UseList} -> UseList; + _ -> [] + end], + Uses = Uses0#{M=>Val}, + scan_toks(F, St#epp{uses=Uses,macs=Ms}) catch {error, Line, Reason} -> epp_reply(F, {error,{Line,epp,Reason}}), @@ -893,23 +894,23 @@ macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> Lm = loc(Atom), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> Lm = loc(Var), Arity = count_args(Rest, Lm, A), - [{{atom, A}, Arity} | macro_ref(Rest)]; + [{A,Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> macro_ref(Rest). %% scan_undef(Tokens, UndefToken, From, EppState) scan_undef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From, St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _Undef, From,St) -> - Macs = dict:erase({atom,M}, St#epp.macs), - Uses = dict:erase({atom,M}, St#epp.uses), + Macs = maps:remove(M, St#epp.macs), + Uses = maps:remove(M, St#epp.uses), scan_toks(From, St#epp{macs=Macs, uses=Uses}); scan_undef(_Toks, Undef, From, St) -> epp_reply(From, {error,{loc(Undef),epp,{bad,undef}}}), @@ -976,17 +977,17 @@ scan_include_lib(_Toks, Inc, From, St) -> %% Report a badly formed if[n]def test and then treat as undefined macro. scan_ifdef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> scan_toks(From, St#epp{istk=[ifdef|St#epp.istk]}); - error -> + _ -> skip_toks(From, St, [ifdef]) end; scan_ifdef(_Toks, IfDef, From, St) -> @@ -994,17 +995,17 @@ scan_ifdef(_Toks, IfDef, From, St) -> wait_req_skip(St, [ifdef]). scan_ifndef([{'(',_Llp},{atom,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef([{'(',_Llp},{var,_Lm,M},{')',_Lrp},{dot,_Ld}], _IfnD, From, St) -> - case dict:find({atom,M}, St#epp.macs) of - {ok,_Def} -> + case St#epp.macs of + #{M:=_Def} -> skip_toks(From, St, [ifndef]); - error -> + _ -> scan_toks(From, St#epp{istk=[ifndef|St#epp.istk]}) end; scan_ifndef(_Toks, IfnDef, From, St) -> @@ -1072,7 +1073,8 @@ scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, {dot,_Ld}], Tf, From, St) -> Anno = erl_anno:new(Ln), enter_file_reply(From, Name, Anno, loc(Tf), generated), - Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs), + Ms0 = St#epp.macs, + Ms = Ms0#{'FILE':={none,[{string,line1(),Name}]}}, Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), Delta = get_line(element(2, Tf))-Ln + St#epp.delta, @@ -1161,38 +1163,41 @@ macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). %% gets the same location as the macro call. expand_macros(MacT, M, Toks, Ms0) -> - {Ms, U} = Ms0, + {Ms,U} = Ms0, Lm = loc(MacT), Tinfo = element(2, MacT), case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> - check_uses([{{atom,M}, none}], [], U, Lm), - Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], dict:new()), Ms0), + check_uses([{M,none}], [], U, Lm), + Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), Ms0), expand_macros(Toks1++Toks, Ms0); {ok,{As,Exp}} -> - check_uses([{{atom,M}, length(As)}], [], U, Lm), - {Bs,Toks1} = bind_args(Toks, Lm, M, As, dict:new()), + check_uses([{M,length(As)}], [], U, Lm), + {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}), expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) end. expand_macro1(Lm, M, Toks, Ms) -> Arity = count_args(Toks, Lm, M), - case dict:find({atom,M}, Ms) of - error -> %% macro not found - throw({error,Lm,{undefined,M,Arity}}); - {ok, undefined} -> %% Predefined macro without definition + case Ms of + #{M:=undefined} -> + %% Predefined macro without definition. throw({error,Lm,{undefined,M,Arity}}); - {ok, [{none, Def}]} -> - {ok, Def}; - {ok, Defs} when is_list(Defs) -> - case proplists:get_value(Arity, Defs) of + #{M:=[{none,Def}]} -> + {ok,Def}; + #{M:=Defs} when is_list(Defs) -> + case proplists:get_value(Arity, Defs) of undefined -> throw({error,Lm,{mismatch,M}}); Def -> - {ok, Def} + {ok,Def} end; - {ok, PreDef} -> %% Predefined macro - {ok, PreDef} + #{M:=PreDef} -> + %% Predefined macro. + {ok,PreDef}; + _ -> + %% Macro not found. + throw({error,Lm,{undefined,M,Arity}}) end. check_uses([], _Anc, _U, _Lm) -> @@ -1200,7 +1205,7 @@ check_uses([], _Anc, _U, _Lm) -> check_uses([M|Rest], Anc, U, Lm) -> case lists:member(M, Anc) of true -> - {{_, Name},Arity} = M, + {Name,Arity} = M, throw({error,Lm,{circular,Name,Arity}}); false -> L = get_macro_uses(M, U), @@ -1209,11 +1214,11 @@ check_uses([M|Rest], Anc, U, Lm) -> end. get_macro_uses({M,Arity}, U) -> - case dict:find(M, U) of - error -> - []; - {ok, L} -> - proplists:get_value(Arity, L, proplists:get_value(none, L, [])) + case U of + #{M:=L} -> + proplists:get_value(Arity, L, proplists:get_value(none, L, [])); + _ -> + [] end. %% Macro expansion @@ -1264,7 +1269,7 @@ macro_args(_Toks, Lm, M, _As, _Bs) -> store_arg(L, M, _A, [], _Bs) -> throw({error,L,{mismatch,M}}); store_arg(_L, _M, A, Arg, Bs) -> - dict:store(A, Arg, Bs). + Bs#{A=>Arg}. %% count_args(Tokens, MacroLine, MacroName) %% Count the number of arguments in a macro call. @@ -1337,19 +1342,17 @@ macro_arg([], _E, Arg) -> %% and then the macro arguments, i.e. simulate textual expansion. expand_macro([{var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(Val, Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([{'?', _}, {'?', _}, {var,_Lv,V}|Ts], L, Rest, Bs) -> - case dict:find(V, Bs) of - {ok,Val} -> - %% lists:append(Val, expand_macro(Ts, L, Rest, Bs)); + case Bs of + #{V:=Val} -> expand_arg(stringify(Val, L), Ts, L, Rest, Bs); - error -> + _ -> [{var,L,V}|expand_macro(Ts, L, Rest, Bs)] end; expand_macro([T|Ts], L, Rest, Bs) -> -- cgit v1.2.3 From 1391715d8bbba315e1509e60e6245159a009bd9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 25 Sep 2015 17:03:02 +0200 Subject: Use copy literal range check in message passing and purging --- erts/emulator/beam/beam_bif_load.c | 5 -- erts/emulator/beam/copy.c | 136 ++++++++++++++++++------------------- erts/emulator/beam/global.h | 10 +++ lib/kernel/src/code_server.erl | 25 ++++--- 4 files changed, 90 insertions(+), 86 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index e61d9ab0a6..6b6c066211 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1013,11 +1013,6 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) static void copy_literals_commit(void*); #endif -typedef struct { - Eterm *ptr; - Uint sz; -} copy_literals_t; - copy_literals_t erts_clrange = {NULL, 0}; /* copy literals diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 4f4d20cb83..5bca3877b5 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -276,49 +276,35 @@ do { \ #define BOXED_SHARED_UNPROCESSED ((Eterm) 2) #define BOXED_SHARED_PROCESSED ((Eterm) 3) +#define COUNT_OFF_HEAP (0) -/* - * Is an object in the local heap of a process? - */ - -#define INHEAP_SIMPLE(p, ptr) ( \ - (OLD_HEAP(p) && OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p)) || \ - (HEAP_START(p) <= ptr && ptr < HEAP_END(p)) \ - ) -#define INHEAP(p, ptr) ( \ - INHEAP_SIMPLE(p, ptr) || \ - (force_local ? (force_local = 0, 1) : 0) \ - ) -#define COUNT_OFF_HEAP 0 - - +#define IN_LITERAL_PURGE_AREA(info, ptr) \ + ((info)->range_ptr && ( \ + (info)->range_ptr <= (ptr) && \ + (ptr) < ((info)->range_ptr + (info)->range_sz))) /* * Return the real size of an object and find sharing information * This currently returns the same as erts_debug:size/1. * It is argued whether the size of subterms in constant pools * should be counted or not. */ + Uint size_shared(Eterm obj) { Eterm saved_obj = obj; Uint sum = 0; Eterm* ptr; - Process* myself; DECLARE_EQUEUE(s); DECLARE_BITSTORE(b); - myself = erts_get_current_process(); - if (myself == NULL) - return size_object(obj); - for (;;) { switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: { Eterm head, tail; ptr = list_val(obj); /* we're not counting anything that's outside our heap */ - if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { goto pop_next; } head = CAR(ptr); @@ -355,7 +341,7 @@ Uint size_shared(Eterm obj) Eterm hdr; ptr = boxed_val(obj); /* we're not counting anything that's outside our heap */ - if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { goto pop_next; } hdr = *ptr; @@ -482,7 +468,7 @@ cleanup: case TAG_PRIMARY_LIST: { Eterm head, tail; ptr = list_val(obj); - if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { goto cleanup_next; } head = CAR(ptr); @@ -512,7 +498,7 @@ cleanup: case TAG_PRIMARY_BOXED: { Eterm hdr; ptr = boxed_val(obj); - if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) { + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { goto cleanup_next; } hdr = *ptr; @@ -1052,8 +1038,9 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) Uint e; unsigned sz; Eterm* ptr; - Process* myself; - int force_local = flags & ERTS_SHCOPY_FLG_TMPBUF; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); +#endif DECLARE_EQUEUE_INIT_INFO(s, info); DECLARE_BITSTORE_INIT_INFO(b, info); @@ -1073,12 +1060,11 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) flags |= disable_copy_shared; #endif - myself = erts_get_current_process(); - if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) + if (flags & ERTS_SHCOPY_FLG_NONE) return size_object(obj); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", myself->common.id, obj)); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", myself->common.id, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj)); /* step #1: ------------------------------------------------------- @@ -1102,9 +1088,10 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) Eterm head, tail; ptr = list_val(obj); /* off heap list pointers are copied verbatim */ - if (!INHEAP(myself, ptr)) { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); - info->literal_size += size_object(obj); + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); goto pop_next; } head = CAR(ptr); @@ -1115,7 +1102,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) primary_tag(head) == TAG_PRIMARY_HEADER) { if (tail != THE_NON_VALUE) { e = SHTABLE_NEXT(t); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", mypid, ptr)); SHTABLE_PUSH(t, head, tail, ptr); CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED; CDR(ptr) = THE_NON_VALUE; @@ -1125,17 +1112,17 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) /* else make it visited now */ switch (primary_tag(tail)) { case TAG_PRIMARY_LIST: - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", mypid, ptr)); CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; break; case TAG_PRIMARY_IMMED1: - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", mypid, ptr)); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); break; case TAG_PRIMARY_BOXED: BITSTORE_PUT(b, primary_tag(head)); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", mypid, ptr)); CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; break; @@ -1152,9 +1139,10 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) Eterm hdr; ptr = boxed_val(obj); /* off heap pointers to boxes are copied verbatim */ - if (!INHEAP(myself, ptr)) { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj)); - info->literal_size += size_object(obj); + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); goto pop_next; } hdr = *ptr; @@ -1163,14 +1151,14 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { if (primary_tag(hdr) == BOXED_VISITED) { e = SHTABLE_NEXT(t); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", mypid, ptr)); SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr); *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED; } goto pop_next; } /* else make it visited now */ - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", mypid, ptr)); *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; /* and count it */ ASSERT(is_header(hdr)); @@ -1293,7 +1281,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) info->shtable_start = t.start; info->shtable_alloc_type = t.alloc_type; /* single point of return: the size of the object */ - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", myself->common.id, sum)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); return sum + info->literal_size; } obj = EQUEUE_GET(s); @@ -1319,9 +1307,8 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, Eterm* resp; Eterm *hbot, *hend; unsigned remaining; - Process* myself; - int force_local = flags & ERTS_SHCOPY_FLG_TMPBUF; #ifdef DEBUG + Eterm mypid = erts_get_current_pid(); Eterm saved_obj = obj; #endif @@ -1343,11 +1330,10 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, flags |= disable_copy_shared; #endif - myself = erts_get_current_process(); - if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE)) + if (flags & ERTS_SHCOPY_FLG_NONE) return copy_struct(obj, size, hpp, off_heap); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", myself->common.id, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj)); /* step #2: was performed before this function was called ------------------------------------------------------- @@ -1376,10 +1362,14 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, Eterm head, tail; ptr = list_val(obj); /* off heap list pointers are copied verbatim */ - if (!INHEAP(myself, ptr)) { - Uint bsz; - *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); - hbot -= bsz; + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } goto cleanup_next; } head = CAR(ptr); @@ -1399,23 +1389,23 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, head = SHTABLE_X(t, e); tail = SHTABLE_Y(t, e); ptr = &(SHTABLE_X(t, e)); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e))); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); SHTABLE_FWD_UPD(t, e, hp); } } /* if not already clean, clean it up and copy it */ if (primary_tag(tail) == TAG_PRIMARY_HEADER) { if (primary_tag(head) == TAG_PRIMARY_HEADER) { - Eterm saved = BITSTORE_GET(b); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", myself->common.id, ptr)); - CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; - CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; + Eterm saved = BITSTORE_GET(b); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; } else { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr)); CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; } } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr)); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; } else { @@ -1439,10 +1429,14 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, Eterm hdr; ptr = boxed_val(obj); /* off heap pointers to boxes are copied verbatim */ - if (!INHEAP(myself, ptr)) { - Uint bsz; - *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); - hbot -= bsz; + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } goto cleanup_next; } hdr = *ptr; @@ -1463,13 +1457,13 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED; hdr = SHTABLE_X(t, e); ASSERT(primary_tag(hdr) == BOXED_VISITED); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e))); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; SHTABLE_FWD_UPD(t, e, hp); break; case BOXED_VISITED: - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; break; } @@ -1749,13 +1743,13 @@ all_clean: VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr)); /* entry was a list */ if (SHTABLE_Y(t, e) != THE_NON_VALUE) { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", mypid, ptr)); CAR(ptr) = SHTABLE_X(t, e); CDR(ptr) = SHTABLE_Y(t, e); } /* entry was boxed */ else { - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", myself->common.id, ptr)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", mypid, ptr)); *ptr = SHTABLE_X(t, e); ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER); } @@ -1769,9 +1763,9 @@ all_clean: } #endif - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", myself->common.id, saved_obj)); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", myself->common.id, result)); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", myself->common.id, result)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result)); ASSERT(hbot == hp); ASSERT(size == ((hp - *hpp) + (hend - hbot))); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index f106b941ef..71d072fa7e 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -982,6 +982,12 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp); +typedef struct { + Eterm *ptr; + Uint sz; +} copy_literals_t; + +extern copy_literals_t erts_clrange; /* beam_load.c */ typedef struct { @@ -1063,6 +1069,8 @@ typedef struct { Eterm* shtable_start; ErtsAlcType_t shtable_alloc_type; Uint literal_size; + Eterm *range_ptr; + Uint range_sz; } erts_shcopy_t; #define INITIALIZE_SHCOPY(info) \ @@ -1071,6 +1079,8 @@ do { \ info.bitstore_start = info.bitstore_default; \ info.shtable_start = info.shtable_default; \ info.literal_size = 0; \ + info.range_ptr = erts_clrange.ptr; \ + info.range_sz = erts_clrange.sz; \ } while(0) #define DESTROY_SHCOPY(info) \ diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index e461c95d19..68dd21b1d7 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1428,16 +1428,18 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> do_purge(Mod0) -> Mod = to_atom(Mod0), case erlang:check_old_code(Mod) of - false -> - false; - true -> - Res = check_proc_code(erlang:processes(), Mod, true), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - Res + false -> + false; + true -> + true = erlang:copy_literals(Mod, true), + Res = check_proc_code(erlang:processes(), Mod, true), + true = erlang:copy_literals(Mod, false), + try + erlang:purge_module(Mod) + catch + _:_ -> ignore + end, + Res end. %% do_soft_purge(Module) @@ -1451,10 +1453,13 @@ do_soft_purge(Mod0) -> false -> true; true -> + true = erlang:copy_literals(Mod, true), case check_proc_code(erlang:processes(), Mod, false) of false -> + true = erlang:copy_literals(Mod, false), false; true -> + true = erlang:copy_literals(Mod, false), try erlang:purge_module(Mod) catch -- cgit v1.2.3 From 0d5ee7a4ad7bc41b7cca878990926fb5ba57f6a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 1 Oct 2015 12:19:50 +0200 Subject: Do not use GCC extensions in copy --- erts/emulator/beam/copy.c | 37 ++++++++++++++++++++----------------- erts/emulator/beam/global.h | 25 +++++++++++++++---------- 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 5bca3877b5..83ca527334 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -258,18 +258,19 @@ do { \ } \ } while(0) -#define BITSTORE_GET(s) ({ \ - UWord result; \ - if (WSTK_CONCAT(s,_bitoffs) <= 0) { \ - WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \ - WSTK_CONCAT(s,_offset)++; \ - WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \ - } \ - WSTK_CONCAT(s,_bitoffs) -= 2; \ - result = WSTK_CONCAT(s,_buffer) & 3; \ - WSTK_CONCAT(s,_buffer) >>= 2; \ - result; \ -}) +#define BITSTORE_FETCH(s,dst) \ +do { \ + UWord result; \ + if (WSTK_CONCAT(s,_bitoffs) <= 0) { \ + WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \ + WSTK_CONCAT(s,_offset)++; \ + WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \ + } \ + WSTK_CONCAT(s,_bitoffs) -= 2; \ + result = WSTK_CONCAT(s,_buffer) & 3; \ + WSTK_CONCAT(s,_buffer) >>= 2; \ + (dst) = result; \ +} while(0) #define BOXED_VISITED_MASK ((Eterm) 3) #define BOXED_VISITED ((Eterm) 1) @@ -476,7 +477,8 @@ cleanup: /* if not already clean, clean it up */ if (primary_tag(tail) == TAG_PRIMARY_HEADER) { if (primary_tag(head) == TAG_PRIMARY_HEADER) { - Eterm saved = BITSTORE_GET(b); + Eterm saved; + BITSTORE_FETCH(b, saved); CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved; CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED; } else { @@ -1396,10 +1398,11 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, /* if not already clean, clean it up and copy it */ if (primary_tag(tail) == TAG_PRIMARY_HEADER) { if (primary_tag(head) == TAG_PRIMARY_HEADER) { - Eterm saved = BITSTORE_GET(b); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr)); - CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; - CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; + Eterm saved; + BITSTORE_FETCH(b, saved); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; } else { VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr)); CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 71d072fa7e..e9f7901a51 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -873,7 +873,7 @@ typedef struct { int possibly_empty; Eterm* end; ErtsAlcType_t alloc_type; -}ErtsEQueue; +} ErtsEQueue; #define DEF_EQUEUE_SIZE (16) @@ -918,15 +918,20 @@ do { \ #define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty) -#define EQUEUE_GET(q) ({ \ - UWord x; \ - q.possibly_empty = 1; \ - x = *(q.front); \ - if (++(q.front) == q.end) { \ - q.front = q.start; \ - } \ - x; \ -}) +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q) { + Eterm x; + q->possibly_empty = 1; + x = *(q->front); + if (++(q->front) == q->end) { + q->front = q->start; + } + return x; +} +#endif +#define EQUEUE_GET(q) erts_equeue_get(&(q)); /* binary.c */ -- cgit v1.2.3 From 7f215c6db8caf0760161437e9d1c3c0a06cf5841 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 25 Sep 2015 18:20:10 +0200 Subject: Add copy_literals testcase Repeatedly reload a literals module while sending the references literals around in a process ring. This will smoke test the non-copying literals message sending does not corrupt code unloading. --- erts/emulator/test/code_SUITE.erl | 82 ++++++++++++++++++++++++- erts/emulator/test/code_SUITE_data/literals.erl | 7 +++ 2 files changed, 87 insertions(+), 2 deletions(-) diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 9f318a38be..1acc4538fb 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -26,7 +26,8 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, - false_dependency/1,coverage/1,fun_confusion/1]). + false_dependency/1,coverage/1,fun_confusion/1, + t_copy_literals/1]). -define(line_trace, 1). -include_lib("test_server/include/test_server.hrl"). @@ -38,7 +39,7 @@ all() -> t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion]. + coverage, fun_confusion, t_copy_literals]. groups() -> []. @@ -753,6 +754,80 @@ compile_load(Mod, Src, Ver) -> {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), ok. + +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the literals module. + Data = ?config(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, Code), + + N = 30, + Me = self(), + %% reload literals code every 567 ms + Rel = spawn_link(fun() -> reloader(literals,Code,567) end), + %% add new literal msgs to the loop every 789 ms + Sat = spawn_link(fun() -> saturate(Me,789) end), + %% run for 10s + _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end), + ok = chase_msg(N, Me), + %% cleanup + Rel ! done, + Sat ! done, + ok = flush(), + ok. + + +chase_msg(0, Pid) -> + chase_loop(Pid); +chase_msg(N, Master) -> + Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end), + chase_loop(Pid). + +chase_loop(Pid) -> + receive + done -> + Pid ! done, + ok; + {_From,Msg} -> + Pid ! {self(), Msg}, + ok = traverse(Msg), + chase_loop(Pid) + end. + +saturate(Pid,Time) -> + Es = [msg1,msg2,msg3,msg4,msg5], + Msg = [literals:E()||E <- Es], + Pid ! {self(), Msg}, + receive + done -> ok + after Time -> + saturate(Pid,Time) + end. + +traverse([]) -> ok; +traverse([H|T]) -> + ok = traverse(H), + traverse(T); +traverse(T) when is_tuple(T) -> ok; +traverse(B) when is_binary(B) -> ok; +traverse(I) when is_integer(I) -> ok; +traverse(#{ 1 := V1, b := V2 }) -> + ok = traverse(V1), + ok = traverse(V2), + ok. + + +reloader(Mod,Code,Time) -> + receive + done -> ok + after Time -> + code:purge(Mod), + {module,Mod} = erlang:load_module(Mod, Code), + reloader(Mod,Code,Time) + end. + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> @@ -775,4 +850,7 @@ bit_sized_binary(Bin0) -> BitSize = 8*size(Bin) + 1, Bin. +flush() -> + receive _ -> flush() after 0 -> ok end. + id(I) -> I. diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 9802d9d3f9..a36bfe09dd 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -20,6 +20,7 @@ -module(literals). -export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). +-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]). a() -> {a,42.0,[7,38877938333399637266518333334747]}. @@ -101,3 +102,9 @@ unused_binaries() -> bits() -> {bits,<<42:13,?MB_1>>}. + +msg1() -> "halloj". +msg2() -> {"hello","world"}. +msg3() -> <<"halloj">>. +msg4() -> #{ 1=> "hello", b => "world"}. +msg5() -> {1,2,3,4,5,6}. -- cgit v1.2.3 From 85491375da14ab087ec99532ee3a896ff6fe0371 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 29 Sep 2015 15:33:18 +0200 Subject: Add erlang:copy_literals/2 spec --- erts/preloaded/src/erlang.erl | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 6a9ec9c915..0d5176019f 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -91,7 +91,7 @@ -export([bit_size/1, bitsize/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). -export([cancel_timer/1, cancel_timer/2, check_old_code/1, check_process_code/2, - check_process_code/3, crc32/1]). + check_process_code/3, copy_literals/2, crc32/1]). -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]). -export([delete_element/2]). -export([delete_module/1, demonitor/1, demonitor/2, display/1]). @@ -520,6 +520,13 @@ get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> get_cpc_opts([], Async, AllowGC) -> {Async, AllowGC}. +%% copy_literals/2 +-spec erlang:copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when + Module :: module(), + Bool :: boolean(). +copy_literals(_Mod, _Bool) -> + erlang:nif_error(undefined). + %% crc32/1 -spec erlang:crc32(Data) -> non_neg_integer() when Data :: iodata(). -- cgit v1.2.3 From da8220501710184f3ee80337bac57d215560ea64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 29 Sep 2015 15:35:54 +0200 Subject: Update preloaded module erlang.beam --- erts/preloaded/ebin/erlang.beam | Bin 101544 -> 101816 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 641fac2d26..4f35928db2 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ -- cgit v1.2.3 From 15c26af0a35fb482408885ea90b3e669d64d71f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 17 Nov 2015 16:26:35 +0100 Subject: Fix erts_debug:copy_shared/1 prototype --- erts/emulator/beam/bif.tab | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 63a0d0b1f0..c49a3ff313 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -646,7 +646,7 @@ bif erlang:copy_literals/2 bif binary:split/2 bif binary:split/3 bif erts_debug:size_shared/1 -bif 'erl.system.debug':size_shared/1 ebif_erts_debug_size_shared_1 +bif erts_debug:copy_shared/1 # # Obsolete -- cgit v1.2.3 From cd2f57bda32374dba98cbb0e72039a2e266f1633 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 18 Nov 2015 10:07:08 +0100 Subject: epp: Only flatten the original filename There is no need to flatten filenames using file_name/1 every time the current filename changes. Any filename obtained from a source file will be already flattened. Only the original source filename may need flattening. --- lib/stdlib/src/epp.erl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 0d3f725afe..45f616bb02 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -543,7 +543,8 @@ init_server(Pid, Name, Options, St0) -> default_encoding=DefEncoding}, From = wait_request(St), Anno = erl_anno:new(AtLocation), - enter_file_reply(From, Name, Anno, AtLocation, code), + enter_file_reply(From, file_name(Name), Anno, + AtLocation, code), wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) @@ -678,7 +679,7 @@ enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> generated -> erl_anno:set_generated(true, Anno0) end, Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, - {string,Anno,file_name(Name)},{',',Anno}, + {string,Anno,Name},{',',Anno}, {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, {dot,Anno}]}, epp_reply(From, Rep). -- cgit v1.2.3 From 3f29cf1f72f50d20ce1864f76e1a298602429ca4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 18 Nov 2015 16:59:08 +0100 Subject: Fix rebase of SHCOPY seq_tokens --- erts/emulator/beam/erl_message.c | 55 ++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 11890a756d..66b337402d 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -691,22 +691,15 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES Uint dt_utag_size = 0; #endif -#ifdef SHCOPY_SEND - unsigned shflags = (flags & ERTS_SND_FLG_SHCOPY_MASK) >> ERTS_SND_FLG_SHCOPY_SHIFT; - erts_shcopy_t info; - INITIALIZE_SHCOPY(info); -#endif - BM_SWAP_TIMER(send,size); -#ifdef SHCOPY_SEND - INITIALIZE_SHCOPY(info); - msize = copy_shared_calculate(message, &info, shflags); -#else - msize = size_object(message); -#endif - BM_SWAP_TIMER(size,send); + BM_SWAP_TIMER(send,size); + /* SHCOPY corrupts the heap between + * copy_shared_calculate, and + * copy_shared_perform. (it inserts move_markers like the gc). + * Make sure we don't use the heap between those instances. + */ #ifdef USE_VM_PROBES - if (stoken != am_have_dt_utag) { + if (stoken != am_have_dt_utag) { #endif seq_trace_update_send(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, @@ -714,23 +707,31 @@ erts_send_message(Process* sender, seq_trace_size = 6; /* TUPLE5 */ #ifdef USE_VM_PROBES } - if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { - dt_utag_size = size_object(DT_UTAG(sender)); - } else if (stoken == am_have_dt_utag ) { - stoken = NIL; - } + if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { + dt_utag_size = size_object(DT_UTAG(sender)); + } else if (stoken == am_have_dt_utag ) { + stoken = NIL; + } +#endif + +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info, shflags); +#else + msize = size_object(message); #endif + BM_SWAP_TIMER(size,send); - mp = erts_alloc_message_heap_state(receiver, - &receiver_state, - receiver_locks, - (msize + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + (msize #ifdef USE_VM_PROBES - + dt_utag_size + + dt_utag_size #endif - + seq_trace_size), - &hp, - &ohp); + + seq_trace_size), + &hp, + &ohp); BM_SWAP_TIMER(send,copy); -- cgit v1.2.3 From 5d764f988ab09326d24e39a172083b09ab364c6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 18 Nov 2015 17:58:14 +0100 Subject: Refactor sharing preserved copy flags The TMPBUF option is no longer needed due to is_literal test and NONE was only used for initial debugging. So we remove the entire option. --- erts/emulator/beam/beam_debug.c | 10 ++-------- erts/emulator/beam/copy.c | 22 ++-------------------- erts/emulator/beam/erl_db.c | 4 ++-- erts/emulator/beam/erl_message.c | 9 ++++----- erts/emulator/beam/erl_message.h | 5 ----- erts/emulator/beam/erl_process.c | 5 ++--- erts/emulator/beam/global.h | 10 ++-------- 7 files changed, 14 insertions(+), 51 deletions(-) diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index b007d000bf..e37bd4d78c 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -97,20 +97,14 @@ erts_debug_copy_shared_1(BIF_ALIST_1) Eterm* hp; Eterm copy; erts_shcopy_t info; -#ifdef SHCOPY_DISABLE - extern int disable_copy_shared; -#endif INITIALIZE_SHCOPY(info); - size = copy_shared_calculate(term, &info, 0); + size = copy_shared_calculate(term, &info); if (size > 0) { hp = HAlloc(p, size); } - copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap, 0); + copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap); DESTROY_SHCOPY(info); -#ifdef SHCOPY_DISABLE - disable_copy_shared = 0; -#endif BIF_RET(copy); } diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 83ca527334..67a96f6442 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -923,10 +923,6 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint * Using an ESTACK but not very transparently; consider refactoring */ -#ifdef SHCOPY_DISABLE -int disable_copy_shared = ERTS_SHCOPY_FLG_NONE; -#endif - #define DECLARE_SHTABLE(s) \ DECLARE_ESTACK(s); \ Uint ESTK_CONCAT(s,_offset) = 0 @@ -1034,7 +1030,7 @@ do { \ * Copy object "obj" preserving sharing. * First half: count size and calculate sharing. */ -Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) +Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) { Uint sum; Uint e; @@ -1058,13 +1054,6 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) if (IS_CONST(obj)) return 0; -#ifdef SHCOPY_DISABLE - flags |= disable_copy_shared; -#endif - - if (flags & ERTS_SHCOPY_FLG_NONE) - return size_object(obj); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj)); @@ -1299,7 +1288,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info, Uint32 flags) * Second half: copy and restore the object. */ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, - Eterm** hpp, ErlOffHeap* off_heap, Uint32 flags) { + Eterm** hpp, ErlOffHeap* off_heap) { Uint e; unsigned sz; Eterm* ptr; @@ -1328,13 +1317,6 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, if (IS_CONST(obj)) return obj; -#ifdef SHCOPY_DISABLE - flags |= disable_copy_shared; -#endif - - if (flags & ERTS_SHCOPY_FLG_NONE) - return copy_struct(obj, size, hpp, off_heap); - VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj)); /* step #2: was performed before this function was called diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 59a0c0b808..3030c1c91a 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1832,7 +1832,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) tb->common.id, from_pid, BIF_ARG_3), - ERTS_SND_FLG_SHCOPY_TMPBUF); + 0); erts_smp_proc_unlock(to_proc, to_locks); UnUseTmpHeap(5,BIF_P); BIF_RET(am_true); @@ -3211,7 +3211,7 @@ retry: tb->common.id, p->common.id, heir_data), - ERTS_SND_FLG_SHCOPY_TMPBUF); + 0); erts_smp_proc_unlock(to_proc, to_locks); return !0; } diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 66b337402d..a964f1968b 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -665,7 +665,6 @@ erts_send_message(Process* sender, #endif erts_aint32_t receiver_state; #ifdef SHCOPY_SEND - unsigned shflags = (flags & ERTS_SND_FLG_SHCOPY_MASK) >> ERTS_SND_FLG_SHCOPY_SHIFT; erts_shcopy_t info; #endif BM_STOP_TIMER(system); @@ -716,7 +715,7 @@ erts_send_message(Process* sender, #ifdef SHCOPY_SEND INITIALIZE_SHCOPY(info); - msize = copy_shared_calculate(message, &info, shflags); + msize = copy_shared_calculate(message, &info); #else msize = size_object(message); #endif @@ -737,7 +736,7 @@ erts_send_message(Process* sender, #ifdef SHCOPY_SEND if (is_not_immed(message)) - message = copy_shared_perform(message, msize, &info, &hp, ohp, shflags); + message = copy_shared_perform(message, msize, &info, &hp, ohp); DESTROY_SHCOPY(info); #else if (is_not_immed(message)) @@ -786,7 +785,7 @@ erts_send_message(Process* sender, BM_SWAP_TIMER(send,size); #ifdef SHCOPY_SEND INITIALIZE_SHCOPY(info); - msize = copy_shared_calculate(message, &info, shflags); + msize = copy_shared_calculate(message, &info); #else msize = size_object(message); #endif @@ -801,7 +800,7 @@ erts_send_message(Process* sender, BM_SWAP_TIMER(send,copy); #ifdef SHCOPY_SEND if (is_not_immed(message)) - message = copy_shared_perform(message, msize, &info, &hp, ohp, shflags); + message = copy_shared_perform(message, msize, &info, &hp, ohp); DESTROY_SHCOPY(info); #else if (is_not_immed(message)) diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 52a648fe0b..740ae46a0f 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -238,11 +238,6 @@ do { \ #define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) -#define ERTS_SND_FLG_SHCOPY_SHIFT 1 -#define ERTS_SND_FLG_SHCOPY_MASK (ERTS_SHCOPY_FLG_MASK << ERTS_SND_FLG_SHCOPY_SHIFT) -#define ERTS_SND_FLG_SHCOPY_NONE (ERTS_SHCOPY_FLG_NONE << ERTS_SND_FLG_SHCOPY_SHIFT) -#define ERTS_SND_FLG_SHCOPY_TMPBUF (ERTS_SHCOPY_FLG_TMPBUF << ERTS_SND_FLG_SHCOPY_SHIFT) - #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index a691a3c773..23616f36bf 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10748,7 +10748,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). erts_aint32_t state = 0; erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; #ifdef SHCOPY_SPAWN - unsigned shflags = 0; /* could be taken from so->flags, if necessary */ erts_shcopy_t info; INITIALIZE_SHCOPY(info); #endif @@ -10804,7 +10803,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_SWAP_TIMER(system,size); #ifdef SHCOPY_SPAWN - arg_size = copy_shared_calculate(args, &info, shflags); + arg_size = copy_shared_calculate(args, &info); #else arg_size = size_object(args); #endif @@ -10886,7 +10885,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_START_TIMER(system); BM_SWAP_TIMER(system,copy); #ifdef SHCOPY_SPAWN - p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap, shflags); + p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap); DESTROY_SHCOPY(info); #else p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index e9f7901a51..98c275a20c 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1052,14 +1052,8 @@ void erl_error(char*, va_list); #ifdef SHCOPY #define SHCOPY_SEND #define SHCOPY_SPAWN -/* Use this if you want sharing-preserving copy to be initially disabled */ -#undef SHCOPY_DISABLE #endif -#define ERTS_SHCOPY_FLG_MASK (((Uint32) 3) << 0) -#define ERTS_SHCOPY_FLG_NONE (((Uint32) 1) << 0) -#define ERTS_SHCOPY_FLG_TMPBUF (((Uint32) 1) << 1) /* forces INHEAP to true */ - /* The persistent state while the sharing-preserving copier works */ typedef struct { @@ -1106,8 +1100,8 @@ Eterm copy_object_x(Eterm, Process*, Uint); #define copy_object(Term, Proc) copy_object_x(Term,Proc,0) Uint size_object(Eterm); -Uint copy_shared_calculate(Eterm, erts_shcopy_t*, Uint32); -Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*, Uint32); +Uint copy_shared_calculate(Eterm, erts_shcopy_t*); +Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*); Uint size_shared(Eterm); -- cgit v1.2.3 From 8b93e77a6d3df65e45a3ca3e2ec9dd4c52464f63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 18 Nov 2015 18:47:55 +0100 Subject: Use sharing preserving copy in enif_make_copy --- erts/emulator/beam/erl_nif.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index a37cda93ef..2ff509e6d0 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -379,9 +379,19 @@ ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term) { Uint sz; Eterm* hp; +#ifdef SHCOPY + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); + sz = copy_shared_calculate(src_term, &info); + hp = alloc_heap(dst_env, sz); + src_term = copy_shared_perform(src_term, sz, &info, &hp, &MSO(dst_env->proc)); + DESTROY_SHCOPY(info); + return src_term; +#else sz = size_object(src_term); hp = alloc_heap(dst_env, sz); return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc)); +#endif } -- cgit v1.2.3 From 02f038355d16e9b6474837727878f58e4ca669c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 18 Nov 2015 20:12:38 +0100 Subject: Use sharing preserving copy error messages and exceptions --- erts/emulator/beam/erl_message.c | 28 +++++++++++++++++++++++++--- erts/emulator/beam/erl_process.c | 33 +++++++++++++++++++++++---------- 2 files changed, 48 insertions(+), 13 deletions(-) diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index a964f1968b..f64385d92b 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -850,6 +850,9 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, Eterm temptoken; ErtsMessage* mp; ErlOffHeap *ohp; +#ifdef SHCOPY_SEND + erts_shcopy_t info; +#endif if (token != NIL #ifdef USE_VM_PROBES @@ -858,13 +861,23 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, ) { ASSERT(is_tuple(token)); - sz_reason = size_object(reason); sz_token = size_object(token); sz_from = size_object(from); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif mp = erts_alloc_message_heap(to, to_locksp, sz_reason + sz_from + sz_token + 4, &hp, &ohp); +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif from_copy = copy_struct(from, sz_from, &hp, ohp); save = TUPLE3(hp, am_EXIT, from_copy, mess); hp += 4; @@ -873,13 +886,22 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, temptoken = copy_struct(token, sz_token, &hp, ohp); erts_queue_message(to, to_locksp, mp, save, temptoken); } else { - sz_reason = size_object(reason); sz_from = IS_CONST(from) ? 0 : size_object(from); - +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif mp = erts_alloc_message_heap(to, to_locksp, sz_reason+sz_from+4, &hp, &ohp); +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif from_copy = (IS_CONST(from) ? from : copy_struct(from, sz_from, &hp, ohp)); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 23616f36bf..f347d57a9d 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11520,31 +11520,44 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, { ErtsMessage *mp; ErlOffHeap *ohp; + Eterm* hp; + Eterm mess; +#ifdef SHCOPY_SEND + erts_shcopy_t info; +#endif if (token == NIL #ifdef USE_VM_PROBES || token == am_have_dt_utag #endif ) { - Eterm* hp; - Eterm mess; - - mp = erts_alloc_message_heap(to, to_locksp, - term_size, &hp, &ohp); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); +#endif erts_queue_message(to, to_locksp, mp, mess, NIL); } else { - Eterm* hp; - Eterm mess; Eterm temp_token; Uint sz_token; ASSERT(is_tuple(token)); sz_token = size_object(token); - - mp = erts_alloc_message_heap(to, to_locksp, - term_size+sz_token, &hp, &ohp); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); +#endif /* the trace token must in this case be updated by the caller */ seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL); temp_token = copy_struct(token, sz_token, &hp, ohp); -- cgit v1.2.3 From f7ac6ac502b6172622159588ab57d1a0b2da699a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 19 Nov 2015 16:07:50 +0100 Subject: Update primary bootstrap --- bootstrap/lib/stdlib/ebin/epp.beam | Bin 28004 -> 26952 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index 6a585f8a08..d9cd838ca9 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ -- cgit v1.2.3 From 6ff15f23c68db356bbad6ab5f939c191b58d453d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 19 Nov 2015 19:36:08 +0100 Subject: Refactor have seq_trace token test --- erts/emulator/beam/beam_emu.c | 2 +- erts/emulator/beam/bif.c | 6 +----- erts/emulator/beam/dist.c | 24 ++++++------------------ erts/emulator/beam/erl_bif_trace.c | 26 +++++--------------------- erts/emulator/beam/erl_db_util.c | 12 ++---------- erts/emulator/beam/erl_message.c | 19 ++++++------------- erts/emulator/beam/erl_message.h | 7 +++++++ erts/emulator/beam/erl_process.c | 12 ++---------- erts/emulator/beam/erl_trace.c | 6 +----- 9 files changed, 31 insertions(+), 83 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index af97cba61c..1a4133bceb 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1963,7 +1963,7 @@ void process_main(void) dtrace_proc_str(c_p, receiver_name); token2 = SEQ_TRACE_TOKEN(c_p); - if (token2 != NIL && token2 != am_have_dt_utag) { + if (have_seqtrace(token2)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index f0340540cb..14ab113b32 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2038,11 +2038,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); - if (SEQ_TRACE_TOKEN(p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(p) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { seq_trace_update_send(p); seq_trace_output(SEQ_TRACE_TOKEN(p), msg, SEQ_TRACE_SEND, portid, p); diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 68745fc448..f480915256 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -881,11 +881,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) DTRACE_CHARBUF(receiver_name, 64); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender); @@ -900,7 +896,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "%T", remote); msize = size_object(message); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -942,11 +938,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, DTRACE_CHARBUF(receiver_name, 128); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender); @@ -961,7 +953,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, 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) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -1006,11 +998,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, #endif UseTmpHeapNoproc(6); - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - ) { + if (have_seqtrace(token)) { seq_trace_update_send(dsdp->proc); seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); ctl = TUPLE5(&ctl_heap[0], @@ -1029,7 +1017,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, "{%T,%s}", remote, node_name); erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), "%T", reason); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 03f51132b1..4d67e39e7e 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1879,11 +1879,7 @@ new_seq_trace_token(Process* p) { Eterm* hp; - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { hp = HAlloc(p, 6); SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */ make_small(0), /* Label */ @@ -1903,12 +1899,8 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) BIF_ERROR(p, BADARG); } - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { - if ((item == am_send) || (item == am_receive) || + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { + if ((item == am_send) || (item == am_receive) || (item == am_print) || (item == am_timestamp)) { hp = HAlloc(p,3); res = TUPLE2(hp, item, am_false); @@ -1964,11 +1956,7 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } seq_trace_update_send(BIF_P); @@ -1987,11 +1975,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) { diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 0bf9558ac9..399be6058c 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2308,11 +2308,7 @@ restart: *esp++ = am_true; break; case matchIsSeqTrace: - if (SEQ_TRACE_TOKEN(c_p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag -#endif - ) + if (have_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = am_true; else *esp++ = am_false; @@ -2336,11 +2332,7 @@ restart: --esp; break; case matchGetSeqToken: - if (SEQ_TRACE_TOKEN(c_p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag -#endif - ) + if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = NIL; else { Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index f64385d92b..1811651a58 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -314,7 +314,7 @@ erts_queue_dist_message(Process *rcvr, DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -335,7 +335,7 @@ erts_queue_dist_message(Process *rcvr, DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -697,15 +697,13 @@ erts_send_message(Process* sender, * copy_shared_perform. (it inserts move_markers like the gc). * Make sure we don't use the heap between those instances. */ -#ifdef USE_VM_PROBES - if (stoken != am_have_dt_utag) { -#endif + if (have_seqtrace(stoken)) { seq_trace_update_send(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); seq_trace_size = 6; /* TUPLE5 */ -#ifdef USE_VM_PROBES } +#ifdef USE_VM_PROBES if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { dt_utag_size = size_object(DT_UTAG(sender)); } else if (stoken == am_have_dt_utag ) { @@ -765,7 +763,7 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_send)) { - if (stoken != NIL && stoken != am_have_dt_utag) { + if (have_seqtrace(stoken)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken)); @@ -854,12 +852,7 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, erts_shcopy_t info; #endif - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - ) { - + if (have_seqtrace(token)) { ASSERT(is_tuple(token)); sz_token = size_object(token); sz_from = size_object(from); diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 740ae46a0f..76387bc34c 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -128,6 +128,13 @@ struct erl_heap_fragment { #else #endif +#ifdef USE_VM_PROBES +#define have_no_seqtrace(T) ((T) == NIL || (T) == am_have_dt_utag) +#else +#define have_no_seqtrace(T) ((T) == NIL) +#endif +#define have_seqtrace(T) (!have_no_seqtrace(T)) + #define ERL_MESSAGE_REF_FIELDS__ \ ErtsMessage *next; /* Next message */ \ union { \ diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f347d57a9d..5907dd4567 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11526,11 +11526,7 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, erts_shcopy_t info; #endif - if (token == NIL -#ifdef USE_VM_PROBES - || token == am_have_dt_utag -#endif - ) { + if (!have_seqtrace(token)) { #ifdef SHCOPY_SEND INITIALIZE_SHCOPY(info); term_size = copy_shared_calculate(exit_term, &info); @@ -11670,11 +11666,7 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { - if (is_not_nil(token) -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - && token_update) + if (have_seqtrace(token)) seq_trace_update_send(token_update); if (is_value(exit_tuple)) send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index d02f1f7213..b774ba97af 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1046,11 +1046,7 @@ seq_trace_update_send(Process *p) { Eterm seq_tracer = erts_get_system_seq_tracer(); ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); - if ( (p->common.id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL) -#ifdef USE_VM_PROBES - || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) -#endif - ) { + if ((p->common.id == seq_tracer) || have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { return 0; } SEQ_TRACE_TOKEN_SENDER(p) = p->common.id; -- cgit v1.2.3 From 5cf556df2e178ce78d0c4197a73654d593f58f92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 24 Nov 2015 16:05:04 +0100 Subject: Fix seq_trace refactoring bug --- erts/emulator/beam/erl_process.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 5907dd4567..a8b7211793 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11666,7 +11666,7 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { - if (have_seqtrace(token)) + if (have_seqtrace(token) && token_update) seq_trace_update_send(token_update); if (is_value(exit_tuple)) send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token); -- cgit v1.2.3 From bc08768e5bad4baa2eaec4c6798ead9ded0a8889 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 24 Nov 2015 18:35:11 +0100 Subject: Fix seq_trace token copy size --- erts/emulator/beam/erl_process.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index a8b7211793..a814462668 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11547,7 +11547,7 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, #ifdef SHCOPY_SEND INITIALIZE_SHCOPY(info); term_size = copy_shared_calculate(exit_term, &info); - mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); DESTROY_SHCOPY(info); #else -- cgit v1.2.3 From c7c27a608e219d7aa2ecd20203632095af94da8a Mon Sep 17 00:00:00 2001 From: Aleksei Magusev Date: Wed, 7 Oct 2015 22:39:35 +0200 Subject: Forbid bytes modifier for unsized part of binary generator This type modifier was missed in 90efeaf21147505b1e8207822e606027f94183cc. --- lib/stdlib/src/erl_lint.erl | 4 ++-- lib/stdlib/test/erl_lint_SUITE.erl | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index a5f0e7dbd3..69eff615b4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3189,8 +3189,8 @@ handle_generator(P,E,Vt,Uvt,St0) -> handle_bitstring_gen_pat({bin,_,Segments=[_|_]},St) -> case lists:last(Segments) of {bin_element,Line,{var,_,_},default,Flags} when is_list(Flags) -> - case member(binary, Flags) orelse member(bits, Flags) - orelse member(bitstring, Flags) of + case member(binary, Flags) orelse member(bytes, Flags) + orelse member(bits, Flags) orelse member(bitstring, Flags) of true -> add_error(Line, unsized_binary_in_bin_gen_pattern, St); false -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 6c07dc1ec6..c1975b8dae 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1296,12 +1296,16 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> Ts = [{unsized_binary_in_bin_gen_pattern, <<"t({bc,binary,Bin}) -> << <> || <> <= Bin >>; + t({bc,bytes,Bin}) -> + << <> || <> <= Bin >>; t({bc,bits,Bin}) -> << <> || <> <= Bin >>; t({bc,bitstring,Bin}) -> << <> || <> <= Bin >>; t({lc,binary,Bin}) -> [ {X,Tail} || <> <= Bin ]; + t({lc,bytes,Bin}) -> + [ {X,Tail} || <> <= Bin ]; t({lc,bits,Bin}) -> [ {X,Tail} || <> <= Bin ]; t({lc,bitstring,Bin}) -> @@ -1313,7 +1317,9 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> {6,erl_lint,unsized_binary_in_bin_gen_pattern}, {8,erl_lint,unsized_binary_in_bin_gen_pattern}, {10,erl_lint,unsized_binary_in_bin_gen_pattern}, - {12,erl_lint,unsized_binary_in_bin_gen_pattern}], + {12,erl_lint,unsized_binary_in_bin_gen_pattern}, + {14,erl_lint,unsized_binary_in_bin_gen_pattern}, + {16,erl_lint,unsized_binary_in_bin_gen_pattern}], []}}], [] = run(Config, Ts), ok. -- cgit v1.2.3 From 6af385b22805cc2e8cee5c0a5f3506361afbe961 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 23 Oct 2015 15:27:22 +0200 Subject: Fix hipe_rtl_binary_construct:floorlog2/1 Relying on double-precision floating-point arithmetic to compute the log2 of an integer up to 64 bits long leads to rounding errors. --- lib/hipe/rtl/hipe_rtl_binary_construct.erl | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 692bad7d96..d01625b4f9 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -1330,7 +1330,19 @@ number2list(X, Acc) -> number2list(X-(1 bsl F), [F|Acc]). floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. set_high(X) -> set_high(X, 0). -- cgit v1.2.3 From fd21382290333e6cc25728c1b6dd7c211ddfc297 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 23 Oct 2015 15:31:28 +0200 Subject: hipe: test unit size match in bs_append This feature was previously missing and expressions such as <<<<1:1>>/binary>> would succeed construction when compiled with HiPE. A primop is_divisible is introduced to handle the case when the unit size is not a power of two. --- erts/emulator/hipe/hipe_bif0.tab | 2 +- erts/emulator/hipe/hipe_bif_list.m4 | 1 + erts/emulator/hipe/hipe_native_bif.c | 12 +++++++++ erts/emulator/hipe/hipe_native_bif.h | 2 ++ erts/emulator/hipe/hipe_primops.h | 2 ++ lib/hipe/rtl/hipe_rtl_binary_construct.erl | 41 ++++++++++++++++++++++-------- 6 files changed, 48 insertions(+), 12 deletions(-) diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index e3328c7d2c..5ce254314a 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -142,4 +142,4 @@ atom bs_validate_unicode atom bs_validate_unicode_retract atom emulate_fpe atom emasculate_binary - +atom is_divisible diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 6aa0c9a32e..7240280345 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -193,6 +193,7 @@ standard_bif_interface_2(nbif_rethrow, hipe_rethrow) standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) +standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible) /* * Mbox primops with implicit P parameter. diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 688378b2fe..119b0b0895 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -504,6 +504,18 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) return 1; } +BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2) +{ + /* Arguments are Eterm-sized unsigned integers */ + Uint dividend = BIF_ARG_1; + Uint divisor = BIF_ARG_2; + if (dividend % divisor) { + BIF_ERROR(BIF_P, BADARG); + } else { + return NIL; + } +} + /* This is like the loop_rec_fr BEAM instruction */ Eterm hipe_check_get_msg(Process *c_p) diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 0e1a75f7eb..55a0d3bb1b 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -68,6 +68,7 @@ AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int)); AEXTERN(Eterm,nbif_bs_get_utf16,(void)); AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm)); AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void)); +AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint)); AEXTERN(void,nbif_select_msg,(Process*)); AEXTERN(Eterm,nbif_cmp_2,(void)); @@ -93,6 +94,7 @@ BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3); BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1); struct erl_bin_match_buffer; int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); +BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2); #ifdef NO_FPE_SIGNALS AEXTERN(void,nbif_emulate_fpe,(Process*)); diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index adf7b1f382..0bec677574 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -68,6 +68,8 @@ PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16) PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode) PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract) +PRIMOP_LIST(am_is_divisible, &nbif_is_divisible) + PRIMOP_LIST(am_cmp_2, &nbif_cmp_2) PRIMOP_LIST(am_op_exact_eqeq_2, &nbif_eq_2) diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index d01625b4f9..97351d0142 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -313,15 +313,16 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; - {bs_append, _U, _F, _B, _Bla} -> + {bs_append, _U, _F, Unit, _Bla} -> [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), - [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls = - create_lbls(5), - [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] = + [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = + Lbls = create_lbls(6), + [ContLblName, ContLbl2Name, ContLbl3Name, ContLbl4Name, + Writable, NotWritable] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, @@ -339,17 +340,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', hipe_rtl:mk_imm(?PB_IS_WRITABLE), - eq, NotWritable, Writable, 0.01), + eq, NotWritable, ContLbl4Name, 0.01), + ContLbl4, + calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), + is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), - calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin), hipe_rtl:mk_goto(TrueLblName), NotWritableLbl, - not_writable_code(Bin, SizeReg, DstVar, Base, Offset, + not_writable_code(Bin, SizeReg, DstVar, Base, Offset, Unit, TrueLblName, FalseLblName)] end, {Code, ConstTab} @@ -361,13 +364,15 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -not_writable_code(Bin, SizeReg, Dst, Base, Offset, +not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), - [IncLbl,AllLbl] = Lbls = create_lbls(2), - [IncLblName,AllLblName] = get_label_names(Lbls), + [DivLbl,IncLbl,AllLbl] = Lbls = create_lbls(3), + [DivLblName,IncLblName,AllLblName] = get_label_names(Lbls), [get_base_offset_size(Bin, SrcBase, SrcOffset, SrcSize, FalseLblName), + is_divisible(SrcSize, Unit, DivLblName, FalseLblName), + DivLbl, hipe_rtl:mk_alu(TotSize, SrcSize, add, SizeReg), hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), @@ -1376,4 +1381,18 @@ first_part(Var, Register, FalseLblName) -> SuccessLbl2, hipe_tagscheme:untag_fixnum(Register, Var)]. - +is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> + [hipe_rtl:mk_goto(SuccLbl)]; +is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> + Log2 = floorlog2(Divisor), + case Divisor =:= 1 bsl Log2 of + true -> %% Divisor is a power of 2 + %% Test that the Log2-1 lowest bits are clear + Mask = hipe_rtl:mk_imm(Divisor - 1), + [Tmp] = create_regs(1), + [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + false -> + %% We need division, fall back to a primop + [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], + SuccLbl, FailLbl, not_remote)] + end. -- cgit v1.2.3 From 148153eb16e873181ff6961f854105a240989265 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 23 Oct 2015 17:09:16 +0200 Subject: hipe: test unit size match in bs_put_binary_all The unit size field was previously completely discarded when lowering this instruction from BEAM to Icode. This feature was previously missing and expressions such as <<0, <<1:1>>/binary>> would succeed construction when compiled with HiPE. --- lib/hipe/cerl/cerl_to_icode.erl | 8 ++++---- lib/hipe/icode/hipe_beam_to_icode.erl | 2 +- lib/hipe/icode/hipe_icode_primops.erl | 13 +++++++------ lib/hipe/rtl/hipe_rtl_binary.erl | 2 +- lib/hipe/rtl/hipe_rtl_binary_construct.erl | 22 ++++++++++++---------- 5 files changed, 25 insertions(+), 22 deletions(-) diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 97b95f2e7c..ab131c2d01 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -794,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> SL = new_label(), case SizeInfo of - {all,_NewUnit, NewAlign, S1} -> + {all, NewUnit, NewAlign, S1} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_guardop([Offset], Primop, [V, Base, Offset], SL, FL), @@ -819,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> case SizeInfo of - {all, _NewUnit, NewAlign, S} -> + {all, NewUnit, NewAlign, S} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_call_primop([Offset], Primop, [V, Base, Offset])], S), diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 0c7bdb788a..6aba48e0c1 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1306,7 +1306,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| {Name, Args, Env2} = case Size of {atom,all} -> %% put all bits - {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env}; {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> %% Create a N*Unit bits subbinary {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index ffb51b2ea4..c2b4fb1afc 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -116,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; -is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; @@ -219,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; -fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; @@ -265,8 +265,8 @@ pp(Dev, Op) -> io:format(Dev, "gc_test<~w>", [N]); {hipe_bs_primop, BsOp} -> case BsOp of - {bs_put_binary_all, Flags} -> - io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary_all, Unit, Flags} -> + io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]); {bs_put_binary, Size} -> io:format(Dev, "bs_put_binary<~w>", [Size]); {bs_put_binary, Flags, Size} -> @@ -628,8 +628,9 @@ type(Primop, Args) -> [_SrcType, _BitsType, _Base, Type] -> erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) end; - {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> - [SrcType, _Base, Type] = Args, + {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} -> + [SrcType0, _Base, Type] = Args, + SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0), erl_types:t_bitstr_concat(SrcType,Type); {hipe_bs_primop, {bs_put_string, _, Size}} -> [_Base, Type] = Args, diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index b549073050..4525994f7d 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -62,7 +62,7 @@ type_of_operation({bs_init,_,_}) -> construct; type_of_operation({bs_init_bits,_}) -> construct; type_of_operation({bs_init_bits,_,_}) -> construct; type_of_operation({bs_put_binary,_,_}) -> construct; -type_of_operation({bs_put_binary_all,_}) -> construct; +type_of_operation({bs_put_binary_all,_,_}) -> construct; type_of_operation({bs_put_float,_,_,_}) -> construct; type_of_operation({bs_put_integer,_,_,_}) -> construct; type_of_operation({bs_put_string,_,_}) -> construct; diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 97351d0142..1a78320592 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -94,10 +94,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_put_binary_all, _Flags} -> + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), - put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName); + put_binary_all(NewOffset, Src, Base, Offset, Unit, + TrueLblName, FalseLblName); {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of @@ -368,11 +369,9 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), - [DivLbl,IncLbl,AllLbl] = Lbls = create_lbls(3), - [DivLblName,IncLblName,AllLblName] = get_label_names(Lbls), + [IncLbl,AllLbl] = Lbls = create_lbls(2), + [IncLblName,AllLblName] = get_label_names(Lbls), [get_base_offset_size(Bin, SrcBase, SrcOffset, SrcSize, FalseLblName), - is_divisible(SrcSize, Unit, DivLblName, FalseLblName), - DivLbl, hipe_rtl:mk_alu(TotSize, SrcSize, add, SizeReg), hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), @@ -383,7 +382,7 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), AllLbl, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), - put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), + put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> @@ -748,13 +747,16 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_move(Dst, TmpDst), hipe_rtl:mk_goto(TrueLblName)]. -put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> +put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> [SrcBase,SrcOffset,NumBits] = create_regs(3), + [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), - get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++ - test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode). + [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), + is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), + ContLbl + |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> [Tmp] = create_regs(1), -- cgit v1.2.3 From bac7c55f9a9250f6edb57170530d567df6c92f29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 20 Nov 2015 14:39:48 +0100 Subject: hipe: Allow unsigned args in hipe_rtl_arith hipe_rtl_arith is only used by hipe_rtl_ssa_const_prop, which applies it to any RTL, including RTL where the intent is to do unsigned math. Since signed and unsigned operations produce the same 2's complement result, this change is harmless. On 32-bit architectures it caused HiPE crashes when compiling code like <<0:((1 bsl 32)-1)>>, because the size of the field is too large to fit in a signed integer. --- lib/hipe/rtl/hipe_rtl_arith.inc | 15 ++++----------- lib/hipe/rtl/hipe_rtl_arith_32.erl | 3 ++- 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 1f455f47ed..1dff56b074 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -30,13 +30,13 @@ %% Returns a tuple %% {Res, Sign, Zero, Overflow, Carry} %% Res will be a number in the range -%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT +%% MAX_UNSIGNED_INT >= Res >= 0 %% The other four values are flags that are either true or false %% eval_alu(Op, Arg1, Arg2) - when Arg1 =< ?MAX_SIGNED_INT, + when Arg1 =< ?MAX_UNSIGNED_INT, Arg1 >= ?MIN_SIGNED_INT, - Arg2 =< ?MAX_SIGNED_INT, + Arg2 =< ?MAX_UNSIGNED_INT, Arg2 >= ?MIN_SIGNED_INT -> Sign1 = sign_bit(Arg1), @@ -111,7 +111,7 @@ eval_alu(Op, Arg1, Arg2) Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) end, - {two_comp_to_erl(Res), N, Z, V, C}; + {Res, N, Z, V, C}; eval_alu(Op, Arg1, Arg2) -> ?EXIT({argument_overflow,Op,Arg1,Arg2}). @@ -162,16 +162,9 @@ eval_cond(Cond, Arg1, Arg2) -> sign_bit(Val) -> ((Val bsr ?SIGN_BIT) band 1) =:= 1. -two_comp_to_erl(V) -> - if V > ?MAX_SIGNED_INT -> - - ((?MAX_UNSIGNED_INT + 1) - V); - true -> V - end. - shiftmask(Arg) -> Setbits = ?BITS - Arg, (1 bsl Setbits) - 1. zero(Val) -> Val =:= 0. - diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl index 572556be1c..d790a8b981 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_32.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl @@ -24,7 +24,8 @@ %% Filename : hipe_rtl_arith_32.erl %% Module : hipe_rtl_arith_32 %% Purpose : To implement 32-bit RTL-arithmetic -%% Notes : The arithmetic works on 32-bit signed integers. +%% Notes : The arithmetic works on 32-bit signed and unsigned +%% integers. %% The implementation is taken from the implementation %% of arithmetic on SPARC. %% XXX: This code is seldom used, and hence also -- cgit v1.2.3 From fa4cc49b0e64b655a167a5daceb2f16252102fc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 20 Nov 2015 15:25:30 +0100 Subject: Add missing corner-case to bs_construct_SUITE huge_binary/1 did not consider that the Shift variable is not a constant, and misses the case of a literal size. --- erts/emulator/test/bs_construct_SUITE.erl | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index cadb30e1a4..1afd01e27b 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -551,10 +551,24 @@ huge_binary(Config) when is_list(Config) -> ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), ?line garbage_collect(), {Shift,Return} = case free_mem() of - undefined -> {32,ok}; - Mb when Mb > 600 -> {32,ok}; - Mb when Mb > 300 -> {31,"Limit huge binaries to 256 Mb"}; - _ -> {30,"Limit huge binary to 128 Mb"} + undefined -> + %% This test has to be inlined inside the case to + %% use a literal Shift + ?line garbage_collect(), + ?line id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 600 -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 32)-1)>>), + {32,ok}; + Mb when Mb > 300 -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 31)-1)>>), + {31,"Limit huge binaries to 256 Mb"}; + _ -> + ?line garbage_collect(), + ?line id(<<0:((1 bsl 30)-1)>>), + {30,"Limit huge binary to 128 Mb"} end, ?line garbage_collect(), ?line id(<<0:((1 bsl Shift)-1)>>), -- cgit v1.2.3 From 4ce3f357aca2b418dda22ce5434b080ba41ffa45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 20 Nov 2015 15:28:05 +0100 Subject: hipe: Fix binary constructions failing with badarith Expressions like <<0:(fun(X)->X end(anka))>> would fail with 'badarith' in HiPE, but 'badarg' in BEAM. hipe_beam_to_icode was attempting to optimise the amount of code generated by letting the arithmetic error propagate instead of catching it. However, since it was emitting a block to throw 'badarg' in that case anyway, we can just reuse it to achieve just as compact code that behaves exactly like BEAM. --- lib/hipe/icode/hipe_beam_to_icode.erl | 49 ++++++++++++++++------------------- 1 file changed, 22 insertions(+), 27 deletions(-) diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 6aba48e0c1..37c6ba9c60 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -881,6 +881,15 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {map_label(Lbl), []} + end, MultIs = case {New,Unit} of {{integer, NewInt}, _} -> @@ -890,40 +899,26 @@ trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> [hipe_icode:mk_move(Temp, NewVar)]; _ -> NewVar = mk_var(New), - if Lbl =:= 0 -> - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)])]; - true -> - Succ = mk_label(new), - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)], - hipe_icode:label_name(Succ), map_label(Lbl)), - Succ] - end + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), FailLblName), + Succ] end, Succ2 = mk_label(new), - {FailLblName, FailCode} = - if Lbl =:= 0 -> - FailLbl = mk_label(new), - {hipe_icode:label_name(FailLbl), - [FailLbl, - hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; - true -> - {map_label(Lbl), []} - end, IsPos = [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], hipe_icode:label_name(Succ2), FailLblName)] ++ - FailCode ++ [Succ2], - AddI = + FailCode ++ [Succ2], + AddRhs = case Old of - {integer,OldInt} -> - hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); - _ -> - OldVar = mk_var(Old), - hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + {integer,OldInt} -> hipe_icode:mk_const(OldInt); + _ -> mk_var(Old) end, - MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; + Succ3 = mk_label(new), + AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs], + hipe_icode:label_name(Succ3), FailLblName), + MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %% Bit syntax instructions added in R12B-5 (Fall 2008) %%-------------------------------------------------------------------- -- cgit v1.2.3 From d5a877aeb8e7845bf92469456a8246cb62cd7036 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 20 Nov 2015 14:38:13 +0100 Subject: hipe: Fix constructing huge binaries Bugs were fixed in hipe_rtl_binary_match:{first_part/3,make_size/3,set_high/1} in commit 5aea81c49, but it turns out these had been copy-pasted verbatim into hipe_rtl_binary_construct, where they were causing further bugs. They have now moved to hipe_rtl_binary, from where they are included by the other two modules. Furthermore, first_part/3 (reamed get_word_integer/3, since it loads integers that fits into an unsigned word), and make_size/3 now accepts a fourth argument to distinguish too large arguments (which should cause a system_limit exception) from negative or non-integral arguments. The use of first_part/3 (get_word_integer/3) from 5aea81c49 in hipe_rtl_binary_construct now allows several binary construction instructions to accept bignum sizes, as they were supposed to. Additionally, calls to hipe_rtl_binary_construct:check_and_untag_fixnum/3 were replaced with get_word_integer/4 since all of them were also supposed to accept sufficiently small bignums, but didn't, and check_and_untag_fixnum/3 was essentially identical to first_part/3 anyway. HiPE is now capable of passing bs_construct_SUITE completely unmodified. --- lib/hipe/rtl/hipe_rtl_binary.erl | 142 ++++++++++++++++++++++++++++- lib/hipe/rtl/hipe_rtl_binary_construct.erl | 131 ++++---------------------- lib/hipe/rtl/hipe_rtl_binary_match.erl | 100 +------------------- lib/hipe/rtl/hipe_tagscheme.erl | 23 +++-- 4 files changed, 176 insertions(+), 220 deletions(-) diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index 4525994f7d..9cbab08ee2 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -1,3 +1,4 @@ +%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% @@ -28,11 +29,20 @@ -export([gen_rtl/7]). +-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]). + +%%-------------------------------------------------------------------- + +-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa +-define(BYTE_SIZE, 8). + +%%-------------------------------------------------------------------- + gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) -> case type_of_operation(BsOP) of match -> {hipe_rtl_binary_match:gen_rtl( - BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; + BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; construct -> hipe_rtl_binary_construct:gen_rtl( BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) @@ -79,3 +89,133 @@ type_of_operation(bs_final) -> construct; type_of_operation({bs_append,_,_,_,_}) -> construct; type_of_operation({bs_private_append,_,_}) -> construct; type_of_operation(bs_init_writable) -> construct. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Small utility functions: +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_lbls(X) when X > 0 -> + [hipe_rtl:mk_new_label()|create_lbls(X-1)]; +create_lbls(0) -> + []. + +%%------------------------------------------------------------------------------ +%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match +%%------------------------------------------------------------------------------ + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) -> + [EndLbl] = create_lbls(1), + EndName = hipe_rtl:label_name(EndLbl), + get_word_integer(Var, Register,SystemLimitLblName, FalseLblName, EndName, EndName, + [EndLbl]). + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName, + BigLblName, Tail) -> + [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), + [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), + hipe_rtl:label_name(NotFixnumLbl), 0.99), + FixnumLbl, + hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), + hipe_rtl:label_name(SuccessLbl), FalseLblName, + 0.99), + SuccessLbl, + hipe_tagscheme:untag_fixnum(Register, Var), + hipe_rtl:mk_goto(TrueLblName), + NotFixnumLbl, + hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), + FalseLblName, SystemLimitLblName, 0.99), + BignumLbl, + hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), + hipe_rtl:mk_goto(BigLblName) | Tail]. + +make_size(UnitImm, BitsVar, FailLblName) -> + make_size(UnitImm, BitsVar, FailLblName, FailLblName). + +make_size(1, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg}; +make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + [FixnumLbl, BignumLbl] = create_lbls(2), + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + FixnumLblName = hipe_rtl:label_name(FixnumLbl), + Tail = [BignumLbl, + hipe_rtl:mk_branch(DstReg, 'ltu', + hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), + FixnumLblName, OverflowLblName, 0.99), + FixnumLbl, + hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], + Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName, + FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail), + {Code, DstReg}; +make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + UnitList = number2list(UnitImm), + Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName), + {Code, DstReg}. + +multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName, + FalseLblName) -> + Test = set_high(Head), + Tmp1 = hipe_rtl:mk_new_reg(), + SuccessLbl = hipe_rtl:mk_new_label(), + Register = hipe_rtl:mk_new_reg(), + Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| + get_word_integer(Variable, Register, OverflowLblName, FalseLblName)] + ++ + [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), + eq, hipe_rtl:label_name(SuccessLbl), + OverflowLblName, 0.99), + SuccessLbl], + multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code). + +multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1, + OldCode) -> + SuccessLbl = hipe_rtl:mk_new_label(), + Code = + OldCode ++ + [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), + hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, + hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99), + SuccessLbl], + multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code); +multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) -> + Code. + +set_high(X) -> + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + set_high(min(X, WordBits), WordBits, 0). + +set_high(0, _, Y) -> + Y; +set_high(X, WordBits, Y) -> + set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). + + +number2list(X) when is_integer(X), X >= 0 -> + number2list(X, []). + +number2list(1, Acc) -> + lists:reverse([0|Acc]); +number2list(0, Acc) -> + lists:reverse(Acc); +number2list(X, Acc) -> + F = floorlog2(X), + number2list(X-(1 bsl F), [F|Acc]). + +floorlog2(X) -> + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 1a78320592..80436a6931 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -34,6 +34,10 @@ get_field_from_term/3, set_field_from_pointer/3, get_field_from_pointer/3]). + +-import(hipe_rtl_binary, [floorlog2/1, + get_word_integer/4, + make_size/4]). %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -111,7 +115,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -133,7 +139,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -162,6 +170,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab CCode, Aligned, LittleEndian, TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -210,6 +219,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -294,7 +304,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [SizeReg] = create_regs(1), [Base] = create_unsafe_regs(1), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), hipe_rtl:mk_goto(TrueLblName)]; @@ -306,7 +316,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubBinSize = {sub_binary, binsize}, [get_field_from_term({sub_binary, orig}, Bin, ProcBin), get_field_from_term(SubBinSize, Bin, SubSize), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), set_field_from_term(SubBinSize, Bin, EndSubSize), @@ -328,7 +338,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), ContLbl, hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), @@ -401,16 +411,6 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -check_and_untag_fixnum(Size, SizeReg, FalseLblName) -> - [ContLbl,NextLbl] = Lbls = create_lbls(2), - [ContLblName,NextLblName] = get_label_names(Lbls), - [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:untag_fixnum(SizeReg,Size), - hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName, - FalseLblName), - NextLbl]. - realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = @@ -673,7 +673,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName WordSize = hipe_rtl_arch:word_size(), [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), [USize,Tmp] = create_unsafe_regs(2), - [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), hipe_rtl:label_name(ContLbl), SystemLimitLblName), @@ -709,7 +709,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), - get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), @@ -1286,103 +1286,6 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)]. -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - 'eq', hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll', - hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - %% Double-precision floats do not have enough precision to make floorlog2 - %% exact for integers larger than 2^47. - Approx = round(math:log(X)/math:log(2)-0.5), - floorlog2_refine(X, Approx). - -floorlog2_refine(X, Approx) -> - if (1 bsl Approx) > X -> - floorlog2_refine(X, Approx - 1); - (1 bsl (Approx+1)) > X -> - Approx; - true -> - floorlog2_refine(X, Approx + 1) - end. - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - -get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) -> - Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4), - [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], - [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99), - FixLbl, - hipe_tagscheme:untag_fixnum(USize, Size), - hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName), - BigLbl, - hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99), - PosBigLbl, - hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName), - OkLbl]. - - -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> [hipe_rtl:mk_goto(SuccLbl)]; is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 51213b71d1..b385ea6afc 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -31,6 +31,8 @@ -import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]). +-import(hipe_rtl_binary, [make_size/3]). + -include("hipe_literals.hrl"). %%-------------------------------------------------------------------- @@ -1100,103 +1102,5 @@ create_gcsafe_regs(X) when X > 0 -> create_gcsafe_regs(0) -> []. -first_part(Var, Register, FalseLblName) -> - [EndLbl] = create_lbls(1), - EndName = hipe_rtl:label_name(EndLbl), - first_part(Var, Register, FalseLblName, EndName, EndName, [EndLbl]). - -first_part(Var, Register, FalseLblName, TrueLblName, BigLblName, Tail) -> - [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), - hipe_rtl:label_name(NotFixnumLbl), 0.99), - FixnumLbl, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl), FalseLblName, - 0.99), - SuccessLbl, - hipe_tagscheme:untag_fixnum(Register, Var), - hipe_rtl:mk_goto(TrueLblName), - NotFixnumLbl, - %% Since binaries are not allowed to be larger than 2^wordsize bits - %% and since bignum digits are words, we know that a bignum with an - %% arity larger than one can't match. - hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), - FalseLblName, 0.99), - BignumLbl, - hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), - hipe_rtl:mk_goto(BigLblName) | Tail]. - -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - [FixnumLbl, BignumLbl] = create_lbls(2), - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - FixnumLblName = hipe_rtl:label_name(FixnumLbl), - Tail = [BignumLbl, - hipe_rtl:mk_branch(DstReg, 'ltu', - hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), - FixnumLblName, FalseLblName, 0.99), - FixnumLbl, - hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], - Code = first_part(BitsVar, DstReg, FalseLblName, FixnumLblName, - hipe_rtl:label_name(BignumLbl), Tail), - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - eq, hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = - OldCode ++ - [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, - hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - set_high(min(X, WordBits), WordBits, 0). - -set_high(0, _, Y) -> - Y; -set_high(X, WordBits, Y) -> - set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). - is_illegal_const(Const) -> Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0. diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index d77078acb6..8825a3ade3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -42,7 +42,7 @@ test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, test_binary/4, test_bitstr/4, test_list/4, test_map/4, test_integer/4, test_number/4, test_tuple_N/5, - test_pos_bignum_arity/5]). + test_pos_bignum_arity/6]). -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, @@ -351,14 +351,23 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) -> mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, TrueLab, FalseLab, Pred)]. -test_pos_bignum_arity(X, Arity, TrueLab, FalseLab, Pred) -> +test_pos_bignum_arity(X, Arity, TrueLab, NotPosBignumLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - HalfTrueLab = hipe_rtl:mk_new_label(), + BoxedLab = hipe_rtl:mk_new_label(), HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)), - [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), - HalfTrueLab, - get_header(Tmp, X), - hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. + [test_is_boxed(X, hipe_rtl:label_name(BoxedLab), NotPosBignumLab, Pred), + BoxedLab, + get_header(Tmp, X)] ++ + case NotPosBignumLab =:= FalseLab of + true -> []; + false -> + BignumLab = hipe_rtl:mk_new_label(), + BigMask = ?TAG_HEADER_MASK, + [mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, + hipe_rtl:label_name(BignumLab), NotPosBignumLab, Pred), + BignumLab] + end ++ + [hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. test_matchstate(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), -- cgit v1.2.3 From 01442bb8d4d1f62f8a4f95d5b89bda725bf1423d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Fri, 20 Nov 2015 17:43:51 +0100 Subject: hipe: Guard against enormous numbers in ranges This allows us to compile bs_match_int_SUITE with HiPE without a system_limit crash. --- lib/hipe/icode/hipe_icode_primops.erl | 24 +++++++++++++++++++++--- lib/hipe/icode/hipe_icode_range.erl | 6 +++--- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index c2b4fb1afc..84aae30291 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -505,11 +505,13 @@ type(Primop, Args) -> NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), if Signed =:= 0 -> - erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), + UpperBound = inf_add(safe_bsl(1, Size), -1), + erl_types:t_product([erl_types:t_from_range(0, UpperBound), NewMatchState]); Signed =:= 4 -> - erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), - (1 bsl (Size-1)) - 1), + erl_types:t_product([erl_types:t_from_range( + inf_inv(safe_bsl(1, Size-1)), + inf_add(safe_bsl(1, Size-1), -1)), NewMatchState]) end; [_Arg] -> @@ -966,3 +968,19 @@ check_fun_args(_, _) -> match_bin(Pattern, Match) -> erl_types:t_bitstr_match(Pattern, Match). + +safe_bsl(0, _) -> 0; +safe_bsl(Base, Shift) when Shift =< 128 -> Base bsl Shift; +safe_bsl(Base, _Shift) when Base > 0 -> pos_inf; +safe_bsl(Base, _Shift) when Base < 0 -> neg_inf. + +inf_inv(pos_inf) -> neg_inf; +inf_inv(neg_inf) -> pos_inf; +inf_inv(Number) -> -Number. + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(neg_inf, _Number) -> neg_inf; +inf_add(_Number, pos_inf) -> pos_inf; +inf_add(_Number, neg_inf) -> neg_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index ba5fa1bfd7..9a20527a83 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1202,11 +1202,11 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, if Signed =:= 0 -> - Max = 1 bsl Size - 1, + Max = inf_add(inf_bsl(1, Size), -1), Min = 0; true -> - Max = 1 bsl (Size-1) - 1, - Min = -(1 bsl (Size-1)) + Max = inf_add(inf_bsl(1, Size-1), -1), + Min = inf_inv(inf_bsl(1, Size-1)) end, {Min, Max}; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), -- cgit v1.2.3 From 57b192d8ad6c319b20da48e55485799168f4d346 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Fri, 27 Nov 2015 17:08:02 +0100 Subject: Add some more binary syntax construction tests Some more cases (taken from the BEAM bs_construct suite) that used to show different behaviour than BEAM when compiled to native code were included in the appropriate test file of the HiPE test suite. --- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 115 +++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 37a54c1981..7d59482662 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -14,6 +14,9 @@ test() -> 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), ok = bad_ones(), ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), ok. %%-------------------------------------------------------------------- @@ -142,3 +145,115 @@ zero_width() -> ok. id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <>, + ok. + +not_used2(I, Sz) -> + <>, + ok. + +not_used3(I) -> + <>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <>. + +append_unit_4(Bin) -> + <>. + +append_unit_8(Bin) -> + <>. + +append_unit_16(Bin) -> + <>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. -- cgit v1.2.3 From 720139f2d285a5746ba712efa236ad4938436e0f Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Fri, 27 Nov 2015 17:17:21 +0100 Subject: Add a case testing the handling of guards involving binaries The HiPE compiler was leaking exceptions out of guards involving binaries with `strange' arithmetic in them. Fixed by the set of changes in this pull request. --- lib/hipe/test/bs_SUITE_data/bs_add.erl | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl index af5a3b2f23..4b92e6b413 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_add.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------- %% 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. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. %%------------------------------------------------------------------------- -module(bs_add). @@ -10,9 +10,17 @@ test() -> 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith ok. f(Bin, A, B) when <> == Bin -> gazonk; f(Bin, _, _) when is_binary(Bin) -> 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<>) -> + true; +g(_, _) -> + false. -- cgit v1.2.3 From 99e6213c0f0cebaa01f8310b6950a814cf4b21ee Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 13 Nov 2015 18:04:09 +0100 Subject: erts: Remove dead code erts_hash_merge --- erts/emulator/beam/hash.c | 50 ----------------------------------------------- erts/emulator/beam/hash.h | 2 -- 2 files changed, 52 deletions(-) diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c index e0fde337f2..636aafc108 100644 --- a/erts/emulator/beam/hash.c +++ b/erts/emulator/beam/hash.c @@ -280,56 +280,6 @@ void* hash_put(Hash* h, void* tmpl) return (void*) b; } -static void -hash_insert_entry(Hash* h, HashBucket* entry) -{ - HashValue hval = entry->hvalue; - int ix = hval % h->size; - HashBucket* b = h->bucket[ix]; - - while (b != (HashBucket*) 0) { - if ((b->hvalue == hval) && (h->fun.cmp((void*)entry, (void*)b) == 0)) { - abort(); /* Should not happen */ - } - b = b->next; - } - - if (h->bucket[ix] == NULL) - h->used++; - - entry->next = h->bucket[ix]; - h->bucket[ix] = entry; - - if (h->used > h->size80percent) /* rehash at 80% */ - rehash(h, 1); -} - - -/* - * Move all entries in src into dst; empty src. - * Entries in src must not exist in dst. - */ -void -erts_hash_merge(Hash* src, Hash* dst) -{ - int limit = src->size; - HashBucket** bucket = src->bucket; - int i; - - src->used = 0; - for (i = 0; i < limit; i++) { - HashBucket* b = bucket[i]; - HashBucket* next; - - bucket[i] = NULL; - while (b) { - next = b->next; - hash_insert_entry(dst, b); - b = next; - } - } -} - /* ** Erase hash entry return template if erased ** return 0 if not erased diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h index 87fdb360e3..c9e75d7acf 100644 --- a/erts/emulator/beam/hash.h +++ b/erts/emulator/beam/hash.h @@ -93,6 +93,4 @@ void* hash_erase(Hash*, void*); void* hash_remove(Hash*, void*); void hash_foreach(Hash*, void (*func)(void *, void *), void *); -void erts_hash_merge(Hash* src, Hash* dst); - #endif -- cgit v1.2.3 From 4b4c3d525a06309b7e23c7c3ccf7a358bd0f33f3 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 13 Nov 2015 18:12:32 +0100 Subject: erts: Redesign grow/shrink thresholds of hash.c 1. Use load factor as indicator, not used buckets. Used buckets is a bad indicator as it makes the situation even worse with a bad hash function. Set grow_threshold to load factor of 160% as it roughly corresponds to the old 80% used bucket limit. 2. Never shrink table below initial size. --- erts/emulator/beam/hash.c | 60 ++++++++++++++++++++++++----------------------- erts/emulator/beam/hash.h | 9 +++---- 2 files changed, 36 insertions(+), 33 deletions(-) diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c index 636aafc108..9d247db039 100644 --- a/erts/emulator/beam/hash.c +++ b/erts/emulator/beam/hash.c @@ -66,6 +66,7 @@ void hash_get_info(HashInfo *hi, Hash *h) int i; int max_depth = 0; int objects = 0; + int used = 0; for (i = 0; i < size; i++) { int depth = 0; @@ -76,14 +77,18 @@ void hash_get_info(HashInfo *hi, Hash *h) depth++; b = b->next; } - if (depth > max_depth) - max_depth = depth; + if (depth) { + used++; + if (depth > max_depth) + max_depth = depth; + } } + ASSERT(objects == h->nobjs); hi->name = h->name; hi->size = h->size; - hi->used = h->used; - hi->objs = objects; + hi->used = used; + hi->objs = h->nobjs; hi->depth = max_depth; } @@ -119,6 +124,15 @@ hash_table_sz(Hash *h) } +static ERTS_INLINE void set_thresholds(Hash* h) +{ + h->grow_threshold = (8*h->size)/5; /* grow at 160% load */ + if (h->size_ix > h->min_size_ix) + h->shrink_threshold = h->size / 5; /* shrink at 20% load */ + else + h->shrink_threshold = -1; /* never shrink below inital size */ +} + /* ** init a pre allocated or static hash structure ** and allocate buckets. @@ -145,10 +159,10 @@ Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions h->name = name; h->fun = fun; h->size = size; - h->size20percent = h->size/5; - h->size80percent = (4*h->size)/5; - h->ix = ix; - h->used = 0; + h->size_ix = ix; + h->min_size_ix = ix; + h->nobjs = 0; + set_thresholds(h); return h; } @@ -199,32 +213,26 @@ static void rehash(Hash* h, int grow) int i; if (grow) { - if ((h_size_table[h->ix+1]) == -1) + if ((h_size_table[h->size_ix+1]) == -1) return; - h->ix++; + h->size_ix++; } else { - if (h->ix == 0) + if (h->size_ix == 0) return; - h->ix--; + h->size_ix--; } - h->size = h_size_table[h->ix]; - h->size20percent = h->size/5; - h->size80percent = (4*h->size)/5; + h->size = h_size_table[h->size_ix]; sz = h->size*sizeof(HashBucket*); new_bucket = (HashBucket **) erts_alloc(h->type, sz); sys_memzero(new_bucket, sz); - h->used = 0; - for (i = 0; i < old_size; i++) { HashBucket* b = h->bucket[i]; while (b != (HashBucket*) 0) { HashBucket* b_next = b->next; int ix = b->hvalue % h->size; - if (new_bucket[ix] == NULL) - h->used++; b->next = new_bucket[ix]; new_bucket[ix] = b; b = b_next; @@ -232,6 +240,7 @@ static void rehash(Hash* h, int grow) } erts_free(h->type, (void *) h->bucket); h->bucket = new_bucket; + set_thresholds(h); } /* @@ -268,14 +277,11 @@ void* hash_put(Hash* h, void* tmpl) } b = (HashBucket*) h->fun.alloc(tmpl); - if (h->bucket[ix] == NULL) - h->used++; - b->hvalue = hval; b->next = h->bucket[ix]; h->bucket[ix] = b; - if (h->used > h->size80percent) /* rehash at 80% */ + if (++h->nobjs > h->grow_threshold) rehash(h, 1); return (void*) b; } @@ -298,9 +304,7 @@ void* hash_erase(Hash* h, void* tmpl) else h->bucket[ix] = b->next; h->fun.free((void*)b); - if (h->bucket[ix] == NULL) - h->used--; - if (h->used < h->size20percent) /* rehash at 20% */ + if (--h->nobjs < h->shrink_threshold) rehash(h, 0); return tmpl; } @@ -331,9 +335,7 @@ hash_remove(Hash *h, void *tmpl) prev->next = b->next; else h->bucket[ix] = b->next; - if (h->bucket[ix] == NULL) - h->used--; - if (h->used < h->size20percent) /* rehash at 20% */ + if (--h->nobjs < h->shrink_threshold) rehash(h, 0); return (void *) b; } diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h index c9e75d7acf..dc7e9c10c5 100644 --- a/erts/emulator/beam/hash.h +++ b/erts/emulator/beam/hash.h @@ -72,10 +72,11 @@ typedef struct hash ErtsAlcType_t type; char* name; /* Table name (static string, for debugging) */ int size; /* Number of slots */ - int size20percent; /* 20 percent of number of slots */ - int size80percent; /* 80 percent of number of slots */ - int ix; /* Size index in size table */ - int used; /* Number of slots used */ + int shrink_threshold; + int grow_threshold; + int size_ix; /* Size index in size table */ + int min_size_ix; /* Never shrink table smaller than this */ + int nobjs; /* Number of objects in table */ HashBucket** bucket; /* Vector of bucket pointers (objects) */ } Hash; -- cgit v1.2.3 From 2afa7580910050b9b087a188215f27553cc0aba3 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 30 Nov 2015 12:08:15 +0100 Subject: erts: Remove unused include files from hash.c Note that hash.c is quite "clean" from Erlang stuff and is used by erl_child_setup as well. --- erts/emulator/beam/hash.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c index 9d247db039..75d091d11c 100644 --- a/erts/emulator/beam/hash.c +++ b/erts/emulator/beam/hash.c @@ -27,8 +27,6 @@ #endif #include "sys.h" -#include "erl_vm.h" -#include "global.h" #include "hash.h" /* -- cgit v1.2.3 From 21918b53a12107fdb1374387acd8b439515bd40d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Mon, 30 Nov 2015 14:46:42 +0100 Subject: hipe: Add tests for bad bit syntax float sizes --- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 7d59482662..7251cdce43 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -17,6 +17,7 @@ test() -> ok = not_used(), ok = bad_append(), ok = system_limit(), + ok = bad_floats(), ok. %%-------------------------------------------------------------------- @@ -257,3 +258,14 @@ system_limit_32() -> {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. -- cgit v1.2.3 From 162d8cdb1ee5efc990abe62a55f8cbff94e48351 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 1 Dec 2015 15:05:49 +0100 Subject: crypto: Avoid bug in OpenSSL-0.9.8 for ECB ciphers that make EVP_CIPHER_iv_length() return non-zero value. Seems to be fixed in 0.9.8m. --- lib/crypto/c_src/crypto.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 18aa8f19ed..bb2771163d 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -99,6 +99,10 @@ # define HAVE_CHACHA20_POLY1305 #endif +#if OPENSSL_VERSION_NUMBER <= 0x009080cfL +# define HAVE_ECB_IVEC_BUG +#endif + #if defined(HAVE_EC) #include #include @@ -358,6 +362,11 @@ static ERL_NIF_TERM atom_onbasis; static ERL_NIF_TERM atom_aes_cfb8; static ERL_NIF_TERM atom_aes_cfb128; +#ifdef HAVE_ECB_IVEC_BUG +static ERL_NIF_TERM atom_aes_ecb; +static ERL_NIF_TERM atom_des_ecb; +static ERL_NIF_TERM atom_blowfish_ecb; +#endif static ErlNifResourceType* hmac_context_rtype; struct hmac_context @@ -613,6 +622,11 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) #endif atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); +#ifdef HAVE_ECB_IVEC_BUG + atom_aes_ecb = enif_make_atom(env, "aes_ecb"); + atom_des_ecb = enif_make_atom(env, "des_ecb"); + atom_blowfish_ecb = enif_make_atom(env, "blowfish_ecb"); +#endif init_digest_types(env); init_cipher_types(env); @@ -1319,6 +1333,12 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM cipher = cipherp->cipher_func(); ivec_size = EVP_CIPHER_iv_length(cipher); +#ifdef HAVE_ECB_IVEC_BUG + if (argv[0] == atom_aes_ecb || argv[0] == atom_blowfish_ecb || + argv[0] == atom_des_ecb) + ivec_size = 0; /* 0.9.8l returns faulty ivec_size */ +#endif + if (text.size % EVP_CIPHER_block_size(cipher) != 0 || (ivec_size == 0 ? argc != 4 : (argc != 5 || -- cgit v1.2.3 From a2ba44595027e09fb562aaede5651d4397bfd23a Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 1 Dec 2015 16:00:54 +0000 Subject: Fix typos in ssl.xml --- lib/ssl/doc/src/ssl.xml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 22ac98c24e..100e0e7cbd 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -245,7 +245,7 @@ RFC 5746. By default secure_renegotiate is set to false, that is, secure renegotiation is used if possible, - but it fallback to unsecure renegotiation if the peer + but it falls back to insecure renegotiation if the peer does not support RFC 5746.

 @@ -331,7 +331,7 @@ atom()}} | unknown_ca

No trusted CA was found in the trusted store. The trusted CA is normally a so called ROOT CA, which is a self-signed certificate. Trust can - be claimed for an intermediat CA (trusted anchor does not have to be + be claimed for an intermediate CA (trusted anchor does not have to be self-signed according to X-509) by using option partial_chain.

 @@ -376,7 +376,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid {http, timeout()}

Enables fetching of CRLs specified as http URIs in X509 cerificate extensions. + marker="public_key:public_key_records"> X509 certificate extensions. Requires the OTP inets application.

 @@ -636,14 +636,14 @@ fun(srp, Username :: string(), UserState :: term()) -> {sni_hosts, [{hostname(), ssloptions()}]}

If the server receives a SNI (Server Name Indication) from the client - matching a host listed in the sni_hosts option, the speicific options for + matching a host listed in the sni_hosts option, the specific options for that host will override previously specified options. The option sni_fun, and sni_hosts are mutually exclusive.

 {sni_fun, SNIfun::fun()}

If the server receives a SNI (Server Name Indication) from the client, - the given function will be called to retrive ssloptions() for indicated server. + the given function will be called to retrieve ssloptions() for the indicated server. These options will be merged into predefined ssloptions(). The function should be defined as: @@ -657,7 +657,7 @@ fun(srp, Username :: string(), UserState :: term()) -> of resources of such an operation is higher for the server than the client. This can act as a vector for denial of service attacks. The SSL application already takes measures to counter-act such attempts, - but client-initiated renegotiation can be stricly disabled by setting + but client-initiated renegotiation can be strictly disabled by setting this option to false. The default value is true. Note that disabling renegotiation can result in long-lived connections becoming unusable due to limits on the number of messages the underlying @@ -773,10 +773,10 @@ fun(srp, Username :: string(), UserState :: term()) -> How = timeout() | {NewController::pid(), timeout()} Reason = term() -

Closes or downgrades an SSL connection, in the later case the transport - connection will be handed over to the NewController process after reciving - the TLS close alert from the peer. The retuned transport socket will have - the following options set [{active, false}, {packet, 0}, {mode, binary}].

+

Closes or downgrades an SSL connection. In the latter case the transport + connection will be handed over to the NewController process after receiving + the TLS close alert from the peer. The returned transport socket will have + the following options set: [{active, false}, {packet, 0}, {mode, binary}]

 @@ -843,7 +843,7 @@ fun(srp, Username :: string(), UserState :: term()) -> Reason = term()

Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. - {ok, Info} will be returned if it executes sucessfully. The Info is a proplists containing the information you requested. + {ok, Info} will be returned if it executes successfully. Info is a proplist containing the information you requested. Otherwise, {error, Reason} will be returned.

 -- cgit v1.2.3 From 33299ece737c635910e358d7e09dd8af6bce1a5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Wed, 2 Dec 2015 14:30:56 +0100 Subject: beam: Fix overflow bug in i_bs_add_jId The test whether the result would fit in a smallnum could overflow into a negative number that would fit a smallnum. A test that reproduces the issue was added to bs_construct_SUITE. --- erts/emulator/beam/beam_emu.c | 2 +- erts/emulator/test/bs_construct_SUITE.erl | 18 ++++++++++++++++-- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 38def5d89f..73292885ce 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4069,7 +4069,7 @@ do { \ tmp_arg1 += Arg1; store_bs_add_result: - if (MY_IS_SSMALL((Sint) tmp_arg1)) { + if (tmp_arg1 <= MAX_SMALL) { tmp_arg1 = make_small(tmp_arg1); } else { /* diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 1afd01e27b..f2bd6c233a 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -29,7 +29,7 @@ mem_leak/1, coerce_to_float/1, bjorn/1, huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1, zero_width/1, bad_append/1]). + otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). -include_lib("test_server/include/test_server.hrl"). @@ -40,7 +40,7 @@ all() -> in_guard, mem_leak, coerce_to_float, bjorn, huge_float_field, huge_binary, system_limit, badarg, copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width, - bad_append]. + bad_append, bs_add_overflow]. groups() -> []. @@ -925,5 +925,19 @@ append_unit_8(Bin) -> append_unit_16(Bin) -> <>. +%% Produce a large result of bs_add that would fit a smallnum if it was viewed +%% as signed. +bs_add_overflow(Config) -> + case erlang:system_info(wordsize) of + 8 -> + {skip, "64-bit architecture"}; + 4 -> + Large = <<0:((1 bsl 30)-1)>>, + {'EXIT',{system_limit,_}} = + (catch <>), + ok + end. id(I) -> I. -- cgit v1.2.3 From 34380bad4985bc827866129597e0bea940e076f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Magnus=20L=C3=A5ng?= Date: Tue, 1 Dec 2015 15:24:25 +0000 Subject: hipe: Fix signed compares of unsigned sizes Also, some of the branches were testing sizes in bits against a constant ?MAX_BINSIZE, which was in bytes. The signed comparisons masked this mistake. These branches have been removed since all sizes in bits that fit in a machine word are valid binary sizes. Finally, a test that reproduces the issue was added to bs_construct, along with a test for one of the cases (bs_init<0>(...)) when the test against ?MAX_BINSIZE must be changed to unsigned rather than removed. --- erts/emulator/test/bs_construct_SUITE.erl | 4 ++-- lib/hipe/rtl/hipe_rtl_binary_construct.erl | 26 +++++++++------------ lib/hipe/rtl/hipe_rtl_binary_match.erl | 21 ++++++++--------- lib/hipe/test/bs_SUITE_data/bs_construct.erl | 34 ++++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 28 deletions(-) diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index f2bd6c233a..7ed99f5b4e 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -925,8 +925,8 @@ append_unit_8(Bin) -> append_unit_16(Bin) -> <>. -%% Produce a large result of bs_add that would fit a smallnum if it was viewed -%% as signed. +%% Produce a large result of bs_add that, if cast to signed int, would overflow +%% into a negative number that fits a smallnum. bs_add_overflow(Config) -> case erlang:system_info(wordsize) of 8 -> diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 80436a6931..4403aa552f 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -386,7 +386,7 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256), + hipe_rtl:mk_branch(UsedBytes, geu, hipe_rtl:mk_imm(256), AllLblName, IncLblName), IncLbl, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), @@ -432,7 +432,7 @@ realloc_binary(SizeReg, ProcBin, Base) -> set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), get_field_from_term(ProcBinValTag, ProcBin, BinPointer), get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize, + hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, get_field_from_term(ProcBinBytesTag, ProcBin, Base), @@ -674,13 +674,13 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), [USize,Tmp] = create_unsafe_regs(2), [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)), @@ -698,8 +698,8 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl, - NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10), + [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), @@ -720,11 +720,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl SubLbl, hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), - ContLbl, - hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, @@ -983,7 +979,7 @@ copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) small_check(SizeVar, CopySize, FalseLblName) -> SuccessLbl = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_branch(SizeVar, le, CopySize, + [hipe_rtl:mk_branch(SizeVar, leu, CopySize, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index b385ea6afc..b7c4dc2536 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -37,7 +37,6 @@ %%-------------------------------------------------------------------- --define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2). -define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa -define(LOW_BITS, 7). %% Three lowest bits set -define(BYTE_SIZE, 8). @@ -819,10 +818,10 @@ create_lbls(0) -> create_lbls(X) when X > 0 -> [hipe_rtl:mk_new_label()|create_lbls(X-1)]. -make_dyn_prep(SizeReg, CCode) -> +make_dyn_prep(SizeReg, CCode) -> [CLbl, SuccessLbl] = create_lbls(2), - Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS), - hipe_rtl:label_name(SuccessLbl), + Init = [hipe_rtl:mk_branch(SizeReg, leu, hipe_rtl:mk_imm(?MAX_SMALL_BITS), + hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl)), SuccessLbl], End = [CLbl|CCode], @@ -867,8 +866,8 @@ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) -> hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))]; {_, WordSize} -> UnsignedBig = {unsigned, big}, - [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), - hipe_rtl:label_name(LessLbl), + [hipe_rtl:mk_branch(TotBits, leu, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), + hipe_rtl:label_name(LessLbl), hipe_rtl:label_name(MoreLbl)), LessLbl, load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad), @@ -928,7 +927,7 @@ get_big_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), load_bytes(LoadDst, Base, ByteOffset, Type, 1), BackLbl, - hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, leu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -957,8 +956,8 @@ get_little_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)), BackLbl, - hipe_rtl:mk_branch(ByteOffset, lt, Limit, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, ltu, Limit, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(DoneLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -1074,7 +1073,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl]; little -> @@ -1086,7 +1085,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, TmpOffset, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl, hipe_rtl:mk_move(Offset, Limit)] diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 7251cdce43..b9e7d93570 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -18,6 +18,7 @@ test() -> ok = bad_append(), ok = system_limit(), ok = bad_floats(), + ok = huge_binaries(), ok. %%-------------------------------------------------------------------- @@ -269,3 +270,36 @@ bad_floats() -> {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. -- cgit v1.2.3 From dee396ffd32dcd68c47cab983c75ba32f921b9db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 4 Dec 2015 12:10:42 +0100 Subject: compile: Eliminate use of the obsolete 'random' module The 'random' module is used to pad the end of a block with random bytes. The appropriate function to use in this case crypto:rand_bytes/1. --- lib/compiler/src/compile.erl | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index a2a23a2b90..b61c104b3c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1306,21 +1306,12 @@ generate_key(String) when is_list(String) -> encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,random_bytes(BlockSize-N)]) + N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)]) end, Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -random_bytes(N) -> - _ = random:seed(erlang:time_offset(), - erlang:monotonic_time(), - erlang:unique_integer()), - random_bytes_1(N, []). - -random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). - save_core_code(St) -> {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. -- cgit v1.2.3 From f67a7375e19734c3f7d6947b0dcf608d0fe1c8fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 1 Dec 2015 18:02:54 +0100 Subject: erts: Use internal hash for process dictionaries --- erts/emulator/beam/erl_process_dict.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 8606371bdf..81469e8716 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -53,11 +53,11 @@ /* Hash utility macros */ #define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition) -#define MAKE_HASH(Term) \ -((is_small(Term)) ? unsigned_val(Term) : \ - ((is_atom(Term)) ? \ - (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ - make_hash2(Term))) +#define MAKE_HASH(Term) \ + ((is_small(Term)) ? unsigned_val(Term) : \ + ((is_atom(Term)) ? \ + (atom_tab(atom_val(Term))->slot.bucket.hvalue) : \ + make_internal_hash(Term))) #define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm)) -- cgit v1.2.3 From c97f3332aeddf039ee2207196229b9ff07047c72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 2 Dec 2015 13:17:28 +0100 Subject: erts: Add i_get_hash instruction Calculate hashvalue in load-time for constant process dictionary gets. --- erts/emulator/beam/beam_emu.c | 10 +++++++ erts/emulator/beam/beam_load.c | 47 +++++++++++++++++++++++++++++ erts/emulator/beam/erl_process_dict.c | 56 +++++++++++++++++++++++------------ erts/emulator/beam/erl_process_dict.h | 1 + erts/emulator/beam/ops.tab | 3 +- 5 files changed, 97 insertions(+), 20 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 38def5d89f..d39cd9d8ea 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3735,6 +3735,16 @@ do { \ StoreBifResult(1, result); } + OpCase(i_get_hash_cId): + { + Eterm arg; + Eterm result; + + GetArg1(0, arg); + result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg); + StoreBifResult(2, result); + } + { Eterm case_end_val; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index b70e5b9a2d..636672217b 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4258,6 +4258,53 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, return op; } +static int +hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx) +{ + switch (Key.type) { + case TAG_a: + *hx = atom_tab(atom_val(Key.val))->slot.bucket.hvalue; + return 1; + case TAG_i: + *hx = Key.val; + return 1; + case TAG_n: + *hx = make_internal_hash(NIL); + return 1; + case TAG_q: + *hx = make_internal_hash(stp->literals[Key.val].term); + return 1; + default: + return 0; + } +} + + +static GenOp* +gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst) +{ + GenOp* op; + Uint32 hx = 0; + + NEW_GENOP(stp, op); + op->next = NULL; + if (hash_internal_genop_arg(stp, Src, &hx)) { + op->arity = 3; + op->op = genop_i_get_hash_3; + op->a[0] = Src; + op->a[1].type = TAG_u; + op->a[1].val = (BeamInstr) hx; + op->a[2] = Dst; + } else { + op->arity = 2; + op->op = genop_i_get_2; + op->a[0] = Src; + op->a[1] = Dst; + } + return op; +} + + static GenOp* gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src, GenOpArg Size, GenOpArg* Rest) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 81469e8716..e497267b63 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -61,6 +61,9 @@ #define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm)) +#define pd_hash_value(Pdict, Key) \ + pd_hash_value_to_ix(Pdict, MAKE_HASH((Key))) + /* Memory allocation macros */ #define PD_ALLOC(Sz) \ erts_alloc(ERTS_ALC_T_PROC_DICT, (Sz)) @@ -82,6 +85,7 @@ */ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); static void pd_hash_erase_all(Process *p); +static Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id); static Eterm pd_hash_get_keys(Process *p, Eterm value); static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd); static Eterm pd_hash_get_all(Process *p, ProcDict *pd); @@ -93,7 +97,7 @@ static void grow(Process *p); static void array_shrink(ProcDict **ppd, unsigned int need); static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term); -static unsigned int pd_hash_value(ProcDict *pdict, Eterm term); +static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx); static unsigned int next_array_size(unsigned int need); /* @@ -390,40 +394,55 @@ static void pd_hash_erase_all(Process *p) } } +Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id) +{ + unsigned int hval; + ProcDict *pd = p->dictionary; + + if (pd == NULL) + return am_undefined; + hval = pd_hash_value_to_ix(pd, hx); + return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id); +} + Eterm erts_pd_hash_get(Process *p, Eterm id) { unsigned int hval; - Eterm tmp; ProcDict *pd = p->dictionary; if (pd == NULL) return am_undefined; hval = pd_hash_value(pd, id); - tmp = ARRAY_GET(pd, hval); - if (is_boxed(tmp)) { /* Tuple */ - ASSERT(is_tuple(tmp)); - if (EQ(tuple_val(tmp)[1], id)) { - return tuple_val(tmp)[2]; + return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id); +} + +Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id) +{ + if (is_boxed(bucket)) { /* Tuple */ + ASSERT(is_tuple(bucket)); + if (EQ(tuple_val(bucket)[1], id)) { + return tuple_val(bucket)[2]; } - } else if (is_list(tmp)) { - for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) { + } else if (is_list(bucket)) { + for (; bucket != NIL && !EQ(tuple_val(TCAR(bucket))[1], id); bucket = TCDR(bucket)) { ; } - if (tmp != NIL) { - return tuple_val(TCAR(tmp))[2]; + if (bucket != NIL) { + return tuple_val(TCAR(bucket))[2]; } - } else if (is_not_nil(tmp)) { + } else if (is_not_nil(bucket)) { #ifdef DEBUG erts_fprintf(stderr, "Process dictionary for process %T is broken, trying to " "display term found in line %d:\n" - "%T\n", p->common.id, __LINE__, tmp); + "%T\n", p->common.id, __LINE__, bucket); #endif erl_exit(1, "Damaged process dictionary found during get/1."); } return am_undefined; } + #define PD_GET_TKEY(Dst,Src) \ do { \ ASSERT(is_tuple((Src))); \ @@ -932,17 +951,16 @@ static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term) ** Basic utilities */ -static unsigned int pd_hash_value(ProcDict *pdict, Eterm term) +static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx) { - Uint hash, high; - - hash = MAKE_HASH(term); - high = hash % (pdict->homeSize*2); + Uint high; + high = hx % (pdict->homeSize*2); if (high >= HASH_RANGE(pdict)) - return hash % pdict->homeSize; + return hx % pdict->homeSize; return high; } + static unsigned int next_array_size(unsigned int need) { static unsigned int tab[] = diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index cc53800eb5..9aa21b7c38 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -39,5 +39,6 @@ void erts_deep_dictionary_dump(int to, void *to_arg, Eterm erts_dictionary_copy(struct process *p, ProcDict *pd); Eterm erts_pd_hash_get(struct process *p, Eterm id); +Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id); #endif diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 1d32e72247..86ae189c27 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1118,7 +1118,7 @@ call_bif e bif0 u$bif:erlang:self/0 Dst=d => self Dst bif0 u$bif:erlang:node/0 Dst=d => node Dst -bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst +bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst) bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst) @@ -1130,6 +1130,7 @@ bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +i_get_hash c I d i_get s d %macro: self Self -- cgit v1.2.3 From 2ae91c3ade0538500ff4dbda29ad539e595f64df Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 15 Oct 2015 20:10:46 +0200 Subject: erts: Change erts_internal:map_type/1 into term_type/1 to support other terms, not just maps --- erts/emulator/beam/atom.h | 1 + erts/emulator/beam/bif.tab | 2 +- erts/emulator/beam/erl_map.c | 25 +++++++++++++++++-------- erts/emulator/test/map_SUITE.erl | 4 ++-- erts/preloaded/ebin/erts_internal.beam | Bin 5964 -> 5988 bytes erts/preloaded/src/erts_internal.erl | 12 ++++++------ lib/kernel/src/erts_debug.erl | 2 +- 7 files changed, 28 insertions(+), 18 deletions(-) diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index ead56c83d8..2c002ca92f 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -129,6 +129,7 @@ typedef enum { (erts_is_atom_utf8_bytes((byte *) LSTR, sizeof(LSTR) - 1, (TERM))) #define ERTS_DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) #define ERTS_INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) +#define ERTS_MAKE_AM(Str) am_atom_put(Str, sizeof(Str) - 1) int atom_table_size(void); /* number of elements */ int atom_table_sz(void); /* table size in bytes, excluding stored objects */ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index c49a3ff313..07d4702b92 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -167,7 +167,7 @@ bif erts_internal:request_system_task/3 bif erts_internal:check_process_code/2 bif erts_internal:map_to_tuple_keys/1 -bif erts_internal:map_type/1 +bif erts_internal:term_type/1 bif erts_internal:map_hashmap_children/1 bif erts_internal:time_unit/0 diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 29b3024644..ac10b9a3e3 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -2698,29 +2698,38 @@ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { } /* - * erts_internal:map_type/1 + * erts_internal:term_type/1 * * Used in erts_debug:size/1 */ -BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) { - DECL_AM(hashmap); - DECL_AM(hashmap_node); - DECL_AM(flatmap); +BIF_RETTYPE erts_internal_term_type_1(BIF_ALIST_1) { if (is_map(BIF_ARG_1)) { Eterm hdr = *(boxed_val(BIF_ARG_1)); ASSERT(is_header(hdr)); switch (hdr & _HEADER_MAP_SUBTAG_MASK) { case HAMT_SUBTAG_HEAD_FLATMAP: - BIF_RET(AM_flatmap); + BIF_RET(ERTS_MAKE_AM("flatmap")); case HAMT_SUBTAG_HEAD_ARRAY: case HAMT_SUBTAG_HEAD_BITMAP: - BIF_RET(AM_hashmap); + BIF_RET(ERTS_MAKE_AM("hashmap")); case HAMT_SUBTAG_NODE_BITMAP: - BIF_RET(AM_hashmap_node); + BIF_RET(ERTS_MAKE_AM("hashmap_node")); default: erl_exit(1, "bad header"); } + } else if (is_immed(BIF_ARG_1)) { + if (is_small(BIF_ARG_1)) { + BIF_RET(ERTS_MAKE_AM("small")); + } else if (is_ifloat(BIF_ARG_1)) { + BIF_RET(ERTS_MAKE_AM("ifloat")); + } + } else if (is_boxed(BIF_ARG_1)) { + if (is_big(BIF_ARG_1)) { + BIF_RET(ERTS_MAKE_AM("big")); + } else if (is_hfloat(BIF_ARG_1)) { + BIF_RET(ERTS_MAKE_AM("hfloat")); + } } BIF_P->fvalue = BIF_ARG_1; BIF_ERROR(BIF_P, BADMAP); diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 6890c42b7a..bde0d408f3 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -2598,7 +2598,7 @@ hashmap_balance(KeyFun) -> F = fun(I, {M0,Max0}) -> Key = KeyFun(I), M1 = M0#{Key => Key}, - Max1 = case erts_internal:map_type(M1) of + Max1 = case erts_internal:term_type(M1) of hashmap -> Nodes = hashmap_nodes(M1), Avg = maps:size(M1) * 0.4, @@ -3004,7 +3004,7 @@ t_gc_rare_map_overflow(Config) -> Loop() end), FatMap = fatmap(34), - false = (flatmap =:= erts_internal:map_type(FatMap)), + false = (flatmap =:= erts_internal:term_type(FatMap)), t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end), diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index dc8c711e1a..d63f79c327 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 7ed4efea4b..023af1579f 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -31,7 +31,7 @@ -export([await_port_send_result/3]). -export([cmp_term/2]). --export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]). +-export([map_to_tuple_keys/1, term_type/1, map_hashmap_children/1]). -export([port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). @@ -215,12 +215,12 @@ cmp_term(_A,_B) -> map_to_tuple_keys(_M) -> erlang:nif_error(undefined). -%% return the internal map type --spec map_type(M) -> Type when - M :: map(), - Type :: 'flatmap' | 'hashmap' | 'hashmap_node'. +%% return the internal term type +-spec term_type(M) -> Type when + M :: term(), + Type :: 'flatmap' | 'hashmap' | 'hashmap_node' | 'small' | 'big' | 'ifloat' | 'hfloat'. -map_type(_M) -> +term_type(_M) -> erlang:nif_error(undefined). %% return the internal hashmap sub-nodes from diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 87f001fdf4..8e2b5ad214 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -243,7 +243,7 @@ map_size(Map,Seen0,Sum0) -> %% is not allowed to leak anywhere. They are only allowed in %% containers (cons cells and tuples, not maps), in gc and %% in erts_debug:same/2 - case erts_internal:map_type(Map) of + case erts_internal:term_type(Map) of flatmap -> Kt = erts_internal:map_to_tuple_keys(Map), Vs = maps:values(Map), -- cgit v1.2.3 From f6eacb9981b40604a031c9d61967b0c3a3588bdb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 13 Nov 2015 17:41:36 +0100 Subject: erts: Let term_type/1 encompass all types --- erts/emulator/beam/erl_map.c | 101 +++++++++++++++++++++++++---------- erts/preloaded/src/erts_internal.erl | 16 ++++-- 2 files changed, 85 insertions(+), 32 deletions(-) diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index ac10b9a3e3..d0ffb11e79 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -2704,35 +2704,82 @@ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { */ BIF_RETTYPE erts_internal_term_type_1(BIF_ALIST_1) { - if (is_map(BIF_ARG_1)) { - Eterm hdr = *(boxed_val(BIF_ARG_1)); - ASSERT(is_header(hdr)); - switch (hdr & _HEADER_MAP_SUBTAG_MASK) { - case HAMT_SUBTAG_HEAD_FLATMAP: - BIF_RET(ERTS_MAKE_AM("flatmap")); - case HAMT_SUBTAG_HEAD_ARRAY: - case HAMT_SUBTAG_HEAD_BITMAP: - BIF_RET(ERTS_MAKE_AM("hashmap")); - case HAMT_SUBTAG_NODE_BITMAP: - BIF_RET(ERTS_MAKE_AM("hashmap_node")); - default: - erl_exit(1, "bad header"); - } - } else if (is_immed(BIF_ARG_1)) { - if (is_small(BIF_ARG_1)) { - BIF_RET(ERTS_MAKE_AM("small")); - } else if (is_ifloat(BIF_ARG_1)) { - BIF_RET(ERTS_MAKE_AM("ifloat")); - } - } else if (is_boxed(BIF_ARG_1)) { - if (is_big(BIF_ARG_1)) { - BIF_RET(ERTS_MAKE_AM("big")); - } else if (is_hfloat(BIF_ARG_1)) { - BIF_RET(ERTS_MAKE_AM("hfloat")); + Eterm obj = BIF_ARG_1; + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: + BIF_RET(ERTS_MAKE_AM("list")); + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(obj); + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + BIF_RET(ERTS_MAKE_AM("tuple")); + case EXPORT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("export")); + case FUN_SUBTAG: + BIF_RET(ERTS_MAKE_AM("fun")); + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : + BIF_RET(ERTS_MAKE_AM("flatmap")); + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + BIF_RET(ERTS_MAKE_AM("hashmap")); + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + BIF_RET(ERTS_MAKE_AM("hashmap_node")); + default: + erl_exit(ERTS_ABORT_EXIT, "term_type: bad map header type %d\n", MAP_HEADER_TYPE(hdr)); + } + case REFC_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("refc_binary")); + case HEAP_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("heap_binary")); + case SUB_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("sub_binary")); + case BIN_MATCHSTATE_SUBTAG: + BIF_RET(ERTS_MAKE_AM("matchstate")); + case POS_BIG_SUBTAG: + case NEG_BIG_SUBTAG: + BIF_RET(ERTS_MAKE_AM("bignum")); + case REF_SUBTAG: + BIF_RET(ERTS_MAKE_AM("reference")); + case EXTERNAL_REF_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_reference")); + case EXTERNAL_PID_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_pid")); + case EXTERNAL_PORT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_port")); + case FLOAT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("hfloat")); + default: + erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", hdr); + } } + case TAG_PRIMARY_IMMED1: + switch (obj & _TAG_IMMED1_MASK) { + case _TAG_IMMED1_SMALL: + BIF_RET(ERTS_MAKE_AM("fixnum")); + case _TAG_IMMED1_PID: + BIF_RET(ERTS_MAKE_AM("pid")); + case _TAG_IMMED1_PORT: + BIF_RET(ERTS_MAKE_AM("port")); + case _TAG_IMMED1_IMMED2: + switch (obj & _TAG_IMMED2_MASK) { + case _TAG_IMMED2_ATOM: + BIF_RET(ERTS_MAKE_AM("atom")); + case _TAG_IMMED2_CATCH: + BIF_RET(ERTS_MAKE_AM("catch")); + case _TAG_IMMED2_NIL: + BIF_RET(ERTS_MAKE_AM("nil")); + default: + erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); + } + default: + erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); + } + default: + erl_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); } - BIF_P->fvalue = BIF_ARG_1; - BIF_ERROR(BIF_P, BADMAP); } /* diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 023af1579f..ce0a6a1d9e 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -216,11 +216,17 @@ map_to_tuple_keys(_M) -> erlang:nif_error(undefined). %% return the internal term type --spec term_type(M) -> Type when - M :: term(), - Type :: 'flatmap' | 'hashmap' | 'hashmap_node' | 'small' | 'big' | 'ifloat' | 'hfloat'. - -term_type(_M) -> +-spec term_type(T) -> Type when + T :: term(), + Type :: 'flatmap' | 'hashmap' | 'hashmap_node' + | 'fixnum' | 'bignum' | 'hfloat' + | 'list' | 'tuple' | 'export' | 'fun' + | 'refc_binary' | 'heap_binary' | 'sub_binary' + | 'reference' | 'external_reference' + | 'pid' | 'external_pid' | 'port' | 'external_port' + | 'atom' | 'catch' | 'nil'. + +term_type(_T) -> erlang:nif_error(undefined). %% return the internal hashmap sub-nodes from -- cgit v1.2.3 From 4f3212c9a84e6feaea1bbffdc1972e4760cc7815 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 13 Nov 2015 19:14:10 +0100 Subject: Test erts_internal:term_type/1 --- erts/emulator/test/erts_debug_SUITE.erl | 45 +++++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 35677f9953..bbba829501 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -24,13 +24,13 @@ -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, - test_size/1,flat_size_big/1,df/1, + test_size/1,flat_size_big/1,df/1,term_type/1, instructions/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [test_size, flat_size_big, df, instructions]. + [test_size, flat_size_big, df, instructions, term_type]. groups() -> []. @@ -138,6 +138,47 @@ flat_size_big_1(Term, Size0, Limit) when Size0 < Limit -> end; flat_size_big_1(_, _, _) -> ok. + +term_type(Config) when is_list(Config) -> + Ts = [{fixnum, 1}, + {fixnum, -1}, + {bignum, 1 bsl 300}, + {bignum, -(1 bsl 300)}, + {hfloat, 0.0}, + {hfloat, 0.0/-1}, + {hfloat, 1.0/(1 bsl 302)}, + {hfloat, 1.0*(1 bsl 302)}, + {hfloat, -1.0/(1 bsl 302)}, + {hfloat, -1.0*(1 bsl 302)}, + {hfloat, 3.1416}, + {hfloat, 1.0e18}, + {hfloat, -3.1416}, + {hfloat, -1.0e18}, + + {heap_binary, <<1,2,3>>}, + {refc_binary, <<0:(8*80)>>}, + {sub_binary, <<5:7>>}, + + {flatmap, #{ a => 1}}, + {hashmap, maps:from_list([{I,I}||I <- lists:seq(1,76)])}, + + {list, [1,2,3]}, + {nil, []}, + {tuple, {1,2,3}}, + {tuple, {}}, + + {export, fun lists:sort/1}, + {'fun', fun() -> ok end}, + {pid, self()}, + {atom, atom}], + lists:foreach(fun({E,Val}) -> + R = erts_internal:term_type(Val), + io:format("expecting term type ~w, got ~w (~p)~n", [E,R,Val]), + E = R + end, Ts), + ok. + + df(Config) when is_list(Config) -> P0 = pps(), PrivDir = ?config(priv_dir, Config), -- cgit v1.2.3 From 04a8110358706fe73a9dbedb81584d9f7fd27377 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 7 Dec 2015 20:02:19 +0100 Subject: erts: Add new test cases to float_SUITE --- erts/emulator/test/float_SUITE.erl | 124 +++++++++++++++++++++++++++ erts/emulator/test/float_SUITE_data/fp_drv.c | 1 + 2 files changed, 125 insertions(+) diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index c1a76b8af4..8826026f88 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -26,9 +26,11 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, + t_mul_add_ops/1, bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). -export([hidden_inf/1]). +-export([arith/1]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> @@ -45,6 +47,7 @@ all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, match, bad_float_unpack, write, {group, comparison} ,hidden_inf + ,arith, t_mul_add_ops ]. groups() -> @@ -328,3 +331,124 @@ hidden_inf_1(A, B, Zero, Huge) -> {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))), {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))), {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))). + +%% Improve code coverage in our different arithmetic functions +%% and make sure they yield consistent results. +arith(_Config) -> + _TAG_IMMED1_SIZE = 4, + + <> = <<0:1, 16#7fe:11, -1:52>>, + <> = <<0:1, 0:11, 1:52>>, + <> = <<1:1, 0:11, 0:52>>, + + WORD_BITS = erlang:system_info(wordsize) * 8, + SMALL_BITS = (WORD_BITS - _TAG_IMMED1_SIZE), + SMALL_MAX = (1 bsl (SMALL_BITS-1)) - 1, + SMALL_MIN = -(1 bsl (SMALL_BITS-1)), + BIG1_MAX = (1 bsl WORD_BITS) - 1, + BIG2_MAX = (1 bsl (WORD_BITS*2)) - 1, + + fixnum = erts_internal:term_type(SMALL_MAX), + fixnum = erts_internal:term_type(SMALL_MIN), + bignum = erts_internal:term_type(SMALL_MAX + 1), + bignum = erts_internal:term_type(SMALL_MIN - 1), + + L = [0, 0.0, FloatNegZero, 1, 1.0, 17, 17.0, 0.17, + FLOAT_MIN, FLOAT_MAX, + SMALL_MAX, SMALL_MAX+1, + SMALL_MIN, SMALL_MIN-1, + BIG1_MAX, BIG1_MAX+1, + BIG2_MAX, BIG2_MAX+1, + trunc(FLOAT_MAX), trunc(FLOAT_MAX)+1, trunc(FLOAT_MAX)*2, + + immed_badarg, + "list badarg", + {"boxed badarg"} + ], + + foreach_pair(fun(A,B) -> do_bin_ops(A,B) end, L). + +foreach_pair(F, L) -> + lists:foreach( + fun(A) -> lists:foreach(fun(B) -> F(A,B) end, L) end, + L). + +do_bin_ops(A, B) -> + Fun = fun(Op) -> + Op(A,B), + is_number(A) andalso Op(-A,B), + is_number(B) andalso Op(A,-B), + is_number(A) andalso is_number(B) andalso Op(-A,-B) + end, + lists:foreach(Fun, + [fun op_add/2, fun op_sub/2, fun op_mul/2, fun op_div/2]). + +op_add(A, B) -> + Info = [A,B], + R = unify(catch A + B, Info), + R = unify(my_apply(erlang,'+',[A,B]), Info), + case R of + _ when A + B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_sub(A, B) -> + Info = [A,B], + R = unify(catch A - B, Info), + R = unify(my_apply(erlang,'-',[A,B]), Info), + case R of + _ when A - B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_mul(A, B) -> + Info = [A,B], + R = unify(catch A * B, Info), + R = unify(my_apply(erlang,'*',[A,B]), Info), + case R of + _ when A * B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_div(A, B) -> + Info = [A,B], + R = unify(catch A / B, Info), + R = unify(my_apply(erlang,'/',[A,B]), Info), + case R of + _ when A / B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +my_apply(M, F, A) -> + catch apply(id(M), id(F), A). + +% Unify exceptions be removing stack traces. +% and add argument info to make it easer to debug failed matches. +unify({'EXIT',{Reason,_Stack}}, Info) -> + {{'EXIT', Reason}, Info}; +unify(Other, Info) -> + {Other, Info}. + + +-define(epsilon, 1.0e-20). +check_epsilon(R,Val) -> + if erlang:abs(R-Val) < ?epsilon -> ok; + true -> ?t:fail({R,Val}) + end. + +t_mul_add_ops(Config) when is_list(Config) -> + check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0), + check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0), + check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0), + check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0), + check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0), + check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0), + check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9), + check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997), + ok. + + +op_mul_add(0, _, _, R) -> R; +op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) -> + op_mul_add(N - 1, A, B, R * A + B). + diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c index 5919dd8e2f..a91d622040 100644 --- a/erts/emulator/test/float_SUITE_data/fp_drv.c +++ b/erts/emulator/test/float_SUITE_data/fp_drv.c @@ -18,6 +18,7 @@ */ #if defined(DEBUG) || 0 +# include # define PRINTF(X) printf X #else # define PRINTF(X) -- cgit v1.2.3 From bc40e21224e871c9bcbb5c2f27854c308bc4fe01 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Sun, 6 Dec 2015 21:37:42 +0000 Subject: Fix compilation with `--enable-vm-probes` ... broken by 3ac08f9b. Compilation error: ``` beam/erl_message.c: In function 'erts_send_message': beam/erl_message.c:753:56: error: macro "copy_struct" requires 4 arguments, but only 3 given utag = copy_struct(DT_UTAG(sender), dt_utag_size, ohp); ^ beam/erl_message.c:753:10: error: 'copy_struct' undeclared (first use in this function) utag = copy_struct(DT_UTAG(sender), dt_utag_size, ohp); ^ beam/erl_message.c:753:10: note: each undeclared identifier is reported only once for each function it appears in ``` --- erts/emulator/beam/erl_message.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 1811651a58..d593108f8e 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -750,7 +750,7 @@ erts_send_message(Process* sender, if (is_immed(DT_UTAG(sender))) utag = DT_UTAG(sender); else - utag = copy_struct(DT_UTAG(sender), dt_utag_size, ohp); + utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp); #ifdef DTRACE_TAG_HARDDEBUG erts_fprintf(stderr, "Dtrace -> (%T) Spreading tag (%T) with " -- cgit v1.2.3 From ac529b0326496e52f3289464f9410001bc3bde6d Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 16 Nov 2015 11:21:49 +0100 Subject: Fix memory leaks --- erts/emulator/beam/erl_gc.c | 8 +++++++- erts/emulator/beam/erl_process.c | 17 +++++++++++------ 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6cb37752bc..3bb1f601aa 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -734,6 +734,12 @@ erts_garbage_collect_hibernate(Process* p) p->arg_reg, p->arity); + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (p->abandoned_heap + ? p->abandoned_heap + : p->heap), + p->heap_sz * sizeof(Eterm)); + p->heap = heap; p->high_water = htop; p->htop = htop; @@ -1435,7 +1441,7 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, (p->abandoned_heap ? p->abandoned_heap : HEAP_START(p)), - (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm)); + p->heap_sz * sizeof(Eterm)); p->abandoned_heap = NULL; p->flags &= ~F_ABANDONED_HEAP_USE; HEAP_START(p) = n_heap; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9acce8acb6..ebb4d323e6 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11259,6 +11259,7 @@ erts_cleanup_empty_process(Process* p) static void delete_process(Process* p) { + Eterm *heap; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); /* Cleanup psd */ @@ -11283,16 +11284,17 @@ delete_process(Process* p) * Release heaps. Clobber contents in DEBUG build. */ - -#ifdef DEBUG - sys_memset(p->heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); -#endif - #ifdef HIPE hipe_delete_process(&p->hipe); #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) p->heap, p->heap_sz*sizeof(Eterm)); + heap = p->abandoned_heap ? p->abandoned_heap : p->heap; + +#ifdef DEBUG + sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); +#endif + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm)); if (p->old_heap != NULL) { #ifdef DEBUG @@ -11311,6 +11313,9 @@ delete_process(Process* p) free_message_buffer(p->mbuf); } + if (p->msg_frag) + erts_cleanup_messages(p->msg_frag); + erts_erase_dicts(p); /* free all pending messages */ -- cgit v1.2.3 From ccbb5ba4d0198f3ba21b83ae1aca3fe52a7f2c80 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 17 Nov 2015 15:21:56 +0100 Subject: Remove unused variable --- erts/emulator/beam/erl_process.c | 4 +--- erts/emulator/beam/erl_process.h | 1 - 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ebb4d323e6..ebe9361b8d 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -335,7 +335,6 @@ static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info; static Uint last_reductions; static Uint last_exact_reductions; -Uint erts_default_process_flags; Eterm erts_system_monitor; Eterm erts_system_monitor_long_gc; Uint erts_system_monitor_long_schedule; @@ -682,7 +681,6 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) last_reductions = 0; last_exact_reductions = 0; - erts_default_process_flags = 0; } void @@ -10737,7 +10735,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm args, /* Arguments for function (must be well-formed list). */ ErlSpawnOpts* so) /* Options for spawn. */ { - Uint flags = erts_default_process_flags; + Uint flags = 0; ErtsRunQueue *rq = NULL; Process *p; Sint arity; /* Number of arguments. */ diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 884027f482..b80aa12872 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1248,7 +1248,6 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra); Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz); #endif -extern Uint erts_default_process_flags; extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx; /* If any of the erts_system_monitor_* variables are set (enabled), ** erts_system_monitor must be != NIL, to allow testing on just -- cgit v1.2.3 From 6ba10e6d64477a4c470baa079eaaf2b20a746747 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 17 Nov 2015 15:24:55 +0100 Subject: Off heap message queue test suite --- erts/emulator/test/Makefile | 1 + .../emulator/test/off_heap_message_queue_SUITE.erl | 216 +++++++++++++++++++++ 2 files changed, 217 insertions(+) create mode 100644 erts/emulator/test/off_heap_message_queue_SUITE.erl diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 77614d455c..6519fd8982 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -79,6 +79,7 @@ MODULES= \ node_container_SUITE \ nofrag_SUITE \ num_bif_SUITE \ + off_heap_message_queue_SUITE \ op_SUITE \ port_SUITE \ port_bif_SUITE \ diff --git a/erts/emulator/test/off_heap_message_queue_SUITE.erl b/erts/emulator/test/off_heap_message_queue_SUITE.erl new file mode 100644 index 0000000000..a667704942 --- /dev/null +++ b/erts/emulator/test/off_heap_message_queue_SUITE.erl @@ -0,0 +1,216 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(off_heap_message_queue_SUITE). + +-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, process_info_messages/1]). + +-export([basic_test/1]). + +-include_lib("test_server/include/test_server.hrl"). + +init_per_testcase(Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(2)), + [{watchdog, Dog}, {testcase, Case}|Config]. + +end_per_testcase(_, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, process_info_messages]. + +groups() -> + []. + +init_per_suite(Config) -> +%% erts_debug:set_internal_state(available_internal_state, true), + Config. + +end_per_suite(_Config) -> +%% erts_debug:set_internal_state(available_internal_state, false), + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% +%% +%% Test cases +%% +%% + +basic(Config) when is_list(Config) -> + + basic_test(erlang:system_info(off_heap_message_queue)), + + {ok, Node1} = start_node(Config, "+xohmq true"), + ok = rpc:call(Node1, ?MODULE, basic_test, [true]), + stop_node(Node1), + + {ok, Node2} = start_node(Config, "+xohmq false"), + ok = rpc:call(Node2, ?MODULE, basic_test, [false]), + stop_node(Node2), + ok. + +basic_test(Default) -> + + Default = erlang:system_info(off_heap_message_queue), + true = (Default == true) orelse (Default == false), + + {off_heap_message_queue, Default} = process_info(self(), off_heap_message_queue), + Default = process_flag(off_heap_message_queue, true), + {off_heap_message_queue, true} = process_info(self(), off_heap_message_queue), + true = process_flag(off_heap_message_queue, false), + {off_heap_message_queue, false} = process_info(self(), off_heap_message_queue), + false = process_flag(off_heap_message_queue, Default), + {'EXIT', _} = (catch process_flag(off_heap_message_queue, blupp)), + + P1 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link]), + {off_heap_message_queue, Default} = process_info(P1, off_heap_message_queue), + unlink(P1), + exit(P1, bye), + + P2 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {off_heap_message_queue, false}]), + {off_heap_message_queue, false} = process_info(P2, off_heap_message_queue), + unlink(P2), + exit(P2, bye), + + P3 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {off_heap_message_queue, true}]), + {off_heap_message_queue, true} = process_info(P3, off_heap_message_queue), + unlink(P3), + exit(P3, bye), + + {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {off_heap_message_queue, blapp}])), + + ok. + +process_info_messages(Config) when is_list(Config) -> + Tester = self(), + P1 = spawn_opt(fun () -> + receive after 500 -> ok end, + false = process_flag(off_heap_message_queue, true), + Tester ! first, + receive after 500 -> ok end, + true = process_flag(off_heap_message_queue, false), + Tester ! second, + receive after 500 -> ok end, + false = process_flag(off_heap_message_queue, true), + Tester ! third, + receive after 500 -> ok end, + true = process_flag(off_heap_message_queue, false), + Tester ! fourth, + + receive after infinity -> ok end + end, + [link, {off_heap_message_queue, false}]), + + P1 ! "A", + receive first -> ok end, + P1 ! "B", + receive second -> ok end, + P1 ! "C", + receive third -> ok end, + P1 ! "D", + receive fourth -> ok end, + P1 ! "E", + + {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages), + + P2 = spawn_opt(fun () -> + receive after 500 -> ok end, + false = process_flag(off_heap_message_queue, true), + Tester ! first, + receive after 500 -> ok end, + true = process_flag(off_heap_message_queue, false), + Tester ! second, + receive after 500 -> ok end, + false = process_flag(off_heap_message_queue, true), + Tester ! third, + receive after 500 -> ok end, + true = process_flag(off_heap_message_queue, false), + Tester ! fourth, + receive after 500 -> ok end, + + Tester ! process_info(self(), messages), + + receive M1 -> M1 = "A" end, + receive M2 -> M2 = "B" end, + receive M3 -> M3 = "C" end, + receive M4 -> M4 = "D" end, + receive M5 -> M5 = "E" end, + + Tester ! self() + end, + [link, {off_heap_message_queue, false}]), + + P2 ! "A", + receive first -> ok end, + P2 ! "B", + receive second -> ok end, + P2 ! "C", + receive third -> ok end, + P2 ! "D", + receive fourth -> ok end, + P2 ! "E", + + receive + Msg -> + {messages, ["A", "B", "C", "D", "E"]} = Msg + end, + + receive P2 -> ok end, + + ok. + +%% +%% +%% helpers +%% +%% + +start_node(Config) -> + start_node(Config, []). +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). -- cgit v1.2.3 From cc3cc025f43a00281d2f836e12c2e1627cd50145 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 17 Nov 2015 15:25:22 +0100 Subject: Fix process_info(_, off_heap_message_queue) --- erts/emulator/beam/erl_bif_info.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 1eb106a551..3fe8aed50e 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1497,7 +1497,7 @@ process_info_aux(Process *BIF_P, } case am_off_heap_message_queue: - res = BIF_P->flags & F_OFF_HEAP_MSGQ ? am_true : am_false; + res = rp->flags & F_OFF_HEAP_MSGQ ? am_true : am_false; hp = HAlloc(BIF_P, 3); break; -- cgit v1.2.3 From a5dd6499d53ed596e2f8aa17ee35ff87cd32fe60 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Thu, 19 Nov 2015 17:07:06 +0100 Subject: Distinguish between GC disabled by BIFs and other disabled GC Processes remember heap fragments that are known to be fully live due to creation in a just called BIF that yields in the live_hf_end field. This field must not be used if we have not disabled GC in a BIF. F_DELAY_GC has been introduced in order to distinguish between to two different scenarios. - F_DISABLE_GC should *only* be used by BIFs. This when the BIF needs to yield while preventig a GC. - F_DELAY_GC should only be used when GC is temporarily disabled while the process is scheduled. A process must not be scheduled out while F_DELAY_GC is set. --- erts/emulator/beam/beam_emu.c | 14 +++++++------- erts/emulator/beam/erl_gc.c | 15 ++++++++++++--- erts/emulator/beam/erl_process.c | 2 ++ erts/emulator/beam/erl_process.h | 14 +++++++++++++- erts/emulator/hipe/hipe_native_bif.c | 6 +++--- 5 files changed, 37 insertions(+), 14 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 208a16dfd0..95a22e6c54 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1843,8 +1843,8 @@ void process_main(void) * in the queue. This since messages with data outside * the heap will be corrupted by a GC. */ - ASSERT(!(c_p->flags & F_DISABLE_GC)); - c_p->flags |= F_DISABLE_GC; + ASSERT(!(c_p->flags & F_DELAY_GC)); + c_p->flags |= F_DELAY_GC; loop_rec__: PROCESS_MAIN_CHK_LOCKS(c_p); @@ -1858,7 +1858,7 @@ void process_main(void) if (ERTS_PROC_PENDING_EXIT(c_p)) { erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); SWAPOUT; - c_p->flags &= ~F_DISABLE_GC; + c_p->flags &= ~F_DELAY_GC; goto do_schedule; /* Will be rescheduled for exit */ } ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); @@ -1868,7 +1868,7 @@ void process_main(void) else #endif { - c_p->flags &= ~F_DISABLE_GC; + c_p->flags &= ~F_DELAY_GC; SET_I((BeamInstr *) Arg(0)); Goto(*I); /* Jump to a wait or wait_timeout instruction */ } @@ -1997,7 +1997,7 @@ void process_main(void) CANCEL_TIMER(c_p); erts_save_message_in_proc(c_p, msgp); - c_p->flags &= ~F_DISABLE_GC; + c_p->flags &= ~F_DELAY_GC; if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { /* @@ -2019,7 +2019,7 @@ void process_main(void) */ OpCase(loop_rec_end_f): { - ASSERT(c_p->flags & F_DISABLE_GC); + ASSERT(c_p->flags & F_DELAY_GC); SET_I((BeamInstr *) Arg(0)); SAVE_MESSAGE(c_p); @@ -2028,7 +2028,7 @@ void process_main(void) goto loop_rec__; } - c_p->flags &= ~F_DISABLE_GC; + c_p->flags &= ~F_DELAY_GC; c_p->i = I; SWAPOUT; c_p->arity = 0; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 3bb1f601aa..3784367195 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -440,8 +440,15 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) ERTS_HOLE_CHECK(p); - if (p->live_hf_end == ERTS_INVALID_HFRAG_PTR) + if ((p->flags & F_DISABLE_GC) + && p->live_hf_end == ERTS_INVALID_HFRAG_PTR) { + /* + * A BIF yielded with disabled GC. Remember + * heap fragments created by the BIF until we + * do next GC. + */ p->live_hf_end = live_hf_end; + } if (need == 0) return 1; @@ -564,10 +571,12 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif - if (p->flags & F_DISABLE_GC) + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) return delay_garbage_collection(p, live_hf_end, need); - if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) + if (p->abandoned_heap) + live_hf_end = ERTS_INVALID_HFRAG_PTR; + else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) live_hf_end = p->live_hf_end; esdp = erts_get_scheduler_data(); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ebe9361b8d..d17355207b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9262,6 +9262,8 @@ Process *schedule(Process *p, int calls) } else { sched_out_proc: + ASSERT(!(p->flags & F_DELAY_GC)); + #ifdef ERTS_SMP ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); esdp = p->scheduler_data; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b80aa12872..41b367435d 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1288,10 +1288,22 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */ #define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ -#define F_DISABLE_GC (1 << 11) /* Disable GC */ +#define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ #define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ #define F_OFF_HEAP_MSGQ_CHNG (1 << 13) /* Off heap msg queue changing */ #define F_ABANDONED_HEAP_USE (1 << 14) /* Have usage of abandoned heap */ +#define F_DELAY_GC (1 << 15) /* Similar to disable GC (see below) */ + +/* + * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent + * GC of the process, but it is important to use the right + * one: + * - F_DISABLE_GC should *only* be used by BIFs. This when + * the BIF needs to yield while preventig a GC. + * - F_DELAY_GC should only be used when GC is temporarily + * disabled while the process is scheduled. A process must + * not be scheduled out while F_DELAY_GC is set. + */ /* process trace_flags */ #define F_SENSITIVE (1 << 0) diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index ad8fb685e5..1bfee94e9e 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -164,7 +164,7 @@ void hipe_select_msg(Process *p) JOIN_MESSAGE(p); CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */ erts_save_message_in_proc(p, msgp); - p->flags &= ~F_DISABLE_GC; + p->flags &= ~F_DELAY_GC; if (ERTS_IS_GC_DESIRED(p)) { /* * We want to GC soon but we leave a few @@ -519,7 +519,7 @@ Eterm hipe_check_get_msg(Process *c_p) { ErtsMessage *msgp; - c_p->flags |= F_DISABLE_GC; + c_p->flags |= F_DELAY_GC; next_message: @@ -541,7 +541,7 @@ Eterm hipe_check_get_msg(Process *c_p) /* XXX: BEAM doesn't need this */ c_p->hipe_smp.have_receive_locks = 1; #endif - c_p->flags &= ~F_DISABLE_GC; + c_p->flags &= ~F_DELAY_GC; return THE_NON_VALUE; #ifdef ERTS_SMP } -- cgit v1.2.3 From 1cd97bc82d042bc713473932af7d6061065f6527 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Fri, 20 Nov 2015 16:57:32 +0100 Subject: Always use literal_alloc --- erts/emulator/beam/erl_alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 019aa0f16c..5574a3b713 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -290,7 +290,7 @@ static void set_default_literal_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); - ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->enable = 1; ip->thr_spec = 0; ip->atype = BESTFIT; ip->init.bf.ao = 1; -- cgit v1.2.3 From 19c4689eea86f26c5af9b8f712c227ce4f62310b Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 24 Nov 2015 15:57:55 +0100 Subject: Replace off_heap_message_queue option with message_queue_data option The message_queue_data option can have the values - off_heap - on_heap - mixed --- erts/doc/src/erl.xml | 10 +- erts/doc/src/erlang.xml | 94 +++++--- erts/emulator/beam/atom.names | 5 +- erts/emulator/beam/bif.c | 30 +-- erts/emulator/beam/erl_bif_info.c | 37 +++- erts/emulator/beam/erl_gc.c | 195 ++++++++++++++++- erts/emulator/beam/erl_init.c | 21 +- erts/emulator/beam/erl_message.c | 160 ++++++++++---- erts/emulator/beam/erl_message.h | 2 +- erts/emulator/beam/erl_process.c | 4 + erts/emulator/beam/erl_process.h | 21 +- erts/emulator/test/Makefile | 2 +- erts/emulator/test/message_queue_data_SUITE.erl | 239 +++++++++++++++++++++ .../emulator/test/off_heap_message_queue_SUITE.erl | 216 ------------------- erts/etc/common/erlexec.c | 2 +- erts/preloaded/src/erlang.erl | 17 +- 16 files changed, 704 insertions(+), 351 deletions(-) create mode 100644 erts/emulator/test/message_queue_data_SUITE.erl delete mode 100644 erts/emulator/test/off_heap_message_queue_SUITE.erl diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index c4eb0e16ec..b6fa4c254c 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1338,14 +1338,14 @@

Default process flag settings.

- +xohmq true|false + +xmqd off_heap|on_heap|mixed

Sets the default value for the process flag - off_heap_message_queue. If +xohmq is not - passed, false will be the default. For more information, + message_queue_data. If +xmqd is not + passed, mixed will be the default. For more information, see the documentation of - process_flag(off_heap_message_queue, - OHMQ). + process_flag(message_queue_data, + MQD).

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 2e82bb62a9..6ed03f3dfc 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -58,6 +58,12 @@ + + +

See erlang:process_flag(message_queue_data, MQD).

+ + +

See erlang:timestamp/0.

@@ -4280,39 +4286,52 @@ os_prompt%

Returns the old value of the flag.

 - + - Set process flag off_heap_message_queue for the calling process + Set process flag message_queue_data for the calling process +

This flag determines how messages in the message queue are stored. When the flag is:

- true + off_heap

All messages in the message queue will be stored outside of the process heap. This implies that no messages in the message queue will be part of a garbage collection of the process.

- false + on_heap +

+ All messages in the message queue will eventually be + placed on heap. They may however temporarily be stored + off heap. This is how messages always have been stored + up until ERTS version 8.0. +

+ mixed

Messages may be placed either on the heap or outside of the heap.

+

+ The default message_queue_data process flag is determined + by the +xmqd + erl command line argument. +

If the process potentially may get a hugh amount of messages, - you are recommended to set the flag to true. This since - a garbage collection with lots of messages placed on the heap - may become extremly expensive. Performance of the actual - message passing is however generally better when setting the - flag to false. + you are recommended to set the flag to off_heap. This + since a garbage collection with lots of messages placed on + the heap may become extremly expensive and the process may + consume large amounts of memory. Performance of the + actual message passing is however generally better when not + using the off_heap flag.

- When changing this flag from false to true, - all messages in the message queue are moved off heap. This - work has been initiated but not completed when this function + When changing this flag messages will be moved. This work + has been initiated but not completed when this function call returns.

Returns the old value of the flag.

@@ -4478,6 +4497,7 @@ os_prompt% +

Returns a list containing InfoTuples with miscellaneous information about the process identified by @@ -4530,6 +4550,7 @@ os_prompt% +

Returns information about the process identified by Pid, as specified by @@ -4698,13 +4719,14 @@ os_prompt% monitor by name, the list item is {process, {RegName, Node}}.

- {off_heap_message_queue, OHMQ} + {message_queue_data, MQD} -

Returns the current state of the off_heap_message_queue - process flag. OHMQ is either true, or - false. For more information, see the documentation of - process_flag(off_heap_message_queue, - OHMQ).

+

Returns the current state of the message_queue_data + process flag. MQD is either off_heap, + on_heap, or mixed. For more information, see the + documentation of + process_flag(message_queue_data, + MQD).

 {priority, Level} @@ -5474,6 +5496,7 @@ true Creates a new process with a fun as entry point. +

Returns the process identifier (pid) of a new process @@ -5490,6 +5513,7 @@ true Creates a new process with a fun as entry point on a given node. +

Returns the process identifier (pid) of a new process started @@ -5505,6 +5529,7 @@ true Creates a new process with a function as entry point. +

Works as @@ -5607,17 +5632,17 @@ true fine-tuning an application and to measure the execution time with various VSize values.

 - {off_heap_message_queue, OHMQ} + {message_queue_data, MQD} -

Sets the state of the off_heap_message_queue process - flag. OHMQ should be either true, or - false. The default off_heap_message_queue process - flag is determined by the - +xohmq erl +

Sets the state of the message_queue_data process + flag. MQD should be either off_heap, + on_heap, or mixed. The default + message_queue_data process flag is determined by the + +xmqd erl command line argument. For more information, see the documentation of - process_flag(off_heap_message_queue, - OHMQ).

+ process_flag(message_queue_data, + MQD).

 @@ -5627,6 +5652,7 @@ true Creates a new process with a function as entry point on a given node. +

Returns the process identifier (pid) of a new process started @@ -7106,15 +7132,15 @@ ok used by the runtime system. It is on the form "<major ver>.<minor ver>".

- off_heap_message_queue + message_queue_data -

Returns the default value of the off_heap_message_queue - process flag which is either true or false. This - default is set by the erl command line argument - +xohmq. For more information on the - off_heap_message_queue process flag, see documentation of - process_flag(off_heap_message_queue, - OHMQ).

+

Returns the default value of the message_queue_data + process flag which is either off_heap, on_heap, or mixed. + This default is set by the erl command line argument + +xmqd. For more information on the + message_queue_data process flag, see documentation of + process_flag(message_queue_data, + MQD).

 otp_release diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index ea04495574..7424e47ec3 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -350,6 +350,7 @@ atom memory_internal atom memory_types atom message atom message_binary +atom message_queue_data atom message_queue_len atom messages atom merge_trap @@ -361,6 +362,7 @@ atom min_heap_size atom min_bin_vheap_size atom minor_version atom Minus='-' +atom mixed atom module atom module_info atom monitored_by @@ -423,11 +425,12 @@ atom notify atom notsup atom nouse_stdio atom objects -atom off_heap_message_queue +atom off_heap atom offset atom ok atom old_heap_block_size atom old_heap_size +atom on_heap atom on_load atom open atom open_error diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index f0340540cb..410a6cecac 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -910,13 +910,22 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) so.priority = PRIORITY_LOW; else goto error; - } else if (arg == am_off_heap_message_queue) { - if (val == am_true) - so.flags |= SPO_OFF_HEAP_MSGQ; - else if (val == am_false) + } else if (arg == am_message_queue_data) { + switch (val) { + case am_mixed: + so.flags &= ~(SPO_OFF_HEAP_MSGQ|SPO_ON_HEAP_MSGQ); + break; + case am_on_heap: so.flags &= ~SPO_OFF_HEAP_MSGQ; - else + so.flags |= SPO_ON_HEAP_MSGQ; + break; + case am_off_heap: + so.flags &= ~SPO_ON_HEAP_MSGQ; + so.flags |= SPO_OFF_HEAP_MSGQ; + break; + default: goto error; + } } else if (arg == am_min_heap_size && is_small(val)) { Sint min_heap_size = signed_val(val); if (min_heap_size < 0) { @@ -1695,15 +1704,10 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) } BIF_RET(old_value); } - else if (BIF_ARG_1 == am_off_heap_message_queue) { - int enable; - if (BIF_ARG_2 == am_true) - enable = 1; - else if (BIF_ARG_2 == am_false) - enable = 0; - else + else if (BIF_ARG_1 == am_message_queue_data) { + old_value = erts_change_message_queue_management(BIF_P, BIF_ARG_2); + if (is_non_value(old_value)) goto error; - old_value = erts_change_off_heap_message_queue_state(BIF_P, enable); BIF_RET(old_value); } else if (BIF_ARG_1 == am_sensitive) { diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 3fe8aed50e..bb75b8abb6 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -589,7 +589,7 @@ static Eterm pi_args[] = { am_min_bin_vheap_size, am_current_location, am_current_stacktrace, - am_off_heap_message_queue + am_message_queue_data }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -637,7 +637,7 @@ pi_arg2ix(Eterm arg) case am_min_bin_vheap_size: return 28; case am_current_location: return 29; case am_current_stacktrace: return 30; - case am_off_heap_message_queue: return 31; + case am_message_queue_data: return 31; default: return -1; } } @@ -1496,8 +1496,22 @@ process_info_aux(Process *BIF_P, break; } - case am_off_heap_message_queue: - res = rp->flags & F_OFF_HEAP_MSGQ ? am_true : am_false; + case am_message_queue_data: + switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) { + case F_OFF_HEAP_MSGQ: + res = am_off_heap; + break; + case F_ON_HEAP_MSGQ: + res = am_on_heap; + break; + case 0: + res = am_mixed; + break; + default: + res = am_error; + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + break; + } hp = HAlloc(BIF_P, 3); break; @@ -2662,9 +2676,18 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_true); } #endif - else if (BIF_ARG_1 == am_off_heap_message_queue) { - BIF_RET(erts_default_spo_flags & SPO_OFF_HEAP_MSGQ - ? am_true : am_false); + else if (BIF_ARG_1 == am_message_queue_data) { + switch (erts_default_spo_flags & (SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ)) { + case SPO_OFF_HEAP_MSGQ: + BIF_RET(am_off_heap); + case SPO_ON_HEAP_MSGQ: + BIF_RET(am_on_heap); + case 0: + BIF_RET(am_mixed); + default: + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + BIF_RET(am_error); + } } else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) { Uint sz; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 3784367195..b63567e563 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -145,6 +145,7 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj); static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size); static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size); +static void move_msgq_to_heap(Process *p); static void init_gc_info(ErtsGCInfo *gcip); @@ -520,6 +521,14 @@ young_gen_usage(Process *p) Eterm *aheap; hsz = p->mbuf_sz; + + if (p->flags & F_ON_HEAP_MSGQ) { + ErtsMessage *mp; + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + hsz += erts_msg_attached_data_size(mp); + } + aheap = p->abandoned_heap; if (!aheap) hsz += p->htop - p->heap; @@ -1040,10 +1049,13 @@ minor_collection(Process* p, ErlHeapFragment *live_hf_end, do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm), new_sz, objv, nobj); + if (p->flags & F_ON_HEAP_MSGQ) + move_msgq_to_heap(p); + new_mature = p->old_htop - prev_old_htop; size_after = new_mature; - size_after += HEAP_TOP(p) - HEAP_START(p); + size_after += HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz; *recl += (size_before - size_after); ErtsGcQuickSanityCheck(p); @@ -1461,9 +1473,14 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, HIGH_WATER(p) = HEAP_TOP(p); + remove_message_buffers(p); + + if (p->flags & F_ON_HEAP_MSGQ) + move_msgq_to_heap(p); + ErtsGcQuickSanityCheck(p); - size_after = HEAP_TOP(p) - HEAP_START(p); + size_after = HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz; *recl += size_before - size_after; adjusted = adjust_after_fullsweep(p, need, objv, nobj); @@ -1471,8 +1488,6 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, #ifdef HARDDEBUG disallow_heap_frag_ref_in_heap(p); #endif - remove_message_buffers(p); - ErtsGcQuickSanityCheck(p); return gc_cost(size_after, adjusted ? size_after : 0); @@ -2000,6 +2015,173 @@ collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, return n_htop; } +static ERTS_INLINE void +copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, + ErlHeapFragment *bp, Eterm *refs, int nrefs) +{ + Uint sz; + int i; + Sint offs; + struct erl_off_heap_header* oh; + Eterm *fhp, *hp; + + OH_OVERHEAD(off_heap, bp->off_heap.overhead); + sz = bp->used_size; + + fhp = bp->mem; + hp = *hpp; + offs = hp - fhp; + + oh = NULL; + while (sz--) { + Uint cpy_sz; + Eterm val = *fhp++; + + switch (primary_tag(val)) { + case TAG_PRIMARY_IMMED1: + *hp++ = val; + break; + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + *hp++ = offset_ptr(val, offs); + break; + case TAG_PRIMARY_HEADER: + *hp++ = val; + switch (val & _HEADER_SUBTAG_MASK) { + case ARITYVAL_SUBTAG: + break; + case REFC_BINARY_SUBTAG: + case FUN_SUBTAG: + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + oh = (struct erl_off_heap_header*) (hp-1); + cpy_sz = thing_arityval(val); + goto cpy_words; + default: + cpy_sz = header_arity(val); + + cpy_words: + ASSERT(sz >= cpy_sz); + sz -= cpy_sz; + while (cpy_sz >= 8) { + cpy_sz -= 8; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + } + switch (cpy_sz) { + case 7: *hp++ = *fhp++; + case 6: *hp++ = *fhp++; + case 5: *hp++ = *fhp++; + case 4: *hp++ = *fhp++; + case 3: *hp++ = *fhp++; + case 2: *hp++ = *fhp++; + case 1: *hp++ = *fhp++; + default: break; + } + if (oh) { + /* Add to offheap list */ + oh->next = off_heap->first; + off_heap->first = oh; + ASSERT(*hpp <= (Eterm*)oh); + ASSERT(hp > (Eterm*)oh); + oh = NULL; + } + break; + } + break; + } + } + + ASSERT(bp->used_size == hp - *hpp); + *hpp = hp; + + for (i = 0; i < nrefs; i++) { + if (is_not_immed(refs[i])) + refs[i] = offset_ptr(refs[i], offs); + } + bp->off_heap.first = NULL; +} + +static void +move_msgq_to_heap(Process *p) +{ + ErtsMessage **mpp = &p->msg.first; + + while (*mpp) { + ErtsMessage *mp = *mpp; + + if (mp->data.attached) { + ErlHeapFragment *bp; + ErtsHeapFactory factory; + + erts_factory_proc_prealloc_init(&factory, p, + erts_msg_attached_data_size(mp)); + + if (is_non_value(ERL_MESSAGE_TERM(mp))) { + if (mp->data.dist_ext) { + ASSERT(mp->data.dist_ext->heap_size >= 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) { + bp = erts_dist_ext_trailer(mp->data.dist_ext); + ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp), + bp->used_size, + &factory.hp, + factory.off_heap); + erts_cleanup_offheap(&bp->off_heap); + } + ERL_MESSAGE_TERM(mp) = erts_decode_dist_ext(&factory, + mp->data.dist_ext); + erts_free_dist_ext_copy(mp->data.dist_ext); + mp->data.dist_ext = NULL; + } + } + else { + + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &mp->hfrag; + else + bp = mp->data.heap_frag; + + if (bp->next) + erts_move_multi_frags(&factory.hp, factory.off_heap, bp, + mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0); + else + copy_one_frag(&factory.hp, factory.off_heap, bp, + mp->m, ERL_MESSAGE_REF_ARRAY_SZ); + + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { + mp->data.heap_frag = NULL; + free_message_buffer(bp); + } + else { + ErtsMessage *tmp = erts_alloc_message(0, NULL); + sys_memcpy((void *) tmp->m, (void *) mp->m, + sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ); + tmp->next = mp->next; + if (p->msg.save == &mp->next) + p->msg.save = &tmp->next; + if (p->msg.last == &mp->next) + p->msg.last = &tmp->next; + *mpp = tmp; + mp->next = NULL; + erts_cleanup_messages(mp); + mp = tmp; + } + } + + erts_factory_close(&factory); + } + + mpp = &(*mpp)->next; + } +} + static Uint setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) { @@ -2089,9 +2271,8 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) case F_OFF_HEAP_MSGQ_CHNG: case 0: { /* - * Off heap message queue disabled, i.e. we may - * have references from the message queue to the - * heap... + * We do not have off heap message queue enabled, i.e. we + * need to add message queue to rootset... */ ErtsMessage *mp; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index f396a0a156..628915eb23 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -630,7 +630,8 @@ void erts_usage(void) erts_fprintf(stderr, "-W set error logger warnings mapping,\n"); erts_fprintf(stderr, " see error_logger documentation for details\n"); - erts_fprintf(stderr, "-xohmq bool set default off_heap_message_queue flag for processes\n"); + erts_fprintf(stderr, "-xmqd val set default message queue data flag for processes,\n"); + erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n"); @@ -2018,15 +2019,21 @@ erl_start(int argc, char **argv) case 'x': { char *sub_param = argv[i]+2; - if (has_prefix("ohmq", sub_param)) { - arg = get_arg(sub_param+4, argv[i+1], &i); - if (sys_strcmp(arg, "true") == 0) - erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; - else if (sys_strcmp(arg, "false") == 0) + if (has_prefix("mqd", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + if (sys_strcmp(arg, "mixed") == 0) + erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); + else if (sys_strcmp(arg, "on_heap") == 0) { erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; + erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; + } + else if (sys_strcmp(arg, "off_heap") == 0) { + erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; + erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; + } else { erts_fprintf(stderr, - "Invalid off_heap_message_queue flag: %s\n", arg); + "Invalid message_queue_data flag: %s\n", arg); erts_usage(); } } else { diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 79739501a8..797212450c 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -629,9 +629,24 @@ erts_try_alloc_message_on_heap(Process *pp, #endif else { in_message_fragment: - - mp = erts_alloc_message(sz, hpp); - *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + if (!((*psp) & ERTS_PSFLG_ON_HEAP_MSGQ)) { + mp = erts_alloc_message(sz, hpp); + *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + } + else { + mp = erts_alloc_message(0, NULL); + if (!sz) { + *hpp = NULL; + *ohpp = NULL; + } + else { + ErlHeapFragment *bp; + bp = new_message_buffer(sz); + *hpp = &bp->mem[0]; + mp->data.heap_frag = bp; + *ohpp = &bp->off_heap; + } + } *on_heap_p = 0; } @@ -976,12 +991,12 @@ erts_complete_off_heap_message_queue_change(Process *c_p) ASSERT(erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ); /* - * This job was first initiated when the process changed - * "off heap message queue" state from false to true. Since - * then ERTS_PSFLG_OFF_HEAP_MSGQ has been set. However, the - * state change might have been changed again (multiple times) - * since then. Check users last requested state (the flag - * F_OFF_HEAP_MSGQ), and make the state consistent with that. + * This job was first initiated when the process changed to off heap + * message queue management. Since then ERTS_PSFLG_OFF_HEAP_MSGQ + * has been set. However, the management state might have been changed + * again (multiple times) since then. Check users last requested state + * (the flags F_OFF_HEAP_MSGQ, and F_ON_HEAP_MSGQ), and make the state + * consistent with that. */ if (!(c_p->flags & F_OFF_HEAP_MSGQ)) @@ -1022,8 +1037,9 @@ change_off_heap_msgq(void *vcohmq) } Eterm -erts_change_off_heap_message_queue_state(Process *c_p, int enable) +erts_change_message_queue_management(Process *c_p, Eterm new_state) { + Eterm res; #ifdef DEBUG if (c_p->flags & F_OFF_HEAP_MSGQ) { @@ -1042,57 +1058,117 @@ erts_change_off_heap_message_queue_state(Process *c_p, int enable) } #endif - if (c_p->flags & F_OFF_HEAP_MSGQ) { - /* Off heap message queue is enabled */ + switch (c_p->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) { - if (!enable) { + case F_OFF_HEAP_MSGQ: + res = am_off_heap; + + switch (new_state) { + case am_off_heap: + break; + case am_on_heap: + c_p->flags |= F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_ON_HEAP_MSGQ); + /* fall through */ + case am_mixed: c_p->flags &= ~F_OFF_HEAP_MSGQ; /* * We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ - * if a change is ongoing. It will be adjusted when the - * change completes... + * if a off heap change is ongoing. It will be adjusted + * when the change completes... */ if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { /* Safe to clear ERTS_PSFLG_OFF_HEAP_MSGQ... */ erts_smp_atomic32_read_band_nob(&c_p->state, ~ERTS_PSFLG_OFF_HEAP_MSGQ); } + break; + default: + res = THE_NON_VALUE; /* badarg */ + break; } + break; + + case F_ON_HEAP_MSGQ: + res = am_on_heap; - return am_true; /* Old state */ + switch (new_state) { + case am_on_heap: + break; + case am_mixed: + c_p->flags &= ~F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_ON_HEAP_MSGQ); + break; + case am_off_heap: + c_p->flags &= ~F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_ON_HEAP_MSGQ); + goto change_to_off_heap; + default: + res = THE_NON_VALUE; /* badarg */ + break; + } + break; + + case 0: + res = am_mixed; + + switch (new_state) { + case am_mixed: + break; + case am_on_heap: + c_p->flags |= F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_ON_HEAP_MSGQ); + break; + case am_off_heap: + goto change_to_off_heap; + default: + res = THE_NON_VALUE; /* badarg */ + break; + } + break; + + default: + res = am_error; + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + break; } - /* Off heap message queue is disabled */ + return res; + +change_to_off_heap: - if (enable) { - c_p->flags |= F_OFF_HEAP_MSGQ; + c_p->flags |= F_OFF_HEAP_MSGQ; + + /* + * We do not have to schedule a change if + * we have an ongoing off heap change... + */ + if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { + ErtsChangeOffHeapMessageQueue *cohmq; /* - * We do not have to schedule a change if - * we have an ongoing change... + * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait + * thread progress before completing the change in + * order to ensure that all senders observe that + * messages should be passed off heap. When the + * change has completed, GC does not need to inspect + * the message queue at all. */ - if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { - ErtsChangeOffHeapMessageQueue *cohmq; - /* - * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait - * thread progress before completing the change in - * order to ensure that all senders observe that - * messages should be passed off heap. When the - * change has completed, GC does not need to inspect - * the message queue at all. - */ - erts_smp_atomic32_read_bor_nob(&c_p->state, - ERTS_PSFLG_OFF_HEAP_MSGQ); - c_p->flags |= F_OFF_HEAP_MSGQ_CHNG; - cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG, - sizeof(ErtsChangeOffHeapMessageQueue)); - cohmq->pid = c_p->common.id; - erts_schedule_thr_prgr_later_op(change_off_heap_msgq, - (void *) cohmq, - &cohmq->lop); - } + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_OFF_HEAP_MSGQ); + c_p->flags |= F_OFF_HEAP_MSGQ_CHNG; + cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG, + sizeof(ErtsChangeOffHeapMessageQueue)); + cohmq->pid = c_p->common.id; + erts_schedule_thr_prgr_later_op(change_off_heap_msgq, + (void *) cohmq, + &cohmq->lop); } - return am_false; /* Old state */ + return res; } int diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 740ae46a0f..e241926638 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -277,7 +277,7 @@ void erts_cleanup_offheap(ErlOffHeap *offheap); void erts_save_message_in_proc(Process *p, ErtsMessage *msg); Sint erts_move_messages_off_heap(Process *c_p); Sint erts_complete_off_heap_message_queue_change(Process *c_p); -Eterm erts_change_off_heap_message_queue_state(Process *c_p, int enable); +Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state); int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d17355207b..7a31aa3e33 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10779,6 +10779,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). state |= ERTS_PSFLG_OFF_HEAP_MSGQ; flags |= F_OFF_HEAP_MSGQ; } + else if (so->flags & SPO_ON_HEAP_MSGQ) { + state |= ERTS_PSFLG_ON_HEAP_MSGQ; + flags |= F_ON_HEAP_MSGQ; + } if (!rq) rq = erts_get_runq_proc(parent); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 41b367435d..f0798d8c2d 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1145,14 +1145,15 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16) #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) #define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18) +#define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19) #ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(19) -#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(20) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(21) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(22) -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 23) +#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(20) +#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(22) +#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(23) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 24) #else -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 19) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 20) #endif #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ @@ -1201,6 +1202,7 @@ void erts_check_for_holes(Process* p); #define SPO_MONITOR 4 #define SPO_SYSTEM_PROC 8 #define SPO_OFF_HEAP_MSGQ 16 +#define SPO_ON_HEAP_MSGQ 32 extern int erts_default_spo_flags; @@ -1290,9 +1292,10 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ #define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ -#define F_OFF_HEAP_MSGQ_CHNG (1 << 13) /* Off heap msg queue changing */ -#define F_ABANDONED_HEAP_USE (1 << 14) /* Have usage of abandoned heap */ -#define F_DELAY_GC (1 << 15) /* Similar to disable GC (see below) */ +#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */ +#define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */ +#define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */ +#define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 6519fd8982..8cc47937b7 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -79,7 +79,7 @@ MODULES= \ node_container_SUITE \ nofrag_SUITE \ num_bif_SUITE \ - off_heap_message_queue_SUITE \ + message_queue_data_SUITE \ op_SUITE \ port_SUITE \ port_bif_SUITE \ diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl new file mode 100644 index 0000000000..11481409aa --- /dev/null +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -0,0 +1,239 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(message_queue_data_SUITE). + +-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, process_info_messages/1]). + +-export([basic_test/1]). + +-include_lib("test_server/include/test_server.hrl"). + +init_per_testcase(Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(2)), + [{watchdog, Dog}, {testcase, Case}|Config]. + +end_per_testcase(_, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, process_info_messages]. + +groups() -> + []. + +init_per_suite(Config) -> +%% erts_debug:set_internal_state(available_internal_state, true), + Config. + +end_per_suite(_Config) -> +%% erts_debug:set_internal_state(available_internal_state, false), + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% +%% +%% Test cases +%% +%% + +basic(Config) when is_list(Config) -> + + basic_test(erlang:system_info(message_queue_data)), + + {ok, Node1} = start_node(Config, "+xmqd off_heap"), + ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]), + stop_node(Node1), + + {ok, Node2} = start_node(Config, "+xmqd on_heap"), + ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]), + stop_node(Node2), + + {ok, Node3} = start_node(Config, "+xmqd mixed"), + ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]), + stop_node(Node3), + + ok. + +is_valid_mqd_value(off_heap) -> + true; +is_valid_mqd_value(on_heap) -> + true; +is_valid_mqd_value(mixed) -> + true; +is_valid_mqd_value(_) -> + false. + + +basic_test(Default) -> + + Default = erlang:system_info(message_queue_data), + true = is_valid_mqd_value(Default), + + {message_queue_data, Default} = process_info(self(), message_queue_data), + Default = process_flag(message_queue_data, off_heap), + {message_queue_data, off_heap} = process_info(self(), message_queue_data), + off_heap = process_flag(message_queue_data, on_heap), + {message_queue_data, on_heap} = process_info(self(), message_queue_data), + on_heap = process_flag(message_queue_data, mixed), + {message_queue_data, mixed} = process_info(self(), message_queue_data), + mixed = process_flag(message_queue_data, Default), + {'EXIT', _} = (catch process_flag(message_queue_data, blupp)), + + P1 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link]), + {message_queue_data, Default} = process_info(P1, message_queue_data), + unlink(P1), + exit(P1, bye), + + P2 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, off_heap}]), + {message_queue_data, off_heap} = process_info(P2, message_queue_data), + unlink(P2), + exit(P2, bye), + + P3 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, on_heap}]), + {message_queue_data, on_heap} = process_info(P3, message_queue_data), + unlink(P3), + exit(P3, bye), + + P4 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, mixed}]), + {message_queue_data, mixed} = process_info(P4, message_queue_data), + unlink(P4), + exit(P4, bye), + + {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, blapp}])), + + ok. + +process_info_messages(Config) when is_list(Config) -> + Tester = self(), + P1 = spawn_opt(fun () -> + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, mixed), + Tester ! third, + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! fourth, + + receive after infinity -> ok end + end, + [link, {message_queue_data, mixed}]), + + P1 ! "A", + receive first -> ok end, + P1 ! "B", + receive second -> ok end, + P1 ! "C", + receive third -> ok end, + P1 ! "D", + receive fourth -> ok end, + P1 ! "E", + + {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages), + + P2 = spawn_opt(fun () -> + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, mixed), + Tester ! third, + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! fourth, + receive after 500 -> ok end, + + Tester ! process_info(self(), messages), + + receive M1 -> M1 = "A" end, + receive M2 -> M2 = "B" end, + receive M3 -> M3 = "C" end, + receive M4 -> M4 = "D" end, + receive M5 -> M5 = "E" end, + + Tester ! self() + end, + [link, {message_queue_data, mixed}]), + + P2 ! "A", + receive first -> ok end, + P2 ! "B", + receive second -> ok end, + P2 ! "C", + receive third -> ok end, + P2 ! "D", + receive fourth -> ok end, + P2 ! "E", + + receive + Msg -> + {messages, ["A", "B", "C", "D", "E"]} = Msg + end, + + receive P2 -> ok end, + + ok. + +%% +%% +%% helpers +%% +%% + +start_node(Config) -> + start_node(Config, []). +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/erts/emulator/test/off_heap_message_queue_SUITE.erl b/erts/emulator/test/off_heap_message_queue_SUITE.erl deleted file mode 100644 index a667704942..0000000000 --- a/erts/emulator/test/off_heap_message_queue_SUITE.erl +++ /dev/null @@ -1,216 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(off_heap_message_queue_SUITE). - --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, process_info_messages/1]). - --export([basic_test/1]). - --include_lib("test_server/include/test_server.hrl"). - -init_per_testcase(Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(2)), - [{watchdog, Dog}, {testcase, Case}|Config]. - -end_per_testcase(_, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [basic, process_info_messages]. - -groups() -> - []. - -init_per_suite(Config) -> -%% erts_debug:set_internal_state(available_internal_state, true), - Config. - -end_per_suite(_Config) -> -%% erts_debug:set_internal_state(available_internal_state, false), - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -%% -%% -%% Test cases -%% -%% - -basic(Config) when is_list(Config) -> - - basic_test(erlang:system_info(off_heap_message_queue)), - - {ok, Node1} = start_node(Config, "+xohmq true"), - ok = rpc:call(Node1, ?MODULE, basic_test, [true]), - stop_node(Node1), - - {ok, Node2} = start_node(Config, "+xohmq false"), - ok = rpc:call(Node2, ?MODULE, basic_test, [false]), - stop_node(Node2), - ok. - -basic_test(Default) -> - - Default = erlang:system_info(off_heap_message_queue), - true = (Default == true) orelse (Default == false), - - {off_heap_message_queue, Default} = process_info(self(), off_heap_message_queue), - Default = process_flag(off_heap_message_queue, true), - {off_heap_message_queue, true} = process_info(self(), off_heap_message_queue), - true = process_flag(off_heap_message_queue, false), - {off_heap_message_queue, false} = process_info(self(), off_heap_message_queue), - false = process_flag(off_heap_message_queue, Default), - {'EXIT', _} = (catch process_flag(off_heap_message_queue, blupp)), - - P1 = spawn_opt(fun () -> receive after infinity -> ok end end, - [link]), - {off_heap_message_queue, Default} = process_info(P1, off_heap_message_queue), - unlink(P1), - exit(P1, bye), - - P2 = spawn_opt(fun () -> receive after infinity -> ok end end, - [link, {off_heap_message_queue, false}]), - {off_heap_message_queue, false} = process_info(P2, off_heap_message_queue), - unlink(P2), - exit(P2, bye), - - P3 = spawn_opt(fun () -> receive after infinity -> ok end end, - [link, {off_heap_message_queue, true}]), - {off_heap_message_queue, true} = process_info(P3, off_heap_message_queue), - unlink(P3), - exit(P3, bye), - - {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end, - [link, {off_heap_message_queue, blapp}])), - - ok. - -process_info_messages(Config) when is_list(Config) -> - Tester = self(), - P1 = spawn_opt(fun () -> - receive after 500 -> ok end, - false = process_flag(off_heap_message_queue, true), - Tester ! first, - receive after 500 -> ok end, - true = process_flag(off_heap_message_queue, false), - Tester ! second, - receive after 500 -> ok end, - false = process_flag(off_heap_message_queue, true), - Tester ! third, - receive after 500 -> ok end, - true = process_flag(off_heap_message_queue, false), - Tester ! fourth, - - receive after infinity -> ok end - end, - [link, {off_heap_message_queue, false}]), - - P1 ! "A", - receive first -> ok end, - P1 ! "B", - receive second -> ok end, - P1 ! "C", - receive third -> ok end, - P1 ! "D", - receive fourth -> ok end, - P1 ! "E", - - {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages), - - P2 = spawn_opt(fun () -> - receive after 500 -> ok end, - false = process_flag(off_heap_message_queue, true), - Tester ! first, - receive after 500 -> ok end, - true = process_flag(off_heap_message_queue, false), - Tester ! second, - receive after 500 -> ok end, - false = process_flag(off_heap_message_queue, true), - Tester ! third, - receive after 500 -> ok end, - true = process_flag(off_heap_message_queue, false), - Tester ! fourth, - receive after 500 -> ok end, - - Tester ! process_info(self(), messages), - - receive M1 -> M1 = "A" end, - receive M2 -> M2 = "B" end, - receive M3 -> M3 = "C" end, - receive M4 -> M4 = "D" end, - receive M5 -> M5 = "E" end, - - Tester ! self() - end, - [link, {off_heap_message_queue, false}]), - - P2 ! "A", - receive first -> ok end, - P2 ! "B", - receive second -> ok end, - P2 ! "C", - receive third -> ok end, - P2 ! "D", - receive fourth -> ok end, - P2 ! "E", - - receive - Msg -> - {messages, ["A", "B", "C", "D", "E"]} = Msg - end, - - receive P2 -> ok end, - - ok. - -%% -%% -%% helpers -%% -%% - -start_node(Config) -> - start_node(Config, []). -start_node(Config, Opts) when is_list(Config), is_list(Opts) -> - Pa = filename:dirname(code:which(?MODULE)), - Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(erlang:system_time(seconds)) - ++ "-" - ++ integer_to_list(erlang:unique_integer([positive]))), - ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). - -stop_node(Node) -> - ?t:stop_node(Node). diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 461957be10..f1cabe5d0b 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -157,7 +157,7 @@ static char *plusr_val_switches[] = { /* +x arguments with values */ static char *plusx_val_switches[] = { - "ohmq", + "mqd", NULL }; diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 6a9ec9c915..7a76c95c53 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2033,6 +2033,9 @@ open_port(_PortName,_PortSettings) -> -type priority_level() :: low | normal | high | max. +-type message_queue_data() :: + off_heap | on_heap | mixed. + -spec process_flag(trap_exit, Boolean) -> OldBoolean when Boolean :: boolean(), OldBoolean :: boolean(); @@ -2045,9 +2048,9 @@ open_port(_PortName,_PortSettings) -> (min_bin_vheap_size, MinBinVHeapSize) -> OldMinBinVHeapSize when MinBinVHeapSize :: non_neg_integer(), OldMinBinVHeapSize :: non_neg_integer(); - (off_heap_message_queue, OHMQ) -> OldOHMQ when - OHMQ :: boolean(), - OldOHMQ :: boolean(); + (message_queue_data, MQD) -> OldMQD when + MQD :: message_queue_data(), + OldMQD :: message_queue_data(); (priority, Level) -> OldLevel when Level :: priority_level(), OldLevel :: priority_level(); @@ -2086,7 +2089,7 @@ process_flag(_Flag, _Value) -> min_bin_vheap_size | monitored_by | monitors | - off_heap_message_queue | + message_queue_data | priority | reductions | registered_name | @@ -2128,7 +2131,7 @@ process_flag(_Flag, _Value) -> {monitors, Monitors :: [{process, Pid :: pid() | {RegName :: atom(), Node :: node()}}]} | - {off_heap_message_queue, OHMQ :: boolean()} | + {message_queue_data, MQD :: message_queue_data()} | {priority, Level :: priority_level()} | {reductions, Number :: non_neg_integer()} | {registered_name, Atom :: atom()} | @@ -2431,7 +2434,7 @@ tuple_to_list(_Tuple) -> (multi_scheduling) -> disabled | blocked | enabled; (multi_scheduling_blockers) -> [Pid :: pid()]; (nif_version) -> string(); - (off_heap_message_queue) -> boolean(); + (message_queue_data) -> message_queue_data(); (otp_release) -> string(); (os_monotonic_time_source) -> [{atom(),term()}]; (os_system_time_source) -> [{atom(),term()}]; @@ -2567,7 +2570,7 @@ spawn_monitor(M, F, A) -> | {fullsweep_after, Number :: non_neg_integer()} | {min_heap_size, Size :: non_neg_integer()} | {min_bin_vheap_size, VSize :: non_neg_integer()} - | {off_heap_message_queue, OHMQ :: boolean()}. + | {message_queue_data, MQD :: message_queue_data()}. -spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when Fun :: function(), -- cgit v1.2.3 From cfecb31a2f6795dafb8858e39a3844bd301b84db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Tue, 8 Dec 2015 15:16:17 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 56328 -> 56060 bytes erts/preloaded/ebin/erlang.beam | Bin 101816 -> 101752 bytes erts/preloaded/ebin/erts_internal.beam | Bin 5988 -> 6076 bytes erts/preloaded/ebin/init.beam | Bin 48812 -> 48600 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1468 -> 1460 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1340 -> 1332 bytes erts/preloaded/ebin/prim_file.beam | Bin 44904 -> 44788 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72628 -> 72624 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23416 -> 23296 bytes erts/preloaded/ebin/zlib.beam | Bin 14176 -> 14168 bytes 10 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index df12c6f8e0..e94a1ba796 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 4f35928db2..632defdb46 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index d63f79c327..fd0a502d2c 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index 73dfb3d351..60c08819eb 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index 33c112f4de..04814c091b 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index ebca6e7eea..7779c8374d 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index e8817d183e..254b0e5b90 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index 357bcd3d9a..b7cfe26462 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 969239be98..6b5c6195c8 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 281f668f8c..43d7b436be 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From b20321973be4d8f7be2f766ac51d2a7b9d5d120f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 8 Dec 2015 17:45:55 +0000 Subject: inets: Add PATCH method to client and server --- lib/inets/src/http_client/httpc.erl | 7 ++++--- lib/inets/src/http_client/httpc_request.erl | 3 ++- lib/inets/src/http_server/httpd_request.erl | 5 ++++- lib/inets/src/http_server/mod_cgi.erl | 2 ++ lib/inets/src/http_server/mod_esi.erl | 9 +++++++++ lib/inets/test/httpc_SUITE.erl | 23 +++++++++++++++++++++++ 6 files changed, 44 insertions(+), 5 deletions(-) diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index e4a6f8f748..85663b5ded 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -101,7 +101,8 @@ request(Url, Profile) -> %% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} | %% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath} %% -%% Method - atom() = head | get | put | post | trace | options| delete +%% Method - atom() = head | get | put | patch | post | trace | +%% options | delete %% Request - {Url, Headers} | {Url, Headers, ContentType, Body} %% Url - string() %% HTTPOptions - [HttpOption] @@ -176,8 +177,8 @@ request(Method, request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= put) orelse (Method =:= delete)) andalso - (is_atom(Profile) orelse is_pid(Profile)) -> + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse + (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, {url, Url}, {headers, Headers}, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index e4451401f4..af4c3f75f2 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -187,7 +187,8 @@ is_client_closing(Headers) -> %%% Internal functions %%%======================================================================== post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) - when (Method =:= post) orelse (Method =:= put) -> + when (Method =:= post) orelse (Method =:= put) + orelse (Method =:= patch) -> NewBody = case Headers#http_request_h.expect of "100-continue" -> ""; diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index abcc0ce898..749f58c197 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -86,7 +86,8 @@ body_data(Headers, Body) -> %%------------------------------------------------------------------------- %% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} | %% {error, {not_supported, {Method, Uri, Version}} -%% Method = "HEAD" | "GET" | "POST" | "TRACE" | "PUT" | "DELETE" +%% Method = "HEAD" | "GET" | "POST" | "PATCH" | "TRACE" | "PUT" +%% | "DELETE" %% Uri = uri() %% Version = "HTTP/N.M" %% Description: Checks that HTTP-request-line is valid. @@ -105,6 +106,8 @@ validate("DELETE", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); validate("POST", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); +validate("PATCH", Uri, "HTTP/1." ++ _N) -> + validate_uri(Uri); validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index 25d9f05028..ec8b9be32e 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -337,6 +337,8 @@ script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) -> [{query_string, QueryString}, {path_info, PathInfo}]; script_elements(#mod{method = "POST", entity_body = Body}, _) -> [{entity_body, Body}]; +script_elements(#mod{method = "PATCH", entity_body = Body}, _) -> + [{entity_body, Body}]; script_elements(#mod{method = "PUT", entity_body = Body}, _) -> [{entity_body, Body}]; script_elements(_, _) -> diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 1923411449..686ab65336 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -281,6 +281,15 @@ erl(#mod{request_uri = ReqUri, ?NICE("Erl mechanism doesn't support method DELETE")}}| Data]}; +erl(#mod{request_uri = ReqUri, + method = "PATCH", + http_version = Version, + data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, patch}]), + {proceed, [{status,{501,{"PATCH", ReqUri, Version}, + ?NICE("Erl mechanism doesn't support method PATCH")}}| + Data]}; + erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> ?hdrt("erl", [{method, post}]), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c6c59ab1af..93b96e101f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -68,6 +68,7 @@ real_requests()-> get, post, post_stream, + patch, async, pipeline, persistent_connection, @@ -256,6 +257,28 @@ post(Config) when is_list(Config) -> httpc:request(post, {URL, [{"expect","100-continue"}], "text/plain", "foobar"}, [], []). +%%-------------------------------------------------------------------- +patch() -> + [{"Test http patch request against local server. We do in this case " + "only care about the client side of the the patch. The server " + "script will not actually use the patch data."}]. +patch(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, + + URL = url(group_name(Config), CGI, Config), + + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(patch, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []). + %%-------------------------------------------------------------------- post_stream() -> [{"Test streaming http post request against local server. " -- cgit v1.2.3 From 9805ea44b04b4d7db65fc6d6369addb223040032 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 9 Dec 2015 10:20:38 +0100 Subject: Fix check_process_code() --- erts/emulator/beam/beam_bif_load.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index c3ebf71a01..8e6123eacd 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -837,10 +837,10 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) return am_true; /* Should not contain any constants... */ - ASSERT(!any_heap_ref_ptrs(&hfrag->mem[0], - &hfrag->mem[hfrag->used_size], - mod_start, - mod_size)); + ASSERT(!any_heap_refs(&hfrag->mem[0], + &hfrag->mem[hfrag->used_size], + mod_start, + mod_size)); } } @@ -881,7 +881,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; - if (any_heap_ref_ptrs(hp, hp_end, mod_start, lit_bsize)) + if (any_heap_refs(hp, hp_end, mod_start, lit_bsize)) goto try_literal_gc; } @@ -902,7 +902,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; - ASSERT(!any_heap_ref_ptrs(hp, hp_end, mod_start, lit_bsize)); + ASSERT(!any_heap_refs(hp, hp_end, mod_start, lit_bsize)); } } -- cgit v1.2.3 From 94c2057beb02608d24cd93432fba72f9a427a20b Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Wed, 9 Dec 2015 14:27:19 +0100 Subject: Update appup for diameter 1.5.1 --- lib/diameter/src/diameter.appup.src | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index c7ae8a2828..30c923a869 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -36,11 +36,13 @@ {load_module, diameter_config}, {load_module, diameter_capx}, {load_module, diameter_service}, + {load_module, diameter_traffic}, {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, {load_module, diameter}]}, {"1.4.3", [{load_module, diameter_capx}, %% R16B02 {load_module, diameter_service}, + {load_module, diameter_traffic}, {load_module, diameter_watchdog}, {load_module, diameter_codec}, {load_module, diameter_types}, @@ -48,9 +50,12 @@ {load_module, diameter}]}, {"1.4.4", [{load_module, diameter_capx}, {load_module, diameter_service}, + {load_module, diameter_traffic}, {load_module, diameter_watchdog}, {load_module, diameter_config}, - {load_module, diameter}]} + {load_module, diameter}]}, + {"1.5", [{load_module, diameter_service}, %% R16B03 + {load_module, diameter_traffic}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -68,14 +73,18 @@ {"1.4.3", [{load_module, diameter_types}, {load_module, diameter_config}, {load_module, diameter_codec}, + {load_module, diameter_traffic}, {load_module, diameter_service}, {load_module, diameter_watchdog}, {load_module, diameter_capx}, {load_module, diameter}]}, {"1.4.4", [{load_module, diameter_capx}, {load_module, diameter_config}, + {load_module, diameter_traffic}, {load_module, diameter_service}, {load_module, diameter_watchdog}, - {load_module, diameter}]} + {load_module, diameter}]}, + {"1.5", [{load_module, diameter_traffic}, + {load_module, diameter_service}]} ] }. -- cgit v1.2.3 From d25d0787413eb403bc11e770dbf17416bd251b08 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Wed, 9 Dec 2015 14:27:50 +0100 Subject: vsn -> 1.5.1 --- lib/diameter/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 9fda067f2b..8ca8dc4b45 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.5 +DIAMETER_VSN = 1.5.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) -- cgit v1.2.3 From 6121107d63ef65b6b96c99684181578db2eea3aa Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Wed, 9 Dec 2015 11:23:04 +0100 Subject: Remove logging of faulty answer messages Since excessive numbers of them can overload a node with logging. Note that most log messages have been removed in OTP 17.1, and replaced by counters. In particular, logging as a result of incoming traffic, over which we have no control, is dangerous. --- lib/diameter/src/base/diameter_traffic.erl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 8b6f026b34..54b0daf7f9 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -1072,8 +1072,7 @@ int(_) -> -spec x(any(), atom(), list()) -> no_return(). %% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), +x(Reason, _F, _A) -> x(Reason). x(T) -> -- cgit v1.2.3 From 0f6b72141b7e04699aae3394b2b29191c8acdec5 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Wed, 9 Dec 2015 14:44:41 +0100 Subject: Update release notes --- lib/diameter/doc/src/notes.xml | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 18c712ec3d..059fffff23 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,36 @@ first.

+
diameter 1.5.1 + +
Fixed Bugs and Malfunctions + + +

+ Fix pick_peer case clause failure.

+

+ In the case of {call_mutates_state, true} configuration + on the service in question, any peer selection that + failed to select a peer resulted in a case clause + failure. This was noticed in the case of a peer failover + in which an alternate peer wasn't available.

+

+ Own Id: OTP-11789

+ + +

+ Remove logging of faulty answer messages.

+

+ Since excessive numbers of them can overload a node with + logging.

+

+ Own Id: OTP-13182

+ + +
+ +
+
diameter 1.5
Improvements and New Features -- cgit v1.2.3 From 343f461a2810ce3440b1d7c55cda996038071d87 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 8 Dec 2015 18:45:32 +0100 Subject: erts: Optimize hashing in process dictionary by limiting table sizes to powers of 2. This will change the default size from 10 to 8. --- erts/emulator/beam/erl_init.c | 4 ++-- erts/emulator/beam/erl_process_dict.c | 21 +++++++++++++++++++-- erts/emulator/beam/erl_process_dict.h | 1 + 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index d9c3b0dcf4..0a34d91a01 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -197,7 +197,7 @@ Uint32 verbose; /* See erl_debug.h for information about verbose */ int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */ -int erts_pd_initial_size = 10; +int erts_pd_initial_size = 8; /* must be power of 2 */ int erts_modified_timing_level; @@ -1479,7 +1479,7 @@ erl_start(int argc, char **argv) VERBOSE(DEBUG_SYSTEM, ("using minimum heap size %d\n", H_MIN_SIZE)); } else if (has_prefix("pds", sub_param)) { arg = get_arg(sub_param+3, argv[i+1], &i); - if ((erts_pd_initial_size = atoi(arg)) <= 0) { + if (!erts_pd_set_initial_size(atoi(arg))) { erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg); erts_usage(); } diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index e497267b63..c56a722542 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -80,6 +80,8 @@ #define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \ (PDict)->data[Index] : NIL) +#define IS_POW2(X) ((X) && !((X) & ((X)-1))) + /* * Forward decalarations */ @@ -138,6 +140,16 @@ static void pd_check(ProcDict *pd); ** External interface */ +int +erts_pd_set_initial_size(int size) +{ + if (size <= 0) + return 0; + + erts_pd_initial_size = 1 << erts_fit_in_bits_uint(size-1); + return 1; +} + /* * Called from break handler */ @@ -399,6 +411,7 @@ Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id) unsigned int hval; ProcDict *pd = p->dictionary; + ASSERT(hx == MAKE_HASH(id)); if (pd == NULL) return am_undefined; hval = pd_hash_value_to_ix(pd, hx); @@ -570,6 +583,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) /* Create it */ array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL); p->dictionary->homeSize = INITIAL_SIZE; + ASSERT(IS_POW2(p->dictionary->homeSize)); } hval = pd_hash_value(p->dictionary, id); old = ARRAY_GET(p->dictionary, hval); @@ -954,9 +968,12 @@ static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term) static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx) { Uint high; - high = hx % (pdict->homeSize*2); + + ASSERT(IS_POW2(pdict->homeSize)); + + high = hx & (pdict->homeSize*2 - 1); if (high >= HASH_RANGE(pdict)) - return hx % pdict->homeSize; + return hx & (pdict->homeSize - 1); return high; } diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index 9aa21b7c38..ab50d45c63 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -31,6 +31,7 @@ typedef struct proc_dict { Eterm data[1]; /* The beginning of an array of erlang terms */ } ProcDict; +int erts_pd_set_initial_size(int size); Uint erts_dicts_mem_size(struct process *p); void erts_erase_dicts(struct process *p); void erts_dictionary_dump(int to, void *to_arg, ProcDict *pd); -- cgit v1.2.3 From eb2e118ee2be5c008fc4417a443c351807adf123 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 8 Dec 2015 20:28:38 +0100 Subject: erts: Optimize away function "array_put" in proc dict Replace heave array_put() with a dumb array index assignment ARRAY_PUT and instead introduce ensure_array_size() to be called when we know the array might need to grow. This change also ensures the entire HASH_RANGE is always allocated. No need for ARRAY_GET to check index any more. --- erts/emulator/beam/erl_process_dict.c | 104 ++++++++++++++++------------------ 1 file changed, 48 insertions(+), 56 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index c56a722542..0934183b6a 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -77,8 +77,10 @@ #define TCDR(Term) CDR(list_val(Term)) /* Array access macro */ -#define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \ - (PDict)->data[Index] : NIL) +#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->size), \ + (PDict)->data[Index]) +#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->size), \ + (PDict)->data[Index] = (Val)) #define IS_POW2(X) ((X) && !((X) & ((X)-1))) @@ -97,7 +99,7 @@ static void shrink(Process *p, Eterm* ret); static void grow(Process *p); static void array_shrink(ProcDict **ppd, unsigned int need); -static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term); +static void ensure_array_size(ProcDict**, unsigned int size); static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx); static unsigned int next_array_size(unsigned int need); @@ -361,7 +363,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret) if (is_boxed(old)) { /* Tuple */ ASSERT(is_tuple(old)); if (EQ(tuple_val(old)[1], id)) { - array_put(&(p->dictionary), hval, NIL); + ARRAY_PUT(p->dictionary, hval, NIL); --(p->dictionary->numElements); *ret = tuple_val(old)[2]; } @@ -381,7 +383,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret) old = ARRAY_GET(p->dictionary, hval); ASSERT(is_list(old)); if (is_nil(TCDR(old))) { - array_put(&p->dictionary, hval, TCAR(old)); + ARRAY_PUT(p->dictionary, hval, TCAR(old)); } } else if (is_not_nil(old)) { #ifdef DEBUG @@ -581,9 +583,8 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) if (p->dictionary == NULL) { /* Create it */ - array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL); + ensure_array_size(&p->dictionary, INITIAL_SIZE); p->dictionary->homeSize = INITIAL_SIZE; - ASSERT(IS_POW2(p->dictionary->homeSize)); } hval = pd_hash_value(p->dictionary, id); old = ARRAY_GET(p->dictionary, hval); @@ -635,19 +636,19 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) * Update the dictionary. */ if (is_nil(old)) { - array_put(&(p->dictionary), hval, tpl); + ARRAY_PUT(p->dictionary, hval, tpl); ++(p->dictionary->numElements); } else if (is_boxed(old)) { ASSERT(is_tuple(old)); if (EQ(tuple_val(old)[1],id)) { - array_put(&(p->dictionary), hval, tpl); + ARRAY_PUT(p->dictionary, hval, tpl); return tuple_val(old)[2]; } else { hp = HeapOnlyAlloc(p, 4); tmp = CONS(hp, old, NIL); hp += 2; ++(p->dictionary->numElements); - array_put(&(p->dictionary), hval, CONS(hp, tpl, tmp)); + ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, tmp)); hp += 2; ASSERT(hp <= hp_limit); } @@ -657,7 +658,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) * New key. Simply prepend the tuple to the beginning of the list. */ hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), hval, CONS(hp, tpl, old)); + ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, old)); hp += 2; ASSERT(hp <= hp_limit); ++(p->dictionary->numElements); @@ -692,7 +693,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) nlist = CONS(hp, tpl, nlist); hp += 2; ASSERT(hp <= hp_limit); - array_put(&(p->dictionary), hval, nlist); + ARRAY_PUT(p->dictionary, hval, nlist); return tuple_val(TCAR(tmp))[2]; } } else { @@ -741,7 +742,7 @@ static void shrink(Process *p, Eterm* ret) lo = ARRAY_GET(pd, pd->splitPosition); if (hi != NIL) { if (lo == NIL) { - array_put(&(p->dictionary), pd->splitPosition, hi); + ARRAY_PUT(p->dictionary, pd->splitPosition, hi); } else { int needed = 4; if (is_list(hi) && is_list(lo)) { @@ -760,13 +761,13 @@ static void shrink(Process *p, Eterm* ret) hp = HeapOnlyAlloc(p, 4); tmp = CONS(hp, hi, NIL); hp += 2; - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(p->dictionary, pd->splitPosition, CONS(hp,lo,tmp)); hp += 2; ASSERT(hp <= hp_limit); } else { /* hi is a list */ hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(p->dictionary, pd->splitPosition, CONS(hp, lo, hi)); hp += 2; ASSERT(hp <= hp_limit); @@ -774,7 +775,7 @@ static void shrink(Process *p, Eterm* ret) } else { /* lo is a list */ if (is_tuple(hi)) { hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(p->dictionary, pd->splitPosition, CONS(hp, hi, lo)); hp += 2; ASSERT(hp <= hp_limit); @@ -786,12 +787,12 @@ static void shrink(Process *p, Eterm* ret) hp += 2; } ASSERT(hp <= hp_limit); - array_put(&(p->dictionary), pd->splitPosition, lo); + ARRAY_PUT(p->dictionary, pd->splitPosition, lo); } } } } - array_put(&(p->dictionary), (pd->splitPosition + pd->homeSize), NIL); + ARRAY_PUT(p->dictionary, (pd->splitPosition + pd->homeSize), NIL); } if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); @@ -808,7 +809,7 @@ static void grow(Process *p) unsigned int pos; unsigned int homeSize; int needed = 0; - ProcDict *pd; + ProcDict *pd = p->dictionary; #ifdef DEBUG Eterm *hp_limit; #endif @@ -817,16 +818,18 @@ static void grow(Process *p) if (steps == 0) steps = 1; /* Dont grow over MAX_HASH */ - if ((MAX_HASH - steps) <= HASH_RANGE(p->dictionary)) { + if ((MAX_HASH - steps) <= HASH_RANGE(pd)) { return; } + ensure_array_size(&p->dictionary, HASH_RANGE(pd) + steps); + pd = p->dictionary; + /* * Calculate total number of heap words needed, and garbage collect * if necessary. */ - pd = p->dictionary; pos = pd->splitPosition; homeSize = pd->homeSize; for (i = 0; i < steps; ++i) { @@ -855,7 +858,6 @@ static void grow(Process *p) */ for (i = 0; i < steps; ++i) { - ProcDict *pd = p->dictionary; if (pd->splitPosition == pd->homeSize) { pd->homeSize *= 2; pd->splitPosition = 0; @@ -865,9 +867,8 @@ static void grow(Process *p) l = ARRAY_GET(pd, pos); if (is_tuple(l)) { if (pd_hash_value(pd, tuple_val(l)[1]) != pos) { - array_put(&(p->dictionary), pos + - p->dictionary->homeSize, l); - array_put(&(p->dictionary), pos, NIL); + ARRAY_PUT(pd, pos + pd->homeSize, l); + ARRAY_PUT(pd, pos, NIL); } } else { l2 = NIL; @@ -889,10 +890,8 @@ static void grow(Process *p) if (l2 != NIL && TCDR(l2) == NIL) l2 = TCAR(l2); ASSERT(hp <= hp_limit); - /* After array_put pd is no longer valid */ - array_put(&(p->dictionary), pos, l1); - array_put(&(p->dictionary), pos + - p->dictionary->homeSize, l2); + ARRAY_PUT(pd, pos, l1); + ARRAY_PUT(pd, pos + pd->homeSize, l2); } } @@ -912,7 +911,7 @@ static void array_shrink(ProcDict **ppd, unsigned int need) HDEBUGF(("array_shrink: size = %d, used = %d, need = %d", (*ppd)->size, (*ppd)->used, need)); - if (siz > (*ppd)->size) + if (siz >= (*ppd)->size) return; /* Only shrink */ *ppd = PD_REALLOC(((void *) *ppd), @@ -925,40 +924,33 @@ static void array_shrink(ProcDict **ppd, unsigned int need) } -static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term) +static void ensure_array_size(ProcDict **ppdict, unsigned int size) { + ProcDict *pd = *ppdict; unsigned int i; - Eterm ret; - if (*ppdict == NULL) { - Uint siz = next_array_size(ndx+1); - ProcDict *p; - p = PD_ALLOC(PD_SZ2BYTES(siz)); + if (pd == NULL) { + Uint siz = next_array_size(size); + + pd = PD_ALLOC(PD_SZ2BYTES(siz)); for (i = 0; i < siz; ++i) - p->data[i] = NIL; - p->size = siz; - p->homeSize = p->splitPosition = p->numElements = p->used = 0; - *ppdict = p; - } else if (ndx >= (*ppdict)->size) { - Uint osize = (*ppdict)->size; - Uint nsize = next_array_size(ndx+1); - *ppdict = PD_REALLOC(((void *) *ppdict), + pd->data[i] = NIL; + pd->size = siz; + pd->homeSize = pd->splitPosition = pd->numElements = pd->used = 0; + *ppdict = pd; + } else if (size > pd->size) { + Uint osize = pd->size; + Uint nsize = next_array_size(size); + pd = PD_REALLOC(((void *) pd), PD_SZ2BYTES(osize), PD_SZ2BYTES(nsize)); for (i = osize; i < nsize; ++i) - (*ppdict)->data[i] = NIL; - (*ppdict)->size = nsize; + pd->data[i] = NIL; + pd->size = nsize; + *ppdict = pd; } - ret = (*ppdict)->data[ndx]; - (*ppdict)->data[ndx] = term; - if ((ndx + 1) > (*ppdict)->used) - (*ppdict)->used = ndx + 1; -#ifdef HARDDEBUG - HDEBUGF(("array_put: (*ppdict)->size = %d, (*ppdict)->used = %d, ndx = %d", - (*ppdict)->size, (*ppdict)->used, ndx)); - erts_fprintf(stderr, "%T", term); -#endif /* HARDDEBUG */ - return ret; + if (size > pd->used) + pd->used = size; } /* -- cgit v1.2.3 From bb5f71a7573158056dd9c80228c95833f970ec0b Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 9 Dec 2015 19:28:15 +0100 Subject: erts: Add proc dict macros ERTS_PD_START/SIZE --- erts/emulator/beam/beam_bif_load.c | 4 ++-- erts/emulator/beam/erl_debug.c | 6 +++--- erts/emulator/beam/erl_gc.c | 10 +++++----- erts/emulator/beam/erl_process_dict.h | 3 +++ 4 files changed, 13 insertions(+), 10 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 0e192b1ebd..c804a09f87 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -851,8 +851,8 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) } if (rp->dictionary != NULL) { - Eterm* start = rp->dictionary->data; - Eterm* end = start + rp->dictionary->used; + Eterm* start = ERTS_PD_START(rp->dictionary); + Eterm* end = start + ERTS_PD_SIZE(rp->dictionary); if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) { goto need_gc; diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 2dcfb79f00..a2af3adf70 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -416,7 +416,7 @@ void verify_process(Process *p) erts_check_heap(p); if (p->dictionary) - VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used); + VERIFY_AREA("dictionary", ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary)); VERIFY_ETERM("seq trace token",p->seq_trace_token); VERIFY_ETERM("group leader",p->group_leader); VERIFY_ETERM("fvalue",p->fvalue); @@ -542,8 +542,8 @@ static void print_process_memory(Process *p) } if (p->dictionary != NULL) { - int n = p->dictionary->used; - Eterm *ptr = p->dictionary->data; + int n = ERTS_PD_SIZE(p->dictionary); + Eterm *ptr = ERTS_PD_START(p->dictionary); erts_printf(" Dictionary: "); while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++); erts_printf("\n"); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index d2604f1595..b743b7e8f6 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1953,7 +1953,7 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, #ifdef HARDDEBUG disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop); if (p->dictionary != NULL) { - disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used); + disallow_heap_frag_ref(p, n_htop, ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary)); } disallow_heap_frag_ref_in_heap(p); #endif @@ -1993,8 +1993,8 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; if (p->dictionary != NULL) { - roots[n].v = p->dictionary->data; - roots[n].sz = p->dictionary->used; + roots[n].v = ERTS_PD_START(p->dictionary); + roots[n].sz = ERTS_PD_SIZE(p->dictionary); ++n; } if (nobj > 0) { @@ -2589,8 +2589,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj) { if (p->dictionary) { - offset_heap(p->dictionary->data, - p->dictionary->used, + offset_heap(ERTS_PD_START(p->dictionary), + ERTS_PD_SIZE(p->dictionary), offs, area, area_size); } diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index ab50d45c63..3ad070d914 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -31,6 +31,9 @@ typedef struct proc_dict { Eterm data[1]; /* The beginning of an array of erlang terms */ } ProcDict; +#define ERTS_PD_START(PD) ((PD)->data) +#define ERTS_PD_SIZE(PD) ((PD)->used) + int erts_pd_set_initial_size(int size); Uint erts_dicts_mem_size(struct process *p); void erts_erase_dicts(struct process *p); -- cgit v1.2.3 From 4179ca9f10cdc78e882ce4496cf0a1261a0129af Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 9 Dec 2015 19:34:45 +0100 Subject: erts: Remove ProcDict.used (homeSize + splitPosition) will do just fine --- erts/emulator/beam/erl_process_dict.c | 20 +++++++++----------- erts/emulator/beam/erl_process_dict.h | 3 +-- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 0934183b6a..34c1f0c993 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -164,9 +164,9 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd) /*PD_CHECK(pd);*/ if (pd == NULL) return; - erts_print(to, to_arg, "(size = %d, used = %d, homeSize = %d, " + erts_print(to, to_arg, "(size = %d, homeSize = %d, " "splitPosition = %d, numElements = %d)\n", - pd->size, pd->used, pd->homeSize, + pd->size, pd->homeSize, pd->splitPosition, (unsigned int) pd->numElements); for (i = 0; i < HASH_RANGE(pd); ++i) { erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i)); @@ -908,8 +908,8 @@ static void array_shrink(ProcDict **ppd, unsigned int need) { unsigned int siz = next_array_size(need); - HDEBUGF(("array_shrink: size = %d, used = %d, need = %d", - (*ppd)->size, (*ppd)->used, need)); + HDEBUGF(("array_shrink: size = %d, need = %d", + (*ppd)->size, need)); if (siz >= (*ppd)->size) return; /* Only shrink */ @@ -919,8 +919,6 @@ static void array_shrink(ProcDict **ppd, unsigned int need) PD_SZ2BYTES(siz)); (*ppd)->size = siz; - if ((*ppd)->size < (*ppd)->used) - (*ppd)->used = (*ppd)->size; } @@ -936,7 +934,7 @@ static void ensure_array_size(ProcDict **ppdict, unsigned int size) for (i = 0; i < siz; ++i) pd->data[i] = NIL; pd->size = siz; - pd->homeSize = pd->splitPosition = pd->numElements = pd->used = 0; + pd->homeSize = pd->splitPosition = pd->numElements = 0; *ppdict = pd; } else if (size > pd->size) { Uint osize = pd->size; @@ -949,8 +947,6 @@ static void ensure_array_size(ProcDict **ppdict, unsigned int size) pd->size = nsize; *ppdict = pd; } - if (size > pd->used) - pd->used = size; } /* @@ -1029,12 +1025,14 @@ static unsigned int next_array_size(unsigned int need) static void pd_check(ProcDict *pd) { unsigned int i; + unsigned int used; Uint num; if (pd == NULL) return; - ASSERT(pd->size >= pd->used); + used = HASH_RANGE(pd); + ASSERT(pd->size >= used); ASSERT(HASH_RANGE(pd) <= MAX_HASH); - for (i = 0, num = 0; i < pd->used; ++i) { + for (i = 0, num = 0; i < used; ++i) { Eterm t = pd->data[i]; if (is_nil(t)) { continue; diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index 3ad070d914..eb26a1ffcc 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -24,7 +24,6 @@ typedef struct proc_dict { unsigned int size; - unsigned int used; unsigned int homeSize; unsigned int splitPosition; Uint numElements; @@ -32,7 +31,7 @@ typedef struct proc_dict { } ProcDict; #define ERTS_PD_START(PD) ((PD)->data) -#define ERTS_PD_SIZE(PD) ((PD)->used) +#define ERTS_PD_SIZE(PD) ((PD)->homeSize + (PD)->splitPosition) int erts_pd_set_initial_size(int size); Uint erts_dicts_mem_size(struct process *p); -- cgit v1.2.3 From 4804ea2aa50af490ab3998466269efa540abd90d Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 10 Dec 2015 15:25:22 +0100 Subject: erts: Add sizeMask for faster proc dict indexing --- erts/emulator/beam/erl_process_dict.c | 26 +++++++++++++++----------- erts/emulator/beam/erl_process_dict.h | 1 + 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 34c1f0c993..97a2828b4e 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -585,6 +585,9 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) /* Create it */ ensure_array_size(&p->dictionary, INITIAL_SIZE); p->dictionary->homeSize = INITIAL_SIZE; + p->dictionary->sizeMask = p->dictionary->homeSize*2 - 1; + p->dictionary->splitPosition = 0; + p->dictionary->numElements = 0; } hval = pd_hash_value(p->dictionary, id); old = ARRAY_GET(p->dictionary, hval); @@ -718,6 +721,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) static void shrink(Process *p, Eterm* ret) { + ProcDict *pd = p->dictionary; unsigned int range = HASH_RANGE(p->dictionary); unsigned int steps = (range*3) / 10; Eterm hi, lo, tmp; @@ -732,8 +736,8 @@ static void shrink(Process *p, Eterm* ret) } for (i = 0; i < steps; ++i) { - ProcDict *pd = p->dictionary; if (pd->splitPosition == 0) { + pd->sizeMask = pd->homeSize - 1; pd->homeSize /= 2; pd->splitPosition = pd->homeSize; } @@ -742,7 +746,7 @@ static void shrink(Process *p, Eterm* ret) lo = ARRAY_GET(pd, pd->splitPosition); if (hi != NIL) { if (lo == NIL) { - ARRAY_PUT(p->dictionary, pd->splitPosition, hi); + ARRAY_PUT(pd, pd->splitPosition, hi); } else { int needed = 4; if (is_list(hi) && is_list(lo)) { @@ -761,13 +765,13 @@ static void shrink(Process *p, Eterm* ret) hp = HeapOnlyAlloc(p, 4); tmp = CONS(hp, hi, NIL); hp += 2; - ARRAY_PUT(p->dictionary, pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp,lo,tmp)); hp += 2; ASSERT(hp <= hp_limit); } else { /* hi is a list */ hp = HeapOnlyAlloc(p, 2); - ARRAY_PUT(p->dictionary, pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp, lo, hi)); hp += 2; ASSERT(hp <= hp_limit); @@ -775,7 +779,7 @@ static void shrink(Process *p, Eterm* ret) } else { /* lo is a list */ if (is_tuple(hi)) { hp = HeapOnlyAlloc(p, 2); - ARRAY_PUT(p->dictionary, pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp, hi, lo)); hp += 2; ASSERT(hp <= hp_limit); @@ -787,12 +791,12 @@ static void shrink(Process *p, Eterm* ret) hp += 2; } ASSERT(hp <= hp_limit); - ARRAY_PUT(p->dictionary, pd->splitPosition, lo); + ARRAY_PUT(pd, pd->splitPosition, lo); } } } } - ARRAY_PUT(p->dictionary, (pd->splitPosition + pd->homeSize), NIL); + ARRAY_PUT(pd, (pd->splitPosition + pd->homeSize), NIL); } if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); @@ -860,7 +864,8 @@ static void grow(Process *p) for (i = 0; i < steps; ++i) { if (pd->splitPosition == pd->homeSize) { pd->homeSize *= 2; - pd->splitPosition = 0; + pd->sizeMask = pd->homeSize*2 - 1; + pd->splitPosition = 0; } pos = pd->splitPosition; ++pd->splitPosition; /* For the hashes */ @@ -934,7 +939,6 @@ static void ensure_array_size(ProcDict **ppdict, unsigned int size) for (i = 0; i < siz; ++i) pd->data[i] = NIL; pd->size = siz; - pd->homeSize = pd->splitPosition = pd->numElements = 0; *ppdict = pd; } else if (size > pd->size) { Uint osize = pd->size; @@ -959,9 +963,9 @@ static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx) ASSERT(IS_POW2(pdict->homeSize)); - high = hx & (pdict->homeSize*2 - 1); + high = hx & pdict->sizeMask; if (high >= HASH_RANGE(pdict)) - return hx & (pdict->homeSize - 1); + return hx & (pdict->sizeMask >> 1); return high; } diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index eb26a1ffcc..fd59c969cf 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -23,6 +23,7 @@ #include "sys.h" typedef struct proc_dict { + unsigned int sizeMask; unsigned int size; unsigned int homeSize; unsigned int splitPosition; -- cgit v1.2.3 From 5f49de9d6e8ae247b10e37c085bf1d1dc9945ac8 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Wed, 28 Oct 2015 17:15:36 +0000 Subject: Save error reasons for TLS distribution connections When establishing an outbound connection for TLS distribution, let's hold on to the failure reasons and use them as exit reasons. These exit reasons are normally invisible, but they can be seen in the logs after calling net_kernel:verbose(1). While there are trace messages in the code already, those require recompiling the module with a special flag, which is more cumbersome than changing the net_kernel verbosity level at run time. --- lib/ssl/src/inet_tls_dist.erl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 7367b5c224..411bb44bdc 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -75,23 +75,23 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Timer, Version, Ip, TcpPort, Address, Type), dist_util:handshake_we_started(HSData); - _ -> + Other -> %% Other Node may have closed since %% port_please ! ?trace("other node (~p) " "closed since port_please.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {connect_failed, Other}}) end; - _ -> + Other -> ?trace("port_please (~p) " "failed.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {port_please_failed, Other}}) end; - _Other -> + Other -> ?trace("inet_getaddr(~p) " "failed (~p).~n", [Node,Other]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}}) end. close(Socket) -> -- cgit v1.2.3 From 91006821c6d65708fa05a93ec1edc2372326a3cb Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Mon, 9 Nov 2015 18:25:56 +0000 Subject: Report bad options for outgoing TLS distribution If ssl:connect/3 returns an error related to options, let's log that so we have a chance to see it and fix it. --- lib/ssl/src/ssl_tls_dist_proxy.erl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index e7f7fa96a1..1f48ce9e8c 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -193,6 +193,11 @@ setup_proxy(Ip, Port, Parent) -> Err -> Parent ! {self(), Err} end; + {error, {options, _}} = Err -> + %% Bad options: that's probably our fault. Let's log that. + error_logger:error_msg("Cannot open TLS distribution connection: ~s~n", + [ssl:format_error(Err)]), + Parent ! {self(), Err}; Err -> Parent ! {self(), Err} end. -- cgit v1.2.3 From 80757f9491c72ee262a5910e0b3b02e95b1e5f2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 4 Dec 2015 12:15:40 +0100 Subject: Use 'rand' instead of the obsolete 'random' module In most cases, we don't have to seed the random number generator, as the rand:uniform/1 takes care about that itself. --- lib/asn1/src/asn1ct_value.erl | 5 +---- lib/asn1/test/testPrimStrings.erl | 2 +- lib/common_test/src/ct_config.erl | 3 +-- lib/compiler/src/rec_env.erl | 11 ++++++++++- lib/kernel/src/global.erl | 20 +++++++------------- lib/mnesia/src/mnesia_lib.erl | 15 +-------------- lib/reltool/src/reltool_fgraph_win.erl | 4 ++-- lib/syntax_tools/src/erl_syntax_lib.erl | 12 +++++++++--- lib/test_server/src/test_server_ctrl.erl | 14 ++++++++++---- lib/test_server/src/test_server_node.erl | 3 +-- 10 files changed, 43 insertions(+), 46 deletions(-) diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 7f20d57b1e..61a5661a11 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -353,10 +353,7 @@ random_unnamed_bit_string(M, C) -> %% end. random(Upper) -> - _ = random:seed(erlang:phash2([erlang:node()]), - erlang:monotonic_time(), - erlang:unique_integer()), - random:uniform(Upper). + rand:uniform(Upper). size_random(C) -> case get_constraint(C,'SizeConstraint') of diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 46793c6bff..c9217d60fa 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -54,7 +54,7 @@ fragmented_strings(Len, Types) -> ok. make_ns_value(0) -> []; -make_ns_value(N) -> [($0 - 1) + random:uniform(10)|make_ns_value(N-1)]. +make_ns_value(N) -> [($0 - 1) + rand:uniform(10)|make_ns_value(N-1)]. fragmented_lengths() -> K16 = 1 bsl 14, diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 251204aa75..33efe7a14a 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -694,11 +694,10 @@ make_crypto_key(String) -> {[K1,K2,K3],IVec}. random_bytes(N) -> - random:seed(os:timestamp()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; -random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). +random_bytes_1(N, Acc) -> random_bytes_1(N-1, [rand:uniform(255)|Acc]). check_callback_load(Callback) -> case code:is_loaded(Callback) of diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 0e9e12d1ad..5a4a870769 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -598,7 +598,16 @@ start_range(Env) -> %% (pseudo-)randomly distributed over the range. generate(_N, Range) -> - random:uniform(Range). % works well + %% We must use the same sequence of random variables to ensure + %% that two compilations of the same source code generates the + %% same BEAM code. + case rand:export_seed() of + undefined -> + rand:seed(exsplus, {1,42,2053}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index dcabeb5e49..0c73ead7c5 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -2068,23 +2068,17 @@ get_known() -> gen_server:call(global_name_server, get_known, infinity). random_sleep(Times) -> - case (Times rem 10) of - 0 -> erase(random_seed); - _ -> ok - end, - case get(random_seed) of - undefined -> - _ = random:seed(erlang:phash2([erlang:node()]), - erlang:monotonic_time(), - erlang:unique_integer()), - ok; - _ -> ok - end, + _ = case Times rem 10 of + 0 -> + _ = rand:seed(exsplus); + _ -> + ok + end, %% First time 1/4 seconds, then doubling each time up to 8 seconds max. Tmax = if Times > 5 -> 8000; true -> ((1 bsl Times) * 1000) div 8 end, - T = random:uniform(Tmax), + T = rand:uniform(Tmax), ?trace({random_sleep, {me,self()}, {times,Times}, {t,T}, {tmax,Tmax}}), receive after T -> ok end. diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 77c7a7638d..4e761d2bed 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -921,20 +921,7 @@ random_time(Retries, _Counter0) -> UpperLimit = 500, Dup = Retries * Retries, MaxIntv = trunc(UpperLimit * (1-(50/((Dup)+50)))), - - case get(random_seed) of - undefined -> - _ = random:seed(erlang:unique_integer(), - erlang:monotonic_time(), - erlang:unique_integer()), - Time = Dup + random:uniform(MaxIntv), - %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), - Time; - _ -> - Time = Dup + random:uniform(MaxIntv), - %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), - Time - end. + Dup + rand:uniform(MaxIntv). report_system_event(Event0) -> Event = {mnesia_system_event, Event0}, diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index 6b58cae187..deab502bfe 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -220,8 +220,8 @@ graph_add_node_unsure(Key, State, G = #graph{ vs = Vs }) -> graph_add_node(Key, Color, G = #graph{ vs = Vs}) -> Q = 20.0, % repulsive force M = 0.5, % mass - P = {float(450 + random:uniform(100)), - float(450 + random:uniform(100))}, + P = {float(450 + rand:uniform(100)), + float(450 + rand:uniform(100))}, G#graph{ vs = reltool_fgraph:add(Key, #fg_v{ p = P, m = M, q = Q, color = Color}, Vs)}. diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 5b5b18d15b..58c4cc5244 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -359,9 +359,9 @@ new_variable_name(S) -> %% within a reasonably small range relative to the number of elements in %% the set. %% -%% This function uses the module `random' to generate new +%% This function uses the module `rand' to generate new %% keys. The seed it uses may be initialized by calling -%% `random:seed/0' or `random:seed/3' before this +%% `rand:seed/1' or `rand:seed/2' before this %% function is first called. %% %% @see new_variable_name/1 @@ -404,7 +404,13 @@ start_range(S) -> %% order, but (pseudo-)randomly distributed over the range. generate(_Key, Range) -> - random:uniform(Range). % works well + _ = case rand:export_seed() of + undefined -> + rand:seed(exsplus, {753,8,73}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 0be6e0b4e4..34681876f3 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -3163,11 +3163,17 @@ delete_prop([], Props) -> %% Shuffles the order of Cases. shuffle_cases(Ref, Cases, undefined) -> - shuffle_cases(Ref, Cases, ?now); + shuffle_cases(Ref, Cases, rand:seed_s(exsplus)); -shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed) -> +shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) -> {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases), - ShuffledCases = random_order(N, random:uniform_s(N, Seed), CasesToShuffle, []), + Seed = case Seed0 of + {X,Y,Z} when is_integer(X+Y+Z) -> + rand:seed(exsplus, Seed0); + _ -> + Seed0 + end, + ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []), [Start|ShuffledCases] ++ Rest. cases_to_shuffle(Ref, Cases) -> @@ -3201,7 +3207,7 @@ random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) -> Shuffled++CaseOrGroup; random_order(N, {Pos,NewSeed}, IxCases, Shuffled) -> {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases), - random_order(N-1, random:uniform_s(N-1, NewSeed), + random_order(N-1, rand:uniform_s(N-1, NewSeed), First++Rest, Shuffled++CaseOrGroup). diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 4e6839fc6b..3419f3f5d0 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -619,8 +619,7 @@ do_quote_progname([Prog,Arg|Args]) -> end. random_element(L) -> - random:seed(os:timestamp()), - lists:nth(random:uniform(length(L)), L). + lists:nth(rand:uniform(length(L)), L). find_release(latest) -> "/usr/local/otp/releases/latest/bin/erl"; -- cgit v1.2.3 From 71ddd8c1aba0478fe5aa07bdc8f9e6a86515bb11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 9 Dec 2015 15:04:28 +0100 Subject: Emulator test suite: Replace use of 'random' with 'rand' --- erts/emulator/test/binary_SUITE.erl | 39 ++++++++++++------------ erts/emulator/test/bs_bincomp_SUITE.erl | 2 +- erts/emulator/test/decode_packet_SUITE.erl | 47 ++++++++++++++--------------- erts/emulator/test/driver_SUITE.erl | 15 +++------ erts/emulator/test/evil_SUITE.erl | 4 +-- erts/emulator/test/hash_SUITE.erl | 10 +++--- erts/emulator/test/map_SUITE.erl | 27 ++++++++--------- erts/emulator/test/nif_SUITE.erl | 19 +++++------- erts/emulator/test/op_SUITE.erl | 23 +++++++------- erts/emulator/test/port_SUITE.erl | 15 +++++---- erts/emulator/test/port_bif_SUITE.erl | 9 +----- erts/emulator/test/random_iolist.erl | 16 +++++----- erts/emulator/test/save_calls_SUITE.erl | 4 +-- erts/emulator/test/system_profile_SUITE.erl | 2 +- erts/emulator/test/time_SUITE.erl | 36 ++++++++++------------ erts/emulator/test/trace_SUITE.erl | 4 +-- 16 files changed, 121 insertions(+), 151 deletions(-) diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 96ba2f64d4..f8f71efecc 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -521,30 +521,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit -> external_size_1(_, _, _) -> ok. t_iolist_size(Config) when is_list(Config) -> - ?line Seed = {erlang:monotonic_time(), - erlang:time_offset(), - erlang:unique_integer([positive])}, - ?line io:format("Seed: ~p", [Seed]), - ?line random:seed(Seed), - ?line Base = <<0:(1 bsl 20)/unit:8>>, - ?line Powers = [1 bsl N || N <- lists:seq(2, 37)], - ?line Sizes0 = [[N - random:uniform(N div 2), - lists:seq(N-2, N+2), - N+N div 2, - N + random:uniform(N div 2)] || - N <- Powers], + _ = rand:uniform(), %Seed generator + io:format("Seed: ~p", [rand:export_seed()]), + + Base = <<0:(1 bsl 20)/unit:8>>, + Powers = [1 bsl N || N <- lists:seq(2, 37)], + Sizes0 = [[N - rand:uniform(N div 2), + lists:seq(N-2, N+2), + N+N div 2, + N + rand:uniform(N div 2)] || + N <- Powers], + %% Test sizes around 1^32 more thoroughly. FourGigs = 1 bsl 32, - ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, - ?line Sizes2 = lists:flatten(Sizes1), - ?line Sizes = lists:usort(Sizes2), + Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, + Sizes2 = lists:flatten(Sizes1), + Sizes = lists:usort(Sizes2), io:format("~p sizes:", [length(Sizes)]), io:format("~p\n", [Sizes]), - ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], + _ = [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], ok. build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <> = Base, Bin; @@ -552,7 +551,7 @@ build_iolist(N, Base) when N < 16 -> lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <> = Base, Bin; @@ -570,7 +569,7 @@ build_iolist(N, Base) when N =< byte_size(Base) -> end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of @@ -1604,7 +1603,7 @@ bit_sized_binary(Bin0) -> unaligned_sub_bin(Bin, 0) -> Bin; unaligned_sub_bin(Bin0, Offs) -> - F = random:uniform(256), + F = rand:uniform(256), Roffs = 8-Offs, Bin1 = <>, Sz = size(Bin0), diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl index dcd13c19df..8836fe40ae 100644 --- a/erts/emulator/test/bs_bincomp_SUITE.erl +++ b/erts/emulator/test/bs_bincomp_SUITE.erl @@ -131,7 +131,7 @@ tracing(Config) when is_list(Config) -> random_binary() -> Seq = [1,2,3,4,5,6,7,8,9,10], - << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>. + << <<($a + rand:uniform($z - $a)):8>> || _ <- Seq >>. random_binaries(N) when N > 0 -> random_binary(), diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 6a5ca20ac3..65ae94d0dc 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -53,11 +53,8 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Seed = {S1,S2,S3} = {erlang:monotonic_time(), - erlang:time_offset(), - erlang:unique_integer()}, - random:seed(S1,S2,S3), - io:format("*** SEED: ~p ***\n", [Seed]), + rand:seed(exsplus), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), Dog=?t:timetrap(?t:minutes(1)), [{watchdog, Dog}|Config]. @@ -136,7 +133,7 @@ pack(Type,Body,Rest,BitOffs) -> {Packet,Unpacked} = pack(Type,Body), %% Make Bin a sub-bin with an arbitrary bitoffset within Orig - Prefix = random:uniform(1 bsl BitOffs) - 1, + Prefix = rand:uniform(1 bsl BitOffs) - 1, Orig = <>, <<_:BitOffs,Bin/bits>> = Orig, {Bin,Unpacked,Orig}. @@ -151,13 +148,13 @@ pack(4,Bin) -> Psz = byte_size(Bin), {<>, Bin}; pack(asn1,Bin) -> - Ident = case random:uniform(3) of + Ident = case rand:uniform(3) of 1 -> <<17>>; 2 -> <<16#1f,16#81,17>>; 3 -> <<16#1f,16#81,16#80,16#80,17>> end, Psz = byte_size(Bin), - Length = case random:uniform(4) of + Length = case rand:uniform(4) of 1 when Psz < 128 -> <>; R when R=<2 andalso Psz < 16#10000 -> @@ -177,42 +174,42 @@ pack(sunrm,Bin) -> {Res,Res}; pack(cdr,Bin) -> GIOP = <<"GIOP">>, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, - MType = random:uniform(256) - 1, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, + MType = rand:uniform(256) - 1, Psz = byte_size(Bin), - Res = case random:uniform(2) of + Res = case rand:uniform(2) of 1 -> <>; 2 -> <> end, {Res,Res}; pack(fcgi,Bin) -> Ver = 1, - Type = random:uniform(256) - 1, - Id = random:uniform(65536) - 1, - PaddSz = random:uniform(16) - 1, + Type = rand:uniform(256) - 1, + Id = rand:uniform(65536) - 1, + PaddSz = rand:uniform(16) - 1, Psz = byte_size(Bin), - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Padd = case PaddSz of 0 -> <<>>; - _ -> list_to_binary([random:uniform(256)-1 + _ -> list_to_binary([rand:uniform(256)-1 || _<- lists:seq(1,PaddSz)]) end, Res = <>, {<>, Res}; pack(tpkt,Bin) -> Ver = 3, - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Size = byte_size(Bin) + 4, Res = <>, {Res, Res}; pack(ssl_tls,Bin) -> - Content = case (random:uniform(256) - 1) of + Content = case (rand:uniform(256) - 1) of C when C<128 -> C; _ -> v2hello end, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, pack_ssl(Content,Major,Minor,Bin). pack_ssl(Content, Major, Minor, Body) -> @@ -371,10 +368,10 @@ http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) -> ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), %% Same tests again but as SubBin - PreLen = random:uniform(64), - Prefix = random:uniform(1 bsl PreLen) - 1, - SufLen = random:uniform(64), - Suffix = random:uniform(1 bsl SufLen) - 1, + PreLen = rand:uniform(64), + Prefix = rand:uniform(1 bsl PreLen) - 1, + SufLen = rand:uniform(64), + Suffix = rand:uniform(1 bsl SufLen) - 1, Orig = <>, BinLen = bit_size(Bin), <<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index b72d6cbe52..4fd7b36e6a 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -224,7 +224,7 @@ outputv_errors_1(Term) -> port_close(Port). build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <> = Base, Bin; @@ -232,7 +232,7 @@ build_iolist(N, Base) when N < 16 -> lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <> = Base, Bin; @@ -250,7 +250,7 @@ build_iolist(N, Base) when N =< byte_size(Base) -> end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of @@ -2502,14 +2502,7 @@ random_char() -> uniform(256) - 1. uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). erl_millisecs() -> erl_millisecs(erlang:monotonic_time()). diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index 484d2a8bf5..d28e4d9596 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -382,10 +382,10 @@ my_appender_1(N, T0) -> my_appender_1(N-1, T). seed() -> - random:seed(3172, 9815, 20129). + rand:seed(exsplus, {3172,9815,20129}). rnd_term() -> - U0 = random:uniform(), + U0 = rand:uniform(), B = <>, {U0,U0 * 2.5 + 3.14,[U0*2.3,B]}. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 2ea49467b8..1b2acf48e1 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -223,11 +223,10 @@ basic_test() -> range_test() -> - random:seed(), F = fun(From,From,_FF) -> ok; (From,To,FF) -> - R = random:uniform(16#FFFFFFFFFFFFFFFF), + R = rand:uniform(16#FFFFFFFFFFFFFFFF), X = erlang:phash(R, From), Y = erlang:phash(R, 16#100000000) - 1, Z = (Y rem From) + 1, @@ -265,14 +264,13 @@ spread_test(N) -> cmp_test(N) -> - % No need to save seed, the error indicates what number caused it. - random:seed(), do_cmp_hashes(N,8). + do_cmp_hashes(0,_) -> ok; do_cmp_hashes(N,Steps) -> - R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), - R = case random:uniform(2) of + R0 = rand:uniform(1 bsl Steps - 1) + rand:uniform(16#FFFFFFFF), + R = case rand:uniform(2) of 1 -> R0; _ -> diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 6890c42b7a..b74be7c53a 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -1511,11 +1511,8 @@ t_map_equal(Config) when is_list(Config) -> t_map_compare(Config) when is_list(Config) -> - Seed = {erlang:monotonic_time(), - erlang:time_offset(), - erlang:unique_integer()}, - io:format("seed = ~p\n", [Seed]), - random:seed(Seed), + rand:seed(exsplus), + io:format("seed = ~p\n", [rand:export_seed()]), repeat(100, fun(_) -> float_int_compare() end, []), repeat(100, fun(_) -> recursive_compare() end, []), ok. @@ -1533,7 +1530,7 @@ float_int_compare() -> numeric_keys(N) -> lists:foldl(fun(_,Acc) -> - Int = random:uniform(N*4) - N*2, + Int = rand:uniform(N*4) - N*2, Float = float(Int), [Int, Float, Float * 0.99, Float * 1.01 | Acc] end, @@ -1564,7 +1561,7 @@ do_compare([Gen1, Gen2]) -> %% Change one key from int to float (or vice versa) and check compare ML1 = maps:to_list(M1), - {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1), + {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1), case K1 of I when is_integer(I) -> case maps:find(float(I),M1) of @@ -1655,9 +1652,9 @@ cmp_others(T1, T2, _) -> map_gen(Pairs, Size) -> {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> - KI = random:uniform(size(Keys)), + KI = rand:uniform(size(Keys)), K = element(KI,Keys), - KV = element(random:uniform(size(K)), K), + KV = element(rand:uniform(size(K)), K), {erlang:delete_element(KI,Keys), [KV | Acc]} end, {Pairs, []}, @@ -1697,15 +1694,15 @@ term_gen_recursive(Leafs, Flags, Depth) -> MaxDepth = 10, Rnd = case {Flags, Depth} of {_, MaxDepth} -> % Only leafs - random:uniform(size(Leafs)) + 3; + rand:uniform(size(Leafs)) + 3; {0, 0} -> % Only containers - random:uniform(3); + rand:uniform(3); {0,_} -> % Anything - random:uniform(size(Leafs)+3) + rand:uniform(size(Leafs)+3) end, case Rnd of 1 -> % Make map - Size = random:uniform(size(Leafs)), + Size = rand:uniform(size(Leafs)), lists:foldl(fun(_, {Acc1,Acc2}) -> {K1,K2} = term_gen_recursive(Leafs, Flags, Depth+1), @@ -1720,7 +1717,7 @@ term_gen_recursive(Leafs, Flags, Depth) -> {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), {[Car1 | Cdr1], [Car2 | Cdr2]}; 3 -> % Make tuple - Size = random:uniform(size(Leafs)), + Size = rand:uniform(size(Leafs)), L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, lists:seq(1,Size)), {L1, L2} = lists:unzip(L), @@ -1729,7 +1726,7 @@ term_gen_recursive(Leafs, Flags, Depth) -> N -> % Make leaf case element(N-3, Leafs) of I when is_integer(I) -> - case random:uniform(4) of + case rand:uniform(4) of 1 -> {I, float(I)}; 2 -> {float(I), I}; _ -> {I,I} diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index af2b955184..56b36d2626 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1192,11 +1192,8 @@ send3(Config) when is_list(Config) -> %% Let a number of processes send random message blobs between each other %% using enif_send. Kill and spawn new ones randomly to keep a ~constant %% number of workers running. - Seed = {erlang:monotonic_time(), - erlang:time_offset(), - erlang:unique_integer()}, - io:format("seed: ~p\n",[Seed]), - random:seed(Seed), + rand:seed(exsplus), + io:format("seed: ~p\n",[rand:export_seed()]), ets:new(nif_SUITE,[named_table,public]), ?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}), timer:send_after(10000, timeout), % Run for 10 seconds @@ -1229,7 +1226,7 @@ send3_controller(SpawnCnt0, Mons0, Pids0, Tick) -> after Tick -> Max = 20, N = length(Pids0), - PidN = random:uniform(Max), + PidN = rand:uniform(Max), %%io:format("N=~p PidN=~p Pids0=~p\n", [N,PidN,Pids0]), case PidN > N of true -> @@ -1293,7 +1290,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> end. send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> - To = lists:nth(random:uniform(length(Pids)),Pids), + To = lists:nth(rand:uniform(length(Pids)),Pids), Blob = send3_make_blob(), State1 = send3_new_state(State0,Blob), case send3_send(To, Blob) of @@ -1305,12 +1302,12 @@ send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> send3_make_blob() -> - case random:uniform(20)-1 of + case rand:uniform(20)-1 of 0 -> {term,[]}; N -> MsgEnv = alloc_msgenv(), repeat(N bsr 1, - fun(_) -> grow_blob(MsgEnv,other_term(),random:uniform(1 bsl 20)) + fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20)) end, void), case (N band 1) of 0 -> {term,copy_blob(MsgEnv)}; @@ -1320,7 +1317,7 @@ send3_make_blob() -> send3_send(Pid, Msg) -> %% 90% enif_send and 10% normal bang - case random:uniform(10) of + case rand:uniform(10) of 1 -> send3_send_bang(Pid,Msg); _ -> send3_send_nif(Pid,Msg) end. @@ -1341,7 +1338,7 @@ send3_send_bang(Pid, {msgenv,MsgEnv}) -> true. send3_new_state(State, Blob) -> - case random:uniform(5+2) of + case rand:uniform(5+2) of N when N =< 5-> setelement(N, State, Blob); _ -> State % Don't store blob end. diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index 6eda78a57b..65a5a4c505 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -97,10 +97,11 @@ relop_simple(Config) when is_list(Config) -> lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end, Combos), - repeat(fun() -> Size = random:uniform(100), - Rnd1 = make_rand_term(Size), - {Rnd2,0} = clone_and_mutate(Rnd1, random:uniform(Size)), - relop_simple_do(Rnd1,Rnd2) + repeat(fun() -> + Size = rand:uniform(100), + Rnd1 = make_rand_term(Size), + {Rnd2,0} = clone_and_mutate(Rnd1, rand:uniform(Size)), + relop_simple_do(Rnd1,Rnd2) end, 1000), ok. @@ -158,7 +159,7 @@ cmp_emu(A,B) -> make_rand_term(1) -> make_rand_term_single(); make_rand_term(Arity) -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> make_rand_list(Arity); 2 -> @@ -169,17 +170,17 @@ make_rand_term(Arity) -> end. make_rand_term_single() -> - Range = 1 bsl random:uniform(200), - case random:uniform(12) of + Range = 1 bsl rand:uniform(200), + case rand:uniform(12) of 1 -> random; 2 -> uniform; - 3 -> random:uniform(Range) - (Range div 2); - 4 -> Range * (random:uniform() - 0.5); + 3 -> rand:uniform(Range) - (Range div 2); + 4 -> Range * (rand:uniform() - 0.5); 5 -> 0; 6 -> 0.0; 7 -> make_ref(); 8 -> self(); - 9 -> term_to_binary(random:uniform(Range)); + 9 -> term_to_binary(rand:uniform(Range)); 10 -> fun(X) -> X*Range end; 11 -> fun(X) -> X/Range end; 12 -> [] @@ -188,7 +189,7 @@ make_rand_term_single() -> make_rand_term_rand_size(1) -> {make_rand_term(1), 0}; make_rand_term_rand_size(MaxArity) -> - Arity = random:uniform(MaxArity-1), + Arity = rand:uniform(MaxArity-1), {make_rand_term(Arity), MaxArity-Arity}. make_rand_list(0) -> []; diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 3d0509a28c..b42e02a1e1 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -2183,15 +2183,14 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = Seed = time(), - io:format("Random seed = ~p\n",[Seed]), - random:seed(X, Y, Z); + case rand:export_seed() of + undefined -> + rand:seed(exsplus), + io:format("Random seed = ~p\n", [rand:export_seed()]); _ -> ok end, - random:uniform(N). + rand:uniform(N). fun_spawn(Fun) -> fun_spawn(Fun, []). @@ -2331,7 +2330,7 @@ close_deaf_port(Config) when is_list(Config) -> close_deaf_port_1(200, _) -> ok; close_deaf_port_1(N, Cmd) -> - Timeout = integer_to_list(random:uniform(5*1000)), + Timeout = integer_to_list(rand:uniform(5*1000)), try open_port({spawn_executable,Cmd},[{args,[Timeout]}]) of Port -> erlang:port_command(Port,"Hello, can you hear me!?!?"), @@ -2372,7 +2371,7 @@ port_setget_data(Config) when is_list(Config) -> ok. port_setget_data_hammer(Port, HeapData, IsSet0, N) -> - Rand = random:uniform(3), + Rand = rand:uniform(3), IsSet1 = try case Rand of 1 -> true = erlang:port_set_data(Port, atom), true; 2 -> true = erlang:port_set_data(Port, HeapData), true; diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index b65a22a528..981899b167 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -485,14 +485,7 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). unaligned_sub_bin(Bin0) -> Bin1 = <<0:3,Bin0/binary,31:5>>, diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl index 9a0f034e72..6da7da04de 100644 --- a/erts/emulator/test/random_iolist.erl +++ b/erts/emulator/test/random_iolist.erl @@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) -> compare2(Iter,Fun1,Fun2). random_byte() -> - random:uniform(256) - 1. + rand:uniform(256) - 1. random_list(0,Acc) -> Acc; @@ -45,7 +45,7 @@ random_list(N,Acc) -> random_binary(N) -> B = list_to_binary(random_list(N,[])), - case {random:uniform(2),size(B)} of + case {rand:uniform(2),size(B)} of {2,M} when M > 1 -> S = M-1, <<_:3,C:S/binary,_:5>> = B, @@ -57,7 +57,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -65,7 +65,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -77,7 +77,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -90,9 +90,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_iolist(0,Acc) -> @@ -139,7 +139,7 @@ random_iolist(N) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index 544d841f16..810bc07eed 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -189,7 +189,7 @@ is_local_function(_) -> % Number crunching for reds test. carmichaels_below(N) -> - random:seed(3172,9814,20125), + rand:seed(exsplus, {3172,9814,20125}), carmichaels_below(1,N). carmichaels_below(N,N2) when N >= N2 -> @@ -219,7 +219,7 @@ expmod(Base,Exp,Mod) -> (Base * expmod(Base,Exp - 1,Mod)) rem Mod. uniform(N) -> - random:uniform(N-1). + rand:uniform(N-1). fermat(N) -> R = uniform(N), diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index e4b6511d1f..0a0784337f 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -448,7 +448,7 @@ run_load(N, Pids) -> run_load(N - 1, [Pid | Pids]). list_load() -> - ok = case math:sin(random:uniform(32451)) of + ok = case math:sin(rand:uniform(32451)) of A when is_float(A) -> ok; _ -> ok end, diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 33076c7461..3bd28a6d20 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -69,7 +69,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> [{testcase, Func}|Config]. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> ok. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -742,25 +742,21 @@ chk_strc(Res0, Res1) -> ok. chk_random_values(FR, TR) -> -% case (FR rem TR == 0) orelse (TR rem FR == 0) of -% true -> - io:format("rand values ~p -> ~p~n", [FR, TR]), - random:seed(268438039, 268440479, 268439161), - Values = lists:map(fun (_) -> random:uniform(1 bsl 65) - (1 bsl 64) end, - lists:seq(1, 100000)), - CheckFun = fun (V) -> - CV = erlang:convert_time_unit(V, FR, TR), - case {(FR*CV) div TR =< V, - (FR*(CV+1)) div TR >= V} of - {true, true} -> - ok; - Failure -> - ?t:fail({Failure, CV, V, FR, TR}) - end - end, - lists:foreach(CheckFun, Values).%; -% false -> ok -% end. + io:format("rand values ~p -> ~p~n", [FR, TR]), + rand:seed(exsplus, {268438039,268440479,268439161}), + Values = lists:map(fun (_) -> rand:uniform(1 bsl 65) - (1 bsl 64) end, + lists:seq(1, 100000)), + CheckFun = fun (V) -> + CV = erlang:convert_time_unit(V, FR, TR), + case {(FR*CV) div TR =< V, + (FR*(CV+1)) div TR >= V} of + {true, true} -> + ok; + Failure -> + ?t:fail({Failure, CV, V, FR, TR}) + end + end, + lists:foreach(CheckFun, Values). chk_values_per_value(_FromRes, _ToRes, diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 6eae182e45..00b90e3c3d 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -933,7 +933,7 @@ suspend_exit(suite) -> []; suspend_exit(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), - ?line random:seed(4711,17,4711), + rand:seed(exsplus, {4711,17,4711}), ?line do_suspend_exit(5000), ?line test_server:timetrap_cancel(Dog), ?line ok. @@ -941,7 +941,7 @@ suspend_exit(Config) when is_list(Config) -> do_suspend_exit(0) -> ?line ok; do_suspend_exit(N) -> - ?line Work = random:uniform(50), + Work = rand:uniform(50), ?line Parent = self(), ?line {Suspendee, Mon2} = spawn_monitor(fun () -> -- cgit v1.2.3 From fcc7aae270464f7328c5ff494d392217267f71cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 9 Dec 2015 15:38:35 +0100 Subject: compiler tests: Replace 'random' with 'rand' --- lib/compiler/test/map_SUITE.erl | 22 +++++++++++----------- lib/compiler/test/misc_SUITE.erl | 4 ++-- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 411b15eebe..b3cafe4ed9 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1882,7 +1882,7 @@ register_corruption_dummy_call(A,B,C) -> {A,B,C}. t_frequency_table(Config) when is_list(Config) -> - random:seed({13,1337,54}), % pseudo random + rand:seed(exsplus, {13,1337,54}), % pseudo random N = 100000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), @@ -1925,7 +1925,7 @@ rand_terms(0) -> []; rand_terms(N) -> [rand_term()|rand_terms(N-1)]. rand_term() -> - case random:uniform(6) of + case rand:uniform(6) of 1 -> rand_binary(); 2 -> rand_number(); 3 -> rand_atom(); @@ -1935,21 +1935,21 @@ rand_term() -> end. rand_binary() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<>>; 2 -> <<"hi">>; 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> end. rand_number() -> - case random:uniform(3) of - 1 -> random:uniform(5); - 2 -> float(random:uniform(5)); - 3 -> 1 bsl (63 + random:uniform(3)) + case rand:uniform(3) of + 1 -> rand:uniform(5); + 2 -> float(rand:uniform(5)); + 3 -> 1 bsl (63 + rand:uniform(3)) end. rand_atom() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> hi; 2 -> some_atom; 3 -> some_other_atom @@ -1957,21 +1957,21 @@ rand_atom() -> rand_tuple() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> {ok, rand_term()}; % careful 2 -> {1, 2, 3}; 3 -> {<<"yep">>, 1337} end. rand_list() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> "hi"; 2 -> [1,rand_term()]; % careful 3 -> [improper|list] end. rand_map() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> #{ hi => 3 }; 2 -> #{ wat => rand_term(), other => 3 }; % careful 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index c7c20fdbf2..a8b4ed0a24 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -389,9 +389,9 @@ integer_encoding_1(Config) -> do_integer_encoding(0, _, _, _) -> ok; do_integer_encoding(N, I0, Src, Data) -> - I1 = (I0 bsl 5) bor (random:uniform(32) - 1), + I1 = (I0 bsl 5) bor (rand:uniform(32) - 1), do_integer_encoding(I1, Src, Data), - I2 = -(I1 bxor (random:uniform(32) - 1)), + I2 = -(I1 bxor (rand:uniform(32) - 1)), do_integer_encoding(I2, Src, Data), do_integer_encoding(N-1, I1, Src, Data). -- cgit v1.2.3 From d8dab7ad987cb0d57bc2e4b2bbbec7ebe5ef2a04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 9 Dec 2015 15:41:28 +0100 Subject: debugger tests: Replace 'random' with 'rand' --- lib/debugger/test/map_SUITE.erl | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 0ef634f7aa..eabcdcbf42 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -2219,7 +2219,7 @@ map_guard_sequence_mixed(K1,K2,M) -> t_frequency_table(Config) when is_list(Config) -> - random:seed({13,1337,54}), % pseudo random + rand:seed(exsplus, {13,1337,54}), % pseudo random N = 1000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), @@ -2262,7 +2262,7 @@ rand_terms(0) -> []; rand_terms(N) -> [rand_term()|rand_terms(N-1)]. rand_term() -> - case random:uniform(6) of + case rand:uniform(6) of 1 -> rand_binary(); 2 -> rand_number(); 3 -> rand_atom(); @@ -2272,21 +2272,21 @@ rand_term() -> end. rand_binary() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<>>; 2 -> <<"hi">>; 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> end. rand_number() -> - case random:uniform(3) of - 1 -> random:uniform(5); - 2 -> float(random:uniform(5)); - 3 -> 1 bsl (63 + random:uniform(3)) + case rand:uniform(3) of + 1 -> rand:uniform(5); + 2 -> float(rand:uniform(5)); + 3 -> 1 bsl (63 + rand:uniform(3)) end. rand_atom() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> hi; 2 -> some_atom; 3 -> some_other_atom @@ -2294,21 +2294,21 @@ rand_atom() -> rand_tuple() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> {ok, rand_term()}; % careful 2 -> {1, 2, 3}; 3 -> {<<"yep">>, 1337} end. rand_list() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> "hi"; 2 -> [1,rand_term()]; % careful 3 -> [improper|list] end. rand_map() -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> #{ hi => 3 }; 2 -> #{ wat => rand_term(), other => 3 }; % careful 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } -- cgit v1.2.3 From 51f1e296e7d8709df6324f78e365446a22201cf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 14:57:40 +0100 Subject: kernel test: Replace 'random' with 'rand' --- lib/kernel/test/file_name_SUITE.erl | 6 +++--- lib/kernel/test/gen_tcp_echo_SUITE.erl | 9 +-------- lib/kernel/test/global_SUITE.erl | 2 +- lib/kernel/test/inet_SUITE.erl | 3 +-- lib/kernel/test/inet_res_SUITE.erl | 2 +- lib/kernel/test/zlib_SUITE.erl | 6 +++--- 6 files changed, 10 insertions(+), 18 deletions(-) diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 32006d893e..4c422c9e0a 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -159,7 +159,7 @@ normalize(suite) -> normalize(doc) -> ["Check that filename normalization works"]; normalize(Config) when is_list(Config) -> - random:seed({1290,431421,830412}), + rand:seed(exsplus, {1290,431421,830412}), try ?line UniMode = file:native_name_encoding() =/= latin1, if @@ -845,7 +845,7 @@ conv(L) -> rand_comp_decomp(Max) -> - N = random:uniform(Max), + N = rand:uniform(Max), L = [ rand_decomp() || _ <- lists:seq(1,N) ], LC = [ A || {A,_} <- L], LD = lists:flatten([B || {_,B} <- L]), @@ -855,7 +855,7 @@ rand_comp_decomp(Max) -> rand_decomp() -> BT = bigtup(), SZ = tuple_size(BT), - element(random:uniform(SZ),BT). + element(rand:uniform(SZ),BT). bigtup() -> {{192,[65,768]}, {200,[69,768]}, diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl index 6dcb21758b..b5ed16ec34 100644 --- a/lib/kernel/test/gen_tcp_echo_SUITE.erl +++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl @@ -442,14 +442,7 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). put_int32(X, big, List) -> [ (X bsr 24) band 16#ff, diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 73ee86eba4..c0e24e17fe 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -2931,7 +2931,7 @@ sync_until(LogFile) -> timer:sleep(Time). shuffle(L) -> - [E || {_, E} <- lists:keysort(1, [{random:uniform(), E} || E <- L])]. + [E || {_, E} <- lists:keysort(1, [{rand:uniform(), E} || E <- L])]. sync_0(suite) -> []; sync_0(doc) -> diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 5ba06bb032..d64a52fc2c 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -868,7 +868,6 @@ gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts) -> ?line Lookupers = [spawn_link( fun () -> - random:seed(), lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts) end) || _ <- lists:seq(1, N)], @@ -929,7 +928,7 @@ lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) -> Parent ! {Tag,Error} end, receive - after random:uniform(Delay) -> + after rand:uniform(Delay) -> lookup_loop(Hs, Delay, Tag, Parent, Cnt-1, Hosts) end. diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index ace4ccb8bd..6e575c2f95 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -120,7 +120,7 @@ ns_init(ZoneDir, PrivDir, DataDir) -> {unix,_} -> PortNum = case {os:type(),os:version()} of {{unix,solaris},{M,V,_}} when M =< 5, V < 10 -> - 11895 + random:uniform(100); + 11895 + rand:uniform(100); _ -> {ok,S} = gen_udp:open(0, [{reuseaddr,true}]), {ok,PNum} = inet:port(S), diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 6aaa024a82..77fdabe73c 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -912,7 +912,7 @@ smp(Config) -> FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})} end, Funcs), - Pids = [spawn_link(?MODULE, worker, [random:uniform(9999), + Pids = [spawn_link(?MODULE, worker, [rand:uniform(9999), list_to_tuple(FnAList), self()]) || _ <- lists:seq(1,NumOfProcs)], @@ -925,7 +925,7 @@ smp(Config) -> worker(Seed, FnATpl, Parent) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), + rand:seed(exsplus, {Seed,Seed,Seed}), worker_loop(100, FnATpl), Parent ! self(). @@ -933,7 +933,7 @@ worker_loop(0, _FnATpl) -> large_deflate_do(), % the time consuming one as finale ok; worker_loop(N, FnATpl) -> - {F,A} = element(random:uniform(size(FnATpl)),FnATpl), + {F,A} = element(rand:uniform(tuple_size(FnATpl)), FnATpl), ?MODULE:F(A), worker_loop(N-1, FnATpl). -- cgit v1.2.3 From 4145a6e4a5a65b1ba070328b03b8a0c085d9feba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 9 Dec 2015 15:41:28 +0100 Subject: stdlib tests: Replace 'random' with 'rand' --- lib/stdlib/test/base64_SUITE.erl | 2 +- lib/stdlib/test/binary_module_SUITE.erl | 34 +++++++------- lib/stdlib/test/dict_SUITE.erl | 16 +++---- lib/stdlib/test/ets_SUITE.erl | 80 ++++++++++++++++----------------- lib/stdlib/test/ets_tough_SUITE.erl | 10 ++--- lib/stdlib/test/filelib_SUITE.erl | 2 +- lib/stdlib/test/lists_SUITE.erl | 22 +++------ lib/stdlib/test/queue_SUITE.erl | 10 ++--- lib/stdlib/test/random_iolist.erl | 16 +++---- lib/stdlib/test/random_unicode_list.erl | 18 ++++---- lib/stdlib/test/run_pcre_tests.erl | 10 ++--- lib/stdlib/test/select_SUITE.erl | 21 +++++---- lib/stdlib/test/sets_SUITE.erl | 22 ++++----- lib/stdlib/test/timer_SUITE.erl | 24 +++++----- 14 files changed, 134 insertions(+), 153 deletions(-) diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl index 75eebba6c6..f750145ef0 100644 --- a/lib/stdlib/test/base64_SUITE.erl +++ b/lib/stdlib/test/base64_SUITE.erl @@ -340,7 +340,7 @@ interleaved_ws_roundtrip_1([], Base64List, Bin, List) -> random_byte_list(0, Acc) -> Acc; random_byte_list(N, Acc) -> - random_byte_list(N-1, [random:uniform(255)|Acc]). + random_byte_list(N-1, [rand:uniform(255)|Acc]). make_big_binary(N) -> list_to_binary(mbb(N, [])). diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 933c3ce5a9..8a2df2bf85 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -716,7 +716,7 @@ do_interesting(Module) -> encode_decode(doc) -> ["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"]; encode_decode(Config) when is_list(Config) -> - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = encode_decode_loop({1,200},1000), % Need to be long enough % to create offheap binaries ok. @@ -823,7 +823,7 @@ copy(Config) when is_list(Config) -> ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>, 16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), ?line <<>> = binary:copy(<<>>,10000), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = random_copy(3000), ?line erts_debug:set_internal_state(available_internal_state,true), ?line io:format("oldlimit: ~p~n", @@ -861,7 +861,7 @@ random_copy(0) -> ok; random_copy(N) -> Str = random_string({0,N}), - Num = random:uniform(N div 10+1), + Num = rand:uniform(N div 10+1), A = ?MASK_ERROR(binary:copy(Str,Num)), B = ?MASK_ERROR(binref:copy(Str,Num)), C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)), @@ -902,7 +902,7 @@ bin_to_list(Config) when is_list(Config) -> ?line [5] = lists:nthtail(byte_size(X)-1,LX), ?line [0,5] = lists:nthtail(byte_size(X)-2,LX), ?line [0,5] = lists:nthtail(byte_size(Y)-2,LY), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line ok = random_bin_to_list(5000), ok. @@ -969,7 +969,7 @@ parts(Config) when is_list(Config) -> ?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})), ?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})), ?line <<8>> = binary:part(Simple,{7,1}), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line random_parts(5000), ok. @@ -993,15 +993,15 @@ random_parts(N) -> random_parts(0,_) -> []; random_parts(X,N) -> - Pos = random:uniform(N), - Len = random:uniform((Pos * 12) div 10), + Pos = rand:uniform(N), + Len = rand:uniform((Pos * 12) div 10), [{Pos,Len} | random_parts(X-1,N)]. random_ref_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation"]; random_ref_comp(Config) when is_list(Config) -> put(success_counter,0), - random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, Hr = {30,1000}, I1 = 1500, @@ -1031,7 +1031,7 @@ random_ref_sr_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; random_ref_sr_comp(Config) when is_list(Config) -> put(success_counter,0), - random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), Nr = {1,40}, Hr = {30,1000}, I1 = 1500, @@ -1049,7 +1049,7 @@ random_ref_fla_comp(doc) -> ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; random_ref_fla_comp(Config) when is_list(Config) -> ?line put(success_counter,0), - ?line random:seed({1271,769940,559934}), + rand:seed(exsplus, {1271,769940,559934}), ?line do_random_first_comp(5000,{1,1000}), ?line do_random_last_comp(5000,{1,1000}), ?line do_random_at_comp(5000,{1,1000}), @@ -1383,24 +1383,24 @@ one_random(N) -> random_number({Min,Max}) -> % Min and Max are *length* of number in % decimal positions - X = random:uniform(Max - Min + 1) + Min - 1, - list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]). + X = rand:uniform(Max - Min + 1) + Min - 1, + list_to_integer([one_random_number(rand:uniform(10)) || _ <- lists:seq(1,X)]). random_length({Min,Max}) -> - random:uniform(Max - Min + 1) + Min - 1. + rand:uniform(Max - Min + 1) + Min - 1. random_string({Min,Max}) -> - X = random:uniform(Max - Min + 1) + Min - 1, - list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]). + X = rand:uniform(Max - Min + 1) + Min - 1, + list_to_binary([one_random(rand:uniform(68)) || _ <- lists:seq(1,X)]). random_substring({Min,Max},Hay) -> - X = random:uniform(Max - Min + 1) + Min - 1, + X = rand:uniform(Max - Min + 1) + Min - 1, Y = byte_size(Hay), Z = if X > Y -> Y; true -> X end, PMax = Y - Z, - Pos = random:uniform(PMax + 1) - 1, + Pos = rand:uniform(PMax + 1) - 1, <<_:Pos/binary,Res:Z/binary,_/binary>> = Hay, Res. diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 648154ebbe..aff73b176d 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -108,7 +108,7 @@ iterate_1(M) -> M(empty, []). iterate_2(M) -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), iter_tree(M, 1000). iter_tree(_M, 0) -> @@ -117,7 +117,7 @@ iter_tree(M, N) -> L = [{I, I} || I <- lists:seq(1, N)], T = M(from_list, L), L = lists:reverse(iterate_tree(M, T)), - R = random:uniform(N), + R = rand:uniform(N), KV = lists:reverse(iterate_tree_from(M, R, T)), KV = [P || P={K,_} <- L, K >= R], iter_tree(M, N-1). @@ -156,7 +156,7 @@ test_all(Tester) -> spawn_tester(M, Tester) -> Parent = self(), spawn_link(fun() -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), S = Tester(M), Res = {M(size, S),lists:sort(M(to_list, S))}, Parent ! {result,self(),Res} @@ -194,12 +194,12 @@ rnd_list_1(0, Acc) -> Acc; rnd_list_1(N, Acc) -> Key = atomic_rnd_term(), - Value = random:uniform(100), + Value = rand:uniform(100), rnd_list_1(N-1, [{Key,Value}|Acc]). atomic_rnd_term() -> - case random:uniform(3) of - 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd"); - 2 -> random:uniform(); - 3 -> random:uniform(50)-37 + case rand:uniform(3) of + 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd"); + 2 -> rand:uniform(); + 3 -> rand:uniform(50)-37 end. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 1b80f555d7..3e63d19213 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -112,9 +112,8 @@ -define(m(A,B), ?line assert_eq(A,B)). init_per_testcase(Case, Config) -> - Seed = {S1,S2,S3} = random:seed0(), %now(), - random:seed(S1,S2,S3), - io:format("*** SEED: ~p ***\n", [Seed]), + rand:seed(exsplus), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), start_spawn_logger(), wait_for_test_procs(), %% Ensure previous case cleaned up Dog=test_server:timetrap(test_server:minutes(20)), @@ -1330,7 +1329,7 @@ drop_match() -> ets_match(Tab,Expr) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> ets:match(Tab,Expr); _ -> @@ -1339,14 +1338,14 @@ ets_match(Tab,Expr) -> match_chunked(Tab,Expr) -> match_chunked_collect(ets:match(Tab,Expr, - random:uniform(1999) + 1)). + rand:uniform(1999) + 1)). match_chunked_collect('$end_of_table') -> []; match_chunked_collect({Results, Continuation}) -> Results ++ match_chunked_collect(ets:match(Continuation)). ets_match_object(Tab,Expr) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> ets:match_object(Tab,Expr); _ -> @@ -1355,7 +1354,7 @@ ets_match_object(Tab,Expr) -> match_object_chunked(Tab,Expr) -> match_object_chunked_collect(ets:match_object(Tab,Expr, - random:uniform(1999) + 1)). + rand:uniform(1999) + 1)). match_object_chunked_collect('$end_of_table') -> []; match_object_chunked_collect({Results, Continuation}) -> @@ -1367,19 +1366,15 @@ random_test() -> ?line ReadDir = get(where_to_read), ?line WriteDir = get(where_to_write), ?line (catch file:make_dir(WriteDir)), - ?line Seed = case file:consult(filename:join([ReadDir, - "preset_random_seed.txt"])) of - {ok,[X]} -> - X; - _ -> - {A,B,C} = erlang:timestamp(), - random:seed(A,B,C), - get(random_seed) - end, - put(random_seed,Seed), - ?line {ok, F} = file:open(filename:join([WriteDir, - "last_random_seed.txt"]), - [write]), + case file:consult(filename:join([ReadDir,"preset_random_seed.txt"])) of + {ok,[X]} -> + rand:seed(X); + _ -> + rand:seed(exsplus) + end, + Seed = rand:export_seed(), + {ok,F} = file:open(filename:join([WriteDir,"last_random_seed.txt"]), + [write]), io:format(F,"~p. ~n",[Seed]), file:close(F), io:format("Random seed ~p written to ~s, copy to ~s to rerun with " @@ -1401,7 +1396,7 @@ do_random_test() -> end, 5000), ?line io:format("~nData inserted~n"), ?line do_n_times(fun() -> - ?line I = random:uniform(25), + I = rand:uniform(25), ?line Key = create_random_string(I) ++ '_', ?line L1 = ets_match_object(OrdSet,{Key,'_'}), ?line L2 = lists:sort(ets_match_object(Set,{Key,'_'})), @@ -1961,7 +1956,7 @@ evil_update_counter(Config) when is_list(Config) -> gb_sets:module_info(), math:module_info(), ordsets:module_info(), - random:module_info(), + rand:module_info(), repeat_for_opts(evil_update_counter_do). @@ -1995,7 +1990,7 @@ evil_counter(I,Opts) -> 1 -> 16#12345678FFFFFFFF; 2 -> 16#7777777777FFFFFFFF863648726743 end, - Start = Start0 + random:uniform(100000), + Start = Start0 + rand:uniform(100000), ets:insert(T, {dracula,Start}), Iter = 40000, End = Start + Iter, @@ -4645,11 +4640,11 @@ create_random_string(0) -> []; create_random_string(OfLength) -> - C = case random:uniform(2) of + C = case rand:uniform(2) of 1 -> - (random:uniform($Z - $A + 1) - 1) + $A; + (rand:uniform($Z - $A + 1) - 1) + $A; _ -> - (random:uniform($z - $a + 1) - 1) + $a + (rand:uniform($z - $a + 1) - 1) + $a end, [C | create_random_string(OfLength - 1)]. @@ -4660,7 +4655,7 @@ create_random_tuple(OfLength) -> end,create_random_string(OfLength))). create_partly_bound_tuple(OfLength) -> - case random:uniform(2) of + case rand:uniform(2) of 1 -> create_partly_bound_tuple1(OfLength); _ -> @@ -4669,14 +4664,14 @@ create_partly_bound_tuple(OfLength) -> create_partly_bound_tuple1(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength), + I = rand:uniform(OfLength), setelement(I,T0,'$1'). set_n_random_elements(T0,0,_,_) -> T0; set_n_random_elements(T0,N,OfLength,GenFun) -> - I = random:uniform(OfLength), + I = rand:uniform(OfLength), What = GenFun(I), case element(I,T0) of What -> @@ -4690,12 +4685,12 @@ make_dollar_atom(I) -> list_to_atom([$$] ++ integer_to_list(I)). create_partly_bound_tuple2(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength - 1), + I = rand:uniform(OfLength - 1), set_n_random_elements(T0,I,OfLength,fun make_dollar_atom/1). create_partly_bound_tuple3(OfLength) -> T0 = create_random_tuple(OfLength), - I = random:uniform(OfLength - 1), + I = rand:uniform(OfLength - 1), set_n_random_elements(T0,I,OfLength,fun(_) -> '_' end). do_n_times(_,0) -> @@ -5058,11 +5053,12 @@ meta_wb_do(Opts) -> io:format("Colliding names = ~p\n",[Names]), F = fun(0,_,_) -> ok; - (N,Tabs,Me) -> Name1 = lists:nth(random:uniform(Len),Names), - Name2 = lists:nth(random:uniform(Len),Names), - Op = element(random:uniform(3),OpFuns), - NTabs = Op(Name1, Name2, Tabs, Opts), - Me(N-1,NTabs,Me) + (N,Tabs,Me) -> + Name1 = lists:nth(rand:uniform(Len), Names), + Name2 = lists:nth(rand:uniform(Len), Names), + Op = element(rand:uniform(3),OpFuns), + NTabs = Op(Name1, Name2, Tabs, Opts), + Me(N-1, NTabs, Me) end, F(Len*100, [], F), @@ -5328,7 +5324,7 @@ smp_insert(suite) -> []; smp_insert(Config) when is_list(Config) -> ets_new(smp_insert,[named_table,public,{write_concurrency,true}]), InitF = fun(_) -> ok end, - ExecF = fun(_) -> true = ets:insert(smp_insert,{random:uniform(10000)}) + ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(10000)}) end, FiniF = fun(_) -> ok end, run_workers(InitF,ExecF,FiniF,100000), @@ -5579,10 +5575,10 @@ smp_select_delete(Config) when is_list(Config) -> Zeros = erlang:make_tuple(Mod,0), InitF = fun(_) -> Zeros end, ExecF = fun(Diffs0) -> - case random:uniform(20) of + case rand:uniform(20) of 1 -> Mod = 17, - Eq = random:uniform(Mod) - 1, + Eq = rand:uniform(Mod) - 1, Deleted = ets:select_delete(T, [{{'_', '$1'}, [{'=:=', {'rem', '$1', Mod}, Eq}], @@ -5591,7 +5587,7 @@ smp_select_delete(Config) when is_list(Config) -> element(Eq+1,Diffs0) - Deleted), Diffs1; _ -> - Key = random:uniform(10000), + Key = rand:uniform(10000), Eq = Key rem Mod, ?line case ets:insert_new(T,{Key,Key}) of true -> @@ -5795,7 +5791,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> N when (N > Exclude) -> N - Exclude end, io:format("smp starting ~p workers\n",[NumOfProcs]), - Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], + Seeds = [{ProcN,rand:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)], Parent = self(), Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end) || Seed <- Seeds], @@ -5806,7 +5802,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) -> worker({ProcN,Seed}, InitF, ExecF, FiniF, Laps, Parent, NumOfProcs) -> io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), + rand:seed(exsplus, {Seed,Seed,Seed}), State1 = InitF([ProcN, NumOfProcs]), State2 = worker_loop(Laps, ExecF, State1), Result = FiniF(State2), diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl index c6f24fc670..8a7f2b1ec2 100644 --- a/lib/stdlib/test/ets_tough_SUITE.erl +++ b/lib/stdlib/test/ets_tough_SUITE.erl @@ -92,7 +92,7 @@ ex1_sub(Config) -> ok. prep(Config) -> - random:seed(), + rand:seed(exsplus), put(dump_ticket,none), DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"), file:make_dir(DumpDir), @@ -221,19 +221,19 @@ random_class() -> random_element(Classes). random_key() -> - random:uniform(8). + rand:uniform(8). random_value() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> ok; 2 -> {data,random_key()}; 3 -> {foo,bar,random_class()}; - 4 -> random:uniform(1000); + 4 -> rand:uniform(1000); 5 -> {recursive,random_value()} end. random_element(T) -> - I = random:uniform(tuple_size(T)), + I = rand:uniform(tuple_size(T)), element(I,T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 01b798faef..c39ff842ee 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -318,7 +318,7 @@ same_lists(Expected0, Actual0, BaseDir) -> mkfiles([H|T], Dir) -> Name = filename:join(Dir, H), - Garbage = [31+random:uniform(95) || _ <- lists:seq(1, random:uniform(1024))], + Garbage = [31+rand:uniform(95) || _ <- lists:seq(1, rand:uniform(1024))], file:write_file(Name, Garbage), [Name|mkfiles(T, Dir)]; mkfiles([], _) -> []. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index a0f7fd2744..bd68c93779 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -1677,8 +1677,7 @@ check_stab(L, U, S, US, SS) -> %%% Element 3 in the tuple is the position of the tuple in the list. biglist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), biglist(N, []). biglist(0, L) -> @@ -1694,8 +1693,7 @@ biglist(N, L) -> %%% No sequence number. ubiglist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), ubiglist(N, []). ubiglist(0, L) -> @@ -1719,8 +1717,7 @@ urandom_tuple(N, I) -> %%% sequence number. bigfunlist(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), bigfunlist_1(N). bigfunlist_1(N) when N < 30000 -> % Now (R8) max 32000 different pids. @@ -1754,21 +1751,13 @@ make_fun(Pid) -> fun_pid(Fun) -> erlang:fun_info(Fun, pid). -get_seed() -> - case random:seed() of - undefined -> - erlang:timestamp(); - Tuple -> - Tuple - end. - random_tuple(N, Seq) -> R1 = randint(N), R2 = randint(N), {R1, R2, Seq}. randint(N) -> - trunc(random:uniform() * N). + trunc(rand:uniform() * N). %% The first "duplicate" is kept. no_dups([]) -> @@ -1830,8 +1819,7 @@ sort_loop_1(Pid) -> end. sloop(N) -> - {A, B, C} = get_seed(), - random:seed(A, B, C), + rand:seed(exsplus), sloop(N, #state{}). sloop(N, S) -> diff --git a/lib/stdlib/test/queue_SUITE.erl b/lib/stdlib/test/queue_SUITE.erl index c965a8b218..5165ac3a3a 100644 --- a/lib/stdlib/test/queue_SUITE.erl +++ b/lib/stdlib/test/queue_SUITE.erl @@ -470,7 +470,7 @@ oops(suite) -> oops(Config) when is_list(Config) -> ?line N = 3142, ?line Optab = optab(), - ?line Seed0 = random:seed0(), + ?line Seed0 = rand:seed(exsplus, {1,2,4}), ?line {Is,Seed} = random_list(N, tuple_size(Optab), Seed0, []), ?line io:format("~p ", [Is]), ?line QA = queue:new(), @@ -562,20 +562,20 @@ args([], _, Seed, R) -> args([q|Ts], [Q|Qs]=Qss, Seed, R) -> args(Ts, if Qs =:= [] -> Qss; true -> Qs end, Seed, [Q|R]); args([l|Ts], Qs, Seed0, R) -> - {N,Seed1} = random:uniform_s(17, Seed0), + {N,Seed1} = rand:uniform_s(17, Seed0), {L,Seed} = random_list(N, 4711, Seed1, []), args(Ts, Qs, Seed, [L|R]); args([t|Ts], Qs, Seed0, R) -> - {T,Seed} = random:uniform_s(4711, Seed0), + {T,Seed} = rand:uniform_s(4711, Seed0), args(Ts, Qs, Seed, [T|R]); args([n|Ts], Qs, Seed0, R) -> - {N,Seed} = random:uniform_s(17, Seed0), + {N,Seed} = rand:uniform_s(17, Seed0), args(Ts, Qs, Seed, [N|R]). random_list(0, _, Seed, R) -> {R,Seed}; random_list(N, M, Seed0, R) -> - {X,Seed} = random:uniform_s(M, Seed0), + {X,Seed} = rand:uniform_s(M, Seed0), random_list(N-1, M, Seed, [X|R]). call(Func, As) -> diff --git a/lib/stdlib/test/random_iolist.erl b/lib/stdlib/test/random_iolist.erl index 9a0f034e72..6da7da04de 100644 --- a/lib/stdlib/test/random_iolist.erl +++ b/lib/stdlib/test/random_iolist.erl @@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) -> compare2(Iter,Fun1,Fun2). random_byte() -> - random:uniform(256) - 1. + rand:uniform(256) - 1. random_list(0,Acc) -> Acc; @@ -45,7 +45,7 @@ random_list(N,Acc) -> random_binary(N) -> B = list_to_binary(random_list(N,[])), - case {random:uniform(2),size(B)} of + case {rand:uniform(2),size(B)} of {2,M} when M > 1 -> S = M-1, <<_:3,C:S/binary,_:5>> = B, @@ -57,7 +57,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -65,7 +65,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -77,7 +77,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -90,9 +90,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_iolist(0,Acc) -> @@ -139,7 +139,7 @@ random_iolist(N) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/lib/stdlib/test/random_unicode_list.erl b/lib/stdlib/test/random_unicode_list.erl index ecafe42318..3bc86a8430 100644 --- a/lib/stdlib/test/random_unicode_list.erl +++ b/lib/stdlib/test/random_unicode_list.erl @@ -85,7 +85,7 @@ int_to_utf32_little(I) -> id(I) -> I. random_char() -> - case random:uniform(16#10FFFF+1) - 1 of + case rand:uniform(16#10FFFF+1) - 1 of X when X >= 16#D800, X =< 16#DFFF -> random_char(); @@ -116,13 +116,13 @@ random_binary(N,Enc) -> int_to(Enc,X) end, L)), - case {random:uniform(3),size(B)} of + case {rand:uniform(3),size(B)} of {2,M} when M > 1 -> B2 = id(<<1:3,B/binary,1:5>>), <<_:3,C:M/binary,_:5>> = B2, C; {3,M} when M > 1 -> - X = random:uniform(M+1)-1, + X = rand:uniform(M+1)-1, <> = B, [B1,B2]; _ -> @@ -132,7 +132,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -140,7 +140,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -152,7 +152,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -165,9 +165,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_unicode_list(0,Acc,_Enc) -> @@ -214,7 +214,7 @@ random_unicode_list(N,Enc) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl index 1fdc777470..b7d1df39b8 100644 --- a/lib/stdlib/test/run_pcre_tests.erl +++ b/lib/stdlib/test/run_pcre_tests.erl @@ -1083,7 +1083,7 @@ dumponesplit(F,{RE,Line,O,TS}) -> %% Generate replacement tests from indatafile, %% you will need perl on the machine gen_repl_test(OneFile) -> - random:seed(1219,687731,62804), + rand:seed(exsplus, {1219,687731,62804}), {ok,Bin} = file:read_file(OneFile), Lines = splitfile(0,Bin,1), Structured = stru(Lines), @@ -1237,15 +1237,15 @@ btr(_) -> ranchar() -> - case random:uniform(10) of + case rand:uniform(10) of 9 -> $&; 10 -> <<"\\1">>; N when N < 5 -> - random:uniform($Z-$A)+$A-1; + rand:uniform($Z-$A)+$A-1; M when M < 9 -> - random:uniform($z-$a)+$a-1 + rand:uniform($z-$a)+$a-1 end. ranstring() -> - iolist_to_binary([ranchar() || _ <- lists:duplicate(random:uniform(20),0) ]). + iolist_to_binary([ranchar() || _ <- lists:duplicate(rand:uniform(20),0) ]). diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index ead64ffc75..6796676179 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -212,11 +212,10 @@ init_random(Config) -> {ok,[X]} -> X; _ -> - {A,B,C} = erlang:timestamp(), - random:seed(A,B,C), - get(random_seed) + rand:seed(exsplus), + rand:export_seed() end, - put(random_seed,Seed), + rand:seed(Seed), {ok, F} = file:open(filename:join([WriteDir, "last_random_seed2.txt"]), [write]), io:format(F,"~p. ~n",[Seed]), @@ -224,11 +223,11 @@ init_random(Config) -> ok. create_random_key(N,Type) -> - gen_key(random:uniform(N),Type). + gen_key(rand:uniform(N),Type). create_pb_key(N,list) -> - X = random:uniform(N), - case random:uniform(4) of + X = rand:uniform(N), + case rand:uniform(4) of 3 -> {[X, X+1, '_'], fun([Z,Z1,P1]) -> [Z,Z1,P1] =:= [X,X+1,P1] end}; 2 -> {[X, '_', '_'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end}; @@ -237,14 +236,14 @@ create_pb_key(N,list) -> _ -> {[X, '$1', '$2'], fun([Z,P1,P2]) -> [Z,P1,P2] =:= [X,P1,P2] end} end; create_pb_key(N, tuple) -> - X = random:uniform(N), - case random:uniform(2) of + X = rand:uniform(N), + case rand:uniform(2) of 1 -> {{X, X+1, '$1'},fun({Z,Z1,P1}) -> {Z,Z1,P1} =:= {X,X+1,P1} end}; _ -> {{X, '$1', '$2'},fun({Z,P1,P2}) -> {Z,P1,P2} =:= {X,P1,P2} end} end; create_pb_key(N, complex) -> - X = random:uniform(N), - case random:uniform(2) of + X = rand:uniform(N), + case rand:uniform(2) of 1 -> {{[X, X+1], '$1'}, fun({[Z,Z1],P1}) -> {[Z,Z1],P1} =:= {[X,X+1],P1} end}; _ -> {{[X, '$1'], '$2'},fun({[Z,P1],P2}) -> diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl index 972a812072..e7fc5595a9 100644 --- a/lib/stdlib/test/sets_SUITE.erl +++ b/lib/stdlib/test/sets_SUITE.erl @@ -107,9 +107,9 @@ add_element_del([H|T], M, S, Del, []) -> add_element_del(T, M, M(add_element, {H,S}), Del, [H]); add_element_del([H|T], M, S0, Del, Inserted) -> S1 = M(add_element, {H,S0}), - case random:uniform(3) of + case rand:uniform(3) of 1 -> - OldEl = lists:nth(random:uniform(length(Inserted)), Inserted), + OldEl = lists:nth(rand:uniform(length(Inserted)), Inserted), S = M(del_element, {OldEl,S1}), add_element_del(T, M, S, [OldEl|Del], [H|Inserted]); _ -> @@ -438,7 +438,7 @@ iterate_1(M) -> M(empty, []). iterate_2(M) -> - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), iter_set(M, 1000). iter_set(_M, 0) -> @@ -447,7 +447,7 @@ iter_set(M, N) -> L = [I || I <- lists:seq(1, N)], T = M(from_list, L), L = lists:reverse(iterate_set(M, T)), - R = random:uniform(N), + R = rand:uniform(N), S = lists:reverse(iterate_set(M, R, T)), S = [E || E <- L, E >= R], iter_set(M, N-1). @@ -481,7 +481,7 @@ sets_mods() -> test_all(Tester) -> Res = [begin - random:seed(1, 2, 42), + rand:seed(exsplus, {1,2,42}), S = Tester(M), {M(size, S),lists:sort(M(to_list, S))} end || M <- sets_mods()], @@ -492,7 +492,7 @@ test_all([{Low,High}|T], Tester) -> test_all([Sz|T], Tester) when is_integer(Sz) -> List = rnd_list(Sz), Res = [begin - random:seed(19, 2, Sz), + rand:seed(exsplus, {19,2,Sz}), S = Tester(List, M), {M(size, S),lists:sort(M(to_list, S))} end || M <- sets_mods()], @@ -512,10 +512,10 @@ rnd_list(Sz) -> rnd_list_1(Sz, []). atomic_rnd_term() -> - case random:uniform(3) of - 1 -> list_to_atom(integer_to_list($\s+random:uniform(94))++"rnd"); - 2 -> random:uniform(); - 3 -> random:uniform(50)-37 + case rand:uniform(3) of + 1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd"); + 2 -> rand:uniform(); + 3 -> rand:uniform(50)-37 end. rnd_list_1(0, Acc) -> Acc; @@ -543,7 +543,7 @@ remove_some(List0, P) -> end. remove_some([H|T], P, Acc) -> - case random:uniform() of + case rand:uniform() of F when F < P -> %Remove. remove_some(T, P, Acc); _ -> diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl index 057d82fb65..10dcfad76f 100644 --- a/lib/stdlib/test/timer_SUITE.erl +++ b/lib/stdlib/test/timer_SUITE.erl @@ -80,8 +80,6 @@ report_result(Error) -> ?line test_server:fail(Error). big_test(N) -> C = start_collect(), system_time(), system_time(), system_time(), - random:seed(erlang:timestamp()), - random:uniform(100),random:uniform(100),random:uniform(100), big_loop(C, N, []), @@ -127,17 +125,17 @@ big_loop(C, N, Pids) -> after 0 -> %% maybe start an interval timer test - Pids1 = maybe_start_i_test(Pids, C, random:uniform(4)), + Pids1 = maybe_start_i_test(Pids, C, rand:uniform(4)), %% start 1-4 "after" tests - Pids2 = start_after_test(Pids1, C, random:uniform(4)), + Pids2 = start_after_test(Pids1, C, rand:uniform(4)), %%Pids2=Pids1, %% wait a little while - timer:sleep(random:uniform(200)*3), + timer:sleep(rand:uniform(200)*3), %% spawn zero, one or two nrev to get some load ;-/ - Pids3 = start_nrev(Pids2, random:uniform(100)), + Pids3 = start_nrev(Pids2, rand:uniform(100)), big_loop(C, N-1, Pids3) end. @@ -148,20 +146,20 @@ start_nrev(Pids, N) when N < 25 -> start_nrev(Pids, N) when N < 75 -> [spawn_link(timer_SUITE, do_nrev, [1])|Pids]; start_nrev(Pids, _N) -> - NrevPid1 = spawn_link(timer_SUITE, do_nrev, [random:uniform(1000)*10]), + NrevPid1 = spawn_link(timer_SUITE, do_nrev, [rand:uniform(1000)*10]), NrevPid2 = spawn_link(timer_SUITE, do_nrev, [1]), [NrevPid1,NrevPid2|Pids]. start_after_test(Pids, C, 1) -> - TO1 = random:uniform(100)*47, + TO1 = rand:uniform(100)*47, [s_a_t(C, TO1)|Pids]; start_after_test(Pids, C, 2) -> - TO1 = random:uniform(100)*47, - TO2 = TO1 div random:uniform(3) + 101, + TO1 = rand:uniform(100)*47, + TO2 = TO1 div rand:uniform(3) + 101, [s_a_t(C, TO1),s_a_t(C, TO2)|Pids]; start_after_test(Pids, C, N) -> - TO1 = random:uniform(100)*47, + TO1 = rand:uniform(100)*47, start_after_test([s_a_t(C, TO1)|Pids], C, N-1). s_a_t(C, TimeOut) -> @@ -187,8 +185,8 @@ a_t(C, TimeOut) -> maybe_start_i_test(Pids, C, 1) -> %% ok do it - TOI = random:uniform(53)*49, - CountI = random:uniform(10) + 3, % at least 4 times + TOI = rand:uniform(53)*49, + CountI = rand:uniform(10) + 3, % at least 4 times [spawn_link(timer_SUITE, i_t, [C, TOI, CountI])|Pids]; maybe_start_i_test(Pids, _C, _) -> Pids. -- cgit v1.2.3 From 9e12af42b3e71df8d812eca96d5f1e0a3c65e4e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 12:46:52 +0100 Subject: wx: Replace 'random' with 'rand' --- lib/wx/examples/demo/ex_canvas.erl | 2 +- lib/wx/examples/sudoku/sudoku_game.erl | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lib/wx/examples/demo/ex_canvas.erl b/lib/wx/examples/demo/ex_canvas.erl index cdc783055c..acc94743d6 100644 --- a/lib/wx/examples/demo/ex_canvas.erl +++ b/lib/wx/examples/demo/ex_canvas.erl @@ -219,4 +219,4 @@ redraw(DC, Bitmap) -> wxMemoryDC:destroy(MemoryDC). get_pos(W,H) -> - {random:uniform(W), random:uniform(H)}. + {rand:uniform(W), rand:uniform(H)}. diff --git a/lib/wx/examples/sudoku/sudoku_game.erl b/lib/wx/examples/sudoku/sudoku_game.erl index e3c39b4ec9..8bb5fe4d38 100644 --- a/lib/wx/examples/sudoku/sudoku_game.erl +++ b/lib/wx/examples/sudoku/sudoku_game.erl @@ -151,8 +151,7 @@ test() -> %% Known to solvable {{9,2},4}, {{9,4},5}, {{9,6},8}, {{9,8},7}]. new_game(S) -> - {X,Y,Z} = erlang:now(), - random:seed(Y,X,Z), + rand:seed(exsplus), case new_game(1,1,gb_sets:empty(),empty_table(S#s{}),[], 0) of stop -> new_game(S); Game -> Game @@ -171,7 +170,7 @@ new_game(R,C,BT,St,Acc,Cnt) when R < 10, C < 10 -> [{{BR,BC},BVal,BBT,BST}|BAcc] = Acc, new_game(BR,BC,gb_sets:add(BVal,BBT),BST,BAcc,Cnt+1); Size -> - Ind = random:uniform(Size), + Ind = rand:uniform(Size), V = lists:nth(Ind,gb_sets:to_list(S)), new_game(R,C+1,gb_sets:empty(), add({R,C,M},V,St), @@ -207,7 +206,7 @@ pick_shown(Given,Left,S0,Level,Gfx) -> io:format("Below level ~p ~p~n", [GivenSz,Level]), S0; true -> - Ran = random:uniform(LeftSz), + Ran = rand:uniform(LeftSz), V = lists:nth(Ran,gb_sets:to_list(Left)), S1 = rebuild_all(rcm(V),S0#s{v=setelement(V,S0#s.v,0)}), case solve(S1, true) of -- cgit v1.2.3 From 004456821045f0bc158db402fecdb637ccde80ca Mon Sep 17 00:00:00 2001 From: Yuki Ito Date: Fri, 23 Oct 2015 19:07:29 +0900 Subject: Use EVP for AES-GCM This enables the use of hardware acceleration on newer Intel CPUs (AES-NI). --- lib/crypto/c_src/crypto.c | 98 +++++++++++++++++++++++++++++++---------------- 1 file changed, 64 insertions(+), 34 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index bb2771163d..b9684168ba 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1620,44 +1620,62 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_GCM) - GCM128_CONTEXT *ctx = NULL; + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; - AES_KEY aes_key; - unsigned char *outp; + unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || (key.size != 16 && key.size != 24 && key.size != 32) || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { return enif_make_badarg(env); } - if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) - return atom_error; + if (key.size == 16) + cipher = EVP_aes_128_gcm(); + else if (key.size == 24) + cipher = EVP_aes_192_gcm(); + else if (key.size == 32) + cipher = EVP_aes_256_gcm(); - CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + if (!(ctx = EVP_CIPHER_CTX_new())) + return atom_error; + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; - if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) - goto out_err; + EVP_CIPHER_CTX_set_padding(ctx, 0); + + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - /* encrypt */ - if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size)) - goto out_err; + if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_EncryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; + + tagp = enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag); - /* calculate the tag */ - CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN); - CRYPTO_gcm128_release(ctx); + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); out_err: - CRYPTO_gcm128_release(ctx); + EVP_CIPHER_CTX_free(ctx); return atom_error; #else @@ -1668,14 +1686,15 @@ out_err: static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_GCM) - GCM128_CONTEXT *ctx; + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; - AES_KEY aes_key; unsigned char *outp; ERL_NIF_TERM out; + int len; if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || (key.size != 16 && key.size != 24 && key.size != 32) || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in) @@ -1683,32 +1702,43 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_badarg(env); } - if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) - return atom_error; - - CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); - - if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) - goto out_err; + if (key.size == 16) + cipher = EVP_aes_128_gcm(); + else if (key.size == 24) + cipher = EVP_aes_192_gcm(); + else if (key.size == 32) + cipher = EVP_aes_256_gcm(); + + if (!(ctx = EVP_CIPHER_CTX_new())) + return atom_error; + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + goto out_err; + if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto out_err; + if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + goto out_err; outp = enif_make_new_binary(env, in.size, &out); - /* decrypt */ - if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) - goto out_err; + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1) + goto out_err; + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; - /* calculate and check the tag */ - if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN)) - goto out_err; + EVP_CIPHER_CTX_free(ctx); - CRYPTO_gcm128_release(ctx); CONSUME_REDS(env, in); return out; out_err: - CRYPTO_gcm128_release(ctx); + EVP_CIPHER_CTX_free(ctx); return atom_error; + #else return enif_raise_exception(env, atom_notsup); #endif -- cgit v1.2.3 From 91d628d92e49c693e79aee2cafc0032fb84e50a5 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 11 Dec 2015 16:22:06 +0100 Subject: crypto: Optimize AES-GCM cipher to not use dynamic allocation for the EVP_CIPHER_CTX. --- lib/crypto/c_src/crypto.c | 50 +++++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b9684168ba..9155c928fe 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1620,7 +1620,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_GCM) - EVP_CIPHER_CTX *ctx; + EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; unsigned char *outp, *tagp; @@ -1642,40 +1642,40 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM else if (key.size == 32) cipher = EVP_aes_256_gcm(); - if (!(ctx = EVP_CIPHER_CTX_new())) - return atom_error; - if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + EVP_CIPHER_CTX_init(&ctx); + + if (EVP_EncryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - EVP_CIPHER_CTX_set_padding(ctx, 0); + EVP_CIPHER_CTX_set_padding(&ctx, 0); - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) goto out_err; - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + if (EVP_EncryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; - if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + if (EVP_EncryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; outp = enif_make_new_binary(env, in.size, &out); - if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + if (EVP_EncryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_EncryptFinal_ex(ctx, outp+len, &len) != 1) + if (EVP_EncryptFinal_ex(&ctx, outp+len, &len) != 1) goto out_err; tagp = enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag); - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1) goto out_err; - EVP_CIPHER_CTX_free(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); out_err: - EVP_CIPHER_CTX_free(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); return atom_error; #else @@ -1686,7 +1686,7 @@ out_err: static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_GCM) - EVP_CIPHER_CTX *ctx; + EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; @@ -1709,34 +1709,34 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM else if (key.size == 32) cipher = EVP_aes_256_gcm(); - if (!(ctx = EVP_CIPHER_CTX_new())) - return atom_error; - if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + EVP_CIPHER_CTX_init(&ctx); + + if (EVP_DecryptInit_ex(&ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_IVLEN, iv.size, NULL) != 1) goto out_err; - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + if (EVP_DecryptInit_ex(&ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; - if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) + if (EVP_DecryptUpdate(&ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; outp = enif_make_new_binary(env, in.size, &out); - if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + if (EVP_DecryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1) goto out_err; - if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + if (EVP_DecryptFinal_ex(&ctx, outp+len, &len) != 1) goto out_err; - EVP_CIPHER_CTX_free(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); CONSUME_REDS(env, in); return out; out_err: - EVP_CIPHER_CTX_free(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); return atom_error; #else -- cgit v1.2.3 From d20ffad0455c6b9abf982b16d370e769bd9a8f69 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 11 Dec 2015 16:28:23 +0100 Subject: crypto: Fix potential memory leak in error case for block cipher --- lib/crypto/c_src/crypto.c | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 9155c928fe..6a41385296 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1359,6 +1359,7 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM key.data, ivec_size ? ivec.data : NULL, -1) || !EVP_CIPHER_CTX_set_padding(&ctx, 0)) { + EVP_CIPHER_CTX_cleanup(&ctx); return enif_raise_exception(env, atom_notsup); } -- cgit v1.2.3 From 32eb9d7d9f680d320f42186de67db65688cdd53f Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 11 Dec 2015 18:07:47 +0100 Subject: crypto: Support 192-bit keys for AES CBC and deprecate aes_cbc128 and aes_cbc256 in favor of aes_cbc. This commit is pr 832 squashed, rebased and made work on master https://github.com/erlang/otp/pull/832/commits --- lib/crypto/c_src/crypto.c | 4 +++ lib/crypto/doc/src/crypto.xml | 10 +++--- lib/crypto/src/crypto.erl | 4 +++ lib/crypto/test/crypto_SUITE.erl | 76 ++++++++++++++++++++++++++++++++++++++-- 4 files changed, 86 insertions(+), 8 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index bb2771163d..850d5bc31f 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -447,6 +447,9 @@ struct cipher_type_t cipher_types[] = {"blowfish_cfb64", &EVP_bf_cfb64}, {"blowfish_ofb64", &EVP_bf_ofb}, {"blowfish_ecb", &EVP_bf_ecb}, + {"aes_cbc", &EVP_aes_128_cbc, 16}, + {"aes_cbc", &EVP_aes_192_cbc, 24}, + {"aes_cbc", &EVP_aes_256_cbc, 32}, {"aes_cbc128", &EVP_aes_128_cbc}, {"aes_cbc256", &EVP_aes_256_cbc}, {"aes_cfb8", &EVP_aes_128_cfb8}, @@ -757,6 +760,7 @@ static void init_algorithms_types(ErlNifEnv* env) #ifdef HAVE_DES_ede3_cfb_encrypt algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbf"); #endif + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8"); algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128"); diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 563a090e98..d3e827b3e6 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -135,9 +135,8 @@ stream_cipher() = rc4 | aes_ctr - block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | - blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf - | des_ede3 | rc2_cbc + block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | + blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc aead_cipher() = aes_gcm | chacha20_poly1305 @@ -160,8 +159,9 @@ hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512

md4 is also supported for hash_init/1 and hash/2. Note that both md4 and md5 are recommended only for compatibility with existing applications.

- cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | - blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 + cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm | + aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb | + des3_cbc | des3_cbf | des_ede3 | rc2_cbc | rc4 public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m

Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 8722e801a6..3e24ff2b0a 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -274,6 +274,7 @@ hmac_final_n(Context, HashLen) -> des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + aes_cbc | rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. @@ -287,6 +288,7 @@ block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= aes_cfb8; Type =:= aes_cfb128; Type =:= aes_cbc256; + Type =:= aes_cbc; Type =:= rc2_cbc -> block_crypt_nif(Type, Key, Ivec, Data, true); block_encrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc; @@ -307,6 +309,7 @@ block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | + aes_cbc | rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), @@ -316,6 +319,7 @@ block_decrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= blowfish_cbc; Type =:= blowfish_cfb64; Type =:= blowfish_ofb64; + Type =:= aes_cbc; Type =:= aes_cbc128; Type =:= aes_cfb8; Type =:= aes_cfb128; diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0b955c0965..70cf801516 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -66,6 +66,7 @@ all() -> {group, aes_ctr}, {group, aes_gcm}, {group, chacha20_poly1305}, + {group, aes_cbc}, mod_pow, exor, rand_uniform @@ -107,7 +108,8 @@ groups() -> {rc4, [], [stream]}, {aes_ctr, [], [stream]}, {aes_gcm, [], [aead]}, - {chacha20_poly1305, [], [aead]} + {chacha20_poly1305, [], [aead]}, + {aes_cbc, [], [block]} ]. %%------------------------------------------------------------------- @@ -363,6 +365,21 @@ block_cipher({Type, Key, IV, PlainText}) -> ok; Other -> ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other}}) + end; + +block_cipher({Type, Key, IV, PlainText, CipherText}) -> + Plain = iolist_to_binary(PlainText), + case crypto:block_encrypt(Type, Key, IV, Plain) of + CipherText -> + ok; + Other0 -> + ct:fail({{crypto, block_encrypt, [Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) + end, + case crypto:block_decrypt(Type, Key, IV, CipherText) of + Plain -> + ok; + Other1 -> + ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other1}}) end. block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc; @@ -370,7 +387,11 @@ block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc; Type == aes_cbc; Type == des_cbf -> - block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); + block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); +block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_cbc -> + Plain = iolist_to_binary(PlainTexts), + Blocks = [iolistify(Block) || << Block:128/bitstring >> <= Plain], + block_cipher_increment(Type, Key, IV, IV, Blocks, Plain, []); block_cipher_increment({_Type, _, _, _}) -> ok; block_cipher_increment({_,_,_}) -> @@ -552,7 +573,9 @@ do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) -> do_block_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; do_block_iolistify({Type, Key, IV, PlainText}) -> - {Type, iolistify(Key), IV, iolistify(PlainText)}. + {Type, iolistify(Key), IV, iolistify(PlainText)}; +do_block_iolistify({Type, Key, IV, PlainText, CipherText}) -> + {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. iolistify(<<"Test With Truncation">>)-> %% Do not iolistify as it spoils this special case @@ -803,6 +826,9 @@ group_config(aes_gcm, Config) -> group_config(chacha20_poly1305, Config) -> AEAD = chacha20_poly1305(), [{aead, AEAD} | Config]; +group_config(aes_cbc, Config) -> + Block = aes_cbc(), + [{block, Block} | Config]; group_config(_, Config) -> Config. @@ -1166,6 +1192,50 @@ rc2_cbc() -> <<72,91,135,182,25,42,35,210>>, <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>> }]. + +%% AES CBC test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf +aes_cbc() -> + [ + %% F.2.1 CBC-AES128.Encrypt, F.2.2 CBC-AES128.Decrypt + {aes_cbc, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), %% Key + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("7649abac8119b246cee98e9b12e9197d" %% CipherText + "5086cb9b507219ee95db113a917678b2" + "73bed6b8e3c1743b7116e69e22229516" + "3ff1caa1681fac09120eca307586e1a7")}, + %% F.2.3 CBC-AES192.Encrypt, F.2.4 CBC-AES192.Decrypt + {aes_cbc, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e5" %% Key + "62f8ead2522c6b7b"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("4f021db243bc633d7178183a9fa071e8" %% CipherText + "b4d9ada9ad7dedf4e5e738763f69145a" + "571b242012fb7ae07fa9baac3df102e0" + "08b0e27988598881d920a9e64f5615cd")}, + %% F.2.5 CBC-AES256.Encrypt, F.2.6 CBC-AES256.Decrypt + {aes_cbc, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" %% Key + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), %% IV + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" %% PlainText + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710"), + hexstr2bin("f58c4c04d6e5f1ba779eabfb5f7bfbd6" %% CipherText + "9cfc4e967edb808d679f777bc6702c7d" + "39f23369a9d9bacfa530e26304231461" + "b2eb05e2c39be9fcda6c19078c6a9d1b")} + ]. + aes_cbc128() -> [{aes_cbc128, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), -- cgit v1.2.3 From 128fc752a45d51beb71c1aea4d5433efd00ac02a Mon Sep 17 00:00:00 2001 From: Alexey Lebedeff Date: Mon, 14 Dec 2015 15:08:15 +0300 Subject: Don't wait for twice the delay_write timeout This happens only during processing ALIVE2 request. reply() already performs the same delay as in the deleted code. --- erts/epmd/src/epmd_srv.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 8c8d7304f2..5b58554590 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -700,9 +700,6 @@ static void do_request(g, fd, s, buf, bsize) put_int16(node->creation, wbuf+2); } - if (g->delay_write) /* Test of busy server */ - sleep(g->delay_write); - if (reply(g, fd, wbuf, 4) != 4) { dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", -- cgit v1.2.3 From 389834628ef9b199d6ce1ab721a20737acb014d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 13:02:00 +0100 Subject: gs: Remove the contribs directory Some of the games no longer work. For example, when calling cols:start/0, there will be a 'badfun' exception because of an attempt to apply a tuple fun. There are also calls to the deprecated now/0 function and to the deprecated 'random' module. Since the entire gs application is deprecated and scheduled to be removed any release now, there is no need to keep the contribs directory. --- lib/gs/Makefile | 2 +- lib/gs/contribs/Makefile | 32 -- lib/gs/contribs/bonk/Makefile | 109 ----- lib/gs/contribs/bonk/bitmaps/bonkbomb | 66 --- lib/gs/contribs/bonk/bitmaps/bonkface | 66 --- lib/gs/contribs/bonk/bitmaps/bonklogo | 320 -------------- lib/gs/contribs/bonk/bitmaps/bonkmiss | 66 --- lib/gs/contribs/bonk/bitmaps/bonktom | 66 --- lib/gs/contribs/bonk/bitmaps/bonkx | 66 --- lib/gs/contribs/bonk/bitmaps/erl-e | 106 ----- lib/gs/contribs/bonk/bitmaps/erl-text | 106 ----- lib/gs/contribs/bonk/bonk.erl | 584 -------------------------- lib/gs/contribs/bonk/bonk.gif | Bin 196 -> 0 bytes lib/gs/contribs/bonk/bonk.tool | 6 - lib/gs/contribs/bonk/bonk.txt | 30 -- lib/gs/contribs/bonk/bonk_sound.erl | 82 ---- lib/gs/contribs/bonk/bonk_square.erl | 146 ------- lib/gs/contribs/bonk/sounder.erl | 160 ------- lib/gs/contribs/bonk/sounds/bonk.au | Bin 2008 -> 0 bytes lib/gs/contribs/bonk/sounds/damn.au | Bin 3744 -> 0 bytes lib/gs/contribs/bonk/sounds/explosion.au | Bin 7708 -> 0 bytes lib/gs/contribs/bonk/sounds/gameover.au | Bin 5986 -> 0 bytes lib/gs/contribs/bonk/sounds/hehee.au | Bin 3772 -> 0 bytes lib/gs/contribs/bonk/sounds/level.au | Bin 5360 -> 0 bytes lib/gs/contribs/bonk/sounds/missedme.au | Bin 2735 -> 0 bytes lib/gs/contribs/bonk/sounds/music.au | Bin 48072 -> 0 bytes lib/gs/contribs/bonk/sounds/ouch!!!.au | Bin 2342 -> 0 bytes lib/gs/contribs/bonk/sounds/praisejesus.au | Bin 16730 -> 0 bytes lib/gs/contribs/bonk/sounds/trumpet.au | Bin 49332 -> 0 bytes lib/gs/contribs/bonk/sounds/yes.au | Bin 4400 -> 0 bytes lib/gs/contribs/cols/Makefile | 103 ----- lib/gs/contribs/cols/cols.erl | 625 --------------------------- lib/gs/contribs/cols/cols.gif | Bin 185 -> 0 bytes lib/gs/contribs/cols/cols.tool | 5 - lib/gs/contribs/cols/help.gif | Bin 172 -> 0 bytes lib/gs/contribs/cols/highscore.erl | 103 ----- lib/gs/contribs/ebin/.gitignore | 0 lib/gs/contribs/mandel/Makefile | 101 ----- lib/gs/contribs/mandel/mandel.erl | 351 ---------------- lib/gs/contribs/mandel/mandel.gif | Bin 394 -> 0 bytes lib/gs/contribs/mandel/mandel.html | 74 ---- lib/gs/contribs/mandel/mandel.tool | 6 - lib/gs/contribs/othello/Makefile | 101 ----- lib/gs/contribs/othello/othello.erl | 237 ----------- lib/gs/contribs/othello/othello.gif | Bin 148 -> 0 bytes lib/gs/contribs/othello/othello.tool | 6 - lib/gs/contribs/othello/othello_adt.erl | 540 ------------------------ lib/gs/contribs/othello/othello_board.erl | 649 ----------------------------- lib/gs/contribs/othello/priv/marker.bm | 43 -- lib/gs/contribs/othello/priv/square.bm | 43 -- 50 files changed, 1 insertion(+), 4999 deletions(-) delete mode 100644 lib/gs/contribs/Makefile delete mode 100644 lib/gs/contribs/bonk/Makefile delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonkbomb delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonkface delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonklogo delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonkmiss delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonktom delete mode 100644 lib/gs/contribs/bonk/bitmaps/bonkx delete mode 100644 lib/gs/contribs/bonk/bitmaps/erl-e delete mode 100644 lib/gs/contribs/bonk/bitmaps/erl-text delete mode 100644 lib/gs/contribs/bonk/bonk.erl delete mode 100644 lib/gs/contribs/bonk/bonk.gif delete mode 100644 lib/gs/contribs/bonk/bonk.tool delete mode 100644 lib/gs/contribs/bonk/bonk.txt delete mode 100644 lib/gs/contribs/bonk/bonk_sound.erl delete mode 100644 lib/gs/contribs/bonk/bonk_square.erl delete mode 100644 lib/gs/contribs/bonk/sounder.erl delete mode 100644 lib/gs/contribs/bonk/sounds/bonk.au delete mode 100644 lib/gs/contribs/bonk/sounds/damn.au delete mode 100644 lib/gs/contribs/bonk/sounds/explosion.au delete mode 100644 lib/gs/contribs/bonk/sounds/gameover.au delete mode 100644 lib/gs/contribs/bonk/sounds/hehee.au delete mode 100644 lib/gs/contribs/bonk/sounds/level.au delete mode 100644 lib/gs/contribs/bonk/sounds/missedme.au delete mode 100644 lib/gs/contribs/bonk/sounds/music.au delete mode 100644 lib/gs/contribs/bonk/sounds/ouch!!!.au delete mode 100644 lib/gs/contribs/bonk/sounds/praisejesus.au delete mode 100644 lib/gs/contribs/bonk/sounds/trumpet.au delete mode 100644 lib/gs/contribs/bonk/sounds/yes.au delete mode 100644 lib/gs/contribs/cols/Makefile delete mode 100644 lib/gs/contribs/cols/cols.erl delete mode 100644 lib/gs/contribs/cols/cols.gif delete mode 100644 lib/gs/contribs/cols/cols.tool delete mode 100644 lib/gs/contribs/cols/help.gif delete mode 100644 lib/gs/contribs/cols/highscore.erl delete mode 100644 lib/gs/contribs/ebin/.gitignore delete mode 100644 lib/gs/contribs/mandel/Makefile delete mode 100644 lib/gs/contribs/mandel/mandel.erl delete mode 100644 lib/gs/contribs/mandel/mandel.gif delete mode 100644 lib/gs/contribs/mandel/mandel.html delete mode 100644 lib/gs/contribs/mandel/mandel.tool delete mode 100644 lib/gs/contribs/othello/Makefile delete mode 100644 lib/gs/contribs/othello/othello.erl delete mode 100644 lib/gs/contribs/othello/othello.gif delete mode 100644 lib/gs/contribs/othello/othello.tool delete mode 100644 lib/gs/contribs/othello/othello_adt.erl delete mode 100644 lib/gs/contribs/othello/othello_board.erl delete mode 100644 lib/gs/contribs/othello/priv/marker.bm delete mode 100644 lib/gs/contribs/othello/priv/square.bm diff --git a/lib/gs/Makefile b/lib/gs/Makefile index 02c8fc3467..b95d435461 100644 --- a/lib/gs/Makefile +++ b/lib/gs/Makefile @@ -26,7 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src tcl contribs examples doc/src +SUB_DIRECTORIES = src tcl examples doc/src include vsn.mk VSN = $(GS_VSN) diff --git a/lib/gs/contribs/Makefile b/lib/gs/contribs/Makefile deleted file mode 100644 index 061fae86c1..0000000000 --- a/lib/gs/contribs/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -SUB_DIRECTORIES = bonk cols mandel othello -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/gs/contribs/bonk/Makefile b/lib/gs/contribs/bonk/Makefile deleted file mode 100644 index b7508a97c9..0000000000 --- a/lib/gs/contribs/bonk/Makefile +++ /dev/null @@ -1,109 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - bonk \ - bonk_sound \ - bonk_square \ - sounder - -HRL_FILES= -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -BITMAPS= bitmaps/bonkbomb bitmaps/bonkface bitmaps/bonklogo bitmaps/bonkmiss \ - bitmaps/bonktom bitmaps/bonkx bitmaps/erl-e bitmaps/erl-text -SOUNDS= sounds/bonk.au sounds/damn.au sounds/explosion.au sounds/gameover.au \ - sounds/hehee.au sounds/level.au sounds/missedme.au sounds/music.au \ - sounds/ouch!!!.au sounds/praisejesus.au sounds/trumpet.au sounds/yes.au - -TOOLNAME = bonk - -EXTRA_FILES= $(TOOLNAME).txt -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/bonk/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk/sounds" - $(INSTALL_DATA) $(SOUNDS) "$(RELSYSDIR)/bonk/sounds" - $(INSTALL_DIR) "$(RELSYSDIR)/bonk" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/bonk" - - -release_docs_spec: - diff --git a/lib/gs/contribs/bonk/bitmaps/bonkbomb b/lib/gs/contribs/bonk/bitmaps/bonkbomb deleted file mode 100644 index 8b121db9e8..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkbomb +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkbomb_width 75 -#define bonkbomb_height 75 -static char bonkbomb_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x04, 0x10, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, - 0x10, 0x42, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x10, 0x21, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x10, 0x11, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x90, 0x08, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x90, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x04, 0x51, 0x82, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, - 0x12, 0x61, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x94, 0x18, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41, 0x06, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xbb, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, - 0x99, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x18, 0x19, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x30, 0x62, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x30, 0x84, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x30, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xc0, 0x31, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0x3b, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x1f, 0x40, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0xb8, 0x0e, 0x80, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x5c, 0x1d, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xff, 0xff, 0xaf, 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, - 0xff, 0x57, 0x35, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xaf, - 0x3a, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x5f, 0x1d, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0x0e, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xfe, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0x01, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x7f, 0xfc, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x80, 0x3f, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, - 0x0f, 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xc0, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0x7f, 0xf0, 0xff, 0xff, - 0x03, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf8, 0xff, 0xff, 0x07, 0x00, - 0x00, 0x00, 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, - 0x00, 0xc0, 0xff, 0xfd, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x80, - 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, - 0x03, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, - 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, - 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkface b/lib/gs/contribs/bonk/bitmaps/bonkface deleted file mode 100644 index 964fb93098..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkface +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkface_width 75 -#define bonkface_height 75 -static char bonkface_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, - 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x40, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, - 0x02, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x01, 0x08, - 0x00, 0x80, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x01, 0x30, 0x00, 0x60, - 0x00, 0x04, 0x00, 0x00, 0x00, 0x80, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x08, - 0x00, 0x00, 0x00, 0x80, 0x07, 0x00, 0x03, 0x06, 0x00, 0x0f, 0x00, 0x00, - 0x00, 0x40, 0xff, 0x00, 0x00, 0x00, 0xf8, 0x17, 0x00, 0x00, 0x00, 0x40, - 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff, - 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00, - 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0, - 0x07, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0x07, 0x1f, - 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x03, 0x06, 0x00, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0, - 0x00, 0x38, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0x01, 0x7c, - 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0x06, 0x03, 0x40, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x10, 0x00, 0xf8, 0x00, 0x40, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x30, 0x00, 0x00, 0x00, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x70, 0x00, 0x00, 0x00, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0x01, - 0x00, 0x00, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0x0f, 0x00, 0x80, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00, - 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40, - 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xc0, 0xff, - 0xff, 0xff, 0x1f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0xff, 0xff, - 0x1f, 0x08, 0x00, 0x00, 0x00, 0x80, 0x80, 0xff, 0xff, 0xff, 0x0f, 0x08, - 0x00, 0x00, 0x00, 0x00, 0x01, 0xff, 0xff, 0xff, 0x07, 0x04, 0x00, 0x00, - 0x00, 0x00, 0x01, 0xfe, 0xff, 0xff, 0x03, 0x04, 0x00, 0x00, 0x00, 0x00, - 0x02, 0xfc, 0xff, 0xfc, 0x01, 0x02, 0x00, 0x00, 0x00, 0x00, 0x04, 0xf0, - 0xff, 0x7c, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x08, 0xc0, 0xff, 0x1c, - 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0xff, 0x07, 0x40, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0x01, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, - 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0xc0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonklogo b/lib/gs/contribs/bonk/bitmaps/bonklogo deleted file mode 100644 index 3adc59984a..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonklogo +++ /dev/null @@ -1,320 +0,0 @@ -#define bonklogo_width 300 -#define bonklogo_height 100 -static char bonklogo_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x3f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, - 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, - 0x83, 0xff, 0x9f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x3c, 0xf8, 0xff, 0x7f, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x87, 0xff, 0xff, 0xff, 0x08, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xf9, 0xff, 0xff, 0xff, 0x13, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0x27, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x02, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, - 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x0f, - 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0x2f, 0xf8, 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x80, 0xdf, 0xff, 0x2f, 0xf0, 0xff, 0x0d, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xc3, 0xff, 0x2f, 0xf0, 0xff, 0x09, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x80, 0xc0, 0xff, 0x2f, 0xe0, 0xff, 0x0b, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x01, 0x00, 0x80, 0xff, 0x09, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x2f, 0xc0, 0xff, - 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x00, 0xc0, - 0xff, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x27, - 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0x01, - 0x00, 0xc0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, - 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff, 0x17, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0x7f, 0x01, 0x00, 0xe0, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xff, 0x3f, 0xe0, 0x7f, 0x02, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xc0, - 0xff, 0x7f, 0xe0, 0xff, 0x3f, 0xfc, 0x7f, 0x00, 0x20, 0xe0, 0x7f, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, - 0x17, 0x00, 0x00, 0x80, 0x00, 0x00, 0x20, 0xfc, 0x7f, 0xfe, 0x2f, 0xf0, - 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, - 0x80, 0xff, 0x17, 0xe0, 0xff, 0x1f, 0xe1, 0xff, 0x2f, 0xfc, 0x7f, 0xfe, - 0x2f, 0xf0, 0x3f, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0x17, 0x80, 0xff, 0x17, 0xf0, 0xff, 0x7f, 0xe6, 0xff, 0x4f, 0xfc, - 0x7f, 0xfe, 0x2f, 0xf0, 0xbf, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xf8, 0xff, 0xff, 0xe8, 0xff, - 0x4f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe, 0xff, 0xff, - 0xeb, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x9f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0x80, 0xff, 0x17, 0xfe, - 0xff, 0xff, 0xe3, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xf8, 0x5f, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, 0xc0, 0xff, - 0x17, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc, - 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x17, - 0xc0, 0xff, 0x93, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x5f, 0xfc, 0x7f, 0xfe, - 0x2f, 0xfc, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0x17, 0xc0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xe7, 0xff, 0x9f, 0xfc, - 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xe0, 0xff, 0x13, 0xe0, 0xff, 0x8b, 0xff, 0xff, 0xff, 0xcf, 0xff, - 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfc, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf2, 0xff, 0xcd, 0xff, 0xff, 0xff, - 0xcf, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x17, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0b, 0xf9, 0xff, 0xd9, 0xff, - 0xff, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, 0x13, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xcb, 0xfc, 0xff, - 0xc0, 0xff, 0x8f, 0xff, 0x1f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, 0x2f, 0xfe, - 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x2b, - 0xfe, 0xff, 0x87, 0xff, 0x03, 0xff, 0x3f, 0xff, 0xbf, 0xfc, 0x7f, 0xfe, - 0x2f, 0xff, 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xff, 0x9b, 0xff, 0xff, 0x3f, 0xff, 0x01, 0xfe, 0x3f, 0xff, 0x3f, 0xfd, - 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xc3, 0xff, 0xff, 0x7f, 0xfe, 0x05, 0xfc, 0x3f, 0xff, - 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xfb, 0xff, 0xff, 0xff, 0xfc, 0x04, 0xfc, - 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0x2f, 0xff, 0x04, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xfc, - 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfd, 0x7f, 0xfe, 0xaf, 0xff, 0x04, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xfd, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe, 0xaf, 0xff, - 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf9, 0x02, 0xf8, 0x3f, 0xff, 0x7f, 0xfc, 0x7f, 0xfe, - 0x8f, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xfb, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, - 0x7f, 0xfe, 0xcf, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8, 0x3f, 0xff, - 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x7f, 0x01, 0x00, 0x00, 0x38, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x02, 0xf8, - 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xcf, 0x3f, 0x01, 0x00, 0x00, 0x38, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0xf7, - 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x3f, 0x01, 0x00, - 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x03, 0x80, 0xff, - 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfc, 0x7f, 0xfe, 0xef, 0x9f, - 0x00, 0x00, 0x00, 0x00, 0x98, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x01, - 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, - 0xef, 0xdf, 0x00, 0x00, 0x00, 0x30, 0xd8, 0x07, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0x05, 0x00, 0xff, 0xff, 0xe7, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, - 0x7f, 0xfe, 0xef, 0x9f, 0x00, 0x00, 0x00, 0x38, 0xfc, 0x07, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0x05, 0x00, 0xff, 0xff, 0xef, 0x02, 0xf8, 0x3f, 0xff, - 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xbf, 0x00, 0x00, 0x00, 0x38, 0x7c, 0x0e, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef, 0x02, 0xf8, - 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x3f, 0x01, 0x00, 0x00, 0x38, - 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfe, 0xff, 0xef, - 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0x7f, 0x02, 0x00, - 0x00, 0x38, 0x3e, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x05, 0x00, 0xfc, - 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xfd, 0x7f, 0xfe, 0xff, 0xff, - 0x02, 0x00, 0x00, 0x38, 0x3b, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x04, - 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff, 0x7f, 0xfe, - 0xff, 0xff, 0x04, 0x00, 0x00, 0xb8, 0x39, 0x2e, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x02, 0xf8, 0x3f, 0xff, 0xff, 0xff, - 0x7f, 0xfe, 0xff, 0xff, 0x05, 0x00, 0x00, 0xf0, 0x39, 0x3c, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x04, 0xf8, 0x3f, 0xff, - 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x09, 0x00, 0x00, 0xf0, 0x38, 0x1c, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf8, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, 0x05, 0xf8, - 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x13, 0x00, 0x00, 0x60, - 0x08, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfc, 0xff, 0xcf, - 0x0d, 0xf8, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x17, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, - 0xff, 0xcf, 0x09, 0xfd, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, 0xff, 0xff, - 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, - 0x00, 0xfe, 0xff, 0xcf, 0xcb, 0xfc, 0x3f, 0xff, 0xfd, 0xff, 0x7f, 0xfe, - 0xff, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x33, 0xfe, 0x3f, 0xff, 0xf9, 0xff, - 0x7f, 0xfe, 0xff, 0xff, 0x5f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0x07, 0xff, 0x3f, 0xff, - 0xf9, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x00, 0xfe, 0xff, 0xcf, 0xcf, 0xff, - 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xff, 0x3f, 0x01, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x40, 0xfe, 0xff, 0xcf, - 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe, 0x3f, 0x01, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x02, 0x3c, 0xff, - 0xff, 0xc7, 0xff, 0xff, 0x3f, 0xff, 0xf9, 0xff, 0x7f, 0xfe, 0x7f, 0xfe, - 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x82, - 0x87, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff, 0x7f, 0xfe, - 0x3f, 0xfc, 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0x72, 0xf0, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x3f, 0xff, 0xf1, 0xff, - 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0x0e, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff, 0x9f, 0xff, - 0xf5, 0xff, 0x7f, 0xfe, 0xbf, 0xf8, 0xff, 0x09, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xe0, 0xff, 0xff, 0xff, 0xe7, 0xff, 0xff, - 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x9f, 0xf0, 0xff, 0x0b, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xe7, - 0xff, 0xff, 0x9f, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x5f, 0xf0, 0xff, 0x13, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf3, 0xff, 0xff, 0xdf, 0xff, 0xf5, 0xff, 0x7f, 0xfe, 0x4f, 0xe0, - 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff, 0x7f, 0xfe, - 0x2f, 0xe0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xff, 0xcf, 0xff, 0xe5, 0xff, - 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x4f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xff, 0xe7, 0xff, - 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0xc0, 0xff, 0x9f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xf8, 0xff, 0xff, - 0xe7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x80, 0xff, 0x9f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0xfc, - 0xff, 0xff, 0xf7, 0xff, 0xe5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xff, 0x3f, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, - 0x1f, 0xfe, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, - 0xff, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0xf3, 0xff, 0xc5, 0xff, 0x7f, 0xfe, - 0x2f, 0x00, 0xfe, 0x7f, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, - 0xff, 0xff, 0xff, 0xff, 0x23, 0xff, 0xff, 0xff, 0xf1, 0xff, 0xc5, 0xff, - 0x7f, 0xfe, 0x2f, 0x00, 0xfe, 0xff, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x11, 0xfe, 0xff, 0xff, 0xf5, 0xff, - 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x04, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x0c, 0xfc, 0xff, 0xff, - 0xf4, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xfc, 0xff, 0x09, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x02, 0xfc, - 0xff, 0x7f, 0xf2, 0xff, 0xc5, 0xff, 0x7f, 0xfe, 0x2f, 0x00, 0xf8, 0xff, - 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01, - 0x00, 0xe0, 0xff, 0x3f, 0xf1, 0xff, 0x85, 0xff, 0x7f, 0xfe, 0x2f, 0x00, - 0xf8, 0xff, 0x13, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, - 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff, 0x7f, 0xfe, - 0x2f, 0x00, 0xf0, 0xff, 0x27, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, - 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x85, 0xff, - 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkmiss b/lib/gs/contribs/bonk/bitmaps/bonkmiss deleted file mode 100644 index 862e4839fc..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkmiss +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkmiss_width 75 -#define bonkmiss_height 75 -static char bonkmiss_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9, 0x01, 0x00, 0x60, 0x80, - 0x19, 0x7e, 0xe0, 0x87, 0xff, 0xf9, 0x03, 0x00, 0xe0, 0xc0, 0x19, 0xe7, - 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0xe0, 0xc0, 0x99, 0xc3, 0x39, 0x9c, - 0x01, 0x18, 0x0e, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, - 0x0c, 0x00, 0xe0, 0xe1, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00, - 0xe0, 0xf3, 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3, - 0x99, 0x01, 0x18, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0xb3, 0x99, 0x03, - 0x38, 0x80, 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x07, 0x70, 0x80, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x9e, 0x19, 0x3e, 0xe0, 0x83, 0x1f, 0x18, - 0x18, 0x00, 0x60, 0x8c, 0x19, 0x7c, 0xc0, 0x87, 0x1f, 0x18, 0x18, 0x00, - 0x60, 0x80, 0x19, 0xe0, 0x00, 0x8e, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, - 0x19, 0xc0, 0x01, 0x9c, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, - 0x01, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x19, 0x80, 0x01, 0x98, 0x01, 0x18, - 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, - 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, - 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, - 0x19, 0x98, 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, - 0x01, 0x18, 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, - 0x18, 0x00, 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x1c, 0x00, - 0x60, 0x80, 0x99, 0x81, 0x19, 0x98, 0x01, 0x18, 0x0c, 0x00, 0x60, 0x80, - 0x99, 0xc3, 0x39, 0x9c, 0x01, 0x18, 0x0e, 0x00, 0x60, 0x80, 0x19, 0xe7, - 0x70, 0x8e, 0x01, 0x18, 0x07, 0x00, 0x60, 0x80, 0x19, 0x7e, 0xe0, 0x87, - 0xff, 0xf9, 0x03, 0x00, 0x60, 0x80, 0x19, 0x3c, 0xc0, 0x83, 0xff, 0xf9, - 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x1c, 0x38, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, - 0x3c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x3c, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x3e, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x6c, 0x36, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xcc, 0x33, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xcc, - 0x33, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x8c, 0x31, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x0c, 0x30, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x0c, 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, - 0x30, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonktom b/lib/gs/contribs/bonk/bitmaps/bonktom deleted file mode 100644 index defbc32cc9..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonktom +++ /dev/null @@ -1,66 +0,0 @@ -#define bonktom_width 75 -#define bonktom_height 75 -static char bonktom_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/bonkx b/lib/gs/contribs/bonk/bitmaps/bonkx deleted file mode 100644 index 70cd89bdb7..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/bonkx +++ /dev/null @@ -1,66 +0,0 @@ -#define bonkx_width 75 -#define bonkx_height 75 -static char bonkx_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x3e, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xf0, 0x03, 0xfe, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf8, 0x03, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, - 0xf8, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xf0, 0x07, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xe0, 0x0f, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03, - 0x00, 0xc0, 0x1f, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0, - 0x0f, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0, 0x00, 0xf0, 0x07, 0x00, - 0x00, 0xfe, 0x00, 0x06, 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0xfc, - 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xf8, 0x43, 0x00, - 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00, - 0x20, 0x7f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x3f, - 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0x00, 0x00, - 0x00, 0x80, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, - 0x7f, 0x00, 0x00, 0x00, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0xff, 0x08, - 0x00, 0x80, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00, 0xfd, 0x31, 0x00, 0x60, - 0xfc, 0x05, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xc3, 0x00, 0x18, 0xfe, 0x08, - 0x00, 0x00, 0x00, 0x80, 0xf7, 0x07, 0x03, 0x06, 0x7f, 0x0f, 0x00, 0x00, - 0x00, 0x40, 0xff, 0x0f, 0x00, 0x80, 0xff, 0x17, 0x00, 0x00, 0x00, 0x40, - 0xfe, 0x1f, 0x00, 0xc0, 0xff, 0x13, 0x00, 0x00, 0x00, 0x20, 0xf8, 0xff, - 0x03, 0xfe, 0xff, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xc0, 0xff, 0xdf, 0xff, 0x1f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0x00, 0xff, 0xdf, 0xff, 0x07, 0x20, 0x00, 0x00, - 0x00, 0x10, 0x00, 0xfe, 0x8f, 0xff, 0x03, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0xf8, 0x8f, 0xff, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xf0, - 0x8f, 0x7f, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xc0, 0xdf, 0x1f, - 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0x80, 0xff, 0x0f, 0x00, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0xff, 0x07, 0x00, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x00, 0x00, 0xfc, 0x01, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x00, 0xe0, - 0xfe, 0x3b, 0x00, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0xf0, 0xff, 0x7f, - 0x40, 0x40, 0x00, 0x00, 0x00, 0x10, 0x10, 0x80, 0xff, 0x0f, 0x40, 0x40, - 0x00, 0x00, 0x00, 0x10, 0x10, 0xc0, 0xff, 0x1f, 0x40, 0x40, 0x00, 0x00, - 0x00, 0x10, 0x30, 0xe0, 0x8f, 0x3f, 0x60, 0x40, 0x00, 0x00, 0x00, 0x10, - 0x70, 0xf0, 0x07, 0x7f, 0x70, 0x40, 0x00, 0x00, 0x00, 0x10, 0xf0, 0xf9, - 0x03, 0xfe, 0x7c, 0x40, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x01, 0xfc, - 0x7f, 0x20, 0x00, 0x00, 0x00, 0x20, 0xf0, 0xff, 0x03, 0xfe, 0x7f, 0x20, - 0x00, 0x00, 0x00, 0x20, 0xf0, 0x7f, 0xfe, 0xff, 0x7f, 0x20, 0x00, 0x00, - 0x00, 0x20, 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x20, 0x00, 0x00, 0x00, 0x40, - 0xe0, 0x7f, 0xfe, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x40, 0xe0, 0xff, - 0xff, 0xff, 0x3f, 0x10, 0x00, 0x00, 0x00, 0x80, 0xf0, 0xff, 0xff, 0xff, - 0x7f, 0x08, 0x00, 0x00, 0x00, 0x80, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x08, - 0x00, 0x00, 0x00, 0x00, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x05, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xfe, 0xff, 0xff, 0xfb, 0x07, 0x00, 0x00, 0x00, 0x00, - 0x7f, 0xfc, 0xff, 0xfc, 0xf1, 0x07, 0x00, 0x00, 0x00, 0x80, 0x3f, 0xf0, - 0xff, 0x7c, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0xc0, 0x1f, 0xc0, 0xff, 0x1c, - 0xc0, 0x1f, 0x00, 0x00, 0x00, 0xe0, 0x1f, 0x00, 0xff, 0x07, 0xc0, 0x3f, - 0x00, 0x00, 0x00, 0xf0, 0x27, 0x00, 0x00, 0x00, 0x20, 0x7f, 0x00, 0x00, - 0x00, 0xf8, 0x43, 0x00, 0x00, 0x00, 0x10, 0xfe, 0x00, 0x00, 0x00, 0xfc, - 0x81, 0x01, 0x00, 0x00, 0x0c, 0xfc, 0x01, 0x00, 0x00, 0xfe, 0x00, 0x06, - 0x00, 0x00, 0x03, 0xf8, 0x03, 0x00, 0x00, 0x7f, 0x00, 0x18, 0x00, 0xc0, - 0x00, 0xf0, 0x07, 0x00, 0x80, 0x3f, 0x00, 0xe0, 0x01, 0x3c, 0x00, 0xe0, - 0x0f, 0x00, 0xc0, 0x1f, 0x00, 0x00, 0xfe, 0x03, 0x00, 0xc0, 0x1f, 0x00, - 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0x00, 0xf0, 0x07, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x00, 0xf8, 0x03, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xfe, 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfc, 0x01, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf8, 0x03, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x03, - 0x3e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x1e, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/bonk/bitmaps/erl-e b/lib/gs/contribs/bonk/bitmaps/erl-e deleted file mode 100644 index 41ad14f404..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/erl-e +++ /dev/null @@ -1,106 +0,0 @@ -#define erl-e_width 108 -#define erl-e_height 88 -static char erl-e_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xe0, 0xff, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0xfc, 0x7f, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0x3f, - 0x00, 0x00, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7, - 0xfc, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, - 0xff, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0x00, 0x00, - 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, - 0x01, 0x00, 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0xe0, - 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x0f, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xfc, 0xf7, 0xfc, 0x07, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xf7, - 0xfc, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, - 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f, 0x00, - 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0x0f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xfc, - 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x01, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0xf0, 0xf7, - 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x7c, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, - 0x7c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xe0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, - 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, - 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x3c, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, 0x7c, 0x00, - 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xf7, - 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, - 0xff, 0xf7, 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, - 0x7f, 0xfe, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0xff, 0xff, 0x3f, 0xf8, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, 0x00, 0xf8, - 0xff, 0xff, 0xff, 0xff, 0x3f, 0xe0, 0xff, 0xf7, 0xfc, 0x00, 0x00, 0x00, - 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x1f, 0xc0, 0xff, 0xf7, 0xfc, 0x01, - 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0xfe, 0xf7, - 0xfc, 0x01, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, - 0xf8, 0xf7, 0xfc, 0x01, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, - 0x03, 0x00, 0xe0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0xc0, 0xf7, 0xfc, 0x03, 0x00, 0x00, 0x00, 0xc0, - 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x80, 0xf7, 0xfc, 0x07, 0x00, 0x00, - 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x80, 0xf7, 0xfc, 0x07, - 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x80, 0xf7, - 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x1f, 0x00, 0x00, - 0xc0, 0xf7, 0xfc, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x0f, - 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, - 0xff, 0x07, 0x00, 0x00, 0xe0, 0xf7, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00, - 0xf0, 0xff, 0xff, 0x03, 0x00, 0x00, 0xf0, 0xf7, 0xfc, 0x3f, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0xf8, 0xf7, 0xfc, 0x7f, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x1f, 0x00, 0x00, 0x00, 0xfc, 0xf7, - 0xfc, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0xfc, 0xf7, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xfe, 0xf7, 0xfc, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xff, 0xf7, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xf7, 0xfc, 0xff, 0x07, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf7, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0}; diff --git a/lib/gs/contribs/bonk/bitmaps/erl-text b/lib/gs/contribs/bonk/bitmaps/erl-text deleted file mode 100644 index e20a9e5a28..0000000000 --- a/lib/gs/contribs/bonk/bitmaps/erl-text +++ /dev/null @@ -1,106 +0,0 @@ -#define erl-text_width 108 -#define erl-text_height 88 -static char erl-text_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, - 0xfc, 0x03, 0xf8, 0x00, 0x70, 0x00, 0x80, 0x03, 0x80, 0x03, 0x07, 0x00, - 0x3e, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x80, 0x03, 0x80, 0x07, - 0x07, 0x80, 0xff, 0xf0, 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xc0, 0x07, - 0x80, 0x07, 0x07, 0xe0, 0xff, 0xf1, 0x1c, 0x00, 0x38, 0x07, 0x70, 0x00, - 0xc0, 0x07, 0x80, 0x0f, 0x07, 0xe0, 0xc1, 0xf3, 0x1c, 0x00, 0x38, 0x0e, - 0x70, 0x00, 0xe0, 0x0f, 0x80, 0x1f, 0x07, 0xf0, 0x80, 0xf3, 0x1c, 0x00, - 0x38, 0x0f, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x1f, 0x07, 0x78, 0x00, 0xf0, - 0xfc, 0x03, 0xf8, 0x07, 0x70, 0x00, 0xe0, 0x0e, 0x80, 0x3f, 0x07, 0x78, - 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x03, 0x70, 0x00, 0x70, 0x1c, 0x80, 0x7b, - 0x07, 0x38, 0x00, 0xf0, 0xfc, 0x03, 0xf8, 0x01, 0x70, 0x00, 0x70, 0x1c, - 0x80, 0xf3, 0x07, 0x38, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x01, 0x70, 0x00, - 0x70, 0x1c, 0x80, 0xe3, 0x07, 0x78, 0xf8, 0xf7, 0x1c, 0x00, 0xf8, 0x03, - 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xe3, 0x07, 0x70, 0x80, 0xf7, 0x1c, 0x00, - 0xb8, 0x03, 0x70, 0x00, 0xf8, 0x3f, 0x80, 0xc3, 0x07, 0xf0, 0x80, 0xf3, - 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x38, 0x38, 0x80, 0x83, 0x07, 0xe0, - 0xe3, 0xf3, 0xfc, 0x03, 0x38, 0x07, 0xf0, 0x07, 0x1c, 0x70, 0x80, 0x83, - 0x07, 0xc0, 0xff, 0xf1, 0xfc, 0x03, 0x38, 0x0e, 0xf0, 0x07, 0x1c, 0x70, - 0x80, 0x03, 0x07, 0x00, 0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0}; diff --git a/lib/gs/contribs/bonk/bonk.erl b/lib/gs/contribs/bonk/bonk.erl deleted file mode 100644 index bbbc656b34..0000000000 --- a/lib/gs/contribs/bonk/bonk.erl +++ /dev/null @@ -1,584 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(bonk). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([run/0, run/1,bonk_dir/0,start/0]). - --record(colors, {miss, x, bomb, face}). --record(scores, {points, level, bombs, hits, showed, bonus}). - -start() -> - spawn(bonk, run, []). - -run() -> - run(color). - -run([ColorMode]) -> % This is for the start script... - run(ColorMode); - -run(ColorMode) when is_atom(ColorMode) -> - GS = gs:start(), - SoundPid = spawn_link(bonk_sound,start,[]), - {H,M,S} = time(), - random:seed(H*13,M*7,S*3), - {SqrPids, Bmps, Colors} = create_board(GS, ColorMode), - {ScoreL,_File} = get_highscore(), - display_highscore(ScoreL), - put(colormode, ColorMode), - SoundPid ! music, - sleep(6500), - gs:config(aboutButton, [{enable,true}]), - gs:config(newButton, [{enable,true}]), - gs:config(quitButton, [{enable,true}]), - idle(SoundPid, SqrPids, Bmps, Colors). - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb -%% -%% Note the silly slash that is added. The rest of the code uses -%% append to contruct file names and assumes that the directory ends -%% in slash. If filename:join was used and the problem is gone. - --define(EbinFromGsPriv,"../contribs/bonk"). - -bonk_dir() -> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv) ++ "/". - - -idle(SoundPid, SqrPids, Bmps, Colors) -> - receive - {gs, newButton, click, _Data, _Args} -> - init(SoundPid, SqrPids, Bmps, Colors); - {gs, aboutButton, click, _Data, _Args} -> - display_about(), - idle(SoundPid, SqrPids, Bmps, Colors); - {gs, quitButton, click, _Data, _Args} -> - SoundPid ! quit, - send_to_all(SqrPids, quit); - _Other -> - %%io:format("Got ~w in idle~n", [_Other]), - idle(SoundPid, SqrPids, Bmps, Colors) - end. - - - -init(SoundPid, SqrPids, Bmps, Colors) -> - clear_board(Bmps), - SoundPid ! start, - gs:config(newButton, [{enable,false}]), - gs:config(endButton, [{enable,true}]), - gs:config(aboutButton, [{enable,false}]), - Scores = #scores{points=0, level=1, bombs=0, hits=0, showed=0, bonus=10}, - clear_scores(Scores), - flush(), - send_to_all(SqrPids, start), - game(SoundPid, SqrPids, Bmps, Colors, Scores). - - -game(SoundPid, SqrPids, Bmps, Colors, Scores) -> - receive - {gs, _Square, buttonpress, SqrPid, [1 | _Rest]} when is_pid(SqrPid) -> - SqrPid ! bonk, - game(SoundPid, SqrPids, Bmps, Colors, Scores); - {gs, _Id, buttonpress, _Data, [Butt | _Rest]} when Butt =/= 1 -> - NewScores = bomb(SoundPid, SqrPids, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {show, Square, Rect} -> - NewScores = show_face(Square, Rect, Colors, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {hide, Square, Rect} -> - NewScores = hide_face(Square, Rect, Colors, Scores), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {missed, Square, Rect} -> - case miss_face(SoundPid, Square, Rect, Colors, Scores) of - {continue, NewScores} -> - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {game_over, NewScores} -> - game_over(SoundPid, SqrPids, Bmps, Colors, NewScores) - end; - {bonked, Square, Rect} -> - NewScores = bonked(SoundPid, SqrPids, Square, Rect, Scores, Colors), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {bombed, Square, Rect} -> - NewScores = bombed(SoundPid, SqrPids, Square, Rect, Scores, Colors), - game(SoundPid, SqrPids, Bmps, Colors, NewScores); - {gs, endButton, click, _Data, _Args} -> - game_over(SoundPid, SqrPids, Bmps, Colors, Scores); - {gs, quitButton, click, _Data, _Args} -> - quit(SoundPid, SqrPids, Bmps, Colors, Scores); - _Other -> - game(SoundPid, SqrPids, Bmps, Colors, Scores) - end. - - - -game_over(SoundPid, SqrPids, Bmps, Colors, Scores) -> - SoundPid ! game_over, - send_to_all(SqrPids, stop), - flush(), - sleep(2000), - update_scorelist(SoundPid, Scores), - gs:config(newButton, [{enable,true}]), - gs:config(endButton, [{enable,false}]), - gs:config(aboutButton, [{enable,true}]), - idle(SoundPid, SqrPids, Bmps, Colors). - - -quit(SoundPid, SqrPids, _Bmps, _Colors, _Scores) -> - SoundPid ! quit, - send_to_all(SqrPids, quit), - true. - - - -bomb(SoundPid, SqrPids, Scores) -> - case Scores#scores.bombs of - Bombs when Bombs > 0 -> - send_to_all(SqrPids, bomb), - SoundPid ! bomb, - gs:config(bombOut,[{text,integer_to_list(Bombs-1)}]), - Scores#scores{bombs=Bombs-1}; - _Other -> - Scores - end. - -show_face(Square, Rect, Colors, Scores) -> - Showed = Scores#scores.showed, - if - Showed == Scores#scores.level+1 -> - Square ! sleep, - Scores; - true -> - FaceColors = Colors#colors.face, - FaceColor = lists:nth(random:uniform(length(FaceColors)), FaceColors), - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkface")},{fg, FaceColor}]), - Scores#scores{showed=Showed+1} - end. - -hide_face(_Square, Rect, _Colors, Scores) -> - Showed = Scores#scores.showed, - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonktom")}]), - Scores#scores{showed=Showed-1}. - - -miss_face(SoundPid, _Square, Rect, Colors, Scores) -> - SoundPid ! missed, - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkmiss")}, {fg, Colors#colors.miss}]), - Bonus = Scores#scores.bonus, - if - Bonus > 1 -> - gs:config(bonusOut, [{text,integer_to_list(Bonus-1)}]), - {continue, Scores#scores{bonus=Bonus-1}}; - true -> - gs:config(bonusOut, [{text,"0"}]), - {game_over, Scores} - end. - -bonked(SoundPid, SqrPids, _Square, Rect, Scores, Colors) -> - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkx")}, {fg, Colors#colors.x}]), - SoundPid ! bonk, - update_score(SoundPid, SqrPids, Scores). - -bombed(SoundPid, SqrPids, _Square, Rect, Scores, Colors) -> - gs:config(Rect, [{bitmap,lists:append(bonk_dir(),"bitmaps/bonkbomb")}, {fg, Colors#colors.bomb}]), - update_score(SoundPid, SqrPids, Scores). - - -update_score(SoundPid, SqrPids, Scores) -> - Points = Scores#scores.points, - Level = Scores#scores.level, - NewPoints = Points+Level, - gs:config(scoreOut,[{text,integer_to_list(NewPoints)}]), - case Scores#scores.hits of - 24 -> - SoundPid ! new_level, - NewLevel = Level+1, - NewBombs = Scores#scores.bombs+1, - send_to_all(SqrPids, {new_level, NewLevel}), - gs:config(levelOut,[{text,integer_to_list(NewLevel)}]), - gs:config(bombOut,[{text,integer_to_list(NewBombs)}]), - Scores#scores{points=NewPoints, level=NewLevel, hits=0, bombs=NewBombs}; - Hits -> - Scores#scores{points=NewPoints, hits=Hits+1} - end. - - -send_to_all([], _Msg) -> - true; -send_to_all([Pid|Rest],Msg) when is_pid(Pid) -> - Pid ! Msg, - send_to_all(Rest,Msg); -send_to_all([_Else|Rest],Msg) -> - send_to_all(Rest,Msg). - - -create_board(GS, ColorMode) -> - Colors = - case ColorMode of - bw -> #colors{miss=white, x=white, bomb=white, face=[white]}; - _Color -> #colors{miss=red, x=green, bomb=white, - face=[lightblue, orange, magenta, peachpuff, pink]} - end, - BGCol = if ColorMode==bw -> black; true -> black end, % background color - TextCol = if ColorMode==bw -> white; true -> pink end, % status texts - NrCol = if ColorMode==bw -> white; true -> purple end, % status figures - LogoCol = if ColorMode==bw -> white; true -> green end, % bonk logo - BLineCol = if ColorMode==bw -> white; true -> grey end, % button line - SLineCol = if ColorMode==bw -> white; true -> red end, % status line - BTextCol = if ColorMode==bw -> white; true -> orange end, % button text - HiHeadCol = if ColorMode==bw -> white; true -> red end, % high score label - HiCol = if ColorMode==bw -> white; true -> cyan end, % high scores - SquareCol = if ColorMode==bw -> white; true -> yellow end, % game squares - ErlFgCol = if ColorMode==bw -> white; true -> red end, % - ErlBGCol = if ColorMode==bw -> black; true -> white end, % - ErlTxtCol = if ColorMode==bw -> white; true -> black end, % - - Width = 550, % width of bonk window - Height = 550, % Height of bonk window - - BX = 0, % x-pos for first button - DBX = 100, % space between buttons - BY = 0, % y-pos for buttons - BLineY = 30, % y-pos of button line - LogoX = (Width-320) div 2, % x-pos of bonk logo (logo is 320 pix wide) - LogoY = BLineY+2, % y-pos of bonk logo - ErlLogoX = LogoX + 200, % x-pos of Erlang e - ErlLogoY = LogoY + 10, % y-pos of Erlang e - SLineY = Height-22, % status line position - TextWidth = 50, % text width of status items - SX = 2, % x-pos for first status item - DSX = TextWidth+94, % pixels between status items - SY = SLineY+2, % y-pos status items - HiWidth = 100, % width of high score field - _HiHeight = 180, % height of the same - HiX = Width-HiWidth, % high score text position - HiY = BLineY+10, - DHY = 20, % space between title & scores - SquareSize = 76, % size of each game square - SquareSpace = 1, % space between game squares - SquareX = 40, - SquareY = 65, - - gs:create(window, bonkWin, GS, [{width, Width}, {height, Height}, - {bg, BGCol}, - {title, "Bonk the game"}, - {iconname, "Bonk!"}, - {map, false}]), - gs:create(canvas, bonkCanvas, bonkWin, [{width, Width}, - {height, Height}, - {bg, BGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonklogo")}, - {coords, [{LogoX, LogoY}]}, - {fg, LogoCol}, - {bg, BGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-e")}, - {coords, [{ErlLogoX, ErlLogoY}]}, - {fg, ErlFgCol}, - {bg, ErlBGCol}]), - gs:create(image, bonkCanvas, [{bitmap,lists:append(bonk_dir(), "bitmaps/erl-text")}, - {coords, [{ErlLogoX, ErlLogoY}]}, - {fg, ErlTxtCol}]), - gs:create(line, bLine, bonkCanvas, [{coords, [{0,BLineY}, {Width,BLineY}]}, - {fg, BLineCol}, - {width, 2}]), - gs:create(line, bLine, bonkCanvas, [{coords, [{0,SLineY}, {Width, SLineY}]}, - {fg, SLineCol}, - {width, 2}]), - gs:create(text, scoreText, bonkCanvas, [{coords, [{SX, SY}]}, - {fg, TextCol}, - {text, "Score:"}]), - gs:create(text, scoreOut, bonkCanvas, [{coords, [{SX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, bombText, bonkCanvas, [{coords, [{SX+DSX, SY}]}, - {fg, TextCol}, - {text, "Bombs:"}]), - gs:create(text, bombOut, bonkCanvas, [{coords, [{SX+DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, bonusText, bonkCanvas, [{coords, [{SX+2*DSX, SY}]}, - {fg, TextCol}, - {text, "Bonus:"}]), - gs:create(text, bonusOut, bonkCanvas, [{coords, [{SX+2*DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, levelText,bonkCanvas, [{coords, [{SX+3*DSX, SY}]}, - {fg, TextCol}, - {text, "Level:"}]), - gs:create(text, levelOut, bonkCanvas, [{coords, [{SX+3*DSX+TextWidth, SY}]}, - {fg, NrCol}, - {width, DSX-TextWidth}, - {text, ""}]), - gs:create(text, hiScoreText, bonkCanvas, [{coords, [{HiX, HiY}]}, - {fg, HiHeadCol}, - {text, "High Scores"}]), - gs:create(text, hiScoreOut, bonkCanvas, [{coords, [{HiX, HiY+DHY}]}, - {fg, HiCol}, - {justify, left}, - {width, HiWidth}]), - gs:create(button, newButton,bonkWin, [{x, BX},{y, BY}, - {enable,false}, - {label, {text, "New Game"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, endButton,bonkWin, [{x, BX+DBX},{y, BY}, - {enable,false}, - {label, {text, "End Game"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, aboutButton,bonkWin, [{x, BX+2*DBX},{y, BY}, - {enable,false}, - {label, {text, "About"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - gs:create(button, quitButton, bonkWin, [{x, BX+3*DBX},{y, BY}, - {enable,false}, - {label, {text, "Quit"}}, - {click, true}, - {fg, BTextCol}, - {bg, BGCol}, - {relief, flat}, - {activefg, BTextCol}, - {activebg, BGCol}, - {align, center}]), - - {SqrPids, Bmps} = - create_squares(SquareX, SquareY, SquareSize, SquareCol, SquareSpace), - gs:config(bonkWin, [{map, true}]), - {SqrPids, Bmps, Colors}. - - - -create_squares(X, Y, Size, Color, Spc) -> - create_squares(X, Y, Size, Color, Spc, 1, 1, [], []). - - -create_squares(_X, _Y, _Size, _Color, _Spc, 4, 5, Pids, Bmps) -> - {Pids, Bmps}; - -create_squares(X, Y, Size, Color, Spc, Row, 5, Pids, Bmps) -> - create_squares(X, Y, Size, Color, Spc, Row+1, 1, Pids, Bmps); - -create_squares(X, Y, Size, Color, Spc, Row, Col, Pids, Bmps) -> - Xpos = X+Col*Size+(Col-1)*Spc, - Ypos = Y+Row*Size+(Row-1)*Spc, - gs:create(rectangle, bonkCanvas, - [{coords, [{Xpos,Ypos},{Xpos+Size, Ypos+Size}]}, - {bw, 2},{fg, Color},{buttonpress,true}]), - Bmp = gs:create(image, bonkCanvas, - [{coords, [{Xpos+1, Ypos+1}]}, - {bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")}, - {buttonpress, true},{fg, Color}]), - Pid = bonk_square:start(Bmp), - gs:config(Bmp, [{data, Pid}]), - create_squares(X, Y, Size, Color, Spc, Row, Col+1, [Pid|Pids], [Bmp|Bmps]). - - - -clear_board([]) -> - true; -clear_board([Square | Rest]) -> - gs:config(Square, [{bitmap,lists:append(bonk_dir(), "bitmaps/bonktom")}]), - clear_board(Rest). - - -%% Prints the list on the screen. -%% The list is on the form [[Score,Name],[Score,Name]..]. - -display_highscore(ScoreList) -> - display_highscore("",ScoreList,0). - -display_highscore(Scores,[],_N) -> - gs:config(hiScoreOut,[{text,Scores}]); - -display_highscore(Scores,_ScoreList,10) -> % This is max number of items. - display_highscore(Scores,[], 10); - -display_highscore(Scores,[[Score,Name]|Rest],N) -> - NewScores = lists:append(Scores,lists:append(lists:append(Score, [32 | Name]), [10])), - display_highscore(NewScores,Rest,N+1). - - -%% Reads the highscorelist from the file "bonk.score". -%% The list should be an sorted erlang-list. - -get_highscore() -> - case file:consult("bonk.score") of - {ok,[Score_list]} -> - {Score_list,"./bonk.score"}; - {error,_} -> - {[],"./bonk.score"} - end. - - -%% Prints out the highscorelist and places the new score in the -%% list if it is high enough. - -update_scorelist(SoundPid, Scores) -> - case Scores#scores.points of - 0 -> true; - Score -> - {ScoreL,FileName} = get_highscore(), - New_scorelist=update_scorelist_2(ScoreL, Score, 0, SoundPid), - display_highscore(New_scorelist), - case file:open(FileName, [write]) of - {error,_} -> - true; - {ok,FD} -> - io:format(FD,"~w~s~n",[New_scorelist,"."]), - file:close(FD) - end - end. - - -update_scorelist_2([], Score, N, _SoundPid) when N < 10 -> - [[integer_to_list(Score),getuser()]]; - -update_scorelist_2(_, _, N, _SoundPid) when N >= 10 -> - []; - -update_scorelist_2([[Sc, Name] | Rest], Score, N, SoundPid) -> - case list_to_integer(Sc) of - Sc_int when Sc_int < Score -> - if - N == 0 -> SoundPid ! best_score; - true -> SoundPid ! high_score - end, - lists:append([[integer_to_list(Score),getuser()]], - update_scorelist_3([[Sc,Name]|Rest],N+1)); - _Other -> - lists:append([[Sc,Name]],update_scorelist_2(Rest, Score, N+1, SoundPid)) - end. - - -update_scorelist_3([],_) -> - []; - -update_scorelist_3(_,N) when N >= 10 -> - []; - -update_scorelist_3([Item|Rest],N) -> - lists:append([Item],update_scorelist_3(Rest,N+1)). - -getuser() -> - case os:type() of - {unix,_} -> - lists:delete(10,os:cmd("whoami")); - _ -> - "Unknown" - end. - -%% Prints out the initial values of scores, bonus, level and bombs. - -clear_scores(Scores) -> - Score = integer_to_list(Scores#scores.points), - Bombs = integer_to_list(Scores#scores.bombs), - Bonus = integer_to_list(Scores#scores.bonus), - Level = integer_to_list(Scores#scores.level), - gs:config(scoreOut,{text,Score}), - gs:config(bombOut,{text,Bombs}), - gs:config(bonusOut,{text,Bonus}), - gs:config(levelOut,{text,Level}). - - -%% Removes everything that is present in the message-que. - -flush() -> - receive - _X -> - flush() - after - 0 -> - true - end. - -sleep(X) -> - receive after X -> true end. - -%% Opens a window and shows the contents of the file: "bonk.txt". -%% The window will be removed before the function ends. - -display_about() -> - {BGColor,TextColor,Bfg} = - case get(colormode) of - bw -> {black, white, white}; - _Color -> {black, peachpuff1, orange} - end, - Wid = 500, Hei = 635, - GS = gs:start(), - gs:create(window, aboutWin, GS, [{width, Wid}, {height,Hei}, - {map, false}, - {bg, BGColor}, - {title, "About Bonk!"}]), - gs:create(canvas, aboutCan, aboutWin, [{width, Wid},{height, Hei}, - {bg, black}]), - gs:create(button, okButton, aboutWin, [{x, Wid div 2 - 50},{y, Hei - 40}, - {label,{text, "Ok"}}, {click, true}, - {fg, Bfg}, {bg, BGColor}, - {relief, flat}, - {activefg, Bfg}, - {activebg, BGColor}]), - gs:create(text, aboutText, aboutCan, [{width, Wid-30}, {coords, [{15, 0}]}, - {fg, TextColor}, {justify, center}]), - case file:open(lists:append(bonk_dir(),"bonk.txt"), [read]) of - {ok, Fd} -> - write_text(Fd, "", io:get_line(Fd, "")), - file:close(Fd); - {error, _Reason} -> - gs:config(aboutText, {text, "Error: could not read the about file"}) - end, - - gs:config(aboutWin, [{map,true}]), - receive - {gs, okButton, click, _, _} -> - gs:destroy(aboutWin) - end. - -write_text(_Fd, Text, eof) -> - gs:config(aboutText, {text, Text}); -write_text(Fd, Text, More) -> - write_text(Fd, lists:append(Text, More), io:get_line(Fd, "")). diff --git a/lib/gs/contribs/bonk/bonk.gif b/lib/gs/contribs/bonk/bonk.gif deleted file mode 100644 index 3c2299686b..0000000000 Binary files a/lib/gs/contribs/bonk/bonk.gif and /dev/null differ diff --git a/lib/gs/contribs/bonk/bonk.tool b/lib/gs/contribs/bonk/bonk.tool deleted file mode 100644 index 79ad8f6701..0000000000 --- a/lib/gs/contribs/bonk/bonk.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Bonk"}, - {start,{bonk,start,[]}}, - {icon,"bonk.gif"}, - {message,"Bonk - The Game"}, - {html,"../bonk/bonk.txt"}}. diff --git a/lib/gs/contribs/bonk/bonk.txt b/lib/gs/contribs/bonk/bonk.txt deleted file mode 100644 index 69c912dbee..0000000000 --- a/lib/gs/contribs/bonk/bonk.txt +++ /dev/null @@ -1,30 +0,0 @@ -BONK! In Erlang for You -by -LENNART OHMAN & MARCUS ARENDT - -After an idea of Mike Darweesh. -Special thanks to Peter Jansson for creating the bitmaps. -Ported to GS 1.1 by Markus Torpvret and Anders Dahlin. - - -INSTRUCTIONS -- Hit as many creatures as possible using the left mouse-button. -- After every 25 hits You will advance one level. For each level You get one bomb. -- Pushing the middle or right mouse-button, in any square, drops a bomb which -wipes out everything. -- The game ends when 10 creatures has escaped from beeing bonked. - - -ABOUT ERLANG -Erlang is a programming language for building robust concurrent systems. It is a single assignment, symbolic language with built in concurrency. It provides unique facilities for error handling and for reloading updated modules in running systems. Erlang was designed and implemented by Joe Armstrong, Robert Virding, and Mike Williams at Ellemtel (now Ericsson Utvecklings AB). - -Please make enquiries about Erlang to: - -Ericsson Software Technology AB -Erlang Systems -Torshamnsgatan 39B -Box 1214 -164 28 Kista -Sweden - -http://www.ericsson.se/erlang \ No newline at end of file diff --git a/lib/gs/contribs/bonk/bonk_sound.erl b/lib/gs/contribs/bonk/bonk_sound.erl deleted file mode 100644 index 9a0db80e5d..0000000000 --- a/lib/gs/contribs/bonk/bonk_sound.erl +++ /dev/null @@ -1,82 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(bonk_sound). --export([start/0]). - -start() -> - random:seed(), - sounder:start(), - {ok,Bonk}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/bonk.au")), - {ok,Ouch}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/ouch!!!.au")), - {ok,Damn}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/damn.au")), - {ok,Bomb}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/explosion.au")), - {ok,Missed}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/missedme.au")), - {ok,Game_over}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/gameover.au")), - {ok,New_level}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/level.au")), - {ok,Music}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/trumpet.au")), - {ok,Start}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/hehee.au")), - {ok,BestS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/praisejesus.au")), - {ok,HighS}=sounder:new(lists:append(bonk:bonk_dir(),"sounds/yes.au")), - loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, - Music, Start, BestS, HighS). - - -loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS) -> - R=random:uniform(1000), - receive - bonk -> - if - R < 75 -> play_sound(Damn); - R < 275 -> play_sound(Ouch); - true -> play_sound(Bonk) - end; - bomb -> play_sound(Bomb); - missed -> play_sound(Missed); - game_over -> play_sound(Game_over); - new_level -> play_sound(New_level); - music -> play_sound(Music); - start -> play_sound(Start); - best_score -> play_sound(BestS); - high_score -> play_sound(HighS); - quit -> - sounder:stop(), - exit(normal) - end, - loop(Bonk, Ouch, Damn, Bomb, Missed, Game_over, New_level, Music, Start, BestS, HighS). - -play_sound(Snd) -> - case catch sounder:play(Snd) of - {'EXIT', _Reason} -> - io:format("Cannot use audio device!\n"), - sounder:stop(), - silent_loop(); - _Other -> - true - end. - -silent_loop() -> - receive - quit -> - exit(normal); - _Other -> - silent_loop() - end. diff --git a/lib/gs/contribs/bonk/bonk_square.erl b/lib/gs/contribs/bonk/bonk_square.erl deleted file mode 100644 index 98af91944b..0000000000 --- a/lib/gs/contribs/bonk/bonk_square.erl +++ /dev/null @@ -1,146 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(bonk_square). --export([start/1,init/5,alarm/3]). - - - -start(Bmp) -> - spawn_link(bonk_square, init, [Bmp, self(), - random:uniform(10000), - random:uniform(10000), - random:uniform(10000)]). - -init(Bmp, BoardPid, Seed1, Seed2, Seed3) -> - random:seed(Seed1,Seed2,Seed3), - idle(Bmp, BoardPid). - - -idle(Bmp, BoardPid) -> - receive - start -> - Level = 1, - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - quit -> - exit(normal); - _Other -> - idle(Bmp, BoardPid) - end. - - -sleep(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - sleep(NewLevel, Bmp, BoardPid, Alarm); - {Alarm, wake_up} -> - show_me(BoardPid, Bmp), - show(Level, Bmp, BoardPid, alarm(2500, missed)); - _Other -> - sleep(Level, Bmp, BoardPid, Alarm) - end. - - -show(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - show(NewLevel, Bmp, BoardPid, Alarm); - sleep -> % The board was too crowded. - Alarm ! quit, - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - bonk -> - bonk_me(BoardPid, Bmp), - Alarm ! quit, - bbmed(Level, Bmp, BoardPid, alarm(1500, hide)); - bomb -> - bomb_me(BoardPid, Bmp), - Alarm ! quit, - bbmed(Level, Bmp, BoardPid, alarm(1000, hide)); - {Alarm, missed} -> - missed_me(BoardPid, Bmp), - bbmed(Level, Bmp, BoardPid, alarm(1500, hide)); - _Other -> - show(Level, Bmp, BoardPid, Alarm) - end. - -%% bonked, bombed or missed -bbmed(Level, Bmp, BoardPid, Alarm) -> - receive - stop -> - Alarm ! quit, - idle(Bmp, BoardPid); - quit -> - Alarm ! quit, - exit(normal); - {new_level, NewLevel} -> - bbmed(NewLevel, Bmp, BoardPid, Alarm); - {Alarm, hide} -> - hide_me(BoardPid, Bmp), - sleep(Level, Bmp, BoardPid, alarm(sleep_time(Level), wake_up)); - _Other -> - bbmed(Level, Bmp, BoardPid, Alarm) - end. - - -show_me(BoardPid, Bmp) -> - BoardPid ! {show, self(), Bmp}. - -hide_me(BoardPid, Bmp) -> - BoardPid ! {hide, self(), Bmp}. - -bonk_me(BoardPid, Bmp) -> - BoardPid ! {bonked, self(), Bmp}. - -bomb_me(BoardPid, Bmp) -> - BoardPid ! {bombed, self(), Bmp}. - -missed_me(BoardPid, Bmp) -> - BoardPid ! {missed, self(), Bmp}. - - -%% Count sleep time - -sleep_time(Level) -> - random:uniform((19000 div (Level+1))*2+1500). - -%% Set an alarm - -alarm(Time, Msg) -> - spawn(bonk_square, alarm, [Time, Msg, self()]). - -alarm(Time, Msg, Pid) -> - receive - quit -> exit(normal) - after - Time -> Pid ! {self(), Msg} - end. diff --git a/lib/gs/contribs/bonk/sounder.erl b/lib/gs/contribs/bonk/sounder.erl deleted file mode 100644 index aabcaa1950..0000000000 --- a/lib/gs/contribs/bonk/sounder.erl +++ /dev/null @@ -1,160 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(sounder). --export([start/0,play/1,new/1,go/0,stop/0,nosound/0,silent/0]). --include_lib("kernel/include/file.hrl"). -%%---------------------------------------------------------------------- -%% sounder.erl - An interface to /dev/audio -%% -%% Created by: {lennarto,mike}@erix.ericsson.se -%% Modified by: EV,tobbe@erix.ericsson.se -%% -%% Mod: 6 Jun 1996 by tobbe@erix.ericsson.se -%% The executable sounder will no be looked for in the -%% same directory as from where sounder.jam is loaded. -%% -%% -%% start() - Returns either: ok ,or: silent ,where silent means -%% that no audio capabilities exists but the sounder -%% will work "silently" in order to not break any code. -%% -%% stop() - Returns: ok -%% -%% new(File) - Tries to load the File. At success, a number refering -%% to the File is returned that shall be used with send/1. -%% Otherwise {error,Reason} is returned. -%% -%% play(No) - Tries to execute the sound registered with the number No -%% Returns: ok , or: {error,Reason} -%% -%% silent() - Returns: true ,if no audio capabilities exists, else: false -%% -%% Note: It is also possible to receive: {error,sounder_not_started} -%% -%%---------------------------------------------------------------------- - -start() -> - case whereis(sounder) of - undefined -> - %% first we check if the workstation has audio capabilities - case file:read_file_info('/dev/audio') of - {ok, FI} when FI#file_info.access==read_write -> - register(sounder, spawn(sounder,go,[])), - ok; - _Other -> - register(sounder, spawn(sounder,nosound,[])), - silent - end; - _Pid -> - ok - end. - -stop() -> - catch begin check(), - sounder ! {stop}, - ok end. - -new(File) when is_list(File) -> new(list_to_atom(File)); -new(File) when is_atom(File) -> - catch begin check(), - sounder ! {new,File,self()}, - wait_for_ack(sounder) end. - -play(No) when is_integer(No) -> - catch begin check(), - sounder ! {play, No, self()}, - wait_for_ack(sounder) end. - -silent() -> - catch begin check(), - sounder ! {play,silent,self()}, - receive {sounder,Answer} -> Answer end end. - -go() -> - Port = open_port({spawn,lists:append(bonk:bonk_dir(), "sounder")},[{packet, 2}]), - loop(Port). - -loop(Port) -> - receive - {new, File, From} when is_atom(File) -> - Port ! {self(),{command,lists:append([0],atom_to_list(File))}}, - From ! {sounder,wait_for_ack(Port)}, - loop(Port); - {play,silent,From} -> - From ! {sounder,false}, - loop(Port); - {play,No,From} when is_integer(No) -> - Port ! {self(),{command,[No]}}, - From ! {sounder,wait_for_ack(Port)}, - loop(Port); - {stop} -> - Port ! {self(),close}, - exit(normal); - _ -> - loop(Port) - end. - -%% The application using sounds can check on silence itself -%% and refrain from playing sounds. -%% Or it can try to play sounds that will be "consumed in silence" - -nosound() -> - receive - {new,File,From} when is_atom(File) -> - From ! {sounder,{ok,silent}}, - nosound(); - {play,silent,From} -> - From ! {sounder,true}, - nosound(); - {play,No,From} when is_integer(No) -> - From ! {sounder,{error,no_audio_cap}}, - nosound(); - {stop} -> - exit(normal); - _ -> - nosound() - end. - -wait_for_ack(sounder) -> - receive {sounder,Res} -> Res end; -wait_for_ack(Port) when is_port(Port) -> - receive - {Port,{data,"ok"}} -> - ok; - {Port,{data,[No]}} -> - {ok,No}; - {Port,{data,Msg}} -> - {error,list_to_atom(Msg)}; - {'EXIT',Port,_} -> - exit(port_exited) - end. - -check() -> - case whereis(sounder) of - Pid when is_pid(Pid) -> - ok; - undefined -> - throw({error,sounder_not_started}) - end. - - - diff --git a/lib/gs/contribs/bonk/sounds/bonk.au b/lib/gs/contribs/bonk/sounds/bonk.au deleted file mode 100644 index 5e6518898b..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/bonk.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/damn.au b/lib/gs/contribs/bonk/sounds/damn.au deleted file mode 100644 index 6117506fb4..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/damn.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/explosion.au b/lib/gs/contribs/bonk/sounds/explosion.au deleted file mode 100644 index 78a6964f1a..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/explosion.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/gameover.au b/lib/gs/contribs/bonk/sounds/gameover.au deleted file mode 100644 index ca7628f3c6..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/gameover.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/hehee.au b/lib/gs/contribs/bonk/sounds/hehee.au deleted file mode 100644 index 10cd16b596..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/hehee.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/level.au b/lib/gs/contribs/bonk/sounds/level.au deleted file mode 100644 index 0508c2a6ae..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/level.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/missedme.au b/lib/gs/contribs/bonk/sounds/missedme.au deleted file mode 100644 index 4c07c9d428..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/missedme.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/music.au b/lib/gs/contribs/bonk/sounds/music.au deleted file mode 100644 index ead6ec79b2..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/music.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/ouch!!!.au b/lib/gs/contribs/bonk/sounds/ouch!!!.au deleted file mode 100644 index 78bcf48074..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/ouch!!!.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/praisejesus.au b/lib/gs/contribs/bonk/sounds/praisejesus.au deleted file mode 100644 index e299bf66d6..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/praisejesus.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/trumpet.au b/lib/gs/contribs/bonk/sounds/trumpet.au deleted file mode 100644 index 2f551b436a..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/trumpet.au and /dev/null differ diff --git a/lib/gs/contribs/bonk/sounds/yes.au b/lib/gs/contribs/bonk/sounds/yes.au deleted file mode 100644 index c1ce7dfb69..0000000000 Binary files a/lib/gs/contribs/bonk/sounds/yes.au and /dev/null differ diff --git a/lib/gs/contribs/cols/Makefile b/lib/gs/contribs/cols/Makefile deleted file mode 100644 index 34a900e5ab..0000000000 --- a/lib/gs/contribs/cols/Makefile +++ /dev/null @@ -1,103 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - cols \ - highscore - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = cols - -EXTRA_FILES= -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif help.gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -$(EBIN)/help.gif: help.gif - $(gen_verbose)rm -f $@ - $(V_at)cp help.gif $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/cols/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/cols/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/cols" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/cols" - -release_docs_spec: - diff --git a/lib/gs/contribs/cols/cols.erl b/lib/gs/contribs/cols/cols.erl deleted file mode 100644 index 265f2b6ee8..0000000000 --- a/lib/gs/contribs/cols/cols.erl +++ /dev/null @@ -1,625 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(cols). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([start/0, init/0]). - -%% internal export. --export([make_board_elem/3]). - -%%====================================================================== -%% Contents -%%===================== -%% 1. The actual program -%% 2. Graphics -%% 3. Data structures and stuff -%% 4. Lambdas -%%====================================================================== - - --define(COLORS, {red,green,blue,grey,yellow,{66,153,130}}). --define(HIGHFILE, "./cols.high"). --define(HEIGHT, 17). --define(LEFT, 50). --define(SIZE, 15). --define(VERSION, "v0.9"). --define(WIDTH, 8). - --record(state, {bit,board,nextbit,ticks, score=0}). -%%---------------------------------------------------------------------- -%% Consists of three boxes. -%%---------------------------------------------------------------------- --record(bit, {x,y,topColor, middleColor, bottomColor, - top_gsobj,mid_gsobj,bot_gsobj}). - -%%====================================================================== -%% 1. The actual program -%%====================================================================== - -start() -> - spawn_link(cols,init,[]). - -init() -> - make_graphics(), - {A,B,C} = erlang:now(), - random:seed(A,B,C), - NextBit = make_bit(), - Board = make_screen_board(), - S = #state{bit=make_bit(), board=Board, ticks=update_timer(1), - score=make_score(), nextbit=new_bit_xy(NextBit, -2,5)}, - gs:config(win, [{map, true}]), - loop(S). - -make_graphics() -> - G = gs:start(), - H = ?HEIGHT*?SIZE, - W = ?WIDTH*?SIZE, - BotMargin = 100, - gs:create(window, win, G, [{destroy,true},{map, true},{title, "cols"}, - {height, H+BotMargin}, {width, W+?LEFT+10}, - {bg, grey},{keypress,true}]), - gs:create(canvas, can, win, [{bg, black}, - {height, H+BotMargin}, - {width, W+?LEFT+20}]), - gs:create(text, can, [{text, "Next"}, {coords, [{5, 45}]}, {fg, red}]), - gs:create(image, help, can, [{coords,[{5,7}]}, - {load_gif, dir() ++ "/help.gif"}, - {buttonpress,true}]), - draw_borders(). - -loop(State) -> - receive - Event -> loop(update(Event, State)) - end. - -%%---------------------------------------------------------------------- -%% How fast speed should be doubled -%%---------------------------------------------------------------------- --define(DBL_TICKS, 300). - -update_timer(Ticks) -> - K = 0.001/?DBL_TICKS, - M = 1.001-K, - Q = K*Ticks+M, - Timeout = round(1/math:log(Q)), - timer:send_after(Timeout, self(), fall_timeout), - Ticks+1. - -add_score({ScoreObj, NScore}, DScore) -> - NScore2 = NScore + DScore, - gs:config(ScoreObj, [{text, io_lib:format("Score: ~w", [NScore2])}]), - {ScoreObj, NScore2}. - - -update({gs,_Obj,keypress,_Data, ['Left'|_]}, State) -> - #state{bit=Bit, board = Board} = State, - #bit{x=X,y=Y} = Bit, - if X > 0 -> - case is_board_empty(Board, X-1,Y) of - true -> - State#state{bit=new_bit_xy(Bit, X-1, Y)}; - false -> - State - end; - true -> State - end; - -update({gs,_Obj,keypress,_Data, ['Right'|_]}, State) -> - #state{bit=Bit, board = Board} = State, - #bit{x=X,y=Y} = Bit, - if X < ?WIDTH - 1 -> - case is_board_empty(Board, X+1, Y) of - true -> - State#state{bit=new_bit_xy(Bit, X+1, Y)}; - false -> - State - end; - true -> State - end; - -update({gs,_Obj,keypress,_Data, ['Up'|_]}, State) -> - State#state{bit=shift_bits(State#state.bit)}; - -update({gs,_Obj,keypress,_Data, [Key|_]}, State) -> - case drop_key(Key) of - true -> - #state{bit=Bit, board=Board, score=Score} = State, - #bit{x=X,y=Y} = Bit, - {NewX, NewY, NewScore} = drop(X,Y,Score,Board), - fasten_bit(State#state{bit=new_bit_xy(Bit,NewX, NewY), - score=NewScore}); - false -> State - end; - -update(fall_timeout, State) -> - #state{bit=Bit, board=Board, ticks = Ticks, score=Score} = State, - NewY = Bit#bit.y+1, - X = Bit#bit.x, - case is_fall_ok(Board, X, NewY) of - true -> - State#state{bit=new_bit_xy(Bit, X, NewY), - ticks=update_timer(Ticks), score=add_score(Score, 1)}; - false -> - S1 = fasten_bit(State), - S1#state{ticks=update_timer(Ticks)} - end; - -update({gs,_,destroy,_,_}, _State) -> - exit(normal); - -update({gs,help,buttonpress,_,_}, State) -> - show_help(), - State; - -update(OtherEvent, State) -> - ok=io:format("got other! ~w~n", [OtherEvent]), State. - -drop_key('Down') -> true; -drop_key(space) -> true; -drop_key(_) -> false. - -is_board_empty(Board, X, Y) -> - case {color_at(Board, X, Y), - color_at(Board, X, Y + 1), - color_at(Board, X, Y + 2)} of - {black, black, black} -> true; - _ -> false - end. - -%%---------------------------------------------------------------------- -%% Returns: NewState -%%---------------------------------------------------------------------- -fasten_bit(State) -> - #state{board=Board, bit=Bit, nextbit=NextBit, score=Score} = State, - #bit{x=X,y=Y,topColor=C1,middleColor=C2,bottomColor=C3} = Bit, - B1 = update_screen_element(Board, X, Y, C1), - B2 = update_screen_element(B1, X, Y+1, C2), - B3 = update_screen_element(B2, X, Y+2, C3), - destroy_bit(Bit), - #bit{topColor=NC1,middleColor=NC2,bottomColor=NC3} = NextBit, - {B4, ExtraScore} = erase_bits(B3, [{X,Y},{X,Y+1},{X,Y+2}], 0), - NewBit = make_bit(NC1,NC2,NC3), - case is_board_empty(B4, NewBit#bit.x, NewBit#bit.y) of - true -> - State#state{score=add_score(Score, ExtraScore), - bit=NewBit, nextbit=new_colors(NextBit),board=B4}; - false -> - {_GsObj,Score2}=State#state.score, - highscore:run(Score2,?HIGHFILE), - exit(normal) - end. - -%%---------------------------------------------------------------------- -%% Args: Check: list of {X,Y} to check. -%% Returns: {NewBoard, ExtraScore} -%%---------------------------------------------------------------------- -erase_bits(Board, Checks, ExtraScore) -> - ElemsToDelete = elems2del(Checks,Board,[]), - NDel = length(ElemsToDelete), - if - NDel > 0 -> - Board2 = delete_elems(Board, ElemsToDelete), - {NewBoard, NewCheck} = fall_down(Board2, ElemsToDelete), - if NDel > 3 -> - {B,ES}=erase_bits(NewBoard,NewCheck,ExtraScore+2*NDel), - {NewBoard2, NewCheck2} = bonus(B, NewCheck), - erase_bits(NewBoard2, NewCheck2, ES); - true -> - erase_bits(NewBoard, NewCheck, 2*NDel) - end; - true -> {Board, ExtraScore} - end. - -bonus(Board, Check) -> - Cols = collect_bottom_bits(0,Board), - NewBoard = randomize_columns(5, Board, Cols), - NewCheck = update_check(Check, Cols), - {NewBoard, NewCheck}. - -randomize_columns(0, Board, _) -> Board; -randomize_columns(N, Board, Cols) -> - NewBoard = randomize_columns(Cols,Board), - randomize_columns(N-1, NewBoard, Cols). - -randomize_columns([],Board) -> Board; -randomize_columns([X|Xs],Board) -> - flush(), - timer:sleep(50), - randomize_columns(Xs,update_screen_element(Board,X,?HEIGHT-1,rndColor())). - -%%---------------------------------------------------------------------- -%% Returns: NewBoard -%%---------------------------------------------------------------------- -delete_elems(Board, Elems2Del) -> - OrgObjs = org_objs(Elems2Del,Board), - visual_effect(?SIZE, OrgObjs), - NewBoard = update_board(Elems2Del, Board), - put_back(OrgObjs), - NewBoard. - -visual_effect(0,_OrgObjs) -> done; -visual_effect(Size,OrgObjs) -> - set_size(OrgObjs,Size), - flush(), - timer:sleep(20), - visual_effect(Size-1,OrgObjs). - -set_size([],_Size) -> done; -set_size([{GsObj,[{X1,Y1},{_X2,_Y2}]}|T],Size) -> - gs:config(GsObj, [{coords, [{X1,Y1},{X1+Size,Y1+Size}]}]), - set_size(T,Size). - -%%---------------------------------------------------------------------- -%% Note: Loop over columns where something is removed only. (efficiency) -%% Returns: {ReversedNewColumns (perhaps shorter), Checks} -%% cols:fall_column([a,b,black,black,c,f,black,d,black], 3, 15, [], []). -%% should return: {[a,b,c,f,d],[{3,11},{3,12},{3,13}]} -%%---------------------------------------------------------------------- -fall_column([], _X, _Y, ColumnAcc, ChecksAcc) -> - {ColumnAcc, ChecksAcc}; -fall_column([black|Colors], X, Y, ColumnAcc, ChecksAcc) -> - case find_box(Colors) of - false -> {ColumnAcc, ChecksAcc}; - NewColors when is_list(NewColors) -> - fall_one_step(NewColors, X, Y, ColumnAcc, ChecksAcc) - end; -fall_column([Color|Colors], X, Y, ColumnAcc, ChecksAcc) -> - fall_column(Colors, X, Y-1, [Color | ColumnAcc], ChecksAcc). - -find_box([]) -> false; -find_box([black|Colors]) -> - find_box(Colors); -find_box([Color|Colors]) -> [Color|Colors]. - -%%---------------------------------------------------------------------- -%% Enters: ([a,b, , ,c,d], 3, 8, Q) -%% Leaves: ([b,a|Q], [ , , ,c,d], 10, [{3,8},{4,9}]) -%%---------------------------------------------------------------------- -fall_one_step([], X, Y, ColumnAcc, Checks) -> - fall_column([], X, Y, ColumnAcc, Checks); -fall_one_step([black|Colors], X, Y, ColumnAcc, Checks) -> - fall_column([black|Colors], X, Y, ColumnAcc, Checks); -fall_one_step([Color|Colors], X, Y, ColumnAcc, Checks) -> - fall_one_step(Colors, X, Y-1, [Color|ColumnAcc],[{X,Y}|Checks]). - -%%---------------------------------------------------------------------- -%% Returns: {NewBoard, NewChecks} -%%---------------------------------------------------------------------- -fall_down(Board1, Elems2Del) -> - UpDatedCols = updated_cols(Elems2Del, []), - fall_column(UpDatedCols, Board1, []). - -fall_column([], NewBoard, NewChecks) -> {NewBoard, NewChecks}; -fall_column([X|Xs], BoardAcc, ChecksAcc) -> - OrgColumn = boardcolumn_to_tuple(BoardAcc, X), - Column = columntuple_to_list(OrgColumn), - {NewColumn, NewChecksAcc} = fall_column(Column, X,?HEIGHT-1,[],ChecksAcc), - NewBoardAcc = - set_board_column(BoardAcc,X,new_column_list(NewColumn,OrgColumn)), - fall_column(Xs,NewBoardAcc,NewChecksAcc). - -new_column_list(NewColumn, ColumnTuple) -> - Nempty = ?HEIGHT - length(NewColumn), - L = make_list(black, Nempty) ++ NewColumn, - new_column_list(L, 1, ColumnTuple). - -new_column_list([H|T], N, Tuple) -> - {GsObj, Color} = element(N, Tuple), - [update_screen_element({GsObj, Color},H) | new_column_list(T, N+1, Tuple)]; -new_column_list([], _, _) -> []. - - -%%---------------------------------------------------------------------- -%% Returns: a reversed list of colors. -%%---------------------------------------------------------------------- -columntuple_to_list(ColumnTuple) when is_tuple(ColumnTuple) -> - columntuple_to_list(tuple_to_list(ColumnTuple),[]). - -columntuple_to_list([],Acc) -> Acc; -columntuple_to_list([{_GsObj, Color}|T],Acc) -> - columntuple_to_list(T,[Color|Acc]). - -%%====================================================================== -%% 2. Graphics -%%====================================================================== - -make_bit() -> - make_bit(rndColor(),rndColor(),rndColor()). - -make_bit(Tc,Mc,Bc) -> - X = ?WIDTH div 2, - Y = 0, - #bit{x=X,y=Y,topColor= Tc, middleColor=Mc, bottomColor=Bc, - top_gsobj = make_box(X,Y,Tc), mid_gsobj=make_box(X,Y+1,Mc), - bot_gsobj=make_box(X,Y+2,Bc)}. - -new_colors(Bit) -> - #bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - Tc = rndColor(), - Mc = rndColor(), - Bc = rndColor(), - gs:config(T, [{fill, Tc}]), - gs:config(M, [{fill, Mc}]), - gs:config(B, [{fill, Bc}]), - Bit#bit{topColor= Tc, middleColor=Mc, bottomColor=Bc}. - -new_bit_xy(Bit, NewX, NewY) -> - #bit{x=X,y=Y,top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - Dx = (NewX - X) * ?SIZE, - Dy = (NewY - Y) * ?SIZE, - gs:config(T, [{move, {Dx, Dy}}]), - gs:config(M, [{move, {Dx, Dy}}]), - gs:config(B, [{move, {Dx, Dy}}]), - Bit#bit{x=NewX, y=NewY}. - -destroy_bit(#bit{top_gsobj=T,mid_gsobj=M,bot_gsobj=B}) -> - gs:destroy(T), - gs:destroy(M), - gs:destroy(B). - -shift_bits(Bit) -> - #bit{topColor=C1,middleColor=C2,bottomColor=C3, - top_gsobj=T,mid_gsobj=M,bot_gsobj=B} = Bit, - gs:config(T, {fill,C2}), - gs:config(M, {fill,C3}), - gs:config(B, {fill,C1}), - Bit#bit{topColor=C2, middleColor=C3, bottomColor=C1}. - -rndColor() -> - Siz = size(?COLORS), - element(random:uniform(Siz), ?COLORS). - -make_score() -> - {gs:create(text, can, [{text, "Score: 0"}, {fg, red}, - {coords, [{5,?HEIGHT*?SIZE+10}]}]), 0}. - -make_screen_board() -> - xy_loop({cols,make_board_elem}, make_board(), ?WIDTH, ?HEIGHT). - -make_board_elem(X,Y,Board) -> - set_board_element(Board,X,Y,{make_box(X,Y,black),black}). - -flush() -> gs:read(can, bg). - -draw_borders() -> - BotY = ?HEIGHT*?SIZE, - RightX = ?LEFT + ?SIZE*?WIDTH, - LeftX = ?LEFT - 1, - gs:create(line,can,[{coords,[{LeftX,0},{LeftX,BotY}]},{fg,white}]), - gs:create(line,can,[{coords,[{LeftX,BotY},{RightX,BotY}]},{fg,white}]), - gs:create(line,can,[{coords,[{RightX,0},{RightX, BotY}]}, {fg,white}]). - -update_screen_element(ScrBoard, X, Y, Color) -> - case board_element(ScrBoard,X,Y) of - {_GsObj, Color} -> - ScrBoard; % don't have to update screen - {GsObj, _ScreenColor} -> - gs:config(GsObj, color_args(Color)), - set_board_element(ScrBoard, X, Y, {GsObj, Color}) - end. - -update_screen_element(ScrElem, Color) -> - case ScrElem of - {_GsObj, Color} -> - ScrElem; % don't have to update screen - {GsObj, _ScreenColor} -> - gs:config(GsObj, color_args(Color)), - {GsObj, Color} - end. - - -color_args(black) -> [{fg,black},{fill,black}]; -color_args(Color) -> [{fg,white},{fill,Color}]. - -%%====================================================================== -%% 3. Data structures and stuff -%%====================================================================== - -xy_loop(Fun, Acc, XMax, YMax) -> - xy_loop(Fun, Acc, 0, 0, XMax, YMax). - -xy_loop(_Fun, Acc, _X, YMax, _XMax, YMax) -> Acc; -xy_loop(Fun, Acc, XMax, Y, XMax, YMax) -> - xy_loop(Fun, Acc, 0, Y+1, XMax, YMax); -xy_loop(Fun, Acc, X, Y, XMax, YMax) -> - xy_loop(Fun, apply(Fun, [X, Y,Acc]), X+1,Y,XMax, YMax). - -%%---------------------------------------------------------------------- -%% Returns: a sorted list of {X,Y} to delete. -%% Pre: PrevDelElems is sorted. -%%---------------------------------------------------------------------- -erase_bits_at(Board, PrevDelElems, X,Y) -> - C = color_at(Board, X, Y), - erase_bits_at([vert, horiz, slash, backslash],X,Y,C,Board,PrevDelElems). - -erase_bits_at([], _X,_Y,_C,_Board, Elems2Del) -> Elems2Del; -erase_bits_at([Dir|Ds],X,Y,C,Board, Elems2DelAcc) -> - Dx = dx(Dir), - Dy = dy(Dir), - DelElems = lists:append(check_dir(Board, X-Dx,Y-Dy,-Dx,-Dy,C), - check_dir(Board, X,Y,Dx,Dy,C)), - N_in_a_row = length(DelElems), - if N_in_a_row >= 3 -> - erase_bits_at(Ds,X,Y,C,Board, - ordsets:union(lists:sort(DelElems),Elems2DelAcc)); - true -> erase_bits_at(Ds,X,Y,C,Board,Elems2DelAcc) - end. - -dx(vert) -> 0; -dx(horiz) -> 1; -dx(slash) -> 1; -dx(backslash) -> -1. - -dy(vert) -> -1; -dy(horiz) -> 0; -dy(slash) -> -1; -dy(backslash) -> -1. - - -%%---------------------------------------------------------------------- -%% Returns: list of {X,Y} to delete. -%%---------------------------------------------------------------------- -check_dir(Board, X, Y, Dx, Dy, Color) - when X >= 0, X < ?WIDTH, Y >= 0, Y < ?HEIGHT -> - case color_at(Board, X, Y) of - Color -> - [{X,Y} | check_dir(Board, X+Dx, Y+Dy, Dx, Dy, Color)]; - _OtherColor -> - [] - end; -check_dir(_Board, _X, _Y, _Dx, _Dy, _Color) -> []. - -make_box(X, Y, Color) -> - make_box(X, Y, 1, 1, Color). - -%%---------------------------------------------------------------------- -%% Returns: GsObj -%%---------------------------------------------------------------------- -make_box(X, Y, Height, Width, Color) -> - Opts = if Color == black -> [{fg, black}, {fill, black}]; - true -> [{fill, Color}, {fg, white}] end, - gs:create(rectangle, can, [{coords, [{?LEFT + X * ?SIZE, Y * ?SIZE}, - {?LEFT + X * ?SIZE + (?SIZE*Width)-1, - Y * ?SIZE + (?SIZE*Height)-1}]}|Opts]). - -is_fall_ok(_Board, _NewX, NewY) when NewY+2 >= ?HEIGHT -> false; -is_fall_ok(Board, NewX, NewY) -> - case color_at(Board, NewX, NewY+2) of - black -> - true; - _ -> false - end. - -color_at(Board, X, Y) -> - {_GsObj, Color} = board_element(Board, X, Y), - Color. - - -%%---------------------------------------------------------------------- -%% X:0..?WIDTH-1, Y:0..?HEIGHT -%%---------------------------------------------------------------------- -make_board() -> - list_to_tuple(make_list(make_column(), ?WIDTH)). - -board_element(Board, X, Y) -> - element(Y+1, element(X+1, Board)). - -set_board_element(Board, X, Y, NewValue) -> - Col = element(X+1, Board), - NewCol=setelement(Y+1,Col, NewValue), - setelement(X+1, Board, NewCol). - -make_column() -> - list_to_tuple(make_list(black, ?HEIGHT)). - -make_list(_Elem, 0) -> []; -make_list(Elem, N) -> [Elem|make_list(Elem,N-1)]. - -boardcolumn_to_tuple(Board, X) -> - element(X+1, Board). - -set_board_column(Board, X, NewCol) when length(NewCol) == ?HEIGHT -> - setelement(X+1, Board, list_to_tuple(NewCol)). - -show_help() -> - W = gs:create(window, win, [{title, "cols Help"}, {width, 300}, - {height,300}, {map, true}]), - gs:create(label, W, [{x,0},{y,0},{height, 200},{width,300},{justify,center}, - {label, {text, - "cols $Revision: 1.23 $" - "\nby\n" - "Klas Eriksson, eklas@erlang.ericsson.se\n\n" - "Help: Use arrows and space keys.\n" - " Try to get 3 in-a-row.\n" - " More than 3 gives bonus."}}]), - B=gs:create(button, W, [{x,100},{y,250}, {label, {text, "Dismiss"}}]), - receive - {gs, B, click, _, _} -> ok - end, - gs:destroy(W). - -%%====================================================================== -%% 4. Lambdas -%%====================================================================== - -drop(X,Y,Score,Board) -> - case is_fall_ok(Board, X, Y+1) of - true -> drop(X,Y+1,add_score(Score, 1),Board); - false -> {X,Y, Score} - end. - -elems2del([], _Board,Elems2DelAcc) -> Elems2DelAcc; -elems2del([{X,Y}|Checks],Board,Elems2DelAcc) -> - NewElems2DelAcc = ordsets:union(erase_bits_at(Board,Elems2DelAcc,X,Y), - Elems2DelAcc), - elems2del(Checks,Board,NewElems2DelAcc). - -collect_bottom_bits(?WIDTH,_Board) -> []; -collect_bottom_bits(X,Board) -> - case color_at(Board, X, ?HEIGHT-1) of - black -> collect_bottom_bits(X+1,Board); - _AcolorHere -> [X|collect_bottom_bits(X+1,Board)] - end. - -update_check(_Check,[]) -> []; -update_check(Check,[X|Xs]) -> - case lists:member({X, ?HEIGHT-1}, Check) of - true -> update_check(Check,Xs); - false -> [{X, ?HEIGHT-1}|update_check(Check,Xs)] - end. - -org_objs([],_Board) -> []; -org_objs([{X,Y}|XYs],Board) -> - {GsObj, _Color} = board_element(Board, X, Y), - [{GsObj, lists:sort(gs:read(GsObj, coords))}|org_objs(XYs,Board)]. - -update_board([],Board) -> Board; -update_board([{X,Y}|XYs], Board) -> - update_board(XYs,update_screen_element(Board, X, Y, black)). - -put_back([]) -> done; -put_back([{GsObj, Coords}|Objs]) -> - gs:config(GsObj, [{coords, Coords}]), - put_back(Objs). - -updated_cols([], UpdColsAcc) -> UpdColsAcc; -updated_cols([{X,_Y}|XYs], UpdColsAcc) -> - case lists:member(X,UpdColsAcc) of - true -> updated_cols(XYs,UpdColsAcc); - false -> updated_cols(XYs,[X|UpdColsAcc]) - end. - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(EbinFromGsPriv,"../contribs/ebin"). - -dir()-> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv). diff --git a/lib/gs/contribs/cols/cols.gif b/lib/gs/contribs/cols/cols.gif deleted file mode 100644 index 96e7c1ed4a..0000000000 Binary files a/lib/gs/contribs/cols/cols.gif and /dev/null differ diff --git a/lib/gs/contribs/cols/cols.tool b/lib/gs/contribs/cols/cols.tool deleted file mode 100644 index 673c3d8efa..0000000000 --- a/lib/gs/contribs/cols/cols.tool +++ /dev/null @@ -1,5 +0,0 @@ -{version,"0.1"}. -{{tool,"Cols"}, - {start,{cols,start,[]}}, - {icon,"cols.gif"}, - {message,"Cols - The Game"}}. diff --git a/lib/gs/contribs/cols/help.gif b/lib/gs/contribs/cols/help.gif deleted file mode 100644 index 59baef1fec..0000000000 Binary files a/lib/gs/contribs/cols/help.gif and /dev/null differ diff --git a/lib/gs/contribs/cols/highscore.erl b/lib/gs/contribs/cols/highscore.erl deleted file mode 100644 index 94f68a043a..0000000000 --- a/lib/gs/contribs/cols/highscore.erl +++ /dev/null @@ -1,103 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(highscore). --compile([{nowarn_deprecated_function,{gs,button,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,grid,2}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,window,2}}]). - --export([run/2]). - -run(NScore, File) -> - Scores = read_scores(File), - case find_pos(NScore, 1, Scores) of - false -> - display(Scores); - Pos -> - NewScores = new_highscore(Scores, Pos, NScore), - write_scores(NewScores,File), - display(NewScores) - end. - - -new_highscore(Scores, Pos, NScore) -> - Txt = io_lib:format("You entered position ~w", [Pos]), - W = gs:create(window, gs:start(), [{width, 200},{height, 110},{map,true}, - {title, "New Highscore!!!"}]), - gs:create(label, W, [{label, {text, Txt}}, {x, 0}, {y,0}, {align, center}, - {width, 190},{height, 30}]), - Entry = gs:create(entry, W, [{x, 0}, {y, 40}, {height, 30}, {width, 200}]), - Ok = gs:create(button, W, [{label, {text, "Ok"}}, {x, 40}, {y, 75}]), - receive - {gs, Ok, click, _,_} -> - T = gs:read(Entry, text), - gs:destroy(W), - lists:sublist(lists:reverse( - lists:keysort(1, [{NScore, T} | Scores])), 1, 10) - end. - - - -read_scores(File) -> - case file:read_file(File) of - {ok, Bin} -> binary_to_term(Bin); - {error, _Reason} -> - mk_empty_high(10) - end. - -mk_empty_high(0) -> []; -mk_empty_high(N) -> [{N,"Erlang"}|mk_empty_high(N-1)]. - -find_pos(_NScore, _N, []) -> false; -find_pos(NScore, N, [{Score, _Name} | Scores]) when Score > NScore -> - find_pos(NScore, N+1, Scores); -find_pos(_NScore, N, _) -> N. - -write_scores(Scores,File) -> - file:write_file(File, term_to_binary(Scores)). - -display(Scores) -> - Win = gs:window(gs:start(), [{width, 300},{height, 250},{map,true}, - {title, "Highscores"}]), - {W,H} = gs:read(Win,{font_wh,{{screen,12},"aaaaaaa"}}), - G = gs:grid(Win,[{rows,{1,11}},{columnwidths,[W,4*W]},{hscroll,false}, - {width, 300},{height, 220},{vscroll,false}, - {cellheight,H+2},{font,{screen,12}}]), - insert_scores(G,2,Scores), - Ok = gs:button(Win, [{label, {text, "OK"}}, {x, 100}, {y, 220}]), - receive - {gs, Ok, click, _,_} -> gs:destroy(Win), - ok - end. - -insert_scores(Grid,_N,[]) -> - gs:create(gridline,Grid,[{row,1},{font,{screen,bold,12}}, - {text,{1,"SCORE"}},{text,{2,"NAME"}}]); - -insert_scores(Grid,Row,[{Score,Name}|Ss]) -> - gs:create(gridline,Grid,[{row,Row},{text,{1,io_lib:format("~w",[Score])}}, - {text,{2,Name}}]), - insert_scores(Grid,Row+1,Ss). - diff --git a/lib/gs/contribs/ebin/.gitignore b/lib/gs/contribs/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/gs/contribs/mandel/Makefile b/lib/gs/contribs/mandel/Makefile deleted file mode 100644 index b806cc7801..0000000000 --- a/lib/gs/contribs/mandel/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - mandel - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = mandel - -EXTRA_FILES= $(TOOLNAME).html -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -$(EBIN)/help.gif: help.gif - $(gen_verbose)rm -f $@ - $(V_at)cp help.gif $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/mandel/bitmaps" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/mandel/bitmaps" - $(INSTALL_DIR) "$(RELSYSDIR)/mandel" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/mandel" - -release_docs_spec: diff --git a/lib/gs/contribs/mandel/mandel.erl b/lib/gs/contribs/mandel/mandel.erl deleted file mode 100644 index e6061ba77d..0000000000 --- a/lib/gs/contribs/mandel/mandel.erl +++ /dev/null @@ -1,351 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(mandel). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,image,2}}, - {nowarn_deprecated_function,{gs,start,0}}]). --author('(mbj,eklas)@erlang.ericsson.se'). - -%% User's interface --export([start/0,start/1]). - -%% Internal exports: --export([start_client/2,refresher/1,start_server/1,respond/2]). - -%%%----------------------------------------------------------------- -%%% Distributed Mandelbrot program. -%%% Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines) -%%% Rewritten in Erlang by Klas Eriksson and Martin Björklund. -%%%----------------------------------------------------------------- - -%% unix>erl -sname foo (all nodes will get the same name) -%% (foo@data)1>mandel:start([{hosts,["computer1","computer2"]},{window,400}]). - -%% unix>erl -%% 1> mandel:start(). - --record(state,{image,width,height,xmax,ymax,range, - maxiter,colortable,zoomstep}). --record(job,{left,right,ymin,ymax,height,width,maxiter,data=[]}). --define(JOBWIDTH,10). - -%%----------------------------------------------------------------- -%% This is the client start function. -%%----------------------------------------------------------------- -start() -> - start([]). - -%%---------------------------------------------------------------------- -%% Option is list of Option. Option is: -%% {xmax,float()}|{ymax,float()}|{range,float()}| -%% {maxiter,integer()}|{window,integer()}|{zoomstep,float()}| -%% {hosts,(list of string())|all_found_nodes} -%%---------------------------------------------------------------------- -start(Opts) -> - Nodes1 = nodes(), - Nodes = case get_option(hosts,Opts,all_found_nodes) of - all_found_nodes when Nodes1 == [] -> - N = [node()], - spawn(mandel,start_server,[N]), - N; - all_found_nodes -> - start_nodes(dir(),Nodes1), - Nodes1; - Hosts -> - start_slaves(Hosts), - start_nodes(dir(),Nodes1), - Nodes1 - end, - spawn(mandel,start_client,[Opts,Nodes]). - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(EbinFromGsPriv,"../contribs/ebin"). - -dir()-> - GsPrivDir = code:priv_dir(gs), - filename:join(GsPrivDir,?EbinFromGsPriv). - - -start_slaves([]) -> ok; -start_slaves([Host|Hs]) -> - {ok,Name}=slave:start(Host), - io:format("host ~p is up~n", [Name]), - start_slaves(Hs). - -start_nodes(_Dir,[]) -> ok; -start_nodes(Dir,[Node|Nodes]) -> - rpc:call(Node,code,add_path,[Dir]), % hack? should be done in .erlang - spawn_link(Node,mandel,start_server,[[node()]]), - io:format("started mandelserver at node: ~p~n", [Node]), - start_nodes(Dir,Nodes). - -start_client(Opts,Nodes) -> - Wt = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH, - Ht = get_option(window,Opts,100) div ?JOBWIDTH * ?JOBWIDTH, - S=gs:start(), - Win=gs:create(window,win1,S,[{title,"Mandel"},{width,Wt-1},{height,Ht-1}, - {configure,true}]), - Canvas=gs:create(canvas,can1,Win,[{width,Wt},{height,Ht}]), - Image=gs:image(Canvas,[{buttonpress,true}]), - MaxIters = get_option(maxiter,Opts,100), - timer:apply_after(8000,mandel,refresher,[Image]), - CT = make_color_table(MaxIters), - State2=#state{image=Image,width=Wt,height=Ht, - xmax=try_random(get_option(xmax,Opts,2),-2,2), - ymax=try_random(get_option(ymax,Opts,2),-2,2), - range=try_random(get_option(range,Opts,4),0,4), - maxiter=MaxIters,colortable=CT, - zoomstep=get_option(zoomstep,Opts,1.7)}, - ToDo = make_jobs(State2), - gs:config(Win,[{map,true}]), - main(State2, [], Nodes, ToDo). - -try_random(random,Low,High) -> - random:uniform()*(High-Low)+Low; -try_random(Float,_Low,_High) when is_number(Float) -> Float. - - -%%----------------------------------------------------------------- -%% Distribute work to the nodes. When a node returns, that -%% node is the first to be used if there's any job left. -%%----------------------------------------------------------------- -main(State, [], PassiveNodes, []) -> - wait_event(State,[],PassiveNodes,[]); -main(State, ActiveNodes, PassiveNodes, []) -> - % No jobs left, but some nodes are still active. - % Wait_Event for their results - wait_event(State,ActiveNodes,PassiveNodes,[]); -main(State, ActiveNodes, [Node|PassiveNodes], [Job|ToDo]) -> - % We have work to do, and at least one passive node. - % Let him do it. - distribute_job(Node, Job), - main(State, [Node|ActiveNodes], PassiveNodes, ToDo); -main(State, ActiveNodes, [], ToDo) -> - % We have work to do, but all nodes are active. - _Node = wait_event(State,ActiveNodes,[],ToDo). - -wait_event(State,ActiveNodes,PassiveNodes,ToDo) -> - receive - {calculation_done, {Node, Job}} -> - if % a small hack. we want to discard data for old pictures - Job#job.ymax==State#state.ymax -> - draw(State, Node, Job); - true -> true - end, - main(State,lists:delete(Node,ActiveNodes),[Node|PassiveNodes],ToDo); - {gs,_Img,buttonpress,_Data,[_Butt,X,Y|_]} -> - #state{width=W,height=H,ymax=Ymax,xmax=Xmax,range=R,zoomstep=ZS} = - State, - RX = Xmax-R+(X/W)*R, - RY = Ymax-R+(1-(Y/H))*R, - R2 = R/ZS, - Xmax2 = RX + R2/2, - Ymax2 = RY + R2/2, - State2 = State#state{xmax=Xmax2,ymax=Ymax2,range=R2}, - io:format("{xmax,~w},{ymax,~w},{range,~w}~n", [Xmax2,Ymax2,R2]), - ToDo2=make_jobs(State2), - main(State2,ActiveNodes,PassiveNodes,ToDo2); - {gs,_Win,destroy,_,_} -> - kill_nodes(lists:append(ActiveNodes,PassiveNodes)); - {gs,_Win,configure,_Data,[W,H|_]} - when State#state.width==W+1, State#state.height==H+1-> - main(State,ActiveNodes,PassiveNodes,ToDo); - {gs,_Win,configure,_Data,[W|_]} -> - gs:config(can1,[{width,W},{height,W}]), - gs:config(win1,{configure,false}), - gs:config(win1,[{width,W-1},{height,W-1}]), - gs:config(win1,{configure,true}), - State2 = State#state{width=W,height=W}, - ToDo2=make_jobs(State2), - main(State2,ActiveNodes,PassiveNodes,ToDo2) - end. - -kill_nodes([]) -> - done; -kill_nodes([Node|Nodes]) -> - exit(rpc:call(Node,erlang,whereis,[mandel_server]),kill), - kill_nodes(Nodes). - - -distribute_job(Node, Job) -> - {mandel_server, Node} ! {mandel_job, {self(), Job}}. - -draw(#state{image=Image, width=Wt, height=Ht, xmax=Xmax, - maxiter=MI,colortable=ColorTable,range=R}, Node, Job) -> - #job{left=Left,data=Data}=Job, - io:format("Got data from node ~30w~n", [Node]), -%% PixelX = K * RealX + M -%% 0 = K * Xmin + M -%% Width-1= K * Xmax + M - K=(1-Wt)/-R, - M=Wt-1-K*Xmax, - Xbegin = round(Left*K+M), - draw_cols(Image, Xbegin, Ht, lists:reverse(Data),MI,ColorTable). - -draw_cols(Image, X, Ht, [H|T],MaxIter,ColorTable) -> - draw_col(Image, X, 0, H,MaxIter,ColorTable), - draw_cols(Image, X+1, Ht, T,MaxIter,ColorTable); -draw_cols(_Image, _X, _, [],_MaxIter,_ColorTable) -> - done. - -draw_col(_Image, _X,_Y,[{no_first_color,0}],_MaxIter,_ColorTable) -> - done; -draw_col(Image, X,Y,[{Color,1}|T],MaxIter,ColorTable) -> - gs:config(Image,[{pix_val,{{X,Y}, - element(Color+1,ColorTable)}}]), - draw_col(Image, X,Y+1,T,MaxIter,ColorTable); -draw_col(Image, X,Y,[{Color,Height}|T],MaxIter,ColorTable) -> - gs:config(Image,[{pix_val,{{{X,Y},{X+1,Y+Height}}, - element(Color+1,ColorTable)}}]), - draw_col(Image, X,Y+Height,T,MaxIter,ColorTable). - -make_jobs(#state{width=W,height=H,range=R, - xmax=Xmax,ymax=Ymax,maxiter=MI}) -> - make_jobs(Xmax-R,Xmax,Ymax-R,Ymax,H,W,MI). - -make_jobs(Xmin,Xmax,Ymin,Ymax,Ht,Wt,MaxIter) -> - NoJobs = Wt/?JOBWIDTH, % Each job is ?JOBWIDTH pixel-col - DX = (Xmax - Xmin)/NoJobs, - make_jobs(DX,Xmin,Xmax,#job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt/NoJobs, - maxiter=MaxIter},[]). - -make_jobs(DX,Left,Xmax,JobSkel,Res) when Left =< Xmax -> - Right = Left + DX, - Job = JobSkel#job{left=Left,right=Right}, - make_jobs(DX,Right,Xmax,JobSkel,[Job | Res]); -make_jobs(_DX,_Left,_Xmax,_JobSkel,Res) -> Res. - -%%---------------------------------------------------------------------- -%% A small process that refreshes the screen now and then. -%%---------------------------------------------------------------------- -refresher(Image) -> - gs:config(Image,flush), - timer:apply_after(8000,mandel,refresher,[Image]). - -%%----------------------------------------------------------------- -%% This is the server start function. -%%----------------------------------------------------------------- -start_server([ClientNode]) -> - register(mandel_server, self()), - erlang:monitor_node(ClientNode, true), - server_loop(). - -server_loop() -> - receive - {mandel_job, {Pid, Job}} -> - spawn_link(mandel, respond, [Pid, Job]), - server_loop() - end. - -respond(Pid, Job) -> - Data = do_job(Job), - Pid ! {calculation_done, {node(), Data}}. - -do_job(Job) -> - calculate_area(Job). - -calculate_area(Job) -> - #job{ymin=Ymin,ymax=Ymax,height=Ht,width=Wt,left=Xmin,right=Xmax}=Job, - Job#job{data=x_loop(0,[],Wt,(Xmax-Xmin)/Wt,(Ymax-Ymin)/Ht,Xmin,Job)}. - -x_loop(IX,Res,Wt,Dx,Dy,X,Job) when IX < Wt -> - #job{ymin=Ymin,height=Ht,maxiter=MaxIter}=Job, - Cols = y_loop(0,Ht,[],MaxIter,Dy,X,Ymin,no_first_color,0), - x_loop(IX+1,[Cols|Res],Wt,Dx,Dy,X+Dx,Job); -x_loop(_,Res,_,_,_,_,_) -> - Res. - -y_loop(IY,Ht,Res,MaxIter,Dy,X,Y,PrevColor,NprevColor) when IY < Ht -> - Color = color_loop(1,MaxIter,0,0,0,0,X,Y), - if - Color == PrevColor -> - y_loop(IY+1,Ht,Res,MaxIter,Dy,X,Y+Dy,PrevColor,NprevColor+1); - true -> - y_loop(IY+1,Ht,[{PrevColor,NprevColor}|Res],MaxIter, - Dy,X,Y+Dy,Color,1) - end; - -y_loop(_,_,Res,_,_,_,_,PC,N) -> - [{PC,N}|Res]. - -color_loop(Color,MaxIter,Za,Zb,Za2,Zb2,X,Y) - when Za2 + Zb2 < 4, Color < MaxIter-> - Ztmp = Za2 - Zb2 + X, - ZbN = 2 * Za * Zb + Y, - color_loop(Color+1,MaxIter,Ztmp,ZbN,Ztmp * Ztmp,ZbN * ZbN,X,Y); -color_loop(MaxIter,MaxIter,_Za,_Zb,_Za2,_Zb2,_X,_Y) -> - 0; % black -color_loop(Color,_,_,_,_,_,_,_) -> - Color. - -%%---------------------------------------------------------------------- -%% The "colormodel". -%%---------------------------------------------------------------------- -make_color_table(MaxColors) -> - list_to_tuple([{0,0,0}|colors(MaxColors)]). - -colors(Ncolors) -> - {A,B,C}=erlang:now(), - random:seed(A,B,C), - Colors = random_colors(Ncolors), - Colors2 = best_insert([hd(Colors)],tl(Colors)), - Colors2. - -random_colors(0) -> []; -random_colors(N) -> - R = random:uniform(256)-1, - G = random:uniform(256)-1, - B = random:uniform(256)-1, - [{R,G,B}|random_colors(N-1)]. - -best_insert(Sorted,[RGB|Unsorted]) -> - best_insert(insert_at(best_pos(RGB,Sorted),RGB,Sorted),Unsorted); -best_insert(Sorted,[]) -> Sorted. - -insert_at(1,Elem,L) -> [Elem|L]; -insert_at(N,Elem,[H|T]) -> [H|insert_at(N-1,Elem,T)]. - -best_pos(RGB, Sorted) -> - D = distances(RGB,Sorted), - pos_for_smallest_distance(D,1,1000,-1). - -pos_for_smallest_distance([],_CurPos,_SmallestDist,Pos) -> Pos; -pos_for_smallest_distance([Dist|T],CurPos,SmallDist,_Pos) - when Dist < SmallDist -> - pos_for_smallest_distance(T,CurPos+1,Dist,CurPos); -pos_for_smallest_distance([_|T],CurPos,Smallest,Pos) -> - pos_for_smallest_distance(T,CurPos+1,Smallest,Pos). - -distances(_RGB,[]) -> - []; -distances({R,G,B},[{R2,G2,B2}|T]) -> - [lists:max([abs(R-R2),abs(G-G2),abs(B-B2)])|distances({R,G,B},T)]. - -get_option(Option, Options, Default) -> - case gs:assq(Option, Options) of - {value, Val} -> Val; - false -> Default - end. diff --git a/lib/gs/contribs/mandel/mandel.gif b/lib/gs/contribs/mandel/mandel.gif deleted file mode 100644 index 49ed1985cb..0000000000 Binary files a/lib/gs/contribs/mandel/mandel.gif and /dev/null differ diff --git a/lib/gs/contribs/mandel/mandel.html b/lib/gs/contribs/mandel/mandel.html deleted file mode 100644 index f69cfa3c6a..0000000000 --- a/lib/gs/contribs/mandel/mandel.html +++ /dev/null @@ -1,74 +0,0 @@ - - - - - - - - - -

Distributed Mandelbrot program

- -

Originally written i C++/rpc/lwp/interviews by Klas Eriksson.(1200 lines) -
-Rewritten in Erlang by Klas Eriksson and Martin Björklund.

- -

What is the Mandelbrot -function?

- -

A small manual

- -
    -
  • Try starting erlang in distributed mode. The mandel program will use
    -all connected nodes for mandel calculations!
    • - -
  • Resizing the window will restart the calculation.
    • - -
  • Press left mouse button to zoom.
    • -
- -

mandel:start(list of Option) can be used to give the program -different options.

- -


-Available options are:

- -
    -
  • {xmax,float()}
    • - -
  • {ymax,float()}
    • - -
  • {range,float()}|
    • - -
  • {maxiter,integer()}
    • - -
  • {window,integer()}
    • - -
  • {zoomstep,float()}
    • - -
  • {hosts,(list of string())|all_found_nodes}
    • -
- -


-

- - - diff --git a/lib/gs/contribs/mandel/mandel.tool b/lib/gs/contribs/mandel/mandel.tool deleted file mode 100644 index b59941268e..0000000000 --- a/lib/gs/contribs/mandel/mandel.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Mandel"}, - {start,{mandel,start,[]}}, - {icon,"mandel.gif"}, - {message,"Mandelbrot"}, - {html,"../mandel/mandel.html"}}. diff --git a/lib/gs/contribs/othello/Makefile b/lib/gs/contribs/othello/Makefile deleted file mode 100644 index 8a66e17ec5..0000000000 --- a/lib/gs/contribs/othello/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN)/contribs - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - othello \ - othello_adt \ - othello_board - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(TARGET_TOOLBOX_FILES) - -TOOLNAME = othello - -EXTRA_FILES= -TOOLBOX_FILES= $(TOOLNAME).tool $(TOOLNAME).gif -TARGET_TOOLBOX_FILES= $(TOOLBOX_FILES:%=$(EBIN)/%) -BITMAPS= priv/marker.bm priv/square.bm - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/$(TOOLNAME).gif: $(TOOLNAME).gif - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).gif $@ - -$(EBIN)/$(TOOLNAME).tool: $(TOOLNAME).tool - $(gen_verbose)rm -f $@ - $(V_at)cp $(TOOLNAME).tool $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/othello" - $(INSTALL_DATA) $(ERL_FILES) $(EXTRA_FILES) "$(RELSYSDIR)/othello" - $(INSTALL_DIR) "$(RELSYSDIR)/othello/priv" - $(INSTALL_DATA) $(BITMAPS) $(TOOLBOX_FILES) "$(RELSYSDIR)/othello/priv" - -release_docs_spec: - diff --git a/lib/gs/contribs/othello/othello.erl b/lib/gs/contribs/othello/othello.erl deleted file mode 100644 index c6ad0a76ec..0000000000 --- a/lib/gs/contribs/othello/othello.erl +++ /dev/null @@ -1,237 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(othello). --export([start/0,new_game/4,start1/5]). - - - -%%---------------------------------------------------------------------- -%% The Othello program now uses the gs graphical package instead of the -%% pxw package. See module othello_board for details -%% -%%---------------------------------------------------------------------- - - -start() -> othello_board:start(). - -new_game(Computer,Player,Depth,Init) -> - spawn_link(othello,start1,[self(),Computer,Player,Depth,Init]). - -start1(Win,Computer,Player,Depth,Init) -> - Board = othello_adt:new(t), - random:seed(), - init_display(Board,Win,Init), - play(Computer,Player,Board,Depth,Win,1). - -play(Computer,Player,Board,Depth,Win,NoDs) -> - tell_win(Win,Computer,Player), - case catch continue(Player,Board) of - {game_over,Result} -> - game_over(Board,Player,Result,Win); - {omit_draw,Player} -> - omit(Player,Win), - play(Computer,swap(Player),Board,Depth,Win,NoDs); - ok -> - Draw = choose_draw(Computer,Player,Board,Depth,Win,NoDs), - Win ! {self(),draw,Draw}, - Board1 = othello_adt:set(Draw,Player,Board), - display(Board1,Board,Win), - play(Computer,swap(Player),Board1,Depth,Win,NoDs+1) - end. - -continue(Player,Board) -> - Draws = game_over(Player,Board), - not_allowed(Draws,Player), - ok. - -choose_draw(Computer,Computer,Board,Depth,_Win,NoDs) -> % Depth > 0 !! - {Draw,_Value} = alpha_beta(Depth,Board,-11000,11000,Computer,NoDs), -% io:format('Choosen draw is {~w,~w} : (~w)~n', -% [othello_adt:col(Draw),othello_adt:row(Draw),Value]), -% io:format('=====================~n',[]), - Draw; -choose_draw(Computer,Player,Board,Depth,Win,NoDs) -> - receive - {Win,position,Draw} -> - flush(Win), - case othello_adt:is_draw(Draw,Player,Board) of - false -> - Win ! {self(),illegal_draw,Draw}, - choose_draw(Computer,Player,Board,Depth,Win,NoDs); - true -> - Draw - end - end. - -flush(Win) -> - receive - {Win,position,_} -> - flush(Win) - after 1 -> - true - end. - -tell_win(Win,Computer,Player) -> - Win ! {self(),player,Computer,Player}, - receive - {Win,go_on_play} -> true - end. - -alpha_beta(0,Board,_,_,Player,_) -> - {-1,othello_adt:evaluate_board(Player,Board)}; -alpha_beta(Depth,Board,Alpha,Beta,Player,NoDs) -> - case compute(Player,Board,NoDs) of - [] -> - Player1 = swap(Player), - case compute(Player1,Board,NoDs) of - [] -> - dead_lock(Board,Player); - PosDraws1 -> - choose(PosDraws1,Board,Depth-1,-Beta,-Alpha,-1, - Player1,NoDs) - end; - PosDraws -> - choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs) -% A = choose(PosDraws,Board,Depth-1,-Beta,-Alpha,-1,Player,NoDs), -% io:format('Alpha-Beta (~w) ==> ~w~n',[Depth,A]), -% A - end. - -choose([Draw|Draws],Board,Depth,Alpha,Beta,Record,Player,NoDs) -> - Player1 = swap(Player), - Board1 = othello_adt:set(Draw,Player,Board), -% io:format('Alpha <~w> Beta <~w> ~n',[Alpha,Beta]), - {_,Value} = alpha_beta(Depth,Board1,Alpha,Beta,Player1,NoDs+1), - Value1 = -Value, - cutoff(Draw,Value1,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs); -choose([],_,_,Alpha,_,Draw,_,_) -> - {Draw,Alpha}. - -cutoff(Draw,Value,_,_,Beta,_,_,_,_,_) when Value >= Beta -> - {Draw,Value}; -cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,_,Player,NoDs) - when Alpha < Value, Value < Beta -> - choose(Draws,Board,Depth,Value,Beta,Draw,Player,NoDs); -cutoff(Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs) - when Value == Alpha, NoDs < 13 -> - choose(Draws,Board,Depth,Alpha,Beta,random_choice(Draw,Record), - Player,NoDs); -cutoff(_Draw,Value,Depth,Alpha,Beta,Draws,Board,Record,Player,NoDs) - when Value =< Alpha -> - choose(Draws,Board,Depth,Alpha,Beta,Record,Player,NoDs). - -compute(Player,Board,NoOfDraws) when NoOfDraws < 13 -> - case othello_adt:possible_draws(Player,Board,begin_play) of - [] -> - othello_adt:possible_draws(Player,Board,playing); - Draws -> - Draws - end; -compute(Player,Board,_) -> - othello_adt:possible_draws(Player,Board,playing). - -%%---------------------------------------------------------- -%% Randomly choose between two draws with the same value. -%%---------------------------------------------------------- - -random_choice(Draw,Draw1) -> - case random:uniform(2) of - 1 -> - Draw; - 2 -> - Draw1 - end. - -dead_lock(Board,Player) -> - case win_or_loose(Board,Player) of - 0 -> {-1,0}; - Value when Value > 0 -> {-1,10000}; - _ -> {-1,-10000} - end. - -win_or_loose(Board,Player) -> - Player1 = swap(Player), - othello_adt:pieces(Player,Board) - othello_adt:pieces(Player1,Board). - -game_over(Player,Board) -> - case othello_adt:possible_draws(Player,Board,playing) of - [] -> - Player1 = swap(Player), - case othello_adt:possible_draws(Player1,Board,playing) of - [] -> - throw({game_over,{{Player,othello_adt:pieces(Player,Board)}, - {Player1,othello_adt:pieces(Player1,Board)}}}); - _ -> - [] % Player`s Draws !! - end; - Draws -> - Draws - end. - -game_over(_Board,_Player,Result,Win) -> - Win ! {self(),game_over,white_res(Result),black_res(Result)}. - -white_res({{white,Res},_}) -> Res; -white_res({_,{white,Res}}) -> Res. - -black_res({{black,Res},_}) -> Res; -black_res({_,{black,Res}}) -> Res. - -not_allowed([],Player) -> - throw({omit_draw, Player}); -not_allowed(_,_Player) -> - ok. - -omit(Player,Win) -> - Win ! {self(),omit_draw,Player}, - receive - {Win,continue} -> - ok - end. - -init_display(_Board,_Win,first_time) -> - true; -init_display(Board,Win,_) -> - display(Board,Win). - -display(Board,Win) -> - All = othello_adt:all_pos(Board), - display1(All,Win), - Win ! {self(),score,othello_adt:pieces(white,Board), - othello_adt:pieces(black,Board)}. - -display(Board,OldB,Win) -> - Diff = othello_adt:diff(Board,OldB), - display1(Diff,Win), - Win ! {self(),score,othello_adt:pieces(white,Board), - othello_adt:pieces(black,Board)}. - -display1([{Pos,Colour}|Diff],Win) -> - Win ! {self(),new_mark,Pos,Colour}, - display1(Diff,Win); -display1(_,_) -> - true. - -swap(white) -> black; -swap(black) -> white. - - diff --git a/lib/gs/contribs/othello/othello.gif b/lib/gs/contribs/othello/othello.gif deleted file mode 100644 index 5970c50209..0000000000 Binary files a/lib/gs/contribs/othello/othello.gif and /dev/null differ diff --git a/lib/gs/contribs/othello/othello.tool b/lib/gs/contribs/othello/othello.tool deleted file mode 100644 index 47550a581d..0000000000 --- a/lib/gs/contribs/othello/othello.tool +++ /dev/null @@ -1,6 +0,0 @@ -{version,"0.1"}. -{{tool,"Othello"}, - {start,{othello,start,[]}}, - {icon,"othello.gif"}, - {message,"Othello - The Game"}, - {html,"http://www.armory.com/~iioa/othguide.html"}}. diff --git a/lib/gs/contribs/othello/othello_adt.erl b/lib/gs/contribs/othello/othello_adt.erl deleted file mode 100644 index e69c1c4d72..0000000000 --- a/lib/gs/contribs/othello/othello_adt.erl +++ /dev/null @@ -1,540 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(othello_adt). --compile(export_all). -%%------------------------------------------------------- -%% Use three main states for the strategy: -%% -%% BeginPlay: Stay in the inner square as long as possible. -%% Use the possible_draws/3. -%% -%% MiddlePlay: Try to choose stable markers (?) -%% Use stable/3 -%% -%% EndPlay: Try to flip as many markers as possible -%% -%% The transition from Begin to Middle is obvious. From Middle -%% to End however, is can be discussed. -%%------------------------------------------------------- - -test(N,B) -> - X=new(B), - statistics(wall_clock), - test0(N,X), - {_,T} = statistics(wall_clock), - {time_was,T/N}. - - -test0(0,_) -> true; -test0(N,X) -> - possible_draws(black,X,begin_play), - test0(N-1,X). - -%%------------------------------------------------------- -%% new/1 - returns a new board -%% -%% Uses a tuple for storing the board -%%------------------------------------------------------- - -new(B) -> - Board = mk_board(B), - {ordsets:from_list([18,19,20,21,26,29,34,37,42,43,44,45]),Board}. - -mk_board(t) -> - Tup = list_to_tuple(gen_list(64,grey)), - Tup1 = setelement(28+1, Tup, white), - Tup2 = setelement(35+1, Tup1, white), - Tup3 = setelement(27+1, Tup2, black), - gen_score_board(), - setelement(36+1, Tup3, black). - -gen_list(0,_) -> []; -gen_list(I,Def) -> [Def|gen_list(I-1,Def)]. - -gen_score_board() -> put(score,list_to_tuple(gen_list(64,0))). - -%%------------------------------------------------------- -%% pos(Col,Row) - returns a position describing column -%% and row. -%% Col and Row have the range 1 - 8. -%%------------------------------------------------------- - -pos(Col,Row) -> ((Row - 1) bsl 3) + (Col - 1). - -%%------------------------------------------------------- -%% col(Pos) - returns the column of the Pos position -%%------------------------------------------------------- - -col(Pos) -> (Pos band 7) + 1. - -%%------------------------------------------------------- -%% row(Pos) - returns the row of the Pos position -%%------------------------------------------------------- - -row(Pos) -> (Pos bsr 3) + 1. - -%%------------------------------------------------------- -%% is_draw(Pos,Colour,Board) - returns true if Pos is a -%% correct draw. -%%------------------------------------------------------- - -is_draw(Pos,Colour,{Bset,Board}) -> - case ordsets:is_element(Pos,Bset) of - true -> - case catch is_good(Colour,Pos,Board) of - true -> - true; - _ -> - false - end; - _ -> - false - end. - -%%------------------------------------------------------- -%% set(Pos,Colour,Board) - returns an updated board -%%------------------------------------------------------- - -set(Pos,Colour,{Bset,Board}) -> - case ordsets:is_element(Pos,Bset) of - true -> - NewBoard = setelement(Pos+1,Board,Colour), - Empty = empty_neighbour(Pos,NewBoard), - NewBset = ordsets:union(Empty,ordsets:del_element(Pos,Bset)), - turn(Colour,Pos,{NewBset,NewBoard}); - _ -> - {error,invalid_position} - end. - -empty_neighbour(Pos,Board) -> - ordsets:from_list(empty_neighbour(Pos,Board,deltas())). - -empty_neighbour(_,_,[]) -> []; -empty_neighbour(Pos,Board,[H|T]) -> - case is_empty(Pos+H,dir(Pos,H),Board) of - true -> [Pos+H|empty_neighbour(Pos,Board,T)]; - _ -> empty_neighbour(Pos,Board,T) - end. - -is_empty(_,false,_) -> false; -is_empty(X,_,_Board) when X<0 -> false; -is_empty(X,_,_Board) when X>63 -> false; -is_empty(X,_,Board) -> - case element(X+1,Board) of - grey -> true; % Empty - _ -> false - end. - -%%------------------------------------------------------- -%% get(Pos,Board) - returns the contents in Pos -%%------------------------------------------------------- - -get(Pos,{_Bset,Board}) -> element(Pos+1,Board). - -%%------------------------------------------------------- -%% pieces(Colour,Board) - returns the number of Colour -%% pieces. -%%------------------------------------------------------- - -pieces(Colour,{_Bset,Board}) -> - pieces(Colour,Board,0,0). - -pieces(Colour,Board,Pos,Count) when Pos < 64 -> - case element(Pos+1,Board) of - Colour -> - pieces(Colour,Board,Pos+1,Count+1); - _ -> - pieces(Colour,Board,Pos+1,Count) - end; -pieces(_,_,_,Count) -> - Count. - -%%------------------------------------------------------- -%% possible_draws(Colour, Board, State) -%% -%% Returns a list of possible draws regarding the current -%% strategy state. -%%------------------------------------------------------- - -possible_draws(Colour,{Bset,Board},begin_play) -> - Dset = ordsets:intersection(Bset,inner_square()), - possible_draws_0(Colour,Dset,Board); -possible_draws(Colour,{Bset,Board},_) -> - possible_draws_0(Colour,Bset,Board). - -possible_draws(Colour,{Bset,Board}) -> - possible_draws_0(Colour,Bset,Board). - -possible_draws_0(_,[],_) -> []; -possible_draws_0(Colour,[H|T],Board) -> - case catch is_good(Colour,H,Board) of - true -> [H|possible_draws_0(Colour,T,Board)]; - false -> possible_draws_0(Colour,T,Board) - end. - - -%%------------------------------------------------------- -%% evaluate_board(Colour,Board) - returns the value of -%% the board from Colours -%% point of view. -%%------------------------------------------------------- - -evaluate_board(Colour,{_Bset,Board}) -> - Score = get(score), % Initialized (zeroed) score board !! - Colour1 = swap(Colour), - Score1 = eval_board(Colour,Colour1,Score,Board,0), - Score2 = cnt_corner(0,Score1,Board,Colour,Colour1), - Score3 = cnt_corner(7,Score2,Board,Colour,Colour1), - Score4 = cnt_corner(56,Score3,Board,Colour,Colour1), - Score5 = cnt_corner(63,Score4,Board,Colour,Colour1), - count(Score5,0). -% A = count(Score5,0), -% io:format('Score = ~w~n',[A]), -% A. - -eval_board(MyCol,OtCol,Score,Board,Pos) when Pos < 64 -> - case element(Pos+1,Board) of - MyCol -> - Score1 = setelement(Pos+1,Score,score(Pos)), - eval_board(MyCol,OtCol,Score1,Board,Pos+1); - OtCol -> - Score1 = setelement(Pos+1,Score,-score(Pos)), - eval_board(MyCol,OtCol,Score1,Board,Pos+1); - _ -> - eval_board(MyCol,OtCol,Score,Board,Pos+1) - end; -eval_board(_,_,Score,_,_) -> - Score. - -cnt_corner(Corner,Score,Board,MyCol,OtCol) -> - case element(Corner+1,Board) of - MyCol -> - cnt_corn(Corner,setelement(Corner+1,Score,50), - Board,50,MyCol); - OtCol -> - cnt_corn(Corner,setelement(Corner+1,Score,-50), - Board,-50,OtCol); - _ -> - Score - end. - -cnt_corn(0,Score,Board,Value,Colour) -> - Score1 = cnt_corn(0,1,8,Score,Board,Value,Colour), - cnt_corn(0,8,1,Score1,Board,Value,Colour); -cnt_corn(7,Score,Board,Value,Colour) -> - Score1 = cnt_corn(7,-1,8,Score,Board,Value,Colour), - cnt_corn(7,8,-1,Score1,Board,Value,Colour); -cnt_corn(56,Score,Board,Value,Colour) -> - Score1 = cnt_corn(56,1,-8,Score,Board,Value,Colour), - cnt_corn(56,-8,1,Score1,Board,Value,Colour); -cnt_corn(63,Score,Board,Value,Colour) -> - Score1 = cnt_corn(63,-1,-8,Score,Board,Value,Colour), - cnt_corn(63,-8,-1,Score1,Board,Value,Colour). - -cnt_corn(Pos,Dir,LineDir,Score,Board,Value,Colour) -> - case dir(Pos,Dir) of - Dir -> - NextEdge = Pos+Dir, - case element(NextEdge+1,Board) of - Colour -> - Score1 = setelement(NextEdge+1,Score,Value), - Score2 = cnt_line(NextEdge,LineDir,Score1,Board, - Colour,Value), - cnt_corn(NextEdge,Dir,LineDir,Score2,Board,Value,Colour); - _ -> - Score - end; - _ -> - Score - end. - -cnt_line(Pos,Dir,Score,Board,Colour,Value) -> - case dir(Pos,Dir) of - Dir -> - OnLinePos = Pos+Dir, - case element(OnLinePos+1,Board) of - Colour -> - Score1 = setelement(OnLinePos+1,Score,Value), - cnt_line(OnLinePos,Dir,Score1,Board,Colour,Value); - _ -> - Score - end; - _ -> - Score - end. - -count(Score,Pos) when Pos < 64 -> - element(Pos+1,Score) + count(Score,Pos+1); -count(_,_) -> - 0. - -swap(white) -> black; -swap(black) -> white. - -%%------------------------------------------------------- -%% stable(Colour,Pos,Board) - returns a value 0-8 -%% -%% A high value is regarded as more stable than a lower one. -%% The stability means how many "friendly" neighbours there -%% are, i.e markers of the same colour. Neighbours positions -%% outside the board are regarded as friendly. -%%------------------------------------------------------- - -stable(Colour,Pos,{_,Board}) -> - stable(deltas(),Colour,Pos,Board). - -stable([],_,_,_) -> 0; -stable([H|T],Colour,Pos,Board) -> - stable_val(Colour,Pos,H,Board) + stable(T,Colour,Pos,Board). - -stable_val(_,H,D,_) when H+D<0 -> 1; -stable_val(_,H,D,_) when H+D>63 -> 1; -stable_val(black,H,D,Board) -> - case element((H+D)+1,Board) of - black -> 1; - _ -> 0 - end; -stable_val(white,H,D,Board) -> - case element((H+D)+1,Board) of - white -> 1; - _ -> 0 - end. - -%%------------------------------------------------------- -%% diff(Board,OldBoard) - return a list of the positions -%% with changed pieces. -%% [{Pos1,Colour1},...] -%%------------------------------------------------------- - -diff(Board,OldBoard) -> diff(0,Board,OldBoard). - -diff(Pos,Board,OldBoard) when Pos < 64 -> - OldP = get(Pos,OldBoard), - case get(Pos,Board) of - OldP -> - diff(Pos+1,Board,OldBoard); - NewP -> - [{Pos,NewP}|diff(Pos+1,Board,OldBoard)] - end; -diff(_,_,_) -> - []. - -%%------------------------------------------------------- -%% all_pos(Board) - return a list of the positions colour. -%% [{Pos1,Colour1},...] -%%------------------------------------------------------- - -all_pos(Board) -> all_pos(0,Board). - -all_pos(Pos,Board) when Pos < 64 -> - [{Pos,get(Pos,Board)}|all_pos(Pos+1,Board)]; -all_pos(_,_) -> - []. - -%%------------------------------------------------------- -%% Internal stuff -%%------------------------------------------------------- - -deltas() -> [9,8,7,1,-1,-7,-8,-9]. - -inner_square() -> - [18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]. % Is already an ordset - % Save list traversing. -% ordsets:list_to_set([18,19,20,21,26,27,28,29,34,35,36,37,42,43,44,45]). - -inv(black) -> white; -inv(white) -> black. - -is_good(Colour,H,Board) -> - is_good_0(Colour,H,dir(H,-9),Board), - is_good_0(Colour,H,dir(H,-8),Board), - is_good_0(Colour,H,dir(H,-7),Board), - is_good_0(Colour,H,dir(H,-1),Board), - is_good_0(Colour,H,dir(H,1),Board), - is_good_0(Colour,H,dir(H,7),Board), - is_good_0(Colour,H,dir(H,8),Board), - is_good_0(Colour,H,dir(H,9),Board), - false. - -is_good_0(_,_,false,_) -> false; -is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; -is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; -is_good_0(black,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - white -> is_good_1(black,H+D,dir(H+D,D),Board); - _ -> false - end; -is_good_0(white,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - black -> is_good_1(white,H+D,dir(H+D,D),Board); - _ -> false - end. - -is_good_1(_,_,false,_) -> false; -is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; -is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; -is_good_1(black,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - white -> is_good_1(black,H+D,dir(H+D,D),Board); - black -> throw(true); - _ -> false - end; -is_good_1(white,H,D,Board) when is_integer(H), is_integer(D) -> - case element((H+D)+1,Board) of - black -> is_good_1(white,H+D,dir(H+D,D),Board); - white -> throw(true); - _ -> false - end. - -%%------------------------------------------------------- -%% turn(Colour,Draw,Board) - returns an updated board -%% turn all possible pieces -%% on the board -%% Neighbours are not changed !! -%%------------------------------------------------------- - -turn(Colour,Draw,{Bset,Board}) -> - {Bset,turn(Colour,Draw,-9, - turn(Colour,Draw,-8, - turn(Colour,Draw,-7, - turn(Colour,Draw,-1, - turn(Colour,Draw,1, - turn(Colour,Draw,7, - turn(Colour,Draw,8, - turn(Colour,Draw,9,Board))))))))}. - -turn(Colour,H,D,Board) -> - case catch is_good_0(Colour,H,dir(H,D),Board) of - true -> - turn_0(Colour,H,D,Board); - false -> - Board - end. - -turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D<0 -> B; -turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D>63 -> B; -turn_0(black,H,D,Board) when is_integer(H), is_integer(D) -> - E = H+D, - case element(E+1,Board) of - white -> turn_0(black,H+D,D,swap(black,E,Board)); - _ -> Board - end; -turn_0(white,H,D,Board) when is_integer(H), is_integer(D) -> - E = H+D, - case element(E+1,Board) of - black -> turn_0(white,H+D,D,swap(white,E,Board)); - _ -> Board - end. - -%%------------------------------------------------------- -%% swap(Colour,Pos,Board) - returns an updated board -%% turn a piece on the board -%% Neighbours are not changed !! -%%------------------------------------------------------- - -swap(Colour,Pos,Board) when is_integer(Pos) -> - setelement(Pos+1,Board,Colour). - -score(Pos) -> score1({col(Pos),row(Pos)}). - -score1({Column,1}) when Column >= 3, Column =< 6 -> 20; -score1({Column,8}) when Column >= 3, Column =< 6 -> 20; -score1({1,Line}) when Line >= 3, Line =< 6 -> 20; -score1({8,Line}) when Line >= 3, Line =< 6 -> 20; -score1({Column,2}) when Column >= 3, Column =< 6 -> -7; -score1({Column,7}) when Column >= 3, Column =< 6 -> -7; -score1({2,Line}) when Line >= 3, Line =< 6 -> -7; -score1({7,Line}) when Line >= 3, Line =< 6 -> -7; -score1({Column,Line}) when Column >= 3, Column =< 6, - Line >= 3, Line =< 6 -> 1; -score1({1,1}) -> 100; -score1({1,8}) -> 100; -score1({8,1}) -> 100; -score1({8,8}) -> 100; -score1({2,1}) -> -30; -score1({7,1}) -> -30; -score1({1,2}) -> -30; -score1({8,2}) -> -30; -score1({1,7}) -> -30; -score1({8,7}) -> -30; -score1({2,8}) -> -30; -score1({7,8}) -> -30; -score1({2,2}) -> -50; -score1({7,2}) -> -50; -score1({2,7}) -> -50; -score1({7,7}) -> -50. - -%%------------------------------------------------------- -%% dir(Pos,Dir) - return Dir if allowed direction at Pos. -%% else return false. -%%------------------------------------------------------- - -dir(0,1) -> 1; % {1,1} -dir(0,8) -> 8; -dir(0,9) -> 9; -dir(0,_) -> false; - -dir(7,-1) -> -1; % {8,1} -dir(7,7) -> 7; -dir(7,8) -> 8; -dir(7,_) -> false; - -dir(56,-8) -> -8; % {1,8} -dir(56,-7) -> -7; -dir(56,1) -> 1; -dir(56,_) -> false; - -dir(63,-9) -> -9; % {8,8} -dir(63,-8) -> -8; -dir(63,-1) -> -1; -dir(63,_) -> false; - -dir(Pos,-1) when (Pos bsr 3) == 0 -> -1; % {_,1} -dir(Pos,1) when (Pos bsr 3) == 0 -> 1; -dir(Pos,7) when (Pos bsr 3) == 0 -> 7; -dir(Pos,8) when (Pos bsr 3) == 0 -> 8; -dir(Pos,9) when (Pos bsr 3) == 0 -> 9; -dir(Pos,_) when (Pos bsr 3) == 0 -> false; - -dir(Pos,-9) when (Pos bsr 3) == 7 -> -9; % {_,8} -dir(Pos,-8) when (Pos bsr 3) == 7 -> -8; -dir(Pos,-7) when (Pos bsr 3) == 7 -> -7; -dir(Pos,-1) when (Pos bsr 3) == 7 -> -1; -dir(Pos,1) when (Pos bsr 3) == 7 -> 1; -dir(Pos,_) when (Pos bsr 3) == 7 -> false; - -dir(Pos,-8) when (Pos band 7) == 0 -> -8; % {1,_} -dir(Pos,-7) when (Pos band 7) == 0 -> -7; -dir(Pos,1) when (Pos band 7) == 0 -> 1; -dir(Pos,8) when (Pos band 7) == 0 -> 8; -dir(Pos,9) when (Pos band 7) == 0 -> 9; -dir(Pos,_) when (Pos band 7) == 0 -> false; - -dir(Pos,-9) when (Pos band 7) == 7 -> -9; % {8,_} -dir(Pos,-8) when (Pos band 7) == 7 -> -8; -dir(Pos,-1) when (Pos band 7) == 7 -> -1; -dir(Pos,7) when (Pos band 7) == 7 -> 7; -dir(Pos,8) when (Pos band 7) == 7 -> 8; -dir(Pos,_) when (Pos band 7) == 7 -> false; - -dir(_Pos,Dir) -> Dir. - diff --git a/lib/gs/contribs/othello/othello_board.erl b/lib/gs/contribs/othello/othello_board.erl deleted file mode 100644 index cc055b1fa1..0000000000 --- a/lib/gs/contribs/othello/othello_board.erl +++ /dev/null @@ -1,649 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(othello_board). --compile([{nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,start,0}}]). - --export([start/0,stop/0,init/0]). - - -%%---------------------------------------------------------------------- -%% The Othello program now uses the gs graphical package instead of the -%% pxw package. -%% -%% Differences are, explanation why and source of change in parenthesis: -%% -%% - Buttons looks different (gs feature) -%% - The black box around "Black to draw" have been removed. (me) -%% - The Colour and Level menues have been moved directly down to the -%% 'Status' box. (usability update, my addition) -%% - The mouse pointer does not change into a watch when the computer -%% is thinking (not supported in gs) -%% - Buttons does not flash when being beeped. (not supported in gs) -%% -%% -%% /Peter -%% -%%---------------------------------------------------------------------- - - --define(BGCOL,forestgreen). - -start() -> - spawn(othello_board,init,[]). - -stop() -> - ok. - -%% This is not an application so we don't have their way of knowing -%% a private data directory where the GIF files are located (this directory). -%% We can find GS and makes it relative from there /kgb - --define(BitmapPath,"../contribs/othello/priv"). - -setup_path() -> - GsPrivDir = code:priv_dir(gs), - Path = filename:join(GsPrivDir,?BitmapPath), - put(path,Path). - -path() -> get(path). - - - -%% -%% The button area are the Quit, Rules buttons at the top of the window. -%% The Status area is the black and white scores level and colour etc -%% inbetween the buttons and the othello board. -%% The board is the 8x8 board where othello battles are fought. -%% -init() -> - process_flag(trap_exit,true), - setup_path(), - S = gs:start(), - put(windowroot,S), % Ugly global store - - %% Shell coordinates - W = 496, - H = 636, - - %% Fix top window - Shell = gs:create(window, S, [{title,"Othello"}, - {width, W},{height, H}]), - - - %% Setup window contents - - setup_buttons(Shell,0,0,W,40), % Fix Menubar - setup_status_box(Shell,0,40,W,100), % Fix Status area - setup_board(Shell,0,140,496,496), % Combat board - - GamePid = othello:new_game(white,black,1,first_time), - - %% Default settings - Options = {white,black,1}, - %%Wids = {Status,B,W,Dr,Le,Co}, - Wids = {change,this,at,later,stage,ponto}, - write_options(Options,Wids), - - gs:config(Shell, {map, true}), %Make win visible - - loop(computer,GamePid,Shell,Wids,Options). - - - - - - -loop(User,GamePid,Shell,Wids,Options) -> - receive - {gs,ButtId, click,_ButtId1,[Button]} -> - GamePid1 = but_pressed(Button,ButtId,User,GamePid,Shell, - Wids,Options), - loop(User,GamePid1,Shell,Wids,Options); - - {gs,_, click,_,[MenuItem,_MenuIndex]} -> - Ops = menu_selected(MenuItem,User,GamePid,Wids,Options), - loop(User,GamePid,Shell,Wids,Ops); - - {'EXIT',GamePid,_} -> - loop(User,null,Shell,Wids,Options); - - {'EXIT',_,_} -> - loop(User,GamePid,Shell,Wids,Options); - - GameMsg -> - game_msg(GameMsg,User,GamePid,Shell,Wids,Options) - end. - -but_pressed("Quit",_ButtId,_User,_GamePid,_Shell,_Wids,_Op) -> - stop(), - exit(quit); -but_pressed("Rules",_ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format("No rules, do as you wish~n",[]), - GamePid; -but_pressed("Help",_ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format("Othello game~n",[]), - io:format("------------~n",[]), - io:format(" Put markers by clicking in squares~n",[]), - io:format(" Change level by clicking on it~n",[]), - io:format(" Change colour by clicking on it~n",[]), - io:format("~n",[]), - GamePid; -but_pressed("Newgame",_ButtId,_User,GamePid,_Shell,Wids,Options) -> - new_game(GamePid,Wids,Options); -but_pressed([],ButtId,User,GamePid,_Shell,_Wids,_Op) - when is_pid(GamePid),User == player -> - [C,R] = atom_to_list(ButtId), - GamePid ! {self(),position,othello_adt:pos(C-96,translate(R-48))}, - GamePid; -but_pressed([],ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - [C,R] = atom_to_list(ButtId), - beep(othello_adt:pos(C-96,translate(R-48))), - GamePid; -but_pressed(Button,ButtId,_User,GamePid,_Shell,_Wids,_Op) -> - io:format('Not implemented button pressed ~p, ~p!!!~n',[ButtId,Button]), - GamePid. - -menu_selected("Black",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,white), - Op1 = setelement(2,Op0,white), - write_options(Op1,Wids), - Op1; -menu_selected("White",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,black), - Op1 = setelement(2,Op0,black), - write_options(Op1,Wids), - Op1; -menu_selected("Black (begin)",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,white), - Op1 = setelement(2,Op0,black), - write_options(Op1,Wids), - Op1; -menu_selected("White (begin)",_User,_GamePid,Wids,Options) -> - Op0 = setelement(1,Options,black), - Op1 = setelement(2,Op0,white), - write_options(Op1,Wids), - Op1; -menu_selected("Beginner",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,1), - write_options(Op1,Wids), - Op1; -menu_selected("Intermediate",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,2), - write_options(Op1,Wids), - Op1; -menu_selected("Advanced",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,3), - write_options(Op1,Wids), - Op1; -menu_selected("Expert",_User,_GamePid,Wids,Options) -> - Op1 = setelement(3,Options,4), - write_options(Op1,Wids), - Op1; -menu_selected(What,_User,_GamePid,_Wids,Options) -> - io:format('Menu item not implemented <~s>~n',[What]), - Options. - -game_msg(Msg,User,GamePid,Shell,Wids,Options) -> - case Msg of - {GamePid,new_mark,Pos,Colour} -> - new_mark(Pos,Colour), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,illegal_draw,Draw} -> - beep(Draw), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,player,Computer,Computer} -> - show_player(element(1,Wids),Computer), - cursor("watch"), - GamePid ! {self(),go_on_play}, - loop(computer,GamePid,Shell,Wids,Options); - - {GamePid,player,_Computer,Player} -> - show_player(element(1,Wids),Player), - cursor("top_left_arrow"), - GamePid ! {self(),go_on_play}, - loop(player,GamePid,Shell,Wids,Options); - - {GamePid,omit_draw,Player} -> - omit_draw(GamePid,Player), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,score,WhiteRes,BlackRes} -> - write_score(Wids,WhiteRes,BlackRes), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,draw,Draw} -> - write_draw(Wids,Draw), - loop(User,GamePid,Shell,Wids,Options); - - {GamePid,game_over,WhiteRes,BlackRes} -> - game_over(WhiteRes,BlackRes), - loop(User,GamePid,Shell,Wids,Options); - - What -> - io:format('game_msg received: ~w~n',[What]), - loop(User,GamePid,Shell,Wids,Options) - end. - - -new_game(GamePid,Wids,Options) when is_pid(GamePid) -> - exit(GamePid,kill), - new_game(Wids,Options); -new_game(_,Wids,Options) -> - new_game(Wids,Options). - -new_game(_Wids,Options) -> - label("",lastdraw), - Computer = element(1,Options), - Start = element(2,Options), - Depth = element(3,Options), - othello:new_game(Computer,Start,Depth,restart). - -new_mark(Pos,Colour) -> - Col = othello_adt:col(Pos), - Row = othello_adt:row(Pos), - Name = [Col+96,translate(Row)+48], - Button = get(Name), - butbit(Button,Colour). - -beep(Draw) -> - Col = othello_adt:col(Draw), - Row = othello_adt:row(Draw), - Name = [Col+96,translate(Row)+48], - Button = get(Name), - bell(Button). - -show_player(_Status,white) -> - label("White to draw",todraw); -show_player(_Status,black) -> - label("Black to draw",todraw). - -write_score(_Wids,WhiteRes,BlackRes) -> - label(integer_to_list(BlackRes),bscore), - label(integer_to_list(WhiteRes),wscore). - -write_draw(_Wids,Draw) -> - Col = othello_adt:col(Draw), - Row = othello_adt:row(Draw), - label(lists:flatten(io_lib:format('{~w,~w}',[Col,Row])), lastdraw). - -write_options(Options,Wids) -> - write_colour(Options,Wids), - write_level(Options,Wids). - -write_colour(Options,Wids) -> - write_colour(element(1,Options),element(2,Options),Wids). - -write_colour(black,white,_Wids) -> label("White (begin)",colour); -write_colour(black,black,_Wids) -> label("White",colour); -write_colour(white,black,_Wids) -> label("Black (begin)",colour); -write_colour(white,white,_Wids) -> label("Black",colour). - -write_level(Options,_Wids) -> - case element(3,Options) of - 1 -> label("Beginner",level); - 2 -> label("Intermediate",level); - 3 -> label("Advanced",level); - 4 -> label("Expert",level) - end. - -cursor(_What) -> - done. -%cursor(What) -> cursor(get(),What). - -%cursor([{[C,R],Button}|Buts],What) -> -% set_widget(Button,"cursor",What), -% cursor(Buts,What); -%cursor([_|Buts],What) -> -% cursor(Buts,What); -%cursor([],_) -> -% true. - -translate(1) -> 8; -translate(2) -> 7; -translate(3) -> 6; -translate(4) -> 5; -translate(5) -> 4; -translate(6) -> 3; -translate(7) -> 2; -translate(8) -> 1. - -bitmap(grey) -> bitmap_path("square.bm"); -bitmap(black) -> bitmap_path("marker.bm"); -bitmap(white) -> bitmap_path("marker.bm"). - -bitmap_path(Bitmap) -> - filename:join(path(),Bitmap). - -xy_position([[Letter,Digit],_,_]) -> - LettPos = Letter - 97, - X = LettPos*60 , - Y = (8 - list_to_integer([Digit])) * 60, - {X+6,Y+6}; -xy_position(X) -> - io:format("xy_position: ~w~n",[{error,X}]). - - -board() -> - [["a1",grey,nil], - ["b1",grey,nil], - ["c1",grey,nil], - ["d1",grey,nil], - ["e1",grey,nil], - ["f1",grey,nil], - ["g1",grey,nil], - ["h1",grey,nil], - - ["a2",grey,nil], - ["b2",grey,nil], - ["c2",grey,nil], - ["d2",grey,nil], - ["e2",grey,nil], - ["f2",grey,nil], - ["g2",grey,nil], - ["h2",grey,nil], - - ["a3",grey,nil], - ["b3",grey,nil], - ["c3",grey,nil], - ["d3",grey,nil], - ["e3",grey,nil], - ["f3",grey,nil], - ["g3",grey,nil], - ["h3",grey,nil], - - ["a4",grey,nil], - ["b4",grey,nil], - ["c4",grey,nil], - ["d4",white,nil], - ["e4",black,nil], - ["f4",grey,nil], - ["g4",grey,nil], - ["h4",grey,nil], - - ["a5",grey,nil], - ["b5",grey,nil], - ["c5",grey,nil], - ["d5",black,nil], - ["e5",white,nil], - ["f5",grey,nil], - ["g5",grey,nil], - ["h5",grey,nil], - - ["a6",grey,nil], - ["b6",grey,nil], - ["c6",grey,nil], - ["d6",grey,nil], - ["e6",grey,nil], - ["f6",grey,nil], - ["g6",grey,nil], - ["h6",grey,nil], - - ["a7",grey,nil], - ["b7",grey,nil], - ["c7",grey,nil], - ["d7",grey,nil], - ["e7",grey,nil], - ["f7",grey,nil], - ["g7",grey,nil], - ["h7",grey,nil], - - ["a8",grey,nil], - ["b8",grey,nil], - ["c8",grey,nil], - ["d8",grey,nil], - ["e8",grey,nil], - ["f8",grey,nil], - ["g8",grey,nil], - ["h8",grey,nil]]. - - -omit_draw(GamePid,Player) -> -% %% Find mouse coords first -% %% This was not possible in gs - - W = 200, H = 100, Root = get(windowroot), - Box = gs:create(window, Root, [{title,"OMIT"}, {width, W},{height, H}]), - - mk_label_c(lists:flatten(io_lib:format('~w has to omit draw !',[Player])), - Box, W, 10), - - mk_button_c("Ok", Box, W, H-40, 80, 30), - - gs:config(Box, {map, true}), %Make win visible - - receive - {gs,_, click,_,["Ok"]} -> - gs:destroy(Box), - GamePid ! {self(),continue} - end. - -game_over(WhiteRes,BlackRes) -> -% %% Find mouse coords first -% %% This was not possible in gs - - W = 200, H = 160, - Root = get(windowroot), - Box = gs:create(window, Root, [{title,"GAME OVER"}, - {width, W},{height, H}]), - - mk_label_c("GAME OVER", Box, W, 10), - - mk_label_c(lists:flatten(io_lib:format('White score: ~w',[WhiteRes])), - Box,W,40), - mk_label_c(lists:flatten(io_lib:format('Black score: ~w',[BlackRes])), - Box,W,70), - - mk_button_c("Ok", Box, W, H-40, 80, 30), - - gs:config(Box, {map, true}), %Make win visible - - receive - {gs,_, click,_,["Ok"]} -> - gs:destroy(Box) - end. - - - -%% ---------------------------------------------------------------- -%% Library functions. -%% ---------------------------------------------------------------- - -bell(Widget) -> - %% gs does not support bells, - Widget. - -label(Text,Label) -> - gs:config(Label,[{label,{text,Text}}]). - -%% mk_label in centered version -mk_label_c(Label,Parent,Width,Y) -> - W = 8*length(Label), - X = trunc((Width-W)/2), - gs:create(label,Parent,[{width,W}, {height, 20}, {x,X}, {y,Y}, - {label, {text, Label}}]). - - - - -setup_buttons(Shell,X,Y,W,H) -> - ButBox = gs:create(frame, Shell,[{x,X}, {y,Y},{bg,white}, - {width,W}, {height,H}]), - C = gs:create(canvas,ButBox,[{x,X}, {y,Y}, {width, W}, {height, H}, - {bg,white}]), - gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]), - - - mk_button("Quit",ButBox, 10, 10, 70, 20), - mk_button("Rules",ButBox, 80, 10, 70, 20), - mk_button("Newgame",ButBox, 150, 10, 70, 20), - mk_button("Help",ButBox, 220, 10, 70, 20), -%% mk_button("Level",ButBox, 290, 10, 70, 20), - - done. - - - - - -%%---------------------------------------- -%% Sets up the middle window w. all the status info in. -%% The labels are given names: -%% bscore, wscore, lastdraw, todraw, level and colour to simplify -%% their frequent setting -%% -setup_status_box(Shell,X,Y,W,H) -> - F = gs:create(frame, Shell,[{x,X}, {y,Y}, - {width,W}, {height,H},{bg,white}]), - C = gs:create(canvas,F,[{x,0}, {y,0}, {width, W}, {height, H},{bg,white}]), - gs:create(line, C, [{coords, [{0,H-1},{W,H-1}]}]), - - %% Left side - gs:create(label,F,[{align,w},{x,10}, {y,5}, {width, 100}, - {label,{text, "Black score:"}},{bg,white}]), - gs:create(label,bscore,F,[{align,w},{x,110}, {y,5}, {width, 40}, - {label,{text, "2"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,10}, {y,35}, {width, 100}, - {label,{text, "White score:"}},{bg,white}]), - gs:create(label,wscore,F,[{align,w},{x,110}, {y,35}, {width, 40}, - {label,{text, "2"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,10}, {y,65}, {width, 100}, - {label,{text, "Last draw:"}},{bg,white}]), - gs:create(label,lastdraw,F,[{align,w},{x,110}, {y,65}, {width, 40}, - {label,{text, ""}},{bg,white}]), - - - %% Right side - X2 = trunc(W/2)+10, - gs:create(label,todraw,F,[{align,w},{x,X2}, {y,5}, {width, 100}, - {label,{text, "Black to draw:"}},{bg,white}]), - - gs:create(label,F,[{align,w},{x,X2}, {y,35}, {width, 80}, - {label,{text, "Level:"}},{bg,white}]), - setup_level_menu(F,X2+80,35), - -%% gs:create(label,level,F,[{align,w},{x,X2+80}, {y,35}, {width, 130}, -%% {label,{text, "Intermediate"}},{bg,white}]), - gs:create(label,F,[{align,w},{x,X2}, {y,65}, {width, 80}, - {label,{text, "Colour:"}},{bg,white}]), - setup_col_menu(F,X2+80,65), - -%% gs:create(label,colour,F,[{align,w},{x,X2+80}, {y,65}, {width, 120}, -%% {label,{text, "black (begin)"}},{bg,white}]), - - done. - - -setup_col_menu(P,X,Y) -> - MB = gs:create(menubutton,colour,P, - [{x,X}, {y,Y}, {bw,3}, - %%{width,W}, {height,H}, - {align,w}, {bg,white}, - {relief, raised}, - {activefg,white}, {activebg,black}, - {label, {text,"Colours"}}]), - - M = gs:create(menu,MB,[]), - gs:create(menuitem,M,[{label,{text,"Black (begin)"}}]), - gs:create(menuitem,M,[{label,{text,"Black"}}]), - gs:create(menuitem,M,[{label,{text,"White (begin)"}}]), - gs:create(menuitem,M,[{label,{text,"White"}}]), - done. - -setup_level_menu(P,X,Y) -> - MB = gs:create(menubutton,level,P, - [{x,X}, {y,Y}, - %%{width,W}, {height,H}, - {relief, raised}, - {activefg,white}, {activebg,black}, - {align,w}, {bg,white}, - {label, {text,"Colours"}}]), - - M = gs:create(menu,MB,[]), - gs:create(menuitem,M,[{label,{text,"Beginner"}}]), - gs:create(menuitem,M,[{label,{text,"Intermediate"}}]), - gs:create(menuitem,M,[{label,{text,"Advanced"}}]), - gs:create(menuitem,M,[{label,{text,"Expert"}}]), - done. - - -setup_board(Shell,X,Y,W,H) -> - F = gs:create(frame, Shell,[{x,X}, {y,Y}, - {width,W}, {height,H},{bg,white}]), - display_board(F). - - -mk_button(Label, Parent, X, Y, W, H) -> - gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y}, - {label, {text, Label}}, {bg,white}, - {activefg,white}, {activebg,black}]). - -%% Centers a button around Width -mk_button_c(Label, Parent, Width, Y, W, H) -> - X = trunc((Width-W)/2), - gs:create(button,Parent,[{width,W}, {height, H}, {x,X}, {y,Y}, - {label, {text, Label}}, {bg,white}]). - - -butbit(Button,Col) -> - gs:config(Button,[ - {label,{image,bitmap(Col)}}, - {fg, Col}, - {activefg,Col}, - {label, {image, bitmap(Col)}}]), - Button. - -mk_board_butt(Top,Name,X,Y,Col) -> - B = gs:create(button,list_to_atom(Name), Top, - [{x,X}, {y,Y}, {width,60}, {height,60}, - {padx,5},{pady,5}, - {relief,flat}, - {bg,?BGCOL}, {activebg,?BGCOL}]), - butbit(B,Col), - B. - - - -display_board(Top) -> - Board = board(), - display_board(Top,Board,1). - -display_board(_,_,65) -> true; -display_board(Top,[H|T],Place) -> - [Name,Colour,_] = H, - {X,Y} = xy_position(H), - Button = mk_board_butt(Top,Name,X,Y,Colour), - %%Button = mk_button("",Name,Top,X,Y,60,60), - put(Name,Button), - %%Bitmap = bitmap(Colour), - %%butbit(Button,Bitmap), - %%set_widget(Button,"internalWidth","1"), - %%set_widget(Button,"internalHeight","1"), - %%borderWidth(2,Button), - display_board(Top,T,Place+1). - - diff --git a/lib/gs/contribs/othello/priv/marker.bm b/lib/gs/contribs/othello/priv/marker.bm deleted file mode 100644 index fe7f3df820..0000000000 --- a/lib/gs/contribs/othello/priv/marker.bm +++ /dev/null @@ -1,43 +0,0 @@ -#define marker2_width 60 -#define marker2_height 60 -static unsigned char marker2_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x0f, 0x00, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, - 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x0f, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, - 0xff, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x01, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0xff, 0xff, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x03, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00, 0x00, 0xfe, 0xff, 0xff, - 0xff, 0xff, 0x0f, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, - 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, - 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x00, 0xe0, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, - 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x00, 0xc0, 0xff, 0xff, 0xff, - 0xff, 0xff, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x7f, 0x00, - 0x80, 0xff, 0xff, 0xff, 0xff, 0x7f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, - 0xff, 0x3f, 0x3f, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x1f, 0x3f, 0x00, - 0x00, 0xff, 0xff, 0xff, 0xff, 0x9f, 0x1f, 0x00, 0x00, 0xff, 0xff, 0xff, - 0xff, 0xcf, 0x1f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0xff, 0xc7, 0x0f, 0x00, - 0x00, 0xfc, 0xff, 0xff, 0xff, 0xe7, 0x07, 0x00, 0x00, 0xf8, 0xff, 0xff, - 0x7f, 0xf1, 0x03, 0x00, 0x00, 0xf8, 0xff, 0xff, 0xbf, 0xfc, 0x03, 0x00, - 0x00, 0xf0, 0xff, 0xff, 0x59, 0xff, 0x01, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x03, 0x00, 0x00, - 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, - 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/lib/gs/contribs/othello/priv/square.bm b/lib/gs/contribs/othello/priv/square.bm deleted file mode 100644 index 4e6880b330..0000000000 --- a/lib/gs/contribs/othello/priv/square.bm +++ /dev/null @@ -1,43 +0,0 @@ -#define square_width 60 -#define square_height 60 -static unsigned char square_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; -- cgit v1.2.3 From 38e8ab99454f69acab55e5bcb575ed60a8b72c2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 15:10:27 +0100 Subject: common_test tests: Replace 'random' with 'rand' --- lib/common_test/test/ct_master_SUITE.erl | 2 +- lib/common_test/test/ct_test_support.erl | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index 15b49c67c0..55837352e2 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -135,7 +135,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config) -> C = lists:map( fun(NodeName) -> - Rnd = random:uniform(2), + Rnd = rand:uniform(2), if Rnd == 1-> {config,NodeName,filename:join(DataDir, "master/config.txt")}; diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 248ec6c4df..4a47d345e9 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -414,14 +414,14 @@ ct_rpc({M,F,A}, Config) -> %%%----------------------------------------------------------------- %%% random_error/1 random_error(Config) when is_list(Config) -> - random:seed(os:timestamp()), + rand:seed(exsplus), Gen = fun(0,_) -> ok; (N,Fun) -> Fun(N-1, Fun) end, - Gen(random:uniform(100), Gen), + Gen(rand:uniform(100), Gen), ErrorTypes = ['BADMATCH','BADARG','CASE_CLAUSE','FUNCTION_CLAUSE', 'EXIT','THROW','UNDEF'], - Type = lists:nth(random:uniform(length(ErrorTypes)), ErrorTypes), - Where = case random:uniform(2) of + Type = lists:nth(rand:uniform(length(ErrorTypes)), ErrorTypes), + Where = case rand:uniform(2) of 1 -> io:format("ct_test_support *returning* error of type ~w", [Type]), -- cgit v1.2.3 From 5850300f41de8047b9a9da1e4f00aaee3dcd662c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 12:40:40 +0100 Subject: system tests: Replace 'random' with 'rand' --- erts/test/ethread_SUITE.erl | 32 -------------------------------- erts/test/run_erl_SUITE.erl | 18 ++++++++---------- 2 files changed, 8 insertions(+), 42 deletions(-) diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 4a40dbb11e..388af66b23 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -123,38 +123,6 @@ try_lock_mutex(suite) -> try_lock_mutex(Config) -> run_case(Config, "try_lock_mutex", ""). -%% Remove dead code? - -% wd_dispatch(P) -> -% receive -% bye -> -% ?line true = port_command(P, "-1 "), -% ?line bye; -% L when is_list(L) -> -% ?line true = port_command(P, L), -% ?line wd_dispatch(P) -% end. -% -% watchdog(Port) -> -% ?line process_flag(priority, max), -% ?line receive after 500 -> ok end, -% -% ?line random:seed(), -% ?line true = port_command(Port, "0 "), -% ?line lists:foreach(fun (T) -> -% erlang:send_after(T, -% self(), -% integer_to_list(T) -% ++ " ") -% end, -% lists:usort(lists:map(fun (_) -> -% random:uniform(4500)+500 -% end, -% lists:duplicate(50,0)))), -% ?line erlang:send_after(5100, self(), bye), -% -% wd_dispatch(Port). - cond_wait(doc) -> ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."]; cond_wait(suite) -> diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index 328477d870..6759d41a2b 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -141,12 +141,10 @@ heavier_1(Config) -> ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), io:format("ToErl = ~p\n", [ToErl]), - X = 1, - Y = 555, - Z = 42, - ?line random:seed(X, Y, Z), - SeedCmd = lists:flatten(io_lib:format("random:seed(~p, ~p, ~p). \r\n", - [X,Y,Z])), + Seed = {1,555,42}, + rand:seed(exsplus, Seed), + SeedCmd = lists:flatten(io_lib:format("rand:seed(exsplus, ~p). \r\n", + [Seed])), ?line io:format("~p\n", [SeedCmd]), ?line erlang:port_command(ToErl, SeedCmd), @@ -157,9 +155,9 @@ heavier_1(Config) -> "F = fun(F,0) -> ok; "++ "(F,N) -> " ++ "io:format(\"\\\"~s\\\"~n\","++ - "[[35|[random:uniform(25)+65 || " ++ + "[[35|[rand:uniform(25)+65 || " ++ "_ <- lists:seq(1, "++ - "random:uniform("++ + "rand:uniform("++ integer_to_list(MaxLen)++ "))]]]), "++ "F(F,N-1) "++ @@ -189,8 +187,8 @@ receive_all(Iter, ToErl, MaxLen) -> receive_all_1(0, _, _, _) -> ok; receive_all_1(Iter, Line, ToErl, MaxLen) -> - NumChars = random:uniform(MaxLen), - Pattern = [random:uniform(25)+65 || _ <- lists:seq(1, NumChars)], + NumChars = rand:uniform(MaxLen), + Pattern = [rand:uniform(25)+65 || _ <- lists:seq(1, NumChars)], receive_all_2(Iter, {NumChars,Pattern}, Line, ToErl, MaxLen). -- cgit v1.2.3 From 983642a38b3627425f77fc6f8b8ccd121fd41f52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 13:18:20 +0100 Subject: percept tests: Replace 'random' with 'rand' --- lib/percept/test/egd_SUITE.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl index 41e8999e17..5a0a9af14d 100644 --- a/lib/percept/test/egd_SUITE.erl +++ b/lib/percept/test/egd_SUITE.erl @@ -40,7 +40,7 @@ -define(default_timeout, ?t:minutes(1)). init_per_suite(Config) when is_list(Config) -> - random:seed(now()), + rand:seed(exsplus), Config. end_per_suite(Config) when is_list(Config) -> @@ -348,4 +348,4 @@ get_points(0, Out) -> get_points(N, Out) -> get_points(N - 1, [get_point() | Out]). -random(N) -> trunc(random:uniform(trunc(N + 1)) - 1). +random(N) -> trunc(rand:uniform(trunc(N + 1)) - 1). -- cgit v1.2.3 From a16ad650d3f9cca03dbc1cf542e9f1ca7dd0a7e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 11 Dec 2015 14:30:01 +0100 Subject: mnesia tests: Replace 'random' with 'rand' --- lib/mnesia/test/mnesia_consistency_test.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/mnesia/test/mnesia_consistency_test.erl b/lib/mnesia/test/mnesia_consistency_test.erl index 087aef86c9..279e7bc1ec 100644 --- a/lib/mnesia/test/mnesia_consistency_test.erl +++ b/lib/mnesia/test/mnesia_consistency_test.erl @@ -696,7 +696,7 @@ consistency_after_restore(ReplicaType, Op, Config) -> ?verify_mnesia(Nodes, []). change_tab(Father, Tab, Test) -> - Key = random:uniform(20), + Key = rand:uniform(20), Update = fun() -> case mnesia:read({Tab, Key}) of [{Tab, Key, 1}] -> -- cgit v1.2.3 From 41d147339c65d2b6dfcf60c1e63482612774bede Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Dec 2015 15:45:55 +0100 Subject: Eliminate mentions of 'random' in documentation --- erts/doc/src/init.xml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index fe26df61f7..2a33096d04 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -247,10 +247,7 @@ Expr during system initialization. If any of these steps fail (syntax error, parse error or exception during evaluation), Erlang stops with an error message. Here is an - example that seeds the random number generator:

- 
-% erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'
-

This example uses Erlang as a hexadecimal calculator:

+ example that uses Erlang as a hexadecimal calculator:

 % erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\
 -s erlang halt
-- 
cgit v1.2.3


From 61fd09aaef2474cd74ddbc465e9d1dfd879a4ab5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Fri, 4 Dec 2015 12:04:12 +0100
Subject: Deprecate the 'random' module

The 'rand' module was introduced in OTP 18 and its use is
discouraged. Deprecate it to further discourage its use.
---
 lib/stdlib/src/otp_internal.erl | 6 ++++++
 lib/stdlib/src/random.erl       | 1 +
 2 files changed, 7 insertions(+)

diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 90ef364d1a..166eb3cef2 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -639,6 +639,12 @@ obsolete_1(httpd_conf, is_file, 1) ->
 obsolete_1(httpd_conf, make_integer, 1) ->
     {deprecated, "deprecated; use erlang:list_to_integer/1 instead"};
 
+%% Added in OTP 19.
+
+obsolete_1(random, _, _) ->
+    {deprecated, "the 'random' module is deprecated; "
+     "use the 'rand' module instead"};
+
 obsolete_1(_, _, _) ->
     no.
 
diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl
index 8b67cde56c..8b639dd0a7 100644
--- a/lib/stdlib/src/random.erl
+++ b/lib/stdlib/src/random.erl
@@ -18,6 +18,7 @@
 %% %CopyrightEnd%
 %%
 -module(random).
+-deprecated(module).
 
 %% Reasonable random number generator.
 %%  The method is attributed to B. A. Wichmann and I. D. Hill
-- 
cgit v1.2.3


From 3ecefb19e555e52e35c8f2c5178c72f165c4a7ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Mon, 14 Dec 2015 15:47:50 +0100
Subject: Update primary bootstrap

---
 bootstrap/lib/compiler/ebin/beam_a.beam        | Bin 2684 -> 2684 bytes
 bootstrap/lib/compiler/ebin/beam_bs.beam       | Bin 5928 -> 5928 bytes
 bootstrap/lib/compiler/ebin/beam_disasm.beam   | Bin 26216 -> 26216 bytes
 bootstrap/lib/compiler/ebin/compile.beam       | Bin 38984 -> 38776 bytes
 bootstrap/lib/compiler/ebin/rec_env.beam       | Bin 4720 -> 4920 bytes
 bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 49728 -> 49728 bytes
 bootstrap/lib/kernel/ebin/code_server.beam     | Bin 28688 -> 28852 bytes
 bootstrap/lib/kernel/ebin/erts_debug.beam      | Bin 5452 -> 5548 bytes
 bootstrap/lib/kernel/ebin/file_io_server.beam  | Bin 15184 -> 15564 bytes
 bootstrap/lib/kernel/ebin/global.beam          | Bin 32348 -> 32252 bytes
 bootstrap/lib/kernel/ebin/inet.beam            | Bin 23072 -> 23320 bytes
 bootstrap/lib/kernel/ebin/user.beam            | Bin 11572 -> 11572 bytes
 bootstrap/lib/stdlib/ebin/erl_lint.beam        | Bin 89268 -> 89380 bytes
 bootstrap/lib/stdlib/ebin/erl_pp.beam          | Bin 26956 -> 26796 bytes
 bootstrap/lib/stdlib/ebin/otp_internal.beam    | Bin 11656 -> 11696 bytes
 bootstrap/lib/stdlib/ebin/rand.beam            | Bin 13444 -> 13440 bytes
 bootstrap/lib/stdlib/ebin/random.beam          | Bin 1704 -> 1736 bytes
 bootstrap/lib/stdlib/ebin/shell.beam           | Bin 30272 -> 30172 bytes
 18 files changed, 0 insertions(+), 0 deletions(-)

diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam
index 599f9cb073..2388ccad80 100644
Binary files a/bootstrap/lib/compiler/ebin/beam_a.beam and b/bootstrap/lib/compiler/ebin/beam_a.beam differ
diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam
index 0823cb2dd7..18b9f8bc1b 100644
Binary files a/bootstrap/lib/compiler/ebin/beam_bs.beam and b/bootstrap/lib/compiler/ebin/beam_bs.beam differ
diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam
index 5c2308ef9d..b2fd7faa0c 100644
Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ
diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam
index 8f60633c81..8126046e08 100644
Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ
diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam
index 69d3f62ca0..9388b5d4e1 100644
Binary files a/bootstrap/lib/compiler/ebin/rec_env.beam and b/bootstrap/lib/compiler/ebin/rec_env.beam differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam
index 809de44217..c510dfde01 100644
Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ
diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam
index 22ae0e7ce6..ece4263caa 100644
Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ
diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam
index d1a60d5cd9..908c63cb9a 100644
Binary files a/bootstrap/lib/kernel/ebin/erts_debug.beam and b/bootstrap/lib/kernel/ebin/erts_debug.beam differ
diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam
index f29483ef36..dabb6b194e 100644
Binary files a/bootstrap/lib/kernel/ebin/file_io_server.beam and b/bootstrap/lib/kernel/ebin/file_io_server.beam differ
diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam
index 469859fa03..419102e285 100644
Binary files a/bootstrap/lib/kernel/ebin/global.beam and b/bootstrap/lib/kernel/ebin/global.beam differ
diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam
index 6353e6564b..55598b0067 100644
Binary files a/bootstrap/lib/kernel/ebin/inet.beam and b/bootstrap/lib/kernel/ebin/inet.beam differ
diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam
index 5b07718039..c2b2808555 100644
Binary files a/bootstrap/lib/kernel/ebin/user.beam and b/bootstrap/lib/kernel/ebin/user.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index 8c07c78369..21b7ce4f3a 100644
Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index d97b5e075b..4cc4884c92 100644
Binary files a/bootstrap/lib/stdlib/ebin/erl_pp.beam and b/bootstrap/lib/stdlib/ebin/erl_pp.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index 97b7826149..9b1bd2c77b 100644
Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam
index 588bbb3394..5bc835e2e8 100644
Binary files a/bootstrap/lib/stdlib/ebin/rand.beam and b/bootstrap/lib/stdlib/ebin/rand.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam
index e1d62c98d5..fc351a800a 100644
Binary files a/bootstrap/lib/stdlib/ebin/random.beam and b/bootstrap/lib/stdlib/ebin/random.beam differ
diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam
index e27b7bcb84..ee304db782 100644
Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ
-- 
cgit v1.2.3


From 3131a94b5d2ce2b95aa0efb99c767e3658f24550 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Fri, 11 Dec 2015 16:25:34 +0100
Subject: Remove the code path cache in the code server

In practice, it does not seem that code path cache can
improve performance. Looking for any file that is not found
will cause the cache to be rebuilt, which will negate any
gain of using the cache.
---
 lib/kernel/doc/src/code.xml     |  36 +--------
 lib/kernel/src/code.erl         |  45 ++++++-----
 lib/kernel/src/code_server.erl  | 170 ++++-----------------------------------
 lib/kernel/test/code_SUITE.erl  | 172 +---------------------------------------
 lib/stdlib/src/otp_internal.erl |   2 +
 5 files changed, 47 insertions(+), 378 deletions(-)

diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index eb0f4b7a06..acc39145e2 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -100,30 +100,6 @@
       use semi-colon as separator.)
-
- Code Path Cache -

The code server incorporates a code path cache. The cache - functionality is disabled by default. To activate it, start - the emulator with the command line flag -code_path_cache - or call code:rehash(). When the cache is created (or - updated), the code server searches for modules in the code path - directories. This may take some time if the the code path is long. - After the cache creation, the time for loading modules in a large - system (one with a large directory structure) is significantly - reduced compared to having the cache disabled. The code server - is able to look up the location of a module from the cache in - constant time instead of having to search through the code path - directories.

-

Application resource files (.app files) are also stored - in the code path cache. This feature is used by the application - controller (see - application(3)) to load - applications efficiently in large systems.

-

Note that when the code path cache is created (or updated), any - relative directory names in the code path are converted to - absolute.

-
-
Loading of Code From Archive Files @@ -699,13 +675,6 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), not sticky.

- - - Rehash or create code path cache - -

This function creates or rehashes the code path cache.

- - Full name of a file located in the code path @@ -714,10 +683,7 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), arbitrary type. If found, the full name is returned. non_existing is returned if the file cannot be found. The function can be useful, for example, to locate - application resource files. If the code path cache is used, - the code server will efficiently read the full name from - the cache, provided that Filename is an object code - file or an .app file.

+ application resource files.

 diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 352c02562b..ae28c97b47 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -68,6 +68,8 @@ clash/0, get_mode/0]). +-deprecated({rehash,0,next_major_release}). + -export_type([load_error_rsn/0, load_ret/0]). -include_lib("kernel/include/file.hrl"). @@ -293,7 +295,9 @@ replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), call({replace_path,Name,Dir}). -spec rehash() -> 'ok'. -rehash() -> call(rehash). +rehash() -> + cache_warning(), + ok. -spec get_mode() -> 'embedded' | 'interactive'. get_mode() -> call(get_mode). @@ -322,6 +326,7 @@ start_link(Flags) -> %%----------------------------------------------------------------- do_start(Flags) -> + maybe_warn_for_cache(), load_code_server_prerequisites(), Mode = get_mode(Flags), @@ -452,30 +457,14 @@ which(File, Base, [Directory|Tail]) -> Filename :: file:filename(), Absname :: file:filename(). where_is_file(File) when is_list(File) -> - case call({is_cached,File}) of - no -> - Path = get_path(), - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end. + Path = get_path(), + which(File, ".", Path). -spec where_is_file(Path :: file:filename(), Filename :: file:filename()) -> file:filename() | 'non_existing'. where_is_file(Path, File) when is_list(Path), is_list(File) -> - CodePath = get_path(), - if - Path =:= CodePath -> - case call({is_cached, File}) of - no -> - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end; - true -> - which(File, ".", Path) - end. + which(File, ".", Path). -spec set_primary_archive(ArchiveFile :: file:filename(), ArchiveBin :: binary(), @@ -552,6 +541,22 @@ has_ext(Ext, Extlen, File) -> _ -> false end. +%%% +%%% Warning for deprecated code path cache. +%%% + +maybe_warn_for_cache() -> + case init:get_argument(code_path_cache) of + {ok, _} -> + cache_warning(); + error -> + ok + end. + +cache_warning() -> + W = "The code path cache functionality has been removed", + error_logger:warning_report(W). + %%% %%% Silently load native code for all modules loaded so far. %%% diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 68dd21b1d7..4361bb7b60 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -40,7 +40,6 @@ path, moddb, namedb, - cache = no_cache, mode = interactive, on_load = []}). -type state() :: #state{}. @@ -89,19 +88,11 @@ init(Ref, Parent, [Root,Mode0]) -> end, Path = add_loader_path(IPath, Mode), - State0 = #state{root = Root, - path = Path, - moddb = Db, - namedb = init_namedb(Path), - mode = Mode}, - - State = - case init:get_argument(code_path_cache) of - {ok, _} -> - create_cache(State0); - error -> - State0 - end, + State = #state{root = Root, + path = Path, + moddb = Db, + namedb = init_namedb(Path), + mode = Mode}, put(?ANY_NATIVE_CODE_LOADED, false), @@ -264,50 +255,29 @@ handle_call({load_file,Mod}, Caller, St) -> end; handle_call({add_path,Where,Dir0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - Dir = absname(Dir0), %% Cache always expands the path - {Resp,Path} = add_path(Where, Dir, Path0, Namedb), - Cache = update_cache([Dir], Where, Cache0), - {reply,Resp,S#state{path=Path,cache=Cache}} - end; + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - %% Cache always expands the path - Dirs = [absname(Dir) || Dir <- Dirs0], - {Resp,Path} = add_paths(Where, Dirs, Path0, Namedb), - Cache=update_cache(Dirs,Where,Cache0), - {reply,Resp,S#state{cache=Cache,path=Path}} - end; + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; handle_call({set_path,PathList}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path,namedb=NewDb})}; + {reply,Resp,S#state{path=Path,namedb=NewDb}}; handle_call({del_path,Name}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = del_path(Name, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; + {reply,Resp,S#state{path=Path}}; handle_call({replace_path,Name,Dir}, {_From,_Tag}, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; - -handle_call(rehash, {_From,_Tag}, S0) -> - S = create_cache(S0), - {reply,ok,S}; + {reply,Resp,S#state{path=Path}}; handle_call(get_path, {_From,_Tag}, S) -> {reply,S#state.path,S}; @@ -398,9 +368,6 @@ handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> handle_call(stop,{_From,_Tag}, S) -> {stop,normal,stopped,S}; -handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) -> - {reply, no, S}; - handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) -> case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) of {ok, Files} -> @@ -409,26 +376,6 @@ handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From {reply, Error, S} end; -handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) -> - ObjExt = objfile_extension(), - Ext = filename:extension(File), - Type = case Ext of - ObjExt -> obj; - ".app" -> app; - _ -> undef - end, - if Type =:= undef -> - {reply, no, S}; - true -> - Key = {Type,list_to_atom(filename:rootname(File, Ext))}, - case ets:lookup(Cache, Key) of - [] -> - {reply, no, S}; - [{Key,Dir}] -> - {reply, Dir, S} - end - end; - handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) -> {reply, Mode, S}; @@ -447,69 +394,6 @@ do_mod_call(Action, Module, Error, St) -> {reply,Error,St} end. -%% -------------------------------------------------------------- -%% Cache functions -%% -------------------------------------------------------------- - -create_cache(St = #state{cache = no_cache}) -> - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St); -create_cache(St) -> - rehash_cache(St). - -rehash_cache(St = #state{cache = no_cache}) -> - St; -rehash_cache(St = #state{cache = OldCache}) -> - ets:delete(OldCache), - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St). - -rehash_cache(Cache, St = #state{path = Path}) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache,NewPath} = locate_mods(lists:reverse(Path), first, Exts, Cache, []), - St#state{cache = Cache, path=NewPath}. - -update_cache(Dirs, Where, Cache0) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache, _} = locate_mods(Dirs, Where, Exts, Cache0, []), - Cache. - -locate_mods([Dir0|Path], Where, Exts, Cache, Acc) -> - Dir = absname(Dir0), %% Cache always expands the path - case erl_prim_loader:list_dir(Dir) of - {ok, Files} -> - Cache = filter_mods(Files, Where, Exts, Dir, Cache), - locate_mods(Path, Where, Exts, Cache, [Dir|Acc]); - error -> - locate_mods(Path, Where, Exts, Cache, Acc) - end; -locate_mods([], _, _, Cache, Path) -> - {Cache,Path}. - -filter_mods([File|Rest], Where, Exts, Dir, Cache) -> - Ext = filename:extension(File), - Root = list_to_atom(filename:rootname(File, Ext)), - case lists:keyfind(Ext, 2, Exts) of - {Type, _} -> - Key = {Type,Root}, - case Where of - first -> - true = ets:insert(Cache, {Key,Dir}); - last -> - case ets:lookup(Cache, Key) of - [] -> - true = ets:insert(Cache, {Key,Dir}); - _ -> - ignore - end - end; - false -> - ok - end, - filter_mods(Rest, Where, Exts, Dir, Cache); -filter_mods([], _, _, _, Cache) -> - Cache. - %% -------------------------------------------------------------- %% Path handling functions. %% -------------------------------------------------------------- @@ -1238,16 +1122,6 @@ load_abs(File, Mod0, Caller, St) -> {reply,{error,nofile},St} end. -try_load_module(Mod, Dir, Caller, St) -> - File = filename:append(Dir, to_list(Mod) ++ - objfile_extension()), - case erl_prim_loader:get_file(File) of - error -> - {reply,error,St}; - {ok,Binary,FName} -> - try_load_module(absname(FName), Mod, Binary, Caller, St) - end. - try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> M = to_atom(Mod), case pending_on_load(M, From, St0) of @@ -1345,26 +1219,12 @@ load_file(Mod0, {From,_}=Caller, St0) -> {yes,St} -> {noreply,St} end. -load_file_1(Mod, Caller, #state{path=Path,cache=no_cache}=St) -> +load_file_1(Mod, Caller, #state{path=Path}=St) -> case mod_to_bin(Path, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> try_load_module(File, Mod, Binary, Caller, St) - end; -load_file_1(Mod, Caller, #state{cache=Cache}=St0) -> - Key = {obj,Mod}, - case ets:lookup(Cache, Key) of - [] -> - St = rehash_cache(St0), - case ets:lookup(St#state.cache, Key) of - [] -> - {reply,{error,nofile},St}; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St) - end; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St0) end. mod_to_bin([Dir|Tail], Mod) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index ef5303defd..dfcb20d594 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -30,8 +30,7 @@ upgrade/1, sticky_dir/1, pa_pz_option/1, add_del_path/1, dir_disappeared/1, ext_mod_dep/1, clash/1, - load_cached/1, start_node_with_cache/1, add_and_rehash/1, - where_is_file_cached/1, where_is_file_no_cache/1, + where_is_file/1, purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, code_archive/1, code_archive2/1, on_load/1, on_load_binary/1, on_load_embedded/1, on_load_errors/1, big_boot_embedded/1, @@ -56,9 +55,8 @@ all() -> load_binary, dir_req, object_code, set_path_file, upgrade, sticky_dir, pa_pz_option, add_del_path, dir_disappeared, - ext_mod_dep, clash, load_cached, start_node_with_cache, - add_and_rehash, where_is_file_no_cache, - where_is_file_cached, purge_stacktrace, mult_lib_roots, + ext_mod_dep, clash, where_is_file, + purge_stacktrace, mult_lib_roots, bad_erl_libs, code_archive, code_archive2, on_load, on_load_binary, on_load_embedded, on_load_errors, big_boot_embedded, native_early_modules, get_mode]. @@ -904,140 +902,7 @@ uniq([H|T],A) -> uniq(T,[H|A]). -load_cached(suite) -> - []; -load_cached(doc) -> - []; -load_cached(Config) when is_list(Config) -> - Priv = ?config(priv_dir, Config), - WD = filename:dirname(code:which(?MODULE)), - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-pa \"" ++ WD ++ "\""}, - {erl, [this]}]), - CCTabCreated = fun(Tab) -> - case ets:info(Tab, name) of - code_cache -> true; - _ -> false - end - end, - Tabs = rpc:call(Node, ets, all, []), - case rpc:call(Node, lists, any, [CCTabCreated,Tabs]) of - true -> - ?t:stop_node(Node), - ?t:fail("Code cache should not be active!"); - false -> - ok - end, - rpc:call(Node, code, del_path, [Priv]), - rpc:call(Node, code, add_pathz, [Priv]), - - FullModName = Priv ++ "/code_cache_test", - {ok,Dev} = file:open(FullModName ++ ".erl", [write]), - io:format(Dev, "-module(code_cache_test). -export([a/0]). a() -> ok.~n", []), - ok = file:close(Dev), - {ok,code_cache_test} = compile:file(FullModName, [{outdir,Priv}]), - - F = fun load_loop/2, - N = 1000, - {T0,T1} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), - TNoCache = now_diff(T1, T0), - rpc:call(Node, code, rehash, []), - {T2,T3} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), - TCache = now_diff(T3, T2), - AvgNoCache = TNoCache/N, - AvgCache = TCache/N, - io:format("Avg. load time (no_cache/cache): ~w/~w~n", [AvgNoCache,AvgCache]), - ?t:stop_node(Node), - if AvgNoCache =< AvgCache -> - ?t:fail("Cache not working properly."); - true -> - ok - end. - -load_loop(N, M) -> - load_loop(N, M, now()). -load_loop(0, _M, T0) -> - {T0,now()}; -load_loop(N, M, T0) -> - code:load_file(M), - code:delete(M), - code:purge(M), - load_loop(N-1, M, T0). - -now_diff({A2, B2, C2}, {A1, B1, C1}) -> - ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1. - -start_node_with_cache(suite) -> - []; -start_node_with_cache(doc) -> - []; -start_node_with_cache(Config) when is_list(Config) -> - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-code_path_cache"}, - {erl, [this]}]), - Tabs = rpc:call(Node, ets, all, []), - io:format("Tabs: ~w~n", [Tabs]), - CCTabCreated = fun(Tab) -> - case rpc:call(Node, ets, info, [Tab,name]) of - code_cache -> true; - _ -> false - end - end, - true = lists:any(CCTabCreated, Tabs), - ?t:stop_node(Node), - ok. - -add_and_rehash(suite) -> - []; -add_and_rehash(doc) -> - []; -add_and_rehash(Config) when is_list(Config) -> - Priv = ?config(priv_dir, Config), - WD = filename:dirname(code:which(?MODULE)), - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-pa \"" ++ WD ++ "\""}, - {erl, [this]}]), - CCTabCreated = fun(Tab) -> - case ets:info(Tab, name) of - code_cache -> true; - _ -> false - end - end, - Tabs0 = rpc:call(Node, ets, all, []), - case rpc:call(Node, lists, any, [CCTabCreated,Tabs0]) of - true -> - ?t:stop_node(Node), - ?t:fail("Code cache should not be active!"); - false -> - ok - end, - ok = rpc:call(Node, code, rehash, []), % create cache - Tabs1 = rpc:call(Node, ets, all, []), - true = rpc:call(Node, lists, any, [CCTabCreated,Tabs1]), % cache table created - ok = rpc:call(Node, code, rehash, []), - OkDir = filename:join(Priv, ""), - BadDir = filename:join(Priv, "guggemuffsussiputt"), - CP = [OkDir | rpc:call(Node, code, get_path, [])], - true = rpc:call(Node, code, set_path, [CP]), - CP1 = [BadDir | CP], - {error,_} = rpc:call(Node, code, set_path, [CP1]), - true = rpc:call(Node, code, del_path, [OkDir]), - true = rpc:call(Node, code, add_path, [OkDir]), - true = rpc:call(Node, code, add_path, [OkDir]), - {error,_} = rpc:call(Node, code, add_path, [BadDir]), - ok = rpc:call(Node, code, rehash, []), - - ?t:stop_node(Node), - ok. - -where_is_file_no_cache(suite) -> - []; -where_is_file_no_cache(doc) -> - []; -where_is_file_no_cache(Config) when is_list(Config) -> +where_is_file(Config) when is_list(Config) -> {T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]), io:format("Load time: ~w ms~n", [T]), KernelEbinDir = filename:dirname(KernelBeamFile), @@ -1046,35 +911,6 @@ where_is_file_no_cache(Config) when is_list(Config) -> non_existing = code:where_is_file("kernel"), % no such file ok. -where_is_file_cached(suite) -> - []; -where_is_file_cached(doc) -> - []; -where_is_file_cached(Config) when is_list(Config) -> - {ok,Node} = - ?t:start_node(code_cache_node, peer, [{args, - "-code_path_cache"}, - {erl, [this]}]), - Tabs = rpc:call(Node, ets, all, []), - io:format("Tabs: ~w~n", [Tabs]), - CCTabCreated = fun(Tab) -> - case rpc:call(Node, ets, info, [Tab,name]) of - code_cache -> true; - _ -> false - end - end, - true = lists:any(CCTabCreated, Tabs), - KernelBeamFile = rpc:call(Node, code, where_is_file, ["kernel.beam"]), - {T,KernelBeamFile} = rpc:call(Node, timer, tc, [code,where_is_file,["kernel.beam"]]), - io:format("Load time: ~w ms~n", [T]), - KernelEbinDir = rpc:call(Node, filename, dirname, [KernelBeamFile]), - AppFile = rpc:call(Node, filename, join, [KernelEbinDir,"kernel.app"]), - AppFile = rpc:call(Node, code, where_is_file, ["kernel.app"]), - non_existing = rpc:call(Node, code, where_is_file, ["kernel"]), % no such file - ?t:stop_node(Node), - ok. - - purge_stacktrace(suite) -> []; purge_stacktrace(doc) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 166eb3cef2..960c70f255 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -644,6 +644,8 @@ obsolete_1(httpd_conf, make_integer, 1) -> obsolete_1(random, _, _) -> {deprecated, "the 'random' module is deprecated; " "use the 'rand' module instead"}; +obsolete_1(code, rehash, 0) -> + {deprecated, "deprecated because the code path cache feature has been removed"}; obsolete_1(_, _, _) -> no. -- cgit v1.2.3 From 17582bae6c651747d847726db75664838433681e Mon Sep 17 00:00:00 2001 From: Pavel Abalihin Date: Mon, 14 Dec 2015 19:24:56 +0300 Subject: Don't sort function index when it's not necessary --- lib/edoc/src/edoc_layout.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index b67ec31ae3..f723cd8373 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -180,7 +180,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> FullDesc = get_content(fullDescription, Desc), Functions = [{function_name(E), E} || E <- get_content(functions, Es)], Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], - SortedFs = lists:sort(Functions), + SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); + true -> Functions + end, Body = (navigation("top") ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL] ++ doc_index(FullDesc, Functions, Types) @@ -204,9 +206,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> end ++ types(lists:sort(Types), Opts) ++ function_index(SortedFs, Opts#opts.index_columns) - ++ if Opts#opts.sort_functions -> functions(SortedFs, Opts); - true -> functions(Functions, Opts) - end + ++ functions(SortedFs, Opts) ++ [hr, ?NL] ++ navigation("bottom") ++ timestamp()), -- cgit v1.2.3 From 2af883c62efe6bae1bf9013783f43a5b9848c237 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 7 Dec 2015 13:24:00 +0100 Subject: stdlib: Remove undocumented function specification syntax The syntax -spec/callback F/A :: FunctionType; has been removed. No deprecation was deemed necessary. --- lib/stdlib/src/erl_lint.erl | 25 ++++++++++++------------- lib/stdlib/src/erl_parse.yrl | 14 ++------------ lib/stdlib/test/erl_lint_SUITE.erl | 27 +++++++++++++++++++++++++-- lib/stdlib/test/erl_pp_SUITE.erl | 8 -------- 4 files changed, 39 insertions(+), 35 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 4a4019b8bd..3ce6abe752 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -373,9 +373,9 @@ format_error({spec_fun_undefined, {F, A}}) -> format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> - "spec has the wrong arity"; + "spec has wrong arity"; format_error(callback_wrong_arity) -> - "callback has the wrong arity"; + "callback has wrong arity"; format_error({deprecated_builtin_type, {Name, Arity}, Replacement, Rel}) -> UseS = case Replacement of @@ -2878,7 +2878,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of true -> add_error(Line, {redefine_spec, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, spec_wrong_arity, Arity, St1) end. %% callback_decl(Line, Fun, Types, State) -> State. @@ -2892,7 +2892,8 @@ callback_decl(Line, MFA0, TypeSpecs, St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, case dict:is_key(MFA, Callbacks) of true -> add_error(Line, {redefine_callback, MFA0}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + false -> check_specs(TypeSpecs, callback_wrong_arity, + Arity, St1) end end. @@ -2929,7 +2930,7 @@ is_fa({FuncName, Arity}) when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; is_fa(_) -> false. -check_specs([FunType|Left], Arity, St0) -> +check_specs([FunType|Left], ETag, Arity, St0) -> {FunType1, CTypes} = case FunType of {type, _, bounded_fun, [FT = {type, _, 'fun', _}, Cs]} -> @@ -2937,18 +2938,16 @@ check_specs([FunType|Left], Arity, St0) -> {FT, lists:append(Types0)}; {type, _, 'fun', _} = FT -> {FT, []} end, - SpecArity = - case FunType1 of - {type, L, 'fun', [any, _]} -> any; - {type, L, 'fun', [{type, _, product, D}, _]} -> length(D) - end, + {type, L, 'fun', [{type, _, product, D}, _]} = FunType1, + SpecArity = length(D), St1 = case Arity =:= SpecArity of true -> St0; - false -> add_error(L, spec_wrong_arity, St0) + false -> %% Cannot happen if called from the compiler. + add_error(L, ETag, St0) end, St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), - check_specs(Left, Arity, St2); -check_specs([], _Arity, St) -> + check_specs(Left, ETag, Arity, St2); +check_specs([], _ETag, _Arity, St) -> St. nowarn() -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index ae42a8f0b1..e07ab2efc2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -85,10 +85,6 @@ type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. spec_fun -> atom : '$1'. spec_fun -> atom ':' atom : {'$1', '$3'}. -%% The following two are retained only for backwards compatibility; -%% they are not part of the EEP syntax and should be removed. -spec_fun -> atom '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. @@ -634,14 +630,8 @@ build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> - {Mod,Fun,find_arity_from_specs(TypeSpecs)}; - {{atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Fun,Arity}; - {{atom,_, Mod}, {atom, _, Fun}, {integer, _, Arity}} -> - %% Old style spec. Allow this for now. - {Mod,Fun,Arity} - end, + {Mod,Fun,find_arity_from_specs(TypeSpecs)} + end, {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 1d35cc71a5..3c746a13d7 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1 + maps/1,maps_type/1,otp_11851/1,otp_11879/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +94,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851]. + maps, maps_type, otp_11851, otp_11879]. groups() -> [{unused_vars_warn, [], @@ -3849,6 +3849,29 @@ otp_11851(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +otp_11879(doc) -> + "OTP-11879: The -spec f/a :: (As) -> B; syntax removed, " + "and is_subtype/2 deprecated"; +otp_11879(_Config) -> + Fs = [{attribute,0,file,{"file.erl",0}}, + {attribute,0,module,m}, + {attribute,1,spec, + {{f,1}, + [{type,2,'fun',[{type,3,product,[{var,4,'V1'}, + {var,5,'V1'}]}, + {type,6,integer,[]}]}]}}, + {attribute,20,callback, + {{cb,21}, + [{type,22,'fun',[{type,23,product,[{var,24,'V1'}, + {var,25,'V1'}]}, + {type,6,integer,[]}]}]}}], + {error,[{"file.erl", + [{1,erl_lint,{spec_fun_undefined,{f,1}}}, + {2,erl_lint,spec_wrong_arity}, + {22,erl_lint,callback_wrong_arity}]}], + []} = compile:forms(Fs, [return,report]), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 8cdd2ceca9..d0de600a1d 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1000,18 +1000,10 @@ otp_8567(Config) when is_list(Config) -> "t() ->\n" " 3.\n" "\n" - "-spec(t1/1 :: (ot()) -> ot1()).\n" - "t1(A) ->\n" - " A.\n" - "\n" "-spec(t2 (ot()) -> ot1()).\n" "t2(A) ->\n" " A.\n" "\n" - "-spec(otp_8567:t3/1 :: (ot()) -> ot1()).\n" - "t3(A) ->\n" - " A.\n" - "\n" "-spec(otp_8567:t4 (ot()) -> ot1()).\n" "t4(A) ->\n" " A.\n">>, -- cgit v1.2.3 From ce1cffd6f8812fa6216d9d71afaca20e789b7beb Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 9 Dec 2015 15:05:40 +0100 Subject: dialyzer: Print constraints using the '::' syntax --- lib/dialyzer/src/dialyzer_contracts.erl | 18 +++++++---- lib/dialyzer/test/r9c_SUITE_data/results/mnesia | 2 +- .../results/contracts_with_subtypes | 36 +++++++++++----------- .../results/contracts_with_subtypes2 | 2 +- .../test/small_SUITE_data/results/pretty_bitstring | 2 +- lib/dialyzer/test/user_SUITE_data/results/wsp_pdu | 2 +- 6 files changed, 34 insertions(+), 28 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 7251de8b10..83b3ef72f2 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -126,13 +126,19 @@ butlast([H|T]) -> [H|butlast(T)]. constraints_to_string([]) -> ""; -constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}]) -> - atom_to_list(What) ++ "(" ++ - sequence([erl_types:t_form_to_string(T) || T <- Types], ",") ++ ")"; constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}|Rest]) -> - atom_to_list(What) ++ "(" ++ - sequence([erl_types:t_form_to_string(T) || T <- Types], ",") - ++ "), " ++ constraints_to_string(Rest). + S = constraint_to_string(What, Types), + case Rest of + [] -> S; + _ -> S ++ ", " ++ constraints_to_string(Rest) + end. + +constraint_to_string(is_subtype, [{var, _, Var}, T]) -> + atom_to_list(Var) ++ " :: " ++ erl_types:t_form_to_string(T); +constraint_to_string(What, Types) -> + atom_to_list(What) ++ "(" + ++ sequence([erl_types:t_form_to_string(T) || T <- Types], ",") + ++ ")". sequence([], _Delimiter) -> ""; sequence([H], _Delimiter) -> H; diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index 1dc5a105bf..220b18ca7a 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -6,7 +6,7 @@ mnesia_bup.erl:111: The created fun has no local return mnesia_bup.erl:574: Function fallback_receiver/2 has no local return mnesia_bup.erl:967: Function uninstall_fallback_master/2 has no local return mnesia_checkpoint.erl:1014: The variable Error can never match since previous clauses completely covered the type {'ok',#checkpoint_args{nodes::[any()],retainers::[any(),...]}} -mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when is_subtype(Msg,term()), is_subtype(From,{pid(),Tag::_}), is_subtype(Parent,pid()), is_subtype(Module,module()), is_subtype(Debug,[dbg_opt()]), is_subtype(Misc,term()) +mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> no_return() when Msg :: term(), From :: {pid(),Tag::_}, Parent :: pid(), Module :: module(), Debug :: [dbg_opt()], Misc :: term() mnesia_controller.erl:1666: The variable Tab can never match since previous clauses completely covered the type [any()] mnesia_controller.erl:1679: The pattern {'stop', Reason, Reply, State2} can never match the type {'noreply',_} | {'reply',_,_} | {'stop','shutdown',#state{}} mnesia_controller.erl:1685: The pattern {'noreply', State2, _Timeout} can never match the type {'reply',_,_} 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 a9fbfb6068..d2a3ebb766 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -1,15 +1,15 @@ -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: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: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:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) -contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,ab()) +contracts_with_subtypes.erl:106: The call contracts_with_subtypes:rec_arg({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:107: The call contracts_with_subtypes:rec_arg({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, 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 Arg :: {'a',A} | {'b',B}, A :: 'a' | {'b',B}, B :: 'b' | {'a',A} +contracts_with_subtypes.erl:135: The call contracts_with_subtypes:rec2({'a','b'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:136: The call contracts_with_subtypes:rec2({'b','a'}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:137: The call contracts_with_subtypes:rec2({'a',{'b','a'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:138: The call contracts_with_subtypes:rec2({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:139: The call contracts_with_subtypes:rec2({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:140: The call contracts_with_subtypes:rec2({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:141: The call contracts_with_subtypes:rec2({'a',{'b',{'a',{'b','a'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() +contracts_with_subtypes.erl:142: The call contracts_with_subtypes:rec2({'b',{'a',{'b',{'a','b'}}}}) breaks the contract (Arg) -> 'ok' when Arg :: ab() contracts_with_subtypes.erl:175: The pattern 1 can never match the type string() contracts_with_subtypes.erl:178: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} contracts_with_subtypes.erl:180: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} @@ -24,13 +24,13 @@ contracts_with_subtypes.erl:23: Invalid type specification for function contract contracts_with_subtypes.erl:240: The pattern {'ok', 42} can never match the type {'ok',_,string()} contracts_with_subtypes.erl:241: The pattern 42 can never match the type {'ok',_,string()} contracts_with_subtypes.erl:267: Function flat_ets_new_t/0 has no local return -contracts_with_subtypes.erl:268: 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:268: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], 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:294: Function factored_ets_new_t/0 has no local return -contracts_with_subtypes.erl:295: 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()) +contracts_with_subtypes.erl:295: The call contracts_with_subtypes:factored_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when Name :: atom(), Options :: [Option], Option :: Type | Access | 'named_table' | {'keypos',Pos} | {'heir',Pid::pid(),HeirData} | {'heir','none'} | Tweaks, Type :: type(), Access :: access(), Tweaks :: {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed', Pos :: pos_integer(), HeirData :: term() +contracts_with_subtypes.erl:77: The call contracts_with_subtypes:foo1(5) breaks the contract (Arg1) -> Res when Arg1 :: atom(), Res :: atom() +contracts_with_subtypes.erl:78: The call contracts_with_subtypes:foo2(5) breaks the contract (Arg1) -> Res when Arg1 :: Arg2, Arg2 :: atom(), Res :: atom() +contracts_with_subtypes.erl:79: The call contracts_with_subtypes:foo3(5) breaks the contract (Arg1) -> Res when Arg2 :: atom(), Arg1 :: Arg2, Res :: atom() contracts_with_subtypes.erl:7: Invalid type specification for function contracts_with_subtypes:extract/0. The success typing is () -> 'something' -contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) +contracts_with_subtypes.erl:80: The call contracts_with_subtypes:foo4(5) breaks the contract (Type) -> Type when Type :: atom() contracts_with_subtypes.erl:81: The call contracts_with_subtypes:foo5(5) breaks the contract (Type::atom()) -> Type::atom() -contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when is_subtype(Type,atom()) +contracts_with_subtypes.erl:82: The call contracts_with_subtypes:foo6(5) breaks the contract (Type) -> Type when Type :: 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 index 9f5433a13d..1a8aeb13d0 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes2 @@ -1,3 +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',_}) +contracts_with_subtypes2.erl:19: The call contracts_with_subtypes2:t({'a',{'b',{'c',{'d',{'e',{'g',3}}}}}}) breaks the contract (Arg) -> 'ok' when Arg :: {'a',A}, A :: {'b',B}, B :: {'c',C}, C :: {'d',D}, D :: {'e',E}, E :: {'f',_} diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring index 0ad6eee766..e148e5cf22 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring +++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring @@ -1,3 +1,3 @@ pretty_bitstring.erl:7: Function t/0 has no local return -pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when is_subtype(Subject,binary()), is_subtype(N,non_neg_integer()) +pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() diff --git a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu index d1f8f4caf2..626e677524 100644 --- a/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu +++ b/lib/dialyzer/test/user_SUITE_data/results/wsp_pdu @@ -6,7 +6,7 @@ wsp_pdu.erl:2403: The call wsp_pdu:d_date(Data1::binary()) will never return sin wsp_pdu.erl:2406: Guard test is_integer(Sec::{[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()}) can never succeed wsp_pdu.erl:2408: The pattern {'short', Data2} can never match the type {[byte()] | byte() | {'long',binary()} | {'short',binary()},binary()} wsp_pdu.erl:2755: Function parse_push_flag/1 has no local return -wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when is_subtype(Integer,integer()) +wsp_pdu.erl:2756: The call erlang:integer_to_list(Value::[any()]) breaks the contract (Integer) -> string() when Integer :: integer() wsp_pdu.erl:2875: The call wsp_pdu:d_text_string(Data::byte()) will never return since it differs in the 1st argument from the success typing arguments: (binary()) wsp_pdu.erl:2976: The call wsp_pdu:d_q_value(QData::byte()) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>>) wsp_pdu.erl:3336: The call wsp_pdu:encode_typed_field(Ver::any(),'Q-value',ParamValue::any()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),'Constrained-encoding' | 'Date-value' | 'No-value' | 'Short-integer' | 'Text-string' | 'Text-value' | 'Well-known-charset',any()) -- cgit v1.2.3 From 5a66cd64bc814b66c88b79a044f1f1512b21df6d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 9 Dec 2015 15:19:05 +0100 Subject: doc: Remove 'is_subtype' from Types and Function Specifications It is harder to remove is_subtype from the parser since the abstract format does not separate is_subtype from the '::' syntax. --- system/doc/reference_manual/typespec.xml | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index 22627058c1..a238e3135a 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -495,7 +495,8 @@ 

  -spec id(X) -> X when X :: tuple().

- Currently, the :: constraint (read as is_subtype) is + Currently, the :: constraint + (read as «is a subtype of») is the only guard constraint that can be used in the 'when' part of a '-spec' attribute.

@@ -529,16 +530,6 @@ 
   -spec foo({X, integer()}) -> X when X :: atom()
          ; ([Y]) -> Y when Y :: number().
- -

- For backwards compatibility the following form is also allowed: -

- 
  -spec id(X) -> X when is_subtype(X, tuple()).
-

- but its use is discouraged. It will be removed in a future - Erlang/OTP release. -

-

Some functions in Erlang are not meant to return; either because they define servers or because they are used to -- cgit v1.2.3 From f8eb1fa88f93487c15ce0834f373cad790159680 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 11 Dec 2015 12:16:06 +0100 Subject: debugger: Use '::' for constraints --- lib/debugger/src/dbg_iload.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 7746a06fcb..369b456524 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -39,7 +39,7 @@ %% dbg_iserver. We are suspended until the module has been loaded. %%-------------------------------------------------------------------- -spec load_mod(Mod, file:filename(), binary(), ets:tid()) -> - {'ok', Mod} when is_subtype(Mod, atom()). + {'ok', Mod} when Mod :: atom(). load_mod(Mod, File, Binary, Db) -> Flag = process_flag(trap_exit, true), -- cgit v1.2.3 From b08742128224c2d9860a97444d22064b4ecbb54d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 11 Dec 2015 12:16:17 +0100 Subject: hipe: Use '::' for constraints --- lib/hipe/icode/hipe_icode.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 9692eebb10..07d230491d 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -1376,12 +1376,12 @@ remove_constants(L) -> %% Substitution: replace occurrences of X by Y if {X,Y} is in the %% Subst_list. --spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst([{_,_}], I) -> I when I :: icode_instr(). subst(Subst, I) -> subst_defines(Subst, subst_uses(Subst, I)). --spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_uses([{_,_}], I) -> I when I :: icode_instr(). subst_uses(Subst, I) -> case I of @@ -1405,7 +1405,7 @@ subst_uses(Subst, I) -> #icode_label{} -> I end. --spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_defines([{_,_}], I) -> I when I :: icode_instr(). subst_defines(Subst, I) -> case I of -- cgit v1.2.3 From 57a1eebddcbbc4f3f9734fb5cff8f9b40e1b2c2d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 11 Dec 2015 12:16:27 +0100 Subject: stdlib: Add a comment about is_subtype(_, _) constraints --- lib/stdlib/test/erl_pp_SUITE.erl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index d0de600a1d..8a128b3815 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -876,6 +876,9 @@ type_examples() -> {ex30,<<"-type t99() ::" "{t2(),'\\'t::4'(),t5(),t6(),t7(),t8(),t10(),t14()," "t15(),t20(),t21(), t22(),t25()}. ">>}, + %% Writing constraints as is_subtype(V, T) is not supported since + %% Erlang/OTP 19.0, but as long as the parser recognizes the + %% is_subtype(V, T) syntax, we need a few examples of the syntax. {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" "(t2()) -> t2();" "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);" -- cgit v1.2.3 From 4b98e710b9c45481c1cdc7a4ee68f7ce7fca908a Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 13 Jul 2015 15:38:41 +0200 Subject: erts: Add support for asynchronous open_port OTP-13086 --- erts/doc/src/driver_entry.xml | 9 +++++- erts/doc/src/erl_driver.xml | 28 +++++++++++++++++ erts/emulator/beam/atom.names | 1 + erts/emulator/beam/bif.tab | 2 +- erts/emulator/beam/erl_bif_port.c | 54 +++++++++++++++++++++++++------- erts/emulator/beam/erl_driver.h | 4 +++ erts/emulator/beam/erl_port.h | 5 +++ erts/emulator/beam/io.c | 60 ++++++++++++++++++++++++++++++++++++ erts/preloaded/src/erlang.erl | 10 ++++-- erts/preloaded/src/erts_internal.erl | 9 +++++- 10 files changed, 166 insertions(+), 16 deletions(-) diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml index c802693977..ae7f264d0c 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -437,7 +437,14 @@ typedef struct erl_drv_entry { erl_drv_busy_msgq_limits() function. - + ERL_DRV_FLAG_USE_INIT_ACK + When this flag is given the linked-in driver has to manually + acknowledge that the port has been successfully started using + erl_drv_init_ack(). + This allows the implementor to make the erlang:open_port exit with + badarg after some initial asynchronous initialization has been done. + + void *handle2 diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index f7b4187b80..a2a1df37e5 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -2130,6 +2130,34 @@ ERL_DRV_MAP int sz + + voiderl_drv_init_ack(ErlDrvPort port, ErlDrvData res) + Acknowledge the start of the port + + +

Arguments:

+ + port + The port handle of the port (driver instance) creating + doing the acknowledgment. + + res + The result of the port initialization. This can be the same values + as the return value of start, + i.e any of the error codes or the ErlDrvData that is to be used for this + port. + + +

+ When this function is called the initiating erlang:open_port call is + returned as if the start + function had just been called. It can only be used when the + ERL_DRV_FLAG_USE_INIT_ACK + flag has been set on the linked-in driver. +

+ + + interl_drv_thread_create(char *name, ErlDrvTid *tid, diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 967cf013f0..f20d99f114 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -209,6 +209,7 @@ atom dsend_continue_trap atom dunlink atom duplicate_bag atom dupnames +atom einval atom elib_malloc atom emulator atom enable_trace diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 65f8d6f1f5..884555dee2 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -115,7 +115,7 @@ bif erlang:time_offset/0 bif erlang:time_offset/1 bif erlang:timestamp/0 -bif erlang:open_port/2 +bif erts_internal:open_port/2 bif erlang:pid_to_list/1 bif erlang:ports/0 diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index e47d7bcbbb..839abd0424 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -41,6 +41,7 @@ #include "external.h" #include "packet_parser.h" #include "erl_bits.h" +#include "erl_bif_unique.h" #include "dtrace-wrapper.h" static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump); @@ -50,10 +51,10 @@ static void free_args(char **); char *erts_default_arg0 = "default"; -BIF_RETTYPE open_port_2(BIF_ALIST_2) +BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2) { Port *port; - Eterm port_id; + Eterm res; char *str; int err_type, err_num; @@ -61,27 +62,58 @@ BIF_RETTYPE open_port_2(BIF_ALIST_2) if (!port) { if (err_type == -3) { ASSERT(err_num == BADARG || err_num == SYSTEM_LIMIT); - BIF_ERROR(BIF_P, err_num); + if (err_num == BADARG) + res = am_badarg; + else if (err_num == SYSTEM_LIMIT) + res = am_system_limit; + else + /* this is only here to silence gcc, it should not happen */ + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); } else if (err_type == -2) { str = erl_errno_id(err_num); + res = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1); } else { - str = "einval"; + res = am_einval; } - BIF_P->fvalue = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1); - BIF_ERROR(BIF_P, EXC_ERROR); - } + BIF_RET(res); + } + + if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) { + /* Copied from erl_port_task.c */ + port->async_open_port = erts_alloc(ERTS_ALC_T_PRTSD, + sizeof(*port->async_open_port)); + erts_make_ref_in_array(port->async_open_port->ref); + port->async_open_port->to = BIF_P->common.id; + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK); + if (ERTS_PROC_PENDING_EXIT(BIF_P)) { + /* need to exit caller instead */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK); + KILL_CATCHES(BIF_P); + BIF_P->freason = EXC_EXIT; + erts_port_release(port); + BIF_RET(am_badarg); + } + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(BIF_P); + BIF_P->msg.save = BIF_P->msg.last; - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE); + + res = erts_proc_store_ref(BIF_P, port->async_open_port->ref); + } else { + res = port->common.id; + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + } - port_id = port->common.id; erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id); - erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port_id); + erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id); erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); erts_port_release(port); - BIF_RET(port_id); + BIF_RET(res); } static ERTS_INLINE Port * diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index e71b87803b..5f2115ef7f 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -163,6 +163,7 @@ typedef struct { #define ERL_DRV_FLAG_USE_PORT_LOCKING (1 << 0) #define ERL_DRV_FLAG_SOFT_BUSY (1 << 1) #define ERL_DRV_FLAG_NO_BUSY_MSGQ (1 << 2) +#define ERL_DRV_FLAG_USE_INIT_ACK (1 << 3) /* * Integer types @@ -690,6 +691,9 @@ 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); +/* spawn start init ack */ +EXTERN void erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res); + #endif /* !ERL_DRIVER_TYPES_ONLY */ #ifdef WIN32_DYNAMIC_ERL_DRIVER diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index acd68ef0ad..bc4b412594 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -187,6 +187,11 @@ struct _erl_drv_port { ErtsPrtSD *psd; /* Port specific data */ int reds; /* Only used while executing driver callbacks */ + + struct { + Eterm to; + Uint32 ref[ERTS_MAX_REF_NUMBERS]; + } *async_open_port; /* Reference used with async open port */ }; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index fdd26fcc4b..409df846e9 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -84,6 +84,7 @@ static void deliver_result(Eterm sender, Eterm pid, Eterm res); static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *); static void terminate_port(Port *p); static void pdl_init(void); +static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof); #ifdef ERTS_SMP static void driver_monitor_lock_pdl(Port *p); static void driver_monitor_unlock_pdl(Port *p); @@ -383,6 +384,7 @@ static Port *create_port(char *name, ERTS_PTMR_INIT(prt); erts_port_task_handle_init(&prt->timeout_task); prt->psd = NULL; + prt->async_open_port = NULL; prt->drv_data = (SWord) 0; prt->os_pid = -1; @@ -2732,6 +2734,61 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp) port_sig_link); } +static void +init_ack_send_reply(Port *port, Eterm resp) +{ + + if (!is_internal_port(resp)) { + Process *rp = erts_proc_lookup_raw(port->async_open_port->to); + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK); + erts_remove_link(&ERTS_P_LINKS(port), port->async_open_port->to); + erts_remove_link(&ERTS_P_LINKS(rp), port->common.id); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + port_sched_op_reply(port->async_open_port->to, + port->async_open_port->ref, + resp); + + erts_free(ERTS_ALC_T_PRTSD, port->async_open_port); + port->async_open_port = NULL; +} + +void +erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) { + Port *port = erts_drvport2port(ix); + SWord err_type = (SWord)res; + Eterm resp; + + if (port == ERTS_INVALID_ERL_DRV_PORT && port->async_open_port) + return; + + if (port->async_open_port) { + switch(err_type) { + case -3: + resp = am_badarg; + break; + case -2: { + char *str = erl_errno_id(errno); + resp = erts_atom_put((byte *) str, strlen(str), + ERTS_ATOM_ENC_LATIN1, 1); + break; + } + case -1: + resp = am_einval; + break; + default: + resp = port->common.id; + break; + } + + init_ack_send_reply(port, resp); + + if (err_type == -1 || err_type == -2 || err_type == -3) + driver_failure_term(ix, am_normal, 0); + port->drv_data = err_type; + } +} + void erts_init_io(int port_tab_size, int port_tab_size_ignore_files, int legacy_port_tab) @@ -6972,6 +7029,9 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt->async_open_port) + init_ack_send_reply(prt, prt->common.id); if (eof) flush_linebuf_messages(prt, state); if (state & ERTS_PORT_SFLG_CLOSING) { diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 7280b43502..4c22c596eb 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2027,8 +2027,14 @@ nodes(_Arg) -> | eof | {parallelism, Boolean :: boolean()} | hide. -open_port(_PortName,_PortSettings) -> - erlang:nif_error(undefined). +open_port(PortName, PortSettings) -> + case case erts_internal:open_port(PortName, PortSettings) of + Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end; + Res -> Res + end of + Port when erlang:is_port(Port) -> Port; + Error -> erlang:error(Error, [PortName, PortSettings]) + end. -type priority_level() :: low | normal | high | max. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 7ed4efea4b..81202ed3e2 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -32,7 +32,7 @@ -export([await_port_send_result/3]). -export([cmp_term/2]). -export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]). --export([port_command/3, port_connect/2, port_close/1, +-export([open_port/2, port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). -export([request_system_task/3]). @@ -88,6 +88,13 @@ gather_io_bytes(Ref, No, InAcc, OutAcc) -> %% Statically linked port NIFs %% +-spec erts_internal:open_port(PortName, PortSettings) -> Result when + PortName :: tuple(), + PortSettings :: term(), + Result :: port() | reference() | atom(). +open_port(_PortName, _PortSettings) -> + erlang:nif_error(undefined). + -spec erts_internal:port_command(Port, Data, OptionList) -> Result when Port :: port() | atom(), Data :: iodata(), -- cgit v1.2.3 From 91c1876f70870f450f7e8fd3b02f2396067e3cb8 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 14 Jul 2015 11:07:33 +0200 Subject: erts: Add erl_drv_set_pid OTP-13087 --- erts/doc/src/erl_driver.xml | 19 +++++++++++++++++++ erts/emulator/beam/erl_driver.h | 3 +++ erts/emulator/beam/io.c | 11 +++++++++++ 3 files changed, 33 insertions(+) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index a2a1df37e5..ef6d69cbeb 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -2158,6 +2158,25 @@ ERL_DRV_MAP int sz + + voiderl_drv_set_os_pid(ErlDrvPort port, ErlDrvSInt pid) + Set the os_pid for the port + + +

Arguments:

+ + port + The port handle of the port (driver instance) to set the pid on. + + pid + The pid to set. + +

+ Set the os_pid seen when doing erlang:port_info/2 on this port. +

+ + + interl_drv_thread_create(char *name, ErlDrvTid *tid, diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 5f2115ef7f..3d663655a2 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -694,6 +694,9 @@ EXTERN int erl_drv_getenv(char *key, char *value, size_t *value_size); /* spawn start init ack */ EXTERN void erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res); +/* set the pid seen in port_info */ +EXTERN void erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid); + #endif /* !ERL_DRIVER_TYPES_ONLY */ #ifdef WIN32_DYNAMIC_ERL_DRIVER diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 409df846e9..2a3759212e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -2789,6 +2789,17 @@ erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) { } } +void +erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid) { + Port *port = erts_drvport2port(ix); + + if (port == ERTS_INVALID_ERL_DRV_PORT) + return; + + port->os_pid = (SWord)pid; + +} + void erts_init_io(int port_tab_size, int port_tab_size_ignore_files, int legacy_port_tab) -- cgit v1.2.3 From 31b8dd2b4b5259d9ed2178017c3580c42bf62ec6 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 12 Aug 2015 10:21:09 +0200 Subject: erts: Bump driver minor version --- erts/emulator/beam/erl_driver.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 3d663655a2..ef7792ecab 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -125,7 +125,7 @@ typedef struct { #define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed) #define ERL_DRV_EXTENDED_MAJOR_VERSION 3 -#define ERL_DRV_EXTENDED_MINOR_VERSION 2 +#define ERL_DRV_EXTENDED_MINOR_VERSION 3 /* * The emulator will refuse to load a driver with a major version -- cgit v1.2.3 From 17ecb94437bac6726044d299dde48d02dd2b2e9c Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 14 Jul 2015 15:20:16 +0200 Subject: erts: Refactor out erts functions from hash --- erts/emulator/beam/atom.c | 3 +++ erts/emulator/beam/erl_fun.c | 3 +++ erts/emulator/beam/erl_node_tables.c | 12 ++++++++---- erts/emulator/beam/erl_node_tables.h | 1 + erts/emulator/beam/export.c | 3 +++ erts/emulator/beam/hash.c | 30 +++++++++++++++--------------- erts/emulator/beam/hash.h | 20 +++++++++++++------- erts/emulator/beam/index.h | 4 ++++ erts/emulator/beam/module.c | 3 +++ erts/emulator/beam/register.c | 3 +++ erts/emulator/hipe/hipe_bif0.c | 12 ++++++++++++ 11 files changed, 68 insertions(+), 26 deletions(-) diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index fe91134ef4..fd2adac676 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -435,6 +435,9 @@ init_atom_table(void) f.cmp = (HCMP_FUN) atom_cmp; f.alloc = (HALLOC_FUN) atom_alloc; f.free = (HFREE_FUN) atom_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; atom_text_pos = NULL; atom_text_end = NULL; diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c index 4268e2d40a..cff476694c 100644 --- a/erts/emulator/beam/erl_fun.c +++ b/erts/emulator/beam/erl_fun.c @@ -66,6 +66,9 @@ erts_init_fun_table(void) f.cmp = (HCMP_FUN) fun_cmp; f.alloc = (HALLOC_FUN) fun_alloc; f.free = (HFREE_FUN) fun_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_FUN_TABLE, &erts_fun_table, "fun_table", 16, f); } diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 62a44f7129..e5bd0d58f0 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -793,10 +793,14 @@ void erts_init_node_tables(int dd_sec) rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; - f.hash = (H_FUN) dist_table_hash; - f.cmp = (HCMP_FUN) dist_table_cmp; - f.alloc = (HALLOC_FUN) dist_table_alloc; - f.free = (HFREE_FUN) dist_table_free; + f.hash = (H_FUN) dist_table_hash; + f.cmp = (HCMP_FUN) dist_table_cmp; + f.alloc = (HALLOC_FUN) dist_table_alloc; + f.free = (HFREE_FUN) dist_table_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; + erts_this_dist_entry = erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); dist_entries = 1; diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 64278d2ea0..fb2f2a5407 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -41,6 +41,7 @@ #include "sys.h" #include "hash.h" +#include "erl_alloc.h" #include "erl_process.h" #include "erl_monitors.h" #include "erl_smp.h" diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index 2420df36b5..581efe6eec 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -184,6 +184,9 @@ init_export_table(void) f.cmp = (HCMP_FUN) export_cmp; f.alloc = (HALLOC_FUN) export_alloc; f.free = (HFREE_FUN) export_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; for (i=0; ifun.meta_print(to, arg, "=hash_table:%s\n", hi.name); + h->fun.meta_print(to, arg, "size: %d\n", hi.size); + h->fun.meta_print(to, arg, "used: %d\n", hi.used); + h->fun.meta_print(to, arg, "objs: %d\n", hi.objs); + h->fun.meta_print(to, arg, "depth: %d\n", hi.depth); } @@ -123,22 +123,22 @@ hash_table_sz(Hash *h) ** init a pre allocated or static hash structure ** and allocate buckets. */ -Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions fun) +Hash* hash_init(int type, Hash* h, char* name, int size, HashFunctions fun) { int sz; int ix = 0; - h->type = type; + h->meta_alloc_type = type; while (h_size_table[ix] != -1 && h_size_table[ix] < size) ix++; if (h_size_table[ix] == -1) - erl_exit(1, "panic: too large hash table size (%d)\n", size); + return NULL; size = h_size_table[ix]; sz = size*sizeof(HashBucket*); - h->bucket = (HashBucket**) erts_alloc(h->type, sz); + h->bucket = (HashBucket**) fun.meta_alloc(h->meta_alloc_type, sz); sys_memzero(h->bucket, sz); h->is_allocated = 0; @@ -155,11 +155,11 @@ Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions /* ** Create a new hash table */ -Hash* hash_new(ErtsAlcType_t type, char* name, int size, HashFunctions fun) +Hash* hash_new(int type, char* name, int size, HashFunctions fun) { Hash* h; - h = erts_alloc(type, sizeof(Hash)); + h = fun.meta_alloc(type, sizeof(Hash)); h = hash_init(type, h, name, size, fun); h->is_allocated = 1; @@ -183,9 +183,9 @@ void hash_delete(Hash* h) b = b_next; } } - erts_free(h->type, h->bucket); + h->fun.meta_free(h->meta_alloc_type, h->bucket); if (h->is_allocated) - erts_free(h->type, (void*) h); + h->fun.meta_free(h->meta_alloc_type, (void*) h); } /* @@ -213,7 +213,7 @@ static void rehash(Hash* h, int grow) h->size80percent = (4*h->size)/5; sz = h->size*sizeof(HashBucket*); - new_bucket = (HashBucket **) erts_alloc(h->type, sz); + new_bucket = (HashBucket **) h->fun.meta_alloc(h->meta_alloc_type, sz); sys_memzero(new_bucket, sz); h->used = 0; @@ -230,7 +230,7 @@ static void rehash(Hash* h, int grow) b = b_next; } } - erts_free(h->type, (void *) h->bucket); + h->fun.meta_free(h->meta_alloc_type, (void *) h->bucket); h->bucket = new_bucket; } diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h index 87fdb360e3..e98f6c32e1 100644 --- a/erts/emulator/beam/hash.h +++ b/erts/emulator/beam/hash.h @@ -29,14 +29,17 @@ #include "sys.h" #endif -#include "erl_alloc.h" - typedef unsigned long HashValue; +typedef struct hash Hash; typedef int (*HCMP_FUN)(void*, void*); typedef HashValue (*H_FUN)(void*); typedef void* (*HALLOC_FUN)(void*); typedef void (*HFREE_FUN)(void*); +/* Meta functions */ +typedef void* (*HMALLOC_FUN)(int,size_t); +typedef void (*HMFREE_FUN)(int,void*); +typedef int (*HMPRINT_FUN)(int,void*,char*, ...); /* ** This bucket must be placed in top of @@ -55,6 +58,9 @@ typedef struct hash_functions HCMP_FUN cmp; HALLOC_FUN alloc; HFREE_FUN free; + HMALLOC_FUN meta_alloc; + HMFREE_FUN meta_free; + HMPRINT_FUN meta_print; } HashFunctions; typedef struct { @@ -65,11 +71,11 @@ typedef struct { int depth; } HashInfo; -typedef struct hash +struct hash { HashFunctions fun; /* Function block */ int is_allocated; /* 0 iff hash structure is on stack or is static */ - ErtsAlcType_t type; + int meta_alloc_type; /* argument to pass to meta_alloc and meta_free */ char* name; /* Table name (static string, for debugging) */ int size; /* Number of slots */ int size20percent; /* 20 percent of number of slots */ @@ -77,10 +83,10 @@ typedef struct hash int ix; /* Size index in size table */ int used; /* Number of slots used */ HashBucket** bucket; /* Vector of bucket pointers (objects) */ -} Hash; +}; -Hash* hash_new(ErtsAlcType_t, char*, int, HashFunctions); -Hash* hash_init(ErtsAlcType_t, Hash*, char*, int, HashFunctions); +Hash* hash_new(int, char*, int, HashFunctions); +Hash* hash_init(int, Hash*, char*, int, HashFunctions); void hash_delete(Hash*); void hash_get_info(HashInfo*, Hash*); diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h index 14fab41026..99b2bdfab0 100644 --- a/erts/emulator/beam/index.h +++ b/erts/emulator/beam/index.h @@ -30,6 +30,10 @@ #include "hash.h" #endif +#ifndef ERL_ALLOC_H__ +#include "erl_alloc.h" +#endif + typedef struct index_slot { HashBucket bucket; diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c index 86dd3b5aac..2db6f957c6 100644 --- a/erts/emulator/beam/module.c +++ b/erts/emulator/beam/module.c @@ -103,6 +103,9 @@ void init_module_table(void) f.cmp = (HCMP_FUN) module_cmp; f.alloc = (HALLOC_FUN) module_alloc; f.free = (HFREE_FUN) module_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; for (i = 0; i < ERTS_NUM_CODE_IX; i++) { erts_index_init(ERTS_ALC_T_MODULE_TABLE, &module_tables[i], "module_code", diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c index 7ade8bca0f..fdb6cbc813 100644 --- a/erts/emulator/beam/register.c +++ b/erts/emulator/beam/register.c @@ -151,6 +151,9 @@ void init_register_table(void) f.cmp = (HCMP_FUN) reg_cmp; f.alloc = (HALLOC_FUN) reg_alloc; f.free = (HFREE_FUN) reg_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_REG_TABLE, &process_reg, "process_reg", PREG_HASH_SIZE, f); diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index cc68e1f74d..70a57ba465 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -507,6 +507,9 @@ static void init_const_term_table(void) f.cmp = (HCMP_FUN) const_term_cmp; f.alloc = (HALLOC_FUN) const_term_alloc; f.free = (HFREE_FUN) NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f); } @@ -715,6 +718,9 @@ static void init_nbif_table(void) f.cmp = (HCMP_FUN) nbif_cmp; f.alloc = (HALLOC_FUN) nbif_alloc; f.free = NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f); @@ -808,6 +814,9 @@ static void init_primop_table(void) f.cmp = (HCMP_FUN) primop_cmp; f.alloc = (HALLOC_FUN) primop_alloc; f.free = NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f); @@ -1826,6 +1835,9 @@ static void init_modinfo_table(void) f.cmp = (HCMP_FUN) modinfo_cmp; f.alloc = (HALLOC_FUN) modinfo_alloc; f.free = (HFREE_FUN) NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f); } -- cgit v1.2.3 From 37f057fca161373bf565ea1bf24fbe89d4946b48 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 14 Jul 2015 15:42:29 +0200 Subject: erts: Rename sys driver structs --- erts/emulator/sys/unix/sys.c | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 8d7da3e47e..5f7f07940d 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -143,7 +143,7 @@ typedef struct ErtsSysBlocking_ { /* This data is shared by these drivers - initialized by spawn_init() */ -static struct driver_data { +typedef struct driver_data { ErlDrvPort port_num; int ofd, packet_bytes; ErtsSysReportExit *report_exit; @@ -152,7 +152,9 @@ static struct driver_data { int status; int terminating; ErtsSysBlocking *blocking; -} *driver_data; /* indexed by fd */ +} ErtsSysDriverData; + +static ErtsSysDriverData *driver_data; /* indexed by fd */ static ErtsSysReportExit *report_exit_list; #if CHLDWTHR && !defined(ERTS_SMP) @@ -257,14 +259,16 @@ static volatile int children_died; #endif -static struct fd_data { +typedef struct ErtsSysFdData { 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 */ +} ErtsSysFdData; + +static ErtsSysFdData *fd_data; /* indexed by fd */ /* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ static void note_child_death(int, int); @@ -1233,7 +1237,7 @@ static RETSIGTYPE onchld(int signum) #endif } -static int set_blocking_data(struct driver_data *dd) { +static int set_blocking_data(ErtsSysDriverData *dd) { dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); @@ -1329,10 +1333,10 @@ static int spawn_init() #endif sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ - driver_data = (struct driver_data *) - erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); + driver_data = (ErtsSysDriverData *) + erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(ErtsSysDriverData)); erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(struct driver_data)); + max_files * sizeof(ErtsSysDriverData)); for (i = 0; i < max_files; i++) driver_data[i].pid = -1; @@ -2523,7 +2527,7 @@ static void fd_async(void *async_data) { int res; - struct driver_data *dd = (struct driver_data*)async_data; + ErtsSysDriverData *dd = (ErtsSysDriverData*)async_data; SysIOVec *iov0; SysIOVec *iov; int iovlen; @@ -2556,7 +2560,7 @@ fd_async(void *async_data) void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data) { - struct driver_data *dd = (struct driver_data *)thread_data; + ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data; ErlDrvPort port_num = dd->port_num; ASSERT(dd->blocking); @@ -2738,10 +2742,10 @@ erts_sys_unsetenv(char *key) void sys_init_io(void) { - fd_data = (struct fd_data *) - erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); + fd_data = (ErtsSysFdData *) + erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(ErtsSysFdData)); erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(struct fd_data)); + max_files * sizeof(ErtsSysFdData)); } #if (0) /* unused? */ -- cgit v1.2.3 From fdc2ce62a041d34cd99413e278e7dd8ff79832d1 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 26 Aug 2015 11:18:29 +0200 Subject: erts: Change name of child_setup to erl_child_setup --- erts/emulator/Makefile.in | 2 +- erts/emulator/sys/unix/sys.c | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index c5080d5b5d..802de21ef0 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -398,7 +398,7 @@ EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll else EMULATOR_EXECUTABLE = beam$(TF_MARKER) endif -CS_EXECUTABLE = child_setup$(TYPEMARKER) +CS_EXECUTABLE = erl_child_setup$(TYPEMARKER) # ---------------------------------------------------------------------- diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 5f7f07940d..1cb7f72a2b 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -195,10 +195,8 @@ extern void erl_crash_dump(char* file, int line, char* fmt, ...); #define ERL_BUILD_TYPE_MARKER #endif -#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER -#if !DISABLE_VFORK +#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER static char *child_setup_prog; -#endif #ifdef DEBUG static int debug_log = 0; -- cgit v1.2.3 From 6089f3c961a981b6bacb6c1590386bb67905ff23 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 26 Aug 2015 14:43:20 +0200 Subject: erts: Move sys drivers to another file --- erts/emulator/Makefile.in | 1 + erts/emulator/sys/unix/erl_unix_sys.h | 16 + erts/emulator/sys/unix/sys.c | 1914 +------------------------------ erts/emulator/sys/unix/sys_drivers.c | 1983 +++++++++++++++++++++++++++++++++ 4 files changed, 2004 insertions(+), 1910 deletions(-) create mode 100644 erts/emulator/sys/unix/sys_drivers.c diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 802de21ef0..69f28b0c10 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -798,6 +798,7 @@ OS_OBJS = \ else OS_OBJS = \ $(OBJDIR)/sys.o \ + $(OBJDIR)/sys_drivers.o \ $(OBJDIR)/driver_tab.o \ $(OBJDIR)/unix_efile.o \ $(OBJDIR)/gzio.o \ diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 8d4e98bf3a..a11a44c259 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -470,4 +470,20 @@ extern jmp_buf erts_sys_sigsegv_jmp; } while(0) #endif +#ifdef USE_THREADS +# ifdef ENABLE_CHILD_WAITER_THREAD +# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD +# else +# define CHLDWTHR 0 +# endif +# define FDBLOCK 1 +#else +# define CHLDWTHR 0 +# define FDBLOCK 0 +#endif + +#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 + +int check_children(void); + #endif /* #ifndef _ERL_UNIX_SYS_H */ diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 1cb7f72a2b..503ef5c2f6 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -67,7 +67,7 @@ #include "erl_mseg.h" extern char **environ; -static erts_smp_rwmtx_t environ_rwmtx; +erts_smp_rwmtx_t environ_rwmtx; #define MAX_VSIZE 16 /* Max number of entries allowed in an I/O * vector sock_sendv(). @@ -76,91 +76,12 @@ static erts_smp_rwmtx_t environ_rwmtx; * Don't need global.h, but bif_table.h (included by bif.h), * won't compile otherwise */ -#include "global.h" +#include "global.h" #include "bif.h" -#include "erl_sys_driver.h" #include "erl_check_io.h" #include "erl_cpu_topology.h" -#ifndef DISABLE_VFORK -#define DISABLE_VFORK 0 -#endif - -#if defined IOV_MAX -#define MAXIOV IOV_MAX -#elif defined UIO_MAXIOV -#define MAXIOV UIO_MAXIOV -#else -#define MAXIOV 16 -#endif - -#ifdef USE_THREADS -# ifdef ENABLE_CHILD_WAITER_THREAD -# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD -# else -# define CHLDWTHR 0 -# endif -# define FDBLOCK 1 -#else -# define CHLDWTHR 0 -# define FDBLOCK 0 -#endif -/* - * [OTP-3906] - * Solaris signal management gets confused when threads are used and a - * lot of child processes dies. The confusion results in that SIGCHLD - * signals aren't delivered to the emulator which in turn results in - * a lot of defunct processes in the system. - * - * The problem seems to appear when a signal is frequently - * blocked/unblocked at the same time as the signal is frequently - * propagated. The child waiter thread is a workaround for this problem. - * The SIGCHLD signal is always blocked (in all threads), and the child - * waiter thread fetches the signal by a call to sigwait(). See - * child_waiter(). - */ - -typedef struct ErtsSysReportExit_ ErtsSysReportExit; -struct ErtsSysReportExit_ { - ErtsSysReportExit *next; - Eterm port; - int pid; - int ifd; - int ofd; -#if CHLDWTHR && !defined(ERTS_SMP) - int status; -#endif -}; - -/* Used by the fd driver iff the fd could not be set to non-blocking */ -typedef struct ErtsSysBlocking_ { - ErlDrvPDL pdl; - int res; - int err; - unsigned int pkey; -} ErtsSysBlocking; - - -/* This data is shared by these drivers - initialized by spawn_init() */ -typedef struct driver_data { - ErlDrvPort port_num; - int ofd, packet_bytes; - ErtsSysReportExit *report_exit; - int pid; - int alive; - int status; - int terminating; - ErtsSysBlocking *blocking; -} ErtsSysDriverData; - -static ErtsSysDriverData *driver_data; /* indexed by fd */ - -static ErtsSysReportExit *report_exit_list; -#if CHLDWTHR && !defined(ERTS_SMP) -static ErtsSysReportExit *report_exit_transit_list; -#endif - extern int driver_interrupt(int, int); extern void do_break(void); @@ -172,32 +93,6 @@ extern void erts_sys_init_float(void); 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) -#define ERL_BUILD_TYPE_MARKER ".purify" -#elif defined(QUANTIFY) -#define ERL_BUILD_TYPE_MARKER ".quantify" -#elif defined(PURECOV) -#define ERL_BUILD_TYPE_MARKER ".purecov" -#elif defined(VALGRIND) -#define ERL_BUILD_TYPE_MARKER ".valgrind" -#else /* opt */ -#define ERL_BUILD_TYPE_MARKER -#endif - -#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER -static char *child_setup_prog; - #ifdef DEBUG static int debug_log = 0; #endif @@ -220,61 +115,18 @@ static volatile int have_prepared_crash_dump; (have_prepared_crash_dump++) #endif -static erts_smp_atomic_t sys_misc_mem_sz; +erts_smp_atomic_t sys_misc_mem_sz; #if defined(ERTS_SMP) static void smp_sig_notify(char c); static int sig_notify_fds[2] = {-1, -1}; static int sig_suspend_fds[2] = {-1, -1}; -#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 #endif jmp_buf erts_sys_sigsegv_jmp; -#if CHLDWTHR || defined(ERTS_SMP) -erts_mtx_t chld_stat_mtx; -#endif -#if CHLDWTHR -static erts_tid_t child_waiter_tid; -/* chld_stat_mtx is used to protect against concurrent accesses - of the driver_data fields pid, alive, and status. */ -erts_cnd_t chld_stat_cnd; -static long children_alive; -#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) -#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) -#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx) -#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd) -#elif 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 - - -typedef struct ErtsSysFdData { - char pbuf[4]; /* hold partial packet bytes */ - int psz; /* size of pbuf */ - char *buf; - char *cpos; - int sz; - int remain; /* for input on fd */ -} ErtsSysFdData; - -static ErtsSysFdData *fd_data; /* indexed by fd */ - -/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ -static void note_child_death(int, int); - -#if CHLDWTHR -static void* child_waiter(void *); -#endif - static int crashdump_companion_cube_fd = -1; /********************* General functions ****************************/ @@ -559,8 +411,6 @@ erts_sys_pre_init(void) erts_thr_init(&eid); - report_exit_list = NULL; - #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_init(); #endif @@ -571,17 +421,6 @@ erts_sys_pre_init(void) #ifdef USE_THREADS -#if CHLDWTHR || defined(ERTS_SMP) - erts_mtx_init(&chld_stat_mtx, "child_status"); -#endif -#if CHLDWTHR -#ifndef ERTS_SMP - report_exit_transit_list = NULL; -#endif - erts_cnd_init(&chld_stat_cnd); - children_alive = 0; -#endif - #ifdef ERTS_SMP erts_smp_atomic32_init_nob(&erts_break_requested, 0); erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0); @@ -591,9 +430,6 @@ erts_sys_pre_init(void) erts_got_sigusr1 = 0; have_prepared_crash_dump = 0; #endif -#if !CHLDWTHR && !defined(ERTS_SMP) - children_died = 0; -#endif #endif /* USE_THREADS */ @@ -630,39 +466,6 @@ erts_sys_pre_init(void) void erl_sys_init(void) { -#if !DISABLE_VFORK - { - int res; - char bindir[MAXPATHLEN]; - size_t bindirsz = sizeof(bindir); - Uint csp_path_sz; - - res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); - if (res != 0) { - if (res < 0) - erl_exit(-1, - "Environment variable BINDIR is not set\n"); - if (res > 0) - erl_exit(-1, - "Value of environment variable BINDIR is too large\n"); - } - if (bindir[0] != DIR_SEPARATOR_CHAR) - erl_exit(-1, - "Environment variable BINDIR does not contain an" - " absolute path\n"); - csp_path_sz = (strlen(bindir) - + 1 /* DIR_SEPARATOR_CHAR */ - + sizeof(CHILD_SETUP_PROG_NAME) - + 1); - child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz); - erts_snprintf(child_setup_prog, csp_path_sz, - "%s%c%s", - bindir, - DIR_SEPARATOR_CHAR, - CHILD_SETUP_PROG_NAME); - } -#endif #ifdef USE_SETLINEBUF setlinebuf(stdout); @@ -980,43 +783,6 @@ int sys_max_files(void) return(max_files); } -static void block_signals(void) -{ -#if !CHLDWTHR - sys_sigblock(SIGCHLD); -#endif -#ifndef ERTS_SMP - sys_sigblock(SIGINT); -#ifndef ETHR_UNUSABLE_SIGUSRX - sys_sigblock(SIGUSR1); -#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ -#endif /* #ifndef ERTS_SMP */ - -#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) - sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL); -#endif - -} - -static void unblock_signals(void) -{ - /* Update erl_child_setup.c if changed */ -#if !CHLDWTHR - sys_sigrelease(SIGCHLD); -#endif -#ifndef ERTS_SMP - sys_sigrelease(SIGINT); -#ifndef ETHR_UNUSABLE_SIGUSRX - sys_sigrelease(SIGUSR1); -#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ -#endif /* #ifndef ERTS_SMP */ - -#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) - sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL); -#endif - -} - /************************** OS info *******************************/ /* Used by erlang:info/1. */ @@ -1104,1502 +870,6 @@ void fini_getenv_state(GETENV_STATE *state) erts_smp_rwmtx_runlock(&environ_rwmtx); } - -/************************** Port I/O *******************************/ - - - -/* I. Common stuff */ - -/* - * Decreasing the size of it below 16384 is not allowed. - */ - -/* II. The spawn/fd/vanilla drivers */ - -#define ERTS_SYS_READ_BUF_SZ (64*1024) - -/* Driver interfaces */ -static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); -static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); -#if FDBLOCK -static void fd_async(void *); -static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); -#endif -static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, - char **, ErlDrvSizeT); -static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); -static int spawn_init(void); -static void fd_stop(ErlDrvData); -static void fd_flush(ErlDrvData); -static void stop(ErlDrvData); -static void ready_input(ErlDrvData, ErlDrvEvent); -static void ready_output(ErlDrvData, ErlDrvEvent); -static void output(ErlDrvData, char*, ErlDrvSizeT); -static void outputv(ErlDrvData, ErlIOVec*); -static void stop_select(ErlDrvEvent, void*); - -struct erl_drv_entry spawn_driver_entry = { - spawn_init, - spawn_start, - 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, - outputv, -#if FDBLOCK - fd_ready_async, /* ready_async */ -#else - NULL, -#endif - fd_flush, /* 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 -}; -struct erl_drv_entry vanilla_driver_entry = { - NULL, - vanilla_start, - stop, - output, - ready_input, - ready_output, - "vanilla", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - 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 -}; - -/* Handle SIGCHLD signals. */ -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE onchld(void) -#else -static RETSIGTYPE onchld(int signum) -#endif -{ -#if CHLDWTHR - ASSERT(0); /* We should *never* catch a SIGCHLD signal */ -#elif defined(ERTS_SMP) - smp_sig_notify('C'); -#else - children_died = 1; - ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ -#endif -} - -static int set_blocking_data(ErtsSysDriverData *dd) { - - dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); - - erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); - - dd->blocking->pdl = driver_pdl_create(dd->port_num); - dd->blocking->res = 0; - dd->blocking->err = 0; - dd->blocking->pkey = driver_async_port_key(dd->port_num); - - return 1; -} - -static int set_driver_data(ErlDrvPort port_num, - int ifd, - int ofd, - int packet_bytes, - int read_write, - int exit_status, - int pid, - int is_blocking) -{ - Port *prt; - ErtsSysReportExit *report_exit; - - if (!exit_status) - report_exit = NULL; - else { - 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; -#if CHLDWTHR && !defined(ERTS_SMP) - report_exit->status = 0; -#endif - report_exit_list = report_exit; - } - - prt = erts_drvport2port(port_num); - if (prt != ERTS_INVALID_ERL_DRV_PORT) - prt->os_pid = pid; - - if (read_write & DO_READ) { - driver_data[ifd].packet_bytes = packet_bytes; - driver_data[ifd].port_num = port_num; - driver_data[ifd].report_exit = report_exit; - driver_data[ifd].pid = pid; - driver_data[ifd].alive = 1; - driver_data[ifd].status = 0; - driver_data[ifd].terminating = 0; - driver_data[ifd].blocking = NULL; - if (read_write & DO_WRITE) { - driver_data[ifd].ofd = ofd; - if (is_blocking && FDBLOCK) - if (!set_blocking_data(driver_data+ifd)) - return -1; - if (ifd != ofd) - driver_data[ofd] = driver_data[ifd]; /* structure copy */ - } else { /* DO_READ only */ - driver_data[ifd].ofd = -1; - } - (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); - return(ifd); - } else { /* DO_WRITE only */ - driver_data[ofd].packet_bytes = packet_bytes; - driver_data[ofd].port_num = port_num; - driver_data[ofd].report_exit = report_exit; - driver_data[ofd].ofd = ofd; - driver_data[ofd].pid = pid; - driver_data[ofd].alive = 1; - driver_data[ofd].status = 0; - driver_data[ofd].terminating = 0; - driver_data[ofd].blocking = NULL; - if (is_blocking && FDBLOCK) - if (!set_blocking_data(driver_data+ofd)) - return -1; - return(ofd); - } -} - -static int spawn_init() -{ - int i; -#if CHLDWTHR - erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; - - thr_opts.detached = 0; - thr_opts.suggested_stack_size = 0; /* Smallest possible */ - thr_opts.name = "child_waiter"; -#endif - - sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ - driver_data = (ErtsSysDriverData *) - erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(ErtsSysDriverData)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(ErtsSysDriverData)); - - for (i = 0; i < max_files; i++) - driver_data[i].pid = -1; - -#if CHLDWTHR - sys_sigblock(SIGCHLD); -#endif - - sys_signal(SIGCHLD, onchld); /* Reap children */ - -#if CHLDWTHR - erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); -#endif - - return 1; -} - -static void close_pipes(int ifd[2], int ofd[2], int read_write) -{ - if (read_write & DO_READ) { - (void) close(ifd[0]); - (void) close(ifd[1]); - } - if (read_write & DO_WRITE) { - (void) close(ofd[0]); - (void) close(ofd[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; -} - -static char **build_unix_environment(char *block) -{ - int i; - int j; - int len; - char *cp; - char **cpp; - char** old_env; - - ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); - - cp = block; - len = 0; - while (*cp != '\0') { - cp += strlen(cp) + 1; - len++; - } - old_env = environ; - while (*old_env++ != NULL) { - len++; - } - - cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, - sizeof(char *) * (len+1)); - if (cpp == NULL) { - return NULL; - } - - cp = block; - len = 0; - while (*cp != '\0') { - cpp[len] = cp; - cp += strlen(cp) + 1; - len++; - } - - i = len; - for (old_env = environ; *old_env; old_env++) { - char* old = *old_env; - - for (j = 0; j < len; j++) { - char *s, *t; - - s = cpp[j]; - t = old; - while (*s == *t && *s != '=') { - s++, t++; - } - if (*s == '=' && *t == '=') { - break; - } - } - - if (j == len) { /* New version not found */ - cpp[len++] = old; - } - } - - for (j = 0; j < i; ) { - size_t last = strlen(cpp[j])-1; - if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) { - cpp[j] = cpp[--len]; - if (len < i) { - i--; - } else { - j++; - } - } - else { - j++; - } - } - - cpp[len] = NULL; - return cpp; -} - -/* - [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory - in swap space for the child of a 'fork', whereas 'vfork' does not do this. - The natural call to use here is therefore 'vfork'. Due to a bug in - 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork' - can be dangerous in what seems to be these circumstances: - If the child code under a vfork sets the signal action to SIG_DFL - (or SIG_IGN) - for any signal which was previously set to a signal handler, the - state of the parent is clobbered, so that the later arrival of - such a signal yields a sigsegv in the parent. If the signal was - not set to a signal handler, but ignored, all seems to work. - If you change the forking code below, beware of this. - */ - -static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) -{ -#define CMD_LINE_PREFIX_STR "exec " -#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) - - int ifd[2], ofd[2], len, pid, i; - char **volatile new_environ; /* volatile since a vfork() then cannot - cause 'new_environ' to be clobbered - in the parent process. */ - int saved_errno; - long res; - char *cmd_line; -#ifndef QNX - int unbind; -#endif -#if !DISABLE_VFORK - int no_vfork; - size_t no_vfork_sz = sizeof(no_vfork); - - no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK", - (char *) &no_vfork, - &no_vfork_sz) >= 0); -#endif - - switch (opts->read_write) { - case DO_READ: - if (pipe(ifd) < 0) - return ERL_DRV_ERROR_ERRNO; - if (ifd[0] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ofd[1] = -1; /* keep purify happy */ - break; - case DO_WRITE: - if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO; - if (ofd[1] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ifd[0] = -1; /* keep purify happy */ - break; - case DO_READ|DO_WRITE: - if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; - errno = EMFILE; /* default for next two conditions */ - if (ifd[0] >= max_files || pipe(ofd) < 0) { - close_pipes(ifd, ofd, DO_READ); - return ERL_DRV_ERROR_ERRNO; - } - if (ofd[1] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - break; - default: - ASSERT(0); - return ERL_DRV_ERROR_GENERAL; - } - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - /* started with spawn_executable, not with spawn */ - len = strlen(name); - cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); - if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - memcpy((void *) cmd_line,(void *) name, len); - cmd_line[len] = '\0'; - if (access(cmd_line,X_OK) != 0) { - int save_errno = errno; - erts_free(ERTS_ALC_T_TMP, cmd_line); - errno = save_errno; - return ERL_DRV_ERROR_ERRNO; - } - } else { - /* make the string suitable for giving to "sh" */ - len = strlen(name); - cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, - CMD_LINE_PREFIX_STR_SZ + len + 1); - if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - memcpy((void *) cmd_line, - (void *) CMD_LINE_PREFIX_STR, - CMD_LINE_PREFIX_STR_SZ); - memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); - cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; - } - - erts_smp_rwmtx_rlock(&environ_rwmtx); - - if (opts->envir == NULL) { - new_environ = environ; - } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - -#ifndef QNX - /* Block child from SIGINT and SIGUSR1. Must be before fork() - to be safe. */ - block_signals(); - - CHLD_STAT_LOCK; - - unbind = erts_sched_bind_atfork_prepare(); - -#if !DISABLE_VFORK - /* See fork/vfork discussion before this function. */ - if (no_vfork) { -#endif - - DEBUGF(("Using fork\n")); - pid = fork(); - - if (pid == 0) { - /* The child! Setup child... */ - - if (erts_sched_bind_atfork_child(unbind) != 0) - goto child_error; - - /* OBSERVE! - * Keep child setup after vfork() (implemented below and in - * erl_child_setup.c) up to date if changes are made here. - */ - - if (opts->use_stdio) { - if (opts->read_write & DO_READ) { - /* stdout for process */ - if (dup2(ifd[1], 1) < 0) - goto child_error; - if(opts->redir_stderr) - /* stderr for process */ - if (dup2(ifd[1], 2) < 0) - goto child_error; - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - if (dup2(ofd[0], 0) < 0) - goto child_error; - } - else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - if (dup2(ifd[1], 4) < 0) - goto child_error; - if (opts->read_write & DO_WRITE) - if (dup2(ofd[0], 3) < 0) - goto child_error; - } - -#if defined(HAVE_CLOSEFROM) - closefrom(opts->use_stdio ? 3 : 5); -#else - for (i = opts->use_stdio ? 3 : 5; i < max_files; i++) - (void) close(i); -#endif - - if (opts->wd && chdir(opts->wd) < 0) - goto child_error; - -#if defined(USE_SETPGRP_NOARGS) /* SysV */ - (void) setpgrp(); -#elif defined(USE_SETPGRP) /* BSD */ - (void) setpgrp(0, getpid()); -#else /* POSIX */ - (void) setsid(); -#endif - - unblock_signals(); - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - if (opts->argv == NULL) { - execle(cmd_line,cmd_line,(char *) NULL, new_environ); - } else { - if (opts->argv[0] == erts_default_arg0) { - opts->argv[0] = cmd_line; - } - execve(cmd_line, opts->argv, new_environ); - if (opts->argv[0] == cmd_line) { - opts->argv[0] = erts_default_arg0; - } - } - } else { - execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); - } - child_error: - _exit(1); - } -#if !DISABLE_VFORK - } -#define ENOUGH_BYTES (44) - else { /* Use vfork() */ - char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* - sizeof(char *)); - char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */ - char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */ - /* on a 64-bit machine. */ - - /* Setup argv[] for the child setup program (implemented in - erl_child_setup.c) */ - i = 0; - if (opts->use_stdio) { - if (opts->read_write & DO_READ){ - /* stdout for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1); - if(opts->redir_stderr) - /* stderr for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2); - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0); - } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4); - if (opts->read_write & DO_WRITE) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3); - } - for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - strcpy(&dup2_op[i][0], "-"); - erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1); - - cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; - cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; - cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind); - cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range; - for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0]; - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - int num = 0; - int j = 0; - if (opts->argv != NULL) { - for(; opts->argv[num] != NULL; ++num) - ; - } - cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *)); - cs_argv[CS_ARGV_CMD_IX] = "-"; - cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line; - if (opts->argv != NULL) { - for (;opts->argv[j] != NULL; ++j) { - if (opts->argv[j] == erts_default_arg0) { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line; - } else { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j]; - } - } - } - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL; - } else { - cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */ - cs_argv[CS_ARGV_NO_OF_ARGS] = NULL; - } - DEBUGF(("Using vfork\n")); - pid = vfork(); - - if (pid == 0) { - /* The child! */ - - /* Observe! - * OTP-4389: The child setup program (implemented in - * erl_child_setup.c) will perform the necessary setup of the - * child before it execs to the user program. This because - * vfork() only allow an *immediate* execve() or _exit() in the - * child. - */ - execve(child_setup_prog, cs_argv, new_environ); - _exit(1); - } - erts_free(ERTS_ALC_T_TMP,cs_argv); - } -#undef ENOUGH_BYTES -#endif - - erts_sched_bind_atfork_parent(unbind); - - if (pid == -1) { - saved_errno = errno; - CHLD_STAT_UNLOCK; - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - unblock_signals(); - close_pipes(ifd, ofd, opts->read_write); - errno = saved_errno; - return ERL_DRV_ERROR_ERRNO; - } -#else /* QNX */ - if (opts->use_stdio) { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */ - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */ - } - else { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[4] = ifd[1]; - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[3] = ofd[0]; - } - /* Close fds on exec */ - for (i = 3; i < max_files; i++) - fcntl(i, F_SETFD, 1); - - qnx_spawn_options.flags = _SPAWN_SETSID; - 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(); - erts_smp_rwmtx_runlock(&environ_rwmtx); - close_pipes(ifd, ofd, opts->read_write); - return ERL_DRV_ERROR_GENERAL; - } - reset_qnx_spawn(); -#endif /* QNX */ - - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - - if (opts->read_write & DO_READ) - (void) close(ifd[1]); - if (opts->read_write & DO_WRITE) - (void) close(ofd[0]); - - if (opts->read_write & DO_READ) { - SET_NONBLOCKING(ifd[0]); - init_fd_data(ifd[0], port_num); - } - if (opts->read_write & DO_WRITE) { - SET_NONBLOCKING(ofd[1]); - init_fd_data(ofd[1], port_num); - } - - res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - opts->read_write, opts->exit_status, pid, 0); - /* Don't unblock SIGCHLD until now, since the call above must - first complete putting away the info about our new subprocess. */ - unblock_signals(); - -#if CHLDWTHR - ASSERT(children_alive >= 0); - - if (!(children_alive++)) - CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children - was alive before we fork()ed ... */ -#endif - /* Don't unlock chld_stat_mtx until now of the same reason as above */ - CHLD_STAT_UNLOCK; - - erts_smp_rwmtx_runlock(&environ_rwmtx); - - return (ErlDrvData)res; -#undef CMD_LINE_PREFIX_STR -#undef CMD_LINE_PREFIX_STR_SZ -} - -#ifdef QNX -static reset_qnx_spawn() -{ - int i; - - /* Reset qnx_spawn_options */ - qnx_spawn_options.flags = 0; - qnx_spawn_options.iov[0] = 0xff; - qnx_spawn_options.iov[1] = 0xff; - qnx_spawn_options.iov[2] = 0xff; - qnx_spawn_options.iov[3] = 0xff; -} -#endif - -#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) -{ - int fd = (int)(long)drv_data; - char resbuff[2*sizeof(Uint32)]; - switch (command) { - case FD_CTRL_OP_GET_WINSIZE: - { - Uint32 w,h; - if (fd_get_window_size(fd,&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; - int non_blocking = 0; - - if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || - ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) - return ERL_DRV_ERROR_GENERAL; - - /* - * Historical: - * - * "Note about nonblocking I/O. - * - * At least on Solaris, setting the write end of a TTY to nonblocking, - * will set the input end to nonblocking as well (and vice-versa). - * If erl is run in a pipeline like this: cat | erl - * the input end of the TTY will be the standard input of cat. - * And cat is not prepared to handle nonblocking I/O." - * - * Actually, the reason for this is not that the tty itself gets set - * in non-blocking mode, but that the "input end" (cat's stdin) and - * the "output end" (erlang's stdout) are typically the "same" file - * descriptor, dup()'ed from a single fd by one of this process' - * ancestors. - * - * The workaround for this problem used to be a rather bad kludge, - * interposing an extra process ("internal cat") between erlang's - * stdout and the original stdout, allowing erlang to set its stdout - * in non-blocking mode without affecting the stdin of the preceding - * process in the pipeline - and being a kludge, it caused all kinds - * of weird problems. - * - * So, this is the current logic: - * - * The only reason to set non-blocking mode on the output fd at all is - * if it's something that can cause a write() to block, of course, - * i.e. primarily if it points to a tty, socket, pipe, or fifo. - * - * If we don't set non-blocking mode when we "should" have, and output - * becomes blocked, the entire runtime system will be suspended - this - * is normally bad of course, and can happen fairly "easily" - e.g. user - * hits ^S on tty - but doesn't necessarily happen. - * - * If we do set non-blocking mode when we "shouldn't" have, the runtime - * system will end up seeing EOF on the input fd (due to the preceding - * process dying), which typically will cause the entire runtime system - * to terminate immediately (due to whatever erlang process is seeing - * the EOF taking it as a signal to halt the system). This is *very* bad. - * - * I.e. we should take a conservative approach, and only set non- - * blocking mode when we a) need to, and b) are reasonably certain - * that it won't be a problem. And as in the example above, the problem - * occurs when input fd and output fd point to different "things". - * - * However, determining that they are not just the same "type" of - * "thing", but actually the same instance of that type of thing, is - * unreasonably complex in many/most cases. - * - * Also, with pipes, sockets, and fifos it's far from obvious that the - * user *wants* non-blocking output: If you're running erlang inside - * some complex pipeline, you're probably not running a real-time system - * that must never stop, but rather *want* it to suspend if the output - * channel is "full". - * - * So, the bottom line: We will only set the output fd non-blocking if - * it points to a tty, and either a) the input fd also points to a tty, - * or b) we can make sure that setting the output fd non-blocking - * doesn't interfere with someone else's input, via a somewhat milder - * kludge than the above. - * - * Also keep in mind that while this code is almost exclusively run as - * a result of an erlang open_port({fd,0,1}, ...), that isn't the only - * case - it can be called with any old pre-existing file descriptors, - * the relations between which (if they're even two) we can only guess - * at - still, we try our best... - * - * Added note OTP 18: Some systems seem to use stdout/stderr to log data - * using unix pipes, so we cannot allow the system to block on a write. - * Therefore we use an async thread to write the data to fd's that could - * not be set to non-blocking. When no async threads are available we - * fall back on the old behaviour. - * - * Also the guarantee about what is delivered to the OS has changed. - * Pre 18 the fd driver did no flushing of data before terminating. - * Now it does. This is because we want to be able to guarantee that things - * such as escripts and friends really have outputted all data before - * terminating. This could potentially block the termination of the system - * for a very long time, but if the user wants to terminate fast she should - * use erlang:halt with flush=false. - */ - - 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); - - /* If we don't have a read end, all bets are off - no non-blocking. */ - if (opts->read_write & DO_READ) { - - if (isatty(opts->ofd)) { /* output fd is a tty:-) */ - - if (isatty(opts->ifd)) { /* input fd is also a tty */ - - /* To really do this "right", we should also check that - input and output fd point to the *same* tty - but - this seems like overkill; ttyname() isn't for free, - and this is a very common case - and it's hard to - imagine a scenario where setting non-blocking mode - here would cause problems - go ahead and do it. */ - - non_blocking = 1; - SET_NONBLOCKING(opts->ofd); - - } else { /* output fd is a tty, input fd isn't */ - - /* This is a "problem case", but also common (see the - example above) - i.e. it makes sense to try a bit - harder before giving up on non-blocking mode: Try to - re-open the tty that the output fd points to, and if - successful replace the original one with the "new" fd - obtained this way, and set *that* one in non-blocking - mode. (Yes, this is a kludge.) - - However, re-opening the tty may fail in a couple of - (unusual) cases: - - 1) The name of the tty (or an equivalent one, i.e. - same major/minor number) can't be found, because - it actually lives somewhere other than /dev (or - wherever ttyname() looks for it), and isn't - equivalent to any of those that do live in the - "standard" place - this should be *very* unusual. - - 2) Permissions on the tty don't allow us to open it - - it's perfectly possible to have an fd open to an - object whose permissions wouldn't allow us to open - it. This is not as unusual as it sounds, one case - is if the user has su'ed to someone else (not - root) - we have a read/write fd open to the tty - (because it has been inherited all the way down - here), but we have neither read nor write - permission for the tty. - - In these cases, we finally give up, and don't set the - output fd in non-blocking mode. */ - - char *tty; - int nfd; - - if ((tty = ttyname(opts->ofd)) != NULL && - (nfd = open(tty, O_WRONLY)) != -1) { - dup2(nfd, opts->ofd); - close(nfd); - non_blocking = 1; - SET_NONBLOCKING(opts->ofd); - } - } - } - } - } - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1, - !non_blocking); - 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, int fd) -{ - driver_select(prt,fd,DO_READ|DO_WRITE,0); - clear_fd_data(fd); - SET_BLOCKING(fd); -} - -static void fd_stop(ErlDrvData ev) /* Does not close the fds */ -{ - int ofd; - int fd = (int)(long)ev; - ErlDrvPort prt = driver_data[fd].port_num; - -#if FDBLOCK - if (driver_data[fd].blocking) { - erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); - driver_data[fd].blocking = NULL; - erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); - } -#endif - - nbio_stop_fd(prt, fd); - ofd = driver_data[fd].ofd; - if (ofd != fd && ofd != -1) - nbio_stop_fd(prt, ofd); -} - -static void fd_flush(ErlDrvData fd) -{ - if (!driver_data[(int)(long)fd].terminating) - driver_data[(int)(long)fd].terminating = 1; -} - -static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, - SysDriverOpts* opts) -{ - int flags, fd; - ErlDrvData res; - - flags = (opts->read_write == DO_READ ? O_RDONLY : - opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : - O_RDWR|O_CREAT); - if ((fd = open(name, flags, 0666)) < 0) - return ERL_DRV_ERROR_GENERAL; - if (fd >= max_files) { - close(fd); - return ERL_DRV_ERROR_GENERAL; - } - SET_NONBLOCKING(fd); - init_fd_data(fd, port_num); - - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1, 0); - CHLD_STAT_UNLOCK; - return res; -} - -/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ -/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ - -static void stop(ErlDrvData fd) -{ - ErlDrvPort prt; - int ofd; - - prt = driver_data[(int)(long)fd].port_num; - nbio_stop_fd(prt, (int)(long)fd); - - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && (int)(long)ofd != -1) - nbio_stop_fd(prt, ofd); - else - ofd = -1; - - CHLD_STAT_LOCK; - - /* Mark as unused. */ - driver_data[(int)(long)fd].pid = -1; - - CHLD_STAT_UNLOCK; - - /* SMP note: Close has to be last thing done (open file descriptors work - as locks on driver_data[] entries) */ - driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */ - if (ofd >= 0) { - driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */ - } -} - -/* used by fd_driver */ -static void outputv(ErlDrvData e, ErlIOVec* ev) -{ - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; - ssize_t n; - ErlDrvSizeT sz; - char lb[4]; - char* lbp; - ErlDrvSizeT len = ev->size; - - /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ - /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/ - if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { - driver_failure_posix(ix, EINVAL); - return; /* -1; */ - } - /* Handles 0 <= pb <= 4 only */ - put_int32((Uint32) len, lb); - lbp = lb + (4-pb); - - ev->iov[0].iov_base = lbp; - ev->iov[0].iov_len = pb; - ev->size += pb; - - if (driver_data[fd].blocking && FDBLOCK) - driver_pdl_lock(driver_data[fd].blocking->pdl); - - if ((sz = driver_sizeq(ix)) > 0) { - driver_enqv(ix, ev, 0); - - if (driver_data[fd].blocking && FDBLOCK) - driver_pdl_unlock(driver_data[fd].blocking->pdl); - - if (sz + ev->size >= (1 << 13)) - set_busy_port(ix, 1); - } - else if (!driver_data[fd].blocking || !FDBLOCK) { - /* We try to write directly if the fd in non-blocking */ - int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; - - n = writev(ofd, (const void *) (ev->iov), vsize); - if (n == ev->size) - return; /* 0;*/ - if (n < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { - driver_failure_posix(ix, errno); - return; /* -1;*/ - } - n = 0; - } - driver_enqv(ix, ev, n); /* n is the skip value */ - driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); - } -#if FDBLOCK - else { - if (ev->size != 0) { - driver_enqv(ix, ev, 0); - driver_pdl_unlock(driver_data[fd].blocking->pdl); - driver_async(ix, &driver_data[fd].blocking->pkey, - fd_async, driver_data+fd, NULL); - } else { - driver_pdl_unlock(driver_data[fd].blocking->pdl); - } - } -#endif - /* return 0;*/ -} - -/* Used by spawn_driver and vanilla driver */ -static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) -{ - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; - ssize_t n; - ErlDrvSizeT sz; - char lb[4]; - char* lbp; - struct iovec iv[2]; - - /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ - if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { - driver_failure_posix(ix, EINVAL); - return; /* -1; */ - } - put_int32(len, lb); - lbp = lb + (4-pb); - - if ((sz = driver_sizeq(ix)) > 0) { - driver_enq(ix, lbp, pb); - driver_enq(ix, buf, len); - if (sz + len + pb >= (1 << 13)) - set_busy_port(ix, 1); - } - else { - iv[0].iov_base = lbp; - iv[0].iov_len = pb; /* should work for pb=0 */ - iv[1].iov_base = buf; - iv[1].iov_len = len; - n = writev(ofd, iv, 2); - if (n == pb+len) - return; /* 0; */ - if (n < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { - driver_failure_posix(ix, errno); - return; /* -1; */ - } - n = 0; - } - if (n < pb) { - driver_enq(ix, lbp+n, pb-n); - driver_enq(ix, buf, len); - } - else { - n -= pb; - driver_enq(ix, buf+n, len-n); - } - driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); - } - return; /* 0; */ -} - -static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) - /* Result: 0 (eof) or -1 (error) */ -{ - int err = errno; - - ASSERT(res <= 0); - (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); - clear_fd_data(ready_fd); - - if (driver_data[ready_fd].blocking && FDBLOCK) { - driver_pdl_lock(driver_data[ready_fd].blocking->pdl); - if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { - driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); - /* We have stuff in the output queue, so we just - set the state to terminating and wait for fd_async_ready - to terminate the port */ - if (res == 0) - driver_data[ready_fd].terminating = 2; - else - driver_data[ready_fd].terminating = -err; - return 0; - } - driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); - } - - if (res == 0) { - if (driver_data[ready_fd].report_exit) { - CHLD_STAT_LOCK; - - if (driver_data[ready_fd].alive) { - /* - * We have eof and want to report exit status, but the process - * hasn't exited yet. When it does report_exit_status() will - * driver_select() this fd which will make sure that we get - * back here with driver_data[ready_fd].alive == 0 and - * driver_data[ready_fd].status set. - */ - CHLD_STAT_UNLOCK; - return 0; - } - else { - int status = driver_data[ready_fd].status; - CHLD_STAT_UNLOCK; - - /* We need not be prepared for stopped/continued processes. */ - if (WIFSIGNALED(status)) - status = 128 + WTERMSIG(status); - else - status = WEXITSTATUS(status); - - driver_report_exit(driver_data[ready_fd].port_num, status); - } - } - driver_failure_eof(port_num); - } else { - driver_failure_posix(port_num, err); - } - return 0; -} - -/* fd is the drv_data that is returned from the */ -/* initial start routine */ -/* ready_fd is the descriptor that is ready to read */ - -static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) -{ - int fd = (int)(long)e; - ErlDrvPort port_num; - int packet_bytes; - int res; - Uint h; - - port_num = driver_data[fd].port_num; - packet_bytes = driver_data[fd].packet_bytes; - - - if (packet_bytes == 0) { - byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, - ERTS_SYS_READ_BUF_SZ); - res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) - port_inp_failure(port_num, ready_fd, res); - else - driver_output(port_num, (char*) read_buf, res); - erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); - } - else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ - /* space is allocated in buf */ - res = read(ready_fd, fd_data[ready_fd].cpos, - fd_data[ready_fd].remain); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) { - port_inp_failure(port_num, ready_fd, res); - } - else if (res == fd_data[ready_fd].remain) { /* we're done */ - driver_output(port_num, fd_data[ready_fd].buf, - fd_data[ready_fd].sz); - clear_fd_data(ready_fd); - } - else { /* if (res < fd_data[ready_fd].remain) */ - fd_data[ready_fd].cpos += res; - fd_data[ready_fd].remain -= res; - } - } - else if (fd_data[ready_fd].remain == 0) { /* clean fd */ - byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, - ERTS_SYS_READ_BUF_SZ); - /* We make one read attempt and see what happens */ - res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) { /* eof */ - port_inp_failure(port_num, ready_fd, res); - } - else if (res < packet_bytes - fd_data[ready_fd].psz) { - memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz, - read_buf, res); - fd_data[ready_fd].psz += res; - } - else { /* if (res >= packet_bytes) */ - unsigned char* cpos = read_buf; - int bytes_left = res; - - while (1) { - int psz = fd_data[ready_fd].psz; - char* pbp = fd_data[ready_fd].pbuf + psz; - - while(bytes_left && (psz < packet_bytes)) { - *pbp++ = *cpos++; - bytes_left--; - psz++; - } - - if (psz < packet_bytes) { - fd_data[ready_fd].psz = psz; - break; - } - fd_data[ready_fd].psz = 0; - - switch (packet_bytes) { - case 1: h = get_int8(fd_data[ready_fd].pbuf); break; - case 2: h = get_int16(fd_data[ready_fd].pbuf); break; - case 4: h = get_int32(fd_data[ready_fd].pbuf); break; - default: ASSERT(0); return; /* -1; */ - } - - if (h <= (bytes_left)) { - driver_output(port_num, (char*) cpos, h); - cpos += h; - bytes_left -= h; - continue; - } - else { /* The last message we got was split */ - char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); - if (!buf) { - errno = ENOMEM; - port_inp_failure(port_num, ready_fd, -1); - } - else { - erts_smp_atomic_add_nob(&sys_misc_mem_sz, h); - sys_memcpy(buf, cpos, bytes_left); - fd_data[ready_fd].buf = buf; - fd_data[ready_fd].sz = h; - fd_data[ready_fd].remain = h - bytes_left; - fd_data[ready_fd].cpos = buf + bytes_left; - } - break; - } - } - } - erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); - } -} - - -/* fd is the drv_data that is returned from the */ -/* initial start routine */ -/* ready_fd is the descriptor that is ready to read */ - -static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) -{ - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int n; - struct iovec* iv; - int vsize; - - - if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { - driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); - if (driver_data[fd].terminating) - driver_failure_atom(driver_data[fd].port_num,"normal"); - return; /* 0; */ - } - vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; - if ((n = writev(ready_fd, iv, vsize)) > 0) { - if (driver_deq(ix, n) == 0) - set_busy_port(ix, 0); - } - else if (n < 0) { - if (errno == ERRNO_BLOCK || errno == EINTR) - return; /* 0; */ - else { - int res = errno; - driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); - driver_failure_posix(ix, res); - return; /* -1; */ - } - } - return; /* 0; */ -} - -static void stop_select(ErlDrvEvent fd, void* _) -{ - close((int)fd); -} - -#if FDBLOCK - -static void -fd_async(void *async_data) -{ - int res; - ErtsSysDriverData *dd = (ErtsSysDriverData*)async_data; - SysIOVec *iov0; - SysIOVec *iov; - int iovlen; - int err = 0; - /* much of this code is stolen from efile_drv:invoke_writev */ - driver_pdl_lock(dd->blocking->pdl); - iov0 = driver_peekq(dd->port_num, &iovlen); - iovlen = iovlen < MAXIOV ? iovlen : MAXIOV; - iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF, - sizeof(SysIOVec)*iovlen); - if (!iov) { - res = -1; - err = ENOMEM; - driver_pdl_unlock(dd->blocking->pdl); - } else { - memcpy(iov,iov0,iovlen*sizeof(SysIOVec)); - driver_pdl_unlock(dd->blocking->pdl); - - do { - res = writev(dd->ofd, iov, iovlen); - } while (res < 0 && errno == EINTR); - if (res < 0) - err = errno; - - erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); - } - dd->blocking->res = res; - dd->blocking->err = err; -} - -void fd_ready_async(ErlDrvData drv_data, - ErlDrvThreadData thread_data) { - ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data; - ErlDrvPort port_num = dd->port_num; - - ASSERT(dd->blocking); - ASSERT(dd == (driver_data + (int)(long)drv_data)); - - if (dd->blocking->res > 0) { - driver_pdl_lock(dd->blocking->pdl); - if (driver_deq(port_num, dd->blocking->res) == 0) { - driver_pdl_unlock(dd->blocking->pdl); - set_busy_port(port_num, 0); - if (dd->terminating) { - /* The port is has been ordered to terminate - from either fd_flush or port_inp_failure */ - if (dd->terminating == 1) - driver_failure_atom(port_num, "normal"); - else if (dd->terminating == 2) - driver_failure_eof(port_num); - else if (dd->terminating < 0) - driver_failure_posix(port_num, -dd->terminating); - return; /* -1; */ - } - } else { - driver_pdl_unlock(dd->blocking->pdl); - /* still data left to write in queue */ - driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); - return /* 0; */; - } - } else if (dd->blocking->res < 0) { - if (dd->blocking->err == ERRNO_BLOCK) { - set_busy_port(port_num, 1); - /* still data left to write in queue */ - driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); - } else - driver_failure_posix(port_num, dd->blocking->err); - return; /* -1; */ - } - return; /* 0; */ -} - -#endif - void erts_do_break_handling(void) { struct termios temp_mode; @@ -2740,10 +1010,7 @@ erts_sys_unsetenv(char *key) void sys_init_io(void) { - fd_data = (ErtsSysFdData *) - erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(ErtsSysFdData)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(ErtsSysFdData)); + } #if (0) /* unused? */ @@ -2937,178 +1204,6 @@ erl_debug(char* fmt, ...) #endif /* DEBUG */ -static ERTS_INLINE void -report_exit_status(ErtsSysReportExit *rep, int status) -{ - Port *pp; -#ifdef ERTS_SMP - CHLD_STAT_UNLOCK; - pp = erts_thr_id2port_sflgs(rep->port, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); - CHLD_STAT_LOCK; -#else - pp = erts_id2port_sflgs(rep->port, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); -#endif - if (pp) { - if (rep->ifd >= 0) { - driver_data[rep->ifd].alive = 0; - driver_data[rep->ifd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ifd, - (ERL_DRV_READ|ERL_DRV_USE), - 1); - } - if (rep->ofd >= 0) { - driver_data[rep->ofd].alive = 0; - driver_data[rep->ofd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ofd, - (ERL_DRV_WRITE|ERL_DRV_USE), - 1); - } -#ifdef ERTS_SMP - erts_thr_port_release(pp); -#else - erts_port_release(pp); -#endif - } - erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); -} - -#if !CHLDWTHR /* ---------------------------------------------------------- */ - -#define ERTS_REPORT_EXIT_STATUS report_exit_status - -static int check_children(void) -{ - int res = 0; - int pid; - int status; - -#ifndef ERTS_SMP - if (children_died) -#endif - { - sys_sigblock(SIGCHLD); - CHLD_STAT_LOCK; - while ((pid = waitpid(-1, &status, WNOHANG)) > 0) - note_child_death(pid, status); -#ifndef ERTS_SMP - children_died = 0; -#endif - CHLD_STAT_UNLOCK; - sys_sigrelease(SIGCHLD); - res = 1; - } - return res; -} - -#ifdef ERTS_SMP - -void -erts_check_children(void) -{ - (void) check_children(); -} - -#endif - -#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */ - -#define ERTS_REPORT_EXIT_STATUS report_exit_status - -#define check_children() (0) - - -#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */ - -#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status - -static ERTS_INLINE void -initiate_report_exit_status(ErtsSysReportExit *rep, int status) -{ - rep->next = report_exit_transit_list; - rep->status = status; - report_exit_transit_list = rep; - erts_sys_schedule_interrupt(1); -} - -static int check_children(void) -{ - int res; - ErtsSysReportExit *rep; - CHLD_STAT_LOCK; - rep = report_exit_transit_list; - res = rep != NULL; - while (rep) { - ErtsSysReportExit *curr_rep = rep; - rep = rep->next; - report_exit_status(curr_rep, curr_rep->status); - } - report_exit_transit_list = NULL; - CHLD_STAT_UNLOCK; - return res; -} - -#endif /* ------------------------------------------------------------------ */ - -static void note_child_death(int pid, int status) -{ - ErtsSysReportExit **repp = &report_exit_list; - ErtsSysReportExit *rep = report_exit_list; - - while (rep) { - if (pid == rep->pid) { - *repp = rep->next; - ERTS_REPORT_EXIT_STATUS(rep, status); - break; - } - repp = &rep->next; - rep = rep->next; - } -} - -#if CHLDWTHR - -static void * -child_waiter(void *unused) -{ - int pid; - int status; - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_set_thread_name("child waiter"); -#endif - - while(1) { -#ifdef DEBUG - int waitpid_errno; -#endif - pid = waitpid(-1, &status, 0); -#ifdef DEBUG - waitpid_errno = errno; -#endif - CHLD_STAT_LOCK; - if (pid < 0) { - ASSERT(waitpid_errno == ECHILD); - } - else { - children_alive--; - ASSERT(children_alive >= 0); - note_child_death(pid, status); - } - while (!children_alive) - CHLD_STAT_WAIT; /* Wait for children to wait on... :) */ - CHLD_STAT_UNLOCK; - } - - return NULL; -} - -#endif /* * Called from schedule() when it runs out of runnable processes, @@ -3127,7 +1222,6 @@ erl_sys_schedule(int runnable) (void) check_children(); } - #ifdef ERTS_SMP static erts_smp_tid_t sig_dispatcher_tid; diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c new file mode 100644 index 0000000000..e3f089fc0f --- /dev/null +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -0,0 +1,1983 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef ISC32 +#define _POSIX_SOURCE +#define _XOPEN_SOURCE +#endif + +#include /* ! */ +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef ISC32 +#include +#endif + +#include +#ifdef HAVE_FCNTL_H +#include +#endif +#ifdef HAVE_SYS_IOCTL_H +#include +#endif + +#define NEED_CHILD_SETUP_DEFINES +#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ +#include "sys.h" +#include "erl_thr_progress.h" + +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + +#ifdef USE_THREADS +#include "erl_threads.h" +#endif + +#include "erl_mseg.h" + +extern char **environ; +extern erts_smp_rwmtx_t environ_rwmtx; + +extern erts_smp_atomic_t sys_misc_mem_sz; + +#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O + * vector sock_sendv(). + */ +/* + * Don't need global.h, but erl_cpu_topology.h won't compile otherwise + */ +#include "global.h" + +#include "erl_sys_driver.h" +#include "erl_check_io.h" +#include "erl_cpu_topology.h" + +#ifndef DISABLE_VFORK +#define DISABLE_VFORK 0 +#endif + +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + +/* + * [OTP-3906] + * Solaris signal management gets confused when threads are used and a + * lot of child processes dies. The confusion results in that SIGCHLD + * signals aren't delivered to the emulator which in turn results in + * a lot of defunct processes in the system. + * + * The problem seems to appear when a signal is frequently + * blocked/unblocked at the same time as the signal is frequently + * propagated. The child waiter thread is a workaround for this problem. + * The SIGCHLD signal is always blocked (in all threads), and the child + * waiter thread fetches the signal by a call to sigwait(). See + * child_waiter(). + */ + +typedef struct ErtsSysReportExit_ ErtsSysReportExit; +struct ErtsSysReportExit_ { + ErtsSysReportExit *next; + Eterm port; + int pid; + int ifd; + int ofd; +#if CHLDWTHR && !defined(ERTS_SMP) + int status; +#endif +}; + +/* Used by the fd driver iff the fd could not be set to non-blocking */ +typedef struct ErtsSysBlocking_ { + ErlDrvPDL pdl; + int res; + int err; + unsigned int pkey; +} ErtsSysBlocking; + + +/* This data is shared by these drivers - initialized by spawn_init() */ +typedef struct driver_data { + ErlDrvPort port_num; + int ofd, packet_bytes; + ErtsSysReportExit *report_exit; + int pid; + int alive; + int status; + int terminating; + ErtsSysBlocking *blocking; +} ErtsSysDriverData; + +static ErtsSysDriverData *driver_data; /* indexed by fd */ + +static ErtsSysReportExit *report_exit_list; +#if CHLDWTHR && !defined(ERTS_SMP) +static ErtsSysReportExit *report_exit_transit_list; +#endif + +#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) +#define ERL_BUILD_TYPE_MARKER ".purify" +#elif defined(QUANTIFY) +#define ERL_BUILD_TYPE_MARKER ".quantify" +#elif defined(PURECOV) +#define ERL_BUILD_TYPE_MARKER ".purecov" +#elif defined(VALGRIND) +#define ERL_BUILD_TYPE_MARKER ".valgrind" +#else /* opt */ +#define ERL_BUILD_TYPE_MARKER +#endif + +#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER +static char *child_setup_prog; + +#if CHLDWTHR || defined(ERTS_SMP) +erts_mtx_t chld_stat_mtx; +#endif +#if CHLDWTHR +static erts_tid_t child_waiter_tid; +/* chld_stat_mtx is used to protect against concurrent accesses + of the driver_data fields pid, alive, and status. */ +erts_cnd_t chld_stat_cnd; +static long children_alive; +#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) +#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) +#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx) +#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd) +#elif 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 + +typedef struct ErtsSysFdData { + char pbuf[4]; /* hold partial packet bytes */ + int psz; /* size of pbuf */ + char *buf; + char *cpos; + int sz; + int remain; /* for input on fd */ +} ErtsSysFdData; + +static ErtsSysFdData *fd_data; /* indexed by fd */ + +/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ +static void note_child_death(int, int); + +#if CHLDWTHR +static void* child_waiter(void *); +#endif + +static void block_signals(void) +{ +#if !CHLDWTHR + sys_sigblock(SIGCHLD); +#endif +#ifndef ERTS_SMP + sys_sigblock(SIGINT); +#ifndef ETHR_UNUSABLE_SIGUSRX + sys_sigblock(SIGUSR1); +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ +#endif /* #ifndef ERTS_SMP */ + +#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) + sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL); +#endif + +} + +static void unblock_signals(void) +{ + /* Update erl_child_setup.c if changed */ +#if !CHLDWTHR + sys_sigrelease(SIGCHLD); +#endif +#ifndef ERTS_SMP + sys_sigrelease(SIGINT); +#ifndef ETHR_UNUSABLE_SIGUSRX + sys_sigrelease(SIGUSR1); +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ +#endif /* #ifndef ERTS_SMP */ + +#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) + sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL); +#endif + +} + +/************************** Port I/O *******************************/ + + + +/* I. Common stuff */ + +/* + * Decreasing the size of it below 16384 is not allowed. + */ + +/* II. The spawn/fd/vanilla drivers */ + +#define ERTS_SYS_READ_BUF_SZ (64*1024) + +/* Driver interfaces */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +#if FDBLOCK +static void fd_async(void *); +static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); +#endif +static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, + char **, ErlDrvSizeT); +static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); +static int spawn_init(void); +static void fd_stop(ErlDrvData); +static void fd_flush(ErlDrvData); +static void stop(ErlDrvData); +static void ready_input(ErlDrvData, ErlDrvEvent); +static void ready_output(ErlDrvData, ErlDrvEvent); +static void output(ErlDrvData, char*, ErlDrvSizeT); +static void outputv(ErlDrvData, ErlIOVec*); +static void stop_select(ErlDrvEvent, void*); + +struct erl_drv_entry spawn_driver_entry = { + spawn_init, + spawn_start, + 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, + outputv, +#if FDBLOCK + fd_ready_async, /* ready_async */ +#else + NULL, +#endif + fd_flush, /* 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 +}; +struct erl_drv_entry vanilla_driver_entry = { + NULL, + vanilla_start, + stop, + output, + ready_input, + ready_output, + "vanilla", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + 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 +}; + +/* Handle SIGCHLD signals. */ +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE onchld(void) +#else +static RETSIGTYPE onchld(int signum) +#endif +{ +#if CHLDWTHR + ASSERT(0); /* We should *never* catch a SIGCHLD signal */ +#elif defined(ERTS_SMP) + smp_sig_notify('C'); +#else + children_died = 1; + ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ +#endif +} + +static int set_blocking_data(ErtsSysDriverData *dd) { + + dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); + + erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); + + dd->blocking->pdl = driver_pdl_create(dd->port_num); + dd->blocking->res = 0; + dd->blocking->err = 0; + dd->blocking->pkey = driver_async_port_key(dd->port_num); + + return 1; +} + +static int set_driver_data(ErlDrvPort port_num, + int ifd, + int ofd, + int packet_bytes, + int read_write, + int exit_status, + int pid, + int is_blocking) +{ + Port *prt; + ErtsSysReportExit *report_exit; + + if (!exit_status) + report_exit = NULL; + else { + 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; +#if CHLDWTHR && !defined(ERTS_SMP) + report_exit->status = 0; +#endif + report_exit_list = report_exit; + } + + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) + prt->os_pid = pid; + + if (read_write & DO_READ) { + driver_data[ifd].packet_bytes = packet_bytes; + driver_data[ifd].port_num = port_num; + driver_data[ifd].report_exit = report_exit; + driver_data[ifd].pid = pid; + driver_data[ifd].alive = 1; + driver_data[ifd].status = 0; + driver_data[ifd].terminating = 0; + driver_data[ifd].blocking = NULL; + if (read_write & DO_WRITE) { + driver_data[ifd].ofd = ofd; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ifd)) + return -1; + if (ifd != ofd) + driver_data[ofd] = driver_data[ifd]; /* structure copy */ + } else { /* DO_READ only */ + driver_data[ifd].ofd = -1; + } + (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); + return(ifd); + } else { /* DO_WRITE only */ + driver_data[ofd].packet_bytes = packet_bytes; + driver_data[ofd].port_num = port_num; + driver_data[ofd].report_exit = report_exit; + driver_data[ofd].ofd = ofd; + driver_data[ofd].pid = pid; + driver_data[ofd].alive = 1; + driver_data[ofd].status = 0; + driver_data[ofd].terminating = 0; + driver_data[ofd].blocking = NULL; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ofd)) + return -1; + return(ofd); + } +} + +static int spawn_init() +{ + int i; +#if CHLDWTHR + erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; +#endif + int res; + char bindir[MAXPATHLEN]; + size_t bindirsz = sizeof(bindir); + Uint csp_path_sz; + +#if CHLDWTHR + thr_opts.detached = 0; + thr_opts.suggested_stack_size = 0; /* Smallest possible */ + thr_opts.name = "child_waiter"; +#endif + +#if !DISABLE_VFORK + res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); + if (res != 0) { + if (res < 0) + erl_exit(-1, + "Environment variable BINDIR is not set\n"); + if (res > 0) + erl_exit(-1, + "Value of environment variable BINDIR is too large\n"); + } + if (bindir[0] != DIR_SEPARATOR_CHAR) + erl_exit(-1, + "Environment variable BINDIR does not contain an" + " absolute path\n"); + csp_path_sz = (strlen(bindir) + + 1 /* DIR_SEPARATOR_CHAR */ + + sizeof(CHILD_SETUP_PROG_NAME) + + 1); + child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz); + erts_snprintf(child_setup_prog, csp_path_sz, + "%s%c%s", + bindir, + DIR_SEPARATOR_CHAR, + CHILD_SETUP_PROG_NAME); +#endif + + report_exit_list = NULL; + +#ifdef USE_THREADS + +#if CHLDWTHR || defined(ERTS_SMP) + erts_mtx_init(&chld_stat_mtx, "child_status"); +#endif +#if CHLDWTHR +#ifndef ERTS_SMP + report_exit_transit_list = NULL; +#endif + erts_cnd_init(&chld_stat_cnd); + children_alive = 0; +#endif + +#if !CHLDWTHR && !defined(ERTS_SMP) + children_died = 0; +#endif + +#endif /* USE_THREADS */ + + sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ + driver_data = (ErtsSysDriverData *) + erts_alloc(ERTS_ALC_T_DRV_TAB, sys_max_files() * sizeof(ErtsSysDriverData)); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, + sys_max_files() * sizeof(ErtsSysDriverData)); + + for (i = 0; i < sys_max_files(); i++) + driver_data[i].pid = -1; + + fd_data = (ErtsSysFdData *) + erts_alloc(ERTS_ALC_T_FD_TAB, sys_max_files() * sizeof(ErtsSysFdData)); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, + sys_max_files() * sizeof(ErtsSysFdData)); + +#if CHLDWTHR + sys_sigblock(SIGCHLD); +#endif + + sys_signal(SIGCHLD, onchld); /* Reap children */ + +#if CHLDWTHR + erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); +#endif + + return 1; +} + +static void close_pipes(int ifd[2], int ofd[2], int read_write) +{ + if (read_write & DO_READ) { + (void) close(ifd[0]); + (void) close(ifd[1]); + } + if (read_write & DO_WRITE) { + (void) close(ofd[0]); + (void) close(ofd[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; +} + +static char **build_unix_environment(char *block) +{ + int i; + int j; + int len; + char *cp; + char **cpp; + char** old_env; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + + cp = block; + len = 0; + while (*cp != '\0') { + cp += strlen(cp) + 1; + len++; + } + old_env = environ; + while (*old_env++ != NULL) { + len++; + } + + cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, + sizeof(char *) * (len+1)); + if (cpp == NULL) { + return NULL; + } + + cp = block; + len = 0; + while (*cp != '\0') { + cpp[len] = cp; + cp += strlen(cp) + 1; + len++; + } + + i = len; + for (old_env = environ; *old_env; old_env++) { + char* old = *old_env; + + for (j = 0; j < len; j++) { + char *s, *t; + + s = cpp[j]; + t = old; + while (*s == *t && *s != '=') { + s++, t++; + } + if (*s == '=' && *t == '=') { + break; + } + } + + if (j == len) { /* New version not found */ + cpp[len++] = old; + } + } + + for (j = 0; j < i; ) { + size_t last = strlen(cpp[j])-1; + if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) { + cpp[j] = cpp[--len]; + if (len < i) { + i--; + } else { + j++; + } + } + else { + j++; + } + } + + cpp[len] = NULL; + return cpp; +} + +/* + [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory + in swap space for the child of a 'fork', whereas 'vfork' does not do this. + The natural call to use here is therefore 'vfork'. Due to a bug in + 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork' + can be dangerous in what seems to be these circumstances: + If the child code under a vfork sets the signal action to SIG_DFL + (or SIG_IGN) + for any signal which was previously set to a signal handler, the + state of the parent is clobbered, so that the later arrival of + such a signal yields a sigsegv in the parent. If the signal was + not set to a signal handler, but ignored, all seems to work. + If you change the forking code below, beware of this. + */ + +static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ +#define CMD_LINE_PREFIX_STR "exec " +#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) + + int ifd[2], ofd[2], len, pid, i; + char **volatile new_environ; /* volatile since a vfork() then cannot + cause 'new_environ' to be clobbered + in the parent process. */ + int saved_errno; + long res; + char *cmd_line; +#ifndef QNX + int unbind; +#endif +#if !DISABLE_VFORK + int no_vfork; + size_t no_vfork_sz = sizeof(no_vfork); + + no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK", + (char *) &no_vfork, + &no_vfork_sz) >= 0); +#endif + + switch (opts->read_write) { + case DO_READ: + if (pipe(ifd) < 0) + return ERL_DRV_ERROR_ERRNO; + if (ifd[0] >= sys_max_files()) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + ofd[1] = -1; /* keep purify happy */ + break; + case DO_WRITE: + if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO; + if (ofd[1] >= sys_max_files()) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + ifd[0] = -1; /* keep purify happy */ + break; + case DO_READ|DO_WRITE: + if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; + errno = EMFILE; /* default for next two conditions */ + if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) { + close_pipes(ifd, ofd, DO_READ); + return ERL_DRV_ERROR_ERRNO; + } + if (ofd[1] >= sys_max_files()) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + break; + default: + ASSERT(0); + return ERL_DRV_ERROR_GENERAL; + } + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + /* started with spawn_executable, not with spawn */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd, opts->read_write); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line,(void *) name, len); + cmd_line[len] = '\0'; + if (access(cmd_line,X_OK) != 0) { + int save_errno = errno; + erts_free(ERTS_ALC_T_TMP, cmd_line); + errno = save_errno; + return ERL_DRV_ERROR_ERRNO; + } + } else { + /* make the string suitable for giving to "sh" */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, + CMD_LINE_PREFIX_STR_SZ + len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd, opts->read_write); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line, + (void *) CMD_LINE_PREFIX_STR, + CMD_LINE_PREFIX_STR_SZ); + memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); + cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; + } + + erts_smp_rwmtx_rlock(&environ_rwmtx); + + if (opts->envir == NULL) { + new_environ = environ; + } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + +#ifndef QNX + /* Block child from SIGINT and SIGUSR1. Must be before fork() + to be safe. */ + block_signals(); + + CHLD_STAT_LOCK; + + unbind = erts_sched_bind_atfork_prepare(); + +#if !DISABLE_VFORK + /* See fork/vfork discussion before this function. */ + if (no_vfork) { +#endif + + DEBUGF(("Using fork\n")); + pid = fork(); + + if (pid == 0) { + /* The child! Setup child... */ + + if (erts_sched_bind_atfork_child(unbind) != 0) + goto child_error; + + /* OBSERVE! + * Keep child setup after vfork() (implemented below and in + * erl_child_setup.c) up to date if changes are made here. + */ + + if (opts->use_stdio) { + if (opts->read_write & DO_READ) { + /* stdout for process */ + if (dup2(ifd[1], 1) < 0) + goto child_error; + if(opts->redir_stderr) + /* stderr for process */ + if (dup2(ifd[1], 2) < 0) + goto child_error; + } + if (opts->read_write & DO_WRITE) + /* stdin for process */ + if (dup2(ofd[0], 0) < 0) + goto child_error; + } + else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ + if (opts->read_write & DO_READ) + if (dup2(ifd[1], 4) < 0) + goto child_error; + if (opts->read_write & DO_WRITE) + if (dup2(ofd[0], 3) < 0) + goto child_error; + } + +#if defined(HAVE_CLOSEFROM) + closefrom(opts->use_stdio ? 3 : 5); +#else + for (i = opts->use_stdio ? 3 : 5; i < sys_max_files(); i++) + (void) close(i); +#endif + + if (opts->wd && chdir(opts->wd) < 0) + goto child_error; + +#if defined(USE_SETPGRP_NOARGS) /* SysV */ + (void) setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + (void) setpgrp(0, getpid()); +#else /* POSIX */ + (void) setsid(); +#endif + + unblock_signals(); + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + if (opts->argv == NULL) { + execle(cmd_line,cmd_line,(char *) NULL, new_environ); + } else { + if (opts->argv[0] == erts_default_arg0) { + opts->argv[0] = cmd_line; + } + execve(cmd_line, opts->argv, new_environ); + if (opts->argv[0] == cmd_line) { + opts->argv[0] = erts_default_arg0; + } + } + } else { + execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); + } + child_error: + _exit(1); + } +#if !DISABLE_VFORK + } +#define ENOUGH_BYTES (44) + else { /* Use vfork() */ + char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* + sizeof(char *)); + char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */ + char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */ + /* on a 64-bit machine. */ + + /* Setup argv[] for the child setup program (implemented in + erl_child_setup.c) */ + i = 0; + if (opts->use_stdio) { + if (opts->read_write & DO_READ){ + /* stdout for process */ + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1); + if(opts->redir_stderr) + /* stderr for process */ + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2); + } + if (opts->read_write & DO_WRITE) + /* stdin for process */ + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0); + } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ + if (opts->read_write & DO_READ) + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4); + if (opts->read_write & DO_WRITE) + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3); + } + for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) + strcpy(&dup2_op[i][0], "-"); + erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, sys_max_files()-1); + + cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; + cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; + cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind); + cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range; + for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) + cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0]; + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + int num = 0; + int j = 0; + if (opts->argv != NULL) { + for(; opts->argv[num] != NULL; ++num) + ; + } + cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *)); + cs_argv[CS_ARGV_CMD_IX] = "-"; + cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line; + if (opts->argv != NULL) { + for (;opts->argv[j] != NULL; ++j) { + if (opts->argv[j] == erts_default_arg0) { + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line; + } else { + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j]; + } + } + } + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL; + } else { + cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */ + cs_argv[CS_ARGV_NO_OF_ARGS] = NULL; + } + DEBUGF(("Using vfork\n")); + pid = vfork(); + + if (pid == 0) { + /* The child! */ + + /* Observe! + * OTP-4389: The child setup program (implemented in + * erl_child_setup.c) will perform the necessary setup of the + * child before it execs to the user program. This because + * vfork() only allow an *immediate* execve() or _exit() in the + * child. + */ + execve(child_setup_prog, cs_argv, new_environ); + _exit(1); + } + erts_free(ERTS_ALC_T_TMP,cs_argv); + } +#undef ENOUGH_BYTES +#endif + + erts_sched_bind_atfork_parent(unbind); + + if (pid == -1) { + saved_errno = errno; + CHLD_STAT_UNLOCK; + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + unblock_signals(); + close_pipes(ifd, ofd, opts->read_write); + errno = saved_errno; + return ERL_DRV_ERROR_ERRNO; + } +#else /* QNX */ + if (opts->use_stdio) { + if (opts->read_write & DO_READ) + qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */ + if (opts->read_write & DO_WRITE) + qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */ + } + else { + if (opts->read_write & DO_READ) + qnx_spawn_options.iov[4] = ifd[1]; + if (opts->read_write & DO_WRITE) + qnx_spawn_options.iov[3] = ofd[0]; + } + /* Close fds on exec */ + for (i = 3; i < sys_max_files(); i++) + fcntl(i, F_SETFD, 1); + + qnx_spawn_options.flags = _SPAWN_SETSID; + 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(); + erts_smp_rwmtx_runlock(&environ_rwmtx); + close_pipes(ifd, ofd, opts->read_write); + return ERL_DRV_ERROR_GENERAL; + } + reset_qnx_spawn(); +#endif /* QNX */ + + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + + if (opts->read_write & DO_READ) + (void) close(ifd[1]); + if (opts->read_write & DO_WRITE) + (void) close(ofd[0]); + + if (opts->read_write & DO_READ) { + SET_NONBLOCKING(ifd[0]); + init_fd_data(ifd[0], port_num); + } + if (opts->read_write & DO_WRITE) { + SET_NONBLOCKING(ofd[1]); + init_fd_data(ofd[1], port_num); + } + + res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, + opts->read_write, opts->exit_status, pid, 0); + /* Don't unblock SIGCHLD until now, since the call above must + first complete putting away the info about our new subprocess. */ + unblock_signals(); + +#if CHLDWTHR + ASSERT(children_alive >= 0); + + if (!(children_alive++)) + CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children + was alive before we fork()ed ... */ +#endif + /* Don't unlock chld_stat_mtx until now of the same reason as above */ + CHLD_STAT_UNLOCK; + + erts_smp_rwmtx_runlock(&environ_rwmtx); + + return (ErlDrvData)res; +#undef CMD_LINE_PREFIX_STR +#undef CMD_LINE_PREFIX_STR_SZ +} + +#ifdef QNX +static reset_qnx_spawn() +{ + int i; + + /* Reset qnx_spawn_options */ + qnx_spawn_options.flags = 0; + qnx_spawn_options.iov[0] = 0xff; + qnx_spawn_options.iov[1] = 0xff; + qnx_spawn_options.iov[2] = 0xff; + qnx_spawn_options.iov[3] = 0xff; +} +#endif + +#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) +{ + int fd = (int)(long)drv_data; + char resbuff[2*sizeof(Uint32)]; + switch (command) { + case FD_CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + if (fd_get_window_size(fd,&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; + int non_blocking = 0; + + if (((opts->read_write & DO_READ) && opts->ifd >= sys_max_files()) || + ((opts->read_write & DO_WRITE) && opts->ofd >= sys_max_files())) + return ERL_DRV_ERROR_GENERAL; + + /* + * Historical: + * + * "Note about nonblocking I/O. + * + * At least on Solaris, setting the write end of a TTY to nonblocking, + * will set the input end to nonblocking as well (and vice-versa). + * If erl is run in a pipeline like this: cat | erl + * the input end of the TTY will be the standard input of cat. + * And cat is not prepared to handle nonblocking I/O." + * + * Actually, the reason for this is not that the tty itself gets set + * in non-blocking mode, but that the "input end" (cat's stdin) and + * the "output end" (erlang's stdout) are typically the "same" file + * descriptor, dup()'ed from a single fd by one of this process' + * ancestors. + * + * The workaround for this problem used to be a rather bad kludge, + * interposing an extra process ("internal cat") between erlang's + * stdout and the original stdout, allowing erlang to set its stdout + * in non-blocking mode without affecting the stdin of the preceding + * process in the pipeline - and being a kludge, it caused all kinds + * of weird problems. + * + * So, this is the current logic: + * + * The only reason to set non-blocking mode on the output fd at all is + * if it's something that can cause a write() to block, of course, + * i.e. primarily if it points to a tty, socket, pipe, or fifo. + * + * If we don't set non-blocking mode when we "should" have, and output + * becomes blocked, the entire runtime system will be suspended - this + * is normally bad of course, and can happen fairly "easily" - e.g. user + * hits ^S on tty - but doesn't necessarily happen. + * + * If we do set non-blocking mode when we "shouldn't" have, the runtime + * system will end up seeing EOF on the input fd (due to the preceding + * process dying), which typically will cause the entire runtime system + * to terminate immediately (due to whatever erlang process is seeing + * the EOF taking it as a signal to halt the system). This is *very* bad. + * + * I.e. we should take a conservative approach, and only set non- + * blocking mode when we a) need to, and b) are reasonably certain + * that it won't be a problem. And as in the example above, the problem + * occurs when input fd and output fd point to different "things". + * + * However, determining that they are not just the same "type" of + * "thing", but actually the same instance of that type of thing, is + * unreasonably complex in many/most cases. + * + * Also, with pipes, sockets, and fifos it's far from obvious that the + * user *wants* non-blocking output: If you're running erlang inside + * some complex pipeline, you're probably not running a real-time system + * that must never stop, but rather *want* it to suspend if the output + * channel is "full". + * + * So, the bottom line: We will only set the output fd non-blocking if + * it points to a tty, and either a) the input fd also points to a tty, + * or b) we can make sure that setting the output fd non-blocking + * doesn't interfere with someone else's input, via a somewhat milder + * kludge than the above. + * + * Also keep in mind that while this code is almost exclusively run as + * a result of an erlang open_port({fd,0,1}, ...), that isn't the only + * case - it can be called with any old pre-existing file descriptors, + * the relations between which (if they're even two) we can only guess + * at - still, we try our best... + * + * Added note OTP 18: Some systems seem to use stdout/stderr to log data + * using unix pipes, so we cannot allow the system to block on a write. + * Therefore we use an async thread to write the data to fd's that could + * not be set to non-blocking. When no async threads are available we + * fall back on the old behaviour. + * + * Also the guarantee about what is delivered to the OS has changed. + * Pre 18 the fd driver did no flushing of data before terminating. + * Now it does. This is because we want to be able to guarantee that things + * such as escripts and friends really have outputted all data before + * terminating. This could potentially block the termination of the system + * for a very long time, but if the user wants to terminate fast she should + * use erlang:halt with flush=false. + */ + + 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); + + /* If we don't have a read end, all bets are off - no non-blocking. */ + if (opts->read_write & DO_READ) { + + if (isatty(opts->ofd)) { /* output fd is a tty:-) */ + + if (isatty(opts->ifd)) { /* input fd is also a tty */ + + /* To really do this "right", we should also check that + input and output fd point to the *same* tty - but + this seems like overkill; ttyname() isn't for free, + and this is a very common case - and it's hard to + imagine a scenario where setting non-blocking mode + here would cause problems - go ahead and do it. */ + + non_blocking = 1; + SET_NONBLOCKING(opts->ofd); + + } else { /* output fd is a tty, input fd isn't */ + + /* This is a "problem case", but also common (see the + example above) - i.e. it makes sense to try a bit + harder before giving up on non-blocking mode: Try to + re-open the tty that the output fd points to, and if + successful replace the original one with the "new" fd + obtained this way, and set *that* one in non-blocking + mode. (Yes, this is a kludge.) + + However, re-opening the tty may fail in a couple of + (unusual) cases: + + 1) The name of the tty (or an equivalent one, i.e. + same major/minor number) can't be found, because + it actually lives somewhere other than /dev (or + wherever ttyname() looks for it), and isn't + equivalent to any of those that do live in the + "standard" place - this should be *very* unusual. + + 2) Permissions on the tty don't allow us to open it - + it's perfectly possible to have an fd open to an + object whose permissions wouldn't allow us to open + it. This is not as unusual as it sounds, one case + is if the user has su'ed to someone else (not + root) - we have a read/write fd open to the tty + (because it has been inherited all the way down + here), but we have neither read nor write + permission for the tty. + + In these cases, we finally give up, and don't set the + output fd in non-blocking mode. */ + + char *tty; + int nfd; + + if ((tty = ttyname(opts->ofd)) != NULL && + (nfd = open(tty, O_WRONLY)) != -1) { + dup2(nfd, opts->ofd); + close(nfd); + non_blocking = 1; + SET_NONBLOCKING(opts->ofd); + } + } + } + } + } + CHLD_STAT_LOCK; + res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); + 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, int fd) +{ + driver_select(prt,fd,DO_READ|DO_WRITE,0); + clear_fd_data(fd); + SET_BLOCKING(fd); +} + +static void fd_stop(ErlDrvData ev) /* Does not close the fds */ +{ + int ofd; + int fd = (int)(long)ev; + ErlDrvPort prt = driver_data[fd].port_num; + +#if FDBLOCK + if (driver_data[fd].blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); + driver_data[fd].blocking = NULL; + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); + } +#endif + + nbio_stop_fd(prt, fd); + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) + nbio_stop_fd(prt, ofd); +} + +static void fd_flush(ErlDrvData fd) +{ + if (!driver_data[(int)(long)fd].terminating) + driver_data[(int)(long)fd].terminating = 1; +} + +static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + int flags, fd; + ErlDrvData res; + + flags = (opts->read_write == DO_READ ? O_RDONLY : + opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : + O_RDWR|O_CREAT); + if ((fd = open(name, flags, 0666)) < 0) + return ERL_DRV_ERROR_GENERAL; + if (fd >= sys_max_files()) { + close(fd); + return ERL_DRV_ERROR_GENERAL; + } + SET_NONBLOCKING(fd); + init_fd_data(fd, port_num); + + CHLD_STAT_LOCK; + res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, + opts->packet_bytes, + opts->read_write, 0, -1, 0); + CHLD_STAT_UNLOCK; + return res; +} + +/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ +/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ + +static void stop(ErlDrvData fd) +{ + ErlDrvPort prt; + int ofd; + + prt = driver_data[(int)(long)fd].port_num; + nbio_stop_fd(prt, (int)(long)fd); + + ofd = driver_data[(int)(long)fd].ofd; + if (ofd != (int)(long)fd && (int)(long)ofd != -1) + nbio_stop_fd(prt, ofd); + else + ofd = -1; + + CHLD_STAT_LOCK; + + /* Mark as unused. */ + driver_data[(int)(long)fd].pid = -1; + + CHLD_STAT_UNLOCK; + + /* SMP note: Close has to be last thing done (open file descriptors work + as locks on driver_data[] entries) */ + driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */ + if (ofd >= 0) { + driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */ + } +} + +/* used by fd_driver */ +static void outputv(ErlDrvData e, ErlIOVec* ev) +{ + int fd = (int)(long)e; + ErlDrvPort ix = driver_data[fd].port_num; + int pb = driver_data[fd].packet_bytes; + int ofd = driver_data[fd].ofd; + ssize_t n; + ErlDrvSizeT sz; + char lb[4]; + char* lbp; + ErlDrvSizeT len = ev->size; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/ + if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + /* Handles 0 <= pb <= 4 only */ + put_int32((Uint32) len, lb); + lbp = lb + (4-pb); + + ev->iov[0].iov_base = lbp; + ev->iov[0].iov_len = pb; + ev->size += pb; + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_lock(driver_data[fd].blocking->pdl); + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enqv(ix, ev, 0); + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_unlock(driver_data[fd].blocking->pdl); + + if (sz + ev->size >= (1 << 13)) + set_busy_port(ix, 1); + } + else if (!driver_data[fd].blocking || !FDBLOCK) { + /* We try to write directly if the fd in non-blocking */ + int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; + + n = writev(ofd, (const void *) (ev->iov), vsize); + if (n == ev->size) + return; /* 0;*/ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1;*/ + } + n = 0; + } + driver_enqv(ix, ev, n); /* n is the skip value */ + driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } +#if FDBLOCK + else { + if (ev->size != 0) { + driver_enqv(ix, ev, 0); + driver_pdl_unlock(driver_data[fd].blocking->pdl); + driver_async(ix, &driver_data[fd].blocking->pkey, + fd_async, driver_data+fd, NULL); + } else { + driver_pdl_unlock(driver_data[fd].blocking->pdl); + } + } +#endif + /* return 0;*/ +} + +/* Used by spawn_driver and vanilla driver */ +static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) +{ + int fd = (int)(long)e; + ErlDrvPort ix = driver_data[fd].port_num; + int pb = driver_data[fd].packet_bytes; + int ofd = driver_data[fd].ofd; + ssize_t n; + ErlDrvSizeT sz; + char lb[4]; + char* lbp; + struct iovec iv[2]; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + put_int32(len, lb); + lbp = lb + (4-pb); + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enq(ix, lbp, pb); + driver_enq(ix, buf, len); + if (sz + len + pb >= (1 << 13)) + set_busy_port(ix, 1); + } + else { + iv[0].iov_base = lbp; + iv[0].iov_len = pb; /* should work for pb=0 */ + iv[1].iov_base = buf; + iv[1].iov_len = len; + n = writev(ofd, iv, 2); + if (n == pb+len) + return; /* 0; */ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1; */ + } + n = 0; + } + if (n < pb) { + driver_enq(ix, lbp+n, pb-n); + driver_enq(ix, buf, len); + } + else { + n -= pb; + driver_enq(ix, buf+n, len-n); + } + driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } + return; /* 0; */ +} + +static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) + /* Result: 0 (eof) or -1 (error) */ +{ + int err = errno; + + ASSERT(res <= 0); + (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(ready_fd); + + if (driver_data[ready_fd].blocking && FDBLOCK) { + driver_pdl_lock(driver_data[ready_fd].blocking->pdl); + if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + /* We have stuff in the output queue, so we just + set the state to terminating and wait for fd_async_ready + to terminate the port */ + if (res == 0) + driver_data[ready_fd].terminating = 2; + else + driver_data[ready_fd].terminating = -err; + return 0; + } + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + } + + if (res == 0) { + if (driver_data[ready_fd].report_exit) { + CHLD_STAT_LOCK; + + if (driver_data[ready_fd].alive) { + /* + * We have eof and want to report exit status, but the process + * hasn't exited yet. When it does report_exit_status() will + * driver_select() this fd which will make sure that we get + * back here with driver_data[ready_fd].alive == 0 and + * driver_data[ready_fd].status set. + */ + CHLD_STAT_UNLOCK; + return 0; + } + else { + int status = driver_data[ready_fd].status; + CHLD_STAT_UNLOCK; + + /* We need not be prepared for stopped/continued processes. */ + if (WIFSIGNALED(status)) + status = 128 + WTERMSIG(status); + else + status = WEXITSTATUS(status); + + driver_report_exit(driver_data[ready_fd].port_num, status); + } + } + driver_failure_eof(port_num); + } else { + driver_failure_posix(port_num, err); + } + return 0; +} + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) +{ + int fd = (int)(long)e; + ErlDrvPort port_num; + int packet_bytes; + int res; + Uint h; + + port_num = driver_data[fd].port_num; + packet_bytes = driver_data[fd].packet_bytes; + + + if (packet_bytes == 0) { + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) + port_inp_failure(port_num, ready_fd, res); + else + driver_output(port_num, (char*) read_buf, res); + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } + else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ + /* space is allocated in buf */ + res = read(ready_fd, fd_data[ready_fd].cpos, + fd_data[ready_fd].remain); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) { + port_inp_failure(port_num, ready_fd, res); + } + else if (res == fd_data[ready_fd].remain) { /* we're done */ + driver_output(port_num, fd_data[ready_fd].buf, + fd_data[ready_fd].sz); + clear_fd_data(ready_fd); + } + else { /* if (res < fd_data[ready_fd].remain) */ + fd_data[ready_fd].cpos += res; + fd_data[ready_fd].remain -= res; + } + } + else if (fd_data[ready_fd].remain == 0) { /* clean fd */ + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + /* We make one read attempt and see what happens */ + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) { /* eof */ + port_inp_failure(port_num, ready_fd, res); + } + else if (res < packet_bytes - fd_data[ready_fd].psz) { + memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz, + read_buf, res); + fd_data[ready_fd].psz += res; + } + else { /* if (res >= packet_bytes) */ + unsigned char* cpos = read_buf; + int bytes_left = res; + + while (1) { + int psz = fd_data[ready_fd].psz; + char* pbp = fd_data[ready_fd].pbuf + psz; + + while(bytes_left && (psz < packet_bytes)) { + *pbp++ = *cpos++; + bytes_left--; + psz++; + } + + if (psz < packet_bytes) { + fd_data[ready_fd].psz = psz; + break; + } + fd_data[ready_fd].psz = 0; + + switch (packet_bytes) { + case 1: h = get_int8(fd_data[ready_fd].pbuf); break; + case 2: h = get_int16(fd_data[ready_fd].pbuf); break; + case 4: h = get_int32(fd_data[ready_fd].pbuf); break; + default: ASSERT(0); return; /* -1; */ + } + + if (h <= (bytes_left)) { + driver_output(port_num, (char*) cpos, h); + cpos += h; + bytes_left -= h; + continue; + } + else { /* The last message we got was split */ + char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) { + errno = ENOMEM; + port_inp_failure(port_num, ready_fd, -1); + } + else { + erts_smp_atomic_add_nob(&sys_misc_mem_sz, h); + sys_memcpy(buf, cpos, bytes_left); + fd_data[ready_fd].buf = buf; + fd_data[ready_fd].sz = h; + fd_data[ready_fd].remain = h - bytes_left; + fd_data[ready_fd].cpos = buf + bytes_left; + } + break; + } + } + } + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } +} + + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) +{ + int fd = (int)(long)e; + ErlDrvPort ix = driver_data[fd].port_num; + int n; + struct iovec* iv; + int vsize; + + + if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + if (driver_data[fd].terminating) + driver_failure_atom(driver_data[fd].port_num,"normal"); + return; /* 0; */ + } + vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; + if ((n = writev(ready_fd, iv, vsize)) > 0) { + if (driver_deq(ix, n) == 0) + set_busy_port(ix, 0); + } + else if (n < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) + return; /* 0; */ + else { + int res = errno; + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + driver_failure_posix(ix, res); + return; /* -1; */ + } + } + return; /* 0; */ +} + +static void stop_select(ErlDrvEvent fd, void* _) +{ + close((int)fd); +} + +#if FDBLOCK + +static void +fd_async(void *async_data) +{ + int res; + ErtsSysDriverData *dd = (ErtsSysDriverData*)async_data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int err = 0; + /* much of this code is stolen from efile_drv:invoke_writev */ + driver_pdl_lock(dd->blocking->pdl); + iov0 = driver_peekq(dd->port_num, &iovlen); + iovlen = iovlen < MAXIOV ? iovlen : MAXIOV; + iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF, + sizeof(SysIOVec)*iovlen); + if (!iov) { + res = -1; + err = ENOMEM; + driver_pdl_unlock(dd->blocking->pdl); + } else { + memcpy(iov,iov0,iovlen*sizeof(SysIOVec)); + driver_pdl_unlock(dd->blocking->pdl); + + do { + res = writev(dd->ofd, iov, iovlen); + } while (res < 0 && errno == EINTR); + if (res < 0) + err = errno; + err = errno; + + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + } + dd->blocking->res = res; + dd->blocking->err = err; +} + +void fd_ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) { + ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data; + ErlDrvPort port_num = dd->port_num; + + ASSERT(dd->blocking); + ASSERT(dd == (driver_data + (int)(long)drv_data)); + + if (dd->blocking->res > 0) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_deq(port_num, dd->blocking->res) == 0) { + driver_pdl_unlock(dd->blocking->pdl); + set_busy_port(port_num, 0); + if (dd->terminating) { + /* The port is has been ordered to terminate + from either fd_flush or port_inp_failure */ + if (dd->terminating == 1) + driver_failure_atom(port_num, "normal"); + else if (dd->terminating == 2) + driver_failure_eof(port_num); + else if (dd->terminating < 0) + driver_failure_posix(port_num, -dd->terminating); + return; /* -1; */ + } + } else { + driver_pdl_unlock(dd->blocking->pdl); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + return /* 0; */; + } + } else if (dd->blocking->res < 0) { + if (dd->blocking->err == ERRNO_BLOCK) { + set_busy_port(port_num, 1); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + } else + driver_failure_posix(port_num, dd->blocking->err); + return; /* -1; */ + } + return; /* 0; */ +} + +#endif + +static ERTS_INLINE void +report_exit_status(ErtsSysReportExit *rep, int status) +{ + Port *pp; +#ifdef ERTS_SMP + CHLD_STAT_UNLOCK; + pp = erts_thr_id2port_sflgs(rep->port, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); + CHLD_STAT_LOCK; +#else + pp = erts_id2port_sflgs(rep->port, + NULL, + 0, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); +#endif + if (pp) { + if (rep->ifd >= 0) { + driver_data[rep->ifd].alive = 0; + driver_data[rep->ifd].status = status; + (void) driver_select(ERTS_Port2ErlDrvPort(pp), + rep->ifd, + (ERL_DRV_READ|ERL_DRV_USE), + 1); + } + if (rep->ofd >= 0) { + driver_data[rep->ofd].alive = 0; + driver_data[rep->ofd].status = status; + (void) driver_select(ERTS_Port2ErlDrvPort(pp), + rep->ofd, + (ERL_DRV_WRITE|ERL_DRV_USE), + 1); + } +#ifdef ERTS_SMP + erts_thr_port_release(pp); +#else + erts_port_release(pp); +#endif + } + erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); +} + +#if !CHLDWTHR /* ---------------------------------------------------------- */ + +#define ERTS_REPORT_EXIT_STATUS report_exit_status + +int check_children(void) +{ + int res = 0; + int pid; + int status; + +#ifndef ERTS_SMP + if (children_died) +#endif + { + sys_sigblock(SIGCHLD); + CHLD_STAT_LOCK; + while ((pid = waitpid(-1, &status, WNOHANG)) > 0) + note_child_death(pid, status); +#ifndef ERTS_SMP + children_died = 0; +#endif + CHLD_STAT_UNLOCK; + sys_sigrelease(SIGCHLD); + res = 1; + } + return res; +} + +#ifdef ERTS_SMP + +void +erts_check_children(void) +{ + (void) check_children(); +} + +#endif + +#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */ + +#define ERTS_REPORT_EXIT_STATUS report_exit_status + +int check_children(void) +{ + return 0; +} + +#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */ + +#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status + +static ERTS_INLINE void +initiate_report_exit_status(ErtsSysReportExit *rep, int status) +{ + rep->next = report_exit_transit_list; + rep->status = status; + report_exit_transit_list = rep; + erts_sys_schedule_interrupt(1); +} + +int check_children(void) +{ + int res; + ErtsSysReportExit *rep; + CHLD_STAT_LOCK; + rep = report_exit_transit_list; + res = rep != NULL; + while (rep) { + ErtsSysReportExit *curr_rep = rep; + rep = rep->next; + report_exit_status(curr_rep, curr_rep->status); + } + report_exit_transit_list = NULL; + CHLD_STAT_UNLOCK; + return res; +} + +#endif /* ------------------------------------------------------------------ */ + +static void note_child_death(int pid, int status) +{ + ErtsSysReportExit **repp = &report_exit_list; + ErtsSysReportExit *rep = report_exit_list; + + while (rep) { + if (pid == rep->pid) { + *repp = rep->next; + ERTS_REPORT_EXIT_STATUS(rep, status); + break; + } + repp = &rep->next; + rep = rep->next; + } +} + +#if CHLDWTHR + +static void * +child_waiter(void *unused) +{ + int pid; + int status; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("child waiter"); +#endif + + while(1) { +#ifdef DEBUG + int waitpid_errno; +#endif + pid = waitpid(-1, &status, 0); +#ifdef DEBUG + waitpid_errno = errno; +#endif + CHLD_STAT_LOCK; + if (pid < 0) { + ASSERT(waitpid_errno == ECHILD); + } + else { + children_alive--; + ASSERT(children_alive >= 0); + note_child_death(pid, status); + } + while (!children_alive) + CHLD_STAT_WAIT; /* Wait for children to wait on... :) */ + CHLD_STAT_UNLOCK; + } + + return NULL; +} + +#endif -- cgit v1.2.3 From 14c7fefd51be035a44bfe42127fb4b9df92d760b Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 6 Jul 2015 17:13:52 +0200 Subject: erts: Create forker process for spawn driver Instead of forking from the beam process, we create a separate process in which all forks are done. This has several advantages: 1) performance: * don't have to close all fd's in the world * fork only has to copy stuff from a small process * work is done in a completely seperate process * a 3x performance increase has been measured, can be made even greater (10x) if we cache the environment in child setup 2) stability * the exec is done in another process than beam, which means that if the file that we exec to is on an nfs that is not available right now we will not block a scheduler until the nfs returns. 3) simplicity * don't have to deal with SIGCHLD in the erts Unfortunately, this solution also implies some badness. 1) There will always be a seperate process running together with beam on unix. This could be confusing and undesirable. 2) We have to transfer the entire environment to child_setup for each command. OTP-13088 --- erts/configure.in | 49 +- erts/emulator/Makefile.in | 11 +- erts/emulator/beam/erl_init.c | 1 + erts/emulator/beam/erl_lock_check.c | 4 +- erts/emulator/beam/erl_port.h | 7 +- erts/emulator/beam/erl_process.c | 37 - erts/emulator/beam/erl_process.h | 6 - erts/emulator/beam/global.h | 1 + erts/emulator/beam/io.c | 67 +- erts/emulator/beam/sys.h | 10 +- erts/emulator/sys/unix/erl_child_setup.c | 427 +++++-- erts/emulator/sys/unix/erl_unix_sys.h | 49 +- erts/emulator/sys/unix/sys.c | 33 +- erts/emulator/sys/unix/sys_drivers.c | 1771 ++++++++++++++---------------- erts/emulator/sys/unix/sys_uds.c | 125 +++ erts/emulator/sys/unix/sys_uds.h | 47 + erts/emulator/sys/win32/sys.c | 12 +- erts/emulator/test/port_SUITE.erl | 30 +- 18 files changed, 1473 insertions(+), 1214 deletions(-) create mode 100644 erts/emulator/sys/unix/sys_uds.c create mode 100644 erts/emulator/sys/unix/sys_uds.h diff --git a/erts/configure.in b/erts/configure.in index 96ad58f941..32d8bca98c 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -106,7 +106,6 @@ AC_CONFIG_HEADER($host/config.h:config.h.in include/internal/$host/ethread_heade dnl ---------------------------------------------------------------------- dnl Optional features. dnl ---------------------------------------------------------------------- -enable_child_waiter_thread=no ENABLE_ALLOC_TYPE_VARS= AC_SUBST(ENABLE_ALLOC_TYPE_VARS) @@ -1291,11 +1290,7 @@ else AC_MSG_RESULT(no) fi - disable_child_waiter_thread=no case $host_os in - solaris*) - enable_child_waiter_thread=yes - ;; linux*) AC_MSG_CHECKING([whether dlopen() needs to be called before first call to dlerror()]) if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then @@ -1305,16 +1300,6 @@ else else AC_MSG_RESULT(no) fi - if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then - # Child waiter thread cannot be enabled - disable_child_waiter_thread=yes - enable_child_waiter_thread=no - fi - ;; - win32) - # Child waiter thread cannot be enabled - disable_child_waiter_thread=yes - enable_child_waiter_thread=no ;; *) ;; @@ -1334,24 +1319,6 @@ else esac done EMU_THR_DEFS=$new_emu_thr_defs - - AC_MSG_CHECKING(whether the child waiter thread should be enabled) - if test $enable_child_waiter_thread = yes; then - AC_DEFINE(ENABLE_CHILD_WAITER_THREAD,[1], - [Define if you want to enable child waiter thread]) - AC_MSG_RESULT(yes) - else - case $ERTS_BUILD_SMP_EMU-$disable_child_waiter_thread in - yes-no) - AC_MSG_RESULT([yes on SMP build, but not on non-SMP build]);; - *-yes) - AC_DEFINE(DISABLE_CHILD_WAITER_THREAD,[1], - [Define if you want to disable child waiter thread]) - AC_MSG_RESULT(no);; - *) - AC_MSG_RESULT(no);; - esac - fi fi AC_SUBST(EMU_THR_LIB_NAME) @@ -1483,19 +1450,27 @@ dnl # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- +tk_oldLibs=$LIBS erl_checkBoth=0 +SOCKET_LIBS="" AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1) if test "$erl_checkSocket" = 1; then - AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1) + AC_CHECK_LIB(socket, main, SOCKET_LIBS="-lsocket", erl_checkBoth=1) fi + if test "$erl_checkBoth" = 1; then - tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" - AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs]) + AC_CHECK_FUNC(accept, SOCKET_LIBS="-lsocket -lnsl") fi -AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +LIBS="$tk_oldLibs $SOCKET_LIBS" +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [SOCKET_LIBS="$SOCKET_LIBS -lnsl"])) AC_CHECK_FUNC(gethostbyname_r,have_gethostbyname_r=yes) +LIBS="$tk_oldLibs $SOCKET_LIBS" + +AC_SUBST(SOCKET_LIBS) + dnl dnl These gethostbyname thingies use old style AC_DEFINE for BC with ancient dnl autoconf... diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 69f28b0c10..ab415b66b4 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -317,7 +317,7 @@ else CS_CFLAGS = $(CS_CFLAGS_) endif CS_LDFLAGS = $(LDFLAGS) -CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ +CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ @SOCKET_LIBS@ LIBS += @TERMCAP_LIB@ -L../lib/internal/$(TARGET) @ERTS_INTERNAL_X_LIBS@ @@ -690,11 +690,11 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c # ---------------------------------------------------------------------- # Specials # -CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c +CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o -$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_SRC) $(ERTS_LIB) - $(ld_verbose)$(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ - $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS) +$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS_LIB) + $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ + $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_OBJ) $(CS_LIBS) $(OBJDIR)/%.kp.o: sys/common/%.c $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -799,6 +799,7 @@ else OS_OBJS = \ $(OBJDIR)/sys.o \ $(OBJDIR)/sys_drivers.o \ + $(OBJDIR)/sys_uds.o \ $(OBJDIR)/driver_tab.o \ $(OBJDIR)/unix_efile.o \ $(OBJDIR)/gzio.o \ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 5c209a4af2..69c0de81be 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -388,6 +388,7 @@ erl_init(int ncpu, erts_mseg_late_init(); /* Must be after timer (erts_init_time()) and thread initializations */ #endif + erl_sys_late_init(); #ifdef HIPE hipe_mode_switch_init(); /* Must be after init_load/beam_catches/init */ #endif diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 84bee976ff..34c0144cbc 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -113,9 +113,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "environ", NULL }, #endif { "efile_drv", "address" }, -#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP) - { "child_status", NULL }, -#endif { "drv_ev_state_grow", NULL, }, { "drv_ev_state", "address" }, { "safe_hash", "address" }, @@ -187,6 +184,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { #ifdef ERTS_SMP { "os_monotonic_time", NULL }, #endif + { "forker_hash_mtx", NULL }, { "erts_alloc_hard_debug", NULL }, { "hard_dbg_mseg", NULL }, { "erts_mmap", NULL } diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index bc4b412594..fa97707a87 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -692,7 +692,7 @@ erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep) Port *prt = ERTS_ErlDrvPort2Port(drvport); erts_aint32_t state; ASSERT(prt); - ERTS_LC_ASSERT(erts_lc_is_emu_thr()); +// ERTS_LC_ASSERT(erts_lc_is_emu_thr()); if (prt == ERTS_INVALID_ERL_DRV_PORT) return ERTS_INVALID_ERL_DRV_PORT; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) @@ -949,4 +949,9 @@ ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *); ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *); +/* + * Signals from ports to ports. Used by sys drivers. + */ +int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT); + #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 15a6d5d651..03cb3dc254 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -497,9 +497,6 @@ dbg_chk_aux_work_val(erts_aint32_t value) #if HAVE_ERTS_MSEG valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; #endif -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; -#endif #ifdef ERTS_SSI_AUX_WORK_REAP_PORTS valid |= ERTS_SSI_AUX_WORK_REAP_PORTS; #endif @@ -586,8 +583,6 @@ erts_pre_init_process(void) = "MISC_THR_PRGR"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX] = "MISC"; - erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX] - = "CHECK_CHILDREN"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX] = "SET_TMO"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX] @@ -2100,34 +2095,6 @@ erts_debug_wait_completed(Process *c_p, int flags) } -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN -void -erts_smp_notify_check_children_needed(void) -{ - int i; - 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 -handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) -{ - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN); - erts_check_children(); - return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN; -} - -#endif - static void notify_reap_ports_relb(void) { @@ -2281,10 +2248,6 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC, handle_misc_aux_work); -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CHECK_CHILDREN, - handle_check_children); -#endif HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO, handle_setup_aux_work_timer); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index e7c5614b9c..ef58fef102 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -293,7 +293,6 @@ typedef enum { ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX, ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX, ERTS_SSI_AUX_WORK_MISC_IX, - ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX, ERTS_SSI_AUX_WORK_SET_TMO_IX, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX, ERTS_SSI_AUX_WORK_REAP_PORTS_IX, @@ -326,8 +325,6 @@ typedef enum { (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX) #define ERTS_SSI_AUX_WORK_MISC \ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_IX) -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ - (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX) #define ERTS_SSI_AUX_WORK_SET_TMO \ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX) #define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \ @@ -1643,11 +1640,8 @@ Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); void erts_alloc_notify_delayed_dealloc(int); void erts_alloc_ensure_handle_delayed_dealloc_call(int); -#ifdef ERTS_SMP void erts_notify_canceled_timer(ErtsSchedulerData *, int); #endif -void erts_smp_notify_check_children_needed(void); -#endif #if ERTS_USE_ASYNC_READY_Q void erts_notify_check_async_ready_queue(void *); #endif diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index b4d02dd1dd..4352d5758b 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1322,6 +1322,7 @@ extern void erts_match_prog_foreach_offheap(Binary *b, extern erts_driver_t vanilla_driver; extern erts_driver_t spawn_driver; +extern erts_driver_t forker_driver; extern erts_driver_t fd_driver; int erts_beam_jump_table(void); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 2a3759212e..6ec7a9ba1e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -54,6 +54,7 @@ extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; extern ErlDrvEntry spawn_driver_entry; +extern ErlDrvEntry forker_driver_entry; extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */ erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */ @@ -71,6 +72,7 @@ const Port erts_invalid_port = {{ERTS_INVALID_PORT}}; erts_driver_t vanilla_driver; erts_driver_t spawn_driver; +erts_driver_t forker_driver; erts_driver_t fd_driver; int erts_port_synchronous_ops = 0; @@ -306,12 +308,9 @@ static Port *create_port(char *name, size_t port_size, busy_port_queue_size, size; erts_aint32_t state = ERTS_PORT_SFLG_CONNECTED; erts_aint32_t x_pts_flgs = 0; -#ifdef DEBUG - /* Make sure the debug flags survives until port is freed */ - state |= ERTS_PORT_SFLG_PORT_DEBUG; -#endif #ifdef ERTS_SMP + ErtsRunQueue *runq; if (!driver_lock) { /* Align size for mutex following port struct */ port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port)); @@ -321,6 +320,12 @@ static Port *create_port(char *name, #endif port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port)); +#ifdef DEBUG + /* Make sure the debug flags survives until port is freed */ + state |= ERTS_PORT_SFLG_PORT_DEBUG; +#endif + + busy_port_queue_size = ((driver->flags & ERL_DRV_FLAG_NO_BUSY_MSGQ) ? 0 @@ -356,8 +361,12 @@ static Port *create_port(char *name, p += sizeof(erts_mtx_t); state |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK; } - erts_smp_atomic_set_nob(&prt->run_queue, - (erts_aint_t) erts_get_runq_current(NULL)); + if (erts_get_scheduler_data()) + runq = erts_get_runq_current(NULL); + else + runq = ERTS_RUNQ_IX(0); + erts_smp_atomic_set_nob(&prt->run_queue, (erts_aint_t) runq); + prt->xports = NULL; #else erts_atomic32_init_nob(&prt->refc, 1); @@ -1535,6 +1544,26 @@ erts_schedule_proc2port_signal(Process *c_p, return ERTS_PORT_OP_SCHEDULED; } +static int +erts_schedule_port2port_signal(Eterm port_num, ErtsProc2PortSigData *sigdp, + int task_flags, + ErtsProc2PortSigCallback callback) +{ + Port *prt = erts_port_lookup_raw(port_num); + + if (!prt) + return -1; + + sigdp->caller = ERTS_INVALID_PID; + + return erts_port_task_schedule(prt->common.id, + NULL, + ERTS_PORT_TASK_PROC_SIG, + sigdp, + callback, + task_flags); +} + static ERTS_INLINE void send_badsig(Port *prt) { ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; @@ -2862,6 +2891,7 @@ void erts_init_io(int port_tab_size, init_driver(&fd_driver, &fd_driver_entry, NULL); init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); init_driver(&spawn_driver, &spawn_driver_entry, NULL); + init_driver(&forker_driver, &forker_driver_entry, NULL); erts_init_static_drivers(); for (dp = driver_tab; *dp != NULL; dp++) erts_add_driver_entry(*dp, NULL, 1); @@ -2923,6 +2953,7 @@ void erts_lcnt_enable_io_lock_count(int enable) { lcnt_enable_drv_lock_count(&vanilla_driver, enable); lcnt_enable_drv_lock_count(&spawn_driver, enable); + lcnt_enable_drv_lock_count(&forker_driver, enable); lcnt_enable_drv_lock_count(&fd_driver, enable); /* enable lock counting in all drivers */ for (dp = driver_list; dp; dp = dp->next) { @@ -3964,7 +3995,7 @@ port_sig_control(Port *prt, Uint hsz, rsz; int control_flags; - rp = erts_proc_lookup_raw(sigdp->caller); + rp = sigdp->caller == ERTS_INVALID_PID ? NULL : erts_proc_lookup_raw(sigdp->caller); if (!rp) goto done; @@ -4007,7 +4038,8 @@ port_sig_control(Port *prt, /* failure */ - port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); + if (sigdp->caller != ERTS_INVALID_PID) + port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); done: @@ -4017,6 +4049,23 @@ done: return ERTS_PORT_REDS_CONTROL; } +/* + * This is an asynchronous control call. I.e. it will not return anything + * to the caller. + */ +int +erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size) +{ + ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data(); + + sigdp->flags = ERTS_P2P_SIG_TYPE_CONTROL | ERTS_P2P_SIG_DATA_FLG_REPLY; + sigdp->u.control.binp = NULL; + sigdp->u.control.command = cmd; + sigdp->u.control.bufp = buff; + sigdp->u.control.size = size; + + return erts_schedule_port2port_signal(port_num, sigdp, 0, port_sig_control); +} ErtsPortOpResult erts_port_control(Process* c_p, @@ -4794,6 +4843,8 @@ print_port_info(Port *p, int to, void *arg) erts_print(to, arg, "Port is a file: %s\n",p->name); } else if (p->drv_ptr == &spawn_driver) { erts_print(to, arg, "Port controls external process: %s\n",p->name); + } else if (p->drv_ptr == &forker_driver) { + erts_print(to, arg, "Port controls forker process: %s\n",p->name); } else { erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name); } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 34011147d9..522d899c94 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -61,15 +61,6 @@ # define NO_FPE_SIGNALS #endif -#ifdef DISABLE_CHILD_WAITER_THREAD -#undef ENABLE_CHILD_WAITER_THREAD -#endif - -#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD) -#undef ENABLE_CHILD_WAITER_THREAD -#define ENABLE_CHILD_WAITER_THREAD 1 -#endif - #define ERTS_I64_LITERAL(X) X##LL #if defined (__WIN32__) @@ -731,6 +722,7 @@ void erts_sys_main_thread(void); extern int erts_sys_prepare_crash_dump(int secs); extern void erts_sys_pre_init(void); extern void erl_sys_init(void); +extern void erl_sys_late_init(void); extern void erl_sys_args(int *argc, char **argv); extern void erl_sys_schedule(int); void sys_tty_reset(int); diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index a3c5c20641..71c7948bf0 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * Copyright Ericsson AB 2002-2015. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -19,109 +19,195 @@ */ /* - * After a vfork() (or fork()) the child exec()s to this program which - * sets up the child and exec()s to the user program (see spawn_start() - * in sys.c and ticket OTP-4389). + * This program is started at erts startup and all fork's that + * have to be done are done in here. This is done for a couple + * of reasons: + * - Allow usage of fork without a memory explosion. + * -- we do not want to use vfork, as it blocks the VM + * until the execv is done, and if the program that + * is to be executed is on an NFS that is unavailable, + * the execv can block for a very long time. + * -- we cannot do fork inside the VM as that would temporarily + * duplicate the memory usage of the VM per parallel exec. + * + * Some implementation notes: + * - A single Unix Domain Socket is setup in between the VM and + * this program. Over that UDS the file descriptors that should + * be used to talk to the child program are sent. + * The actual command to execute, together with options and the + * environment, is sent over the pipe represented by the + * file descriptors mentioned above. We don't send the + * command over the UDS as that would increase the likely hood + * that it's buffer would be full. + * + * - Since it is this program that execv's, it has to take care of + * all the SIGCHLD signals that the child programs generate. The + * signals are received and the pid+exit reason is sent as data + * on the UDS to the VM. The VM is then able to map the pid to the + * port of the child program that just exited and deliver the status + * code if requested. */ #ifdef HAVE_CONFIG_H # include "config.h" #endif -#define NEED_CHILD_SETUP_DEFINES -#include "sys.h" -#include "erl_misc_utils.h" +#include +#include +#include -#ifdef SIG_SIGSET /* Old SysV */ -void sys_sigrelease(int sig) -{ - sigrelse(sig); -} -#else /* !SIG_SIGSET */ -#ifdef SIG_SIGNAL /* Old BSD */ -sys_sigrelease(int sig) +#include "erl_driver.h" +#include "sys_uds.h" + +#define SET_CLOEXEC(fd) fcntl(fd, F_SETFD, fcntl(fd, F_GETFD) | FD_CLOEXEC) + +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + +//#define HARD_DEBUG +#ifdef HARD_DEBUG +#define DEBUG_PRINT(fmt, ...) fprintf(stderr, fmt "\r\n", ##__VA_ARGS__) +#else +#define DEBUG_PRINT(fmt, ...) +#endif + +#define ABORT(fmt, ...) do { \ + fprintf(stderr, "erl_child_setup: " fmt "\r\n", ##__VA_ARGS__); \ + abort(); \ + } while(0) + +#undef ASSERT +#ifdef DEBUG +#define ASSERT(cnd) do { if (!(cnd)) { ABORT("assertion %s failed", #cnd); } } while(0) +#else +#define ASSERT(cnd) +#endif + +void sys_sigblock(int sig) { - sigsetmask(sigblock(0) & ~sigmask(sig)); + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL); } -#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */ + void sys_sigrelease(int sig) { sigset_t mask; - sigemptyset(&mask); sigaddset(&mask, sig); sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); } -#endif /* !SIG_SIGNAL */ -#endif /* !SIG_SIGSET */ -#if defined(__ANDROID__) -static int system_properties_fd(void); -#endif /* __ANDROID__ */ +static int max_files = -1; +static int sigchld_pipe[2]; -#if defined(__ANDROID__) -#define SHELL "/system/bin/sh" -#else -#define SHELL "/bin/sh" -#endif /* __ANDROID__ */ +static int +start_new_child(int pipes[]) +{ + int size, res, i; + char *buff, *o_buff; + char *cmd, *wd, **new_environ, **args = NULL, cbuff[1]; -int -main(int argc, char *argv[]) -{ - int i, from, to; - int erts_spawn_executable = 0; - - /* OBSERVE! - * Keep child setup after fork() (implemented in sys.c) up to date - * if changes are made here. - */ - - if (argc != CS_ARGV_NO_OF_ARGS) { - if (argc < CS_ARGV_NO_OF_ARGS) { - return 1; - } else { - erts_spawn_executable = 1; - } + Sint cnt, flags; + + /* only child executes here */ + + if ((res = read(pipes[0], (char*)&size, sizeof(size))) < 0) { + ABORT("Failed to read size from %d (%d)", pipes[0], errno); } - if (strcmp("false", argv[CS_ARGV_UNBIND_IX]) != 0) - if (erts_unbind_from_cpu_str(argv[CS_ARGV_UNBIND_IX]) != 0) - return 1; - - for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) { - if (argv[CS_ARGV_DUP2_OP_IX(i)][0] == '-' - && argv[CS_ARGV_DUP2_OP_IX(i)][1] == '\0') - break; - if (sscanf(argv[CS_ARGV_DUP2_OP_IX(i)], "%d:%d", &from, &to) != 2) - return 1; - if (dup2(from, to) < 0) - return 1; + buff = malloc(size); + + DEBUG_PRINT("size = %d", size); + + if ((res = read(pipes[0], buff, size)) != size) { + ABORT("Failed to read %d bytes from %d (%d,%d)", + size, pipes[0], res, errno); } - if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2) - return 1; + o_buff = buff; -#if defined(HAVE_CLOSEFROM) - closefrom(from); -#elif defined(__ANDROID__) - if (from <= to) { - int spfd = system_properties_fd(); - for (i = from; i <= to; i++) { - if (i != spfd) { - (void) close(i); - } - } + flags = *(int*)buff; + buff += sizeof(int); + + DEBUG_PRINT("flags = %d", flags); + + cmd = buff; + buff += strlen(buff) + 1; + if (*buff == '\0') { + wd = NULL; + } else { + wd = buff; + buff += strlen(buff) + 1; + } + buff++; + + DEBUG_PRINT("wd = %s", wd); + + cnt = *(int*)buff; + buff += sizeof(int); + new_environ = malloc(sizeof(char*)*(cnt + 1)); + + for (i = 0; i < cnt; i++, buff++) { + new_environ[i] = buff; + while(*buff != '\0') buff++; + } + new_environ[cnt] = NULL; + + if (o_buff + size != buff) { + /* This is a spawn executable call */ + cnt = *(int*)buff; + buff += sizeof(int); + args = malloc(sizeof(char*)*(cnt + 1)); + for (i = 0; i < cnt; i++, buff++) { + args[i] = buff; + while(*buff != '\0') buff++; + } + args[cnt] = NULL; + } + + if (o_buff + size != buff) { + ABORT("Buff error: %p, %p:%p", o_buff, o_buff+size, buff); + } + + if (read(pipes[0], cbuff, 1) < 1) + goto child_error; + + DEBUG_PRINT("Do that forking business: '%s'\n",cmd); + + /* When the dup2'ing below is done, only + fd's 0, 1, 2 and maybe 3, 4 should survive the + exec. All other fds (i.e. the unix domain sockets + and stray pipe ends) should have CLOEXEC set on them + so they will be closed when the exec happens */ + if (flags & FORKER_FLAG_USE_STDIO) { + /* stdin for process */ + if (flags & FORKER_FLAG_DO_WRITE && + dup2(pipes[0], 0) < 0) + goto child_error; + /* stdout for process */ + if (flags & FORKER_FLAG_DO_READ && + dup2(pipes[1], 1) < 0) + goto child_error; } -#else /* !__ANDROID__ */ - for (i = from; i <= to; i++) { - (void) close(i); + else { /* XXX will fail if pipes[0] == 4 (unlikely..) */ + if (flags & FORKER_FLAG_DO_READ && dup2(pipes[1], 4) < 0) + goto child_error; + if (flags & FORKER_FLAG_DO_WRITE && dup2(pipes[0], 3) < 0) + goto child_error; } -#endif /* HAVE_CLOSEFROM */ - if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0') - && chdir(argv[CS_ARGV_WD_IX]) < 0) - return 1; + if (dup2(pipes[2], 2) < 0) + goto child_error; + + if (wd && chdir(wd) < 0) + goto child_error; #if defined(USE_SETPGRP_NOARGS) /* SysV */ (void) setpgrp(); @@ -131,34 +217,197 @@ main(int argc, char *argv[]) (void) setsid(); #endif + close(pipes[0]); + close(pipes[1]); + close(pipes[2]); + sys_sigrelease(SIGCHLD); - sys_sigrelease(SIGINT); - sys_sigrelease(SIGUSR1); - - if (erts_spawn_executable) { - if (argv[CS_ARGV_NO_OF_ARGS + 1] == NULL) { - execl(argv[CS_ARGV_NO_OF_ARGS],argv[CS_ARGV_NO_OF_ARGS], - (char *) NULL); - } else { - execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1])); - } + + if (args) { + /* spawn_executable */ + execve(cmd, args, new_environ); } else { - execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); + execle(SHELL, "sh", "-c", cmd, (char *) NULL, new_environ); } - return 1; +child_error: + _exit(1); +} + + +/* + * [OTP-3906] + * Solaris signal management gets confused when threads are used and a + * lot of child processes dies. The confusion results in that SIGCHLD + * signals aren't delivered to the emulator which in turn results in + * a lot of defunct processes in the system. + * + * The problem seems to appear when a signal is frequently + * blocked/unblocked at the same time as the signal is frequently + * propagated. The child waiter thread is a workaround for this problem. + * The SIGCHLD signal is always blocked (in all threads), and the child + * waiter thread fetches the signal by a call to sigwait(). See + * child_waiter(). + * + * This should be a non-issue since the fork:ing was moved outside of + * the emulator into erl_child_setup. I'm leaving the comment here + * for posterity. */ + +static void handle_sigchld(int sig) { + int buff[2], res; + + sys_sigblock(SIGCHLD); + + while ((buff[0] = waitpid((pid_t)(-1), buff+1, WNOHANG)) > 0) { + if ((res = write(sigchld_pipe[1], buff, sizeof(buff))) <= 0) + ABORT("Failed to write to sigchld_pipe (%d): %d (%d)", sigchld_pipe[1], res, errno); + DEBUG_PRINT("Reap child %d (%d)", buff[0], buff[1]); + } + + sys_sigrelease(SIGCHLD); } #if defined(__ANDROID__) static int system_properties_fd(void) { - int fd; + static int fd = -2; char *env; + if (fd != -2) return fd; env = getenv("ANDROID_PROPERTY_WORKSPACE"); if (!env) { + fd = -1; return -1; } fd = atoi(env); return fd; } #endif /* __ANDROID__ */ + +int +main(int argc, char *argv[]) +{ + /* This fd should be open from beam */ + int uds_fd = 3, max_fd = 3; +#ifndef HAVE_CLOSEFROM + int i; +#endif + struct sigaction sa; + + if (argc < 1 || sscanf(argv[1],"%d",&max_files) != 1) { + ABORT("Invalid arguments to child_setup"); + } + +/* We close all fds except the uds from beam. + All other fds from now on will have the + CLOEXEC flags set on them. This means that we + only have to close a very limited number of fds + after we fork before the exec. */ +#if defined(HAVE_CLOSEFROM) + closefrom(4); +#else + for (i = 4; i < max_files; i++) +#if defined(__ANDROID__) + if (i != system_properties_fd()) +#endif + (void) close(i); +#endif + + if (pipe(sigchld_pipe) < 0) { + ABORT("Failed to setup sigchld pipe (%d)", errno); + } + + SET_CLOEXEC(sigchld_pipe[0]); + SET_CLOEXEC(sigchld_pipe[1]); + + max_fd = max_fd < sigchld_pipe[0] ? sigchld_pipe[0] : max_fd; + + sa.sa_handler = &handle_sigchld; + sigemptyset(&sa.sa_mask); + sa.sa_flags = SA_RESTART | SA_NOCLDSTOP; + if (sigaction(SIGCHLD, &sa, 0) == -1) { + perror(0); + exit(1); + } + + SET_CLOEXEC(uds_fd); + + DEBUG_PRINT("Starting forker %d", max_files); + + while (1) { + fd_set read_fds; + int res; + FD_ZERO(&read_fds); + FD_SET(uds_fd, &read_fds); + FD_SET(sigchld_pipe[0], &read_fds); + DEBUG_PRINT("child_setup selecting on %d, %d (%d)", + uds_fd, sigchld_pipe[0], max_fd); + res = select(max_fd+1, &read_fds, NULL, NULL, NULL); + + if (res < 0) { + if (errno == EINTR) continue; + ABORT("Select failed: %d (%d)",res, errno); + } + + if (FD_ISSET(uds_fd, &read_fds)) { + int pipes[3], res, os_pid; + char buff[256]; + errno = 0; + if ((res = sys_uds_read(uds_fd, buff, 1, pipes, 3, MSG_DONTWAIT)) < 0) { + if (errno == EINTR) + continue; + DEBUG_PRINT("erl_child_setup failed to read from uds: %d, %d", res, errno); + _exit(0); + } + + if (res == 0) { + DEBUG_PRINT("uds was closed!"); + _exit(0); + } + /* Since we use unix domain sockets and send the entire data in + one go we *should* get the entire payload at once. */ + ASSERT(res == 1); + ASSERT(buff[0] == 'S'); + + sys_sigblock(SIGCHLD); + + errno = 0; + + os_pid = fork(); + if (os_pid == 0) + start_new_child(pipes); + + /* We write an ack here, but expect the reply on + the pipes[0] inside the fork */ + res = sprintf(buff,"GO:%010d:%010d", os_pid, errno); + if (write(pipes[1], buff, res + 1)) + ; /* remove gcc warning */ + + sys_sigrelease(SIGCHLD); + close(pipes[0]); + close(pipes[1]); + close(pipes[2]); + } + + if (FD_ISSET(sigchld_pipe[0], &read_fds)) { + int ibuff[2]; + char buff[256]; + res = read(sigchld_pipe[0], ibuff, sizeof(ibuff)); + if (res < 0) { + if (errno == EINTR) + continue; + ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno); + } + res = snprintf(buff, 256, "SIGCHLD:%010d:%010d", ibuff[0], ibuff[1]); + DEBUG_PRINT("send %s to %d", buff, uds_fd); + if (write(uds_fd, buff, res + 1) < 0) { + if (errno == EINTR) + continue; + /* The uds was close, which most likely means that the VM + has exited. This will be detected when we try to read + from the uds_fd. */ + DEBUG_PRINT("Failed to write to uds: %d (%d)", uds_fd, errno); + } + } + } + return 1; +} diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index a11a44c259..c46f2c1fa2 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -30,9 +30,7 @@ #include #include #include -#ifndef QNX #include -#endif #if defined(__sun__) && defined(__SVR4) && !defined(__EXTENSIONS__) # define __EXTENSIONS__ @@ -92,11 +90,6 @@ #include #endif -#ifdef QNX -#include -#include -#endif - #include #ifndef HZ @@ -136,13 +129,6 @@ # define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT #endif -#ifndef ENABLE_CHILD_WAITER_THREAD -# ifdef ERTS_SMP -# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN -void erts_check_children(void); -# endif -#endif - typedef void *GETENV_STATE; /* @@ -310,7 +296,6 @@ typedef void (*SIGFUNC)(int); extern SIGFUNC sys_signal(int, SIGFUNC); extern void sys_sigrelease(int); extern void sys_sigblock(int); -extern void sys_stop_cat(void); /* * Handling of floating point exceptions. @@ -425,18 +410,14 @@ void erts_sys_unblock_fpe(int); #define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) -#ifdef NEED_CHILD_SETUP_DEFINES -/* The child setup argv[] */ -#define CS_ARGV_PROGNAME_IX 0 /* Program name */ -#define CS_ARGV_UNBIND_IX 1 /* Unbind from cpu */ -#define CS_ARGV_WD_IX 2 /* Working directory */ -#define CS_ARGV_CMD_IX 3 /* Command */ -#define CS_ARGV_FD_CR_IX 4 /* Fd close range */ -#define CS_ARGV_DUP2_OP_IX(N) ((N) + 5) /* dup2 operations */ +#define FORKER_ARGV_NO_OF_ARGS 3 +#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */ +#define FORKER_ARGV_MAX_FILES 1 /* max_files */ -#define CS_ARGV_NO_OF_DUP2_OPS 3 /* Number of dup2 ops */ -#define CS_ARGV_NO_OF_ARGS 8 /* Number of arguments */ -#endif /* #ifdef NEED_CHILD_SETUP_DEFINES */ +#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */ +#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */ +#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */ +#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */ /* Threads */ #ifdef USE_THREADS @@ -470,20 +451,4 @@ extern jmp_buf erts_sys_sigsegv_jmp; } while(0) #endif -#ifdef USE_THREADS -# ifdef ENABLE_CHILD_WAITER_THREAD -# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD -# else -# define CHLDWTHR 0 -# endif -# define FDBLOCK 1 -#else -# define CHLDWTHR 0 -# define FDBLOCK 0 -#endif - -#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 - -int check_children(void); - #endif /* #ifndef _ERL_UNIX_SYS_H */ diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 503ef5c2f6..2ad5f3b4d5 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -49,7 +49,6 @@ #include #endif -#define NEED_CHILD_SETUP_DEFINES #define ERTS_WANT_BREAK_HANDLING #define ERTS_WANT_GOT_SIGUSR1 #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ @@ -93,6 +92,7 @@ extern void erts_sys_init_float(void); extern void erl_crash_dump(char* file, int line, char* fmt, ...); + #ifdef DEBUG static int debug_log = 0; #endif @@ -122,6 +122,7 @@ static void smp_sig_notify(char c); static int sig_notify_fds[2] = {-1, -1}; static int sig_suspend_fds[2] = {-1, -1}; +#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2 #endif @@ -307,9 +308,10 @@ MALLOC_USE_HASH(1); #ifdef USE_THREADS #ifdef ERTS_THR_HAVE_SIG_FUNCS + /* * Child thread inherits parents signal mask at creation. In order to - * guarantee that the main thread will receive all SIGINT, SIGCHLD, and + * guarantee that the main thread will receive all SIGINT, and * SIGUSR1 signals sent to the process, we block these signals in the * parent thread when creating a new thread. */ @@ -405,7 +407,6 @@ erts_sys_pre_init(void) #ifdef ERTS_THR_HAVE_SIG_FUNCS sigemptyset(&thr_create_sigmask); sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ - sigaddset(&thr_create_sigmask, SIGCHLD); /* block child signals */ sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ #endif @@ -1010,7 +1011,6 @@ erts_sys_unsetenv(char *key) void sys_init_io(void) { - } #if (0) /* unused? */ @@ -1204,7 +1204,6 @@ erl_debug(char* fmt, ...) #endif /* DEBUG */ - /* * Called from schedule() when it runs out of runnable processes, * or when Erlang code has performed INPUT_REDUCTIONS reduction @@ -1213,15 +1212,11 @@ erl_debug(char* fmt, ...) void erl_sys_schedule(int runnable) { -#ifdef ERTS_SMP ERTS_CHK_IO(!runnable); -#else - ERTS_CHK_IO(runnable ? 0 : !check_children()); -#endif ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); - (void) check_children(); } + #ifdef ERTS_SMP static erts_smp_tid_t sig_dispatcher_tid; @@ -1246,10 +1241,6 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { -#if !CHLDWTHR - int initialized = 0; - int notify_check_children = 0; -#endif #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_set_thread_name("signal_dispatcher"); #endif @@ -1287,19 +1278,7 @@ signal_dispatcher_thread_func(void *unused) */ switch (buf[i]) { case 0: /* Emulator initialized */ -#if !CHLDWTHR - initialized = 1; - if (!notify_check_children) -#endif - break; -#if !CHLDWTHR - case 'C': /* SIGCHLD */ - if (initialized) - erts_smp_notify_check_children_needed(); - else - notify_check_children = 1; - break; -#endif + break; case 'I': /* SIGINT */ break_requested(); break; diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index e3f089fc0f..8402197924 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -36,6 +36,7 @@ #include #include #include +#include #ifdef ISC32 #include @@ -49,26 +50,20 @@ #include #endif -#define NEED_CHILD_SETUP_DEFINES #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ #include "sys.h" -#include "erl_thr_progress.h" - -#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) -#define __DARWIN__ 1 -#endif #ifdef USE_THREADS #include "erl_threads.h" #endif -#include "erl_mseg.h" - extern char **environ; extern erts_smp_rwmtx_t environ_rwmtx; extern erts_smp_atomic_t sys_misc_mem_sz; +static Eterm forker_port; + #define MAX_VSIZE 16 /* Max number of entries allowed in an I/O * vector sock_sendv(). */ @@ -76,14 +71,10 @@ extern erts_smp_atomic_t sys_misc_mem_sz; * Don't need global.h, but erl_cpu_topology.h won't compile otherwise */ #include "global.h" - -#include "erl_sys_driver.h" -#include "erl_check_io.h" #include "erl_cpu_topology.h" -#ifndef DISABLE_VFORK -#define DISABLE_VFORK 0 -#endif +#include "erl_sys_driver.h" +#include "sys_uds.h" #if defined IOV_MAX #define MAXIOV IOV_MAX @@ -93,32 +84,11 @@ extern erts_smp_atomic_t sys_misc_mem_sz; #define MAXIOV 16 #endif -/* - * [OTP-3906] - * Solaris signal management gets confused when threads are used and a - * lot of child processes dies. The confusion results in that SIGCHLD - * signals aren't delivered to the emulator which in turn results in - * a lot of defunct processes in the system. - * - * The problem seems to appear when a signal is frequently - * blocked/unblocked at the same time as the signal is frequently - * propagated. The child waiter thread is a workaround for this problem. - * The SIGCHLD signal is always blocked (in all threads), and the child - * waiter thread fetches the signal by a call to sigwait(). See - * child_waiter(). - */ - -typedef struct ErtsSysReportExit_ ErtsSysReportExit; -struct ErtsSysReportExit_ { - ErtsSysReportExit *next; - Eterm port; - int pid; - int ifd; - int ofd; -#if CHLDWTHR && !defined(ERTS_SMP) - int status; +#ifdef USE_THREADS +# define FDBLOCK 1 +#else +# define FDBLOCK 0 #endif -}; /* Used by the fd driver iff the fd could not be set to non-blocking */ typedef struct ErtsSysBlocking_ { @@ -128,12 +98,21 @@ typedef struct ErtsSysBlocking_ { unsigned int pkey; } ErtsSysBlocking; +typedef struct fd_data { + int fd; + char pbuf[4]; /* hold partial packet bytes */ + int psz; /* size of pbuf */ + char *buf; + char *cpos; + int sz; + int remain; /* for input on fd */ +} ErtsSysFdData; -/* This data is shared by these drivers - initialized by spawn_init() */ typedef struct driver_data { ErlDrvPort port_num; - int ofd, packet_bytes; - ErtsSysReportExit *report_exit; + ErtsSysFdData *ofd; + ErtsSysFdData *ifd; + int packet_bytes; int pid; int alive; int status; @@ -141,12 +120,11 @@ typedef struct driver_data { ErtsSysBlocking *blocking; } ErtsSysDriverData; -static ErtsSysDriverData *driver_data; /* indexed by fd */ - -static ErtsSysReportExit *report_exit_list; -#if CHLDWTHR && !defined(ERTS_SMP) -static ErtsSysReportExit *report_exit_transit_list; -#endif +typedef struct exit_status { + HashBucket hb; + pid_t os_pid; + Eterm port_id; +} ErtsSysExitStatus; #define DIR_SEPARATOR_CHAR '/' @@ -156,7 +134,6 @@ static ErtsSysReportExit *report_exit_transit_list; #define SHELL "/bin/sh" #endif /* __ANDROID__ */ - #if defined(DEBUG) #define ERL_BUILD_TYPE_MARKER ".debug" #elif defined(PURIFY) @@ -171,103 +148,80 @@ static ErtsSysReportExit *report_exit_transit_list; #define ERL_BUILD_TYPE_MARKER #endif +#ifdef DEBUG +#define close(fd) do { int res = close(fd); ASSERT(res > -1); } while(0) +#endif + #define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER -static char *child_setup_prog; -#if CHLDWTHR || defined(ERTS_SMP) -erts_mtx_t chld_stat_mtx; -#endif -#if CHLDWTHR -static erts_tid_t child_waiter_tid; -/* chld_stat_mtx is used to protect against concurrent accesses - of the driver_data fields pid, alive, and status. */ -erts_cnd_t chld_stat_cnd; -static long children_alive; -#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) -#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) -#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx) -#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd) -#elif 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; +// #define HARD_DEBUG +#ifdef HARD_DEBUG +#define driver_select(port_num, fd, flags, onoff) \ + do { \ + if (((flags) & ERL_DRV_READ) && onoff) \ + fprintf(stderr,"%010d %p: read select %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_WRITE) && onoff) \ + fprintf(stderr,"%010d %p: writ select %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_READ) && !onoff) \ + fprintf(stderr,"%010d %p: read unsele %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_WRITE) && !onoff) \ + fprintf(stderr,"%010d %p: writ unsele %d\r\n", __LINE__, port_num, (int)fd); \ + driver_select_nkp(port_num, fd, flags, onoff); \ + } while(0) #endif -typedef struct ErtsSysFdData { - char pbuf[4]; /* hold partial packet bytes */ - int psz; /* size of pbuf */ - char *buf; - char *cpos; - int sz; - int remain; /* for input on fd */ -} ErtsSysFdData; - -static ErtsSysFdData *fd_data; /* indexed by fd */ +/* + * Decreasing the size of it below 16384 is not allowed. + */ -/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ -static void note_child_death(int, int); +#define ERTS_SYS_READ_BUF_SZ (64*1024) -#if CHLDWTHR -static void* child_waiter(void *); -#endif +/* I. Initialization */ -static void block_signals(void) +void +erl_sys_late_init(void) { -#if !CHLDWTHR - sys_sigblock(SIGCHLD); -#endif -#ifndef ERTS_SMP - sys_sigblock(SIGINT); -#ifndef ETHR_UNUSABLE_SIGUSRX - sys_sigblock(SIGUSR1); -#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ -#endif /* #ifndef ERTS_SMP */ - -#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) - sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL); + SysDriverOpts opts; +#ifdef ERTS_SMP + Port *port; #endif -} + sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ + + opts.packet_bytes = 0; + opts.use_stdio = 1; + opts.redir_stderr = 0; + opts.read_write = 0; + opts.hide_window = 0; + opts.wd = NULL; + opts.envir = NULL; + opts.exit_status = 0; + opts.overlapped_io = 0; + opts.spawn_type = ERTS_SPAWN_ANY; + opts.argv = NULL; + opts.parallelism = erts_port_parallelism; -static void unblock_signals(void) -{ - /* Update erl_child_setup.c if changed */ -#if !CHLDWTHR - sys_sigrelease(SIGCHLD); +#ifdef ERTS_SMP + port = #endif -#ifndef ERTS_SMP - sys_sigrelease(SIGINT); -#ifndef ETHR_UNUSABLE_SIGUSRX - sys_sigrelease(SIGUSR1); -#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ -#endif /* #ifndef ERTS_SMP */ - -#if defined(ERTS_SMP) && !defined(ETHR_UNUSABLE_SIGUSRX) - sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL); + erts_open_driver(&forker_driver, make_internal_pid(0), "forker", &opts, NULL, NULL); +#ifdef ERTS_SMP + erts_mtx_unlock(port->lock); #endif - } -/************************** Port I/O *******************************/ +/* II. Prototypes */ +/* II.I Spawn prototypes */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvSSizeT spawn_control(ErlDrvData, unsigned int, char *, + ErlDrvSizeT, char **, ErlDrvSizeT); +/* II.II Vanilla prototypes */ +static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); -/* I. Common stuff */ - -/* - * Decreasing the size of it below 16384 is not allowed. - */ - -/* II. The spawn/fd/vanilla drivers */ - -#define ERTS_SYS_READ_BUF_SZ (64*1024) -/* Driver interfaces */ -static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +/* II.III FD prototypes */ static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); #if FDBLOCK static void fd_async(void *); @@ -275,10 +229,10 @@ static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); #endif static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); -static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); -static int spawn_init(void); static void fd_stop(ErlDrvData); static void fd_flush(ErlDrvData); + +/* II.IV Common prototypes */ static void stop(ErlDrvData); static void ready_input(ErlDrvData, ErlDrvEvent); static void ready_output(ErlDrvData, ErlDrvEvent); @@ -286,8 +240,22 @@ static void output(ErlDrvData, char*, ErlDrvSizeT); static void outputv(ErlDrvData, ErlIOVec*); static void stop_select(ErlDrvEvent, void*); +/* II.V Forker prototypes */ +static int forker_init(void); +static ErlDrvData forker_start(ErlDrvPort, char*, SysDriverOpts*); +static void forker_stop(ErlDrvData); +static void forker_ready_input(ErlDrvData, ErlDrvEvent); +static void forker_ready_output(ErlDrvData, ErlDrvEvent); +static ErlDrvSSizeT forker_control(ErlDrvData, unsigned int, char *, + ErlDrvSizeT, char **, ErlDrvSizeT); +static void forker_add_os_pid_mapping(ErtsSysDriverData *); +static void forker_remove_os_pid_mapping(ErtsSysDriverData *); + +/* III Driver entries */ + +/* III.I The spawn driver */ struct erl_drv_entry spawn_driver_entry = { - spawn_init, + forker_init, spawn_start, stop, output, @@ -296,7 +264,7 @@ struct erl_drv_entry spawn_driver_entry = { "spawn", NULL, NULL, - NULL, + spawn_control, NULL, NULL, NULL, @@ -306,17 +274,19 @@ struct erl_drv_entry spawn_driver_entry = { ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, - ERL_DRV_FLAG_USE_PORT_LOCKING, + ERL_DRV_FLAG_USE_PORT_LOCKING | ERL_DRV_FLAG_USE_INIT_ACK, NULL, NULL, stop_select }; + +/* III.II The fd driver */ struct erl_drv_entry fd_driver_entry = { NULL, fd_start, fd_stop, output, ready_input, - ready_output, + ready_output, "fd", NULL, NULL, @@ -339,6 +309,8 @@ struct erl_drv_entry fd_driver_entry = { NULL, /* process_exit */ stop_select }; + +/* III.III The vanilla driver */ struct erl_drv_entry vanilla_driver_entry = { NULL, vanilla_start, @@ -365,22 +337,33 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; -/* Handle SIGCHLD signals. */ -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE onchld(void) -#else -static RETSIGTYPE onchld(int signum) -#endif -{ -#if CHLDWTHR - ASSERT(0); /* We should *never* catch a SIGCHLD signal */ -#elif defined(ERTS_SMP) - smp_sig_notify('C'); -#else - children_died = 1; - ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ -#endif -} +/* III.III The forker driver */ +struct erl_drv_entry forker_driver_entry = { + NULL, + forker_start, + forker_stop, + NULL, + forker_ready_input, + forker_ready_output, + "spawn_forker", + NULL, + NULL, + forker_control, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, NULL, + stop_select +}; + +/* Untility functions */ static int set_blocking_data(ErtsSysDriverData *dd) { @@ -396,187 +379,94 @@ static int set_blocking_data(ErtsSysDriverData *dd) { return 1; } -static int set_driver_data(ErlDrvPort port_num, - int ifd, - int ofd, - int packet_bytes, - int read_write, - int exit_status, - int pid, - int is_blocking) +static void init_fd_data(ErtsSysFdData *fd_data, int fd) { - Port *prt; - ErtsSysReportExit *report_exit; - - if (!exit_status) - report_exit = NULL; - else { - 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; -#if CHLDWTHR && !defined(ERTS_SMP) - report_exit->status = 0; -#endif - report_exit_list = report_exit; - } - - prt = erts_drvport2port(port_num); - if (prt != ERTS_INVALID_ERL_DRV_PORT) - prt->os_pid = pid; - - if (read_write & DO_READ) { - driver_data[ifd].packet_bytes = packet_bytes; - driver_data[ifd].port_num = port_num; - driver_data[ifd].report_exit = report_exit; - driver_data[ifd].pid = pid; - driver_data[ifd].alive = 1; - driver_data[ifd].status = 0; - driver_data[ifd].terminating = 0; - driver_data[ifd].blocking = NULL; - if (read_write & DO_WRITE) { - driver_data[ifd].ofd = ofd; - if (is_blocking && FDBLOCK) - if (!set_blocking_data(driver_data+ifd)) - return -1; - if (ifd != ofd) - driver_data[ofd] = driver_data[ifd]; /* structure copy */ - } else { /* DO_READ only */ - driver_data[ifd].ofd = -1; - } - (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); - return(ifd); - } else { /* DO_WRITE only */ - driver_data[ofd].packet_bytes = packet_bytes; - driver_data[ofd].port_num = port_num; - driver_data[ofd].report_exit = report_exit; - driver_data[ofd].ofd = ofd; - driver_data[ofd].pid = pid; - driver_data[ofd].alive = 1; - driver_data[ofd].status = 0; - driver_data[ofd].terminating = 0; - driver_data[ofd].blocking = NULL; - if (is_blocking && FDBLOCK) - if (!set_blocking_data(driver_data+ofd)) - return -1; - return(ofd); - } + fd_data->fd = fd; + fd_data->buf = NULL; + fd_data->cpos = NULL; + fd_data->remain = 0; + fd_data->sz = 0; + fd_data->psz = 0; } -static int spawn_init() +static ErtsSysDriverData * +create_driver_data(ErlDrvPort port_num, + int ifd, + int ofd, + int packet_bytes, + int read_write, + int exit_status, + int pid, + int is_blocking) { - int i; -#if CHLDWTHR - erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; -#endif - int res; - char bindir[MAXPATHLEN]; - size_t bindirsz = sizeof(bindir); - Uint csp_path_sz; - -#if CHLDWTHR - thr_opts.detached = 0; - thr_opts.suggested_stack_size = 0; /* Smallest possible */ - thr_opts.name = "child_waiter"; -#endif - -#if !DISABLE_VFORK - res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); - if (res != 0) { - if (res < 0) - erl_exit(-1, - "Environment variable BINDIR is not set\n"); - if (res > 0) - erl_exit(-1, - "Value of environment variable BINDIR is too large\n"); - } - if (bindir[0] != DIR_SEPARATOR_CHAR) - erl_exit(-1, - "Environment variable BINDIR does not contain an" - " absolute path\n"); - csp_path_sz = (strlen(bindir) - + 1 /* DIR_SEPARATOR_CHAR */ - + sizeof(CHILD_SETUP_PROG_NAME) - + 1); - child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz); - erts_snprintf(child_setup_prog, csp_path_sz, - "%s%c%s", - bindir, - DIR_SEPARATOR_CHAR, - CHILD_SETUP_PROG_NAME); -#endif - - report_exit_list = NULL; - -#ifdef USE_THREADS - -#if CHLDWTHR || defined(ERTS_SMP) - erts_mtx_init(&chld_stat_mtx, "child_status"); -#endif -#if CHLDWTHR -#ifndef ERTS_SMP - report_exit_transit_list = NULL; -#endif - erts_cnd_init(&chld_stat_cnd); - children_alive = 0; -#endif - -#if !CHLDWTHR && !defined(ERTS_SMP) - children_died = 0; -#endif - -#endif /* USE_THREADS */ - - sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ - driver_data = (ErtsSysDriverData *) - erts_alloc(ERTS_ALC_T_DRV_TAB, sys_max_files() * sizeof(ErtsSysDriverData)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - sys_max_files() * sizeof(ErtsSysDriverData)); + Port *prt; + ErtsSysDriverData *driver_data; + char *data; + int size = sizeof(ErtsSysDriverData); - for (i = 0; i < sys_max_files(); i++) - driver_data[i].pid = -1; + if (read_write & DO_READ) + size += sizeof(ErtsSysFdData); - fd_data = (ErtsSysFdData *) - erts_alloc(ERTS_ALC_T_FD_TAB, sys_max_files() * sizeof(ErtsSysFdData)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - sys_max_files() * sizeof(ErtsSysFdData)); + if ((read_write & DO_WRITE) && + ((ifd != ofd || ofd == -1) || !(read_write & DO_READ))) + size += sizeof(ErtsSysFdData); -#if CHLDWTHR - sys_sigblock(SIGCHLD); -#endif + data = erts_alloc(ERTS_ALC_T_DRV_TAB,size); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, size); - sys_signal(SIGCHLD, onchld); /* Reap children */ + driver_data = (ErtsSysDriverData*)data; + data += sizeof(*driver_data); -#if CHLDWTHR - erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); -#endif + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) + prt->os_pid = pid; - return 1; -} + driver_data->packet_bytes = packet_bytes; + driver_data->port_num = port_num; + driver_data->pid = pid; + driver_data->alive = exit_status ? 1 : 0; + driver_data->status = 0; + driver_data->terminating = 0; + driver_data->blocking = NULL; -static void close_pipes(int ifd[2], int ofd[2], int read_write) -{ if (read_write & DO_READ) { - (void) close(ifd[0]); - (void) close(ifd[1]); + driver_data->ifd = (ErtsSysFdData*)data; + data += sizeof(*driver_data->ifd); + init_fd_data(driver_data->ifd, ifd); + driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); + } else { + driver_data->ifd = NULL; } + if (read_write & DO_WRITE) { - (void) close(ofd[0]); - (void) close(ofd[1]); + if (ofd != -1 && ifd == ofd && read_write & DO_READ) { + /* This is for when ifd and ofd are the same fd */ + driver_data->ofd = driver_data->ifd; + } else { + driver_data->ofd = (ErtsSysFdData*)data; + data += sizeof(*driver_data->ofd); + init_fd_data(driver_data->ofd, ofd); + } + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data)) { + erts_free(ERTS_ALC_T_DRV_TAB, driver_data); + return NULL; + } + } else { + driver_data->ofd = NULL; } + + return driver_data; } -static void init_fd_data(int fd, ErlDrvPort port_num) +/* Spawn driver */ + +static void close_pipes(int ifd[2], int ofd[2]) { - 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; + close(ifd[0]); + close(ifd[1]); + close(ofd[0]); + close(ofd[1]); } static char **build_unix_environment(char *block) @@ -622,6 +512,10 @@ static char **build_unix_environment(char *block) for (j = 0; j < len; j++) { char *s, *t; + /* check if cpp[j] equals old + before the = sign, + i.e. + "TMPDIR=/tmp/" */ s = cpp[j]; t = old; while (*s == *t && *s != '=') { @@ -656,81 +550,43 @@ static char **build_unix_environment(char *block) return cpp; } -/* - [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory - in swap space for the child of a 'fork', whereas 'vfork' does not do this. - The natural call to use here is therefore 'vfork'. Due to a bug in - 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork' - can be dangerous in what seems to be these circumstances: - If the child code under a vfork sets the signal action to SIG_DFL - (or SIG_IGN) - for any signal which was previously set to a signal handler, the - state of the parent is clobbered, so that the later arrival of - such a signal yields a sigsegv in the parent. If the signal was - not set to a signal handler, but ignored, all seems to work. - If you change the forking code below, beware of this. - */ - -static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) { #define CMD_LINE_PREFIX_STR "exec " #define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) - int ifd[2], ofd[2], len, pid, i; - char **volatile new_environ; /* volatile since a vfork() then cannot - cause 'new_environ' to be clobbered - in the parent process. */ - int saved_errno; - long res; + int len; + char **new_environ; + ErtsSysDriverData *res; char *cmd_line; -#ifndef QNX - int unbind; -#endif -#if !DISABLE_VFORK - int no_vfork; - size_t no_vfork_sz = sizeof(no_vfork); + char wd_buff[MAXPATHLEN+1]; + char *wd; + int ifd[2], ofd[2], stderrfd; + + if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; + errno = EMFILE; /* default for next three conditions */ + if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) { + close(ifd[0]); + close(ifd[1]); + return ERL_DRV_ERROR_ERRNO; + } + if (ofd[1] >= sys_max_files()) { + close_pipes(ifd, ofd); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } - no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK", - (char *) &no_vfork, - &no_vfork_sz) >= 0); -#endif + SET_NONBLOCKING(ifd[0]); + SET_NONBLOCKING(ofd[1]); - switch (opts->read_write) { - case DO_READ: - if (pipe(ifd) < 0) - return ERL_DRV_ERROR_ERRNO; - if (ifd[0] >= sys_max_files()) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ofd[1] = -1; /* keep purify happy */ - break; - case DO_WRITE: - if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO; - if (ofd[1] >= sys_max_files()) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ifd[0] = -1; /* keep purify happy */ - break; - case DO_READ|DO_WRITE: - if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; - errno = EMFILE; /* default for next two conditions */ - if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) { - close_pipes(ifd, ofd, DO_READ); - return ERL_DRV_ERROR_ERRNO; - } - if (ofd[1] >= sys_max_files()) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - break; - default: - ASSERT(0); - return ERL_DRV_ERROR_GENERAL; + stderrfd = opts->redir_stderr ? ifd[1] : dup(2); + + if (stderrfd >= sys_max_files() || stderrfd < 0) { + close_pipes(ifd, ofd); + if (stderrfd > -1) + close(stderrfd); + return ERL_DRV_ERROR_ERRNO; } if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { @@ -738,15 +594,17 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op len = strlen(name); cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); + close_pipes(ifd, ofd); errno = ENOMEM; return ERL_DRV_ERROR_ERRNO; } memcpy((void *) cmd_line,(void *) name, len); cmd_line[len] = '\0'; + len = len + 1; if (access(cmd_line,X_OK) != 0) { int save_errno = errno; erts_free(ERTS_ALC_T_TMP, cmd_line); + close_pipes(ifd, ofd); errno = save_errno; return ERL_DRV_ERROR_ERRNO; } @@ -756,7 +614,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, CMD_LINE_PREFIX_STR_SZ + len + 1); if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); + close_pipes(ifd, ofd); errno = ENOMEM; return ERL_DRV_ERROR_ERRNO; } @@ -765,6 +623,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op CMD_LINE_PREFIX_STR_SZ); memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; + len = CMD_LINE_PREFIX_STR_SZ + len + 1; } erts_smp_rwmtx_rlock(&environ_rwmtx); @@ -773,283 +632,194 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op new_environ = environ; } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { erts_smp_rwmtx_runlock(&environ_rwmtx); + close_pipes(ifd, ofd); erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); errno = ENOMEM; return ERL_DRV_ERROR_ERRNO; - } + } -#ifndef QNX - /* Block child from SIGINT and SIGUSR1. Must be before fork() - to be safe. */ - block_signals(); + if (opts->wd == NULL) { + if ((wd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) { + /* on some OSs this call opens a fd in the + background which means that this can + return EMFILE */ + int err = errno; + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + erts_smp_rwmtx_runlock(&environ_rwmtx); + errno = err; + return ERL_DRV_ERROR_ERRNO; + } + } else { + wd = opts->wd; + } - CHLD_STAT_LOCK; + { + struct iovec *io_vector; + int buffsz = 0, iov_len = 5; + char nullbuff[] = "\0"; + int j, i = 0; + Sint32 env_len = 0, argv_len = 0, + flags = (opts->use_stdio ? FORKER_FLAG_USE_STDIO : 0) + | (opts->exit_status ? FORKER_FLAG_EXIT_STATUS : 0) + | (opts->read_write & DO_READ ? FORKER_FLAG_DO_READ : 0) + | (opts->read_write & DO_WRITE ? FORKER_FLAG_DO_WRITE : 0); + + /* count number of elements in environment */ + while(new_environ[env_len] != NULL) + env_len++; + iov_len += 1 + env_len; /* num envs including size int */ + + /* count number of element in argument list */ + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + if (opts->argv != NULL) { + while(opts->argv[argv_len] != NULL) + argv_len++; + } else { + argv_len++; + } + iov_len += 1 + argv_len; /* num argvs including size int */ + } - unbind = erts_sched_bind_atfork_prepare(); + io_vector = erts_alloc_fnf(ERTS_ALC_T_TMP, sizeof(struct iovec) * iov_len); -#if !DISABLE_VFORK - /* See fork/vfork discussion before this function. */ - if (no_vfork) { -#endif + if (!io_vector) { + close_pipes(ifd, ofd); + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } - DEBUGF(("Using fork\n")); - pid = fork(); - - if (pid == 0) { - /* The child! Setup child... */ - - if (erts_sched_bind_atfork_child(unbind) != 0) - goto child_error; - - /* OBSERVE! - * Keep child setup after vfork() (implemented below and in - * erl_child_setup.c) up to date if changes are made here. - */ - - if (opts->use_stdio) { - if (opts->read_write & DO_READ) { - /* stdout for process */ - if (dup2(ifd[1], 1) < 0) - goto child_error; - if(opts->redir_stderr) - /* stderr for process */ - if (dup2(ifd[1], 2) < 0) - goto child_error; - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - if (dup2(ofd[0], 0) < 0) - goto child_error; - } - else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - if (dup2(ifd[1], 4) < 0) - goto child_error; - if (opts->read_write & DO_WRITE) - if (dup2(ofd[0], 3) < 0) - goto child_error; - } + io_vector[i].iov_base = (void*)&buffsz; + io_vector[i++].iov_len = sizeof(buffsz); -#if defined(HAVE_CLOSEFROM) - closefrom(opts->use_stdio ? 3 : 5); -#else - for (i = opts->use_stdio ? 3 : 5; i < sys_max_files(); i++) - (void) close(i); -#endif + io_vector[i].iov_base = (void*)&flags; + io_vector[i++].iov_len = sizeof(flags); + buffsz += sizeof(flags); - if (opts->wd && chdir(opts->wd) < 0) - goto child_error; + io_vector[i].iov_base = cmd_line; + io_vector[i++].iov_len = len; + buffsz += len; -#if defined(USE_SETPGRP_NOARGS) /* SysV */ - (void) setpgrp(); -#elif defined(USE_SETPGRP) /* BSD */ - (void) setpgrp(0, getpid()); -#else /* POSIX */ - (void) setsid(); -#endif - - unblock_signals(); - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - if (opts->argv == NULL) { - execle(cmd_line,cmd_line,(char *) NULL, new_environ); - } else { - if (opts->argv[0] == erts_default_arg0) { - opts->argv[0] = cmd_line; - } - execve(cmd_line, opts->argv, new_environ); - if (opts->argv[0] == cmd_line) { - opts->argv[0] = erts_default_arg0; - } - } - } else { - execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); - } - child_error: - _exit(1); - } -#if !DISABLE_VFORK - } -#define ENOUGH_BYTES (44) - else { /* Use vfork() */ - char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* - sizeof(char *)); - char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */ - char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */ - /* on a 64-bit machine. */ - - /* Setup argv[] for the child setup program (implemented in - erl_child_setup.c) */ - i = 0; - if (opts->use_stdio) { - if (opts->read_write & DO_READ){ - /* stdout for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1); - if(opts->redir_stderr) - /* stderr for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2); - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0); - } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4); - if (opts->read_write & DO_WRITE) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3); - } - for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - strcpy(&dup2_op[i][0], "-"); - erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, sys_max_files()-1); - - cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; - cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; - cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind); - cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range; - for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0]; - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - int num = 0; - int j = 0; - if (opts->argv != NULL) { - for(; opts->argv[num] != NULL; ++num) - ; - } - cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *)); - cs_argv[CS_ARGV_CMD_IX] = "-"; - cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line; - if (opts->argv != NULL) { - for (;opts->argv[j] != NULL; ++j) { - if (opts->argv[j] == erts_default_arg0) { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line; - } else { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j]; - } - } - } - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL; - } else { - cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */ - cs_argv[CS_ARGV_NO_OF_ARGS] = NULL; - } - DEBUGF(("Using vfork\n")); - pid = vfork(); - - if (pid == 0) { - /* The child! */ - - /* Observe! - * OTP-4389: The child setup program (implemented in - * erl_child_setup.c) will perform the necessary setup of the - * child before it execs to the user program. This because - * vfork() only allow an *immediate* execve() or _exit() in the - * child. - */ - execve(child_setup_prog, cs_argv, new_environ); - _exit(1); - } - erts_free(ERTS_ALC_T_TMP,cs_argv); - } -#undef ENOUGH_BYTES -#endif + io_vector[i].iov_base = wd; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; - erts_sched_bind_atfork_parent(unbind); + io_vector[i].iov_base = nullbuff; + io_vector[i++].iov_len = 1; + buffsz += io_vector[i-1].iov_len; - if (pid == -1) { - saved_errno = errno; - CHLD_STAT_UNLOCK; - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - unblock_signals(); - close_pipes(ifd, ofd, opts->read_write); - errno = saved_errno; - return ERL_DRV_ERROR_ERRNO; - } -#else /* QNX */ - if (opts->use_stdio) { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */ - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */ - } - else { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[4] = ifd[1]; - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[3] = ofd[0]; - } - /* Close fds on exec */ - for (i = 3; i < sys_max_files(); i++) - fcntl(i, F_SETFD, 1); + io_vector[i].iov_base = (void*)&env_len; + io_vector[i++].iov_len = sizeof(env_len); + buffsz += io_vector[i-1].iov_len; - qnx_spawn_options.flags = _SPAWN_SETSID; - 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(); - erts_smp_rwmtx_runlock(&environ_rwmtx); - close_pipes(ifd, ofd, opts->read_write); - return ERL_DRV_ERROR_GENERAL; + for (j = 0; new_environ[j] != NULL; j++) { + io_vector[i].iov_base = new_environ[j]; + io_vector[i++].iov_len = strlen(new_environ[j]) + 1; + buffsz += io_vector[i-1].iov_len; + } + + /* only append arguments if this was a spawn_executable */ + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + + io_vector[i].iov_base = (void*)&argv_len; + io_vector[i++].iov_len = sizeof(argv_len); + buffsz += io_vector[i-1].iov_len; + + if (opts->argv) { + /* If there are arguments we copy in the references to + them into the iov */ + for (j = 0; opts->argv[j]; j++) { + if (opts->argv[j] == erts_default_arg0) + io_vector[i].iov_base = cmd_line; + else + io_vector[i].iov_base = opts->argv[j]; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; + } + } else { + io_vector[i].iov_base = cmd_line; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; + } + } + + /* we send the request to do the fork */ + if (writev(ofd[1], io_vector, iov_len) < 0) { + int err = errno; + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, io_vector); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = err; + return ERL_DRV_ERROR_ERRNO; + } + + erts_free(ERTS_ALC_T_TMP, io_vector); } - reset_qnx_spawn(); -#endif /* QNX */ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); if (new_environ != environ) erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - if (opts->read_write & DO_READ) - (void) close(ifd[1]); - if (opts->read_write & DO_WRITE) - (void) close(ofd[0]); - - if (opts->read_write & DO_READ) { - SET_NONBLOCKING(ifd[0]); - init_fd_data(ifd[0], port_num); - } - if (opts->read_write & DO_WRITE) { - SET_NONBLOCKING(ofd[1]); - init_fd_data(ofd[1], port_num); - } + erts_smp_rwmtx_runlock(&environ_rwmtx); - res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - opts->read_write, opts->exit_status, pid, 0); - /* Don't unblock SIGCHLD until now, since the call above must - first complete putting away the info about our new subprocess. */ - unblock_signals(); + res = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, + DO_WRITE | DO_READ, opts->exit_status, + 0, 0); -#if CHLDWTHR - ASSERT(children_alive >= 0); + { + /* send ofd[0] + ifd[1] + stderrfd to forker port */ + int *fds = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(int)*3); + memset(fds, 0, sizeof(int)*3); + fds[0] = ofd[0]; + fds[1] = ifd[1]; + fds[2] = stderrfd; + if (erl_drv_port_control(forker_port, 'S', (char*)fds, sizeof(int)*3)) { + /* The forker port has been killed, we close both fd's which will + make open_port throw an epipe error */ + close(ofd[0]); + close(ifd[1]); + } + } - if (!(children_alive++)) - CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children - was alive before we fork()ed ... */ -#endif - /* Don't unlock chld_stat_mtx until now of the same reason as above */ - CHLD_STAT_UNLOCK; + /* we set these fds to negative to mark if + they should be closed after the handshake */ + if (!(opts->read_write & DO_READ)) + res->ifd->fd *= -1; - erts_smp_rwmtx_runlock(&environ_rwmtx); + if (!(opts->read_write & DO_WRITE)) + res->ofd->fd *= -1; return (ErlDrvData)res; #undef CMD_LINE_PREFIX_STR #undef CMD_LINE_PREFIX_STR_SZ } -#ifdef QNX -static reset_qnx_spawn() +static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { - int i; + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + + memcpy(&dd->status, buf, sizeof(dd->status)); + dd->alive = -1; + + if (dd->ifd) + driver_select(dd->port_num, abs(dd->ifd->fd), ERL_DRV_READ | ERL_DRV_USE, 1); + + if (dd->ofd) + driver_select(dd->port_num, abs(dd->ofd->fd), ERL_DRV_WRITE | ERL_DRV_USE, 1); - /* Reset qnx_spawn_options */ - qnx_spawn_options.flags = 0; - qnx_spawn_options.iov[0] = 0xff; - qnx_spawn_options.iov[1] = 0xff; - qnx_spawn_options.iov[2] = 0xff; - qnx_spawn_options.iov[3] = 0xff; + return 0; } -#endif #define FD_DEF_HEIGHT 24 #define FD_DEF_WIDTH 80 @@ -1099,7 +869,6 @@ static ErlDrvSSizeT fd_control(ErlDrvData drv_data, static ErlDrvData fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) { - ErlDrvData res; int non_blocking = 0; if (((opts->read_write & DO_READ) && opts->ifd >= sys_max_files()) || @@ -1189,11 +958,8 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, * use erlang:halt with flush=false. */ - if (opts->read_write & DO_READ) { - init_fd_data(opts->ifd, port_num); - } + /* Try to figure out if we can use non-blocking writes */ if (opts->read_write & DO_WRITE) { - init_fd_data(opts->ofd, port_num); /* If we don't have a read end, all bets are off - no non-blocking. */ if (opts->read_write & DO_READ) { @@ -1259,60 +1025,66 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, } } } - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1, - !non_blocking); - CHLD_STAT_UNLOCK; - return res; + return (ErlDrvData)create_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); } -static void clear_fd_data(int fd) +static void clear_fd_data(ErtsSysFdData *fdd) { - 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); + if (fdd->sz > 0) { + erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fdd->buf); + ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fdd->sz); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fdd->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; + fdd->buf = NULL; + fdd->sz = 0; + fdd->remain = 0; + fdd->cpos = NULL; + fdd->psz = 0; } -static void nbio_stop_fd(ErlDrvPort prt, int fd) +static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd) { - driver_select(prt,fd,DO_READ|DO_WRITE,0); - clear_fd_data(fd); - SET_BLOCKING(fd); + driver_select(prt, abs(fdd->fd), DO_READ|DO_WRITE, 0); + clear_fd_data(fdd); + SET_BLOCKING(abs(fdd->fd)); + } static void fd_stop(ErlDrvData ev) /* Does not close the fds */ { - int ofd; - int fd = (int)(long)ev; - ErlDrvPort prt = driver_data[fd].port_num; - + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + ErlDrvPort prt = dd->port_num; + int sz = sizeof(ErtsSysDriverData); + #if FDBLOCK - if (driver_data[fd].blocking) { - erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); - driver_data[fd].blocking = NULL; - erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); + if (dd->blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING, dd->blocking); + dd->blocking = NULL; + sz += sizeof(ErtsSysBlocking); } #endif - nbio_stop_fd(prt, fd); - ofd = driver_data[fd].ofd; - if (ofd != fd && ofd != -1) - nbio_stop_fd(prt, ofd); + if (dd->ifd) { + sz += sizeof(ErtsSysFdData); + nbio_stop_fd(prt, dd->ifd); + } + if (dd->ofd && dd->ofd != dd->ifd) { + sz += sizeof(ErtsSysFdData); + nbio_stop_fd(prt, dd->ofd); + } + + erts_free(ERTS_ALC_T_DRV_TAB, dd); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sz); } -static void fd_flush(ErlDrvData fd) +static void fd_flush(ErlDrvData ev) { - if (!driver_data[(int)(long)fd].terminating) - driver_data[(int)(long)fd].terminating = 1; + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + if (!dd->terminating) + dd->terminating = 1; } static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, @@ -1331,55 +1103,45 @@ static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, return ERL_DRV_ERROR_GENERAL; } SET_NONBLOCKING(fd); - init_fd_data(fd, port_num); - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1, 0); - CHLD_STAT_UNLOCK; + res = (ErlDrvData)(long)create_driver_data(port_num, fd, fd, + opts->packet_bytes, + opts->read_write, 0, -1, 0); return res; } /* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ /* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ -static void stop(ErlDrvData fd) +static void stop(ErlDrvData ev) { - ErlDrvPort prt; - int ofd; - - prt = driver_data[(int)(long)fd].port_num; - nbio_stop_fd(prt, (int)(long)fd); + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + ErlDrvPort prt = dd->port_num; - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && (int)(long)ofd != -1) - nbio_stop_fd(prt, ofd); - else - ofd = -1; + if (dd->alive == 1) + /* Stop has been called before the exit status has been reported */ + forker_remove_os_pid_mapping(dd); - CHLD_STAT_LOCK; - - /* Mark as unused. */ - driver_data[(int)(long)fd].pid = -1; - - CHLD_STAT_UNLOCK; + if (dd->ifd) { + nbio_stop_fd(prt, dd->ifd); + driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE, 0); /* close(ifd); */ + } - /* SMP note: Close has to be last thing done (open file descriptors work - as locks on driver_data[] entries) */ - driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */ - if (ofd >= 0) { - driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */ + if (dd->ofd && dd->ofd != dd->ifd) { + nbio_stop_fd(prt, dd->ofd); + driver_select(prt, abs(dd->ofd->fd), ERL_DRV_USE, 0); /* close(ofd); */ } + + erts_free(ERTS_ALC_T_DRV_TAB, dd); } /* used by fd_driver */ static void outputv(ErlDrvData e, ErlIOVec* ev) { - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; + int pb = dd->packet_bytes; + int ofd = dd->ofd ? dd->ofd->fd : -1; ssize_t n; ErlDrvSizeT sz; char lb[4]; @@ -1400,19 +1162,19 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) ev->iov[0].iov_len = pb; ev->size += pb; - if (driver_data[fd].blocking && FDBLOCK) - driver_pdl_lock(driver_data[fd].blocking->pdl); + if (dd->blocking && FDBLOCK) + driver_pdl_lock(dd->blocking->pdl); if ((sz = driver_sizeq(ix)) > 0) { driver_enqv(ix, ev, 0); - if (driver_data[fd].blocking && FDBLOCK) - driver_pdl_unlock(driver_data[fd].blocking->pdl); + if (dd->blocking && FDBLOCK) + driver_pdl_unlock(dd->blocking->pdl); if (sz + ev->size >= (1 << 13)) set_busy_port(ix, 1); } - else if (!driver_data[fd].blocking || !FDBLOCK) { + else if (!dd->blocking || !FDBLOCK) { /* We try to write directly if the fd in non-blocking */ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; @@ -1433,11 +1195,11 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) else { if (ev->size != 0) { driver_enqv(ix, ev, 0); - driver_pdl_unlock(driver_data[fd].blocking->pdl); - driver_async(ix, &driver_data[fd].blocking->pkey, - fd_async, driver_data+fd, NULL); + driver_pdl_unlock(dd->blocking->pdl); + driver_async(ix, &dd->blocking->pkey, + fd_async, dd, NULL); } else { - driver_pdl_unlock(driver_data[fd].blocking->pdl); + driver_pdl_unlock(dd->blocking->pdl); } } #endif @@ -1447,10 +1209,10 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) /* Used by spawn_driver and vanilla driver */ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) { - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; + int pb = dd->packet_bytes; + int ofd = dd->ofd ? dd->ofd->fd : -1; ssize_t n; ErlDrvSizeT sz; char lb[4]; @@ -1458,7 +1220,9 @@ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) struct iovec iv[2]; /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ - if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + if (((pb == 2) && (len > 0xffff)) + || (pb == 1 && len > 0xff) + || dd->pid == 0 /* Attempt at output before port is ready */) { driver_failure_posix(ix, EINVAL); return; /* -1; */ } @@ -1499,62 +1263,58 @@ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) return; /* 0; */ } -static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) +static int port_inp_failure(ErtsSysDriverData *dd, int res) /* Result: 0 (eof) or -1 (error) */ { int err = errno; ASSERT(res <= 0); - (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); - clear_fd_data(ready_fd); + if (dd->ifd) { + driver_select(dd->port_num, dd->ifd->fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(dd->ifd); + } - if (driver_data[ready_fd].blocking && FDBLOCK) { - driver_pdl_lock(driver_data[ready_fd].blocking->pdl); - if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { - driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + if (dd->blocking && FDBLOCK) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_sizeq(dd->port_num) > 0) { + driver_pdl_unlock(dd->blocking->pdl); /* We have stuff in the output queue, so we just set the state to terminating and wait for fd_async_ready to terminate the port */ if (res == 0) - driver_data[ready_fd].terminating = 2; + dd->terminating = 2; else - driver_data[ready_fd].terminating = -err; + dd->terminating = -err; return 0; } - driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + driver_pdl_unlock(dd->blocking->pdl); } if (res == 0) { - if (driver_data[ready_fd].report_exit) { - CHLD_STAT_LOCK; - - if (driver_data[ready_fd].alive) { - /* - * We have eof and want to report exit status, but the process - * hasn't exited yet. When it does report_exit_status() will - * driver_select() this fd which will make sure that we get - * back here with driver_data[ready_fd].alive == 0 and - * driver_data[ready_fd].status set. - */ - CHLD_STAT_UNLOCK; - return 0; - } - else { - int status = driver_data[ready_fd].status; - CHLD_STAT_UNLOCK; - - /* We need not be prepared for stopped/continued processes. */ - if (WIFSIGNALED(status)) - status = 128 + WTERMSIG(status); - else - status = WEXITSTATUS(status); + if (dd->alive == 1) { + /* + * We have eof and want to report exit status, but the process + * hasn't exited yet. When it does ready_input will + * driver_select() this fd which will make sure that we get + * back here with dd->alive == -1 and dd->status set. + */ + return 0; + } + else if (dd->alive == -1) { + int status = dd->status; - driver_report_exit(driver_data[ready_fd].port_num, status); - } - } - driver_failure_eof(port_num); + /* We need not be prepared for stopped/continued processes. */ + if (WIFSIGNALED(status)) + status = 128 + WTERMSIG(status); + else + status = WEXITSTATUS(status); + driver_report_exit(dd->port_num, status); + } + driver_failure_eof(dd->port_num); + } else if (dd->ifd) { + erl_drv_init_ack(dd->port_num, ERL_DRV_ERROR_ERRNO); } else { - driver_failure_posix(port_num, err); + driver_failure_posix(dd->port_num, err); } return 0; } @@ -1565,15 +1325,70 @@ static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) { - int fd = (int)(long)e; + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; ErlDrvPort port_num; int packet_bytes; int res; Uint h; - port_num = driver_data[fd].port_num; - packet_bytes = driver_data[fd].packet_bytes; + port_num = dd->port_num; + packet_bytes = dd->packet_bytes; + + ASSERT(abs(dd->ifd->fd) == ready_fd); + + if (dd->pid == 0) { + /* the pid is sent from erl_child_setup. spawn driver only. */ + char message_buffer[3 + 10 + 1 + 10 + 1]; + int reason, res; + + if((res = read(ready_fd, message_buffer, sizeof(message_buffer))) <= 0) { + /* hmm, child setup seems to have closed the pipe too early... + we close the port as there is not much else we can do */ + if (res < 0 && errno == ERRNO_BLOCK) + return; + driver_select(port_num, ready_fd, ERL_DRV_READ, 0); + if (res == 0) + errno = EPIPE; + port_inp_failure(dd, -1); + return; + } + + if(sscanf(message_buffer,"GO:%010d:%010d", &dd->pid, &reason) == 2) { + if (dd->pid == -1) { + /* Setup failed! The only reason why this should happen is if + the fork fails. */ + errno = reason; + port_inp_failure(dd, -1); + return; + } + + if (write(abs(dd->ofd->fd), "A", 1) < 0) + ; /* do nothing on failure here. If the ofd is broken, then + the ifd will probably also be broken and trigger + a port_inp_failure */ + + if (dd->ifd->fd < 0) { + driver_select(port_num, abs(dd->ifd->fd), ERL_DRV_READ|ERL_DRV_USE, 0); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData)); + dd->ifd = NULL; + } + + if (dd->ofd->fd < 0 || driver_sizeq(port_num) > 0) + /* we select in order to close fd or write to queue, + child setup will close this fd if fd < 0 */ + driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1); + + if (dd->alive == 1) { + forker_add_os_pid_mapping(dd); + } + erl_drv_set_os_pid(port_num, dd->pid); + erl_drv_init_ack(port_num, e); + return; + } + ASSERT(0); + return; + } if (packet_bytes == 0) { byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, @@ -1581,76 +1396,76 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); if (res < 0) { if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); + port_inp_failure(dd, res); } else if (res == 0) - port_inp_failure(port_num, ready_fd, res); - else + port_inp_failure(dd, res); + else driver_output(port_num, (char*) read_buf, res); erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); } - else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ + else if (dd->ifd->remain > 0) { /* We try to read the remainder */ /* space is allocated in buf */ - res = read(ready_fd, fd_data[ready_fd].cpos, - fd_data[ready_fd].remain); + res = read(ready_fd, dd->ifd->cpos, + dd->ifd->remain); if (res < 0) { if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); + port_inp_failure(dd, res); } else if (res == 0) { - port_inp_failure(port_num, ready_fd, res); + port_inp_failure(dd, res); } - else if (res == fd_data[ready_fd].remain) { /* we're done */ - driver_output(port_num, fd_data[ready_fd].buf, - fd_data[ready_fd].sz); - clear_fd_data(ready_fd); + else if (res == dd->ifd->remain) { /* we're done */ + driver_output(port_num, dd->ifd->buf, + dd->ifd->sz); + clear_fd_data(dd->ifd); } - else { /* if (res < fd_data[ready_fd].remain) */ - fd_data[ready_fd].cpos += res; - fd_data[ready_fd].remain -= res; + else { /* if (res < dd->ifd->remain) */ + dd->ifd->cpos += res; + dd->ifd->remain -= res; } } - else if (fd_data[ready_fd].remain == 0) { /* clean fd */ + else if (dd->ifd->remain == 0) { /* clean fd */ byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, ERTS_SYS_READ_BUF_SZ); /* We make one read attempt and see what happens */ res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); - if (res < 0) { + if (res < 0) { if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); + port_inp_failure(dd, res); } else if (res == 0) { /* eof */ - port_inp_failure(port_num, ready_fd, res); - } - else if (res < packet_bytes - fd_data[ready_fd].psz) { - memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz, + port_inp_failure(dd, res); + } + else if (res < packet_bytes - dd->ifd->psz) { + memcpy(dd->ifd->pbuf+dd->ifd->psz, read_buf, res); - fd_data[ready_fd].psz += res; + dd->ifd->psz += res; } else { /* if (res >= packet_bytes) */ unsigned char* cpos = read_buf; int bytes_left = res; while (1) { - int psz = fd_data[ready_fd].psz; - char* pbp = fd_data[ready_fd].pbuf + psz; + int psz = dd->ifd->psz; + char* pbp = dd->ifd->pbuf + psz; while(bytes_left && (psz < packet_bytes)) { *pbp++ = *cpos++; bytes_left--; psz++; } - + if (psz < packet_bytes) { - fd_data[ready_fd].psz = psz; + dd->ifd->psz = psz; break; } - fd_data[ready_fd].psz = 0; + dd->ifd->psz = 0; switch (packet_bytes) { - case 1: h = get_int8(fd_data[ready_fd].pbuf); break; - case 2: h = get_int16(fd_data[ready_fd].pbuf); break; - case 4: h = get_int32(fd_data[ready_fd].pbuf); break; + case 1: h = get_int8(dd->ifd->pbuf); break; + case 2: h = get_int16(dd->ifd->pbuf); break; + case 4: h = get_int32(dd->ifd->pbuf); break; default: ASSERT(0); return; /* -1; */ } @@ -1664,15 +1479,15 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); if (!buf) { errno = ENOMEM; - port_inp_failure(port_num, ready_fd, -1); + port_inp_failure(dd, -1); } else { erts_smp_atomic_add_nob(&sys_misc_mem_sz, h); sys_memcpy(buf, cpos, bytes_left); - fd_data[ready_fd].buf = buf; - fd_data[ready_fd].sz = h; - fd_data[ready_fd].remain = h - bytes_left; - fd_data[ready_fd].cpos = buf + bytes_left; + dd->ifd->buf = buf; + dd->ifd->sz = h; + dd->ifd->remain = h - bytes_left; + dd->ifd->cpos = buf + bytes_left; } break; } @@ -1689,17 +1504,24 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) { - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; int n; struct iovec* iv; int vsize; - if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); - if (driver_data[fd].terminating) - driver_failure_atom(driver_data[fd].port_num,"normal"); + if (dd->pid > 0 && dd->ofd->fd < 0) { + /* The port was opened with 'in' option, which means we + should close the output fd as soon as the command has + been sent. */ + driver_select(ix, ready_fd, ERL_DRV_WRITE|ERL_DRV_USE, 0); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData)); + dd->ofd = NULL; + } + if (dd->terminating) + driver_failure_atom(dd->port_num,"normal"); return; /* 0; */ } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -1731,7 +1553,7 @@ static void fd_async(void *async_data) { int res; - ErtsSysDriverData *dd = (ErtsSysDriverData*)async_data; + ErtsSysDriverData *dd = (ErtsSysDriverData *)async_data; SysIOVec *iov0; SysIOVec *iov; int iovlen; @@ -1751,7 +1573,7 @@ fd_async(void *async_data) driver_pdl_unlock(dd->blocking->pdl); do { - res = writev(dd->ofd, iov, iovlen); + res = writev(dd->ofd->fd, iov, iovlen); } while (res < 0 && errno == EINTR); if (res < 0) err = errno; @@ -1769,7 +1591,6 @@ void fd_ready_async(ErlDrvData drv_data, ErlDrvPort port_num = dd->port_num; ASSERT(dd->blocking); - ASSERT(dd == (driver_data + (int)(long)drv_data)); if (dd->blocking->res > 0) { driver_pdl_lock(dd->blocking->pdl); @@ -1807,177 +1628,259 @@ void fd_ready_async(ErlDrvData drv_data, #endif -static ERTS_INLINE void -report_exit_status(ErtsSysReportExit *rep, int status) +/* Forker driver */ + +static int forker_fd; +static Hash *forker_hash; +static erts_smp_mtx_t forker_hash_mtx; + +static void ffree(void *e); + +static ErlDrvData forker_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) { - Port *pp; -#ifdef ERTS_SMP - CHLD_STAT_UNLOCK; - pp = erts_thr_id2port_sflgs(rep->port, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); - CHLD_STAT_LOCK; -#else - pp = erts_id2port_sflgs(rep->port, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); -#endif - if (pp) { - if (rep->ifd >= 0) { - driver_data[rep->ifd].alive = 0; - driver_data[rep->ifd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ifd, - (ERL_DRV_READ|ERL_DRV_USE), - 1); - } - if (rep->ofd >= 0) { - driver_data[rep->ofd].alive = 0; - driver_data[rep->ofd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ofd, - (ERL_DRV_WRITE|ERL_DRV_USE), - 1); - } -#ifdef ERTS_SMP - erts_thr_port_release(pp); -#else - erts_port_release(pp); -#endif + + int i; + int fds[2]; + int res, unbind; + char bindir[MAXPATHLEN]; + size_t bindirsz = sizeof(bindir); + Uint csp_path_sz; + char *child_setup_prog; + + forker_port = erts_drvport2id(port_num); + + res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); + if (res != 0) { + if (res < 0) + erl_exit(-1, + "Environment variable BINDIR is not set\n"); + if (res > 0) + erl_exit(-1, + "Value of environment variable BINDIR is too large\n"); + } + if (bindir[0] != DIR_SEPARATOR_CHAR) + erl_exit(-1, + "Environment variable BINDIR does not contain an" + " absolute path\n"); + csp_path_sz = (strlen(bindir) + + 1 /* DIR_SEPARATOR_CHAR */ + + sizeof(CHILD_SETUP_PROG_NAME) + + 1); + child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); + erts_snprintf(child_setup_prog, csp_path_sz, + "%s%c%s", + bindir, + DIR_SEPARATOR_CHAR, + CHILD_SETUP_PROG_NAME); + if (socketpair(AF_UNIX, SOCK_STREAM, 0, fds) < 0) { + erl_exit(ERTS_ABORT_EXIT, + "Could not open unix domain socket in spawn_init: %d\n", + errno); } - erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); -} -#if !CHLDWTHR /* ---------------------------------------------------------- */ + forker_fd = fds[0]; -#define ERTS_REPORT_EXIT_STATUS report_exit_status + unbind = erts_sched_bind_atfork_prepare(); -int check_children(void) -{ - int res = 0; - int pid; - int status; + i = fork(); -#ifndef ERTS_SMP - if (children_died) -#endif - { - sys_sigblock(SIGCHLD); - CHLD_STAT_LOCK; - while ((pid = waitpid(-1, &status, WNOHANG)) > 0) - note_child_death(pid, status); -#ifndef ERTS_SMP - children_died = 0; + if (i == 0) { + /* The child */ + char *cs_argv[FORKER_ARGV_NO_OF_ARGS] = + {CHILD_SETUP_PROG_NAME, NULL, NULL}; + char buff[128]; + + erts_sched_bind_atfork_child(unbind); + + snprintf(buff, 128, "%d", sys_max_files()); + cs_argv[FORKER_ARGV_MAX_FILES] = buff; + + /* We preallocate fd 3 for the uds fd */ + if (fds[1] != 3) { + dup2(fds[1], 3); + } + +#if defined(USE_SETPGRP_NOARGS) /* SysV */ + (void) setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + (void) setpgrp(0, getpid()); +#else /* POSIX */ + (void) setsid(); #endif - CHLD_STAT_UNLOCK; - sys_sigrelease(SIGCHLD); - res = 1; + + execv(child_setup_prog, cs_argv); + _exit(1); } - return res; -} -#ifdef ERTS_SMP + erts_sched_bind_atfork_parent(unbind); -void -erts_check_children(void) -{ - (void) check_children(); -} + erts_free(ERTS_ALC_T_CS_PROG_PATH, child_setup_prog); -#endif + close(fds[1]); -#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */ + SET_NONBLOCKING(forker_fd); -#define ERTS_REPORT_EXIT_STATUS report_exit_status + driver_select(port_num, forker_fd, ERL_DRV_READ|ERL_DRV_USE, 1); -int check_children(void) + return (ErlDrvData)port_num; +} + +static void forker_stop(ErlDrvData e) { - return 0; + /* we probably should do something here */ } -#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */ +static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) +{ + int res, *exit_status; + char buff[8+10+1+10+1] = {0}; + ErtsSysExitStatus est, *es; + + if ((res = read(fd, buff, sizeof(buff))) < 0) { + if (errno == ERRNO_BLOCK) + return; + erl_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno); + } + + if (res == 0) + erl_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n"); + + if (sscanf(buff, "SIGCHLD:%010d:%010d", &est.os_pid, &res) != 2) + erl_exit(ERTS_DUMP_EXIT, "Got corrupt data from erl_child_setup: %.s\n", + buff, sizeof(buff)); + + erts_smp_mtx_lock(&forker_hash_mtx); + es = hash_remove(forker_hash, &est); + erts_smp_mtx_unlock(&forker_hash_mtx); + + if (!es) + return; -#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status + exit_status = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(int)); + exit_status[0] = res; + /* ideally this would be a port_command call, but as command is + already used by the spawn_driver, we use control instead. + Note that when using erl_drv_port_control it is an asynchronous + control. */ + erl_drv_port_control(es->port_id, 'S', (char*)exit_status, sizeof(int)); -static ERTS_INLINE void -initiate_report_exit_status(ErtsSysReportExit *rep, int status) + ffree(es); + +} + +static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) { - rep->next = report_exit_transit_list; - rep->status = status; - report_exit_transit_list = rep; - erts_sys_schedule_interrupt(1); + ErlDrvPort port_num = (ErlDrvPort)e; + + while(driver_sizeq(port_num) > 0) { + int vlen; + SysIOVec *iov = driver_peekq(port_num, &vlen); + int *fds = (int*)iov[0].iov_base; + ASSERT(iov[0].iov_len >= sizeof(int)*3); + if (sys_uds_write(forker_fd, "S", 1, fds, 3, 0) < 0) { + if (errno == ERRNO_BLOCK) + return; + erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } + close(fds[0]); + close(fds[1]); + if (fds[1] != fds[2]) + close(fds[2]); + driver_deq(port_num, sizeof(int)*3); + } + + driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); } -int check_children(void) +static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { + int *fds = (int*)buf; + ErlDrvPort port_num = (ErlDrvPort)e; int res; - ErtsSysReportExit *rep; - CHLD_STAT_LOCK; - rep = report_exit_transit_list; - res = rep != NULL; - while (rep) { - ErtsSysReportExit *curr_rep = rep; - rep = rep->next; - report_exit_status(curr_rep, curr_rep->status); + + if (driver_sizeq(port_num) > 0) { + driver_enq(port_num, buf, len); + return 0; } - report_exit_transit_list = NULL; - CHLD_STAT_UNLOCK; - return res; + + if ((res = sys_uds_write(forker_fd, "S", 1, fds, 3, 0)) < 0) { + if (errno == ERRNO_BLOCK) { + driver_enq(port_num, buf, len); + driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + return 0; + } + erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } + close(fds[0]); + close(fds[1]); + if (fds[1] != fds[2]) + close(fds[2]); + return 0; } -#endif /* ------------------------------------------------------------------ */ +static void forker_add_os_pid_mapping(ErtsSysDriverData *dd) +{ + Eterm port_id = erts_drvport2id(dd->port_num); + ErtsSysExitStatus es; + es.os_pid = dd->pid; + es.port_id = port_id; + erts_smp_mtx_lock(&forker_hash_mtx); + hash_put(forker_hash, &es); + erts_smp_mtx_unlock(&forker_hash_mtx); +} -static void note_child_death(int pid, int status) +static void forker_remove_os_pid_mapping(ErtsSysDriverData *dd) { - ErtsSysReportExit **repp = &report_exit_list; - ErtsSysReportExit *rep = report_exit_list; - - while (rep) { - if (pid == rep->pid) { - *repp = rep->next; - ERTS_REPORT_EXIT_STATUS(rep, status); - break; - } - repp = &rep->next; - rep = rep->next; - } + ErtsSysExitStatus est, *es; + est.os_pid = dd->pid; + erts_smp_mtx_lock(&forker_hash_mtx); + es = hash_remove(forker_hash, &est); + erts_smp_mtx_unlock(&forker_hash_mtx); + if (es) + ffree(es); } -#if CHLDWTHR +static int fcmp(void *a, void *b) +{ + ErtsSysExitStatus *sa = a; + ErtsSysExitStatus *sb = b; + return !(sa->os_pid == sb->os_pid); +} -static void * -child_waiter(void *unused) +static HashValue fhash(void *e) { - int pid; - int status; + ErtsSysExitStatus *se = e; + return make_hash2(make_small(se->os_pid)); +} -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_set_thread_name("child waiter"); -#endif +static void *falloc(void *e) +{ + ErtsSysExitStatus *se = e; + ErtsSysExitStatus *ne = erts_alloc(ERTS_ALC_T_DRV, sizeof(ErtsSysExitStatus)); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); + ne->os_pid = se->os_pid; + ne->port_id = se->port_id; + return ne; +} - while(1) { -#ifdef DEBUG - int waitpid_errno; -#endif - pid = waitpid(-1, &status, 0); -#ifdef DEBUG - waitpid_errno = errno; -#endif - CHLD_STAT_LOCK; - if (pid < 0) { - ASSERT(waitpid_errno == ECHILD); - } - else { - children_alive--; - ASSERT(children_alive >= 0); - note_child_death(pid, status); - } - while (!children_alive) - CHLD_STAT_WAIT; /* Wait for children to wait on... :) */ - CHLD_STAT_UNLOCK; - } - - return NULL; +static void ffree(void *e) +{ + erts_free(ERTS_ALC_T_DRV, e); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysBlocking)); } -#endif +static int forker_init(void) +{ + HashFunctions forker_hash_functions; + forker_hash_functions.hash = fhash; + forker_hash_functions.cmp = fcmp; + forker_hash_functions.alloc = falloc; + forker_hash_functions.free = ffree; + forker_hash = hash_new(ERTS_ALC_T_DRV, "forker_hash", + 16, forker_hash_functions); + erts_smp_mtx_init(&forker_hash_mtx, "forker_hash_mtx"); + + return 1; +} diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c new file mode 100644 index 0000000000..3b63d05cf6 --- /dev/null +++ b/erts/emulator/sys/unix/sys_uds.c @@ -0,0 +1,125 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + + +#include "sys_uds.h" + +int +sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags) { + struct msghdr msg; + struct cmsghdr *cmsg = NULL; + char ancillary_buff[256] = {0}; + int res, i = 0; + + /* setup a place to fill in message contents */ + memset(&msg, 0, sizeof(struct msghdr)); + msg.msg_iov = iov; + msg.msg_iovlen = iov_len; + + /* provide space for the ancillary data */ + msg.msg_control = ancillary_buff; + msg.msg_controllen = sizeof(ancillary_buff); + + if((res = recvmsg(fd, &msg, flags)) < 0) { + return res; + } + + if((msg.msg_flags & MSG_CTRUNC) == MSG_CTRUNC) + { + /* We assume that we have given enough space for any header + that are sent to us. So the only remaining reason to get + this flag set is if the caller has run out of file descriptors. + */ + errno = EMFILE; + return -1; + } + + for (cmsg = CMSG_FIRSTHDR(&msg); cmsg; cmsg = CMSG_NXTHDR(&msg, cmsg) ) { + if ((cmsg->cmsg_level == SOL_SOCKET) && + (cmsg->cmsg_type == SCM_RIGHTS)) { + int *cmsg_data = (int *)CMSG_DATA(cmsg); + while ((char*)cmsg_data < (char*)cmsg + cmsg->cmsg_len) { + if (i < fd_count) { + fds[i++] = *cmsg_data++; + } else { + /* for some strange reason, we have received more FD's + than we wanted... close them if we are not running + debug. */ + if(i >= fd_count) abort(); + close(*cmsg_data++); + } + } + } + } + + return res; +} + +int +sys_uds_read(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags) { + struct iovec iov; + iov.iov_base = buff; + iov.iov_len = len; + return sys_uds_readv(fd, &iov, 1, fds, fd_count, flags); +} + + +int +sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags) { + + struct msghdr msg; + struct cmsghdr *cmsg = NULL; + int res; + + /* initialize socket message */ + memset(&msg, 0, sizeof(struct msghdr)); + msg.msg_iov = iov; + msg.msg_iovlen = iov_len; + + /* initialize the ancillary data */ + msg.msg_control = calloc(1, CMSG_SPACE(sizeof(int) * fd_count)); + msg.msg_controllen = CMSG_SPACE(sizeof(int) * fd_count); + + /* copy the fd array into the ancillary data */ + cmsg = CMSG_FIRSTHDR(&msg); + if(!cmsg) abort(); + cmsg->cmsg_level = SOL_SOCKET; + cmsg->cmsg_type = SCM_RIGHTS; + cmsg->cmsg_len = CMSG_LEN(sizeof(int) * fd_count); + memcpy(CMSG_DATA(cmsg), fds, sizeof(int) * fd_count); + + res = sendmsg(fd, &msg, flags); + + free(msg.msg_control); + + return res; +} + +int +sys_uds_write(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags) { + struct iovec iov; + iov.iov_base = buff; + iov.iov_len = len; + return sys_uds_writev(fd, &iov, 1, fds, fd_count, flags); +} diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h new file mode 100644 index 0000000000..7ff58b17dd --- /dev/null +++ b/erts/emulator/sys/unix/sys_uds.h @@ -0,0 +1,47 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef _ERL_UNIX_UDS_H +#define _ERL_UNIX_UDS_H + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#if defined(__sun__) && !defined(_XOPEN_SOURCE) +#define _XOPEN_SOURCE 500 +#endif + +#include +#include +#include + +#include "sys.h" + +int sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags); +int sys_uds_read(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags); +int sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags); +int sys_uds_write(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags); + +#endif /* #ifndef _ERL_UNIX_UDS_H */ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index fce76db28f..3793357848 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1334,10 +1334,8 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts) retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, opts->exit_status); if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) { - Port *prt = erts_drvport2port(port_num); - /* We assume that this cannot generate a negative number */ - ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT); - prt->os_pid = (SWord) pid; + /* We assume that this cannot generate a negative number */ + erl_drv_set_os_pid(port_num, pid); } } @@ -3272,6 +3270,12 @@ void erl_sys_init(void) SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); } +void +erl_sys_late_init(void) +{ + /* do nothing */ +} + void erts_sys_schedule_interrupt(int set) { diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 3d0509a28c..f2a7ddef2c 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -385,27 +385,33 @@ input_only(Config) when is_list(Config) -> output_only(Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(100)), Dir = ?config(priv_dir, Config), + + %% First we test that the port program gets the data Filename = filename:join(Dir, "output_only_stream"), - output_and_verify(Config, Filename, "-h0", - random_packet(35777, "echo")), + Data = random_packet(35777, "echo"), + output_and_verify(Config, ["-h0 -o", Filename], Data), + Wait_time = 500, + test_server:sleep(Wait_time), + {ok, Written} = file:read_file(Filename), + Data = binary_to_list(Written), + + %% Then we test that any writes to stdout from + %% the port program is not sent to erlang + output_and_verify(Config, ["-h0"], Data), + test_server:timetrap_cancel(Dog), ok. -output_and_verify(Config, Filename, Options, Data) -> +output_and_verify(Config, Options, Data) -> PortTest = port_test(Config), - Command = lists:concat([PortTest, " ", - Options, " -o", Filename]), + Command = lists:concat([PortTest, " " | Options]), Port = open_port({spawn, Command}, [out]), Port ! {self(), {command, Data}}, Port ! {self(), close}, receive - {Port, closed} -> ok - end, - Wait_time = 500, - test_server:sleep(Wait_time), - {ok, Written} = file:read_file(Filename), - Data = binary_to_list(Written), - ok. + {Port, closed} -> ok; + Msg -> ct:fail({received_unexpected_message, Msg}) + end. %% Test that receiving several packages written in the same %% write operation works. -- cgit v1.2.3 From a8276a38ded70b2854ae0fc2941ba21cc06a9130 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 15 Jul 2015 11:02:36 +0200 Subject: erts: Add fd count test for spawn_driver --- erts/emulator/test/port_SUITE.erl | 35 +++++++++++++++++++++++++- erts/emulator/test/port_SUITE_data/port_test.c | 35 ++++++++++++++++++++------ 2 files changed, 61 insertions(+), 9 deletions(-) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index f2a7ddef2c..b67fd1c409 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -82,6 +82,7 @@ mul_basic/1, mul_slow_writes/1, dying_port/1, port_program_with_path/1, open_input_file_port/1, open_output_file_port/1, + count_fds/1, iter_max_ports/1, eof/1, input_only/1, output_only/1, name1/1, t_binary/1, parallell/1, t_exit/1, @@ -112,7 +113,7 @@ all() -> {group, multiple_packets}, parallell, dying_port, port_program_with_path, open_input_file_port, open_output_file_port, name1, env, bad_env, cd, - exit_status, iter_max_ports, t_exit, {group, tps}, line, + exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line, stderr_to_stdout, otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, exit_status_multi_scheduling_block, ports, spawn_driver, @@ -616,6 +617,38 @@ open_output_file_port(Config) when is_list(Config) -> test_server:timetrap_cancel(Dog), ok. +%% Tests that all appropriate fd's have been closed in the port program +count_fds(suite) -> []; +count_fds(Config) when is_list(Config) -> + case os:type() of + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + Filename = filename:join(PrivDir, "my_fd_counter"), + + RunTest = fun(PortOpts) -> + PortTest = port_test(Config), + Command = lists:concat([PortTest, " -n -f -o", Filename]), + Port = open_port({spawn, Command}, PortOpts), + Port ! {self(), close}, + receive + {Port, closed} -> ok + end, + test_server:sleep(500), + {ok, Written} = file:read_file(Filename), + Written + end, + <<4:32/native>> = RunTest([out, nouse_stdio]), + <<4:32/native>> = RunTest([in, nouse_stdio]), + <<5:32/native>> = RunTest([in, out, nouse_stdio]), + <<3:32/native>> = RunTest([out, use_stdio]), + <<3:32/native>> = RunTest([in, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio, stderr_to_stdout]), + <<3:32/native>> = RunTest([out, use_stdio, stderr_to_stdout]); + _ -> + {skip, "Skipped on windows"} + end. + %% %% Open as many ports as possible. Do this several times and check %% that we get the same number of ports every time. diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index 7abefab2e3..cc3ebdf0f8 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -13,6 +13,7 @@ #ifndef __WIN32__ #include +#include #include @@ -48,6 +49,7 @@ typedef struct { * after reading the header for a packet * before reading the rest. */ + int fd_count; /* Count the number of open fds */ int break_mode; /* If set, this program will close standard * input, which should case broken pipe * error in the writer. @@ -107,7 +109,7 @@ MAIN(argc, argv) int argc; char *argv[]; { - int ret; + int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { fprintf(stderr, "Couldn't malloc for port_data"); exit(1); @@ -115,6 +117,7 @@ char *argv[]; port_data->header_size = 0; port_data->io_buf_size = 0; port_data->delay_mode = 0; + port_data->fd_count = 0; port_data->break_mode = 0; port_data->quit_mode = 0; port_data->slow_writes = 0; @@ -144,6 +147,9 @@ char *argv[]; case 'e': port_data->fd_to_erl = 2; break; + case 'f': + port_data->fd_count = 1; + break; case 'h': /* Header size for packets. */ switch (argv[1][2]) { case '0': port_data->header_size = 0; break; @@ -189,18 +195,31 @@ char *argv[]; /* XXX Add error printout here */ } + if (port_data->fd_count) { +#ifdef __WIN32__ + DWORD handles; + GetProcessHandleCount(GetCurrentProcess(), &handles); + fd_count = handles; +#else + int i; + for (i = 0, fd_count = 0; i < 1024; i++) + if (fcntl(i, F_GETFD) >= 0) { + fd_count++; + } +#endif + } + + if (port_data->output_file) + replace_stdout(port_data->output_file); + + if (port_data->fd_count) + reply(&fd_count, sizeof(fd_count)); + if (port_data->no_packet_loop){ free(port_data); exit(0); } - /* - * If an output file was given, let it replace standard output. - */ - - if (port_data->output_file) - replace_stdout(port_data->output_file); - ret = packet_loop(); if(port_data->io_buf_size > 0) free(port_data->io_buf); -- cgit v1.2.3 From d5f541904839b0307b1db3a28aace3ea6ba2fd37 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 11 Aug 2015 13:20:49 +0200 Subject: erts: Flatten too long io vectors in uds write --- erts/emulator/sys/unix/sys_uds.c | 30 ++++++++++++++++++++++++++---- erts/emulator/sys/unix/sys_uds.h | 10 ++++++++++ 2 files changed, 36 insertions(+), 4 deletions(-) diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c index 3b63d05cf6..daebcb307b 100644 --- a/erts/emulator/sys/unix/sys_uds.c +++ b/erts/emulator/sys/unix/sys_uds.c @@ -18,7 +18,6 @@ * %CopyrightEnd% */ - #include "sys_uds.h" int @@ -89,12 +88,32 @@ sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, struct msghdr msg; struct cmsghdr *cmsg = NULL; - int res; + int res, i; /* initialize socket message */ memset(&msg, 0, sizeof(struct msghdr)); - msg.msg_iov = iov; - msg.msg_iovlen = iov_len; + + /* We flatten the iov if it is too long */ + if (iov_len > MAXIOV) { + int size = 0; + char *buff; + for (i = 0; i < iov_len; i++) + size += iov[i].iov_len; + buff = malloc(size); + + for (i = 0; i < iov_len; i++) { + memcpy(buff, iov[i].iov_base, iov[i].iov_len); + buff += iov[i].iov_len; + } + + iov[0].iov_base = buff - size; + iov[0].iov_len = size; + msg.msg_iov = iov; + msg.msg_iovlen = 1; + } else { + msg.msg_iov = iov; + msg.msg_iovlen = iov_len; + } /* initialize the ancillary data */ msg.msg_control = calloc(1, CMSG_SPACE(sizeof(int) * fd_count)); @@ -110,6 +129,9 @@ sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, res = sendmsg(fd, &msg, flags); + if (iov_len > MAXIOV) + free(iov[0].iov_base); + free(msg.msg_control); return res; diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h index 7ff58b17dd..844a2804d8 100644 --- a/erts/emulator/sys/unix/sys_uds.h +++ b/erts/emulator/sys/unix/sys_uds.h @@ -29,10 +29,20 @@ #define _XOPEN_SOURCE 500 #endif +#include + #include #include #include +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + #include "sys.h" int sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, -- cgit v1.2.3 From 898ca7f86dff3fe21c9bf2e5018c7fb93dca158e Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 14 Aug 2015 11:51:21 +0200 Subject: erts: Fix dereferencing of unaligned integer for sparc --- erts/emulator/sys/unix/erl_child_setup.c | 12 ++++++------ erts/emulator/sys/unix/sys_drivers.c | 3 +++ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 71c7948bf0..8bec36be60 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -133,8 +133,8 @@ start_new_child(int pipes[]) o_buff = buff; - flags = *(int*)buff; - buff += sizeof(int); + flags = get_int32(buff); + buff += sizeof(Sint32); DEBUG_PRINT("flags = %d", flags); @@ -150,8 +150,8 @@ start_new_child(int pipes[]) DEBUG_PRINT("wd = %s", wd); - cnt = *(int*)buff; - buff += sizeof(int); + cnt = get_int32(buff); + buff += sizeof(Sint32); new_environ = malloc(sizeof(char*)*(cnt + 1)); for (i = 0; i < cnt; i++, buff++) { @@ -162,8 +162,8 @@ start_new_child(int pipes[]) if (o_buff + size != buff) { /* This is a spawn executable call */ - cnt = *(int*)buff; - buff += sizeof(int); + cnt = get_int32(buff); + buff += sizeof(Sint32); args = malloc(sizeof(char*)*(cnt + 1)); for (i = 0; i < cnt; i++, buff++) { args[i] = buff; diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 8402197924..97a9c3dfaa 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -699,6 +699,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, io_vector[i++].iov_len = sizeof(buffsz); io_vector[i].iov_base = (void*)&flags; + flags = htonl(flags); io_vector[i++].iov_len = sizeof(flags); buffsz += sizeof(flags); @@ -715,6 +716,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, buffsz += io_vector[i-1].iov_len; io_vector[i].iov_base = (void*)&env_len; + env_len = htonl(env_len); io_vector[i++].iov_len = sizeof(env_len); buffsz += io_vector[i-1].iov_len; @@ -728,6 +730,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { io_vector[i].iov_base = (void*)&argv_len; + argv_len = htonl(argv_len); io_vector[i++].iov_len = sizeof(argv_len); buffsz += io_vector[i-1].iov_len; -- cgit v1.2.3 From 9612b1fff77dc50e797f23b587321c90ceffe953 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 14 Aug 2015 19:45:44 +0200 Subject: erts: Fix uds socket handling for os x OS X is very strict in what it requires of you and also gives strange error codes for some errors. In this commit we remap EMSGSIZE to EMFILE and also precisely tune the amount of data we send on the socket so that we can recv only that data. If we try to recv more, recvmsg fails with EPIPE if the remote end has been closed. --- erts/emulator/sys/unix/sys_uds.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c index daebcb307b..015d0346a1 100644 --- a/erts/emulator/sys/unix/sys_uds.c +++ b/erts/emulator/sys/unix/sys_uds.c @@ -38,6 +38,14 @@ sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, msg.msg_controllen = sizeof(ancillary_buff); if((res = recvmsg(fd, &msg, flags)) < 0) { +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) + /* When some OS X versions run out of fd's + they give EMSGSIZE instead of EMFILE. + We remap this as we want the correct + error to appear for the user */ + if (errno == EMSGSIZE) + errno = EMFILE; +#endif return res; } -- cgit v1.2.3 From 05823de18bd48b70b398a6b6fd756a0f71587283 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 27 Aug 2015 10:53:07 +0200 Subject: erts: Fix forker driver ifdefs for win32 --- erts/emulator/beam/io.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 6ec7a9ba1e..fc247a3260 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -54,7 +54,9 @@ extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; extern ErlDrvEntry spawn_driver_entry; +#ifndef __WIN32__ extern ErlDrvEntry forker_driver_entry; +#endif extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */ erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */ @@ -72,7 +74,9 @@ const Port erts_invalid_port = {{ERTS_INVALID_PORT}}; erts_driver_t vanilla_driver; erts_driver_t spawn_driver; +#ifndef __WIN32__ erts_driver_t forker_driver; +#endif erts_driver_t fd_driver; int erts_port_synchronous_ops = 0; @@ -2891,7 +2895,9 @@ void erts_init_io(int port_tab_size, init_driver(&fd_driver, &fd_driver_entry, NULL); init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); init_driver(&spawn_driver, &spawn_driver_entry, NULL); +#ifndef __WIN32__ init_driver(&forker_driver, &forker_driver_entry, NULL); +#endif erts_init_static_drivers(); for (dp = driver_tab; *dp != NULL; dp++) erts_add_driver_entry(*dp, NULL, 1); @@ -2953,7 +2959,9 @@ void erts_lcnt_enable_io_lock_count(int enable) { lcnt_enable_drv_lock_count(&vanilla_driver, enable); lcnt_enable_drv_lock_count(&spawn_driver, enable); +#ifndef __WIN32__ lcnt_enable_drv_lock_count(&forker_driver, enable); +#endif lcnt_enable_drv_lock_count(&fd_driver, enable); /* enable lock counting in all drivers */ for (dp = driver_list; dp; dp = dp->next) { @@ -4843,8 +4851,10 @@ print_port_info(Port *p, int to, void *arg) erts_print(to, arg, "Port is a file: %s\n",p->name); } else if (p->drv_ptr == &spawn_driver) { erts_print(to, arg, "Port controls external process: %s\n",p->name); +#ifndef __WIN32__ } else if (p->drv_ptr == &forker_driver) { erts_print(to, arg, "Port controls forker process: %s\n",p->name); +#endif } else { erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name); } -- cgit v1.2.3 From 3599b995428032eb26e8b7cc6ac52bc5260ee454 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 27 Aug 2015 10:56:15 +0200 Subject: erts: Make child_setup work with large environments --- erts/emulator/sys/unix/erl_child_setup.c | 26 +++++++++---- erts/emulator/sys/unix/sys_drivers.c | 66 ++++++++++++++++++++------------ 2 files changed, 61 insertions(+), 31 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 8bec36be60..6e0a7c143f 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -109,7 +109,7 @@ static int sigchld_pipe[2]; static int start_new_child(int pipes[]) { - int size, res, i; + int size, res, i, pos = 0; char *buff, *o_buff; char *cmd, *wd, **new_environ, **args = NULL, cbuff[1]; @@ -126,10 +126,19 @@ start_new_child(int pipes[]) DEBUG_PRINT("size = %d", size); - if ((res = read(pipes[0], buff, size)) != size) { - ABORT("Failed to read %d bytes from %d (%d,%d)", - size, pipes[0], res, errno); - } + do { + if ((res = read(pipes[0], buff + pos, size - pos)) < 0) { + if (errno == EAGAIN || errno == EINTR) + continue; + ABORT("Failed to read %d bytes from %d (%d,%d)", + size, pipes[0], res, errno); + } + if (res == 0) { + errno = EPIPE; + goto child_error; + } + pos += res; + } while(size - pos != 0); o_buff = buff; @@ -154,6 +163,7 @@ start_new_child(int pipes[]) buff += sizeof(Sint32); new_environ = malloc(sizeof(char*)*(cnt + 1)); + DEBUG_PRINT("env_len = %ld", cnt); for (i = 0; i < cnt; i++, buff++) { new_environ[i] = buff; while(*buff != '\0') buff++; @@ -176,6 +186,7 @@ start_new_child(int pipes[]) ABORT("Buff error: %p, %p:%p", o_buff, o_buff+size, buff); } + DEBUG_PRINT("read ack"); if (read(pipes[0], cbuff, 1) < 1) goto child_error; @@ -230,7 +241,8 @@ start_new_child(int pipes[]) execle(SHELL, "sh", "-c", cmd, (char *) NULL, new_environ); } child_error: - _exit(1); + DEBUG_PRINT("exec error: %d\r\n",errno); + _exit(128 + errno); } @@ -392,7 +404,7 @@ main(int argc, char *argv[]) int ibuff[2]; char buff[256]; res = read(sigchld_pipe[0], ibuff, sizeof(ibuff)); - if (res < 0) { + if (res <= 0) { if (errno == EINTR) continue; ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno); diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 97a9c3dfaa..6a1f2f6b2c 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -558,7 +558,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, int len; char **new_environ; - ErtsSysDriverData *res; + ErtsSysDriverData *dd; char *cmd_line; char wd_buff[MAXPATHLEN+1]; char *wd; @@ -658,10 +658,10 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, { struct iovec *io_vector; - int buffsz = 0, iov_len = 5; + int iov_len = 5; char nullbuff[] = "\0"; - int j, i = 0; - Sint32 env_len = 0, argv_len = 0, + int j, i = 0, res; + Sint32 buffsz = 0, env_len = 0, argv_len = 0, flags = (opts->use_stdio ? FORKER_FLAG_USE_STDIO : 0) | (opts->exit_status ? FORKER_FLAG_EXIT_STATUS : 0) | (opts->read_write & DO_READ ? FORKER_FLAG_DO_READ : 0) @@ -753,16 +753,29 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, } /* we send the request to do the fork */ - if (writev(ofd[1], io_vector, iov_len) < 0) { - int err = errno; - close_pipes(ifd, ofd); - erts_free(ERTS_ALC_T_TMP, io_vector); - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - errno = err; - return ERL_DRV_ERROR_ERRNO; + if ((res = writev(ofd[1], io_vector, iov_len > MAXIOV ? MAXIOV : iov_len)) < 0) { + if (errno == ERRNO_BLOCK) { + res = 0; + } else { + int err = errno; + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, io_vector); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = err; + return ERL_DRV_ERROR_ERRNO; + } + } + + if (res < buffsz) { + /* we only wrote part of the command payload. Enqueue the rest. */ + for (i = 0; i < iov_len; i++) { + driver_enq(port_num, io_vector[i].iov_base, io_vector[i].iov_len); + } + driver_deq(port_num, res); + driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1); } erts_free(ERTS_ALC_T_TMP, io_vector); @@ -775,7 +788,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, erts_smp_rwmtx_runlock(&environ_rwmtx); - res = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, + dd = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, DO_WRITE | DO_READ, opts->exit_status, 0, 0); @@ -797,12 +810,12 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, /* we set these fds to negative to mark if they should be closed after the handshake */ if (!(opts->read_write & DO_READ)) - res->ifd->fd *= -1; + dd->ifd->fd *= -1; if (!(opts->read_write & DO_WRITE)) - res->ofd->fd *= -1; + dd->ofd->fd *= -1; - return (ErlDrvData)res; + return (ErlDrvData)dd; #undef CMD_LINE_PREFIX_STR #undef CMD_LINE_PREFIX_STR_SZ } @@ -1365,10 +1378,16 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) return; } - if (write(abs(dd->ofd->fd), "A", 1) < 0) - ; /* do nothing on failure here. If the ofd is broken, then - the ifd will probably also be broken and trigger - a port_inp_failure */ + if (driver_sizeq(port_num) > 0) { + driver_enq(port_num, "A", 1); + } else { + if (write(abs(dd->ofd->fd), "A", 1) < 0) + if (errno == ERRNO_BLOCK || errno == EINTR) + driver_enq(port_num, "A", 1); + /* do nothing on failure here. If the ofd is broken, then + the ifd will probably also be broken and trigger + a port_inp_failure */ + } if (dd->ifd->fd < 0) { driver_select(port_num, abs(dd->ifd->fd), ERL_DRV_READ|ERL_DRV_USE, 0); @@ -1381,9 +1400,8 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) child setup will close this fd if fd < 0 */ driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1); - if (dd->alive == 1) { + if (dd->alive == 1) forker_add_os_pid_mapping(dd); - } erl_drv_set_os_pid(port_num, dd->pid); erl_drv_init_ack(port_num, e); -- cgit v1.2.3 From 123797a395b96b083d895c6ed7f41c56f4eafc78 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 14 Sep 2015 11:04:22 +0200 Subject: erts: Handle all EINTR and EAGAIN cases in child setup --- erts/emulator/sys/unix/erl_child_setup.c | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 6e0a7c143f..1f7ead0ec3 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -56,6 +56,8 @@ #include #include +#define WANT_NONBLOCKING + #include "erl_driver.h" #include "sys_uds.h" @@ -118,7 +120,11 @@ start_new_child(int pipes[]) /* only child executes here */ - if ((res = read(pipes[0], (char*)&size, sizeof(size))) < 0) { + do { + res = read(pipes[0], (char*)&size, sizeof(size)); + } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); + + if (res <= 0) { ABORT("Failed to read size from %d (%d)", pipes[0], errno); } @@ -128,7 +134,7 @@ start_new_child(int pipes[]) do { if ((res = read(pipes[0], buff + pos, size - pos)) < 0) { - if (errno == EAGAIN || errno == EINTR) + if (errno == ERRNO_BLOCK || errno == EINTR) continue; ABORT("Failed to read %d bytes from %d (%d,%d)", size, pipes[0], res, errno); @@ -187,8 +193,13 @@ start_new_child(int pipes[]) } DEBUG_PRINT("read ack"); - if (read(pipes[0], cbuff, 1) < 1) + do { + res = read(pipes[0], cbuff, 1); + } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); + if (res < 1) { + errno = EPIPE; goto child_error; + } DEBUG_PRINT("Do that forking business: '%s'\n",cmd); @@ -270,7 +281,10 @@ static void handle_sigchld(int sig) { sys_sigblock(SIGCHLD); while ((buff[0] = waitpid((pid_t)(-1), buff+1, WNOHANG)) > 0) { - if ((res = write(sigchld_pipe[1], buff, sizeof(buff))) <= 0) + do { + res = write(sigchld_pipe[1], buff, sizeof(buff)); + } while (res < 0 && errno == EINTR); + if (res <= 0) ABORT("Failed to write to sigchld_pipe (%d): %d (%d)", sigchld_pipe[1], res, errno); DEBUG_PRINT("Reap child %d (%d)", buff[0], buff[1]); } @@ -391,7 +405,7 @@ main(int argc, char *argv[]) /* We write an ack here, but expect the reply on the pipes[0] inside the fork */ res = sprintf(buff,"GO:%010d:%010d", os_pid, errno); - if (write(pipes[1], buff, res + 1)) + while (write(pipes[1], buff, res + 1) < 0 && errno == EINTR) ; /* remove gcc warning */ sys_sigrelease(SIGCHLD); -- cgit v1.2.3 From 0ad8c5f46bc0173c09fa5e7e91f917de82389068 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 11 Sep 2015 16:35:48 +0200 Subject: erts: Move os_pid to port hash to child setup Had to move the hashing because of a race that can otherwise happen where a new os_pid value was inserted into the hash before the previous value had been removed. Also replaced the protocol inbetween erts and child setup to be a binary protocol. This was done in order to deal with the varying size of Eterm. --- erts/emulator/Makefile.in | 2 +- erts/emulator/beam/erl_lock_check.c | 1 - erts/emulator/sys/unix/erl_child_setup.c | 127 +++++++++++++++++-- erts/emulator/sys/unix/erl_child_setup.h | 68 ++++++++++ erts/emulator/sys/unix/erl_unix_sys.h | 9 -- erts/emulator/sys/unix/sys_drivers.c | 211 ++++++++++--------------------- 6 files changed, 251 insertions(+), 167 deletions(-) create mode 100644 erts/emulator/sys/unix/erl_child_setup.h diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index ab415b66b4..8cf435905b 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -690,7 +690,7 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c # ---------------------------------------------------------------------- # Specials # -CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o +CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o $(OBJDIR)/hash.o $(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS_LIB) $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 34c0144cbc..f7b4bd8041 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -184,7 +184,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { #ifdef ERTS_SMP { "os_monotonic_time", NULL }, #endif - { "forker_hash_mtx", NULL }, { "erts_alloc_hard_debug", NULL }, { "hard_dbg_mseg", NULL }, { "erts_mmap", NULL } diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 1f7ead0ec3..f74cb0f356 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -60,6 +60,8 @@ #include "erl_driver.h" #include "sys_uds.h" +#include "hash.h" +#include "erl_child_setup.h" #define SET_CLOEXEC(fd) fcntl(fd, F_SETFD, fcntl(fd, F_GETFD) | FD_CLOEXEC) @@ -105,6 +107,10 @@ void sys_sigrelease(int sig) sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); } +static void add_os_pid_to_port_id_mapping(Eterm, pid_t); +static Eterm get_port_id(pid_t); +static int forker_hash_init(void); + static int max_files = -1; static int sigchld_pipe[2]; @@ -114,7 +120,7 @@ start_new_child(int pipes[]) int size, res, i, pos = 0; char *buff, *o_buff; - char *cmd, *wd, **new_environ, **args = NULL, cbuff[1]; + char *cmd, *wd, **new_environ, **args = NULL; Sint cnt, flags; @@ -194,7 +200,12 @@ start_new_child(int pipes[]) DEBUG_PRINT("read ack"); do { - res = read(pipes[0], cbuff, 1); + ErtsSysForkerProto proto; + res = read(pipes[0], &proto, sizeof(proto)); + if (res > 0) { + ASSERT(proto.action == ErtsSysForkerProtoAction_Ack); + ASSERT(res == sizeof(proto)); + } } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); if (res < 1) { errno = EPIPE; @@ -355,6 +366,8 @@ main(int argc, char *argv[]) exit(1); } + forker_hash_init(); + SET_CLOEXEC(uds_fd); DEBUG_PRINT("Starting forker %d", max_files); @@ -376,9 +389,10 @@ main(int argc, char *argv[]) if (FD_ISSET(uds_fd, &read_fds)) { int pipes[3], res, os_pid; - char buff[256]; + ErtsSysForkerProto proto; errno = 0; - if ((res = sys_uds_read(uds_fd, buff, 1, pipes, 3, MSG_DONTWAIT)) < 0) { + if ((res = sys_uds_read(uds_fd, (char*)&proto, sizeof(proto), + pipes, 3, MSG_DONTWAIT)) < 0) { if (errno == EINTR) continue; DEBUG_PRINT("erl_child_setup failed to read from uds: %d, %d", res, errno); @@ -391,8 +405,8 @@ main(int argc, char *argv[]) } /* Since we use unix domain sockets and send the entire data in one go we *should* get the entire payload at once. */ - ASSERT(res == 1); - ASSERT(buff[0] == 'S'); + ASSERT(res == sizeof(proto)); + ASSERT(proto.action == ErtsSysForkerProtoAction_Start); sys_sigblock(SIGCHLD); @@ -402,10 +416,14 @@ main(int argc, char *argv[]) if (os_pid == 0) start_new_child(pipes); + add_os_pid_to_port_id_mapping(proto.u.start.port_id, os_pid); + /* We write an ack here, but expect the reply on the pipes[0] inside the fork */ - res = sprintf(buff,"GO:%010d:%010d", os_pid, errno); - while (write(pipes[1], buff, res + 1) < 0 && errno == EINTR) + proto.action = ErtsSysForkerProtoAction_Go; + proto.u.go.os_pid = os_pid; + proto.u.go.error_number = errno; + while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR) ; /* remove gcc warning */ sys_sigrelease(SIGCHLD); @@ -416,16 +434,23 @@ main(int argc, char *argv[]) if (FD_ISSET(sigchld_pipe[0], &read_fds)) { int ibuff[2]; - char buff[256]; + ErtsSysForkerProto proto; res = read(sigchld_pipe[0], ibuff, sizeof(ibuff)); if (res <= 0) { if (errno == EINTR) continue; ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno); } - res = snprintf(buff, 256, "SIGCHLD:%010d:%010d", ibuff[0], ibuff[1]); + + proto.u.sigchld.port_id = get_port_id((pid_t)(ibuff[0])); + + if (proto.u.sigchld.port_id == THE_NON_VALUE) + continue; /* exit status report not requested */ + + proto.action = ErtsSysForkerProtoAction_SigChld; + proto.u.sigchld.error_number = ibuff[1]; DEBUG_PRINT("send %s to %d", buff, uds_fd); - if (write(uds_fd, buff, res + 1) < 0) { + if (write(uds_fd, &proto, sizeof(proto)) < 0) { if (errno == EINTR) continue; /* The uds was close, which most likely means that the VM @@ -437,3 +462,83 @@ main(int argc, char *argv[]) } return 1; } + +typedef struct exit_status { + HashBucket hb; + pid_t os_pid; + Eterm port_id; +} ErtsSysExitStatus; + +static Hash *forker_hash; + +static void add_os_pid_to_port_id_mapping(Eterm port_id, pid_t os_pid) +{ + if (port_id != THE_NON_VALUE) { + /* exit status report requested */ + ErtsSysExitStatus es; + es.os_pid = os_pid; + es.port_id = port_id; + hash_put(forker_hash, &es); + } +} + +static Eterm get_port_id(pid_t os_pid) +{ + ErtsSysExitStatus est, *es; + Eterm port_id; + est.os_pid = os_pid; + es = hash_remove(forker_hash, &est); + if (!es) return THE_NON_VALUE; + port_id = es->port_id; + free(es); + return port_id; +} + +static int fcmp(void *a, void *b) +{ + ErtsSysExitStatus *sa = a; + ErtsSysExitStatus *sb = b; + return !(sa->os_pid == sb->os_pid); +} + +static HashValue fhash(void *e) +{ + ErtsSysExitStatus *se = e; + Uint32 val = se->os_pid; + val = (val+0x7ed55d16) + (val<<12); + val = (val^0xc761c23c) ^ (val>>19); + val = (val+0x165667b1) + (val<<5); + val = (val+0xd3a2646c) ^ (val<<9); + val = (val+0xfd7046c5) + (val<<3); + val = (val^0xb55a4f09) ^ (val>>16); + return val; +} + +static void *falloc(void *e) +{ + ErtsSysExitStatus *se = e; + ErtsSysExitStatus *ne = malloc(sizeof(ErtsSysExitStatus)); + ne->os_pid = se->os_pid; + ne->port_id = se->port_id; + return ne; +} + +static void *meta_alloc(int type, size_t size) { return malloc(size); } +static void meta_free(int type, void *p) { free(p); } + +static int forker_hash_init(void) +{ + HashFunctions forker_hash_functions; + forker_hash_functions.hash = fhash; + forker_hash_functions.cmp = fcmp; + forker_hash_functions.alloc = falloc; + forker_hash_functions.free = free; + forker_hash_functions.meta_alloc = meta_alloc; + forker_hash_functions.meta_free = meta_free; + forker_hash_functions.meta_print = NULL; + + forker_hash = hash_new(0, "forker_hash", + 16, forker_hash_functions); + + return 1; +} diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h new file mode 100644 index 0000000000..c3258f7cbe --- /dev/null +++ b/erts/emulator/sys/unix/erl_child_setup.h @@ -0,0 +1,68 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + * + * This file defines the interface inbetween erts and child_setup. + */ + +#ifndef _ERL_UNIX_FORKER_H +#define _ERL_UNIX_FORKER_H + +#include "sys.h" + +#define FORKER_ARGV_NO_OF_ARGS 3 +#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */ +#define FORKER_ARGV_MAX_FILES 1 /* max_files */ + +#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */ +#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */ +#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */ +#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */ + +#if SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long ErtsSysPortId; +#elif SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int ErtsSysPortId; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long ErtsSysPortId; +#endif + +typedef struct ErtsSysForkerProto_ { + enum { + ErtsSysForkerProtoAction_Start, + ErtsSysForkerProtoAction_Go, + ErtsSysForkerProtoAction_SigChld, + ErtsSysForkerProtoAction_Ack + } action; + union { + struct { + ErtsSysPortId port_id; + int fds[3]; + } start; + struct { + pid_t os_pid; + int error_number; + } go; + struct { + ErtsSysPortId port_id; + int error_number; + } sigchld; + } u; +} ErtsSysForkerProto; + +#endif /* #ifndef _ERL_UNIX_FORKER_H */ diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index c46f2c1fa2..0352ee1b3c 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -410,15 +410,6 @@ void erts_sys_unblock_fpe(int); #define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) -#define FORKER_ARGV_NO_OF_ARGS 3 -#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */ -#define FORKER_ARGV_MAX_FILES 1 /* max_files */ - -#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */ -#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */ -#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */ -#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */ - /* Threads */ #ifdef USE_THREADS extern int init_async(int); diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 6a1f2f6b2c..82096e5779 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -76,6 +76,8 @@ static Eterm forker_port; #include "erl_sys_driver.h" #include "sys_uds.h" +#include "erl_child_setup.h" + #if defined IOV_MAX #define MAXIOV IOV_MAX #elif defined UIO_MAXIOV @@ -120,12 +122,6 @@ typedef struct driver_data { ErtsSysBlocking *blocking; } ErtsSysDriverData; -typedef struct exit_status { - HashBucket hb; - pid_t os_pid; - Eterm port_id; -} ErtsSysExitStatus; - #define DIR_SEPARATOR_CHAR '/' #if defined(__ANDROID__) @@ -241,21 +237,18 @@ static void outputv(ErlDrvData, ErlIOVec*); static void stop_select(ErlDrvEvent, void*); /* II.V Forker prototypes */ -static int forker_init(void); static ErlDrvData forker_start(ErlDrvPort, char*, SysDriverOpts*); static void forker_stop(ErlDrvData); static void forker_ready_input(ErlDrvData, ErlDrvEvent); static void forker_ready_output(ErlDrvData, ErlDrvEvent); static ErlDrvSSizeT forker_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); -static void forker_add_os_pid_mapping(ErtsSysDriverData *); -static void forker_remove_os_pid_mapping(ErtsSysDriverData *); /* III Driver entries */ /* III.I The spawn driver */ struct erl_drv_entry spawn_driver_entry = { - forker_init, + NULL, spawn_start, stop, output, @@ -794,12 +787,16 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, { /* send ofd[0] + ifd[1] + stderrfd to forker port */ - int *fds = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(int)*3); - memset(fds, 0, sizeof(int)*3); - fds[0] = ofd[0]; - fds[1] = ifd[1]; - fds[2] = stderrfd; - if (erl_drv_port_control(forker_port, 'S', (char*)fds, sizeof(int)*3)) { + ErtsSysForkerProto *proto = + erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, + sizeof(ErtsSysForkerProto)); + memset(proto, 0, sizeof(ErtsSysForkerProto)); + proto->action = ErtsSysForkerProtoAction_Start; + proto->u.start.fds[0] = ofd[0]; + proto->u.start.fds[1] = ifd[1]; + proto->u.start.fds[2] = stderrfd; + proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE; + if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) { /* The forker port has been killed, we close both fd's which will make open_port throw an epipe error */ close(ofd[0]); @@ -824,8 +821,12 @@ static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf; - memcpy(&dd->status, buf, sizeof(dd->status)); + ASSERT(len == sizeof(*proto)); + ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); + + dd->status = proto->u.sigchld.error_number; dd->alive = -1; if (dd->ifd) @@ -1134,10 +1135,6 @@ static void stop(ErlDrvData ev) ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; ErlDrvPort prt = dd->port_num; - if (dd->alive == 1) - /* Stop has been called before the exit status has been reported */ - forker_remove_os_pid_mapping(dd); - if (dd->ifd) { nbio_stop_fd(prt, dd->ifd); driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE, 0); /* close(ifd); */ @@ -1354,10 +1351,10 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) if (dd->pid == 0) { /* the pid is sent from erl_child_setup. spawn driver only. */ - char message_buffer[3 + 10 + 1 + 10 + 1]; - int reason, res; + ErtsSysForkerProto proto; + int res; - if((res = read(ready_fd, message_buffer, sizeof(message_buffer))) <= 0) { + if((res = read(ready_fd, &proto, sizeof(proto))) <= 0) { /* hmm, child setup seems to have closed the pipe too early... we close the port as there is not much else we can do */ if (res < 0 && errno == ERRNO_BLOCK) @@ -1369,21 +1366,25 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) return; } - if(sscanf(message_buffer,"GO:%010d:%010d", &dd->pid, &reason) == 2) { - if (dd->pid == -1) { - /* Setup failed! The only reason why this should happen is if - the fork fails. */ - errno = reason; - port_inp_failure(dd, -1); - return; - } + ASSERT(proto.action == ErtsSysForkerProtoAction_Go); + dd->pid = proto.u.go.os_pid; + + if (dd->pid == -1) { + /* Setup failed! The only reason why this should happen is if + the fork fails. */ + errno = proto.u.go.error_number; + port_inp_failure(dd, -1); + return; + } + + proto.action = ErtsSysForkerProtoAction_Ack; - if (driver_sizeq(port_num) > 0) { - driver_enq(port_num, "A", 1); + if (driver_sizeq(port_num) > 0) { + driver_enq(port_num, (char*)&proto, sizeof(proto)); } else { - if (write(abs(dd->ofd->fd), "A", 1) < 0) + if (write(abs(dd->ofd->fd), &proto, sizeof(proto)) < 0) if (errno == ERRNO_BLOCK || errno == EINTR) - driver_enq(port_num, "A", 1); + driver_enq(port_num, (char*)&proto, sizeof(proto)); /* do nothing on failure here. If the ofd is broken, then the ifd will probably also be broken and trigger a port_inp_failure */ @@ -1400,15 +1401,9 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) child setup will close this fd if fd < 0 */ driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1); - if (dd->alive == 1) - forker_add_os_pid_mapping(dd); - erl_drv_set_os_pid(port_num, dd->pid); erl_drv_init_ack(port_num, e); return; - } - ASSERT(0); - return; } if (packet_bytes == 0) { @@ -1652,10 +1647,6 @@ void fd_ready_async(ErlDrvData drv_data, /* Forker driver */ static int forker_fd; -static Hash *forker_hash; -static erts_smp_mtx_t forker_hash_mtx; - -static void ffree(void *e); static ErlDrvData forker_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) @@ -1749,16 +1740,18 @@ static ErlDrvData forker_start(ErlDrvPort port_num, char* name, static void forker_stop(ErlDrvData e) { - /* we probably should do something here */ + /* we probably should do something here, + the port has been closed by the user. */ } static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) { - int res, *exit_status; - char buff[8+10+1+10+1] = {0}; - ErtsSysExitStatus est, *es; + int res; + ErtsSysForkerProto *proto; + + proto = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(*proto)); - if ((res = read(fd, buff, sizeof(buff))) < 0) { + if ((res = read(fd, proto, sizeof(*proto))) < 0) { if (errno == ERRNO_BLOCK) return; erl_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno); @@ -1767,26 +1760,15 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) if (res == 0) erl_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n"); - if (sscanf(buff, "SIGCHLD:%010d:%010d", &est.os_pid, &res) != 2) - erl_exit(ERTS_DUMP_EXIT, "Got corrupt data from erl_child_setup: %.s\n", - buff, sizeof(buff)); - - erts_smp_mtx_lock(&forker_hash_mtx); - es = hash_remove(forker_hash, &est); - erts_smp_mtx_unlock(&forker_hash_mtx); + ASSERT(res == sizeof(*proto)); + ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); - if (!es) - return; - - exit_status = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(int)); - exit_status[0] = res; /* ideally this would be a port_command call, but as command is already used by the spawn_driver, we use control instead. Note that when using erl_drv_port_control it is an asynchronous control. */ - erl_drv_port_control(es->port_id, 'S', (char*)exit_status, sizeof(int)); - - ffree(es); + erl_drv_port_control(proto->u.sigchld.port_id, 'S', + (char*)proto, sizeof(*proto)); } @@ -1797,18 +1779,19 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) while(driver_sizeq(port_num) > 0) { int vlen; SysIOVec *iov = driver_peekq(port_num, &vlen); - int *fds = (int*)iov[0].iov_base; - ASSERT(iov[0].iov_len >= sizeof(int)*3); - if (sys_uds_write(forker_fd, "S", 1, fds, 3, 0) < 0) { + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; + ASSERT(iov[0].iov_len >= (sizeof(*proto))); + if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0) < 0) { if (errno == ERRNO_BLOCK) return; erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } - close(fds[0]); - close(fds[1]); - if (fds[1] != fds[2]) - close(fds[2]); - driver_deq(port_num, sizeof(int)*3); + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); } driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); @@ -1817,7 +1800,7 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { - int *fds = (int*)buf; + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf; ErlDrvPort port_num = (ErlDrvPort)e; int res; @@ -1826,7 +1809,8 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, return 0; } - if ((res = sys_uds_write(forker_fd, "S", 1, fds, 3, 0)) < 0) { + if ((res = sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0)) < 0) { if (errno == ERRNO_BLOCK) { driver_enq(port_num, buf, len); driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); @@ -1834,74 +1818,11 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, } erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } - close(fds[0]); - close(fds[1]); - if (fds[1] != fds[2]) - close(fds[2]); - return 0; -} -static void forker_add_os_pid_mapping(ErtsSysDriverData *dd) -{ - Eterm port_id = erts_drvport2id(dd->port_num); - ErtsSysExitStatus es; - es.os_pid = dd->pid; - es.port_id = port_id; - erts_smp_mtx_lock(&forker_hash_mtx); - hash_put(forker_hash, &es); - erts_smp_mtx_unlock(&forker_hash_mtx); -} - -static void forker_remove_os_pid_mapping(ErtsSysDriverData *dd) -{ - ErtsSysExitStatus est, *es; - est.os_pid = dd->pid; - erts_smp_mtx_lock(&forker_hash_mtx); - es = hash_remove(forker_hash, &est); - erts_smp_mtx_unlock(&forker_hash_mtx); - if (es) - ffree(es); -} - -static int fcmp(void *a, void *b) -{ - ErtsSysExitStatus *sa = a; - ErtsSysExitStatus *sb = b; - return !(sa->os_pid == sb->os_pid); -} - -static HashValue fhash(void *e) -{ - ErtsSysExitStatus *se = e; - return make_hash2(make_small(se->os_pid)); -} - -static void *falloc(void *e) -{ - ErtsSysExitStatus *se = e; - ErtsSysExitStatus *ne = erts_alloc(ERTS_ALC_T_DRV, sizeof(ErtsSysExitStatus)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); - ne->os_pid = se->os_pid; - ne->port_id = se->port_id; - return ne; -} - -static void ffree(void *e) -{ - erts_free(ERTS_ALC_T_DRV, e); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysBlocking)); -} - -static int forker_init(void) -{ - HashFunctions forker_hash_functions; - forker_hash_functions.hash = fhash; - forker_hash_functions.cmp = fcmp; - forker_hash_functions.alloc = falloc; - forker_hash_functions.free = ffree; - forker_hash = hash_new(ERTS_ALC_T_DRV, "forker_hash", - 16, forker_hash_functions); - erts_smp_mtx_init(&forker_hash_mtx, "forker_hash_mtx"); - - return 1; + ASSERT(res == sizeof(*proto)); + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + return 0; } -- cgit v1.2.3 From 846c86559dea147d069bd489e141484dc2194610 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 14 Sep 2015 11:02:18 +0200 Subject: erts: Add testcase for huge port environment --- erts/emulator/test/port_SUITE.erl | 38 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index b67fd1c409..6cc86a26a3 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -86,7 +86,7 @@ iter_max_ports/1, eof/1, input_only/1, output_only/1, name1/1, t_binary/1, parallell/1, t_exit/1, - env/1, bad_env/1, cd/1, exit_status/1, + env/1, huge_env/1, bad_env/1, cd/1, exit_status/1, tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, @@ -112,7 +112,7 @@ all() -> bad_packet, bad_port_messages, {group, options}, {group, multiple_packets}, parallell, dying_port, port_program_with_path, open_input_file_port, - open_output_file_port, name1, env, bad_env, cd, + open_output_file_port, name1, env, huge_env, bad_env, cd, exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line, stderr_to_stdout, otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, @@ -962,6 +962,40 @@ try_bad_env(Env) -> error:badarg -> ok end. +%% Test that we can handle a very very large environment gracefully. +huge_env(Config) when is_list(Config) -> + Vars = case os:type() of + {win32,_} -> 500; + _ -> + %% We create a huge environment, + %% 20000 variables is about 25MB + %% which seems to be the limit on Linux. + 20000 + end, + Env = [{[$a + I div (25*25*25*25) rem 25, + $a + I div (25*25*25) rem 25, + $a + I div (25*25) rem 25, + $a+I div 25 rem 25, $a+I rem 25], + lists:duplicate(100,$a+I rem 25)} + || I <- lists:seq(1,Vars)], + try erlang:open_port({spawn,"ls"},[exit_status, {env, Env}]) of + P -> + receive + {P, {exit_status,N}} = M -> + %% We test that the exit status is an integer, this means + %% that the child program has started. If we get an atom + %% something went wrong in the driver which is not ok. + ct:log("Got ~p",[M]), + true = is_integer(N) + end + catch E:R -> + %% Have to catch the error here, as printing the stackdump + %% in the ct log is way to heavy for some test machines. + ct:fail("Open port failed ~p:~p",[E,R]) + end. + + + %% 'cd' option %% (Can perhaps be made smaller by calling the other utility functions %% in this module.) -- cgit v1.2.3 From 200247f972b012ced0c4b2c6611f091af66ebedd Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 14 Sep 2015 11:52:09 +0200 Subject: kernel: Remove cmd server for unix os:cmd Since we no longer to vfork in the emulator there is no need to serialize the os:cmd calls through a central command server. This greatly decreases the complexity of this code and should make it fast+more scalable. OTP-13089 --- lib/kernel/src/os.erl | 191 ++++++------------------------------------- lib/kernel/test/os_SUITE.erl | 58 +++---------- 2 files changed, 37 insertions(+), 212 deletions(-) diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index ffb899e5ca..0022959c11 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -212,174 +212,33 @@ extensions() -> Command :: atom() | io_lib:chars(). cmd(Cmd) -> validate(Cmd), - Bytes = case type() of - {unix, _} -> - unix_cmd(Cmd); - {win32, Wtype} -> - Command0 = case {os:getenv("COMSPEC"),Wtype} of - {false,windows} -> lists:concat(["command.com /c", Cmd]); - {false,_} -> lists:concat(["cmd /c", Cmd]); - {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) - end, - %% open_port/2 awaits string() in Command, but io_lib:chars() can be - %% deep lists according to io_lib module description. - Command = lists:flatten(Command0), - Port = open_port({spawn, Command}, [stream, in, eof, hide]), - get_data(Port, []) - end, - String = unicode:characters_to_list(list_to_binary(Bytes)), + {SpawnCmd, SpawnOpts, SpawnInput} = mk_cmd(os:type(), Cmd), + Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, + stream, in, eof, hide | SpawnOpts]), + true = port_command(Port, SpawnInput), + Bytes = get_data(Port, []), + String = unicode:characters_to_list(Bytes), if %% Convert to unicode list if possible otherwise return bytes is_list(String) -> String; - true -> Bytes + true -> binary_to_list(Bytes) end. -unix_cmd(Cmd) -> - Tag = make_ref(), - {Pid,Mref} = erlang:spawn_monitor( - fun() -> - process_flag(trap_exit, true), - Port = start_port(), - erlang:port_command(Port, mk_cmd(Cmd)), - exit({Tag,unix_get_data(Port)}) - end), - receive - {'DOWN',Mref,_,Pid,{Tag,Result}} -> - Result; - {'DOWN',Mref,_,Pid,Reason} -> - exit(Reason) - end. - -%% The -s flag implies that only the positional parameters are set, -%% and the commands are read from standard input. We set the -%% $1 parameter for easy identification of the resident shell. -%% --define(ROOT, "/"). --define(ROOT_ANDROID, "/system"). --define(SHELL, "bin/sh -s unix:cmd 2>&1"). --define(PORT_CREATOR_NAME, os_cmd_port_creator). - -%% -%% Serializing open_port through a process to avoid smp lock contention -%% when many concurrent os:cmd() want to do vfork (OTP-7890). -%% --spec start_port() -> port(). -start_port() -> - Ref = make_ref(), - Request = {Ref,self()}, - {Pid, Mon} = case whereis(?PORT_CREATOR_NAME) of - undefined -> - spawn_monitor(fun() -> - start_port_srv(Request) - end); - P -> - P ! Request, - M = erlang:monitor(process, P), - {P, M} - end, - receive - {Ref, Port} when is_port(Port) -> - erlang:demonitor(Mon, [flush]), - Port; - {Ref, Error} -> - erlang:demonitor(Mon, [flush]), - exit(Error); - {'DOWN', Mon, process, Pid, _Reason} -> - start_port() - end. - -start_port_srv(Request) -> - %% We don't want a group leader of some random application. Use - %% kernel_sup's group leader. - {group_leader, GL} = process_info(whereis(kernel_sup), - group_leader), - true = group_leader(GL, self()), - process_flag(trap_exit, true), - StayAlive = try register(?PORT_CREATOR_NAME, self()) - catch - error:_ -> false - end, - start_port_srv_handle(Request), - case StayAlive of - true -> start_port_srv_loop(); - false -> exiting - end. - -start_port_srv_handle({Ref,Client}) -> - 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), - Port - catch - error:Reason -> - {Reason,erlang:get_stacktrace()} - end, - Client ! {Ref,Reply}, - ok. - -start_port_srv_loop() -> - receive - {Ref, Client} = Request when is_reference(Ref), - is_pid(Client) -> - start_port_srv_handle(Request); - _Junk -> - ok - end, - start_port_srv_loop(). - -%% -%% unix_get_data(Port) -> Result -%% -unix_get_data(Port) -> - unix_get_data(Port, []). - -unix_get_data(Port, Sofar) -> - receive - {Port,{data, Bytes}} -> - case eot(Bytes) of - {done, Last} -> - lists:flatten([Sofar|Last]); - more -> - unix_get_data(Port, [Sofar|Bytes]) - end; - {'EXIT', Port, _} -> - lists:flatten(Sofar) - end. - -%% -%% eot(String) -> more | {done, Result} -%% -eot(Bs) -> - eot(Bs, []). - -eot([4| _Bs], As) -> - {done, lists:reverse(As)}; -eot([B| Bs], As) -> - eot(Bs, [B| As]); -eot([], _As) -> - more. - -%% -%% mk_cmd(Cmd) -> {ok, ShellCommandString} | {error, ErrorString} -%% -%% We do not allow any input to Cmd (hence commands that want -%% to read from standard input will return immediately). -%% Standard error is redirected to standard output. -%% -%% We use ^D (= EOT = 4) to mark the end of the stream. -%% -mk_cmd(Cmd) when is_atom(Cmd) -> % backward comp. - mk_cmd(atom_to_list(Cmd)); -mk_cmd(Cmd) -> - %% We insert a new line after the command, in case the command - %% contains a comment character. - [$(, unicode:characters_to_binary(Cmd), "\n) + Command = case {os:getenv("COMSPEC"),Wtype} of + {false,windows} -> lists:concat(["command.com /c", Cmd]); + {false,_} -> lists:concat(["cmd /c", Cmd]); + {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) + end, + {Command, [], []}; +mk_cmd(OsType,Cmd) when is_atom(Cmd) -> + mk_cmd(OsType, atom_to_list(Cmd)); +mk_cmd(_,Cmd) -> + %% Have to send command in like this in order to make sh commands like + %% cd and ulimit available + {"/bin/sh -s unix:cmd", [out], + %% We insert a new line after the command, in case the command + %% contains a comment character. + ["(", unicode:characters_to_binary(Cmd), "\n); exit\n"]}. validate(Atom) when is_atom(Atom) -> ok; @@ -397,7 +256,7 @@ validate1([]) -> get_data(Port, Sofar) -> receive {Port, {data, Bytes}} -> - get_data(Port, [Sofar|Bytes]); + get_data(Port, [Sofar,Bytes]); {Port, eof} -> Port ! {self(), close}, receive @@ -410,5 +269,5 @@ get_data(Port, Sofar) -> after 1 -> % force context switch ok end, - lists:flatten(Sofar) + iolist_to_binary(Sofar) end. diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 29d8d10262..83a95019e7 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -22,7 +22,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, - find_executable/1, unix_comment_in_command/1, deep_list_command/1, evil/1]). + find_executable/1, unix_comment_in_command/1, deep_list_command/1, + large_output_command/1]). -include_lib("test_server/include/test_server.hrl"). @@ -30,7 +31,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, - find_executable, unix_comment_in_command, deep_list_command, evil]. + find_executable, unix_comment_in_command, deep_list_command, + large_output_command]. groups() -> []. @@ -267,50 +269,14 @@ deep_list_command(Config) when is_list(Config) -> %% FYI: [$e, $c, "ho"] =:= io_lib:format("ec~s", ["ho"]) ok. - --define(EVIL_PROCS, 100). --define(EVIL_LOOPS, 100). --define(PORT_CREATOR, os_cmd_port_creator). -evil(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(5)), - Parent = self(), - Ps = lists:map(fun (N) -> - spawn_link(fun () -> - evil_loop(Parent, ?EVIL_LOOPS,N) - end) - end, lists:seq(1, ?EVIL_PROCS)), - Devil = spawn_link(fun () -> devil(hd(Ps), hd(lists:reverse(Ps))) end), - lists:foreach(fun (P) -> receive {P, done} -> ok end end, Ps), - unlink(Devil), - exit(Devil, kill), - test_server:timetrap_cancel(Dog), - ok. - -devil(P1, P2) -> - erlang:display({?PORT_CREATOR, whereis(?PORT_CREATOR)}), - (catch ?PORT_CREATOR ! lists:seq(1,1000000)), - (catch ?PORT_CREATOR ! lists:seq(1,666)), - (catch ?PORT_CREATOR ! grrrrrrrrrrrrrrrr), - (catch ?PORT_CREATOR ! {'EXIT', P1, buhuuu}), - (catch ?PORT_CREATOR ! {'EXIT', hd(erlang:ports()), buhuuu}), - (catch ?PORT_CREATOR ! {'EXIT', P2, arggggggg}), - receive after 500 -> ok end, - (catch exit(whereis(?PORT_CREATOR), kill)), - (catch ?PORT_CREATOR ! ">8|"), - receive after 500 -> ok end, - (catch exit(whereis(?PORT_CREATOR), diiiiiiiiiiiiiiiiiiiie)), - receive after 100 -> ok end, - devil(P1, P2). - -evil_loop(Parent, Loops, N) -> - Res = integer_to_list(N), - evil_loop(Parent, Loops, Res, "echo " ++ Res). - -evil_loop(Parent, 0, _Res, _Cmd) -> - Parent ! {self(), done}; -evil_loop(Parent, Loops, Res, Cmd) -> - comp(Res, os:cmd(Cmd)), - evil_loop(Parent, Loops-1, Res, Cmd). +large_output_command(doc) -> + "Test to take sure that the correct data is" + "received when doing large commands"; +large_output_command(suite) -> []; +large_output_command(Config) when is_list(Config) -> + %% Maximum allowed on windows is 8192, so we test well below that + AAA = lists:duplicate(7000, $a), + comp(AAA,os:cmd("echo " ++ AAA)). comp(Expected, Got) -> case strip_nl(Got) of -- cgit v1.2.3 From e56d78b761680d83ab61045a62d4fc7bdb312b3c Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 28 Sep 2015 11:02:40 +0200 Subject: erts: Fix memory leak at async open port When an async open port fails early, it would sometimes leak memory. --- erts/emulator/beam/io.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index fc247a3260..df8a213a1d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -479,6 +479,11 @@ erts_port_free(Port *prt) erts_port_task_fini_sched(&prt->sched); + if (prt->async_open_port) { + erts_free(ERTS_ALC_T_PRTSD, prt->async_open_port); + prt->async_open_port = NULL; + } + #ifdef ERTS_SMP ASSERT(prt->lock); if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) -- cgit v1.2.3 From 42b6156235421fbda1bc65c725e4ea7d183e4c84 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 12 Oct 2015 14:59:37 +0200 Subject: erts: Fix large open_port arg segfault for win32 os_SUITE:large_output_command send a 10k large argument to open_port({spawn,""}) which was too small for the 2K buffer allocated for win32. The buffer is now dynamic and any size can be used. --- erts/emulator/sys/win32/sys.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 3793357848..76ce25916a 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1526,8 +1526,8 @@ create_child_process * Parse out the program name from the command line (it can be quoted and * contain spaces). */ - newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, 2048*sizeof(wchar_t)); cmdlength = parse_command(origcmd); + newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (MAX_PATH+wcslen(origcmd)-cmdlength)*sizeof(wchar_t)); thecommand = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (cmdlength+1)*sizeof(wchar_t)); wcsncpy(thecommand, origcmd, cmdlength); thecommand[cmdlength] = L'\0'; -- cgit v1.2.3 From 598e7e6a456d882aaa586b5ddb17811ecd43f2e5 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 13 Oct 2015 16:55:50 +0200 Subject: erts: Add forker StartAck for port start flowcontrol An acknowledgement of the Start command has to be managed as we have to make sure that packages are not dropped and also that the close calls do not happen too early. --- erts/emulator/sys/unix/erl_child_setup.c | 4 ++ erts/emulator/sys/unix/erl_child_setup.h | 1 + erts/emulator/sys/unix/sys_drivers.c | 76 +++++++++++++++++++------------- 3 files changed, 51 insertions(+), 30 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index f74cb0f356..fdffc7f119 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -426,6 +426,10 @@ main(int argc, char *argv[]) while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR) ; /* remove gcc warning */ + proto.action = ErtsSysForkerProtoAction_StartAck; + while (write(uds_fd, &proto, sizeof(proto)) < 0 && errno == EINTR) + ; /* remove gcc warning */ + sys_sigrelease(SIGCHLD); close(pipes[0]); close(pipes[1]); diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h index c3258f7cbe..93b39d46b2 100644 --- a/erts/emulator/sys/unix/erl_child_setup.h +++ b/erts/emulator/sys/unix/erl_child_setup.h @@ -45,6 +45,7 @@ typedef unsigned long long ErtsSysPortId; typedef struct ErtsSysForkerProto_ { enum { ErtsSysForkerProtoAction_Start, + ErtsSysForkerProtoAction_StartAck, ErtsSysForkerProtoAction_Go, ErtsSysForkerProtoAction_SigChld, ErtsSysForkerProtoAction_Ack diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 82096e5779..dc1c00ff96 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -1761,37 +1761,59 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) erl_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n"); ASSERT(res == sizeof(*proto)); - ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); - - /* ideally this would be a port_command call, but as command is - already used by the spawn_driver, we use control instead. - Note that when using erl_drv_port_control it is an asynchronous - control. */ - erl_drv_port_control(proto->u.sigchld.port_id, 'S', - (char*)proto, sizeof(*proto)); - -} -static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) -{ - ErlDrvPort port_num = (ErlDrvPort)e; - - while(driver_sizeq(port_num) > 0) { + if (proto->action == ErtsSysForkerProtoAction_StartAck) { + /* Ideally we would like to not have to ack each Start + command being sent over the uds, but it would seem + that some operating systems (only observed on FreeBSD) + throw away data on the uds when the socket becomes full, + so we have to. + + Also the freebsd manual explicitly states that + you should not close fds before they are known + to have reached the other side, so this Ack protects + against that as well. + */ + ErlDrvPort port_num = (ErlDrvPort)e; int vlen; SysIOVec *iov = driver_peekq(port_num, &vlen); ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; - ASSERT(iov[0].iov_len >= (sizeof(*proto))); - if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), - proto->u.start.fds, 3, 0) < 0) { - if (errno == ERRNO_BLOCK) - return; - erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); - } + close(proto->u.start.fds[0]); close(proto->u.start.fds[1]); if (proto->u.start.fds[1] != proto->u.start.fds[2]) close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); + + if (driver_sizeq(port_num) > 0) + driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } else { + ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); + + /* ideally this would be a port_command call, but as command is + already used by the spawn_driver, we use control instead. + Note that when using erl_drv_port_control it is an asynchronous + control. */ + erl_drv_port_control(proto->u.sigchld.port_id, 'S', + (char*)proto, sizeof(*proto)); + } + +} + +static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) +{ + ErlDrvPort port_num = (ErlDrvPort)e; + + int vlen; + SysIOVec *iov = driver_peekq(port_num, &vlen); + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; + ASSERT(iov[0].iov_len >= (sizeof(*proto))); + if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0) < 0) { + if (errno == ERRNO_BLOCK) + return; + erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup uds: %d", errno); } driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); @@ -1804,25 +1826,19 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, ErlDrvPort port_num = (ErlDrvPort)e; int res; - if (driver_sizeq(port_num) > 0) { - driver_enq(port_num, buf, len); + driver_enq(port_num, buf, len); + if (driver_sizeq(port_num) > sizeof(*proto)) { return 0; } if ((res = sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), proto->u.start.fds, 3, 0)) < 0) { if (errno == ERRNO_BLOCK) { - driver_enq(port_num, buf, len); driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); return 0; } erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } - ASSERT(res == sizeof(*proto)); - close(proto->u.start.fds[0]); - close(proto->u.start.fds[1]); - if (proto->u.start.fds[1] != proto->u.start.fds[2]) - close(proto->u.start.fds[2]); return 0; } -- cgit v1.2.3 From b96e62d346eea60b2300dce22d8d892387de4681 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 14 Oct 2015 09:17:58 +0200 Subject: erts: It is not possible to exit the forker driver --- erts/emulator/beam/io.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index df8a213a1d..8d9199162c 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -2408,6 +2408,11 @@ erts_port_exit(Process *c_p, | ERTS_PORT_SIG_FLG_BROKEN_LINK | ERTS_PORT_SIG_FLG_FORCE_SCHED)) == 0); +#ifndef __WIN32__ + if (prt->drv_ptr == &forker_driver) + return ERTS_PORT_OP_DROPPED; +#endif + if (!(flags & ERTS_PORT_SIG_FLG_FORCE_SCHED)) { ErtsTryImmDrvCallState try_call_state = ERTS_INIT_TRY_IMM_DRV_CALL_STATE(c_p, -- cgit v1.2.3 From 6fc7ccb41da5e9ec4357b40811ad740dd6a3b5b2 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 14 Oct 2015 09:56:03 +0200 Subject: erts: Only use forker StackAck on freebsd --- erts/emulator/sys/unix/erl_child_setup.c | 2 ++ erts/emulator/sys/unix/erl_child_setup.h | 8 ++++++ erts/emulator/sys/unix/sys_drivers.c | 48 ++++++++++++++++++++++---------- 3 files changed, 43 insertions(+), 15 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index fdffc7f119..998a0d297f 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -426,9 +426,11 @@ main(int argc, char *argv[]) while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR) ; /* remove gcc warning */ +#ifdef FORKER_PROTO_START_ACK proto.action = ErtsSysForkerProtoAction_StartAck; while (write(uds_fd, &proto, sizeof(proto)) < 0 && errno == EINTR) ; /* remove gcc warning */ +#endif sys_sigrelease(SIGCHLD); close(pipes[0]); diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h index 93b39d46b2..a28b136bfc 100644 --- a/erts/emulator/sys/unix/erl_child_setup.h +++ b/erts/emulator/sys/unix/erl_child_setup.h @@ -25,6 +25,14 @@ #include "sys.h" +#ifdef __FreeBSD__ +/* The freebsd sendmsg man page explicitly states that + you should not close fds before they are known + to have reached the other side, so this Ack protects + against that. */ +#define FORKER_PROTO_START_ACK 1 +#endif + #define FORKER_ARGV_NO_OF_ARGS 3 #define FORKER_ARGV_PROGNAME_IX 0 /* Program name */ #define FORKER_ARGV_MAX_FILES 1 /* max_files */ diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index dc1c00ff96..2a7cd91265 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -1762,17 +1762,13 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) ASSERT(res == sizeof(*proto)); +#ifdef FORKER_PROTO_START_ACK if (proto->action == ErtsSysForkerProtoAction_StartAck) { /* Ideally we would like to not have to ack each Start command being sent over the uds, but it would seem that some operating systems (only observed on FreeBSD) throw away data on the uds when the socket becomes full, so we have to. - - Also the freebsd manual explicitly states that - you should not close fds before they are known - to have reached the other side, so this Ack protects - against that as well. */ ErlDrvPort port_num = (ErlDrvPort)e; int vlen; @@ -1788,7 +1784,9 @@ static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) if (driver_sizeq(port_num) > 0) driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); - } else { + } else +#endif + { ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); /* ideally this would be a port_command call, but as command is @@ -1805,16 +1803,27 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) { ErlDrvPort port_num = (ErlDrvPort)e; - int vlen; - SysIOVec *iov = driver_peekq(port_num, &vlen); - ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; - ASSERT(iov[0].iov_len >= (sizeof(*proto))); - if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), - proto->u.start.fds, 3, 0) < 0) { - if (errno == ERRNO_BLOCK) - return; - erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup uds: %d", errno); +#ifndef FORKER_PROTO_START_ACK + while (driver_sizeq(port_num) > 0) { +#endif + int vlen; + SysIOVec *iov = driver_peekq(port_num, &vlen); + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; + ASSERT(iov[0].iov_len >= (sizeof(*proto))); + if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0) < 0) { + if (errno == ERRNO_BLOCK) + return; + erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } +#ifndef FORKER_PROTO_START_ACK + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); } +#endif driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); } @@ -1840,5 +1849,14 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, erl_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); } +#ifndef FORKER_PROTO_START_ACK + ASSERT(res == sizeof(*proto)); + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); +#endif + return 0; } -- cgit v1.2.3 From 638476d255cf6f9e5cd880eb9318d5b08664e5f8 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 15 Oct 2015 11:53:24 +0200 Subject: erts: Allow one dangling fd if there is a gethost port --- erts/emulator/test/driver_SUITE.erl | 26 +++++++++++++++++++++++-- erts/emulator/test/z_SUITE.erl | 38 ++++++++++++++++++++++++++++++------- 2 files changed, 55 insertions(+), 9 deletions(-) diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index b72d6cbe52..e17d0ff96c 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -2395,13 +2395,35 @@ z_test(Config) when is_list(Config) -> check_io_debug() -> get_stable_check_io_info(), - {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug = erts_debug:get_internal_state(check_io_debug), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), 0 = NoErrorFds, - NoUsedFds = NoDrvSelStructs, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on + ok + end, 0 = NoDrvEvStructs, ok. +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. + %flush_msgs() -> % receive % M -> diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index f4d9030255..abc353fb01 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -249,6 +249,7 @@ pollset_size(Config) when is_list(Config) -> ?line io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), ?line InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), ?line FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), + HasGethost = case has_gethost() of true -> 1; _ -> 0 end, ?line case InitPollsetSize =:= FinPollsetSize of true -> case InitPollsetSize of @@ -269,7 +270,7 @@ pollset_size(Config) when is_list(Config) -> = InitPollsetSize, ?line {value, {total_poll_set_size, FinSize}} = FinPollsetSize, - ?line true = FinSize < InitSize, + ?line true = FinSize < (InitSize + HasGethost), ?line true = 2 =< FinSize, ?line {comment, "Start pollset size: " @@ -289,16 +290,39 @@ check_io_debug(Config) when is_list(Config) -> end. check_io_debug_test() -> - ?line erlang:display(get_check_io_info()), - ?line erts_debug:set_internal_state(available_internal_state, true), - ?line {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} + erlang:display(get_check_io_info()), + erts_debug:set_internal_state(available_internal_state, true), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug = erts_debug:get_internal_state(check_io_debug), - ?line erts_debug:set_internal_state(available_internal_state, false), - ?line 0 = NoErrorFds, - ?line NoUsedFds = NoDrvSelStructs, + erts_debug:set_internal_state(available_internal_state, false), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), + 0 = NoErrorFds, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on. + %% This happens when the initial setup of the + %% port returns an EAGAIN + ok + end, ?line 0 = NoDrvEvStructs, ?line ok. +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. %% -- cgit v1.2.3 From 99415cedd98151ca74715b6cadf90f6dd8493025 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 19 Oct 2015 17:29:48 +0200 Subject: erts: iter_port sleep longer on freebsd --- erts/emulator/test/port_SUITE.erl | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 6cc86a26a3..19065fe811 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -719,7 +719,16 @@ close_ports([]) -> ok. open_ports(Name, Settings) -> - test_server:sleep(5), + case os:type() of + {unix, freebsd} -> + %% FreeBsd has issues with sendmsg/recvmsg in fork + %% implementation and we therefor have to spawn + %% slower to make sure that we always hit the same + %% make roof. + test_server:sleep(10); + _ -> + test_server:sleep(5) + end, case catch open_port(Name, Settings) of P when is_port(P) -> [P| open_ports(Name, Settings)]; -- cgit v1.2.3 From 70c4711252e260e4ad4c43625226b21ecf775a75 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 20 Oct 2015 18:19:17 +0200 Subject: erts: Allow enomem failures in port_SUITE With the new forker implementation also enomem can be returned as an indicator that it is not possible to create more ports. --- erts/emulator/test/port_SUITE.erl | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 19065fe811..6f29e3ad95 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1310,13 +1310,15 @@ otp_4389(Config) when is_list(Config) -> {P,{exit_status,_}} -> TCR ! {self(),ok}; {'EXIT',_,{R2,_}} when R2 == emfile; - R2 == eagain -> + R2 == eagain; + R2 == enomem -> TCR ! {self(),ok}; Err2 -> TCR ! {self(),{msg,Err2}} end; {'EXIT',{R1,_}} when R1 == emfile; - R1 == eagain -> + R1 == eagain; + R1 == enomem -> TCR ! {self(),ok}; Err1 -> TCR ! {self(), {open_port,Err1}} @@ -1922,10 +1924,12 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> {Prt, erlang:system_info(scheduler_id)}; {'EXIT', {Err, _}} when Err == eagain; - Err == emfile -> + Err == emfile; + Err == enomem -> noop; {'EXIT', Err} when Err == eagain; - Err == emfile -> + Err == emfile; + Err == enomem -> noop; Error -> ?t:fail(Error) -- cgit v1.2.3 From 10ffa0b2f8c66b3a318503b4dfdfe02d6577d746 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 30 Nov 2015 12:00:44 +0100 Subject: erts: Mend ASSERT makro for erl_child_setup when called by hash.c for example. We use ASSERT from sys.h but erl_child_setup implements its own erl_assert_error() as it doesn't link with sys.o. --- erts/emulator/sys/unix/erl_child_setup.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 998a0d297f..94d1fd64c7 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -83,11 +83,16 @@ abort(); \ } while(0) -#undef ASSERT #ifdef DEBUG -#define ASSERT(cnd) do { if (!(cnd)) { ABORT("assertion %s failed", #cnd); } } while(0) -#else -#define ASSERT(cnd) +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); + abort(); +} #endif void sys_sigblock(int sig) -- cgit v1.2.3 From 4b1b3bf6c62f8208b2eea506c9dac1504df6e916 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 8 Dec 2015 12:17:22 +0100 Subject: erts: Never abort in the forked child We always want the error to propagate up to the application when a child cannot be created. --- erts/emulator/sys/unix/erl_child_setup.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 94d1fd64c7..4e61530cf1 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -136,7 +136,7 @@ start_new_child(int pipes[]) } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); if (res <= 0) { - ABORT("Failed to read size from %d (%d)", pipes[0], errno); + goto child_error; } buff = malloc(size); @@ -147,8 +147,7 @@ start_new_child(int pipes[]) if ((res = read(pipes[0], buff + pos, size - pos)) < 0) { if (errno == ERRNO_BLOCK || errno == EINTR) continue; - ABORT("Failed to read %d bytes from %d (%d,%d)", - size, pipes[0], res, errno); + goto child_error; } if (res == 0) { errno = EPIPE; @@ -200,7 +199,8 @@ start_new_child(int pipes[]) } if (o_buff + size != buff) { - ABORT("Buff error: %p, %p:%p", o_buff, o_buff+size, buff); + errno = EINVAL; + goto child_error; } DEBUG_PRINT("read ack"); -- cgit v1.2.3 From 1cf9bed55624fefabcb8c517f9e496a92883117a Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 15 Dec 2015 10:22:25 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erlang.beam | Bin 101752 -> 34396 bytes erts/preloaded/ebin/erts_internal.beam | Bin 6076 -> 2032 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 632defdb46..6610800458 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index fd0a502d2c..fcc8c85e52 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ -- cgit v1.2.3 From 8e6d005dcd8f62745d28d1820c4b2a5025634f5f Mon Sep 17 00:00:00 2001 From: Alexey Lebedeff Date: Mon, 14 Dec 2015 15:15:52 +0300 Subject: Prevent down nodes going undetected in epmd In the following (rare) case down node will be always registered in epmd: - client connects to epmd and sends ALIVE2 request - epmd reads this request and starts to process it - during that time client socket closes in such way that subsequent write(2) in epmd will result in error - at this point we have node that was registered in database, but as the connection struct has no 'keep' flag set, the do_read() closes connection and removes it from select fdset - and so there is no way for this node to be cleaned up later. We've seen several epmd instances in such state on our production systems. And while I'm not sure what was the exact sequence of events that leads to failed write(2), issue could be easily reproduced using SO_LINGER option for socket. --- erts/epmd/src/epmd_srv.c | 1 + erts/epmd/test/epmd_SUITE.erl | 58 +++++++++++++++++++++++++++++++++++++------ 2 files changed, 52 insertions(+), 7 deletions(-) diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 8c8d7304f2..c9d49e73d0 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -705,6 +705,7 @@ static void do_request(g, fd, s, buf, bsize) if (reply(g, fd, wbuf, 4) != 4) { + node_unreg(g, name); dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", name); return; diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index e8bbfdbb18..4de65500e9 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -76,7 +76,9 @@ buffer_overrun_2/1, no_nonlocal_register/1, no_nonlocal_kill/1, - no_live_killing/1 + no_live_killing/1, + + socket_reset_before_alive2_reply_is_written/1 ]). @@ -123,7 +125,8 @@ all() -> returns_valid_populated_extra_with_nulls, names_stdout, {group, buffer_overrun}, no_nonlocal_register, - no_nonlocal_kill, no_live_killing]. + no_nonlocal_kill, no_live_killing, + socket_reset_before_alive2_reply_is_written]. groups() -> [{buffer_overrun, [], @@ -243,11 +246,7 @@ register_node(Name,Port) -> register_node_v2(Port,$M,0,5,5,Name,""). register_node_v2(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> - Utf8Name = unicode:characters_to_binary(Name), - Req = [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, - put16(HVsn), put16(LVsn), - put16(size(Utf8Name)), binary_to_list(Utf8Name), - size16(Extra), Extra], + Req = alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra), case send_req(Req) of {ok,Sock} -> case recv(Sock,4) of @@ -938,6 +937,42 @@ no_live_killing(Config) when is_list(Config) -> ?line close(Sock3), ok. +socket_reset_before_alive2_reply_is_written(doc) -> + ["Check for regression - don't make zombie from node which " + "sends TCP RST at wrong time"]; +socket_reset_before_alive2_reply_is_written(suite) -> + []; +socket_reset_before_alive2_reply_is_written(Config) when is_list(Config) -> + %% - delay_write for easier triggering of race condition + %% - relaxed_command_check for gracefull shutdown of epmd even if there + %% is stuck node. + ?line ok = epmdrun("-delay_write 1 -relaxed_command_check"), + + %% We can't use send_req/1 directly as we want to do inet:setopts/2 + %% on our socket. + ?line {ok, Sock} = connect(), + + %% Issuing close/1 on such socket will result in immediate RST packet. + ?line ok = inet:setopts(Sock, [{linger, {true, 0}}]), + + Req = alive2_req(4711, 77, 0, 5, 5, "test", []), + ?line ok = send(Sock, [size16(Req), Req]), + + timer:sleep(500), %% Wait for the first 1/2 of delay_write before closing + ?line ok = close(Sock), + + timer:sleep(500 + ?SHORT_PAUSE), %% Wait for the other 1/2 of delay_write + + %% Wait another delay_write interval, due to delay doubling in epmd. + %% Should be removed when this is issue is fixed there. + timer:sleep(1000), + + ?line {ok, SockForNames} = connect_active(), + + %% And there should be no stuck nodes + ?line {ok, []} = do_get_names(SockForNames), + ?line ok = close(SockForNames), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Terminate all tests with killing epmd. @@ -1200,3 +1235,12 @@ flat_count([_|T], N) -> flat_count(T, N); flat_count([], N) -> N. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> + Utf8Name = unicode:characters_to_binary(Name), + [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, + put16(HVsn), put16(LVsn), + put16(size(Utf8Name)), binary_to_list(Utf8Name), + size16(Extra), Extra]. -- cgit v1.2.3 From 5801defc866e34c6effd49b9dec995b5dac164f3 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 10 Dec 2015 16:21:59 +0100 Subject: erts: Refactor proc dict with 'usedSlots' which is same as old homeSize + splitPosition. --- erts/emulator/beam/erl_process_dict.c | 50 ++++++++++++++++++++--------------- erts/emulator/beam/erl_process_dict.h | 4 +-- 2 files changed, 31 insertions(+), 23 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 97a2828b4e..b3d7627f08 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -51,7 +51,7 @@ #define INITIAL_SIZE (erts_pd_initial_size) /* Hash utility macros */ -#define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition) +#define HASH_RANGE(PDict) ((PDict)->usedSlots) #define MAKE_HASH(Term) \ ((is_small(Term)) ? unsigned_val(Term) : \ @@ -164,9 +164,9 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd) /*PD_CHECK(pd);*/ if (pd == NULL) return; - erts_print(to, to_arg, "(size = %d, homeSize = %d, " + erts_print(to, to_arg, "(size = %d, usedSlots = %d, " "splitPosition = %d, numElements = %d)\n", - pd->size, pd->homeSize, + pd->arraySize, pd->usedSlots, pd->splitPosition, (unsigned int) pd->numElements); for (i = 0; i < HASH_RANGE(pd); ++i) { erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i)); @@ -584,8 +584,8 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) if (p->dictionary == NULL) { /* Create it */ ensure_array_size(&p->dictionary, INITIAL_SIZE); - p->dictionary->homeSize = INITIAL_SIZE; - p->dictionary->sizeMask = p->dictionary->homeSize*2 - 1; + p->dictionary->usedSlots = INITIAL_SIZE; + p->dictionary->sizeMask = INITIAL_SIZE*2 - 1; p->dictionary->splitPosition = 0; p->dictionary->numElements = 0; } @@ -737,12 +737,13 @@ static void shrink(Process *p, Eterm* ret) for (i = 0; i < steps; ++i) { if (pd->splitPosition == 0) { - pd->sizeMask = pd->homeSize - 1; - pd->homeSize /= 2; - pd->splitPosition = pd->homeSize; + ASSERT(IS_POW2(pd->usedSlots)); + pd->sizeMask = pd->usedSlots - 1; + pd->splitPosition = pd->usedSlots / 2; } --(pd->splitPosition); - hi = ARRAY_GET(pd, (pd->splitPosition + pd->homeSize)); + /* Must wait to decrement 'usedSlots' for GC rootset below */ + hi = ARRAY_GET(pd, pd->usedSlots - 1); lo = ARRAY_GET(pd, pd->splitPosition); if (hi != NIL) { if (lo == NIL) { @@ -754,7 +755,7 @@ static void shrink(Process *p, Eterm* ret) } if (HeapWordsLeft(p) < needed) { BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1)); - hi = pd->data[(pd->splitPosition + pd->homeSize)]; + hi = pd->data[pd->usedSlots - 1]; lo = pd->data[pd->splitPosition]; } #ifdef DEBUG @@ -796,7 +797,8 @@ static void shrink(Process *p, Eterm* ret) } } } - ARRAY_PUT(pd, (pd->splitPosition + pd->homeSize), NIL); + --pd->usedSlots; + ARRAY_PUT(pd, pd->usedSlots, NIL); } if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); @@ -806,7 +808,7 @@ static void shrink(Process *p, Eterm* ret) static void grow(Process *p) { unsigned int i,j; - unsigned int steps = p->dictionary->homeSize / 5; + unsigned int steps = (p->dictionary->usedSlots / 4) & 0xf; Eterm l1,l2; Eterm l; Eterm *hp; @@ -835,7 +837,7 @@ static void grow(Process *p) */ pos = pd->splitPosition; - homeSize = pd->homeSize; + homeSize = pd->usedSlots - pd->splitPosition; for (i = 0; i < steps; ++i) { if (pos == homeSize) { homeSize *= 2; @@ -860,19 +862,21 @@ static void grow(Process *p) /* * Now grow. */ - + homeSize = pd->usedSlots - pd->splitPosition; for (i = 0; i < steps; ++i) { - if (pd->splitPosition == pd->homeSize) { - pd->homeSize *= 2; - pd->sizeMask = pd->homeSize*2 - 1; + if (pd->splitPosition == homeSize) { + homeSize *= 2; + pd->sizeMask = homeSize*2 - 1; pd->splitPosition = 0; } pos = pd->splitPosition; ++pd->splitPosition; /* For the hashes */ + ++pd->usedSlots; + ASSERT(pos + homeSize == pd->usedSlots - 1); l = ARRAY_GET(pd, pos); if (is_tuple(l)) { if (pd_hash_value(pd, tuple_val(l)[1]) != pos) { - ARRAY_PUT(pd, pos + pd->homeSize, l); + ARRAY_PUT(pd, pos + homeSize, l); ARRAY_PUT(pd, pos, NIL); } } else { @@ -896,7 +900,7 @@ static void grow(Process *p) l2 = TCAR(l2); ASSERT(hp <= hp_limit); ARRAY_PUT(pd, pos, l1); - ARRAY_PUT(pd, pos + pd->homeSize, l2); + ARRAY_PUT(pd, pos + homeSize, l2); } } @@ -961,7 +965,9 @@ static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx) { Uint high; - ASSERT(IS_POW2(pdict->homeSize)); + ASSERT(IS_POW2(pdict->sizeMask+1)); + ASSERT(HASH_RANGE(pdict) >= (pdict->sizeMask >> 1)); + ASSERT(HASH_RANGE(pdict) <= (pdict->sizeMask + 1)); high = hx & pdict->sizeMask; if (high >= HASH_RANGE(pdict)) @@ -1043,12 +1049,14 @@ static void pd_check(ProcDict *pd) } else if (is_tuple(t)) { ++num; ASSERT(arityval(*tuple_val(t)) == 2); + ASSERT(pd_hash_value(pd, tuple_val(t)[1]) == i); continue; } else if (is_list(t)) { while (t != NIL) { ++num; ASSERT(is_tuple(TCAR(t))); ASSERT(arityval(*(tuple_val(TCAR(t)))) == 2); + ASSERT(pd_hash_value(pd, tuple_val(TCAR(t))[1]) == i); t = TCDR(t); } continue; @@ -1059,7 +1067,7 @@ static void pd_check(ProcDict *pd) } } ASSERT(num == pd->numElements); - ASSERT(pd->splitPosition <= pd->homeSize); + ASSERT(pd->usedSlots >= pd->splitPosition*2); } #endif /* DEBUG */ diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index fd59c969cf..f0d57da1e6 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -25,14 +25,14 @@ typedef struct proc_dict { unsigned int sizeMask; unsigned int size; - unsigned int homeSize; + unsigned int usedSlots; unsigned int splitPosition; Uint numElements; Eterm data[1]; /* The beginning of an array of erlang terms */ } ProcDict; #define ERTS_PD_START(PD) ((PD)->data) -#define ERTS_PD_SIZE(PD) ((PD)->homeSize + (PD)->splitPosition) +#define ERTS_PD_SIZE(PD) ((PD)->usedSlots) int erts_pd_set_initial_size(int size); Uint erts_dicts_mem_size(struct process *p); -- cgit v1.2.3 From 0f32d250876e7bb226fb96e07fb31734ba7d16f2 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 10 Dec 2015 17:47:37 +0100 Subject: erts: Rename proc dict size to arraySize for naming style consistency. --- erts/emulator/beam/erl_process_dict.c | 26 +++++++++++++------------- erts/emulator/beam/erl_process_dict.h | 2 +- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index b3d7627f08..e384f4c3f6 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -77,9 +77,9 @@ #define TCDR(Term) CDR(list_val(Term)) /* Array access macro */ -#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->size), \ +#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \ (PDict)->data[Index]) -#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->size), \ +#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->arraySize), \ (PDict)->data[Index] = (Val)) #define IS_POW2(X) ((X) && !((X) & ((X)-1))) @@ -221,7 +221,7 @@ erts_dicts_mem_size(Process *p) { Uint size = 0; if (p->dictionary) - size += PD_SZ2BYTES(p->dictionary->size); + size += PD_SZ2BYTES(p->dictionary->arraySize); return size; } @@ -800,7 +800,7 @@ static void shrink(Process *p, Eterm* ret) --pd->usedSlots; ARRAY_PUT(pd, pd->usedSlots, NIL); } - if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { + if (HASH_RANGE(p->dictionary) <= (p->dictionary->arraySize / 4)) { array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); } } @@ -918,16 +918,16 @@ static void array_shrink(ProcDict **ppd, unsigned int need) unsigned int siz = next_array_size(need); HDEBUGF(("array_shrink: size = %d, need = %d", - (*ppd)->size, need)); + (*ppd)->arraySize, need)); - if (siz >= (*ppd)->size) + if (siz >= (*ppd)->arraySize) return; /* Only shrink */ *ppd = PD_REALLOC(((void *) *ppd), - PD_SZ2BYTES((*ppd)->size), + PD_SZ2BYTES((*ppd)->arraySize), PD_SZ2BYTES(siz)); - (*ppd)->size = siz; + (*ppd)->arraySize = siz; } @@ -942,17 +942,17 @@ static void ensure_array_size(ProcDict **ppdict, unsigned int size) pd = PD_ALLOC(PD_SZ2BYTES(siz)); for (i = 0; i < siz; ++i) pd->data[i] = NIL; - pd->size = siz; + pd->arraySize = siz; *ppdict = pd; - } else if (size > pd->size) { - Uint osize = pd->size; + } else if (size > pd->arraySize) { + Uint osize = pd->arraySize; Uint nsize = next_array_size(size); pd = PD_REALLOC(((void *) pd), PD_SZ2BYTES(osize), PD_SZ2BYTES(nsize)); for (i = osize; i < nsize; ++i) pd->data[i] = NIL; - pd->size = nsize; + pd->arraySize = nsize; *ppdict = pd; } } @@ -1040,7 +1040,7 @@ static void pd_check(ProcDict *pd) if (pd == NULL) return; used = HASH_RANGE(pd); - ASSERT(pd->size >= used); + ASSERT(pd->arraySize >= used); ASSERT(HASH_RANGE(pd) <= MAX_HASH); for (i = 0, num = 0; i < used; ++i) { Eterm t = pd->data[i]; diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index f0d57da1e6..dac214c8a1 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -24,8 +24,8 @@ typedef struct proc_dict { unsigned int sizeMask; - unsigned int size; unsigned int usedSlots; + unsigned int arraySize; unsigned int splitPosition; Uint numElements; Eterm data[1]; /* The beginning of an array of erlang terms */ -- cgit v1.2.3 From 46a1a3b8c8819a117d7f48a864d8e0f5e08ac548 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 14 Dec 2015 20:02:54 +0100 Subject: erts: Add 'fill_heap' to erts_debug:state_internal_state to make it easy to provoke GC inside/after a BIF or instruction. --- erts/emulator/beam/erl_bif_info.c | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index b44382cde8..caa1cb7608 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -4085,6 +4085,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_ok); } } + else if (ERTS_IS_ATOM_STR("fill_heap", BIF_ARG_1)) { + UWord left = HeapWordsLeft(BIF_P); + if (left > 1) { + Eterm* hp = HAlloc(BIF_P, left); + *hp = make_pos_bignum_header(left - 1); + } + if (BIF_ARG_2 == am_true) { + FLAGS(BIF_P) |= F_NEED_FULLSWEEP; + } + BIF_RET(am_ok); + } } BIF_ERROR(BIF_P, BADARG); -- cgit v1.2.3 From 5db3a62f821413f267427b2bc38045324c57aaf6 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 14 Dec 2015 20:15:12 +0100 Subject: erts: Add new test case pdict_SUITE:mixed --- lib/kernel/test/pdict_SUITE.erl | 61 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 60 insertions(+), 1 deletion(-) diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl index 6de4ff9f77..b096296fa1 100644 --- a/lib/kernel/test/pdict_SUITE.erl +++ b/lib/kernel/test/pdict_SUITE.erl @@ -32,6 +32,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, + mixed/1, simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]). -export([init_per_testcase/2, end_per_testcase/2]). -export([other_process/2]). @@ -47,7 +48,8 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [simple, complicated, heavy, simple_all_keys, info]. + [simple, complicated, heavy, simple_all_keys, info, + mixed]. groups() -> []. @@ -369,3 +371,60 @@ match_keys(All) -> Ks = lists:sort([K||{K,_}<-All]), Ks = lists:sort(erlang:get_keys()), ok. + + +%% Do random mixed put/erase to test grow/shrink +%% Written for a temporary bug in gc during shrink +mixed(_Config) -> + Rand0 = rand:seed_s(exsplus), + io:format("Random seed = ~p\n\n", [rand:export_seed_s(Rand0)]), + + erts_debug:set_internal_state(available_internal_state, true), + try + C = do_mixed([10,0,100,50,1000,500,600,100,150,1,11,2,30,0], + 0, + array:new(), + 1, + Rand0), + io:format("\nDid total of ~p operations\n", [C]) + after + erts_debug:set_internal_state(available_internal_state, false) + end. + +do_mixed([], _, _, C, _) -> + C; +do_mixed([GoalN | Tail], GoalN, Array, C, Rand0) -> + io:format("Reached goal of ~p keys in dict after ~p mixed ops\n",[GoalN, C]), + GoalN = array:size(Array), + do_mixed(Tail, GoalN, Array, C, Rand0); +do_mixed([GoalN | _]=Goals, CurrN, Array0, C, Rand0) -> + CurrN = array:size(Array0), + GrowPercent = case GoalN > CurrN of + true when CurrN == 0 -> 100; + true -> 75; + false -> 25 + end, + {R, Rand1} = rand:uniform_s(100, Rand0), + case R of + _ when R =< GrowPercent -> %%%%%%%%%%%%% GROW + {Key, Rand2} = rand:uniform_s(10000, Rand1), + case put(Key, {Key,C}) of + undefined -> + Array1 = array:set(CurrN, Key, Array0), + do_mixed(Goals, CurrN+1, Array1, C+1, Rand2); + _ -> + do_mixed(Goals, CurrN, Array0, C+1, Rand2) + end; + + _ -> %%%%%%%%%% SHRINK + {Kix, Rand2} = rand:uniform_s(CurrN, Rand1), + Key = array:get(Kix-1, Array0), + + %% provoke GC during shrink + erts_debug:set_internal_state(fill_heap, true), + + {Key, _} = erase(Key), + Array1 = array:set(Kix-1, array:get(CurrN-1, Array0), Array0), + Array2 = array:resize(CurrN-1, Array1), + do_mixed(Goals, CurrN-1, Array2, C+1, Rand2) + end. -- cgit v1.2.3 From 1a101efd5654d3d4a3e96523fbbf4eb871e61d1b Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 15 Dec 2015 18:08:41 +0100 Subject: erts: Fix bug in check_process_code for literals --- erts/emulator/beam/beam_bif_load.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index c925a8c812..956454d9b3 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -826,6 +826,9 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); + literals = (char*) modp->old.code_hdr->literals_start; + lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; + for (msgp = rp->msg.first; msgp; msgp = msgp->next) { if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) hfrag = &msgp->hfrag; @@ -839,14 +842,11 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) /* Should not contain any constants... */ ASSERT(!any_heap_refs(&hfrag->mem[0], &hfrag->mem[hfrag->used_size], - mod_start, - mod_size)); + literals, + lit_bsize)); } } - literals = (char*) modp->old.code_hdr->literals_start; - lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; - while (1) { /* Check heap, stack etc... */ @@ -881,7 +881,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; - if (any_heap_refs(hp, hp_end, mod_start, lit_bsize)) + if (any_heap_refs(hp, hp_end, literals, lit_bsize)) goto try_literal_gc; } @@ -902,7 +902,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) hp = &hfrag->mem[0]; hp_end = &hfrag->mem[hfrag->used_size]; - ASSERT(!any_heap_refs(hp, hp_end, mod_start, lit_bsize)); + ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize)); } } -- cgit v1.2.3 From 3685711811a2d3452d0a55d6872d5dfb705b1933 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 15 Dec 2015 15:26:45 +0100 Subject: ssl: Convert all test to use "ssl_test_lib:portable_open_port" --- lib/ssl/test/ssl_to_openssl_SUITE.erl | 123 +++++++++++++++++----------------- 1 file changed, 61 insertions(+), 62 deletions(-) diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 119baf1072..57acbb94cf 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -753,11 +753,9 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> "-CAfile", CaCertFile, "-key", KeyFile,"-connect", "localhost:" ++ integer_to_list(Port), ssl_test_lib:version_flag(Version)], - OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), - true = port_command(OpenSslPort, Data), - + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), %% Clean close down! Server needs to be closed first !! @@ -841,7 +839,6 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-cert", CertFile, "-key", KeyFile], - OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1003,7 +1000,7 @@ erlang_client_alpn_openssl_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [{alpn_advertised_protocols, [<<"spdy/2">>]}], - "", + [], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1016,7 +1013,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [], - "-alpn spdy/2", + ["-alpn", "spdy/2"], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1153,7 +1150,7 @@ erlang_server_openssl_client_npn_renegotiate(Config) when is_list(Config) -> erlang_client_openssl_server_npn_only_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [], - "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> + ["-nextprotoneg", "spdy/2"], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), @@ -1165,7 +1162,7 @@ erlang_client_openssl_server_npn_only_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [{client_preferred_next_protocols, - {client, [<<"spdy/2">>], <<"http/1.1">>}}], "", + {client, [<<"spdy/2">>], <<"http/1.1">>}}], [], Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) @@ -1276,14 +1273,14 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, {options, ServerOptions}]), Port = ssl_test_lib:inet_port(Server), - ClientCommand = case SNIHostname of + Exe = "openssl", + ClientArgs = case SNIHostname of undefined -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; _ -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname - end, - ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), - ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), "-servername", SNIHostname] + end, + ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), %% Client check needs to be done befor server check, %% or server check might consume client messages @@ -1305,14 +1302,14 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo {from, self()}, {mfa, {?MODULE, send_and_hostname, []}}, {options, ServerOptions}]), Port = ssl_test_lib:inet_port(Server), - ClientCommand = case SNIHostname of + Exe = "openssl", + ClientArgs = case SNIHostname of undefined -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port); + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; _ -> - "openssl s_client -connect " ++ Hostname ++ ":" ++ integer_to_list(Port) ++ " -servername " ++ SNIHostname + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), "-servername", SNIHostname] end, - ct:log("Options: ~p", [[ServerOptions, ClientCommand]]), - ClientPort = open_port({spawn, ClientCommand}, [stderr_to_stdout]), + ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), %% Client check needs to be done befor server check, %% or server check might consume client messages @@ -1332,12 +1329,11 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", - - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1395,13 +1391,19 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++ - integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + Exe = "openssl", + Args = case OpensslServerOpts of + [] -> + ["s_server", "-accept", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile,"-key", KeyFile]; + [Opt, Value] -> + ["s_server", Opt, Value, "-accept", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile,"-key", KeyFile] + end, + + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1435,13 +1437,10 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - + Exe = "openssl", + Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key" ++ KeyFile], + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -1473,12 +1472,13 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -alpn http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -host localhost", - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_client", "-alpn", "http/1.0,spdy/2" "-msg" "-port", + integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-host", "localhost"], - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), Callback(Server, OpenSslPort), @@ -1503,12 +1503,12 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), + Exe = "openssl", + Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", + "spdy/3", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-cert" ++ CertFile ++ "-key" ++ KeyFile], - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1542,17 +1542,15 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -host localhost", - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + Exe = "openssl", + Args = ["s_client", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", "spdy/3", + "-msg", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-host", "localhost"], + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), Callback(Server, OpenSslPort), ssl_test_lib:close(Server), - ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1570,13 +1568,12 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - - Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ CertFile ++ " -key " ++ KeyFile, - - ct:log("openssl cmd: ~p~n", [Cmd]), - - OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Exe = "openssl", + Args = ["s_server", "-msg", "-nextprotoneg", "http/1.1,spdy/2", "-accept", integer_to_list(Port), + ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile], + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1759,7 +1756,9 @@ check_sane_openssl_renegotaite(Config) -> end. check_sane_openssl_sslv2(Config) -> - Port = open_port({spawn, "openssl s_client -ssl2 "}, [stderr_to_stdout]), + Exe = "openssl", + Args = ["s_client", "-ssl2"], + Port = ssl_test_lib:portable_open_port(Exe, Args), case supports_sslv2(Port) of true -> Config; -- cgit v1.2.3 From 6b60ed6d30dccaeab1207178d5e786aaa14b3201 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 16 Dec 2015 11:14:40 +0100 Subject: Fix offset_mqueue --- erts/emulator/beam/erl_gc.c | 48 ++++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index b63567e563..e182782323 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -2773,33 +2773,37 @@ offset_mqueue(Process *p, Sint offs, char* area, Uint area_size) { ErtsMessage* mp = p->msg.first; - while (mp != NULL) { - Eterm mesg = ERL_MESSAGE_TERM(mp); - if (is_value(mesg)) { - switch (primary_tag(mesg)) { - case TAG_PRIMARY_LIST: - case TAG_PRIMARY_BOXED: - if (ErtsInArea(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs); + if ((p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) != F_OFF_HEAP_MSGQ) { + + while (mp != NULL) { + Eterm mesg = ERL_MESSAGE_TERM(mp); + if (is_value(mesg)) { + switch (primary_tag(mesg)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs); + } + break; } - break; } - } - mesg = ERL_MESSAGE_TOKEN(mp); - if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs); - } + mesg = ERL_MESSAGE_TOKEN(mp); + if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs); + } #ifdef USE_VM_PROBES - mesg = ERL_MESSAGE_DT_UTAG(mp); - if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs); - } + mesg = ERL_MESSAGE_DT_UTAG(mp); + if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs); + } #endif - ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) || - is_tuple(ERL_MESSAGE_TOKEN(mp)) || - is_atom(ERL_MESSAGE_TOKEN(mp)))); - mp = mp->next; + ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) || + is_tuple(ERL_MESSAGE_TOKEN(mp)) || + is_atom(ERL_MESSAGE_TOKEN(mp)))); + mp = mp->next; + } + } } -- cgit v1.2.3 From 568cd49812ff0b59b0b8f1ebfc2da588f78d55a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Dec 2015 12:45:05 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 56060 -> 56052 bytes erts/preloaded/ebin/erlang.beam | Bin 34396 -> 102012 bytes erts/preloaded/ebin/erts_internal.beam | Bin 2032 -> 6260 bytes erts/preloaded/ebin/init.beam | Bin 48600 -> 48592 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1460 -> 1452 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1332 -> 1324 bytes erts/preloaded/ebin/prim_file.beam | Bin 44788 -> 44780 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72624 -> 72612 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23296 -> 23284 bytes erts/preloaded/ebin/zlib.beam | Bin 14168 -> 14160 bytes 10 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index e94a1ba796..8ccbd1e36b 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 6610800458..87a48525bb 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index fcc8c85e52..191dd332e2 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index 60c08819eb..a78d9abc20 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index 04814c091b..9cc91be343 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index 7779c8374d..e84c8ffd2d 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index 254b0e5b90..e1b2a1c8eb 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index b7cfe26462..8853ae8bda 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 6b5c6195c8..563e604a1d 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 43d7b436be..304783ae37 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From 27b921fef54b7410efdf756d6ad20ce2877fbc6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 8 Oct 2015 14:11:07 +0200 Subject: Clean up parsing and lookup of flags The handling of flags has been incrementally messed up over time, leading to convoluted code. Rewrite the parsing and lookup of flags. By using the appropriate data structures, the code will become simpler. --- erts/preloaded/src/init.erl | 98 ++++++++++++++++----------------------------- 1 file changed, 34 insertions(+), 64 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 0ad5824ad1..b166aba81d 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -169,8 +169,7 @@ boot(BootArgs) -> process_flag(trap_exit, true), {Start0,Flags,Args} = parse_boot_args(BootArgs), Start = map(fun prepare_run_args/1, Start0), - Flags0 = flags_to_atoms_again(Flags), - boot(Start,Flags0,Args). + boot(Start, Flags, Args). prepare_run_args({eval, [Expr]}) -> {eval,Expr}; @@ -202,16 +201,6 @@ map(_F, []) -> map(F, [X|Rest]) -> [F(X) | map(F, Rest)]. -flags_to_atoms_again([]) -> - []; -flags_to_atoms_again([{F0,L0}|Rest]) -> - L = L0, - F = b2a(F0), - [{F,L}|flags_to_atoms_again(Rest)]; -flags_to_atoms_again([{F0}|Rest]) -> - F = b2a(F0), - [{F}|flags_to_atoms_again(Rest)]. - -spec code_path_choice() -> 'relaxed' | 'strict'. code_path_choice() -> case get_argument(code_path_choice) of @@ -451,9 +440,9 @@ do_handle_msg(Msg,State) -> %%% ------------------------------------------------- make_permanent(Boot,Config,Flags0,State) -> - case set_flag('-boot',Boot,Flags0) of + case set_flag(boot, Boot, Flags0) of {ok,Flags1} -> - case set_flag('-config',Config,Flags1) of + case set_flag(config, Config, Flags1) of {ok,Flags} -> {ok,State#state{flags = Flags}}; Error -> @@ -716,10 +705,10 @@ add_to_kernel(Init,Pid) -> end. prim_load_flags(Flags) -> - PortPgm = get_flag('-loader',Flags,<<"efile">>), - Hosts = get_flag_list('-hosts', Flags, []), - Id = get_flag('-id',Flags,none), - Path = get_flag_list('-path',Flags,false), + PortPgm = get_flag(loader, Flags, <<"efile">>), + Hosts = get_flag_list(hosts, Flags, []), + Id = get_flag(id, Flags, none), + Path = get_flag_list(path, Flags, false), {PortPgm, Hosts, Id, Path}. %%% ------------------------------------------------- @@ -735,17 +724,17 @@ do_boot(Flags,Start) -> do_boot(Init,Flags,Start) -> process_flag(trap_exit,true), {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), - Root = b2s(get_flag('-root',Flags)), + Root = b2s(get_flag(root, Flags)), PathFls = path_flags(Flags), Pgm = b2s(Pgm0), _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), bs2ss(Path),PathFls), BootFile = bootfile(Flags,Root), BootList = get_boot(BootFile,Root), - LoadMode = b2a(get_flag('-mode',Flags,false)), - Deb = b2a(get_flag('-init_debug',Flags,false)), + LoadMode = b2a(get_flag(mode, Flags, false)), + Deb = b2a(get_flag(init_debug, Flags, false)), catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb}, - BootVars = get_flag_args('-boot_var',Flags), + BootVars = get_flag_args(boot_var, Flags), ParallelLoad = (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), @@ -760,11 +749,11 @@ do_boot(Init,Flags,Start) -> start_em(Start). bootfile(Flags,Root) -> - b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))). + b2s(get_flag(boot, Flags, concat([Root,"/bin/start"]))). path_flags(Flags) -> - Pa = append(reverse(get_flag_args('-pa',Flags))), - Pz = append(get_flag_args('-pz',Flags)), + Pa = append(reverse(get_flag_args(pa, Flags))), + Pz = append(get_flag_args(pz, Flags)), {bs2ss(Pa),bs2ss(Pz)}. get_boot(BootFile0,Root) -> @@ -1102,7 +1091,7 @@ load_mod_code(Mod, BinCode, FullName) -> %% -------------------------------------------------------- shutdown_timer(Flags) -> - case get_flag('-shutdown_time',Flags,infinity) of + case get_flag(shutdown_time, Flags, infinity) of infinity -> self(); Time -> @@ -1152,14 +1141,10 @@ parse_boot_args([B|Bs], Ss, Fs, As) -> eval_arg -> {Expr,Rest} = get_args(Bs, []), parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As); - flag -> + {flag,A} -> {F,Rest} = get_args(Bs, []), - Fl = case F of - [] -> [B]; - FF -> [B,FF] - end, - parse_boot_args(Rest, Ss, - [list_to_tuple(Fl)|Fs], As); + Fl = {A,F}, + parse_boot_args(Rest, Ss, [Fl|Fs], As); arg -> parse_boot_args(Bs, Ss, Fs, [B|As]); end_args -> @@ -1173,12 +1158,8 @@ check(<<"-s">>) -> start_arg; check(<<"-run">>) -> start_arg2; check(<<"-eval">>) -> eval_arg; check(<<"--">>) -> end_args; -check(X) when is_binary(X) -> - case binary_to_list(X) of - [$-|_Rest] -> flag; - _Chars -> arg %Even empty atoms - end; -check(_X) -> arg. %This should never occur +check(<<"-",Flag/binary>>) -> {flag,b2a(Flag)}; +check(_) -> arg. get_args([B|Bs], As) -> case check(B) of @@ -1187,7 +1168,7 @@ get_args([B|Bs], As) -> start_arg2 -> {reverse(As), [B|Bs]}; eval_arg -> {reverse(As), [B|Bs]}; end_args -> {reverse(As), Bs}; - flag -> {reverse(As), [B|Bs]}; + {flag,_} -> {reverse(As), [B|Bs]}; arg -> get_args(Bs, [B|As]) end; @@ -1209,12 +1190,12 @@ get_flag(F,Flags,Default) -> get_flag(F,Flags) -> case search(F,Flags) of + {value,{F,[]}} -> + true; {value,{F,[V]}} -> V; {value,{F,V}} -> V; - {value,{F}} -> % Flag given! - true; _ -> exit(list_to_atom(concat(["no ",F," flag"]))) end. @@ -1246,21 +1227,15 @@ get_flag_list(F,Flags) -> %% get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]). -get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) -> - get_flag_args(F,Flags,[V|Acc]); get_flag_args(F,[{F,V}|Flags],Acc) -> - get_flag_args(F,Flags,[[V]|Acc]); + get_flag_args(F,Flags,[V|Acc]); get_flag_args(F,[_|Flags],Acc) -> get_flag_args(F,Flags,Acc); get_flag_args(_,[],Acc) -> reverse(Acc). get_arguments([{F,V}|Flags]) -> - [$-|Fl] = atom_to_list(F), - [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)]; -get_arguments([{F}|Flags]) -> - [$-|Fl] = atom_to_list(F), - [{list_to_atom(Fl),[]}|get_arguments(Flags)]; + [{F,to_strings(V)}|get_arguments(Flags)]; get_arguments([]) -> []. @@ -1268,26 +1243,21 @@ to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)]; to_strings([H|T]) when is_binary(H) -> [b2s(H)|to_strings(T)]; to_strings([]) -> []. -get_argument(Arg,Flags) -> - Args = get_arguments(Flags), - case get_argument1(Arg,Args) of - [] -> - error; - Value -> - {ok,Value} +get_argument(Arg, Flags) -> + case get_argument1(Arg, Flags) of + [] -> error; + Value -> {ok,Value} end. -get_argument1(Arg,[{Arg,V}|Args]) -> - [V|get_argument1(Arg,Args)]; -get_argument1(Arg,[_|Args]) -> - get_argument1(Arg,Args); -get_argument1(_,[]) -> +get_argument1(Arg, [{Arg,V}|Args]) -> + [to_strings(V)|get_argument1(Arg, Args)]; +get_argument1(Arg, [_|Args]) -> + get_argument1(Arg, Args); +get_argument1(_, []) -> []. set_argument([{Flag,_}|Flags],Flag,Value) -> [{Flag,[Value]}|Flags]; -set_argument([{Flag}|Flags],Flag,Value) -> - [{Flag,[Value]}|Flags]; set_argument([Item|Flags],Flag,Value) -> [Item|set_argument(Flags,Flag,Value)]; set_argument([],Flag,Value) -> -- cgit v1.2.3 From e1dc0aa4100f881f4350162bd523c53d38f08b8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 12 Oct 2015 15:14:14 +0200 Subject: Simplify get_flag() and get_flag_list() The get_flag/3 function which returns a default value if the flag doesn't exist, is implemented in terms of get_flag/2 which throws an exception if the flag doesn't exist. get_flag/3 is frequently used for the flags that don't exist, which means that means that an exception will be generated and catched for no good reason. Reimplement get_flag/3 so that it doesn't have to call get_flag/2 and catch an exception. Eliminate the get_flag/2 function by writing a special purpose function for the only time it's used, that is for retrieving the value for the -root flag. As a side-effect, we will get a nicer error message if there is something wrong with the -root flag. Similarly, simplify get_flag_list/3 and remove get_flag_list/2. We can also eliminate search/3 and use the lists:keyfind/3 BIF instead. --- erts/preloaded/src/init.erl | 53 ++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 34 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index b166aba81d..a85b41fddb 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -724,7 +724,7 @@ do_boot(Flags,Start) -> do_boot(Init,Flags,Start) -> process_flag(trap_exit,true), {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), - Root = b2s(get_flag(root, Flags)), + Root = get_root(Flags), PathFls = path_flags(Flags), Pgm = b2s(Pgm0), _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), @@ -748,6 +748,14 @@ do_boot(Init,Flags,Start) -> start_em(Start). +get_root(Flags) -> + case get_argument(root, Flags) of + {ok,[[Root]]} -> + Root; + _ -> + exit(no_or_multiple_root_variables) + end. + bootfile(Flags,Root) -> b2s(get_flag(boot, Flags, concat([Root,"/bin/start"]))). @@ -1180,44 +1188,28 @@ get_args([], As) -> {reverse(As),[]}. %% atom() if a single arg was given. %% list(atom()) if several args were given. %% -get_flag(F,Flags,Default) -> - case catch get_flag(F,Flags) of - {'EXIT',_} -> - Default; - Value -> - Value - end. - -get_flag(F,Flags) -> - case search(F,Flags) of - {value,{F,[]}} -> +get_flag(F, Flags, Default) -> + case lists:keyfind(F, 1, Flags) of + {F,[]} -> true; - {value,{F,[V]}} -> + {F,[V]} -> V; - {value,{F,V}} -> + {F,V} -> V; _ -> - exit(list_to_atom(concat(["no ",F," flag"]))) + Default end. %% %% Internal get_flag function, with default value. %% Return: list(atom()) %% -get_flag_list(F,Flags,Default) -> - case catch get_flag_list(F,Flags) of - {'EXIT',_} -> - Default; - Value -> - Value - end. - -get_flag_list(F,Flags) -> - case search(F,Flags) of - {value,{F,V}} -> +get_flag_list(F, Flags, Default) -> + case lists:keyfind(F, 1, Flags) of + {F,[_|_]=V} -> V; _ -> - exit(list_to_atom(concat(["no ",F," flag"]))) + Default end. %% @@ -1290,13 +1282,6 @@ reverse([A, B]) -> reverse([A, B | L]) -> lists:reverse(L, [B, A]). % BIF -search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key -> - {value, H}; -search(Key, [_|T]) -> - search(Key, T); -search(_Key, []) -> - false. - -spec objfile_extension() -> nonempty_string(). objfile_extension() -> ".beam". -- cgit v1.2.3 From 93f7c2dcdd36a31dca6bfd06e0784ed715e51f77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 12 Oct 2015 15:56:35 +0200 Subject: Remove useless 'catch' in start_it/1 The last clause in start_it/1 calls a function in some module. It goes to great length to catch any exception and pass them on unchanged, and if there was a normal return, it will just return the return value. It can been seen that the entire 'catch' construction with the reference trick is totally unnecessary. --- erts/preloaded/src/init.erl | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index a85b41fddb..c1c0e781e7 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -1046,18 +1046,10 @@ start_it({eval,Bin}) -> {value, _Value, _Bs} = erl_eval:exprs(Expr, erl_eval:new_bindings()), ok; start_it([_|_]=MFA) -> - Ref = make_ref(), - case catch {Ref,case MFA of - [M] -> M:start(); - [M,F] -> M:F(); - [M,F|Args] -> M:F(Args) % Args is a list - end} of - {Ref,R} -> - R; - {'EXIT',Reason} -> - exit(Reason); - Other -> - throw(Other) + case MFA of + [M] -> M:start(); + [M,F] -> M:F(); + [M,F|Args] -> M:F(Args) % Args is a list end. %% -- cgit v1.2.3 From af888f46b08c354021724ca76029930d3baf2e2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 13 Oct 2015 14:05:16 +0200 Subject: init_SUITE: Correct the test for a "real system" --- lib/kernel/test/init_SUITE.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 54ab5aa566..3fe618ea4c 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -307,8 +307,8 @@ create_boot(Config) -> is_real_system(KernelVsn, StdlibVsn) -> LibDir = code:lib_dir(), - filelib:is_dir(filename:join(LibDir, "kernel"++KernelVsn)) andalso - filelib:is_dir(filename:join(LibDir, "stdlib"++StdlibVsn)). + filelib:is_dir(filename:join(LibDir, "kernel-"++KernelVsn)) andalso + filelib:is_dir(filename:join(LibDir, "stdlib-"++StdlibVsn)). %% ------------------------------------------------ %% Slave executes erlang:halt() on master nodedown. -- cgit v1.2.3 From 4551a14515a57b9aabaa95b729ac546c91ff71f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 13 Oct 2015 10:10:25 +0200 Subject: Clean up handling of boot_vars Expansion of $ROOT in paths are handled specially compared to boot variables. There is no reason $ROOT can't be handled as a boot variable. We can simplify the expansion of boot variables if we spend a little extra effort upfront collecting all boot variables into a map. Make the error checking for -boot_var arguments stricter. Only allow -boot_var followed by exactly two arguments to help users catch errors earlier. --- erts/preloaded/src/init.erl | 53 +++++++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index c1c0e781e7..730aac9902 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -734,12 +734,12 @@ do_boot(Init,Flags,Start) -> LoadMode = b2a(get_flag(mode, Flags, false)), Deb = b2a(get_flag(init_debug, Flags, false)), catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb}, - BootVars = get_flag_args(boot_var, Flags), + BootVars = get_boot_vars(Root, Flags), ParallelLoad = (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), PathChoice = code_path_choice(), - eval_script(BootList,Init,PathFls,{Root,BootVars},Path, + eval_script(BootList,Init,PathFls,BootVars,Path, {true,LoadMode,ParallelLoad},Deb,PathChoice), %% To help identifying Purify windows that pop up, @@ -756,6 +756,20 @@ get_root(Flags) -> exit(no_or_multiple_root_variables) end. +get_boot_vars(Root, Flags) -> + BootVars = get_boot_vars_1(#{}, Flags), + RootKey = <<"ROOT">>, + BootVars#{RootKey=>Root}. + +get_boot_vars_1(Vars, [{boot_var,[Key,Value]}|T]) -> + get_boot_vars_1(Vars#{Key=>Value}, T); +get_boot_vars_1(_, [{boot_var,_}|_]) -> + exit(invalid_boot_var_argument); +get_boot_vars_1(Vars, [_|T]) -> + get_boot_vars_1(Vars, T); +get_boot_vars_1(Vars, []) -> + Vars. + bootfile(Flags,Root) -> b2s(get_flag(boot, Flags, concat([Root,"/bin/start"]))). @@ -905,34 +919,25 @@ fix_path([Path|Ps], Vars) -> fix_path(_, _) -> []. -add_var("$ROOT/" ++ Path, {Root,_}) -> - concat([Root, "/", Path]); -add_var([$$|Path0], {_,VarList}) -> - {Var,Path} = extract_var(Path0,[]), - Value = b2s(get_var_value(list_to_binary(Var),VarList)), - concat([Value, "/", Path]); -add_var(Path, _) -> +add_var("$"++Path0, Vars) -> + {Var,Path} = extract_var(Path0, []), + Key = list_to_binary(Var), + case Vars of + #{Key:=Value0} -> + Value = b2s(Value0), + Value ++ "/" ++ Path; + _ -> + Error0 = "cannot expand $" ++ Var ++ " in bootfile", + Error = list_to_atom(Error0), + exit(Error) + end; +add_var(Path, _) -> Path. extract_var([$/|Path],Var) -> {reverse(Var),Path}; extract_var([H|T],Var) -> extract_var(T,[H|Var]); extract_var([],Var) -> {reverse(Var),[]}. -%% get_var_value(Var, [Vars]) where Vars == [atom()] -get_var_value(Var,[Vars|VarList]) -> - case get_var_val(Var,Vars) of - {ok, Value} -> - Value; - _ -> - get_var_value(Var,VarList) - end; -get_var_value(Var,[]) -> - exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))). - -get_var_val(Var,[Var,Value|_]) -> {ok, Value}; -get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars); -get_var_val(_,_) -> false. - patch_path(Dirs, strict) -> Dirs; patch_path(Dirs, relaxed) -> -- cgit v1.2.3 From 657a1be6b54e9baaf8d2c7a28ac261b4086148dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 13 Oct 2015 15:53:39 +0200 Subject: Reduce the ludicrous number of arguments for eval_script() The compact wall of arguments makes it hard to see what is actually happening in eval_script(). Collect the arguments into a record. --- erts/preloaded/src/init.erl | 100 +++++++++++++++++++++++++++----------------- 1 file changed, 61 insertions(+), 39 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 730aac9902..cc30999ba5 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -75,6 +75,20 @@ subscribed = []}). -type state() :: #state{}. +%% Data for eval_script/2. +-record(es, + {init, + debug, + path, + pa, + pz, + path_choice, + prim_load, + load_mode, + par_load, + vars + }). + -define(ON_LOAD_HANDLER, init__boot__on_load_handler). debug(false, _) -> ok; @@ -725,7 +739,7 @@ do_boot(Init,Flags,Start) -> process_flag(trap_exit,true), {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), Root = get_root(Flags), - PathFls = path_flags(Flags), + {Pa,Pz} = PathFls = path_flags(Flags), Pgm = b2s(Pgm0), _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), bs2ss(Path),PathFls), @@ -735,12 +749,15 @@ do_boot(Init,Flags,Start) -> Deb = b2a(get_flag(init_debug, Flags, false)), catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb}, BootVars = get_boot_vars(Root, Flags), - ParallelLoad = - (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), + ParLoad = Pgm =:= "efile" andalso + erlang:system_info(thread_pool_size) > 0, PathChoice = code_path_choice(), - eval_script(BootList,Init,PathFls,BootVars,Path, - {true,LoadMode,ParallelLoad},Deb,PathChoice), + Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz, + path_choice=PathChoice, + prim_load=true,load_mode=LoadMode,par_load=ParLoad, + vars=BootVars}, + eval_script(BootList, Es), %% To help identifying Purify windows that pop up, %% print the node name into the Purify log. @@ -818,48 +835,53 @@ get_boot(BootFile) -> %% boot process hangs (we want to ensure syncronicity). %% -eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{progress,Info}), +eval_script([{progress,Info}=Progress|T], #es{debug=Deb}=Es) -> + debug(Deb, Progress), init ! {self(),progress,Info}, - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) -> + eval_script(T, Es); +eval_script([{preLoaded,_}|T], #es{}=Es) -> + eval_script(T, Es); +eval_script([{path,Path}|T], #es{path=false,pa=Pa,pz=Pz, + path_choice=PathChoice, + vars=Vars}=Es) -> RealPath0 = make_path(Pa, Pz, Path, Vars), RealPath = patch_path(RealPath0, PathChoice), erl_prim_loader:set_path(RealPath), - eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice); -eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + eval_script(T, Es); +eval_script([{path,_}|T], #es{}=Es) -> %% Ignore, use the command line -path flag. - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice); -eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); -eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice) + eval_script(T, Es); +eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) -> + Es = case Mode of + embedded -> Es0; + _ -> Es0#es{prim_load=false} + end, + eval_script(T, Es); +eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad, + par_load=Par}=Es) when is_list(Mods) -> - if - Par =:= true -> - par_load_modules(Mods,Init); - true -> - load_modules(Mods) + case {PrimLoad,Par} of + {true,true} -> + par_load_modules(Mods, Init); + {true,false} -> + load_modules(Mods); + {false,_} -> + %% Do not load now, code_server does that dynamically! + ok end, - eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice); -eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) -> - %% Do not load now, code_server does that dynamically! - eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); -eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init, - PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{start,Server}), - start_in_kernel(Server,Mod,Fun,Args,Init), - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{apply,{Mod,Fun,Args}}), - apply(Mod,Fun,Args), - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([],_,_,_,_,_,_,_) -> + eval_script(T, Es); +eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|T], + #es{init=Init,debug=Deb}=Es) -> + debug(Deb, {start,Server}), + start_in_kernel(Server, Mod, Fun, Args, Init), + eval_script(T, Es); +eval_script([{apply,{Mod,Fun,Args}}=Apply|T], #es{debug=Deb}=Es) -> + debug(Deb, Apply), + apply(Mod, Fun, Args), + eval_script(T, Es); +eval_script([], #es{}) -> ok; -eval_script(What,_,_,_,_,_,_,_) -> +eval_script(What, #es{}) -> exit({'unexpected command in bootfile',What}). load_modules([Mod|Mods]) -> -- cgit v1.2.3 From ca72f6a938201d71baf25eeba649d7ec33628c94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 18 Nov 2015 16:11:06 +0100 Subject: prim_file: Suppress a dialyzer warning Kostis Sagonas pointed out that there is a dialyzer warning for constructing an improper list in the following clause: translate_response(?FILE_RESP_N2DATA = X, [<<_:64, _:64, _:64>> | <<>>] = Data) -> {error, {bad_response_from_port, [X | Data]}}; I don't want to change the code to somehow eliminate the warning. An improper list has already been constructed in the efile driver itself, and that would be difficult to fix. Therefore, tell dialyzer to ignore warnings for improper lists in translate_response/2. --- erts/preloaded/src/prim_file.erl | 1 + 1 file changed, 1 insertion(+) diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index c87b2645ec..2eb1b1d408 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -1276,6 +1276,7 @@ lseek_position(_) -> %% Translates the response from the driver into %% {ok, Result} or {error, Reason}. +-dialyzer({no_improper_lists, translate_response/2}). translate_response(?FILE_RESP_OK, []) -> ok; translate_response(?FILE_RESP_ERROR, List) when is_list(List) -> -- cgit v1.2.3 From afcec4ab26ef5d9d202810ed6fd8661b3b3ddfcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 15 Dec 2015 09:13:34 +0100 Subject: erl_prim_loader: Break loop/3 into two functions for readability The deep indentation makes loop/3 difficult to read and maintain. Break out the request handling code into a separate function. --- erts/preloaded/src/erl_prim_loader.erl | 102 +++++++++++++++------------------ 1 file changed, 46 insertions(+), 56 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 9f6cba33bd..d19de63b65 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -310,69 +310,59 @@ check_file_result(_, _, Other) -> %%% The main loop. %%% -------------------------------------------------------- -loop(State, Parent, Paths) -> +loop(St0, Parent, Paths) -> receive + {Pid,{set_path,NewPaths}} when is_pid(Pid) -> + Pid ! {self(),ok}, + loop(St0, Parent, to_strs(NewPaths)); {Pid,Req} when is_pid(Pid) -> - %% erlang:display(Req), - {Resp,State2,Paths2} = - case Req of - {set_path,NewPaths} -> - {ok,State,to_strs(NewPaths)}; - {get_path,_} -> - {{ok,Paths},State,Paths}; - {get_file,File} -> - {Res,State1} = handle_get_file(State, Paths, File), - {Res,State1,Paths}; - {get_files,{ModFiles,Fun}} -> - {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun), - {Res,State1,Paths}; - {list_dir,Dir} -> - {Res,State1} = handle_list_dir(State, Dir), - {Res,State1,Paths}; - {read_file_info,File} -> - {Res,State1} = handle_read_file_info(State, File), - {Res,State1,Paths}; - {read_link_info,File} -> - {Res,State1} = handle_read_link_info(State, File), - {Res,State1,Paths}; - {get_cwd,[]} -> - {Res,State1} = handle_get_cwd(State, []), - {Res,State1,Paths}; - {get_cwd,[_]=Args} -> - {Res,State1} = handle_get_cwd(State, Args), - {Res,State1,Paths}; - {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> - {Res,State1} = - handle_set_primary_archive(State, File, - ArchiveBin, FileInfo, - ParserFun), - {Res,State1,Paths}; - release_archives -> - {Res,State1} = handle_release_archives(State), - {Res,State1,Paths}; - _Other -> - {ignore,State,Paths} - end, - if Resp =:= ignore -> ok; - true -> Pid ! {self(),Resp}, ok - end, - if - is_record(State2, state) -> - loop(State2, Parent, Paths2); - true -> - exit({bad_state, Req, State2}) + case handle_request(Req, Paths, St0) of + ignore -> + ok; + {Resp,#state{}=St1} -> + Pid ! {self(),Resp}, + loop(St1, Parent, Paths); + {_,State2,_} -> + exit({bad_state,Req,State2}) end; {'EXIT',Parent,W} -> - _State1 = handle_stop(State), + _ = handle_stop(St0), exit(W); {'EXIT',P,W} -> - State1 = handle_exit(State, P, W), - loop(State1, Parent, Paths); + St1 = handle_exit(St0, P, W), + loop(St1, Parent, Paths); _Message -> - loop(State, Parent, Paths) - after State#state.timeout -> - State1 = handle_timeout(State, Parent), - loop(State1, Parent, Paths) + loop(St0, Parent, Paths) + after St0#state.timeout -> + St1 = handle_timeout(St0, Parent), + loop(St1, Parent, Paths) + end. + +handle_request(Req, Paths, St0) -> + case Req of + {get_path,_} -> + {{ok,Paths},St0}; + {get_file,File} -> + handle_get_file(St0, Paths, File); + {get_files,{ModFiles,Fun}} -> + handle_get_files(St0, ModFiles, Paths, Fun); + {list_dir,Dir} -> + handle_list_dir(St0, Dir); + {read_file_info,File} -> + handle_read_file_info(St0, File); + {read_link_info,File} -> + handle_read_link_info(St0, File); + {get_cwd,[]} -> + handle_get_cwd(St0, []); + {get_cwd,[_]=Args} -> + handle_get_cwd(St0, Args); + {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> + handle_set_primary_archive(St0, File, ArchiveBin, + FileInfo, ParserFun); + release_archives -> + handle_release_archives(St0); + _ -> + ignore end. handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) -> -- cgit v1.2.3 From 471d2408de06f3c93507769ce0eb0a9f42c3d119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 19 Nov 2015 10:17:28 +0100 Subject: erl_prim_loader: Remove code for handling OSE --- erts/preloaded/src/erl_prim_loader.erl | 2 -- 1 file changed, 2 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index d19de63b65..07c439a990 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1405,8 +1405,6 @@ 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, _} -> -- cgit v1.2.3 From af9bfce55f0df03edaab638dcd3612c8478dfcc9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Dec 2015 14:50:56 +0100 Subject: Remove erl_prim_loader:get_files/2 erl_prim_loader:get_files/2 was an optimization introduced before the SMP emulator (that is, before R11). The idea was to use the async threads in the efile driver to read multiple BEAM files from the disk in parallel. In a modern computer with the SMP emulator, loading a BEAM module seems to be more time-consuming than reading it from disk. To optimize loading we would need to load several modules in parallel. We could modify get_files/2 so that it would support parallel loading, but it is cleaner to first remove get_files/2 and then (in a future commit), introduce new functions to support parallel loading. --- erts/preloaded/src/erl_prim_loader.erl | 76 +--------------------------------- erts/preloaded/src/init.erl | 51 +++-------------------- 2 files changed, 6 insertions(+), 121 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 07c439a990..a8d1e4df76 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -42,7 +42,7 @@ -include("inet_boot.hrl"). %% Public --export([start/3, set_path/1, get_path/0, get_file/1, get_files/2, +-export([start/3, set_path/1, get_path/0, get_file/1, list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]). %% Used by erl_boot_server @@ -69,7 +69,6 @@ timeout :: timeout(), % idle timeout %% Number of timeouts before archives are released n_timeouts :: non_neg_integer(), - multi_get = false :: boolean(), prim_state :: prim_state()}). % state for efile code loader -define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes @@ -162,16 +161,11 @@ start_it("efile", Id, Pid, _Hosts) -> _ -> init_ack(Pid) end, - MultiGet = case erlang:system_info(thread_pool_size) of - 0 -> false; - _ -> true - end, PS = prim_init(), State = #state {loader = efile, id = Id, data = Port, timeout = infinity, - multi_get = MultiGet, prim_state = PS}, loop(State, Pid, []). @@ -198,20 +192,6 @@ get_file(File) when is_atom(File) -> get_file(File) -> check_file_result(get_file, File, request({get_file,File})). --spec get_files([{atom(), string()}], - fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) -> - 'ok' | {'error', atom()}. -get_files(ModFiles, Fun) -> - case request({get_files,{ModFiles,Fun}}) of - E = {error,_M} -> - E; - {error,Reason,M} -> - check_file_result(get_files, M, {error,Reason}), - {error,M}; - ok -> - ok - end. - -spec list_dir(Dir) -> {'ok', Filenames} | 'error' when Dir :: string(), Filenames :: [Filename :: string()]. @@ -344,8 +324,6 @@ handle_request(Req, Paths, St0) -> {{ok,Paths},St0}; {get_file,File} -> handle_get_file(St0, Paths, File); - {get_files,{ModFiles,Fun}} -> - handle_get_files(St0, ModFiles, Paths, Fun); {list_dir,Dir} -> handle_list_dir(St0, Dir); {read_file_info,File} -> @@ -365,11 +343,6 @@ handle_request(Req, Paths, St0) -> ignore end. -handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) -> - ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State); -handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get - {{error,no_multi_get},State}. - handle_get_file(State = #state{loader = efile}, Paths, File) -> ?SAFE2(efile_get_file_from_port(State, File, Paths), State); handle_get_file(State = #state{loader = inet}, Paths, File) -> @@ -420,53 +393,6 @@ handle_timeout(State = #state{loader = inet}, Parent) -> %%% Functions which handle efile as prim_loader (default). %%% -------------------------------------------------------- -%%% Reading many files in parallel is an optimization. -%%% See also comment in init.erl. - -%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State} -efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) -> - Ref = make_ref(), - %% More than 200 processes is no gain. - Max = erlang:min(200, erlang:system_info(thread_pool_size)), - efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok). - -efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max -> - Self = self(), - _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end), - efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret); -efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 -> - receive - {Ref, ok, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret); - {Ref, {error,_Mod} = Error, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error); - {Ref, MF, {error,emfile,State1}} -> - %% Max can take negative values. Out cannot. - efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret); - {Ref, {M,_F}, {error,Error,State1}} -> - efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M}) - end; -efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) -> - {Ret,State}. - -efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) -> - %% One port for each file read in "parallel": - case prim_file:start() of - {ok, Port} -> - Port0 = State#state.data, - State1 = State#state{data = Port}, - R = case efile_get_file_from_port(State1, File, Paths) of - {{error,Reason},State2} -> - {Ref,MF,{error,Reason,State2}}; - {{ok,BinFile,Full},State2} -> - %% Fun(...) -> ok | {error,Mod} - {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}} - end, - prim_file:close(Port), - Pid ! R; - {error, Error} -> - Pid ! {Ref,MF,{error,Error,State}} - end. %% -> {{ok,BinFile,File},State} | {{error,Reason},State} efile_get_file_from_port(State, File, Paths) -> diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index cc30999ba5..b5c1d46e60 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -85,7 +85,6 @@ path_choice, prim_load, load_mode, - par_load, vars }). @@ -749,13 +748,11 @@ do_boot(Init,Flags,Start) -> Deb = b2a(get_flag(init_debug, Flags, false)), catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb}, BootVars = get_boot_vars(Root, Flags), - ParLoad = Pgm =:= "efile" andalso - erlang:system_info(thread_pool_size) > 0, PathChoice = code_path_choice(), Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz, path_choice=PathChoice, - prim_load=true,load_mode=LoadMode,par_load=ParLoad, + prim_load=true,load_mode=LoadMode, vars=BootVars}, eval_script(BootList, Es), @@ -857,15 +854,12 @@ eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) -> _ -> Es0#es{prim_load=false} end, eval_script(T, Es); -eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad, - par_load=Par}=Es) +eval_script([{primLoad,Mods}|T], #es{prim_load=PrimLoad}=Es) when is_list(Mods) -> - case {PrimLoad,Par} of - {true,true} -> - par_load_modules(Mods, Init); - {true,false} -> + case PrimLoad of + true -> load_modules(Mods); - {false,_} -> + false -> %% Do not load now, code_server does that dynamically! ok end, @@ -892,41 +886,6 @@ load_modules([Mod|Mods]) -> load_modules([]) -> ok. -%%% An optimization: erl_prim_loader gets the chance of loading many -%%% files in parallel, using threads. This will reduce the seek times, -%%% and loaded code can be processed while other threads are waiting -%%% for the disk. The optimization is not tried unless the loader is -%%% "efile" and there is a non-empty pool of threads. -%%% -%%% Many threads are needed to get a good result, so it would be -%%% beneficial to load several applications in parallel. However, -%%% measurements show that the file system handles one directory at a -%%% time, regardless if parallel threads are created for files on -%%% several directories (a guess: writing the meta information when -%%% the file was last read ('mtime'), forces the file system to sync -%%% between directories). - -par_load_modules(Mods,Init) -> - Ext = objfile_extension(), - ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods, - not erlang:module_loaded(Mod)], - Self = self(), - Fun = fun(Mod, BinCode, FullName) -> - case catch load_mod_code(Mod, BinCode, FullName) of - {ok, _} -> - Init ! {Self,loaded,{Mod,FullName}}, - ok; - _EXIT -> - {error, Mod} - end - end, - case erl_prim_loader:get_files(ModFiles, Fun) of - ok -> - ok; - {error,Mod} -> - exit({'cannot load',Mod,get_files}) - end. - make_path(Pa, Pz, Path, Vars) -> append([Pa,append([fix_path(Path,Vars),Pz])]). -- cgit v1.2.3 From 566a7f4324376428f3f0f6a77bc57679f04ada78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Dec 2015 15:15:03 +0100 Subject: Clean up start of erl_prim_loader The 'init' module fetches command line parameters and passes them to erl_prim_loader:start/3. The code can be simplified if 'init' calls a new erl_prim_loader:start/0 function that itself fetches the necessary command line parameters. Also remove the documentation for the start() function, since it there is no way that it can be usefully called by a user application. While we are at it, also get rid of '-id' command line parameter, which is fetched and stored but never actually used. --- erts/doc/src/erl_prim_loader.xml | 40 +++------------------ erts/preloaded/src/erl_prim_loader.erl | 65 ++++++++++++++++------------------ erts/preloaded/src/init.erl | 51 ++++++++++++-------------- 3 files changed, 56 insertions(+), 100 deletions(-) diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml index db4f132609..6fdec8c89e 100644 --- a/erts/doc/src/erl_prim_loader.xml +++ b/erts/doc/src/erl_prim_loader.xml @@ -50,35 +50,8 @@ -loader_debug are also experimental

- - - - - - - - Start the Erlang low level loader - -

Starts the Erlang low level loader. This function is called - by the init process (and module). The init - process reads the command line flags -id Id, - -loader Loader, and -hosts Hosts. These are - the arguments supplied to the start/3 function.

-

If -loader is not given, the default loader is - efile which tells the system to read from the file - system.

-

If -loader is inet, the -id Id, - -hosts Hosts, and -setcookie Cookie flags must - also be supplied. Hosts identifies hosts which this - node can contact in order to load modules. One Erlang - runtime system with a erl_boot_server process must be - started on each of hosts given in Hosts in order to - answer the requests. See erl_boot_server(3).

- - Get a file @@ -189,17 +162,12 @@

Specifies which other Erlang nodes the inet loader can use. This flag is mandatory if the -loader inet flag is present. On each host, there must be on Erlang node - with the erl_boot_server which handles the load - requests. Hosts is a list of IP addresses (hostnames + with the erl_boot_server(3) + which handles the load requests. + Hosts is a list of IP addresses (hostnames are not acceptable).

- -id Id - -

Specifies the identity of the Erlang runtime system. If - the system runs as a distributed node, Id must be - identical to the name supplied with the -sname or - -name distribution flags.

- -setcookie Cookie

Specifies the cookie of the Erlang runtime system. This flag diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index a8d1e4df76..041b54ee0d 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -42,7 +42,7 @@ -include("inet_boot.hrl"). %% Public --export([start/3, set_path/1, get_path/0, get_file/1, +-export([start/0, set_path/1, get_path/0, get_file/1, list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]). %% Used by erl_boot_server @@ -64,9 +64,8 @@ -record(state, {loader :: 'efile' | 'inet', hosts = [] :: [host()], % hosts list (to boot from) - id, % not used any more? data :: 'noport' | port(), % data port etc - timeout :: timeout(), % idle timeout + timeout :: timeout(), % idle timeout %% Number of timeouts before archives are released n_timeouts :: non_neg_integer(), prim_state :: prim_state()}). % state for efile code loader @@ -102,26 +101,13 @@ debug(#prim_state{debug = Deb}, Term) -> %%% Interface Functions. %%% -------------------------------------------------------- --spec start(Id, Loader, Hosts) -> +-spec start() -> {'ok', Pid} | {'error', What} when - Id :: term(), - Loader :: atom() | string(), - Hosts :: Host | [Host], - Host :: host(), Pid :: pid(), What :: term(). -start(Id, Pgm, Hosts) when is_atom(Hosts) -> - start(Id, Pgm, [Hosts]); -start(Id, Pgm0, Hosts) -> - Pgm = if - is_atom(Pgm0) -> - atom_to_list(Pgm0); - true -> - Pgm0 - end, +start() -> Self = self(), - Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end), - register(erl_prim_loader, Pid), + Pid = spawn_link(fun() -> start_it(Self) end), receive {Pid,ok} -> {ok,Pid}; @@ -129,26 +115,40 @@ start(Id, Pgm0, Hosts) -> {error,Reason} end. -%% Hosts must be a list of form ['1.2.3.4' ...] -start_it("inet", Id, Pid, Hosts) -> +start_it(Parent) -> process_flag(trap_exit, true), - ?dbg(inet, {Id,Pid,Hosts}), + register(erl_prim_loader, self()), + Loader = case init:get_argument(loader) of + {ok,[[Loader0]]} -> + Loader0; + error -> + "efile" + end, + case Loader of + "efile" -> start_efile(Parent); + "inet" -> start_inet(Parent) + end. + +%% Hosts must be a list of form ['1.2.3.4' ...] +start_inet(Parent) -> + Hosts = case init:get_argument(hosts) of + {ok,[Hosts0]} -> Hosts0; + _ -> [] + end, AL = ipv4_list(Hosts), ?dbg(addresses, AL), {ok,Tcp} = find_master(AL), - init_ack(Pid), + init_ack(Parent), PS = prim_init(), State = #state {loader = inet, hosts = AL, - id = Id, data = Tcp, timeout = ?IDLE_TIMEOUT, n_timeouts = ?N_TIMEOUTS, prim_state = PS}, - loop(State, Pid, []); + loop(State, Parent, []). -start_it("efile", Id, Pid, _Hosts) -> - process_flag(trap_exit, true), +start_efile(Parent) -> {ok, Port} = prim_file:start(), %% Check that we started in a valid directory. case prim_file:get_cwd(Port) of @@ -159,15 +159,14 @@ start_it("efile", Id, Pid, _Hosts) -> erlang:display(Report), exit({error, invalid_current_directory}); _ -> - init_ack(Pid) + init_ack(Parent) end, PS = prim_init(), State = #state {loader = efile, - id = Id, data = Port, timeout = infinity, prim_state = PS}, - loop(State, Pid, []). + loop(State, Parent, []). init_ack(Pid) -> Pid ! {self(),ok}, @@ -1262,11 +1261,7 @@ string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) -> %% Parse list of ipv4 addresses ipv4_list([H | T]) -> - IPV = if is_atom(H) -> ipv4_address(atom_to_list(H)); - is_list(H) -> ipv4_address(H); - true -> {error,einal} - end, - case IPV of + case ipv4_address(H) of {ok,IP} -> [IP | ipv4_list(T)]; _ -> ipv4_list(T) end; diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index b5c1d46e60..197bc5fde8 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -23,7 +23,6 @@ %% a local file or distributed from another erlang node. %% %% Flags: -%% -id Identity : identity of the system. %% -boot File : Absolute file name of the boot script. %% -boot_var Var Value %% : $Var in the boot script is expanded to @@ -693,17 +692,15 @@ sleep(T) -> receive after T -> ok end. %%% The loader shall run for ever! %%% ------------------------------------------------- -start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) -> - case erl_prim_loader:start(Id,Pgm,Nodes) of - {ok,Pid} when Path =:= false -> - InitPath = append(Pa,["."|Pz]), - erl_prim_loader:set_path(InitPath), - add_to_kernel(Init,Pid), - Pid; +start_prim_loader(Init, Path0, {Pa,Pz}) -> + Path = case Path0 of + false -> Pa ++ ["."|Pz]; + _ -> Path0 + end, + case erl_prim_loader:start() of {ok,Pid} -> erl_prim_loader:set_path(Path), - add_to_kernel(Init,Pid), - Pid; + add_to_kernel(Init, Pid); {error,Reason} -> erlang:display({"cannot start loader",Reason}), exit(Reason) @@ -717,13 +714,6 @@ add_to_kernel(Init,Pid) -> ok end. -prim_load_flags(Flags) -> - PortPgm = get_flag(loader, Flags, <<"efile">>), - Hosts = get_flag_list(hosts, Flags, []), - Id = get_flag(id, Flags, none), - Path = get_flag_list(path, Flags, false), - {PortPgm, Hosts, Id, Path}. - %%% ------------------------------------------------- %%% The boot process fetches a boot script and loads %%% all modules specified and starts spec. processes. @@ -736,12 +726,10 @@ do_boot(Flags,Start) -> do_boot(Init,Flags,Start) -> process_flag(trap_exit,true), - {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), Root = get_root(Flags), + Path = get_flag_list(path, Flags, false), {Pa,Pz} = PathFls = path_flags(Flags), - Pgm = b2s(Pgm0), - _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), - bs2ss(Path),PathFls), + start_prim_loader(Init, bs2ss(Path), PathFls), BootFile = bootfile(Flags,Root), BootList = get_boot(BootFile,Root), LoadMode = b2a(get_flag(mode, Flags, false)), @@ -854,11 +842,18 @@ eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) -> _ -> Es0#es{prim_load=false} end, eval_script(T, Es); -eval_script([{primLoad,Mods}|T], #es{prim_load=PrimLoad}=Es) +eval_script([{primLoad,[Mod]}|T], #es{prim_load=true}=Es) -> + %% Common special case (loading of error_handler). Nothing + %% to gain by parallel loading. + File = atom_to_list(Mod) ++ objfile_extension(), + {ok,Full} = load_mod(Mod, File), + init ! {self(),loaded,{Mod,Full}}, % Tell init about loaded module + eval_script(T, Es); +eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad}=Es) when is_list(Mods) -> case PrimLoad of true -> - load_modules(Mods); + load_modules(Mods, Init); false -> %% Do not load now, code_server does that dynamically! ok @@ -878,12 +873,12 @@ eval_script([], #es{}) -> eval_script(What, #es{}) -> exit({'unexpected command in bootfile',What}). -load_modules([Mod|Mods]) -> +load_modules([Mod|Mods], Init) -> File = concat([Mod,objfile_extension()]), {ok,Full} = load_mod(Mod,File), - init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module - load_modules(Mods); -load_modules([]) -> + Init ! {self(),loaded,{Mod,Full}}, %Tell init about loaded module + load_modules(Mods, Init); +load_modules([], _) -> ok. make_path(Pa, Pz, Path, Vars) -> @@ -1244,8 +1239,6 @@ concat([S|T]) -> concat([]) -> []. -append(L, Z) -> L ++ Z. - append([E]) -> E; append([H|T]) -> H ++ append(T); -- cgit v1.2.3 From e2e49ee0b0292da4a48d90ed762d7df0b3a64f78 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 26 Nov 2015 11:23:41 +0100 Subject: init: Eliminate the concat/1 function There is no need to use the concat/1 function since all arguments that are passed to it have known types. --- erts/preloaded/src/init.erl | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 197bc5fde8..383c4a1ec6 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -338,7 +338,7 @@ boot_loop(BootPid, State) -> end. ensure_loaded(Module, Loaded) -> - File = concat([Module,objfile_extension()]), + File = atom_to_list(Module) ++ objfile_extension(), case catch load_mod(Module,File) of {ok, FullName} -> {{module, Module}, [{Module, FullName}|Loaded]}; @@ -773,7 +773,7 @@ get_boot_vars_1(Vars, []) -> Vars. bootfile(Flags,Root) -> - b2s(get_flag(boot, Flags, concat([Root,"/bin/start"]))). + b2s(get_flag(boot, Flags, Root++"/bin/start")). path_flags(Flags) -> Pa = append(reverse(get_flag_args(pa, Flags))), @@ -781,12 +781,12 @@ path_flags(Flags) -> {bs2ss(Pa),bs2ss(Pz)}. get_boot(BootFile0,Root) -> - BootFile = concat([BootFile0,".boot"]), + BootFile = BootFile0 ++ ".boot", case get_boot(BootFile) of {ok, CmdList} -> CmdList; not_found -> %% Check for default. - BootF = concat([Root,"/bin/",BootFile]), + BootF = Root ++ "/bin/" ++ BootFile, case get_boot(BootF) of {ok, CmdList} -> CmdList; @@ -874,7 +874,7 @@ eval_script(What, #es{}) -> exit({'unexpected command in bootfile',What}). load_modules([Mod|Mods], Init) -> - File = concat([Mod,objfile_extension()]), + File = atom_to_list(Mod) ++ objfile_extension(), {ok,Full} = load_mod(Mod,File), Init ! {self(),loaded,{Mod,Full}}, %Tell init about loaded module load_modules(Mods, Init); @@ -1228,17 +1228,6 @@ set_argument([Item|Flags],Flag,Value) -> set_argument([],Flag,Value) -> [{Flag,[Value]}]. -concat([A|T]) when is_atom(A) -> - atom_to_list(A) ++ concat(T); -concat([C|T]) when is_integer(C), 0 =< C, C =< 255 -> - [C|concat(T)]; -concat([Bin|T]) when is_binary(Bin) -> - binary_to_list(Bin) ++ concat(T); -concat([S|T]) -> - S ++ concat(T); -concat([]) -> - []. - append([E]) -> E; append([H|T]) -> H ++ append(T); -- cgit v1.2.3 From 07c69ccb45b5d39493cdc830ee78fe3ec0f3d973 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 27 Nov 2015 15:53:23 +0100 Subject: erl_prim_loader: Clean up splitting of filenames --- erts/preloaded/src/erl_prim_loader.erl | 55 +++++++++++++++++----------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 041b54ee0d..dbb658c904 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1205,24 +1205,15 @@ path_join([Path|Paths],Acc) -> name_split(ArchiveFile, File0) -> File = absname(File0), do_name_split(ArchiveFile, File). - + do_name_split(undefined, File) -> %% Ignore primary archive - case string_split(File, init:archive_extension(), []) of + RevExt = reverse(init:archive_extension()), + case archive_split(File, RevExt, []) of no_split -> - %% Plain file {file, File}; - {split, _RevArchiveBase, RevArchiveFile, []} -> - %% Top dir in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, []}; - {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} -> - %% File in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, FileInArchive}; - {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} -> - %% False match. Assume plain file - {file, File} + Archive -> + Archive end; do_name_split(ArchiveFile, File) -> %% Look first in primary archive @@ -1244,20 +1235,28 @@ string_match([$/ | File], [], RevTop) -> string_match(_File, _Archive, _RevTop) -> no_match. -string_split([Char | File], [Char | Ext] = FullExt, RevTop) -> - RevTop2 = [Char | RevTop], - string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2); -string_split([Char | File], Ext, RevTop) -> - string_split(File, Ext, [Char | RevTop]); -string_split([], _Ext, _RevTop) -> - no_split. - -string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) -> - string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop); -string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) -> - {split, RevBase, RevTop, File}; -string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) -> - string_split(SaveFile, SaveExt, SaveTop). +archive_split("/"++File, RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + archive_split(File, RevExt, [$/|Acc]); + true -> + ArchiveFile = reverse(Acc), + {archive, ArchiveFile, File} + end; +archive_split([H|T], RevExt, Acc) -> + archive_split(T, RevExt, [H|Acc]); +archive_split([], RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + no_split; + true -> + ArchiveFile = reverse(Acc), + {archive, ArchiveFile, []} + end. + +is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2); +is_prefix([_|_], _) -> false; +is_prefix([], _ ) -> true. %% Parse list of ipv4 addresses ipv4_list([H | T]) -> -- cgit v1.2.3 From ea2481f1fdec3ce9f510201130eca51ab553fa71 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 27 Nov 2015 16:06:41 +0100 Subject: erl_prim_loader: Avoid making absolute paths We don't need absolute paths unless we are dealing with archives. Since it is not free to turn a relative path absolute (we will need a call to prim_file to fetch the current directory), it's better to delay the call to absname/1 until we are sure it's needed. --- erts/preloaded/src/erl_prim_loader.erl | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index dbb658c904..91ef2bd6d0 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1202,11 +1202,7 @@ path_join([Path],Acc) -> path_join([Path|Paths],Acc) -> path_join(Paths,"/" ++ reverse(Path) ++ Acc). -name_split(ArchiveFile, File0) -> - File = absname(File0), - do_name_split(ArchiveFile, File). - -do_name_split(undefined, File) -> +name_split(undefined, File) -> %% Ignore primary archive RevExt = reverse(init:archive_extension()), case archive_split(File, RevExt, []) of @@ -1215,12 +1211,13 @@ do_name_split(undefined, File) -> Archive -> Archive end; -do_name_split(ArchiveFile, File) -> +name_split(ArchiveFile, File0) -> %% Look first in primary archive + File = absname(File0), case string_match(real_path(File), ArchiveFile, []) of no_match -> %% Archive or plain file - do_name_split(undefined, File); + name_split(undefined, File); {match, _RevPrimArchiveFile, FileInArchive} -> %% Primary archive {archive, ArchiveFile, FileInArchive} @@ -1240,7 +1237,7 @@ archive_split("/"++File, RevExt, Acc) -> false -> archive_split(File, RevExt, [$/|Acc]); true -> - ArchiveFile = reverse(Acc), + ArchiveFile = absname(reverse(Acc)), {archive, ArchiveFile, File} end; archive_split([H|T], RevExt, Acc) -> @@ -1250,7 +1247,7 @@ archive_split([], RevExt, Acc) -> false -> no_split; true -> - ArchiveFile = reverse(Acc), + ArchiveFile = absname(reverse(Acc)), {archive, ArchiveFile, []} end. -- cgit v1.2.3 From 8a2c833d1ff02957d2fbd15640e876a5247a1b63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 14 Dec 2015 13:53:05 +0100 Subject: erl_prim_loader: Clean up string_match() Part of the return value for string_match/3 is not used by its only caller. Eliminate the unused part of the return value and the accumulator argument for string_match(). --- erts/preloaded/src/erl_prim_loader.erl | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 91ef2bd6d0..5f88029585 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1214,22 +1214,22 @@ name_split(undefined, File) -> name_split(ArchiveFile, File0) -> %% Look first in primary archive File = absname(File0), - case string_match(real_path(File), ArchiveFile, []) of + case string_match(real_path(File), ArchiveFile) of no_match -> %% Archive or plain file name_split(undefined, File); - {match, _RevPrimArchiveFile, FileInArchive} -> + {match, FileInArchive} -> %% Primary archive {archive, ArchiveFile, FileInArchive} end. -string_match([Char | File], [Char | Archive], RevTop) -> - string_match(File, Archive, [Char | RevTop]); -string_match([] = File, [], RevTop) -> - {match, RevTop, File}; -string_match([$/ | File], [], RevTop) -> - {match, RevTop, File}; -string_match(_File, _Archive, _RevTop) -> +string_match([Char | File], [Char | Archive]) -> + string_match(File, Archive); +string_match([] = File, []) -> + {match, File}; +string_match([$/ | File], []) -> + {match, File}; +string_match(_File, _Archive) -> no_match. archive_split("/"++File, RevExt, Acc) -> -- cgit v1.2.3 From b74e7f4c1404a334be10c5d4a8b1ef5415405425 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Dec 2015 14:38:55 +0100 Subject: erl_prim_loader doc: Remove mention of user supplied loader Custom loaders are no longer supported. Most of the documentation for them were removed in c8a7d2d7. --- erts/doc/src/erl_prim_loader.xml | 2 -- 1 file changed, 2 deletions(-) diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml index 6fdec8c89e..8f66e07ae1 100644 --- a/erts/doc/src/erl_prim_loader.xml +++ b/erts/doc/src/erl_prim_loader.xml @@ -60,8 +60,6 @@ Filename is either an absolute file name or just the name of the file, for example "lists.beam". If an internal path is set to the loader, this path is used to find the file. - If a user supplied loader is used, the path can be stripped - off if it is obsolete, and the loader does not use a path. FullName is the complete name of the fetched file. Bin is the contents of the file as a binary.

-- cgit v1.2.3 From ef8a03c6dc3965ed56a746df524036b6b205feb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 16 Dec 2015 15:52:56 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 56052 -> 51424 bytes erts/preloaded/ebin/erlang.beam | Bin 102012 -> 102012 bytes erts/preloaded/ebin/erts_internal.beam | Bin 6260 -> 6260 bytes erts/preloaded/ebin/init.beam | Bin 48592 -> 44700 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1452 -> 1452 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1324 -> 1324 bytes erts/preloaded/ebin/prim_file.beam | Bin 44780 -> 44892 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72612 -> 72612 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23284 -> 23284 bytes erts/preloaded/ebin/zlib.beam | Bin 14160 -> 14160 bytes 10 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index 8ccbd1e36b..6ee26b7575 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 87a48525bb..77f25653a3 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 191dd332e2..4e1cb7f8a0 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index a78d9abc20..a44b022931 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index 9cc91be343..328520844d 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index e84c8ffd2d..8d6c1927fd 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index e1b2a1c8eb..1221c513db 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index 8853ae8bda..fa617f1f51 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 563e604a1d..83e1e49974 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 304783ae37..8f654e3abf 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From 9fd2f21c38944c8a605020d6662bb5935c5bbee2 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 3 Mar 2014 01:40:39 +0100 Subject: First part of the basic test suite for the HiPE compiler --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 72 +++++ .../test/basic_SUITE_data/basic_beam_instrs.erl | 90 ++++++ lib/hipe/test/basic_SUITE_data/basic_bifs.erl | 41 +++ lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 124 ++++++++ lib/hipe/test/basic_SUITE_data/basic_boolean.erl | 47 +++ lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl | 101 +++++++ lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 189 ++++++++++++ .../test/basic_SUITE_data/basic_comparisons.erl | 157 ++++++++++ .../test/basic_SUITE_data/basic_exceptions.erl | 206 +++++++++++++ lib/hipe/test/basic_SUITE_data/basic_floats.erl | 156 ++++++++++ lib/hipe/test/basic_SUITE_data/basic_fun.erl | 124 ++++++++ lib/hipe/test/basic_SUITE_data/basic_guards.erl | 58 ++++ .../test/basic_SUITE_data/basic_issues_beam.erl | 325 +++++++++++++++++++++ .../test/basic_SUITE_data/basic_issues_hipe.erl | 119 ++++++++ lib/hipe/test/basic_SUITE_data/basic_lists.erl | 41 +++ .../test/basic_SUITE_data/basic_module_info.erl | 32 ++ .../test/basic_SUITE_data/basic_pattern_match.erl | 36 +++ lib/hipe/test/basic_SUITE_data/basic_receive.erl | 56 ++++ lib/hipe/test/basic_SUITE_data/basic_tuples.erl | 177 +++++++++++ 19 files changed, 2151 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_arith.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bifs.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bignums.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_boolean.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_comparisons.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_exceptions.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_floats.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_fun.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_guards.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_lists.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_module_info.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_receive.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_tuples.erl diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl new file mode 100644 index 0000000000..3dddc265c8 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -0,0 +1,72 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%--------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests cases for compilation of arithmetic. +%%%--------------------------------------------------------------------- +-module(basic_arith). + +-export([test/0]). + +test() -> + ok = test_rem(), + ok = test_bit_ops(), + ok = test_uplus(), + ok = test_bsl_errors(), + ok. + +%%---------------------------------------------------------------------- +%% Tests the remainder operator. + +test_rem() -> + 2 = ret_rem(42, 20), + -2 = ret_rem(-42, 20), + -2 = ret_rem(-42, -20), + {'EXIT', {badarith, _}} = ret_rem(3.14, 2), + {'EXIT', {badarith, _}} = ret_rem(42, 3.14), + ok. + +ret_rem(X, Y) -> + catch X rem Y. + +%%---------------------------------------------------------------------- +%% + +test_bit_ops() -> + 2 = bbb(11, 2, 16#3ff), + ok. + +bbb(X, Y, Z) -> + ((1 bsl X) bor Y) band Z. + +%%---------------------------------------------------------------------- +%% Tests unary plus: it used to be the identity function but not anymore + +test_uplus() -> + badarith = try uplus(gazonk) catch error:E -> E end, + 42 = uplus(42), + ok. + +uplus(X) -> +(X). + +%%---------------------------------------------------------------------- +%% The first part of this test triggered a bug in the emulator as one +%% of the arguments to bsl is not an integer. +%% +%% The second part triggered a compilation crash since an arithmetic +%% expression resulting in a 'system_limit' exception was statically +%% evaluated and an arithmetic result was expected. + +test_bsl_errors() -> + {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))), + badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end, + system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end, + ok. + +t1(_, X, _) -> + (1 bsl X) + 1. + +t2(_, X, _) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl new file mode 100644 index 0000000000..50c2180cbd --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl @@ -0,0 +1,90 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of various BEAM instructions. +%%%------------------------------------------------------------------- +-module(basic_beam_instrs). + +-export([test/0]). + +test() -> + ok = test_make_fun(), + ok = test_switch_val(), + ok = test_put_literal(), + ok = test_set_tuple_element(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of make_fun works. + +test_make_fun() -> + {F, G} = double_the_fun(), + ok = F(), + {ok, 42} = G(42), + FV1 = {ok, free_var1}, + FV2 = {also, {free, var2}}, + {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2), + ok. + +double_the_fun() -> + {fun () -> ok end, fun (V) -> {ok, V} end}. + +contains_fun(X, _IGNORED_ARG, Y) -> + calls_fun(fun(Term) -> {X, Term, Y} end). + +calls_fun(F) -> + F({ok, [bv]}). + +%%-------------------------------------------------------------------- +%% Tests whether the translation of switch_val works. + +test_switch_val() -> + 'A' = sv(a), + 'B' = sv(b), + 'C' = sv(c), + foo = sv(d), + ok. + +sv(a) -> 'A'; +sv(b) -> 'B'; +sv(c) -> 'C'; +sv(_) -> foo. + +%%-------------------------------------------------------------------- +%% Tests correct handling of literals (statically constant terms) + +-define(QUADRUPLE, {a,b,c,42}). +-define(DEEP_LIST, [42,[42,[42]]]). + +test_put_literal() -> + ?QUADRUPLE = mk_literal_quadruple(), + ?DEEP_LIST = mk_literal_deep_list(), + ok. + +mk_literal_quadruple() -> + ?QUADRUPLE. + +mk_literal_deep_list() -> + ?DEEP_LIST. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of set_tuple_element works. + +-record(rec, {f1, f2, f3, f4, f5}). + +test_set_tuple_element() -> + F2 = [a,b,c], F4 = {a,b}, + State0 = init_rec(F2, F4), + State1 = simple_set(State0, 42), + #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21), + ok. + +init_rec(F2, F4) -> + #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}. + +simple_set(State, Val) -> %% f3 = Val is the one used in set_element; + State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable + +odd_set(State, Val) -> %% f3 = foo is the one used in set_element; + State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl new file mode 100644 index 0000000000..d6f21ceb52 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -0,0 +1,41 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for handling of BIFs in guards and body calls. +%%%------------------------------------------------------------------- +-module(basic_bifs). + +-export([test/0]). + +test() -> + ok = test_element(), + ok = test_binary_part(). + +%%-------------------------------------------------------------------- + +test_element() -> + true = elem({a, b}), + false = elem({a, c}), + other = elem(gazonk), + ok. + +elem(T) when element(1, T) == a -> element(2, T) == b; +elem(_) -> other. + +%%-------------------------------------------------------------------- +%% Checks that 2-ary and 3-ary BIFs can be compiled to native code. + +test_binary_part() -> + Bin = <<1,2,3,4,5,6,7,8,9,10>>, + BinPart = bp3(Bin), + <<7,8>> = bp2(BinPart), + ok. + +bp2(Bin) -> + binary_part(Bin, {1, 2}). + +bp3(Bin) -> + binary_part(Bin, byte_size(Bin), -5). + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl new file mode 100644 index 0000000000..c455bf318f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -0,0 +1,124 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test bignum arithmetic and matching. +%%%------------------------------------------------------------------- +-module(basic_bignums). + +-export([test/0, test_bsl/0]). + +test() -> + ok = test_ops(), + ok = test_big_fac(), + ok = test_int_overfl_32(), + ok = test_int_overfl_64(), + ok. + +%%-------------------------------------------------------------------- +%% Define some constants for the tests of arithmetic operators + +-define(X, 68719476736). +-define(Y, 98765432101234). +-define(Z, 4722366482869645213696). +-define(W, 339254531512339254531512). + +-define(B1, 4398046511104). +-define(B5, 1645504557321206042154969182557350504982735865633579863348609024). +-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384). + +%%-------------------------------------------------------------------- + +test_ops() -> + ok = test_mult(), + ok = test_div(), + ok = test_round(), + ok = test_trunc(), + ok = test_bsl(), + ok. + +test_mult() -> + ?Z = mult(?X, ?X), + ok. + +mult(X, Y) -> X * Y. + +test_div() -> + 4 = div_f(339254531512, ?X), + 0 = div_f(?Y, ?Y+1), + 64 = div_f(?B1, ?X), + ?X = div_f(?Z, ?X), + 1073741824 = div_f(?Z, ?B1), + ok. + +div_f(X, Y) -> X div Y. + +test_round() -> + 0 = round_f(?Z, ?W), + 1 = round_f(?Y, ?Y), + 71 = round_f(?W, ?Z), + 1437 = round_f(?Y, ?X), + 47813960 = round_f(?Z, ?Y), + 4936803183406 = round_f(?W, ?X), + ok. + +trunc_f(X, Y) -> round(X/Y). + +test_trunc() -> + 0 = trunc_f(?Z, ?W), + 1 = trunc_f(?Y, ?Y), + 72 = trunc_f(?W, ?Z), + 1437 = trunc_f(?Y, ?X), + 47813961 = trunc_f(?Z, ?Y), + 4936803183407 = trunc_f(?W, ?X), + ok. + +round_f(X, Y) -> trunc(X/Y). + +test_bsl() -> + ?B1 = bsl_f(1, 42), + ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator + ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function + ok. + +bsl_f(X, Y) -> X bsl Y. + +%% applies a binary function N times +n(1, F, X, Y) -> F(X, Y); +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). + +%%-------------------------------------------------------------------- + +-define(FAC42, 1405006117752879898543142606244511569936384000000000). + +test_big_fac() -> + ?FAC42 = fac(42), + ok. + +fac(0) -> 1; +fac(N) -> N * fac(N-1). + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow + +test_int_overfl_32() -> + 16#7FFFFFF = add(16#7FFFFFF, 0), + 16#8000000 = add(16#8000000, 0), + 16#8000001 = add(16#8000000, 1), + case add(16#7FFFFFF, 1) of + 16#8000000 -> ok; + -16#7FFFFFF -> error + end. + +test_int_overfl_64() -> + 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0), + 16#800000000000000 = add(16#800000000000000, 0), + 16#800000000000001 = add(16#800000000000000, 1), + case add(16#7FFFFFFFFFFFFFF, 1) of + 16#800000000000000 -> ok; + -16#7FFFFFFFFFFFFFF -> error + end. + +add(X, Y) -> X + Y. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl new file mode 100644 index 0000000000..e4a91ef5af --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl @@ -0,0 +1,47 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of booleans and their primitives. +%%%------------------------------------------------------------------- +-module(basic_boolean). + +-export([test/0]). + +test() -> + ok = test_boolean_ops(false, true), + ok = test_orelse_redundant(), + ok. + +%%-------------------------------------------------------------------- + +test_boolean_ops(F, T) -> + true = T and T, + false = T and F, + false = F and T, + false = F and F, + true = T or T, + true = T or F, + true = F or T, + false = F or F, + true = T andalso T, + false = T andalso F, + false = F andalso T, + false = F andalso F, + true = T orelse T, + true = T orelse F, + true = F orelse T, + false = F orelse F, + ok. + +%%-------------------------------------------------------------------- +%% Redundant test in BEAM code will generate type warning. + +test_orelse_redundant() -> + true = test_orelse(true, true, true), + ok. + +test_orelse(A, B, C) -> + A andalso B orelse C. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl new file mode 100644 index 0000000000..0cf9a3cd4c --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl @@ -0,0 +1,101 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the BEAM compiler. +%%%------------------------------------------------------------------- +-module(basic_bugs_beam). + +-export([test/0]). + +%% the following are needed for the test_catch_bug +-behaviour(gen_server). +-export([start_link/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +test() -> + ok = test_fp_basic_blocks(), + ok = test_catch_bug(), + ok. + +%%-------------------------------------------------------------------- +%% Test which shows that BEAM's splitting of basic blocks should take +%% into account that arithmetic operations implemented as BIFs can +%% also cause exceptions and thus calls to BIFs should end basic blocks. +%% +%% Investigated and fixed in the beginning of April 2004. +%%-------------------------------------------------------------------- + +test_fp_basic_blocks() -> + ok = t1(), + ok = t2(). + +t1() -> + X = (catch bad_arith1(2.0, 1.7)), + case X of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith1(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + X2 = X1 + 1.0, + Y1 = Y * 2, + {X2, Y1}. + +%% Similarly, it is not kosher to have anything that can fail inside +%% the fp block since it will throw the exception before the fp +%% exception and we will get the same problems. + +t2() -> + case catch bad_arith2(2.0, []) of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith2(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + Y1 = element(1, Y), + {X1 + 1.0, Y1}. + +%%-------------------------------------------------------------------- +%% This was posted on the Erlang mailing list as a question: +%% +%% Given the module below and the function call +%% "catch_bug:start_link(foo)." +%% from the Erlang shell, why does Erlang crash with "Catch not found"? +%% +%% The BEAM compiler was generating wrong code for this case; +%% this was fixed in R9C-0. Native code generation was OK. +%%-------------------------------------------------------------------- + +test_catch_bug() -> + ignore = start_link(foo), + ok. + +start_link(Param) -> + gen_server:start_link(?MODULE, Param, []). + +init(Param) -> + process_flag(trap_exit, true), + (catch begin + dummy(Param), + (catch exit(bar)) + end + ), + ignore. + +dummy(_) -> ok. + +%% gen_server callbacks below +handle_call(_Call, _From, State) -> {noreply, State}. +handle_cast(_Msg, State) -> {noreply, State}. +handle_info(_Msg, State) -> {noreply, State}. +terminate(_Reason, _State) -> ok. +code_change(_OldVsn, State, _Extra) -> {ok, State}. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl new file mode 100644 index 0000000000..1948e4efa7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -0,0 +1,189 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_bugs_hipe). + +-export([test/0]). + +test() -> + ok = test_ets_bifs(), + ok = test_bit_shift(), + ok = test_R12B5_seg_fault(), + ok. + +%%-------------------------------------------------------------------- +%% From: Bjorn Gustavsson +%% +%% This code, if HiPE compiled, crashed like this (on SPARC) +%% +%% (gdb) where +%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3) +%% at beam/ggc.c:1060 +%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...) +%% at beam/ggc.c:1648 +%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc) +%% at hipe/hipe_mode_switch.c:180 +%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314 +%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936 +%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28 +%% +%% A guess at what could be the problem: From R8, many ets BIFs trap +%% to other ets BIFs with a *different* arity (i.e. they have more or +%% less arguments). I have probably forgotten to mention that subtle +%% change. +%%-------------------------------------------------------------------- + +test_ets_bifs() -> + Seed = {1032, 15890, 22716}, + put(random_seed, Seed), + do_random_test(). + +do_random_test() -> + OrdSet = ets:new(xxx, [ordered_set]), + Set = ets:new(xxx, []), + do_n_times(fun() -> + Key = create_random_string(25), + Value = create_random_tuple(25), + ets:insert(OrdSet, {Key, Value}), + ets:insert(Set, {Key, Value}) + end, 5000), + %% io:format("~nData inserted~n"), + do_n_times(fun() -> + I = random:uniform(25), + Key = create_random_string(I) ++ '_', + L1 = ets_match_object(OrdSet, {Key, '_'}), + L2 = lists:sort(ets_match_object(Set, {Key, '_'})), + case L1 == L2 of + false -> + %% io:format("~p != ~p~n", [L1, L2]), + exit({not_eq, L1, L2}); + true -> + ok + end + end, + 2000), + %% io:format("~nData matched~n"), + ets:match_delete(OrdSet, '_'), + ets:match_delete(Set, '_'), + ok. + +create_random_string(0) -> + []; +create_random_string(OfLength) -> + C = case random:uniform(2) of + 1 -> (random:uniform($Z - $A + 1) - 1) + $A; + _ -> (random:uniform($z - $a + 1) - 1) + $a + end, + [C | create_random_string(OfLength - 1)]. + +create_random_tuple(OfLength) -> + list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]). + +ets_match_object(Tab,Expr) -> + case random:uniform(2) of + 1 -> ets:match_object(Tab,Expr); + _ -> match_object_chunked(Tab,Expr) + end. + +match_object_chunked(Tab,Expr) -> + match_object_chunked_collect(ets:match_object(Tab, Expr, + random:uniform(1999) + 1)). + +match_object_chunked_collect('$end_of_table') -> + []; +match_object_chunked_collect({Results, Continuation}) -> + Results ++ match_object_chunked_collect(ets:match_object(Continuation)). + +do_n_times(_, 0) -> + ok; +do_n_times(Fun, N) -> + Fun(), + case N rem 1000 of + 0 -> ok; %% WAS: io:format("."); + _ -> ok + end, + do_n_times(Fun, N - 1). + +%%-------------------------------------------------------------------- +%% From: Niclas Pehrsson +%% Date: Apr 20, 2006 +%% +%% We found something weird with the bit shifting in HiPE. It seems +%% that bsr in some cases shifts the bits in the wrong way... +%% +%% Fixed about 10 mins afterwards; was a bug in constant propagation. +%%-------------------------------------------------------------------- + +test_bit_shift() -> + 1 = plain_shift(), % 1 + 6 = length_list_plus(), % 6 + 0 = shift_length_list(), % 0 + 1 = shift_length_list_plus(), % 1 + 1 = shift_length_list_plus2(), % 1 + 24 = shift_length_list_plus_bsl(), % 24 + 1 = shift_fun(), % 1 + %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G}, + ok. + +plain_shift() -> + 6 bsr 2. + +length_list() -> + length([0,0]). + +length_list_plus() -> + length([0,0]) + 4. + +shift_length_list() -> + length([0,0]) bsr 2. + +shift_length_list_plus() -> + (length([0,0]) + 4) bsr 2. + +shift_length_list_plus_bsl() -> + (length([0,0]) + 4) bsl 2. + +shift_length_list_plus2() -> + N = length([0,0]) + 4, + N bsr 2. + +shift_fun() -> + (length_list() + 4) bsr 2. + +%%----------------------------------------------------------------------- +%% From: Sergey S, mid January 2009. +%% +%% While I was playing with +native option, I run into a bug in HiPE +%% which leads to segmentation fault using +native and Erlang R12B-5. +%% +%% Eshell V5.6.5 (abort with ^G) +%% 1> crash:test(). +%% # Some message to be printed here each loop iteration +%% Segmentation fault +%% +%% Diagnozed and fixed by Mikael Petterson (22 Jan 2009): +%% +%% I've analysed the recently posted HiPE bug report on erlang-bugs +%% . +%% The segfault is caused by memory corruption, which in turn is caused +%% by RTL removing an update of the HP (heap pointer) register due to +%% what looks like broken liveness information. +%%----------------------------------------------------------------------- + +test_R12B5_seg_fault() -> + _ = spawn(fun() -> init() end), + ok. + +init() -> + repeat(5, fun() -> void end), + receive after infinity -> ok end. + +repeat(0, _) -> + ok; +repeat(N, Fun) -> + %% io:format("# Some message to be printed here each loop iteration\n"), + Fun(), + repeat(N - 1, Fun). diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl new file mode 100644 index 0000000000..8dab2cab1f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl @@ -0,0 +1,157 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct execution of comparison operators. +%%%------------------------------------------------------------------- +-module(basic_comparisons). + +-export([test/0]). + +test() -> + Ns = [0, 0.0, 42, 42.0, gazonk], + T1F4 = [true, false, false, false, false], + T2F3 = [true, true, false, false, false], + F1T4 = [false, true, true, true, true], + F2T3 = [false, false, true, true, true], + %% tests for calls + T1F4 = [eq_exact_call(0, N) || N <- Ns], + F1T4 = [ne_exact_call(0, N) || N <- Ns], + T2F3 = [eq_call(0, N) || N <- Ns], + F2T3 = [ne_call(0, N) || N <- Ns], + %% tests for guards + T1F4 = [eq_exact_guard(0, N) || N <- Ns], + F1T4 = [ne_exact_guard(0, N) || N <- Ns], + T2F3 = [eq_guard(0, N) || N <- Ns], + F2T3 = [ne_guard(0, N) || N <- Ns], + %% some more tests + ok = test_against_zero(), + ok = test_against_other_terms(), + ok = test_sofs_func(), + ok. + +test_against_zero() -> + Xs = [0, 1, 0.0], + [true, false, false] = [is_zero_int(X) || X <- Xs], + [true, false, true] = [is_zero_num(X) || X <- Xs], + [false, true, true] = [is_nonzero_int(X) || X <- Xs], + [false, true, false] = [is_nonzero_num(X) || X <- Xs], + ok. + +test_against_other_terms() -> + TTT = {true, true, true}, + FFF = {false, false, false}, + TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)}, + FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)}, + FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)}, + TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)}, + Tup = {a, {42}, [c]}, + TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)}, + BNi = <<42>>, + TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)}, + BNf = <<42/float>>, + FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)}, + ok. + +test_sofs_func() -> + L = [0, 0.0], + ok = sofs_func(L, L, L). + +%%-------------------------------------------------------------------- +%% Test for comparison operators used in body calls + +eq_exact_call(X, Y) -> X =:= Y. + +ne_exact_call(X, Y) -> X =/= Y. + +eq_call(X, Y) -> X == Y. + +ne_call(X, Y) -> X /= Y. + +%%-------------------------------------------------------------------- +%% Tests for comparison operators used as guards + +eq_exact_guard(X, Y) when X =:= Y -> true; +eq_exact_guard(_, _) -> false. + +ne_exact_guard(X, Y) when X =/= Y -> true; +ne_exact_guard(_, _) -> false. + +eq_guard(X, Y) when X == Y -> true; +eq_guard(_, _) -> false. + +ne_guard(X, Y) when X /= Y -> true; +ne_guard(_, _) -> false. + +%%-------------------------------------------------------------------- + +is_zero_int(N) when N =:= 0 -> true; +is_zero_int(_) -> false. + +is_nonzero_int(N) when N =/= 0 -> true; +is_nonzero_int(_) -> false. + +is_zero_num(N) when N == 0 -> true; +is_zero_num(_) -> false. + +is_nonzero_num(N) when N /= 0 -> true; +is_nonzero_num(_) -> false. + +%%-------------------------------------------------------------------- +%% There should not really be any difference in the generated code +%% for the following three functions. + +is_foo_exact(A) when A =:= foo -> true; +is_foo_exact(_) -> false. + +is_foo_term1(A) when A == foo -> true; +is_foo_term1(_) -> false. + +is_foo_term2(A) when foo == A -> true; +is_foo_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% Same for these cases + +is_nonfoo_exact(A) when A =/= foo -> true; +is_nonfoo_exact(_) -> false. + +is_nonfoo_term1(A) when A /= foo -> true; +is_nonfoo_term1(_) -> false. + +is_nonfoo_term2(A) when foo /= A -> true; +is_nonfoo_term2(_) -> false. + +%%-------------------------------------------------------------------- + +is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true; +is_tuple_skel(T) when is_tuple(T) -> false. + +is_tuple_exact(T) when T =:= {a,{42},[c]} -> true; +is_tuple_exact(T) when is_tuple(T) -> false. + +is_tuple_term(T) when T == {a,{42.0},[c]} -> true; +is_tuple_term(T) when is_tuple(T) -> false. + +%%-------------------------------------------------------------------- +%% But for binaries the treatment has to be different, due to the need +%% for construction of the binary in the guard. + +is_bin_exact(B) when B =:= <<42>> -> true; +is_bin_exact(_) -> false. + +is_bin_term1(B) when B == <<42>> -> true; +is_bin_term1(_) -> false. + +is_bin_term2(B) when <<42>> == B -> true; +is_bin_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% a test from sofs.erl which failed at some point + +sofs_func([X | Ts], X0, L) when X /= X0 -> + sofs_func(Ts, X, L); +sofs_func([X | _Ts], X0, _L) when X == X0 -> + ok; +sofs_func([], _X0, L) -> + L. diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl new file mode 100644 index 0000000000..cf11e8b2a0 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -0,0 +1,206 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that raise exceptions and catch them. +%%%------------------------------------------------------------------- +-module(basic_exceptions). + +-export([test/0]). + +%% functions used as arguments to spawn/3 +-export([bad_guy/2]). + +test() -> + ok = test_catch_exit(42), + ok = test_catch_throw(42), + ok = test_catch_element(), + ok = test_catch_merge(), + ok = test_pending_errors(), + ok = test_bad_fun_call(), + ok. + +%%-------------------------------------------------------------------- + +test_catch_exit(N) -> + {'EXIT', N} = (catch exit(N)), + {'EXIT', 42} = (catch exit(42)), + 42 = try exit(N) catch exit:R1 -> R1 end, + 42 = try exit(42) catch exit:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_throw(N) -> + N = (catch throw(N)), + 42 = (catch throw(42)), + 42 = try throw(N) catch throw:R1 -> R1 end, + 42 = try throw(42) catch throw:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_element() -> + 'EXIT' = test_catch_element([]), + 'EXIT' = test_catch_element(42), + ok. + +test_catch_element(N) -> + element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})). + +%%-------------------------------------------------------------------- +%% Test that shows how BEAM can merge catch-end blocks that belong to +%% different catch-start instructions. Written by Richard Carlsson. +%%-------------------------------------------------------------------- + +test_catch_merge() -> + merge(get(whatever)). + +merge(foo=X) -> + catch f(X), + catch g(X); +merge(X) -> + catch f(X), + catch g(X). + +f(_) -> ok. + +g(_) -> ok. + +%%-------------------------------------------------------------------- +%% Taken from exception_SUITE.erl +%%-------------------------------------------------------------------- + +test_pending_errors() -> + error_logger:tty(false), % disable printouts of error reports + pending_errors(). + +%% Test various exceptions, in the presence of a previous error +%% suppressed in a guard. +pending_errors() -> + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + %% pending(e_badarith, badarith), + %% pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + %% pending(e_badarg, badarg), + %% pending(e_badarg_spawn, badarg), + ok. + +bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed) + ok; +bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) + ok; +bad_guy(_, e_case) -> + case xxx() of + ok -> ok + end; % case_clause +bad_guy(_, e_if) -> + B = b(), + if + a == B -> ok + end; % if_clause +%% bad_guy(_, e_badarith) -> +%% 1+b; % badarith +bad_guy(_, e_undef) -> + non_existing_module:foo(); % undef +bad_guy(_, e_timeoutval) -> + receive + after gazonk -> ok % timeout_value + end; +bad_guy(_, e_badarg) -> + node(xxx); % badarg +bad_guy(_, e_badarg_spawn) -> + spawn({}, {}, {}); % badarg +bad_guy(_, e_badmatch) -> + a = b(). % badmatch + +xxx() -> xxx. + +b() -> b. + +pending(Arg, Expected) -> + pending(pe_badarith, Arg, Expected), + pending(pe_badarg, Arg, Expected). + +pending(First, Second, Expected) -> + pending_catched(First, Second, Expected), + pending_exit_message([First, Second], Expected). + +pending_catched(First, Second, Expected) -> + %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]), + case catch bad_guy(First, Second) of + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + exit({not_exit, Other}) + end. + +pending_exit_message(Args, Expected) -> + %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n", + %% [?MODULE, bad_guy, Args]), + process_flag(trap_exit, true), + Pid = spawn_link(?MODULE, bad_guy, Args), + receive + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + exit({unexpected_message, Other}) + after 10000 -> + exit(timeout) + end, + process_flag(trap_exit, false). + +%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, +%% Func, Args, _Code) +%% when atom(Bif), list(BifArgs), length(Args) =:= Arity -> +%% ok; +pending({badarg,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +%% ok; +pending({undef,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +%% ok; +pending({function_clause,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) +%% when length(Args) =:= Arity -> +%% ok; +pending({Code,Trace}, _, _, Code) when is_list(Trace) -> + ok; +pending(Reason, _Function, _Args, _Code) -> + exit({bad_exit_reason, Reason}). + +%%-------------------------------------------------------------------- +%% Taken from fun_SUITE.erl +%% +%% Checks correct exception throwing when calling a bad fun. +%%-------------------------------------------------------------------- + +test_bad_fun_call() -> + ok = bad_call_fc(42), + ok = bad_call_fc(xx), + ok = bad_call_fc({}), + ok = bad_call_fc({1}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3,4}), + ok = bad_call_fc({1,2,3,4,5,6}), + ok = bad_call_fc({1,2,3,4,5}), + ok = bad_call_fc({1,2}), + ok. + +bad_call_fc(Fun) -> + Args = [some, stupid, args], + Res = (catch Fun(Fun(Args))), + case Res of + {'EXIT', {{badfun, Fun} ,_Where}} -> + ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]); + Other -> + io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), + exit({bad_result, Other}) + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl new file mode 100644 index 0000000000..a3df73b928 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -0,0 +1,156 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate floating point numbers. +%%%------------------------------------------------------------------- +-module(basic_floats). + +-export([test/0]). + +test() -> + ok = test_arith_ops(), + ok = test_fp_ebb(), + ok = test_fp_phi(), + ok = test_big_bad_float(), + ok = test_catch_bad_fp_arith(), + ok = test_catch_fp_conv(), + ok = test_fp_with_fp_exceptions(), + ok. + +%%-------------------------------------------------------------------- + +test_arith_ops() -> + E = 2.5617, + 5.703200000000001 = add(E), + 0.5798000000000001 = sub(E), + 8.047580550000001 = mult(E), + -6.023e23 = negate(6.023e23), + ok. + +add(X) -> + 3.1415 + X. + +sub(X) -> + 3.1415 - X. + +mult(X) -> + 3.1415 * X. + +%% tests the translation of the fnegate BEAM instruction. +negate(X) -> + - (X + 0.0). + +%%-------------------------------------------------------------------- +%% Test the construction of overlapping extended basic blocks where +%% BEAM has constructed one and hipe_icode_fp constructs the other. +%%-------------------------------------------------------------------- + +test_fp_ebb() -> + 1.0 = foo(2*math:pi()), + 1.0 = bar(2*math:pi()), + ok. + +foo(X) -> + X / (2 * math:pi()). + +bar(X) -> + F = float_two(), + case F < 3.0 of + true -> (X * F) / ((2 * F) * math:pi()); + false -> weird + end. + +float_two() -> + 2.0. + +%%-------------------------------------------------------------------- + +test_fp_phi() -> + 10 = fp_phi(10, 100), + undefined = fp_phi(1.1e302, 0.000000001), + ok. + +fp_phi(A, B) -> + case catch A / B of + {'EXIT', _Reason} -> undefined; + _ -> round(100 * (A / B)) + end. + +%%-------------------------------------------------------------------- + +-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0"). + +test_big_bad_float() -> + ok = try f2l(?BS) catch error:badarg -> ok end, + ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end, + ok. + +f2l(F) -> + float_to_list(list_to_float(F)). + +%%-------------------------------------------------------------------- +%% Tests catching of floating point bad arithmetic. + +test_catch_bad_fp_arith() -> + 5.7 = f(2.56), + {'EXIT', {badarith, _}} = bad_arith(9.9), + ok. + +f(F) when is_float(F) -> F + 3.14. + +bad_arith(F) when is_float(F) -> + catch F * 1.70000e+308. + +%%-------------------------------------------------------------------- +%% Tests proper catching of exceptions due to illegal convertion of +%% bignums to floating point numbers. + +test_catch_fp_conv() -> + F = 1.7e308, %% F is a number very close to a maximum float. + ok = big_arith(F), + ok = big_const_float(F), + ok. + +big_arith(F) -> + I = trunc(F), + {'EXIT', {badarith, _}} = big_int_arith(I), + ok. + +big_int_arith(I) when is_integer(I) -> + catch(3.0 + 2*I). + +big_const_float(F) -> + I = trunc(F), + badarith = try (1/(2*I)) catch error:Err -> Err end, + _Ignore = 2/I, + {'EXIT', _} = (catch 4/(2*I)), + ok. + +%%-------------------------------------------------------------------- +%% Forces floating point exceptions and tests that subsequent, legal, +%% operations are calculated correctly. + +test_fp_with_fp_exceptions() -> + 0.0 = math:log(1.0), + badarith = try math:log(minus_one_float()) catch error:E1 -> E1 end, + 0.0 = math:log(1.0), + badarith = try math:log(zero_float()) catch error:E2 -> E2 end, + 0.0 = math:log(1.0), + %% An old-fashioned exception here just so as to test this case also + {'EXIT',_} = (catch fp_mult(3.23e133, 3.57e257)), + 0.0 = math:log(1.0), + badarith = try fp_div(5.0,0.0) catch error:E3 -> E3 end, + 0.0 = math:log(1.0), + ok. + +fp_mult(X, Y) -> X * Y. + +fp_div(X, Y) -> X / Y. + +%% The following two function definitions appear here just to shut +%% off 'expression will fail with a badarg' warnings from the compiler + +zero_float() -> 0.0. + +minus_one_float() -> -1.0. diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl new file mode 100644 index 0000000000..18ba7fdb3f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl @@ -0,0 +1,124 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct handling of funs. +%%%------------------------------------------------------------------- +-module(basic_fun). + +-export([test/0]). + +-export([dummy_foo/4, add1/1, test_fun03/0]). + +test() -> + ok = test_calls(), + ok = test_is_function(), + ok = test_is_function2(), + ok. + +%%-------------------------------------------------------------------- +%% Tests function and fun calls. + +test_calls() -> + ok = test_apply_call(?MODULE, dummy_foo), + ok = test_fun_call(fun dummy_foo/4), + ok = test_fun_call(fun ?MODULE:dummy_foo/4), + ok. + +test_apply_call(M, F) -> + M:F(bar, 42, foo, 17). + +test_fun_call(Fun) -> + Fun(bar, 42, foo, 17). + +dummy_foo(_, _, foo, _) -> ok. + +%%-------------------------------------------------------------------- +%% Tests handling of funs out of exported functions and 2-tuple funs. + +test_fun03() -> + MFPair = add1_as_2tuple(), + 4712 = do_call(add1_as_export(), 4711), + {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end, + true = do_guard(add1_as_export()), + false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1 + ok. + +do_call(F, X) -> F(X). + +do_guard(F) when is_function(F) -> true; +do_guard(_) -> false. + +add1_as_export() -> fun ?MODULE:add1/1. + +add1_as_2tuple() -> {?MODULE, add1}. + +add1(X) -> X+1. + +%%-------------------------------------------------------------------- +%% Tests the is_function guard and BIF. + +test_is_function() -> + Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end, + ok = test_when_guard(Fun), + ok = test_if_guard(Fun), + ok. + +test_when_guard(X) when is_function(X) -> ok. + +test_if_guard(X) -> + if is_function(X) -> ok; + true -> weird + end. + +%%-------------------------------------------------------------------- +%% Tests the is_function2 guard and BIF. + +test_is_function2() -> + ok = test_guard(), + ok = test_guard2(), + ok = test_call(), + ok. + +test_guard() -> + zero_fun = test_f2(fun () -> ok end), + unary_fun = test_f2(fun(X) -> X end), + binary_fun = test_f2(fun (X, Y) -> {X, Y} end), + no_fun = test_f2(gazonk), + ok. + +test_f2(Fun) when is_function(Fun, 0) -> + zero_fun; +test_f2(Fun) when is_function(Fun, 1) -> + unary_fun; +test_f2(Fun) when is_function(Fun, 2) -> + binary_fun; +test_f2(_) -> + no_fun. + +test_guard2() -> + zero_fun = test_f2_n(fun () -> ok end, 0), + unary_fun = test_f2_n(fun (X) -> X end, 1), + binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2), + no_fun = test_f2_n(gazonk, 0), + ok. + +test_f2_n(F, N) when is_function(F, N) -> + case N of + 0 -> zero_fun; + 1 -> unary_fun; + 2 -> binary_fun + end; +test_f2_n(_, _) -> + no_fun. + +test_call() -> + true = test_fn2(fun (X, Y) -> {X,Y} end, 2), + false = test_fn2(fun (X, Y) -> {X,Y} end, 3), + false = test_fn2(gazonk, 2), + {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)), + {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)), + ok. + +test_fn2(F, N) -> + is_function(F, N). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl new file mode 100644 index 0000000000..50c0ddd972 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -0,0 +1,58 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct handling of guards and guard BIFs. +%%%------------------------------------------------------------------- +-module(basic_guards). + +-export([test/0]). + +test() -> + ok = guard0(4.2), + ok = guard1([foo]), + ok = test_guard2(), + ok = test_guard3(), + ok. + +%%-------------------------------------------------------------------- + +guard0(X) when X /= 0, is_float(X) -> + ok. + +guard1(X) when is_atom(X) orelse is_float(X) -> + error1; +guard1(X) when is_reference(hd(X)) -> + error2; +guard1(X) when is_integer(hd(X)) -> + error3; +guard1(X) when hd(X) == foo -> + ok. + +%%-------------------------------------------------------------------- + +test_guard2() -> + ok1 = guard2(true), + not_boolean = guard2(42), + ok2 = guard2(false), + ok. + +guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true + ok1; +guard2(X) when X =:= false -> + ok2; +guard2(_) -> + not_boolean. + +%%-------------------------------------------------------------------- + +-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))). + +test_guard3() -> + no = f('foo'), + yes = f({'foo', 42}), + no = f(42), + ok. + +f(X) when ?is_foo(X) -> yes; +f(_) -> no. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl new file mode 100644 index 0000000000..47306b2502 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -0,0 +1,325 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples, mostly taken from the mailing list, that +%%% crashed the BEAM compiler or gave an internal error at some point. +%%%------------------------------------------------------------------- +-module(basic_issues_beam). + +-export([test/0]). + +test() -> + ok = test_crash_R10_hinde(), + ok = test_error_R10_mander(), + ok = test_error_R11_bjorklund(), + ok = test_error_R11_rath(), + ok = test_error_R12_empty_bin_rec(), + ok = test_bug_R12_cornish(), + ok = test_crash_R12_morris(), + ok = test_error_R13_almeida(), + ok = test_error_R13B01_fisher(), + ok = test_error_R13B01_sawatari(), + ok = test_error_R13B01_whongo(), + ok = test_error_R16B03_norell(), + ok = test_error_try_wings(), + ok. + +%%-------------------------------------------------------------------- +%% Fisher R10 compiler crash +%%-------------------------------------------------------------------- + +-record(r, {a, b, c}). + +test_crash_R10_hinde() -> + rec_R10_hinde(#r{}). + +rec_R10_hinde(As) -> + case As of + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error + end. + +%%-------------------------------------------------------------------- +%% From: Peter-Henry Mander +%% Date: 27 Jan, 2005 +%% +%% I managed to isolate a non-critical BEAM compilation error +%% (internal error in v3_codegen) when compiling the following code: +%%-------------------------------------------------------------------- + +test_error_R10_mander() -> + try just_compile_me_R10() catch _:_ -> ok end. + +just_compile_me_R10() -> + URI_Before = + {absoluteURI, + {scheme, fun() -> nil end}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + fun() -> nil end}, + nil}, + {port, nil}}}, + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + _HostportBefore}, + nil}, + {port, nil}}} = URI_Before, + %% ... some funky code ommitted, not relevant ... + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + HostportAfter}, + nil}, + {port, nil}}} = URI_Before, + %% NOTE: I intended to write URI_After instead of URI_Before + %% but the accident revealed that when you add the line below, + %% it causes internal error in v3_codegen on compilation + {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter, + ok. + +%%-------------------------------------------------------------------- +%% From: Martin Bjorklund +%% Date: Aug 16, 2006 +%% +%% I found this compiler bug in R10B-10 and R11B-0. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18 +%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_bjorklund() -> + just_compile_me_R11_bjorklund(). + +just_compile_me_R11_bjorklund() -> + G = fun() -> ok end, + try + G() %% fun() -> ok end + after + fun({A, B}) -> A + B end + end. + +%%-------------------------------------------------------------------- +%% From: Tim Rath +%% Date: Sep 13, 2006 +%% Subject: Compiler bug not quite fixed +%% +%% I saw a compiler bug posted to the list by Martin Bjorklund that +%% appeared to be exactly the problem I'm seeing, and then noticed +%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears +%% to fix the code submitted by Martin, it does not fix my case. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13 +%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_rath() -> + just_compile_me_R11_rath(). + +just_compile_me_R11_rath() -> + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end. + +%%---------------------------------------------------------------------- +%% Program that crashed the R12B-0 compiler: internal error in v3_codegen +%%---------------------------------------------------------------------- + +-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}). + +test_error_R12_empty_bin_rec() -> + 42 = test_empty_bin_rec(#rec{}), + ok. + +test_empty_bin_rec(R) -> + #rec{a = <<>>} = R, + R#rec.b. + +%%---------------------------------------------------------------------- +%% From: Simon Cornish +%% Date: Jan 13, 2008 +%% +%% The attached Erlang code demonstrates an R12B-0 bug with funs. +%% Compile and evaluate the two die/1 calls for two different failure modes. +%% It seems to me that the live register check for call_fun is off by one. +%%---------------------------------------------------------------------- + +-record(b, {c}). + +test_bug_R12_cornish() -> + {a2, a} = die(a), + {a2, {b, c}} = die({b, c}), + ok. + +die(A) -> + F = fun() -> {ok, A} end, + if A#b.c =:= [] -> one; + true -> + case F() of + {ok, A2} -> {a2, A2}; + _ -> three + end + end. + +%%---------------------------------------------------------------------- +%% From: Hunter Morris +%% Date: Nov 20, 2008 +%% +%% The following code (tested with R12B-4 or R12B-5, vanilla compiler +%% options) produces a compiler crash. It's nonsensical, and I realise +%% that andalso can be quite evil, but it's a crash nonetheless. +%%---------------------------------------------------------------------- + +test_crash_R12_morris() -> + foo(42). + +foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> + ok. + +%%-------------------------------------------------------------------- +%% From: Paulo Sergio Almeida +%% Date: May 20, 2009 +%% +%% The following code when compiled under R13B gives a compiler error. +%% Function loop/1 refers to undefined label 6 +%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%%-------------------------------------------------------------------- + +test_error_R13_almeida() -> + self() ! {backup, 42, false}, + loop([]). + +loop(Tids) -> + receive + {backup, Tid, Dumping} -> + case Dumping of + false -> ok; + _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end + end, + collect(Tid, Tids, []) + end. + +collect(_, _, _) -> ok. + +%%-------------------------------------------------------------------- +%% Fisher R13B01 compiler error +%%-------------------------------------------------------------------- + +test_error_R13B01_fisher() -> + perform_select({foo, "42"}). + +perform_select({Type, Keyval}) -> + try + if is_atom(Type) andalso length(Keyval) > 0 -> ok; + true -> ok + end + catch + _:_ -> fail + end. + +%%-------------------------------------------------------------------- +%% From: Mikage Sawatari +%% Date: Jun 12, 2009 +%% +%% I have the following compilation problem on Erlang R13B01. +%% Compiler reports "Internal consistency check failed". +%%-------------------------------------------------------------------- + +test_error_R13B01_sawatari() -> + test_sawatari([1, null, 3], <<1, 2, 3>>). + +test_sawatari([], _Bin) -> ok; +test_sawatari([H|T], Bin) -> + _ = case H of + null -> <>; + _ -> ok + end, + test_sawatari(T, Bin). + +%%-------------------------------------------------------------------- + +test_error_R13B01_whongo() -> + S = "gazonk", + S = orgno_alphanum(S), + ok. + +orgno_alphanum(Cs) -> + [C || C <- Cs, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +%%-------------------------------------------------------------------- +%% I'm getting an Internal Consistency Check error when attempting to +%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6): +%% +%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info +%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl +%% wings_color: function internal_rgb_to_hsv/3+97: +%% Internal consistency check failed - please report this bug. +%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]} +%% Error: {unsafe_instruction,{float_error_state,cleared}}: +%% +%% The problem is the interaction of the 'try' construct with the +%% handling of FP exceptions. +%%-------------------------------------------------------------------- + +test_error_try_wings() -> + %% a call with a possible FP exception + {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44), + ok. + +rgb_to_hsv(R, G, B) -> + Max = lists:max([R, G, B]), + Min = lists:min([R, G, B]), + V = Max, + {Hue, Sat} = try + {if Min == B -> (G-Min)/(R+G-2.0*Min); + Min == R -> (1.0+(B-Min)/(B+G-2.0*Min)); + Min == G -> (2.0+(R-Min)/(B+R-2.0*Min)) + end * 120, (Max-Min)/Max} + catch + error:badarith -> {undefined, 0.0} + end, + {Hue, Sat, V}. + +%%-------------------------------------------------------------------- +%% From: Ulf Norell +%% Date: Feb 28, 2014 +%% +%% This caused an internal error in v3_codegen +%%-------------------------------------------------------------------- + +test_error_R16B03_norell() -> + test_error_R16B03_norell(#r{}, gazonk). + +test_error_R16B03_norell(Rec, Tag) -> + ok. %% is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl new file mode 100644 index 0000000000..e3618c0e72 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl @@ -0,0 +1,119 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited crashes in the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_issues_hipe). + +-export([test/0]). + +%% functions that need to be exported so that they are retained. +-export([auth/4]). + +test() -> + ok = test_bif_fails(), + ok = test_var_pair(), + ok = test_find_catches(), + ok = test_heap_allocate_trim(), + ok. + +%%-------------------------------------------------------------------- +%% This is taken from a file sent to us by Martin Bjorklund @ Nortel +%% on 14th November 2004. The problem was in the SSA unconvert pass. +%% +%% No tests here; we simply check that the HiPE compiler does not go +%% into an infinite loop when compiling strange functions like this. +%% -------------------------------------------------------------------- + +auth(_, A, B, C) -> + auth(A, B, C, []). + +%%-------------------------------------------------------------------- +%% Checks that the HiPE compiler does not get confused by constant +%% data structures similar to the internal compiler data structures. +%%-------------------------------------------------------------------- + +test_var_pair() -> + ok = var_pair([gazonk]). + +var_pair([_|_]) -> + var_pair({var, some_atom}); +var_pair(_) -> + ok. + +%%-------------------------------------------------------------------- +%% This module was causing the HiPE compiler to crash in January 2007. +%% The culprit was an "optimization" of the BEAM compiler: postponing +%% the save of x variables when BIFs cannot fail. This was fixed on +%% February 1st, by making the HiPE compiler use the same functions +%% as the BEAM compiler for deciding whether a BIF fails. +%%-------------------------------------------------------------------- + +test_bif_fails() -> + [42] = bif_fails_in_catch([42]), + true = bif_fails_in_try([42]), + ok. + +bif_fails_in_catch(X) -> + case catch get(gazonk) of + _ -> X + end. + +bif_fails_in_try(X) -> + try + true = X =/= [] + catch + _ -> nil(X) + end. + +nil(_) -> []. + +%%-------------------------------------------------------------------- +%% Test that resulted in a native code compiler crash in the code of +%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2. +%%-------------------------------------------------------------------- + +test_find_catches() -> + 42 = find_catches(a, false), + ok. + +find_catches(X, Y) -> + case X of + a when Y =:= true -> + catch id(X), + X; + b when Y =:= true -> + catch id(X), + X; + a -> + catch id(X), + 42; + b -> + catch id(X), + 42 + end. + +id(X) -> X. + +%%-------------------------------------------------------------------- +%% Date: Dec 28, 2007 +%% +%% This is a test adapted from the file sent to the Erlang mailing +%% list by Eranga Udesh. The file did not compile because of problems +%% with the heap_allocate instruction and stack trimming. +%%-------------------------------------------------------------------- + +test_heap_allocate_trim() -> + {abandon, 42} = get_next_retry(a, 42), + ok. + +get_next_retry(Error, Count) -> + case catch pair(retry_scheme, {Error, Count}) of + _ -> + case pair(Error, Count) of + _ -> {abandon, Count} + end + end. + +pair(A, B) -> {A, B}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl new file mode 100644 index 0000000000..d229467b84 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl @@ -0,0 +1,41 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against lists. +%%%------------------------------------------------------------------- +-module(basic_lists). + +-export([test/0]). + +test() -> + ok = test_length(), + ok = test_lists_and_strings(), + ok. + +%%-------------------------------------------------------------------- + +test_length() -> + Len = 42, + Lst = mklist(Len, []), + Len = iterate(100, Lst), + ok. + +mklist(0, L) -> L; +mklist(X, L) -> mklist(X-1, [X|L]). + +iterate(0, L) -> len(L, 0); +iterate(X, L) -> len(L, 0), iterate(X-1, L). + +len([_|X], L) -> len(X, L+1); +len([], L) -> L. + +%%-------------------------------------------------------------------- + +test_lists_and_strings() -> + LL = ["H'A", " H'B", " H'C"], + LL2 = lists:map(fun string:strip/1, LL), + HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end, + {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2), + ["A", "B", "C"] = lists:sublist(LL3, 42), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl new file mode 100644 index 0000000000..cab48b10ba --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl @@ -0,0 +1,32 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% Date: Oct 25, 2003 +%%% +%%% Tests whether calling module_info from the same module works. +%%% This seems trivial, but the problem is that the module_info/[0,1] +%%% functions that the BEAM file contains used to be dummy functions +%%% containing crap. So, these functions could not be used for +%%% compilation to native code and the functions that the BEAM loader +%%% generates should have been used instead. This was a HiPE bug +%%% reported by Dan Wallin. +%%%------------------------------------------------------------------- +-module(basic_module_info). + +-export([test/0]). + +test() -> + L = test_local_mi0_call(), + E = test_remote_mi1_call(), + {3, 3} = {L, E}, + ok. + +test_local_mi0_call() -> + ModInfo = module_info(), + %% io:format("ok, ModInfo=~w\n", [ModInfo]), + {exports, FunList} = lists:keyfind(exports, 1, ModInfo), + length(FunList). + +test_remote_mi1_call() -> + FunList = ?MODULE:module_info(exports), + length(FunList). diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl new file mode 100644 index 0000000000..9922b34415 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -0,0 +1,36 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test pattern matching against terms of +%%% various types. +%%%------------------------------------------------------------------- +-module(basic_pattern_match). + +-export([test/0]). + +test() -> + ok = test_hello_world(), + ok. + +%%-------------------------------------------------------------------- +%% Trivial test to test pattern matching compilation with atoms, the +%% correct handling of all sorts of alphanumeric types in Erlang, and +%% conversions between them. + +test_hello_world() -> + String = gimme(string), + String = atom_to_list(gimme(atom)), + String = binary_to_list(gimme(binary)), + true = (list_to_atom(String) =:= gimme(atom)), + true = (list_to_binary(String) =:= gimme(binary)), + ok. + +gimme(string) -> + "hello world"; +gimme(atom) -> + 'hello world'; +gimme(binary) -> + <<"hello world">>. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl new file mode 100644 index 0000000000..5f865d7b7a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl @@ -0,0 +1,56 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test correct handling of receives. +%%%------------------------------------------------------------------- +-module(basic_receive). + +-export([test/0]). + +test() -> + ok = test_wait_timeout(), + ok = test_double_timeout(), + ok = test_reschedule(), + ok. + +%%-------------------------------------------------------------------- + +test_wait_timeout() -> + receive after 42 -> ok end. + +%%-------------------------------------------------------------------- + +test_double_timeout() -> + self() ! foo, + self() ! another_foo, + receive + non_existent -> weird + after 0 -> timeout + end, + receive + foo -> ok + after 1000 -> timeout + end. + +%%-------------------------------------------------------------------- +%% Check that RESCHEDULE returns from BIFs work. + +test_reschedule() -> + erts_debug:set_internal_state(available_internal_state, true), + First = self(), + Second = spawn(fun() -> doit(First) end), + receive + Second -> ok + end, + receive + after 42 -> ok + end, + erts_debug:set_internal_state(hipe_test_reschedule_resume, Second), + ok. + +doit(First) -> + First ! self(), + erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1). + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl new file mode 100644 index 0000000000..94c187e364 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl @@ -0,0 +1,177 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against tuples. +%%%------------------------------------------------------------------- +-module(basic_tuples). + +-export([test/0]). + +test() -> + Num = 4711, + ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5}, + {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}), + ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}), + ok = test_element({}, {a}, {a,b}, Num), + ok = test_setelement({}, {1}, {1,2}, 3, [1,2]), + ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num), + ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num), + ok = test_tuple_with_case(), + ok = test_tuple_in_guard({a, b}, {a, b, c}), + ok. + +%%-------------------------------------------------------------------- +%% Tests matching of tuples + +test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) -> + {} = T0, + {1} = T1, + {1, 2} = T2, + {1, 2, 3} = T3, + {1, 2, 3, 4} = T4, + {1, 2, 3, 4, 5} = T5, + {1, 2, 3, 4, 5, 6} = T6, + T6 = {1, 2, 3, 4, 5, 6}, + T7 = {1, 2, 3, 4, 5, 6, 7}, + {1, 2, 3, 4, 5, 6, 7, 8} = T8, + ok. + +%%-------------------------------------------------------------------- +%% Tests the size/1 and tuple_size/1 BIFs. + +test_size(T0, T1, T2, T3) -> + [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]], + [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]], + ok. + +%%-------------------------------------------------------------------- +%% Tests element/2. + +test_element(T0, T1, T2, N) -> + a = element(1, T1), + a = element(1, T2), + %% indirect calls to element/2 + List = lists:seq(1, N), + Tuple = list_to_tuple(List), + ok = get_elements(List, Tuple, 1), + %% some cases that throw exceptions + {'EXIT', _} = (catch my_element(0, T2)), + {'EXIT', _} = (catch my_element(3, T2)), + {'EXIT', _} = (catch my_element(1, T0)), + {'EXIT', _} = (catch my_element(1, List)), + {'EXIT', _} = (catch my_element(1, N)), + {'EXIT', _} = (catch my_element(1.5, T2)), + ok. + +my_element(Pos, Term) -> + element(Pos, Term). + +get_elements([Element|Rest], Tuple, Pos) -> + Element = element(Pos, Tuple), + get_elements(Rest, Tuple, Pos + 1); +get_elements([], _Tuple, _Pos) -> + ok. + +%%-------------------------------------------------------------------- +%% Tests set_element/3. + +test_setelement(T0, T1, Pair, Three, L) -> + {x} = setelement(1, T1, x), + {x, 2} = setelement(1, Pair, x), + {1, x} = setelement(2, Pair, x), + %% indirect calls to setelement/3 + Tuple = list_to_tuple(lists:duplicate(2048, x)), + NewTuple = set_all_elements(Tuple, 1), + NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + %% the following cases were rewritten to use the Three + %% variable in this weird way so as to silence the compiler + {'EXIT', _} = (catch setelement(Three - Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three div Three, T0, x)), + {'EXIT', _} = (catch setelement(Three div Three, L, x)), + {'EXIT', _} = (catch setelement(Three / 2, Pair, x)), + ok. + +set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) -> + set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1); +set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) -> + Tuple. + +%%-------------------------------------------------------------------- +%% Tests tuple_to_list/1. + +test_tuple_to_list(T0, T1, T2, T3, T4, Size) -> + [] = tuple_to_list(T0), + [a] = tuple_to_list(T1), + [a, b] = tuple_to_list(T2), + [a, b, c] = tuple_to_list(T3), + [a, b, c, d] = tuple_to_list(T4), + [a, b, c, d] = tuple_to_list(T4), + %% test a big tuple + List = lists:seq(1, Size), + Tuple = list_to_tuple(List), + Size = tuple_size(Tuple), + List = tuple_to_list(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))), + {'EXIT', _} = (catch my_tuple_to_list(Size)), + ok. + +my_tuple_to_list(X) -> + tuple_to_list(X). + +%%-------------------------------------------------------------------- +%% Tests list_to_tuple/1. + +test_list_to_tuple(L0, L1, L2, L3, L4, Size) -> + {} = list_to_tuple(L0), + {a} = list_to_tuple(L1), + {a, b} = list_to_tuple(L2), + {a, b, c} = list_to_tuple(L3), + {a, b, c, d} = list_to_tuple(L4), + {a, b, c, d, e} = list_to_tuple(L4++[e]), + %% test list_to_tuple with a big list + Tuple = list_to_tuple(lists:seq(1, Size)), + Size = tuple_size(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_list_to_tuple({a,b})), + {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])), + ok. + +my_list_to_tuple(X) -> + list_to_tuple(X). + +%%-------------------------------------------------------------------- +%% Tests that a case nested inside a tuple is ok. +%% (This was known to crash earlier versions of BEAM.) + +test_tuple_with_case() -> + {reply, true} = tuple_with_case(), + ok. + +tuple_with_case() -> + %% The following comments apply to the BEAM compiler. + void(), % Reset var count. + {reply, % Compiler will choose {x,1} for tuple. + case void() of % Call will reset var count. + {'EXIT', Reason} -> % Case will return in {x,1} (first free), + {error, Reason}; % but the tuple will be build in {x,1}, + _ -> % so case value is lost and a circular + true % data element is built. + end}. + +void() -> ok. + +%%-------------------------------------------------------------------- +%% Test to build a tuple in a guard. + +test_tuple_in_guard(T2, T3) -> + %% T2 = {a, b}; T3 = {a, b, c} + ok = if T2 == {element(1, T3), element(2, T3)} -> ok; + true -> other + end, + ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok; + true -> other + end, + ok. -- cgit v1.2.3 From 6a645e07a02f9adda9b9534214e699ad8f30a15f Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 4 Mar 2014 14:05:49 +0100 Subject: More basic tests and some tests that the HiPE compiler is not causing trouble --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 2 +- .../test/basic_SUITE_data/basic_beam_instrs.erl | 12 ++ lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 19 ++ lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl | 37 ++++ lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 111 +++++++++- .../test/basic_SUITE_data/basic_exceptions.erl | 122 ++++++++++- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 17 ++ .../test/basic_SUITE_data/basic_issues_hipe.erl | 38 +++- lib/hipe/test/basic_SUITE_data/basic_lists.erl | 22 +- lib/hipe/test/basic_SUITE_data/basic_random.erl | 238 +++++++++++++++++++++ lib/hipe/test/basic_SUITE_data/basic_records.erl | 28 +++ .../test/sanity_SUITE_data/sanity_comp_timeout.erl | 26 +++ .../test/sanity_SUITE_data/sanity_no_zombies.erl | 19 ++ 13 files changed, 677 insertions(+), 14 deletions(-) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_random.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_records.erl create mode 100644 lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl create mode 100644 lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl index 3dddc265c8..0277ad852b 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_arith.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -43,7 +43,7 @@ bbb(X, Y, Z) -> %% Tests unary plus: it used to be the identity function but not anymore test_uplus() -> - badarith = try uplus(gazonk) catch error:E -> E end, + badarith = try uplus(gazonk) catch error:Err -> Err end, 42 = uplus(42), ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl index 50c2180cbd..6fafea3b09 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl @@ -13,6 +13,7 @@ test() -> ok = test_switch_val(), ok = test_put_literal(), ok = test_set_tuple_element(), + ok = test_unguarded_unsafe_element(), ok. %%-------------------------------------------------------------------- @@ -88,3 +89,14 @@ simple_set(State, Val) -> %% f3 = Val is the one used in set_element; odd_set(State, Val) -> %% f3 = foo is the one used in set_element; State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant + +%%-------------------------------------------------------------------- +%% Tests the handling of unguarded unsafe_element operations that BEAM +%% can sometimes construct on records (when it has enough context). + +test_unguarded_unsafe_element() -> + {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end, + ok. + +unguarded_unsafe_element(X) -> + X#rec{f1 = X#rec.f3}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl index c455bf318f..79f62e3229 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -13,6 +13,8 @@ test() -> ok = test_big_fac(), ok = test_int_overfl_32(), ok = test_int_overfl_64(), + ok = test_int_overfl_32_guard(), + ok = test_int_overfl_64_guard(), ok. %%-------------------------------------------------------------------- @@ -122,3 +124,20 @@ test_int_overfl_64() -> add(X, Y) -> X + Y. %%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow in guards + +test_int_overfl_32_guard() -> + ok = overfl_in_guard(16#7ffffff, 0), + ok = overfl_in_guard(16#7ffffff, 16#7ffffff), + ok. + +test_int_overfl_64_guard() -> + ok = overfl_in_guard(16#7ffffffffffffff, 0), + ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff), + ok. + +overfl_in_guard(X, Y) -> + case ok of + V when X+Y > 12 -> V; + _ -> bad + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl index 0cf9a3cd4c..964b0f423a 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl @@ -8,6 +8,8 @@ -export([test/0]). +%% the following is needed for the test_weird_message +-export([loop/1]). %% the following are needed for the test_catch_bug -behaviour(gen_server). -export([start_link/1]). @@ -16,6 +18,7 @@ test() -> ok = test_fp_basic_blocks(), + ok = test_weird_message(), ok = test_catch_bug(), ok. @@ -63,6 +66,40 @@ bad_arith2(X, Y) when is_float(X) -> Y1 = element(1, Y), {X1 + 1.0, Y1}. +%%-------------------------------------------------------------------- +%% Sending 'test' to this process should return 'ok'. But: +%% +%% 1> MOD:test(). +%% Weird: received true +%% timeout +%% +%% Surprisingly, the message has been bound to the value of 'ena' +%% in the record! The problem was visible in the .S file. +%%-------------------------------------------------------------------- + +-record(state, {ena = true}). + +test_weird_message() -> + P = spawn_link(?MODULE, loop, [#state{}]), + P ! {msg, self()}, + receive + What -> What + after 42 -> timeout + end. + +loop(S) -> + receive + _ when S#state.ena == false -> + io:format("Weird: ena is false\n"); + % loop(S); + {msg, Pid} -> + Pid ! ok; + % loop(S); + Other -> + io:format("Weird: received ~p\n", [Other]) + % loop(S) + end. + %%-------------------------------------------------------------------- %% This was posted on the Erlang mailing list as a question: %% diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl index 1948e4efa7..01add52cb0 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -1,9 +1,9 @@ %%% -*- erlang-indent-level: 2 -*- -%%%------------------------------------------------------------------- +%%%---------------------------------------------------------------------- %%% Author: Kostis Sagonas %%% %%% Contains code examples that exhibited bugs in the HiPE compiler. -%%%------------------------------------------------------------------- +%%%---------------------------------------------------------------------- -module(basic_bugs_hipe). -export([test/0]). @@ -11,10 +11,13 @@ test() -> ok = test_ets_bifs(), ok = test_bit_shift(), + ok = test_match_big_list(), + ok = test_unsafe_bsl(), + ok = test_unsafe_bsr(), ok = test_R12B5_seg_fault(), ok. -%%-------------------------------------------------------------------- +%%----------------------------------------------------------------------- %% From: Bjorn Gustavsson %% %% This code, if HiPE compiled, crashed like this (on SPARC) @@ -34,7 +37,7 @@ test() -> %% to other ets BIFs with a *different* arity (i.e. they have more or %% less arguments). I have probably forgotten to mention that subtle %% change. -%%-------------------------------------------------------------------- +%%----------------------------------------------------------------------- test_ets_bifs() -> Seed = {1032, 15890, 22716}, @@ -63,8 +66,7 @@ do_random_test() -> true -> ok end - end, - 2000), + end, 2000), %% io:format("~nData matched~n"), ets:match_delete(OrdSet, '_'), ets:match_delete(Set, '_'), @@ -107,7 +109,7 @@ do_n_times(Fun, N) -> end, do_n_times(Fun, N - 1). -%%-------------------------------------------------------------------- +%%----------------------------------------------------------------------- %% From: Niclas Pehrsson %% Date: Apr 20, 2006 %% @@ -115,7 +117,7 @@ do_n_times(Fun, N) -> %% that bsr in some cases shifts the bits in the wrong way... %% %% Fixed about 10 mins afterwards; was a bug in constant propagation. -%%-------------------------------------------------------------------- +%%----------------------------------------------------------------------- test_bit_shift() -> 1 = plain_shift(), % 1 @@ -153,13 +155,104 @@ shift_length_list_plus2() -> shift_fun() -> (length_list() + 4) bsr 2. +%%----------------------------------------------------------------------- +%% From: Igor Goryachev +%% Date: June 15, 2006 +%% +%% I have experienced a different behaviour and possibly a weird result +%% while playing with matching a big list on x86 and x86_64 machines. +%%----------------------------------------------------------------------- + +-define(BIG_LIST, + ["uid", "nickname", "n_family", "n_given", "email_pref", + "tel_home_number", "tel_cellular_number", "adr_home_country", + "adr_home_locality", "adr_home_region", "url", "gender", "bday", + "constitution", "height", "weight", "hair", "routine", "smoke", + "maritalstatus", "children", "independence", "school_number", + "school_locality", "school_title", "school_period", "org_orgname", + "title", "adr_work_locality", "photo_type", "photo_binval"]). + +test_match_big_list() -> + case create_tuple_with_big_const_list() of + {selected, ?BIG_LIST, _} -> ok; + _ -> weird + end. + +create_tuple_with_big_const_list() -> + {selected, ?BIG_LIST, [{"test"}]}. + +%%----------------------------------------------------------------------- +%% In October 2006 the HiPE compiler acquired more type-driven +%% optimisations of arithmetic operations. One of these, the +%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version +%% (unsafe_bsl), was incorrectly performed even when the result +%% wouldn't be a fixnum. The error occurred for all backends, but the +%% only place known to break was hipe_arm:imm_to_am1/2. Some +%% immediates got broken on ARM, causing segmentation faults in +%% compiler_tests when HiPE recompiled itself. +%%----------------------------------------------------------------------- + +test_unsafe_bsl() -> + ok = bsl_check(bsl_test_cases()). + +bsl_test_cases() -> + [{16#FF, {16#FF, 0}}, + {16#F000000F, {16#FF, 2}}]. + +bsl_check([]) -> ok; +bsl_check([{X, Y}|Rest]) -> + case imm_to_am1(X) of + Y -> bsl_check(Rest); + _ -> 'hipe_broke_bsl' + end. + +imm_to_am1(Imm) -> + imm_to_am1(Imm band 16#FFFFFFFF, 16). +imm_to_am1(Imm, RotCnt) -> + if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15}; + true -> + NewRotCnt = RotCnt - 1, + if NewRotCnt =:= 0 -> []; % full circle, no joy + true -> + NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30), + imm_to_am1(NewImm, NewRotCnt) + end + end. + +%%----------------------------------------------------------------------- +%% Another transformation, namely that of bsr to a pure fixnum bsr +%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts +%% larger than the number of bits in fixnums. Such shifts should +%% return zero, but instead they became plain machine-level shift +%% instructions. Machines often only consider the low-order bits of +%% the shift count, so machine-level shifts larger than the word size +%% do not match the Erlang semantics. +%%----------------------------------------------------------------------- + +test_unsafe_bsr() -> + ok = bsr_check(bsr_test_cases()). + +bsr_test_cases() -> + [{16#FF, 4, 16#0F}, + {16#FF, 64, 0}]. + +bsr_check([]) -> ok; +bsr_check([{X, Y, Z}|Rest]) -> + case do_bsr(X, Y) of + Z -> bsr_check(Rest); + _ -> 'hipe_broke_bsr' + end. + +do_bsr(X, Y) -> + (X band 16#FFFF) bsr (Y band 16#FFFF). + %%----------------------------------------------------------------------- %% From: Sergey S, mid January 2009. %% %% While I was playing with +native option, I run into a bug in HiPE %% which leads to segmentation fault using +native and Erlang R12B-5. %% -%% Eshell V5.6.5 (abort with ^G) +%% Eshell V5.6.5 %% 1> crash:test(). %% # Some message to be printed here each loop iteration %% Segmentation fault diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index cf11e8b2a0..082e805580 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -6,7 +6,7 @@ %%%------------------------------------------------------------------- -module(basic_exceptions). --export([test/0]). +-export([test/0, test_catches/0]). %% functions used as arguments to spawn/3 -export([bad_guy/2]). @@ -15,11 +15,63 @@ test() -> ok = test_catch_exit(42), ok = test_catch_throw(42), ok = test_catch_element(), + ok = test_catch_crash(), + ok = test_catch_empty(), ok = test_catch_merge(), + ok = test_catches_merged(), ok = test_pending_errors(), ok = test_bad_fun_call(), ok. +%%-------------------------------------------------------------------- +%% Written in 2001 by Erik Johansson. + +test_catches() -> + ExitBar = {'EXIT', bar}, + L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}], + L1 = [t1(), t2(), t3(), t4()], + badarith = (catch element(1, element(2, t5(a, b)))), + L2 = [42, ExitBar, ExitBar, {no_exception, ok}], + L2 = [t5(21, 21), t6(), t7(), t8()], + ok. + +t1() -> + catch foo(). + +t2() -> + V = (catch ok()), + s(), + V. + +t3() -> + V = (catch foo()), + V. + +t4() -> + V1 = ok(), + V2 = (catch foo()), + {V1, V2}. + +t5(A, B) -> + catch A + B. + +t6() -> + catch {no_exception, ok(), foo()}. + +t7() -> + catch {no_exception, foo(), ok()}. + +t8() -> + catch {no_exception, ok()}. + +foo() -> + s(), + exit(bar). + +ok() -> s(), ok. + +s() -> nada. + %%-------------------------------------------------------------------- test_catch_exit(N) -> @@ -48,6 +100,52 @@ test_catch_element() -> test_catch_element(N) -> element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})). +%%-------------------------------------------------------------------- + +-define(try_match(E), + catch ?MODULE:non_existing(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())). + +test_catch_crash() -> + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), + ok. + +no_match() -> nomatch. + +%% small_test() -> +%% catch ?MODULE:non_existing(), +%% io:format("Before\n",[]), +%% hipe_bifs:show_nstack(self()), +%% io:format("After\n",[]), +%% garbage_collect(). + +%%-------------------------------------------------------------------- +%% Tests whether the HiPE compiler optimizes catches in a way that +%% does not result in an infinite loop. +%%-------------------------------------------------------------------- + +test_catch_empty() -> + badmatch(). + +badmatch() -> + Big = ret_big(), + Float = ret_float(), + catch a = Big, + catch b = Float, + ok = case Big of Big -> ok end, + ok = case Float of Float -> ok end, + ok. + +ret_big() -> + 329847987298478924982978248748729829487298292982972978239874. + +ret_float() -> + 3.1415927. + %%-------------------------------------------------------------------- %% Test that shows how BEAM can merge catch-end blocks that belong to %% different catch-start instructions. Written by Richard Carlsson. @@ -67,6 +165,28 @@ f(_) -> ok. g(_) -> ok. +%%-------------------------------------------------------------------- +%% Written by Tobias Lindahl. + +test_catches_merged() -> + {'EXIT', _} = merged_catches(foo), + {'EXIT', {badarith, _}} = merged_catches(bar), + {'EXIT', _} = merged_catches(baz), + ok. + +merged_catches(X) -> + case X of + foo -> catch fail1(0); + bar -> catch {catch(1 = X), fail2(0)}; + baz -> catch fail3(0) + end. + +fail1(X) -> 1/X. + +fail2(X) -> 1/X. + +fail3(X) -> 1/X. + %%-------------------------------------------------------------------- %% Taken from exception_SUITE.erl %%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index 50c0ddd972..a519944916 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -13,6 +13,7 @@ test() -> ok = guard1([foo]), ok = test_guard2(), ok = test_guard3(), + ok = test_guard4(), ok. %%-------------------------------------------------------------------- @@ -56,3 +57,19 @@ test_guard3() -> f(X) when ?is_foo(X) -> yes; f(_) -> no. + +%%-------------------------------------------------------------------- + +-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>). + +test_guard4() -> + yes = is_ref(make_ref()), + no = is_ref(gazonk), + yes = is_ref(an_external_ref(?EXT_REF)), + ok. + +is_ref(Ref) when is_reference(Ref) -> yes; +is_ref(_Ref) -> no. + +an_external_ref(Bin) -> + binary_to_term(Bin). diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl index e3618c0e72..e71045bfe2 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl @@ -12,8 +12,10 @@ -export([auth/4]). test() -> - ok = test_bif_fails(), + ok = test_dominance_trees(), + ok = test_merged_const(), ok = test_var_pair(), + ok = test_bif_fails(), ok = test_find_catches(), ok = test_heap_allocate_trim(), ok. @@ -24,11 +26,43 @@ test() -> %% %% No tests here; we simply check that the HiPE compiler does not go %% into an infinite loop when compiling strange functions like this. -%% -------------------------------------------------------------------- +%%-------------------------------------------------------------------- auth(_, A, B, C) -> auth(A, B, C, []). +%%-------------------------------------------------------------------- +%% Exposed a crash in the generation of dominance trees used in SSA. +%%-------------------------------------------------------------------- + +-record(state, {f}). + +test_dominance_trees() -> + {ok, true} = doit(true, #state{f = true}), + ok. + +doit(Foo, S) -> + Fee = case Foo of + Bar when Bar == S#state.f; Bar == [] -> true; + _ -> false + end, + {ok, Fee}. + +%%-------------------------------------------------------------------- +%% Checks that the merging of constants in the constant table uses the +%% appropriate comparison function for this. +%%-------------------------------------------------------------------- + +test_merged_const() -> + Const1 = {'', 1.0000}, + Const2 = {'', 1}, + match(Const1, Const2). + +match(A, A) -> + error; +match(_A, _B) -> + ok. + %%-------------------------------------------------------------------- %% Checks that the HiPE compiler does not get confused by constant %% data structures similar to the internal compiler data structures. diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl index d229467b84..264a7f86f6 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_lists.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl @@ -2,7 +2,8 @@ %%%------------------------------------------------------------------- %%% Author: Kostis Sagonas %%% -%%% Contains tests that manipulate and pattern match against lists. +%%% Contains tests that manipulate and pattern match against lists +%%% (perhaps by calling functions from the 'lists' module). %%%------------------------------------------------------------------- -module(basic_lists). @@ -10,6 +11,7 @@ test() -> ok = test_length(), + ok = test_lists_key(), ok = test_lists_and_strings(), ok. @@ -32,6 +34,24 @@ len([], L) -> L. %%-------------------------------------------------------------------- +test_lists_key() -> + First = {x, 42.0}, + Second = {y, -77}, + Third = {z, [a, b, c], {5.0}}, + List = [First, Second, Third], + {value, First} = key_search_find(42, 2, List), + ok. + +key_search_find(Key, Pos, List) -> + case lists:keyfind(Key, Pos, List) of + false -> + false = lists:keysearch(Key, Pos, List); + Tuple when is_tuple(Tuple) -> + {value, Tuple} = lists:keysearch(Key, Pos, List) + end. + +%%-------------------------------------------------------------------- + test_lists_and_strings() -> LL = ["H'A", " H'B", " H'C"], LL2 = lists:map(fun string:strip/1, LL), diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl new file mode 100644 index 0000000000..8866218318 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -0,0 +1,238 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% A test for list handling created using the 'random' module. +%%%------------------------------------------------------------------- +-module(basic_random). + +-export([test/0]). + +%% It can be used as a benchmark by playing with the following defines +-define(N, 1000). +-define(Iter, 500). + +test() -> + ok = random(?N). + +random(N) -> + random(N, ?Iter). + +random(N, Iter) -> + random:seed(1, 2, 3), + t(ranlist(N, [], N*100), Iter). + +ranlist(0, L, _N) -> L; +ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0). + +t(_, 0) -> ok; +t(L, Iter) -> + %% io:format("Sort starting~n"), + sort(L), + t(L, Iter-1). + +sort([X, Y | L]) when X =< Y -> + split_1(X, Y, L, [], []); +sort([X, Y | L]) -> + split_2(X, Y, L, [], []); +sort(L) -> + L. + +%% Ascending. +split_1(X, Y, [Z | L], R, Rs) when Z >= Y -> + split_1(Y, Z, L, [X | R], Rs); +split_1(X, Y, [Z | L], R, Rs) when Z >= X -> + split_1(Z, Y, L, [X | R], Rs); +split_1(X, Y, [Z | L], [], Rs) -> + split_1(X, Y, L, [Z], Rs); +split_1(X, Y, [Z | L], R, Rs) -> + split_1_1(X, Y, L, R, Rs, Z); +split_1(X, Y, [], R, Rs) -> + rmergel([[Y, X | R] | Rs], []). + +%% One out-of-order element, S. +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y -> + split_1_1(Y, Z, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X -> + split_1_1(Z, Y, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z -> + split_1(S, Z, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [Z | L], R, Rs, S) -> + split_1(Z, S, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [], R, Rs, S) -> + rmergel([[S], [Y, X | R] | Rs], []). + +%% Descending. +split_2(X, Y, [Z | L], R, Rs) when Z =< Y -> + split_2(Y, Z, L, [X | R], Rs); +split_2(X, Y, [Z | L], R, Rs) when Z =< X -> + split_2(Z, Y, L, [X | R], Rs); +split_2(X, Y, [Z | L], [], Rs) -> + split_2(X, Y, L, [Z], Rs); +split_2(X, Y, [Z | L], R, Rs) -> + split_2_1(X, Y, L, R, Rs, Z); +split_2(X, Y, [], R, Rs) -> + mergel([[Y, X | R] | Rs], []). + +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y -> + split_2_1(Y, Z, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X -> + split_2_1(Z, Y, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z -> + split_2(S, Z, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [Z | L], R, Rs, S) -> + split_2(Z, S, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [], R, Rs, S) -> + mergel([[S], [Y, X | R] | Rs], []). + +mergel([[] | L], Acc) -> + mergel(L, Acc); +mergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]); +mergel([A, [H | T]], Acc) -> + rmergel([merge2_1(A, H, T, []) | Acc], []); +mergel([L], []) -> + L; +mergel([L], Acc) -> + rmergel([lists:reverse(L, []) | Acc], []); +mergel([], []) -> + []; +mergel([], Acc) -> + rmergel(Acc, []); +mergel([A, [] | L], Acc) -> + mergel([A | L], Acc); +mergel([A, B, [] | L], Acc) -> + mergel([A, B | L], Acc). + +rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]); +rmergel([A, [H | T]], Acc) -> + mergel([rmerge2_1(A, H, T, []) | Acc], []); +rmergel([L], Acc) -> + mergel([lists:reverse(L, []) | Acc], []); +rmergel([], Acc) -> + mergel(Acc, []). + +%% Take L1 apart. +merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_1([H1 | T1], M, H2, T2, H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 -> + merge2_1(T2, H3, T3, [H2 | M]); +merge3_1(_nil, M, H2, T2, H3, T3) -> + merge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 -> + merge2_1(T1, H3, T3, [H1 | M]); +merge3_2(T1, H1, M, _nil, H3, T3) -> + merge2_1(T3, H1, T1, [H3 | M]). + +%% H1 <= H2. Inlined. +merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12(T1, H1, H2, T2, H3, T3, M) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 <= H2, take L3 apart. +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3); +merge3_12_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T1, H2, T2, [H1 | M]). + +%% H1 > H2. Inlined. +merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21(T1, H1, H2, T2, H3, T3, M) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 > H2, take L3 apart. +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3); +merge3_21_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T2, H1, T1, [H2 | M]). + +%% Take L1 apart. +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 -> + rmerge2_1(T2, H3, T3, [H2 | M]); +rmerge3_1(_nil, M, H2, T2, H3, T3) -> + rmerge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 -> + rmerge2_1(T1, H3, T3, [H1 | M]); +rmerge3_2(T1, H1, M, _nil, H3, T3) -> + rmerge2_1(T3, H1, T1, [H3 | M]). + +%% H1 > H2. Inlined. +rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 > H2, take L3 apart. +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3); +rmerge3_12_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T1, H2, T2, [H1 | M]). + +%% H1 =< H2. Inlined. +rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 =< H2, take L3 apart. +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3); +rmerge3_21_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T2, H1, T1, [H2 | M]). + +merge2_1([H1 | T1], H2, T2, M) when H2 < H1 -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_1([H1 | T1], H2, T2, M) -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_2(T1, H1, [H2 | T2], M) -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). + +rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_1([H1 | T1], H2, T2, M) -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_2(T1, H1, [H2 | T2], M) -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl new file mode 100644 index 0000000000..cbb451196c --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against records. +%%%------------------------------------------------------------------- +-module(basic_records). + +-export([test/0]). + +test() -> + ok = test_rec1(), + ok. + +%%-------------------------------------------------------------------- + +-record(r, {ra}). +-record(s, {sa, sb, sc, sd}). + +test_rec1() -> + R = #r{}, + S = #s{}, + S1 = S#s{sc=R, sd=1}, + R1 = S1#s.sc, + undefined = R1#r.ra, + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl new file mode 100644 index 0000000000..bee38fd87a --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests that when the native code compilation times out or gets killed +%%% for some other reason, the parent process does not also get killed. +%%% +%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis. +%%%---------------------------------------------------------------------- + +-module(sanity_comp_timeout). + +-export([test/0]). + +test() -> + ok = write_dummy_mod(), + error_logger:tty(false), % disable printouts of error reports + Self = self(), % get the parent process + c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process + Self = self(), % make sure the parent process stays the same + ok. + +write_dummy_mod() -> + Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>, + ok = file:write_file("dummy_mod.erl", Prog). + diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl new file mode 100644 index 0000000000..f9f9951de2 --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -0,0 +1,19 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Per Gustafsson +%%% +%%% Checks that HiPE's concurrent compilation does not leave any zombie +%%% processes around after compilation has finished. +%%% +%%% This was a bug reported on erlang-bugs (Oct 25, 2007). +%%%---------------------------------------------------------------------- + +-module(sanity_no_zombies). + +-export([test/0]). + +test() -> + L = length(processes()), + hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation + L = length(processes()), + ok. -- cgit v1.2.3 From f3b62ad3fb0b989d58e9018cbe3b62d4d7300341 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sun, 23 Mar 2014 13:21:26 +0100 Subject: Add function to prevent running tests in the LLVM backend --- lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl | 4 +++- lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl index bee38fd87a..9f0830574f 100644 --- a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -10,7 +10,7 @@ -module(sanity_comp_timeout). --export([test/0]). +-export([test/0, to_llvm/0]). test() -> ok = write_dummy_mod(), @@ -20,6 +20,8 @@ test() -> Self = self(), % make sure the parent process stays the same ok. +to_llvm() -> false. + write_dummy_mod() -> Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>, ok = file:write_file("dummy_mod.erl", Prog). diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl index f9f9951de2..87e746042e 100644 --- a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -10,10 +10,12 @@ -module(sanity_no_zombies). --export([test/0]). +-export([test/0, to_llvm/0]). test() -> L = length(processes()), hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation L = length(processes()), ok. + +to_llvm() -> false. -- cgit v1.2.3 From 348059f6ff735362977115d5910c1edbd3f1bc25 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:50:40 +0200 Subject: Use function from hipe module instead of a local one --- lib/hipe/test/hipe_testsuite_driver.erl | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 5f05a716bc..9f5d7421b4 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -176,7 +176,8 @@ run(TestCase, Dir, _OutDir) -> HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, {ok, TestCase} = hipe:c(TestCase, HiPEOpts), ok = TestCase:test(), - case is_llvm_opt_available() of + ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, + case ToLLVM andalso hipe:llvm_support_available() of true -> {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), ok = TestCase:test(); @@ -186,16 +187,3 @@ run(TestCase, Dir, _OutDir) -> %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. - - -%% This function, which is supposed to check whether the right LLVM -%% infrastructure is available, should be probably written in a better -%% and more portable way and moved to the hipe application. - -is_llvm_opt_available() -> - OptStr = os:cmd("opt -version"), - SubStr = "LLVM version ", N = length(SubStr), - case string:str(OptStr, SubStr) of - 0 -> false; - S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4" - end. -- cgit v1.2.3 From 7cfbe22bca2569f763b0ca0bbd04eeaaa5a0e298 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:52:06 +0200 Subject: Add more generated test suites in Makefile --- lib/hipe/test/Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 009f503abb..d781e4f9be 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -10,8 +10,10 @@ MODULES= \ # .erl files for these modules are automatically generated GEN_MODULES= \ + basic_SUITE \ bs_SUITE \ - maps_SUITE + maps_SUITE \ + sanity_SUITE ERL_FILES= $(MODULES:%=%.erl) -- cgit v1.2.3 From 77084e1b477a4cf99b944d0e06afd707c51e6576 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Apr 2014 23:52:57 +0200 Subject: Minor code cleanup --- lib/hipe/test/bs_SUITE_data/bs_split.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl index 2e52308a77..617543f789 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_split.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -26,13 +26,13 @@ bs1(L, B, Pos, Sz1, Sz2) -> <> = B, bs2(L, B, Pos, B1, B2). -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). + byte_split(L, B, Pos - 1). %%-------------------------------------------------------------------- @@ -56,14 +56,14 @@ 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(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_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). @@ -101,5 +101,5 @@ z_split(B, N) -> <<_:N/binary>> -> [B]; _ -> - z_split(B, N+1) + z_split(B, N + 1) end. -- cgit v1.2.3 From 1c6075b7c69709ce129e817b4652ccb5ff9d2e95 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Thu, 3 Apr 2014 01:24:51 +0200 Subject: More tests for handling of UTF in bitstrings --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 343 ++++++++++++++++++++++++++++++++- 1 file changed, 340 insertions(+), 3 deletions(-) diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index f50ae08964..3a1988be0a 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -1,18 +1,355 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------- -%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%% Purpose: test support for UTF datatypes in binaries +%% +%% Most of it taken from emulator/test/bs_utf_SUITE.erl %%------------------------------------------------------------------- -module(bs_utf). -export([test/0]). +-include_lib("test_server/include/test_server.hrl"). + test() -> + ok = utf8_cm65(), + ok = utf8_roundtrip(), + ok = utf16_roundtrip(), + ok = utf32_roundtrip(), + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), + ok. + +%%------------------------------------------------------------------- +%% A test with construction and matching + +utf8_cm65() -> <<65>> = b65utf8(), ok = m(<<65>>). +b65utf8() -> + <<65/utf8>>. + m(<<65/utf8>>) -> ok. -b65utf8() -> - <<65/utf8>>. +%%------------------------------------------------------------------- + +utf8_roundtrip() -> + ok = utf8_roundtrip(0, 16#D7FF), + ok = utf8_roundtrip(16#E000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> + ok. + +%%------------------------------------------------------------------- + +utf16_roundtrip() -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf32_roundtrip() -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf8_illegal_sequences() -> + fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + + %% Illegal first character. + [fail(<>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + %% io:format("~p - ~p\n", [Char, CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <> -> + <> = S0, + <> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<>), + fail(<>), + fail(<>); + <> -> + <> = S0, + fail(S0), + fail(S1), + fail(<>), + fail(<>), + fail(<>); + <> -> + fail(S), + fail(<>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<> = Bin) -> + ?t:fail({illegal_encoding_accepted, Bin, Char}); +fail_1(_) -> ok. + +%%------------------------------------------------------------------- + +utf16_illegal_sequences() -> + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + {'EXIT', _} = (catch <>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +%%------------------------------------------------------------------- + +utf32_illegal_sequences() -> + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <>), + {'EXIT', _} = (catch <>), + case {<>,<>} of + {<>,_} -> + ?t:fail(Unexpected); + {_,<>} -> + ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +%%------------------------------------------------------------------- +%% This function intentionally allows construction of UTF-8 sequence +%% in illegal ranges. + +int_to_utf8(I) when I =< 16#7F -> + <>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +%%------------------------------------------------------------------- + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%%------------------------------------------------------------------- +%% Just to prevent compiler optimizations + +id(X) -> X. -- cgit v1.2.3 From 1c759f0bab4b0598231bd6e1d78171722d5c29df Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sat, 28 Nov 2015 22:18:42 +0100 Subject: Cleanups & uncomment some code --- lib/hipe/test/basic_SUITE_data/basic_arith.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_bignums.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_floats.erl | 2 +- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 6 ++-- .../test/basic_SUITE_data/basic_issues_beam.erl | 38 +++++++++++----------- lib/hipe/test/basic_SUITE_data/basic_random.erl | 4 +-- 6 files changed, 27 insertions(+), 27 deletions(-) diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl index 0277ad852b..28e99be053 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_arith.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -14,7 +14,7 @@ test() -> ok = test_uplus(), ok = test_bsl_errors(), ok. - + %%---------------------------------------------------------------------- %% Tests the remainder operator. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl index 79f62e3229..e3b523b3f5 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -87,7 +87,7 @@ bsl_f(X, Y) -> X bsl Y. %% applies a binary function N times n(1, F, X, Y) -> F(X, Y); -n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). %%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl index a3df73b928..c49ac3946e 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_floats.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -36,7 +36,7 @@ sub(X) -> mult(X) -> 3.1415 * X. - + %% tests the translation of the fnegate BEAM instruction. negate(X) -> - (X + 0.0). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index a519944916..4bfe363ed3 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -35,7 +35,7 @@ guard1(X) when hd(X) == foo -> test_guard2() -> ok1 = guard2(true), not_boolean = guard2(42), - ok2 = guard2(false), + ok2 = guard2(false), ok. guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true @@ -48,7 +48,7 @@ guard2(_) -> %%-------------------------------------------------------------------- -define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))). - + test_guard3() -> no = f('foo'), yes = f({'foo', 42}), @@ -65,7 +65,7 @@ f(_) -> no. test_guard4() -> yes = is_ref(make_ref()), no = is_ref(gazonk), - yes = is_ref(an_external_ref(?EXT_REF)), + yes = is_ref(an_external_ref(?EXT_REF)), ok. is_ref(Ref) when is_reference(Ref) -> yes; diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl index 47306b2502..7c4db28dd4 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -33,11 +33,11 @@ test() -> test_crash_R10_hinde() -> rec_R10_hinde(#r{}). - + rec_R10_hinde(As) -> case As of - A when A#r.b == ""; A#r.b == undefined -> ok; - _ -> error + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error end. %%-------------------------------------------------------------------- @@ -118,7 +118,7 @@ just_compile_me_R11_bjorklund() -> %% From: Tim Rath %% Date: Sep 13, 2006 %% Subject: Compiler bug not quite fixed -%% +%% %% I saw a compiler bug posted to the list by Martin Bjorklund that %% appeared to be exactly the problem I'm seeing, and then noticed %% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears @@ -198,9 +198,9 @@ die(A) -> test_crash_R12_morris() -> foo(42). - + foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> - ok. + ok. %%-------------------------------------------------------------------- %% From: Paulo Sergio Almeida @@ -237,20 +237,20 @@ collect(_, _, _) -> ok. test_error_R13B01_fisher() -> perform_select({foo, "42"}). -perform_select({Type, Keyval}) -> +perform_select({Type, Keyval}) -> try - if is_atom(Type) andalso length(Keyval) > 0 -> ok; - true -> ok - end - catch - _:_ -> fail - end. + if is_atom(Type) andalso length(Keyval) > 0 -> ok; + true -> ok + end + catch + _:_ -> fail + end. %%-------------------------------------------------------------------- %% From: Mikage Sawatari %% Date: Jun 12, 2009 %% -%% I have the following compilation problem on Erlang R13B01. +%% I have the following compilation problem on Erlang R13B01. %% Compiler reports "Internal consistency check failed". %%-------------------------------------------------------------------- @@ -263,7 +263,7 @@ test_sawatari([H|T], Bin) -> null -> <>; _ -> ok end, - test_sawatari(T, Bin). + test_sawatari(T, Bin). %%-------------------------------------------------------------------- @@ -278,10 +278,10 @@ orgno_alphanum(Cs) -> orelse ((C >= $A) andalso (C =< $Z))]. %%-------------------------------------------------------------------- -%% I'm getting an Internal Consistency Check error when attempting to +%% I'm getting an Internal Consistency Check error when attempting to %% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6): -%% -%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info +%% +%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info %% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl %% wings_color: function internal_rgb_to_hsv/3+97: %% Internal consistency check failed - please report this bug. @@ -322,4 +322,4 @@ test_error_R16B03_norell() -> test_error_R16B03_norell(#r{}, gazonk). test_error_R16B03_norell(Rec, Tag) -> - ok. %% is_record(Rec, Tag, 3) orelse ok. + is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl index 8866218318..783947bd31 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_random.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -218,7 +218,7 @@ merge2_1(_nil, H2, T2, M) -> merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 -> merge2_1(T1, H2, T2, [H1 | M]); -merge2_2(T1, H1, [H2 | T2], M) -> +merge2_2(T1, H1, [H2 | T2], M) -> merge2_2(T1, H1, T2, [H2 | M]); merge2_2(T1, H1, _nil, M) -> lists:reverse(T1, [H1 | M]). @@ -232,7 +232,7 @@ rmerge2_1(_nil, H2, T2, M) -> rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 -> rmerge2_1(T1, H2, T2, [H1 | M]); -rmerge2_2(T1, H1, [H2 | T2], M) -> +rmerge2_2(T1, H1, [H2 | T2], M) -> rmerge2_2(T1, H1, T2, [H2 | M]); rmerge2_2(T1, H1, _nil, M) -> lists:reverse(T1, [H1 | M]). -- cgit v1.2.3 From e991a1cf556e3af1894773834195d33d4e3bbb78 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sat, 28 Nov 2015 22:19:45 +0100 Subject: Comment out tests that are not ready for to_llvm --- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index 3a1988be0a..b50566ab1b 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -16,9 +16,10 @@ test() -> ok = utf8_roundtrip(), ok = utf16_roundtrip(), ok = utf32_roundtrip(), - ok = utf8_illegal_sequences(), - ok = utf16_illegal_sequences(), - ok = utf32_illegal_sequences(), + %% Currently, the following are problematic for the LLVM backend + %% ok = utf8_illegal_sequences(), + %% ok = utf16_illegal_sequences(), + %% ok = utf32_illegal_sequences(), ok. %%------------------------------------------------------------------- @@ -134,10 +135,10 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences() -> fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. - + %% Illegal first character. [fail(<>) || I <- lists:seq(16#80, 16#BF)], - + %% Short sequences. short_sequences(16#80, 16#10FFFF), -- cgit v1.2.3 From 11e67cc4bfa8242bbb5a5c64d91dd6186bb2c4e4 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Sun, 29 Nov 2015 15:05:30 +0100 Subject: Minor cleanup Take out extraneous spaces at the end of lines. --- lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl index 7c4db28dd4..73367c5c45 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -119,6 +119,7 @@ just_compile_me_R11_bjorklund() -> %% Date: Sep 13, 2006 %% Subject: Compiler bug not quite fixed %% +%% %% I saw a compiler bug posted to the list by Martin Bjorklund that %% appeared to be exactly the problem I'm seeing, and then noticed %% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears @@ -201,7 +202,7 @@ test_crash_R12_morris() -> foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> ok. - + %%-------------------------------------------------------------------- %% From: Paulo Sergio Almeida %% Date: May 20, 2009 -- cgit v1.2.3 From e91d465773e349409476ab8c85f9967a4fb7cc4a Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:12:30 +0100 Subject: Three more tests added --- lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 81 ++++++++++++ .../test/basic_SUITE_data/basic_exceptions.erl | 139 +++++++++++++++++++++ .../test/basic_SUITE_data/basic_pattern_match.erl | 10 ++ 3 files changed, 230 insertions(+) diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl index 01add52cb0..e70c25c905 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -10,6 +10,7 @@ test() -> ok = test_ets_bifs(), + ok = test_szar_bug(), ok = test_bit_shift(), ok = test_match_big_list(), ok = test_unsafe_bsl(), @@ -109,6 +110,86 @@ do_n_times(Fun, N) -> end, do_n_times(Fun, N - 1). +%%----------------------------------------------------------------------- +%% From: Jozsef Berces (PR/ECZ) +%% Date: Feb 19, 2004 +%% +%% Program which was added to the testsuite as a result of another bug +%% report involving tuples as funs. Thanks God, these are no longer +%% supported, but the following is a good test for testing calling +%% native code funs from BEAM code (lists:map, lists:filter, ...). +%%----------------------------------------------------------------------- + +test_szar_bug() -> + ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"), + ok. + +smartconcat(B, L) -> + LL = tokenize(L, $,), + NewlineDel = fun (X) -> killcontrol(X) end, + StripFun = fun (X) -> string:strip(X) end, + LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)), + EmptyDel = fun(X) -> + case string:len(X) of + 0 -> false; + _ -> true + end + end, + LL3 = lists:filter(EmptyDel, LL2), + HexFormat = fun(X, Acc) -> + case string:str(X, "H'") of + 1 -> + case checkhex(string:substr(X, 3)) of + {ok, Y} -> + {Y, Acc}; + _ -> + {X, Acc + 1} + end; + _ -> + {X, Acc + 1} + end + end, + {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3), + lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))). + +checkhex(L) -> + checkhex(L, ""). + +checkhex([H | T], N) when H >= $0, H =< $9 -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H >= $A, H =< $F -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H =< 32 -> + checkhex(T, N); +checkhex([_ | _], _) -> + {error, ""}; +checkhex([], N) -> + {ok, lists:reverse(N)}. + +killcontrol([C | S]) when C < 32 -> + killcontrol(S); +killcontrol([C | S]) -> + [C | killcontrol(S)]; +killcontrol([]) -> + []. + +tokenize(L, C) -> + tokenize(L, C, [], []). + +tokenize([C | T], C, A, B) -> + case A of + [] -> + tokenize(T, C, [], B); + _ -> + tokenize(T, C, [], [lists:reverse(A) | B]) + end; +tokenize([H | T], C, A, B) -> + tokenize(T, C, [H | A], B); +tokenize(_, _, [], B) -> + lists:reverse(B); +tokenize(_, _, A, B) -> + lists:reverse([lists:reverse(A) | B]). + %%----------------------------------------------------------------------- %% From: Niclas Pehrsson %% Date: Apr 20, 2006 diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index 082e805580..229a0516dc 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -21,6 +21,7 @@ test() -> ok = test_catches_merged(), ok = test_pending_errors(), ok = test_bad_fun_call(), + ok = test_guard_bif(), ok. %%-------------------------------------------------------------------- @@ -324,3 +325,141 @@ bad_call_fc(Fun) -> io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), exit({bad_result, Other}) end. + +%%-------------------------------------------------------------------- +%% Taken from guard_SUITE.erl +%% +%% Tests correct handling of exceptions by calling guard BIFs with +%% nasty (but legal arguments). +%%-------------------------------------------------------------------- + +test_guard_bif() -> + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, + + %% Succeding use of guard bifs. + + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), + + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), + + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), + + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), + + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), + + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), + + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), + + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), + + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), + + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), + + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), + + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), + + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), + + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), + + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_gbif}) + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_fail_gbif}) + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl index 9922b34415..93240354a7 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -11,6 +11,7 @@ test() -> ok = test_hello_world(), + ok = test_list_plus_plus_match(), ok. %%-------------------------------------------------------------------- @@ -34,3 +35,12 @@ gimme(binary) -> <<"hello world">>. %%-------------------------------------------------------------------- +%% Makes sure that pattern matching expressions involving ++ work OK. +%% The third expression caused a problem in the Erlang shell of R11B-5. +%% It worked OK in both interpreted and compiled code. + +test_list_plus_plus_match() -> + ok = (fun("X" ++ _) -> ok end)("X"), + ok = (fun([$X | _]) -> ok end)("X"), + ok = (fun([$X] ++ _) -> ok end)("X"), + ok. -- cgit v1.2.3 From c3e5a1ea98d2dae23aa6d050f93b7912dbe6f43c Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:42:56 +0100 Subject: Test that apply/3 is tail recursive --- lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl | 39 +++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl new file mode 100644 index 0000000000..0124f13df6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl @@ -0,0 +1,39 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that check that tail recursion optimization occurs. +%%%------------------------------------------------------------------- +-module(basic_tail_rec). + +-export([test/0]). +-export([app0/2]). %% used in an apply/3 call + +test() -> + ok = test_app_tail(), + ok. + +%%-------------------------------------------------------------------- +%% Written by Mikael Pettersson: check that apply is tail recursive. + +%% Increased the following quantity from 20 to 30 so that the test +%% remains valid even with the naive register allocator. - Kostis +-define(SIZE_INCREASE, 30). + +test_app_tail() -> + Inc = start(400), + %% io:format("Inc ~w\n", [Inc]), + case Inc > ?SIZE_INCREASE of + true -> + {error, "apply/3 is not tail recursive in native code"}; + false -> + ok + end. + +start(N) -> + app0(N, hipe_bifs:nstack_used_size()). + +app0(0, Size0) -> + hipe_bifs:nstack_used_size() - Size0; +app0(N, Size) -> + apply(?MODULE, app0, [N-1, Size]). -- cgit v1.2.3 From 664cfa9f9c0676bdc949b2fd8c92dabcb3f75a09 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 00:54:40 +0100 Subject: Two more tests added - A test for proper handling of negative numbers in binary search key tables - A test for HiPE's ICode range analysis --- lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl | 102 ++++++++++++++++++++- 1 file changed, 101 insertions(+), 1 deletion(-) diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl index e70c25c905..caa0e71d0b 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -16,6 +16,8 @@ test() -> ok = test_unsafe_bsl(), ok = test_unsafe_bsr(), ok = test_R12B5_seg_fault(), + ok = test_switch_neg_int(), + ok = test_icode_range_anal(), ok. %%----------------------------------------------------------------------- @@ -338,7 +340,7 @@ do_bsr(X, Y) -> %% # Some message to be printed here each loop iteration %% Segmentation fault %% -%% Diagnozed and fixed by Mikael Petterson (22 Jan 2009): +%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009): %% %% I've analysed the recently posted HiPE bug report on erlang-bugs %% . @@ -361,3 +363,101 @@ repeat(N, Fun) -> %% io:format("# Some message to be printed here each loop iteration\n"), Fun(), repeat(N - 1, Fun). + +%%----------------------------------------------------------------------- +%% From: Jon Meredith +%% Date: July 9, 2009 +%% +%% Binary search key tables are sorted by the loader based on the +%% runtime representations of the keys as unsigned words. However, +%% the code generated for the binary search used signed comparisons. +%% That worked for atoms and non-negative fixnums, but not for +%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009. +%%----------------------------------------------------------------------- + +test_switch_neg_int() -> + ok = f(-80, 8). + +f(10, -1) -> ok; +f(X, Y) -> + Y = g(X), + f(X + 10, Y - 1). + +g(X) -> % g(0) should be 0 but became -1 + case X of + 0 -> 0; + -10 -> 1; + -20 -> 2; + -30 -> 3; + -40 -> 4; + -50 -> 5; + -60 -> 6; + -70 -> 7; + -80 -> 8; + _ -> -1 + end. + +%%----------------------------------------------------------------------- +%% From: Paul Guyot +%% Date: Jan 31, 2011 +%% +%% There is a bug in HiPE compilation with the comparison of floats +%% with integers. This bug happens in functions f/1 and g/2 below. +%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE +%% will evaluate them to false. +%% +%% The culprit was the Icode range analysis which was buggy. (On the +%% other hand, HiPE properly evaluated these calls to true if passed +%% the option 'no_icode_range'.) Fixed by Kostis Sagonas. +%% -------------------------------------------------------------------- + +test_icode_range_anal() -> + true = f_eq(42), + true = f_eq(42.0), + false = f_ne(42), + false = f_ne(42.0), + false = f_eq_ex(42), + false = f_eq_ex(42.0), + true = f_ne_ex(42), + true = f_ne_ex(42.0), + false = f_gt(42), + false = f_gt(42.0), + true = f_le(42), + true = f_le(42.0), + zero_test = g(0, test), + zero_test = g(0.0, test), + non_zero_test = g(42, test), + other = g(42, other), + ok. + +f_eq(X) -> + Y = X / 2, + Y == 21. + +f_ne(X) -> + Y = X / 2, + Y /= 21. + +f_eq_ex(X) -> + Y = X / 2, + Y =:= 21. + +f_ne_ex(X) -> + Y = X / 2, + Y =/= 21. + +f_gt(X) -> + Y = X / 2, + Y > 21. + +f_le(X) -> + Y = X / 2, + Y =< 21. + +g(X, Z) -> + Y = X / 2, + case Z of + test when Y == 0 -> zero_test; + test -> non_zero_test; + other -> other + end. -- cgit v1.2.3 From 186868ede408e714afe191c0a40123e4f8b2e847 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 01:59:00 +0100 Subject: Add tests for the is_boolean/1 guard --- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 42 +++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index 4bfe363ed3..b821a05ad5 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -14,6 +14,7 @@ test() -> ok = test_guard2(), ok = test_guard3(), ok = test_guard4(), + ok = test_is_boolean(), ok. %%-------------------------------------------------------------------- @@ -73,3 +74,44 @@ is_ref(_Ref) -> no. an_external_ref(Bin) -> binary_to_term(Bin). + +%%-------------------------------------------------------------------- + +test_is_boolean() -> + ok = is_boolean_in_if(), + ok = is_boolean_in_guard(). + +is_boolean_in_if() -> + ok1 = tif(true), + ok2 = tif(false), + not_bool = tif(other), + ok. + +is_boolean_in_guard() -> + ok = tg(true), + ok = tg(false), + not_bool = tg(other), + ok. + +tif(V) -> + Yes = yes(), %% just to prevent the optimizer removing this + if + %% the following line generates an is_boolean instruction + V, Yes == yes -> + %% while the following one does not (?!) + %% Yes == yes, V -> + ok1; + not(not(not(V))) -> + ok2; + V -> + ok3; + true -> + not_bool + end. + +tg(V) when is_boolean(V) -> + ok; +tg(_) -> + not_bool. + +yes() -> yes. -- cgit v1.2.3 From a0286ce52c775812e499c4f036033daa5ffe4676 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Mon, 30 Nov 2015 23:36:42 +0100 Subject: Include some more old HiPE tests to the test suite --- lib/hipe/test/basic_SUITE_data/basic_guards.erl | 47 ++++++++++++++++ .../basic_SUITE_data/basic_strength_reduce.erl | 65 ++++++++++++++++++++++ lib/hipe/test/basic_SUITE_data/basic_switches.erl | 52 +++++++++++++++++ 3 files changed, 164 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_switches.erl diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl index b821a05ad5..81eeed7c3b 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_guards.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -7,6 +7,8 @@ -module(basic_guards). -export([test/0]). +%% Prevent the inlining of the following functions +-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]). test() -> ok = guard0(4.2), @@ -15,6 +17,7 @@ test() -> ok = test_guard3(), ok = test_guard4(), ok = test_is_boolean(), + ok = test_bad_guards(), ok. %%-------------------------------------------------------------------- @@ -115,3 +118,47 @@ tg(_) -> not_bool. yes() -> yes. + +%%-------------------------------------------------------------------- +%% original test by Bjorn G + +test_bad_guards() -> + ok = bad_arith(), + ok = bad_tuple(), + ok = is_strange_guard(), + ok. + +bad_arith() -> + 13 = bad_arith1(1, 12), + 42 = bad_arith1(1, infinity), + 42 = bad_arith1(infinity, 1), + 42 = bad_arith2(infinity, 1), + 42 = bad_arith3(inf), + 42 = bad_arith4(infinity, 1), + ok. + +bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2; +bad_arith1(_, _) -> 42. + +bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2; +bad_arith2(_, _) -> 42. + +bad_arith3(T) when (bnot T) < 17 -> T; +bad_arith3(_) -> 42. + +bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2; +bad_arith4(_, _) -> 42. + +bad_tuple() -> + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) =:= x -> x; +bad_tuple1(T) when element(3, T) =:= y -> y; +bad_tuple1(_) -> error. + +is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok; +is_strange_guard() -> error. diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl new file mode 100644 index 0000000000..0f94320a33 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl @@ -0,0 +1,65 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests the strength reduction component of the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_strength_reduce). + +-export([test/0]). +%% These functions are exported so as to not remove them by inlining +-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]). + +test() -> + ok = test_strength_reduce1(), + ok. + +%%-------------------------------------------------------------------- + +test_strength_reduce1() -> + ok = crash_0(0), + ok = crash_1(42), + ok = crash_2(42), + ok = crash_3(42), + 5 = 42 bsr 3 = bug_div_2N(42), + -6 = -42 bsr 3 = bug_div_2N(-42) - 1, + ok. + +%% This is a crash report by Peter Wang (10 July 2007) triggering an +%% R11B-5 crash: strength reduction could not handle calls with no +%% destination +crash_0(A) -> + case A of + 0 -> + A div 8, + ok + end. + +%% The above was simplified to the following which showed another +%% crash, this time on RTL +crash_1(A) when is_integer(A), A >= 0 -> + A div 8, + ok. + +%% A similar crash like the first one, but in a different place in the +%% code, was triggered by the following code +crash_2(A) when is_integer(A), A >= 0 -> + A div 1, + ok. + +%% A crash similar to the first one happened in the following code +crash_3(A) -> + case A of + 42 -> + A * 0, + ok + end. + +%% Strength reduction for div/2 and rem/2 with a power of 2 +%% should be performed only for non-negative integers +bug_div_2N(X) when is_integer(X), X >= 0 -> + X div 8; +bug_div_2N(X) when is_integer(X), X < 0 -> + X div 8. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl new file mode 100644 index 0000000000..0a7ae5b8b7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl @@ -0,0 +1,52 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for pattern matching switches. +%%%------------------------------------------------------------------- +-module(basic_switches). + +-export([test/0]). + +test() -> + ok = test_switch_mix(), + ok. + +%%--------------------------------------------------------------------- + +-define(BIG1, 21323233222132323322). +-define(BIG2, 4242424242424242424242424242424242). + +test_switch_mix() -> + small1 = t(42), + small2 = t(17), + big1 = t(?BIG1), + big2 = t(?BIG2), + atom = t(foo), + pid = t(self()), + float = t(4.2), + ok. + +t(V) -> + S = self(), + case V of + 42 -> small1; + 17 -> small2; + ?BIG1 -> big1; + ?BIG2 -> big2; + 1 -> no; + 2 -> no; + 3 -> no; + 4 -> no; + 5 -> no; + 6 -> no; + 7 -> no; + 8 -> no; + foo -> atom; + 9 -> no; + 4.2 -> float; + S -> pid; + _ -> no + end. + +%%--------------------------------------------------------------------- -- cgit v1.2.3 From 34e992d6681563145c777d5c16e1305f27a751fd Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Tue, 1 Dec 2015 01:44:10 +0100 Subject: More tests for BIFs --- lib/hipe/test/basic_SUITE_data/basic_bifs.erl | 232 +++++++++++++++++++++++++- 1 file changed, 224 insertions(+), 8 deletions(-) diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl index d6f21ceb52..e7ee2f3678 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -8,20 +8,39 @@ -export([test/0]). +-define(BIG, 1398479237498374913984792374983749). + test() -> + ok = test_abs(), + ok = test_binary_part(), ok = test_element(), - ok = test_binary_part(). + ok = test_float(), + ok = test_float_to_list(), + ok = test_integer_to_list(), + ok = test_list_to_float(), + ok = test_list_to_integer(), + ok = test_round(), + ok = test_trunc(), + ok. %%-------------------------------------------------------------------- -test_element() -> - true = elem({a, b}), - false = elem({a, c}), - other = elem(gazonk), - ok. +test_abs() -> + t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG). -elem(T) when element(1, T) == a -> element(2, T) == b; -elem(_) -> other. +t_abs(F1, F2, F3, I1, I2, I3, BigNum) -> + %% Floats. + 5.5 = abs(F1), + 0.0 = abs(F2), + 100.0 = abs(F3), + %% Integers. + 5 = abs(I1), + 0 = abs(I2), + 100 = abs(I3), + %% Bignums. + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. %%-------------------------------------------------------------------- %% Checks that 2-ary and 3-ary BIFs can be compiled to native code. @@ -39,3 +58,200 @@ bp3(Bin) -> binary_part(Bin, byte_size(Bin), -5). %%-------------------------------------------------------------------- + +test_element() -> + true = elem({a, b}), + false = elem({a, c}), + other = elem(gazonk), + ok. + +elem(T) when element(1, T) == a -> element(2, T) == b; +elem(_) -> other. + +%%-------------------------------------------------------------------- + +test_float() -> + t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG). + +t_float(I1, I2, I3, F1, F2, F3, B1, B2) -> + 0.0 = float(I1), + 2.5 = float(F1), + 0.0 = float(F2), + -100.42 = float(F3), + 42.0 = float(I2), + -100.0 = float(I3), + %% Bignums. + 1398479237498374913984792374983749.0 = float(B1), + -1398479237498374913984792374983749.0 = float(B2), + %% Extremly big bignums. + Big = list_to_integer(duplicate(2000, $1)), + {'EXIT', _} = (catch float(Big)), + %% Invalid types and lists. + {'EXIT', _} = (catch my_list_to_integer(atom)), + {'EXIT', _} = (catch my_list_to_integer(123)), + {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])), + {'EXIT', _} = (catch my_list_to_integer("1.2")), + {'EXIT', _} = (catch my_list_to_integer("a")), + {'EXIT', _} = (catch my_list_to_integer("")), + ok. + +my_list_to_integer(X) -> + list_to_integer(X). + +%%-------------------------------------------------------------------- + +test_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No \n on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%%-------------------------------------------------------------------- + +test_integer_to_list() -> + t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738). + +t_integer_to_list(I1, I2, I3, I4, BIG) -> + "0" = integer_to_list(I1), + "42" = integer_to_list(I2), + "-42" = integer_to_list(-I2), + "-42" = integer_to_list(-I2), + "32768" = integer_to_list(I3), + "268435455" = integer_to_list(I4), + "-268435455" = integer_to_list(-I4), + "123456932798748738738" = integer_to_list(BIG), + BigList = duplicate(2000, $1), + Big = list_to_integer(BigList), + BigList = integer_to_list(Big), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_float() -> + ok = t_list_to_float_safe(), + ok = t_list_to_float_risky(). + +t_list_to_float_safe() -> + 0.0 = my_list_to_float("0.0"), + 0.0 = my_list_to_float("-0.0"), + 0.5 = my_list_to_float("0.5"), + -0.5 = my_list_to_float("-0.5"), + 100.0 = my_list_to_float("1.0e2"), + 127.5 = my_list_to_float("127.5"), + -199.5 = my_list_to_float("-199.5"), + {'EXIT', _} = (catch my_list_to_float("0")), + {'EXIT', _} = (catch my_list_to_float("0..0")), + {'EXIT', _} = (catch my_list_to_float("0e12")), + {'EXIT', _} = (catch my_list_to_float("--0.0")), + ok. + +my_list_to_float(X) -> + list_to_float(X). + +%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.) + +t_list_to_float_risky() -> + Many_Ones = duplicate(25000, $1), + ok = case list_to_float("2." ++ Many_Ones) of + F when is_float(F), 0.0 < F, F =< 3.14 -> ok + end, + {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_integer() -> + ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12", + "32768", "268435455", "-268435455"), + ok = t_list_to_integer_bignum("123456932798748738738666"), + ok. + +t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) -> + 0 = list_to_integer(S1), + 0 = list_to_integer(S2), + 0 = list_to_integer(S3), + 1 = list_to_integer(S4), + -1 = list_to_integer(S5), + 42 = list_to_integer(S6), + -12 = list_to_integer(S7), + 32768 = list_to_integer(S8), + 268435455 = list_to_integer(S9), + -268435455 = list_to_integer(S10), + ok. + +t_list_to_integer_bignum(S) -> + 123456932798748738738666 = list_to_integer(S), + case list_to_integer(duplicate(2000, $1)) of + I when is_integer(I), I > 123456932798748738738666 -> ok + end. + +%%-------------------------------------------------------------------- + +test_round() -> + ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6), + ok = t_round_big(4294967296.1, 4294967296.9), + ok. + +t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) -> + 0 = round(F1), + 0 = round(F2), + 1 = round(F3), + 0 = round(F4), + -1 = round(F5), + 255 = round(F6), + 256 = round(F7), + -1033 = round(F8), + -1034 = round(F9), + ok. + +t_round_big(B1, B2) -> + 4294967296 = round(B1), + 4294967297 = round(B2), + -4294967296 = round(-B1), + -4294967297 = round(-B2), + ok. + +%%-------------------------------------------------------------------- + +test_trunc() -> + t_trunc(0.0, 5.3333, -10.978987, 4294967305.7). + +t_trunc(F1, F2, F3, B) -> + 0 = trunc(F1), + 5 = trunc(F2), + -10 = trunc(F3), + %% Bignums. + 4294967305 = trunc(B), + -4294967305 = trunc(-B), + ok. + +%%-------------------------------------------------------------------- +%% Auxiliary functions below + +duplicate(N, X) when is_integer(N), N >= 0 -> + duplicate(N, X, []). + +duplicate(0, _, L) -> L; +duplicate(N, X, L) -> duplicate(N-1, X, [X|L]). -- cgit v1.2.3 From fd154a229271e488eccd25cf1b838560c2decb52 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Dec 2015 01:11:24 +0100 Subject: Two tests that depend on inlining being turned on --- .../basic_SUITE_data/basic_inline_function.erl | 73 ++++++++++++++++++++++ .../test/basic_SUITE_data/basic_inline_module.erl | 31 +++++++++ 2 files changed, 104 insertions(+) create mode 100644 lib/hipe/test/basic_SUITE_data/basic_inline_function.erl create mode 100644 lib/hipe/test/basic_SUITE_data/basic_inline_module.erl diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl new file mode 100644 index 0000000000..4c08064670 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl @@ -0,0 +1,73 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_function). + +-export([test/0]). + +-compile({inline, [{to_objects, 3}]}). + +test() -> + ok = test_inline_match(), + ok. + +%%-------------------------------------------------------------------- + +test_inline_match() -> + bad_object = test1(a, {binary, foo, set}, c), + bad_object = test2(a, {binary, foo, set}, c), + bad_object = test3(a, {binary, foo, set}, c), + ok. + +%% Inlined +test1(KeysObjs, C, Ts) -> + case catch to_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% "Inlined" by hand +test2(KeysObjs, C, _Ts) -> + case catch (case C of + {binary, _, set} -> + <<_ObjSz0:32, _T/binary>> = KeysObjs; + _ -> ok + end) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Not inlined +test3(KeysObjs, C, Ts) -> + case catch fto_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Inlined. +to_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) -> + ok; +to_objects(_Bin, _, _Ts) -> + ok. + +%% Not Inlined. +fto_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) -> + ok; +fto_objects(_Bin, _, _Ts) -> + ok. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl new file mode 100644 index 0000000000..306c6a39ce --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl @@ -0,0 +1,31 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_module). + +-export([test/0]). + +-compile([inline]). %% necessary for these tests + +test() -> + ok = test_case_end_atom(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of a case_end instruction works even +%% when an exception (no matching case pattern) is to be raised. + +test_case_end_atom() -> + {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()), + ok. + +test_case_stm_inlining() -> + case some_atom() of + another_atom -> strange_result + end. + +some_atom() -> + some_atom. -- cgit v1.2.3 From 8da78333089d1e28e51a9724f67cac66656e1368 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 2 Dec 2015 01:52:50 +0100 Subject: Cleanup and add one more test case --- lib/hipe/test/basic_SUITE_data/basic_floats.erl | 42 +++++++++++++++++++------ 1 file changed, 33 insertions(+), 9 deletions(-) diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl index c49ac3946e..eec175075a 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_floats.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -7,6 +7,7 @@ -module(basic_floats). -export([test/0]). +-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning test() -> ok = test_arith_ops(), @@ -16,6 +17,7 @@ test() -> ok = test_catch_bad_fp_arith(), ok = test_catch_fp_conv(), ok = test_fp_with_fp_exceptions(), + %% ok = test_fmt_double_fpe_leak(), % this requires printing ok. %%-------------------------------------------------------------------- @@ -47,8 +49,8 @@ negate(X) -> %%-------------------------------------------------------------------- test_fp_ebb() -> - 1.0 = foo(2*math:pi()), - 1.0 = bar(2*math:pi()), + 1.0 = foo(2 * math:pi()), + 1.0 = bar(2 * math:pi()), ok. foo(X) -> @@ -123,7 +125,7 @@ big_int_arith(I) when is_integer(I) -> big_const_float(F) -> I = trunc(F), badarith = try (1/(2*I)) catch error:Err -> Err end, - _Ignore = 2/I, + _ = 2/I, {'EXIT', _} = (catch 4/(2*I)), ok. @@ -133,14 +135,14 @@ big_const_float(F) -> test_fp_with_fp_exceptions() -> 0.0 = math:log(1.0), - badarith = try math:log(minus_one_float()) catch error:E1 -> E1 end, + badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end, 0.0 = math:log(1.0), - badarith = try math:log(zero_float()) catch error:E2 -> E2 end, + badarith = try math:log(float_zero()) catch error:E2 -> E2 end, 0.0 = math:log(1.0), %% An old-fashioned exception here just so as to test this case also - {'EXIT',_} = (catch fp_mult(3.23e133, 3.57e257)), + {'EXIT', _} = (catch fp_mult(3.23e133, 3.57e257)), 0.0 = math:log(1.0), - badarith = try fp_div(5.0,0.0) catch error:E3 -> E3 end, + badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end, 0.0 = math:log(1.0), ok. @@ -151,6 +153,28 @@ fp_div(X, Y) -> X / Y. %% The following two function definitions appear here just to shut %% off 'expression will fail with a badarg' warnings from the compiler -zero_float() -> 0.0. +float_zero() -> 0.0. -minus_one_float() -> -1.0. +float_minus_one() -> -1.0. + +%%-------------------------------------------------------------------- +%% Test that erl_printf_format.c:fmt_double() does not leak pending FP +%% exceptions to subsequent code. This used to break x87 FP code on +%% 32-bit x86. Based on a problem report from Richard Carlsson. + +test_fmt_double_fpe_leak() -> + test_fmt_double_fpe_leak(float_zero(), int_two()), + ok. + +%% We need the specific sequence of erlang:display/1 on a float that +%% triggers faulting ops in fmt_double() followed by a simple FP BIF. +%% We also need to repeat this at least three times. +test_fmt_double_fpe_leak(X, Y) -> + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), + math:log10(Y). + +int_two() -> 2. -- cgit v1.2.3 From 8970c8c25c45e6a4f92b0652c65e26d890939409 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 16 Dec 2015 23:09:46 +0100 Subject: Fix compilation of matching with UTF binaries The code generated by the HiPE compiler for pattern matching with UTF binaries was such that sometimes THE_NON_VALUE was stored in the roots followed by the garbage collector. This was not an issue for the vanilla native code compiler, but was problematic for the ErLLVM back-end. Fix the issue by not storing THE_NON_VALUE in the live roots. An alternative fix would be to change the code of the garbage collector. With this fix, there are no more (known) failing test cases for the ErLLVM back-end (at least on x86_64 with LLVM 3.5, which is the configuation regularly tested). Thanks to @margnus1 for the fix. --- lib/hipe/rtl/hipe_rtl_binary_match.erl | 30 ++++++++++++++++++++++++------ lib/hipe/test/bs_SUITE_data/bs_utf.erl | 8 ++++---- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 51213b71d1..cf1b8e453f 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -333,32 +333,50 @@ float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> SizeReg = hipe_rtl:mk_new_reg_gcsafe(), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), + RetReg = hipe_rtl:mk_new_reg_gcsafe(), MatchBuf = hipe_rtl:mk_new_reg(), RetLabel = hipe_rtl:mk_new_label(), + OkLabel = hipe_rtl:mk_new_label(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_rtl:mk_move(SizeReg, Size), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf], + hipe_rtl_arch:call_bif([RetReg], Func, [SizeReg, FlagsReg, MatchBuf], hipe_rtl:label_name(RetLabel), FalseLblName), RetLabel, - hipe_rtl:mk_branch(Dst1, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst1, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf8, [MatchBuf], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf16, [MatchBuf, FlagsReg], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) -> MatchBuf = hipe_rtl:mk_new_reg(), diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index b50566ab1b..24526f574d 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -16,10 +16,10 @@ test() -> ok = utf8_roundtrip(), ok = utf16_roundtrip(), ok = utf32_roundtrip(), - %% Currently, the following are problematic for the LLVM backend - %% ok = utf8_illegal_sequences(), - %% ok = utf16_illegal_sequences(), - %% ok = utf32_illegal_sequences(), + %% The following were problematic for the LLVM backend + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), ok. %%------------------------------------------------------------------- -- cgit v1.2.3 From 0e35294cfc820828295a65511c5e4a62e03a6452 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 17 Dec 2015 07:36:26 +0100 Subject: Update primary bootstrap --- bootstrap/bin/start.boot | Bin 5285 -> 5287 bytes bootstrap/bin/start_clean.boot | Bin 5285 -> 5287 bytes bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11524 -> 11524 bytes bootstrap/lib/compiler/ebin/compiler.app | 2 +- bootstrap/lib/compiler/ebin/compiler.appup | 2 +- bootstrap/lib/kernel/ebin/code.beam | Bin 7140 -> 7312 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 28852 -> 26468 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 13712 -> 13712 bytes bootstrap/lib/kernel/ebin/kernel.app | 2 +- bootstrap/lib/kernel/ebin/kernel.appup | 6 +++--- bootstrap/lib/kernel/ebin/os.beam | Bin 5836 -> 3636 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89380 -> 89344 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 83340 -> 82296 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11696 -> 11764 bytes bootstrap/lib/stdlib/ebin/stdlib.app | 2 +- bootstrap/lib/stdlib/ebin/stdlib.appup | 10 +++++----- 16 files changed, 12 insertions(+), 12 deletions(-) diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot index b93d49f146..e8f9a4fe12 100644 Binary files a/bootstrap/bin/start.boot and b/bootstrap/bin/start.boot differ diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot index b93d49f146..e8f9a4fe12 100644 Binary files a/bootstrap/bin/start_clean.boot and b/bootstrap/bin/start_clean.boot differ diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index 0e05b1474a..ae57c8dd6b 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index d31b449f72..37a6ce4acb 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "6.0.1"}, + {vsn, "6.0.2"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 1ff223434a..ceb96264d5 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"6.0.1", +{"6.0.2", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index 2a61400c9a..e380d59305 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index ece4263caa..2b12bfe427 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index e60cf784ea..3faa4c94ba 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 644077b9e7..a409bf6f3a 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "4.1"}, + {vsn, "4.1.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index b2a161aa1d..5cd6724383 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -16,11 +16,11 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"4.1", +{"4.1.1", %% Up from - max one major revision back - [{<<"4\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.0.* + [{<<"4\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"4\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.0.* + [{<<"4\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam index 054c70e8b1..ed3e5a2683 100644 Binary files a/bootstrap/lib/kernel/ebin/os.beam and b/bootstrap/lib/kernel/ebin/os.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 21b7ce4f3a..0cdf78b62b 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index aab674f3c8..f00eef7500 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 9b1bd2c77b..a8ee669a95 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 7a76bc0ff1..3e166b2b4b 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.6"}, + {vsn, "2.7"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 8cfe41a2e1..8b0206f6be 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -16,11 +16,11 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"2.6", +{"2.7", %% Up from - max one major revision back - [{<<"2\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, %% OTP-18.0.* - {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 + [{<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* + {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], % 17.0-17.5 %% Down to - max one major revision back - [{<<"2\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}, %% OTP-18.0.* - {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 + [{<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* + {<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] % 17.0-17.5 }. -- cgit v1.2.3 From cf04a89bb3585466896e6eef61bfd6e8aed27527 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 17 Dec 2015 08:43:12 +0100 Subject: test_server tests: Update test cases to cope with use of 'rand' In 80757f9, test_server was updated use the new 'rand' module instead of 'random', but the the shuffle test cases were not updated. --- .../test_server_shuffle01_SUITE.erl | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 847c7b6bdd..80ac9f6b3d 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl @@ -224,7 +224,7 @@ conf5_end(_Config) -> ok. conf6_init(Config) when is_list(Config) -> - [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), + validate_shuffle(Config), test_server:comment("Shuffle (random)"), init = ?config(suite,Config), [{cc6,conf6}|Config]. @@ -242,23 +242,28 @@ conf5(suite) -> % test specification conf7_init(Config) when is_list(Config) -> test_server:comment("Group 7, Shuffle (random seed)"), - case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of - {_,_,_} -> ok - end, + validate_shuffle(Config), [{cc7,conf7}|Config]. conf7_end(_Config) -> ok. conf8_init(Config) when is_list(Config) -> test_server:comment("Group 8, Shuffle (user start seed)"), - case proplists:get_value(shuffle,?config(tc_group_properties,Config)) of - {_,_,_} -> ok - end, + validate_shuffle(Config), init = ?config(suite,Config), [{cc8,conf8}|Config]. conf8_end(_Config) -> ok. +validate_shuffle(Config) -> + case proplists:get_value(shuffle, ?config(tc_group_properties,Config)) of + {_,_,_} -> + ok; + Seed -> + %% Must be a valid seed. + _ = rand:seed_s(rand:export_seed_s(Seed)) + end. + %%---------- test cases ---------- -- cgit v1.2.3 From e616e04d55b28bff5f0660eb8e3a32fffe398a13 Mon Sep 17 00:00:00 2001 From: Kenji Rikitake Date: Thu, 17 Dec 2015 20:52:54 +0900 Subject: hipe_x86_signal.c: add FreeBSD sigaction code * erts/emulator/hipe/hipe_x86_signal.c: add FreeBSD sigaction code, based on the Darwin (OS X) code --- erts/emulator/hipe/hipe_x86_signal.c | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 69d4ea10c2..b7dae88417 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -234,7 +234,29 @@ static void do_init(void) #define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __sun__ */ -#if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__sun__)) +#if defined(__FreeBSD__) +/* + * This is a copy of Darwin code for FreeBSD. + * CAVEAT: detailed semantics are not verified yet. + */ +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +extern int _sigaction(int, const struct sigaction*, struct sigaction*); +#define __SIGACTION _sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym_freebsd"); + abort(); +} +#define _NSIG NSIG +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* __FreeBSD__ */ + +#if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__)) /* * Unknown libc -- assume musl. Note: musl deliberately does not provide a musl-specific * feature test macro, so we cannot check for it. @@ -259,7 +281,7 @@ static void do_init(void) #define _NSIG NSIG #endif #define INIT() do { if (!init_done()) do_init(); } while (0) -#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __sun__) */ +#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */ #if !defined(__NetBSD__) /* @@ -299,7 +321,7 @@ int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldac /* * This catches the application's own sigaction() calls. */ -#if !defined(__DARWIN__) && !defined(__NetBSD__) +#if !defined(__DARWIN__) && !defined(__NetBSD__) && !defined(__FreeBSD__) int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) { return my_sigaction(signum, act, oldact); -- cgit v1.2.3 From f77436f337d83a9751dc84d53791500c7f99c92e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 17 Dec 2015 14:11:12 +0100 Subject: Revert "Fix erroneous splitting of emulator path" This reverts commit 731890f3b4ac62eed1221aa7d9fd2bfa6bf51d8c. --- erts/etc/common/ct_run.c | 25 ++++++++++++++++++++++--- erts/etc/common/dialyzer.c | 24 +++++++++++++++++++++++- erts/etc/common/erlc.c | 22 +++++++++++++++++++++- erts/etc/common/escript.c | 25 +++++++++++++++++++++++-- erts/etc/common/typer.c | 26 ++++++++++++++++++++++---- 5 files changed, 111 insertions(+), 11 deletions(-) diff --git a/erts/etc/common/ct_run.c b/erts/etc/common/ct_run.c index 11cec26264..548514ee6c 100644 --- a/erts/etc/common/ct_run.c +++ b/erts/etc/common/ct_run.c @@ -83,6 +83,7 @@ static int eargc; /* Number of arguments in eargv. */ static void error(char* format, ...); static char* emalloc(size_t size); static char* strsave(char* string); +static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ @@ -151,8 +152,6 @@ int main(int argc, char** argv) argv0 = argv; emulator = get_default_emulator(argv[0]); - if (strlen(emulator) >= MAXPATHLEN) - error("Emulator path length is too large"); /* * Allocate the argv vector to be used for arguments to Erlang. @@ -164,7 +163,7 @@ int main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - PUSH(strsave(emulator)); + push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; @@ -295,6 +294,26 @@ int main(int argc, char** argv) return run_erlang(eargv[0], eargv); } +static void +push_words(char* src) +{ + char sbuf[MAXPATHLEN]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} #ifdef __WIN32__ wchar_t *make_commandline(char **argv) { diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index cac1464bf6..c45626606c 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -65,6 +65,7 @@ static int eargc; /* Number of arguments in eargv. */ static void error(char* format, ...); static char* emalloc(size_t size); static char* strsave(char* string); +static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ @@ -188,7 +189,7 @@ int main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - PUSH(strsave(emulator)); + push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; @@ -268,6 +269,27 @@ int main(int argc, char** argv) return run_erlang(eargv[0], eargv); } +static void +push_words(char* src) +{ + char sbuf[MAXPATHLEN]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} + #ifdef __WIN32__ wchar_t *make_commandline(char **argv) { diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index 049afc526a..f9d909e01c 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -200,7 +200,7 @@ int main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - PUSH(strsave(emulator)); + push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; @@ -330,6 +330,26 @@ process_opt(int* pArgc, char*** pArgv, int offset) return argv[1]; } +static void +push_words(char* src) +{ + char sbuf[MAXPATHLEN]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} #ifdef __WIN32__ wchar_t *make_commandline(char **argv) { diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index a5c6d0d40b..7fd02ed436 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -74,6 +74,7 @@ static void error(char* format, ...); static char* emalloc(size_t size); static void efree(void *p); static char* strsave(char* string); +static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ @@ -431,7 +432,7 @@ main(int argc, char** argv) emulator = get_default_emulator(argv[0]); } - if (strlen(emulator) >= MAXPATHLEN) + if (strlen(emulator) >= PMAX) error("Value of environment variable ESCRIPT_EMULATOR is too large"); /* @@ -444,7 +445,7 @@ main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - PUSH(strsave(emulator)); + push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; @@ -553,6 +554,26 @@ main(int argc, char** argv) return run_erlang(eargv[0], eargv); } +static void +push_words(char* src) +{ + char sbuf[PMAX]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} #ifdef __WIN32__ wchar_t *make_commandline(char **argv) { diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index 7ff8aa76e2..0aa0996808 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -65,6 +65,7 @@ static int eargc; /* Number of arguments in eargv. */ static void error(char* format, ...); static char* emalloc(size_t size); static char* strsave(char* string); +static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ @@ -128,9 +129,6 @@ main(int argc, char** argv) emulator = get_default_emulator(argv[0]); - if (strlen(emulator) >= MAXPATHLEN) - error("Emulator path length is too large"); - /* * Allocate the argv vector to be used for arguments to Erlang. * Arrange for starting to pushing information in the middle of @@ -141,7 +139,7 @@ main(int argc, char** argv) eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); eargv = eargv_base; eargc = 0; - PUSH(strsave(emulator)); + push_words(emulator); eargc_base = eargc; eargv = eargv + eargv_size/2; eargc = 0; @@ -194,6 +192,26 @@ main(int argc, char** argv) return run_erlang(eargv[0], eargv); } +static void +push_words(char* src) +{ + char sbuf[MAXPATHLEN]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} #ifdef __WIN32__ wchar_t *make_commandline(char **argv) { -- cgit v1.2.3 From dcdeac8cc6504c091e6886fa1ec2ac48709026c9 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Thu, 17 Dec 2015 14:33:24 +0100 Subject: [cover] Simplify module cc in cover test to avoid confusion Functions in this module are never called, and some functions are outdated. In order to avoid confusion (and need for update), the module is now reduced to a simple dummy module. --- lib/tools/test/cover_SUITE.erl | 6 +-- lib/tools/test/cover_SUITE_data/cc.erl | 95 +++++----------------------------- 2 files changed, 15 insertions(+), 86 deletions(-) diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 25c9317608..3b3cd98837 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -778,8 +778,8 @@ distribution_performance(Config) -> %% [{ok,_} = cover:compile_beam(Mod) || Mod <- Mods] %% end, CFun = fun() -> cover:compile_beam(Mods) end, - {CT,CA} = timer:tc(CFun), -% erlang:display(CA), + {CT,_CA} = timer:tc(CFun), +% erlang:display(_CA), erlang:display({compile,CT}), {SNT,_} = timer:tc(fun() -> {ok,[N1]} = cover:start(nodes()) end), @@ -799,7 +799,7 @@ distribution_performance(Config) -> % Fun = fun() -> cover:reset() end, - {AT,A} = timer:tc(Fun), + {AT,_A} = timer:tc(Fun), erlang:display({analyse,AT}), % erlang:display(lists:sort([X || X={_MFA,N} <- lists:append([L || {ok,L}<-A]), N=/=0])), diff --git a/lib/tools/test/cover_SUITE_data/cc.erl b/lib/tools/test/cover_SUITE_data/cc.erl index 587bdbe493..7eb165ef8a 100644 --- a/lib/tools/test/cover_SUITE_data/cc.erl +++ b/lib/tools/test/cover_SUITE_data/cc.erl @@ -1,88 +1,17 @@ -module(cc). --export([epp/1, epp/2, dbg/1, dbg/2, cvr/1, cvr/2]). --export([p/2, pp/2]). +-compile(export_all). -%% epp(Module) - Creates Module.epp which contains all forms of Module -%% as obtained by using epp. -%% -%% dbg(Module) - Creates Module.dbg which contains all forms of Module -%% as obtained by using beam_lib:chunks/2. -%% -%% cvr(Module) - Creates Module.cvr which contains all forms of Module -%% as obtained by using cover:transform/3. -%% +%% This is a dummy module used only for cover compiling. The content +%% of this module has no meaning for the test. -epp(Module) -> - epp(Module, p). -epp(Module, P) -> - File = atom_to_list(Module)++".erl", - {ok,Cwd} = file:get_cwd(), - {ok, Fd1} = epp:open(File, [Cwd], []), - {ok, Fd2} = file:open(atom_to_list(Module)++".epp", write), +foo() -> + T = erlang:time(), + spawn(fun() -> bar(T) end). - epp(Fd1, Fd2, P), - - epp:close(Fd1), - file:close(Fd2), - ok. - -epp(Fd1, Fd2, P) -> - case epp:parse_erl_form(Fd1) of - {ok, {attribute,Line,Attr,Data}} -> - epp(Fd1, Fd2, P); - {ok, Form} when P==p -> - io:format(Fd2, "~p.~n", [Form]), - epp(Fd1, Fd2, P); - {ok, Form} when P==pp -> - io:format(Fd2, "~p.~n", [erl_pp:form(Form)]), - epp(Fd1, Fd2, P); - {eof, Line} -> - ok - end. - -cvr(Module) -> - cvr(Module, p). -cvr(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - Vars = {vars,Module,Vsn, [], - undefined, undefined, undefined, undefined, undefined, - undefined, - false}, - {ok, TForms, _Vars2} = cover:transform(Forms, [], Vars), - File = atom_to_list(Module)++".cvr", - apply(?MODULE, P, [File, TForms]); - Error -> - Error +bar(T) -> + receive + X -> + T1 = erlang:time(), + io:format("received ~p at ~p. Last time: ~p~n",[X,T1,T]), + bar(T1) end. - -dbg(Module) -> - dbg(Module, p). -dbg(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - File = atom_to_list(Module)++".dbg", - apply(?MODULE, P, [File, Forms]); - Error -> - Error - end. - -p(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~p.~n", [Form]) - end, - Forms), - file:close(Fd). - -pp(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~s", [erl_pp:form(Form)]) - end, - Forms), - file:close(Fd). -- cgit v1.2.3 From d38569f7deb8a5ae582e13802ae605b03d5f9498 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Thu, 17 Dec 2015 14:52:58 +0100 Subject: Update version numbers --- erts/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/vsn.mk b/erts/vsn.mk index be6cf2e376..94b5d0b169 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 7.2 +VSN = 7.2.1 # Port number 4365 in 4.2 # Port number 4366 in 4.3 -- cgit v1.2.3 From a96f36890da959bcb134ac4f6d24d5132e7bb5be Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Thu, 17 Dec 2015 14:53:04 +0100 Subject: Update release notes --- erts/doc/src/notes.xml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 5cb9bdb690..a726cc7b97 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,27 @@

This document describes the changes made to the ERTS application.

+
Erts 7.2.1 + +
Fixed Bugs and Malfunctions + + +

+ Revert "Fix erroneous splitting of emulator path"

+

+ Own Id: OTP-13202

+ + +

+ Fix HiPE enabled emulator for FreeBSD.

+

+ Own Id: OTP-13204 Aux Id: pr926

+ + +
+ +
+
Erts 7.2
Fixed Bugs and Malfunctions -- cgit v1.2.3 From 21d6192389a04024f7a41ced9d0911a9cce6f4e8 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Thu, 17 Dec 2015 14:53:05 +0100 Subject: Updated OTP version --- OTP_VERSION | 2 +- otp_versions.table | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index 528f7b565a..c0aa6d4aec 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.2 +18.2.1 diff --git a/otp_versions.table b/otp_versions.table index b0f8efeb4c..9e1b5de0ad 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.2.1 : erts-7.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2 : asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 crypto-3.6.2 dialyzer-2.8.2 diameter-1.11.1 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2 eunit-2.2.12 hipe-3.14 inets-6.1 jinterface-1.6.1 kernel-4.1.1 observer-2.1.1 parsetools-2.1.1 public_key-1.1 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 wx-1.6 xmerl-1.3.9 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 debugger-4.1.1 edoc-0.7.17 eldap-1.2 et-1.5.1 gs-1.6 ic-4.4 megaco-3.18 mnesia-4.13.2 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 webtool-0.9 : OTP-18.1.5 : ssh-4.1.3 # asn1-4.0 common_test-1.11 compiler-6.0.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.1 debugger-4.1.1 dialyzer-2.8.1 diameter-1.11 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 erts-7.1 et-1.5.1 eunit-2.2.11 gs-1.6 hipe-3.13 ic-4.4 inets-6.0.3 jinterface-1.6 kernel-4.1 megaco-3.18 mnesia-4.13.2 observer-2.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0.1 reltool-0.7 runtime_tools-1.9.1 sasl-2.6 snmp-5.2 ssl-7.1 stdlib-2.6 syntax_tools-1.7 test_server-3.9 tools-2.8.1 typer-0.9.9 webtool-0.9 wx-1.5 xmerl-1.3.8 : OTP-18.1.4 : inets-6.0.3 # asn1-4.0 common_test-1.11 compiler-6.0.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.1 debugger-4.1.1 dialyzer-2.8.1 diameter-1.11 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 erts-7.1 et-1.5.1 eunit-2.2.11 gs-1.6 hipe-3.13 ic-4.4 jinterface-1.6 kernel-4.1 megaco-3.18 mnesia-4.13.2 observer-2.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0.1 reltool-0.7 runtime_tools-1.9.1 sasl-2.6 snmp-5.2 ssh-4.1.2 ssl-7.1 stdlib-2.6 syntax_tools-1.7 test_server-3.9 tools-2.8.1 typer-0.9.9 webtool-0.9 wx-1.5 xmerl-1.3.8 : -- cgit v1.2.3 From 064990cac9e5012aafba1169d9e098a7140d812a Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Thu, 17 Dec 2015 15:32:17 +0100 Subject: [cover] Don't crash when compiling beam without 'file' attribute cover:compile_beam and cover:compile_beam_directory crashed when trying to compile a beam file without a 'file' attribute. This has been corrected, so an error is returned instead. --- lib/tools/src/cover.erl | 72 ++++++++++++++++++++++++------------------ lib/tools/test/cover_SUITE.erl | 57 ++++++++++++++++----------------- 2 files changed, 69 insertions(+), 60 deletions(-) diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 366d6bcbd9..0ae5c7978d 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1474,7 +1474,7 @@ do_compile_beam(Module,BeamFile0,State) -> {ok,Module,BeamFile}; error -> {error, BeamFile}; - {error,Reason} -> % no abstract code + {error,Reason} -> % no abstract code or no 'file' attribute {error, {Reason, BeamFile}} end; {error,no_beam} -> @@ -1537,32 +1537,11 @@ do_compile_beam1(Module,Beam,UserOptions) -> {error,E}; {raw_abstract_v1,Code} -> Forms0 = epp:interpret_file_attribute(Code), - {Forms,Vars} = transform(Forms0, Module), - - %% We need to recover the source from the compilation - %% info otherwise the newly compiled module will have - %% source pointing to the current directory - SourceInfo = get_source_info(Module, Beam), - - %% Compile and load the result - %% It's necessary to check the result of loading since it may - %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), - case code:load_binary(Module, ?TAG, Binary) of - {module, Module} -> - - %% Store info about all function clauses in database - InitInfo = lists:reverse(Vars#vars.init_info), - ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), - - %% Store binary code so it can be loaded on remote nodes - ets:insert(?BINARY_TABLE, {Module, Binary}), - - {ok, Module}; - - _Error -> - do_clear(Module), - error + case find_main_filename(Forms0) of + {ok,MainFile} -> + do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile); + Error -> + Error end; {_VSN,_Code} -> %% Wrong version of abstract code. Just report that there @@ -1579,6 +1558,35 @@ get_abstract_code(Module, Beam) -> Error -> Error end. +do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile) -> + {Forms,Vars} = transform(Forms0, Module, MainFile), + + %% We need to recover the source from the compilation + %% info otherwise the newly compiled module will have + %% source pointing to the current directory + SourceInfo = get_source_info(Module, Beam), + + %% Compile and load the result + %% It's necessary to check the result of loading since it may + %% fail, for example if Module resides in a sticky directory + {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), + case code:load_binary(Module, ?TAG, Binary) of + {module, Module} -> + + %% Store info about all function clauses in database + InitInfo = lists:reverse(Vars#vars.init_info), + ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), + + %% Store binary code so it can be loaded on remote nodes + ets:insert(?BINARY_TABLE, {Module, Binary}), + + {ok, Module}; + + _Error -> + do_clear(Module), + error + end. + get_source_info(Module, Beam) -> Compile = get_compile_info(Module, Beam), case lists:keyfind(source, 1, Compile) of @@ -1601,8 +1609,7 @@ get_compile_info(Module, Beam) -> [] end. -transform(Code, Module) -> - MainFile=find_main_filename(Code), +transform(Code, Module, MainFile) -> Vars0 = #vars{module=Module}, {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), {MungedForms,Vars}. @@ -1610,9 +1617,12 @@ transform(Code, Module) -> %% Helpfunction which returns the first found file-attribute, which can %% be interpreted as the name of the main erlang source file. find_main_filename([{attribute,_,file,{MainFile,_}}|_]) -> - MainFile; + {ok,MainFile}; find_main_filename([_|Rest]) -> - find_main_filename(Rest). + find_main_filename(Rest); +find_main_filename([]) -> + {error, no_file_attribute}. + transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) -> Form = expand(Form0), diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 3b3cd98837..483ea9774e 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -19,43 +19,16 @@ %% -module(cover_SUITE). --export([all/0, init_per_testcase/2, end_per_testcase/2, - suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - --export([coverage/1, coverage_analysis/1, - start/1, compile/1, analyse/1, misc/1, stop/1, - distribution/1, reconnect/1, die_and_reconnect/1, - dont_reconnect_after_stop/1, stop_node_after_disconnect/1, - export_import/1, - otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, - otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1, compile_beam_opts/1, eep37/1, - analyse_no_beam/1, line_0/1]). - --export([do_coverage/1]). - --export([distribution_performance/1]). +-compile(export_all). -include_lib("test_server/include/test_server.hrl"). -%%---------------------------------------------------------------------- -%% The following directory structure is assumed: -%% cwd __________________________________________ -%% | \ \ \ \ \ \ \ -%% a b cc d f d1 compile_beam_____ otp_6115 -%% | \ \ \ \ \ \ \ -%% e crypt v w x d f1 f2 -%% | -%% y -%%---------------------------------------------------------------------- - suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, otp_8340,otp_8188,compile_beam_opts,eep37, - analyse_no_beam, line_0], + analyse_no_beam, line_0, compile_beam_no_file], StartStop = [start, compile, analyse, misc, stop, distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, @@ -1746,6 +1719,32 @@ line_0(Config) -> ok. +%% OTP-13200: Return error instead of crashing when trying to compile +%% a beam which has no 'file' attribute. +compile_beam_no_file(Config) -> + PrivDir = ?config(priv_dir,Config), + Dir = filename:join(PrivDir,"compile_beam_no_file"), + ok = filelib:ensure_dir(filename:join(Dir,"*")), + code:add_patha(Dir), + Str = lists:concat( + ["-module(nofile).\n" + "-compile(export_all).\n" + "foo() -> ok.\n"]), + TT = do_scan(Str), + Forms = [ begin {ok,Y} = erl_parse:parse_form(X),Y end || X <- TT ], + {ok,_,Bin} = compile:forms(Forms,[debug_info]), + BeamFile = filename:join(Dir,"nofile.beam"), + ok = file:write_file(BeamFile,Bin), + {error,{no_file_attribute,BeamFile}} = cover:compile_beam(nofile), + [{error,{no_file_attribute,BeamFile}}] = cover:compile_beam_directory(Dir), + ok. + +do_scan([]) -> + []; +do_scan(Str) -> + {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), + [ T | do_scan(C) ]. + %%--Auxiliary------------------------------------------------------------ -- cgit v1.2.3 From 41e0a3fcbcc39ed1b7d503fc6d648c00f858bd42 Mon Sep 17 00:00:00 2001 From: Andrew Bennett Date: Thu, 17 Dec 2015 16:03:05 +0100 Subject: crypto: Support 192-bit keys for AES ECB --- lib/crypto/c_src/crypto.c | 1 + lib/crypto/test/crypto_SUITE.erl | 26 +++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index bb2771163d..a839518a64 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -452,6 +452,7 @@ struct cipher_type_t cipher_types[] = {"aes_cfb8", &EVP_aes_128_cfb8}, {"aes_cfb128", &EVP_aes_128_cfb128}, {"aes_ecb", &EVP_aes_128_ecb, 16}, + {"aes_ecb", &EVP_aes_192_ecb, 24}, {"aes_ecb", &EVP_aes_256_ecb, 32}, {NULL} }; diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0b955c0965..30319facea 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1301,7 +1301,31 @@ aes_ecb() -> <<"0000000000000000">>}, {aes_ecb, <<"FEDCBA9876543210">>, - <<"FFFFFFFFFFFFFFFF">>} + <<"FFFFFFFFFFFFFFFF">>}, + %% AES ECB test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf + %% F.1.1 ECB-AES128.Encrypt, F.1.2 ECB-AES128.Decrypt + {aes_ecb, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.3 ECB-AES192.Encrypt, F.1.4 ECB-AES192.Decrypt + {aes_ecb, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e5" + "62f8ead2522c6b7b"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.5 ECB-AES256.Encrypt, F.1.6 ECB-AES256.Decrypt + {aes_ecb, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")} ]. aes_ige256() -> -- cgit v1.2.3 From 78a2b1f8dbba3227dc56e86a7df1231c04f5735d Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 11 Dec 2015 11:54:20 +0100 Subject: ssh: fix the check that open-ssh supports certain pubkeys in a test suite --- lib/ssh/test/ssh_to_openssh_SUITE.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 02cc79e4d5..67a61d3c11 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -110,9 +110,9 @@ end_per_testcase(_TestCase, _Config) -> chk_key(Pgm, Name, File, Config) -> case ssh_test_lib:openssh_supports(Pgm, public_key, Name) of - true -> - {skip,lists:concat(["openssh client does not support ",Name])}; false -> + {skip,lists:concat(["openssh client does not support ",Name])}; + true -> {ok,[[Home]]} = init:get_argument(home), KeyFile = filename:join(Home, File), case file:read_file(KeyFile) of -- cgit v1.2.3 From 573552e7c6df1bc828385ff918b1ad1965463ba2 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 18 Dec 2015 12:10:47 +0100 Subject: ssh: add econnaborted to disconnect msgs in test suite --- lib/ssh/test/ssh_protocol_SUITE.erl | 47 +++++++++++++++---------------------- 1 file changed, 19 insertions(+), 28 deletions(-) diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5af60adfae..4c088acabf 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -277,12 +277,7 @@ no_common_alg_server_disconnects(Config) -> {send, hello}, {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, ssh_msg_kexinit}, % with server unsupported 'ssh-dss' ! - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ] ). @@ -323,10 +318,7 @@ no_common_alg_client_disconnects(Config) -> first_kex_packet_follows = false, reserved = 0 }}, - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed]}, - receive_msg} + {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg} ], InitialState) } @@ -437,10 +429,7 @@ bad_service_name_then_correct(Config) -> [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = "kdjglkfdjgkldfjglkdfjglkfdjglkj"}}, {send, #ssh_msg_service_request{name = "ssh-connection"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). @@ -450,10 +439,7 @@ bad_service_name(Config, Name) -> ssh_trpt_test_lib:exec( [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = Name}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -476,11 +462,7 @@ bad_packet_length(Config, LengthExcess) -> PacketFun}}, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -509,11 +491,7 @@ bad_service_name_length(Config, LengthExcess) -> PacketFun} }, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%================================================================ @@ -644,3 +622,16 @@ connect_and_kex(Config, InitialState) -> {match, #ssh_msg_newkeys{_='_'}, receive_msg} ], InitialState). + +%%%---------------------------------------------------------------- + +%%% For matching peer disconnection +disconnect() -> + disconnect('_'). + +disconnect(Code) -> + {'or',[#ssh_msg_disconnect{code = Code, + _='_'}, + tcp_closed, + {tcp_error,econnaborted} + ]}. -- cgit v1.2.3 From 2f1928b18b59ffb984530e104e737dd8d7449f25 Mon Sep 17 00:00:00 2001 From: Zandra Date: Fri, 18 Dec 2015 14:31:13 +0100 Subject: update java version in documentation --- HOWTO/INSTALL.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 51e8648a4a..c1b6f44046 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -76,10 +76,10 @@ also find the utilities needed for building the documentation. Read more and download from . * Oracle Java SE JDK -- The Java Development Kit (Standard Edition). Required for building the application `jinterface` and parts of `ic` and `orber`. - At least version 1.5.0 of the JDK is required. + At least version 1.6.0 of the JDK is required. Download from . - We have also tested with IBM's JDK 1.5.0. + We have also tested with IBM's JDK 1.6.0. * X Windows -- Development headers and libraries are needed to build the Erlang/OTP application `gs` on Unix/Linux. * `flex` -- Headers and libraries are needed to build the flex -- cgit v1.2.3 From 1be4f6f84f36ad8a84ddcf211336aa4b266661d8 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Fri, 20 Nov 2015 15:27:34 +0000 Subject: TLS distribution: bind erts socket to localhost There is no reason for the socket on the erts side of the proxy to accept connections from other hosts, so let's bind it to the loopback interface. Also change {ip, {127,0,0,1}} to {ip, loopback} for the erts side of the socket for outgoing connections, to avoid hardcoding IPv4. --- lib/ssl/src/ssl_tls_dist_proxy.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 273d3b5521..25192aac0e 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -60,7 +60,7 @@ init([]) -> {ok, #state{}}. handle_call({listen, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of {ok, Socket} -> {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), {ok, TcpAddress} = get_tcp_address(Socket), @@ -179,7 +179,7 @@ setup_proxy(Ip, Port, Parent) -> Opts = get_ssl_options(client), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of -- cgit v1.2.3 From 516708326db6887190425f5c020e66dfe3666a67 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 20 Dec 2015 16:23:20 +0100 Subject: Be resilient to diameter_service state upgrades By not failing in code that looks up state: pick_peer and service_info. --- lib/diameter/src/base/diameter_service.erl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index a31cef2c8c..ed22ef7801 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -206,7 +206,7 @@ stop_transport(SvcName, [_|_] = Refs) -> info(SvcName, Item) -> case lookup_state(SvcName) of - [#state{} = S] -> + [S] -> service_info(Item, S); [] -> undefined @@ -215,7 +215,12 @@ info(SvcName, Item) -> %% lookup_state/1 lookup_state(SvcName) -> - ets:lookup(?STATE_TABLE, SvcName). + case ets:lookup(?STATE_TABLE, SvcName) of + [#state{}] = L -> + L; + _ -> + [] + end. %% --------------------------------------------------------------------------- %% # subscribe/1 -- cgit v1.2.3 From 464492d2ebe24bc13c91fbc99550c05eead599d4 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 20 Dec 2015 10:23:44 +0100 Subject: Update/fix appup for 17.5.6.7 OTP-12947 strict_mbit OTP-12969 watchdog function_clause OTP-13137 request leak diameter_config (that allows the new option) should be loaded after the others. Anchor was missing from one regexp. Patches did not accumulate through older versions. --- lib/diameter/src/diameter.appup.src | 66 ++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 38 deletions(-) diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index adb3f960ff..7d66557162 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -36,45 +36,40 @@ {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, %% R16B03 {"1.6", [{restart_application, diameter}]}, %% 17.0 - {<<"1\\.(7(\\.1)?|8)$">>, %% 17.[134] + {<<"^1\\.(7(\\.1)?|8)$">>, %% 17.[134] [{restart_application, diameter}]}, {<<"^1.9(\\.1)?$">>, %% 17.5(.3)? - [{load_module, diameter_codec}, - {load_module, diameter_traffic}, - {load_module, diameter_sctp}, - {load_module, diameter_peer_fsm}, + [{restart_application, diameter}]}, + {"1.9.2", [{load_module, diameter_peer_fsm}, %% 17.5.5 {load_module, diameter_watchdog}, {load_module, diameter_stats}, - {load_module, diameter_config}, + {load_module, diameter_codec}, {load_module, diameter_lib}, {load_module, diameter_peer}, {load_module, diameter_reg}, {load_module, diameter_service}, {load_module, diameter_session}, {load_module, diameter_sync}, + {load_module, diameter_traffic}, + {load_module, diameter_sctp}, {load_module, diameter_gen_base_rfc6733}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}]}, - {"1.9.2", [{load_module, diameter_peer_fsm}, %% 17.5.5 - {load_module, diameter_watchdog}, - {load_module, diameter_stats}, - {load_module, diameter_config}, + {load_module, diameter_gen_relay}, + {load_module, diameter}, + {load_module, diameter_config}]}, + {"1.9.2.1", [{load_module, diameter_watchdog}, %% 17.5.6.3 {load_module, diameter_codec}, - {load_module, diameter_lib}, - {load_module, diameter_peer}, - {load_module, diameter_reg}, - {load_module, diameter_service}, - {load_module, diameter_session}, - {load_module, diameter_sync}, {load_module, diameter_traffic}, - {load_module, diameter_sctp}, + {load_module, diameter_service}, {load_module, diameter_gen_base_rfc6733}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}]} + {load_module, diameter_gen_relay}, + {load_module, diameter, + {load_module, diameter_config}}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -93,44 +88,39 @@ {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, {"1.6", [{restart_application, diameter}]}, - {<<"1\\.(7(\\.1)?|8)$">>, + {<<"^1\\.(7(\\.1)?|8)$">>, [{restart_application, diameter}]}, {<<"^1.9(\\.1)?$">>, - [{load_module, diameter_gen_relay}, + [{restart_application, diameter}]}, + {"1.9.2", [{load_module, diameter_config}, + {load_module, diameter}, + {load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_sctp}, + {load_module, diameter_traffic}, {load_module, diameter_sync}, {load_module, diameter_session}, {load_module, diameter_service}, {load_module, diameter_reg}, {load_module, diameter_peer}, {load_module, diameter_lib}, - {load_module, diameter_config}, + {load_module, diameter_codec}, {load_module, diameter_stats}, {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_sctp}, - {load_module, diameter_traffic}, - {load_module, diameter_codec}]}, - {"1.9.2", [{load_module, diameter_gen_relay}, + {load_module, diameter_peer_fsm}]}, + {"1.9.2.1", [{load_module, diameter_config}, + {load_module, diameter}, + {load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_sctp}, - {load_module, diameter_traffic}, - {load_module, diameter_sync}, - {load_module, diameter_session}, {load_module, diameter_service}, - {load_module, diameter_reg}, - {load_module, diameter_peer}, - {load_module, diameter_lib}, + {load_module, diameter_traffic}, {load_module, diameter_codec}, - {load_module, diameter_config}, - {load_module, diameter_stats}, - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}]} + {load_module, diameter_watchdog}]} ] }. -- cgit v1.2.3 From 68198c72bc4924d42ea54b4ea0997109ec59cfeb Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 20 Dec 2015 11:01:24 +0100 Subject: vsn -> 1.9.2.2 --- lib/diameter/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index a16b8d712c..18b77e243f 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -16,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.9.2.1 +DIAMETER_VSN = 1.9.2.2 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) -- cgit v1.2.3 From 6a6ff0791a7de5a7a9e034366271497aa2130204 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Sun, 20 Dec 2015 16:29:15 +0100 Subject: Update release notes --- lib/diameter/doc/src/notes.xml | 52 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 7726d761bd..838b1ad7dc 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,58 @@ first.

+
diameter 1.9.2.2 + +
Fixed Bugs and Malfunctions + + +

+ Fix diameter_watchdog function clause.

+

+ OTP-12912 introduced an error with accepting transports + setting {restrict_connections, false}, causing + processes to fail when peer connections were terminated.

+

+ Own Id: OTP-12969

+ + +

+ Fix request table leaks

+

+ The End-to-End and Hop-by-Hop identifiers of outgoing + Diameter requests are stored in a table in order for the + caller to be located when the corresponding answer + message is received. Entries were orphaned if the handler + was terminated by an exit signal as a consequence of + actions taken by callback functions, or if callbacks + modified identifiers in retransmission cases.

+

+ Own Id: OTP-13137

+ + +
+ + +
Improvements and New Features + + +

+ Add service_opt() strict_mbit.

+

+ There are differing opinions on whether or not reception + of an arbitrary AVP setting the M-bit is an error. The + default interpretation is strict: if a command grammar + doesn't explicitly allow an AVP setting the M-bit then + reception of such an AVP is regarded as an error. Setting + {strict_mbit, false} disables this check.

+

+ Own Id: OTP-12947

+ + +
+ +
+
diameter 1.9.2.1
Fixed Bugs and Malfunctions -- cgit v1.2.3 From d7db1f1612e8a5a8a732a7e055ba5618778f1ac2 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Sun, 20 Dec 2015 16:29:16 +0100 Subject: Updated OTP version --- OTP_VERSION | 2 +- otp_versions.table | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index 9ec03a6b8d..cb5558ccf6 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.5.6.6 +17.5.6.7 diff --git a/otp_versions.table b/otp_versions.table index 1d7ad7dee0..fc605e425d 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-17.5.6.7 : diameter-1.9.2.2 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1.5 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.6 : erts-6.4.1.5 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.5 : erts-6.4.1.4 kernel-3.2.0.1 ssl-6.0.1.1 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.4 : debugger-4.0.3.1 erts-6.4.1.3 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : -- cgit v1.2.3 From fe72df791e7857fa72f6ac2b7ba476212a0c2edd Mon Sep 17 00:00:00 2001 From: Mikael Pettersson Date: Sun, 20 Dec 2015 17:02:15 +0100 Subject: efile_drv: logic error in compressed file write Compiling OTP 18.2.1 with gcc-5.3 shows the following warning: drivers/common/efile_drv.c:1538:23: warning: logical not is only applied to the left hand side of comparison [-Wlogical-not-parentheses] The code in question is: if (! (status = erts_gzwrite((ErtsGzFile)d->fd, iov[i].iov_base, iov[i].iov_len)) == iov[i].iov_len) { d->errInfo.posix_errno = d->errInfo.os_errno = errno; /* XXX Correct? */ break; } If we hoist the assignment out of the if for clarity, it becomes: status = erts_gzwrite(..., iov[i].iov_len); if (! status == iov[i].iov_len) { ...; break; } iov_len is > 0 here, and status will equal iov_len if erts_gzwrite succeeded, but will be less than iov_len if an error occurred. "! status" is 0 or 1, which can only equal iov_len if iov_len is 1 and erts_gzwrite detected an error and returned 0. The effect of this mistake is that any error when iov_len >= 2 will skip the conditional code and break statement. In particular, partial writes (0 < status && status < iov_len) will not be flagged as errors. All releases since OTP R8B-0 are affected. The variable "status" is really a boolean, which is to be set to zero on error. The fix is to set status to 1 if erts_gzwrite() returned iov_len and 0 otherwise, and to change the condition to "if (! status) ...". I'm also hoisting the assignment out of the condition since it obscures the code while providing not benefit (the condition in a while or for loop would be a different matter). --- erts/emulator/drivers/common/efile_drv.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3b6abec25e..a5a5dfb7f8 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1532,10 +1532,10 @@ static void invoke_writev(void *data) { * with errno. */ errno = EINVAL; - if (! (status = - erts_gzwrite((ErtsGzFile)d->fd, - iov[i].iov_base, - iov[i].iov_len)) == iov[i].iov_len) { + status = erts_gzwrite((ErtsGzFile)d->fd, + iov[i].iov_base, + iov[i].iov_len) == iov[i].iov_len; + if (! status) { d->errInfo.posix_errno = d->errInfo.os_errno = errno; /* XXX Correct? */ break; -- cgit v1.2.3 From c3135a817f22f76b1ae594dc5821d2d6eab1d25a Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 11 Dec 2015 12:01:43 +0100 Subject: ssh: Add first version of ssh_benchmark_SUITE --- lib/ssh/test/Makefile | 5 +- lib/ssh/test/ssh.spec | 3 + lib/ssh/test/ssh_bench.spec | 1 + lib/ssh/test/ssh_benchmark_SUITE.erl | 295 +++++++++++++++++++++ lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa | 13 + lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 | 5 + .../test/ssh_benchmark_SUITE_data/id_ecdsa256.pub | 1 + lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 | 6 + .../test/ssh_benchmark_SUITE_data/id_ecdsa384.pub | 1 + lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 | 7 + .../test/ssh_benchmark_SUITE_data/id_ecdsa521.pub | 1 + lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa | 15 ++ .../test/ssh_benchmark_SUITE_data/ssh_host_dsa_key | 13 + .../ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub | 11 + .../ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 | 5 + .../ssh_host_ecdsa_key256.pub | 1 + .../ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 | 6 + .../ssh_host_ecdsa_key384.pub | 1 + .../ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 | 7 + .../ssh_host_ecdsa_key521.pub | 1 + .../test/ssh_benchmark_SUITE_data/ssh_host_rsa_key | 16 ++ .../ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub | 5 + 22 files changed, 416 insertions(+), 3 deletions(-) create mode 100644 lib/ssh/test/ssh_bench.spec create mode 100644 lib/ssh/test/ssh_benchmark_SUITE.erl create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key create mode 100644 lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 781a876723..9cd98f069f 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -35,9 +35,8 @@ MODULES= \ ssh_algorithms_SUITE \ ssh_options_SUITE \ ssh_renegotiate_SUITE \ - \ ssh_basic_SUITE \ - \ + ssh_benchmark_SUITE \ ssh_connection_SUITE \ ssh_protocol_SUITE \ ssh_sftp_SUITE \ @@ -129,7 +128,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) ssh.spec ssh.cover "$(RELSYSDIR)" + $(INSTALL_DATA) ssh.spec ssh_bench.spec ssh.cover "$(RELSYSDIR)" $(INSTALL_DATA) $(HRL_FILES_NEEDED_IN_TEST) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index 8de0fe44e4..a3296d97a1 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,4 +1,7 @@ {suites,"../ssh_test",all}. +{skip_cases, "../ssh_test", + ssl_benchmark_SUITE, [openssh_shell,erl_shell], + "Benchmarks run separately"}. {skip_cases,"../ssh_test",ssh_ssh_SUITE, [ssh], "Current implementation is timingdependent and\nhence will succeed/fail on a whim"}. diff --git a/lib/ssh/test/ssh_bench.spec b/lib/ssh/test/ssh_bench.spec new file mode 100644 index 0000000000..029f0bd074 --- /dev/null +++ b/lib/ssh/test/ssh_bench.spec @@ -0,0 +1 @@ +{suites,"../ssh_test",[ssh_benchmark_SUITE]}. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl new file mode 100644 index 0000000000..0d7239c5b5 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -0,0 +1,295 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ssh_benchmark_SUITE). +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/include/ct.hrl"). + +-include_lib("ssh/src/ssh.hrl"). +-include_lib("ssh/src/ssh_connect.hrl"). + +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. +%%suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [{group, opensshc_erld} +%% {group, erlc_opensshd} + ]. + +groups() -> + [{opensshc_erld, [{repeat, 3}], [openssh_client_shell]}, + {erlc_opensshd, [{repeat, 3}], [erl_shell]} + ]. + + +init_per_suite(Config) -> + catch ssh:stop(), + catch crypto:stop(), + try + ok = crypto:start(), + ok = ssh:start(), + {ok,TracerPid} = erlang_trace(), + [{tracer_pid,TracerPid} | Config] + catch + C:E -> + {skip, io_lib:format("Couldn't start ~p:~p",[C,E])} + end. + +end_per_suite(_Config) -> + catch ssh:stop(), + catch crypto:stop(), + ok. + + + +init_per_group(opensshc_erld, Config) -> + case ssh_test_lib:ssh_type() of + openSSH -> + DataDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_rsa(DataDir, UserDir), + ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + [{c_kexs, ssh_test_lib:sshc(kex)}, + {c_ciphers, ssh_test_lib:sshc(cipher)} + | Config]; + _ -> + {skip, "No OpenSsh client found"} + end; + +init_per_group(erlc_opensshd, _) -> + {skip, "Group erlc_opensshd not implemented"}; + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + +%%%================================================================ +openssh_client_shell(Config) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {failfun, fun ssh_test_lib:failfun/2}]), + ct:sleep(500), + + Data = lists:duplicate(100000, $a), + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost '\"",Data,"\"'."]), +%% ct:pal("Cmd ="++Cmd), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, ClientResponse} -> +%% ct:pal("ClientResponse = ~p",[ClientResponse]), + {ok, List} = get_trace_list(TracerPid), + Times = find_times(List), + Algs = proplists:get_value(algorithms, List, #alg{}), + ct:pal("List = ~p~n~nAlgorithms = ~p~n~nTimes = ~p",[List,Algs,Times]), + lists:foreach( + fun({Tag0,MicroSeconds,Unit}) -> + Tag = case Tag0 of + {A,B} -> lists:concat([A," ",B]); + _ when is_list(Tag0) -> lists:concat(Tag0); + _ when is_atom(Tag0) -> Tag0 + end, + DataName = + ["Erl server ",Tag,sp(algo(Tag,Algs))," [",Unit,"]"], + EventData = [{value, MicroSeconds}, + {suite, ?MODULE}, + {name, lists:concat(DataName)} + ], + ct:pal("ct_event:notify ~p",[EventData]), + ct_event:notify(#event{name = benchmark_data, + data = EventData}) + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + + +algo(kex, #alg{kex=Alg} ) -> Alg; +algo(_, _) -> "". + +sp("") -> ""; +sp(A) -> lists:concat([" ",A]). + +%%%================================================================ +find_times(L) -> + [{accept_to_hello, find_time([tcp_accept, + {send,hello}], L, [])/1000, + millisec}, + {kex, find_time([{send,hello}, + {send,ssh_msg_newkeys}], L, []), + microsec}, + {kex_to_auth, find_time([{send,ssh_msg_newkeys}, + {recv,ssh_msg_userauth_request}], L, []), + microsec}, + {auth, find_time([{recv,ssh_msg_userauth_request}, + {send,ssh_msg_userauth_success}], L, []), + microsec}, + {to_prompt, find_time([tcp_accept, + {recv,{ssh_msg_channel_request,"env"}}], L, []), + microsec} + + | alg_times([encrypt,decrypt], L) + ]. + + +find_time([Event|Events], [{Event,T}|TraceList], Ts) -> + %% Important that the first one found is used! + find_time(Events, TraceList, [T|Ts]); +find_time([], _, [T1,T0]) -> + now2micro_sec(now_diff(T1,T0)); +find_time(Events, [_|TraceList], Ts) -> + find_time(Events, TraceList, Ts); +find_time(_, [], _Ts) -> + throw({error,not_found}). + + + +alg_times(Ops, L) -> + OpAlgs = lists:usort([{Op,Alg} || Op <- Ops, + {{{Op,Alg},_,_},_} <- L]), + [begin + {[Op,"(",Alg,")"], + sum_times(OpAlg, L, 0, 0), + "microsec/kbyte" + } + end || {Op,Alg} = OpAlg <- OpAlgs]. + + +sum_times(T, [{{T,start,Id={_,Nbytes}},TS0}|Events], SumBytes, SumMicroSec) -> + TS1 = proplists:get_value({T,stop,Id}, Events), + sum_times(T, Events, SumBytes+Nbytes, SumMicroSec+now2micro_sec(now_diff(TS1,TS0))); +sum_times(T, [_|Events], SumBytes, SumMicroSec) -> + sum_times(T, Events, SumBytes, SumMicroSec); +sum_times(T, [], SumBytes, SumMicroSec) -> + round(1024*SumMicroSec / SumBytes). % Microseconds per 1k bytes. + +%%%---------------------------------------------------------------- +%%% +%%% API for the traceing +%%% +get_trace_list(TracerPid) -> + TracerPid ! {get_trace_list,self()}, + receive + {trace_list,L} -> {ok,lists:reverse(L)} + after 5000 -> {error,no_reply} + end. + +erlang_trace() -> + TracerPid = spawn(fun trace_loop/0), + 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), + [init_trace(MFA, TP) + || {MFA,TP} <- [{{ssh_acceptor,handle_connection,5}, []}, + {{ssh_connection_handler,hello,2}, []}, + {{ssh_message,encode,1}, []}, + {{ssh_message,decode,1}, [{['_'], [], [{return_trace}]}]}, + {{ssh_transport,select_algorithm,3}, [{['_','_','_'], [], [{return_trace}]}]}, + {{ssh_transport,encrypt,2}, [{['_','_'], [], [{return_trace}]}]}, + {{ssh_transport,decrypt,2}, [{['_','_'], [], [{return_trace}]}]} + ]], + {ok, TracerPid}. + + +%%%---------------- +init_trace(MFA = {Module,_,_}, TP) -> + case code:is_loaded(Module) of + false -> code:load_file(Module); + _ -> ok + end, + erlang:trace_pattern(MFA, TP, [local]). + + +trace_loop() -> + trace_loop([]). + +trace_loop(L) -> + receive + {trace_ts, Pid, call, {M,F,Args}, TS} = Ev -> + cond_pal(Ev), + trace_loop(save_event(call, Pid, {M,F,Args}, TS, L)); + {trace_ts, Pid, return_from, {M,F,Arity}, Ret, TS} = Ev -> + cond_pal(Ev), + trace_loop(save_event(return_from, Pid, {M,F,Arity,Ret}, TS, L)); + {get_trace_list, From} -> + From ! {trace_list, L}, + trace_loop(L) + + ; Other -> io:format('~p got ~p~n',[self(),Other]), trace_loop(L) + end. + +%%cond_pal(Ev) -> ct:pal("~p",[Ev]). +cond_pal(Ev) -> ok. + + +save_event(_Type, _Pid, MFA, TimeStamp, L) -> + try + event_name(MFA) + of + {Tag, 'TS'} -> [{Tag,TimeStamp} | L]; + Val -> [Val | L] + catch + _:_ -> L + end. + +event_name({ssh_acceptor,handle_connection,_}) -> {tcp_accept, 'TS'}; +event_name({ssh_connection_handler,hello,[socket_control|_]}) -> {{send,hello}, 'TS'}; +event_name({ssh_connection_handler,hello,[{version_exchange,_}|_]}) -> {{recv,hello}, 'TS'}; +event_name({ssh_message,encode,[Msg]}) -> {{send,element(1,Msg)}, 'TS'}; +event_name({ssh_message,decode,1, + #ssh_msg_channel_request{request_type=ReqType}}) -> {{recv,{ssh_msg_channel_request,ReqType}}, 'TS'}; +event_name({ssh_message,decode,1,Return}) -> {{recv,element(1,Return)}, 'TS'}; +event_name({ssh_transport,select_algorithm,3,{ok,Algs}}) -> {algorithms,Algs}; +event_name({ssh_transport,encrypt,[S,Data]}) -> {{{encrypt,S#ssh.encrypt},start, {S#ssh.send_sequence,size(Data)}}, 'TS'}; +event_name({ssh_transport,encrypt,2,{S,Ret}}) -> {{{encrypt,S#ssh.encrypt},stop, {S#ssh.send_sequence,size(Ret) }}, 'TS'}; +event_name({ssh_transport,decrypt,[S,Data]}) -> {{{decrypt,S#ssh.decrypt},start, {S#ssh.recv_sequence,size(Data)}}, 'TS'}; +event_name({ssh_transport,decrypt,2,{S,Ret}}) -> {{{decrypt,S#ssh.decrypt},stop, {S#ssh.recv_sequence,size(Ret) }}, 'TS'}. + + +now2sec({A,B,C}) -> A*1000000 + B + C/1000000. + +now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C. + +now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}. + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 new file mode 100644 index 0000000000..4b1eb12eaa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIJfCaBKIIKhjbJl5F8BedqlXOQYDX5ba9Skypllmx/w+oAoGCCqGSM49 +AwEHoUQDQgAE49RbK2xQ/19ji3uDPM7uT4692LbwWF1TiaA9vUuebMGazoW/98br +N9xZu0L1AWwtEjs3kmJDTB7eJEGXnjUAcQ== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub new file mode 100644 index 0000000000..a0147e60fa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBOPUWytsUP9fY4t7gzzO7k+Ovdi28FhdU4mgPb1LnmzBms6Fv/fG6zfcWbtC9QFsLRI7N5JiQ0we3iRBl541AHE= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 new file mode 100644 index 0000000000..4e8aa40959 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDCYXb6OSAZyXRfLXOtMo43za197Hdc/T0YKjgQQjwDt6rlRwqTh7v7S +PV2kXwNGdWigBwYFK4EEACKhZANiAARN2khlJUOOIiwsWHEALwDieeZR96qL4pUd +ci7aeGaczdUK5jOA9D9zmBZtSYTfO8Cr7ekVghDlcWAIJ/BXcswgQwSEQ6wyfaTF +8FYfyr4l3u9IirsnyaFzeIgeoNis8Gw= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub new file mode 100644 index 0000000000..41e722e545 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBE3aSGUlQ44iLCxYcQAvAOJ55lH3qovilR1yLtp4ZpzN1QrmM4D0P3OYFm1JhN87wKvt6RWCEOVxYAgn8FdyzCBDBIRDrDJ9pMXwVh/KviXe70iKuyfJoXN4iB6g2KzwbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 new file mode 100644 index 0000000000..7196f46e97 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEFMadoz4ckEcClfqXa2tiUuYkJdDfwq+/iFQcpt8ESuEd26IY/vm47Q +9UzbPkO4ou8xkNsQ3WvCRQBBWtn5O2kUU6AHBgUrgQQAI6GBiQOBhgAEAde5BRu5 +01/jS0jRk212xsb2DxPrxNpgp6IMCV8TA4Eps+8bSqHB091nLiBcP422HXYfuCd7 +XDjSs8ihcmhp0hCRASLqZR9EzW9W/SOt876May1Huj5X+WSO6RLe7vPn9vmf7kHf +pip6m7M7qp2qGgQ3q2vRwS2K/O6156ohiOlmuuFs +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub new file mode 100644 index 0000000000..8f059120bc --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHXuQUbudNf40tI0ZNtdsbG9g8T68TaYKeiDAlfEwOBKbPvG0qhwdPdZy4gXD+Nth12H7gne1w40rPIoXJoadIQkQEi6mUfRM1vVv0jrfO+jGstR7o+V/lkjukS3u7z5/b5n+5B36YqepuzO6qdqhoEN6tr0cEtivzuteeqIYjpZrrhbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..2979ea88ed --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIMe4MDoit0t8RzSVPwkCBemQ9fhXL+xnTSAWISw8HNCioAoGCCqGSM49 +AwEHoUQDQgAEo2q7U3P6r0W5WGOLtM78UQtofM9UalEhiZeDdiyylsR/RR17Op0s +VPGSADLmzzgcucLEKy17j2S+oz42VUJy5A== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..85dc419345 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBKNqu1Nz+q9FuVhji7TO/FELaHzPVGpRIYmXg3YsspbEf0UdezqdLFTxkgAy5s84HLnCxCste49kvqM+NlVCcuQ= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..fb1a862ded --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDArxbDfh3p1okrD9wQw6jJ4d4DdlBPD5GqXE8bIeRJiK41Sh40LgvPw +mkqEDSXK++CgBwYFK4EEACKhZANiAAScl43Ih2lWTDKrSox5ve5uiTXil4smsup3 +CfS1XPjKxgBAmlfBim8izbdrT0BFdQzz2joduNMtpt61wO4rGs6jm0UP7Kim9PC7 +Hneb/99fIYopdMH5NMnk60zGO1uZ2vc= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..428d5fb7d7 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBJyXjciHaVZMMqtKjHm97m6JNeKXiyay6ncJ9LVc+MrGAECaV8GKbyLNt2tPQEV1DPPaOh240y2m3rXA7isazqObRQ/sqKb08Lsed5v/318hiil0wfk0yeTrTMY7W5na9w== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..3e51ec2ecd --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIB8O1BFkl2HQjQLRLonEZ97da/h39DMa9/0/hvPZWAI8gUPEQcHxRx +U7b09p3Zh+EBbMFq8+1ae9ds+ZTxE4WFSvKgBwYFK4EEACOhgYkDgYYABAAlWVjq +Bzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/ +vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5 +ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..017a29f4da --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAAlWVjqBzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- -- cgit v1.2.3 From ee18dff59a88407e66eb852e3226665cddc8080b Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 15 Dec 2015 21:05:39 +0100 Subject: ssh: ssh_benchmark_SUITE re-organized --- lib/ssh/test/ssh_benchmark_SUITE.erl | 251 +++++++++++++++++++++-------------- 1 file changed, 151 insertions(+), 100 deletions(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 0d7239c5b5..fe22aa9f20 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -24,7 +24,10 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). -include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_userauth.hrl"). + suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. %%suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -115,14 +118,14 @@ openssh_client_shell(Config) -> Parent ! {self(),os:cmd(Cmd)} end), receive - {SlavePid, ClientResponse} -> -%% ct:pal("ClientResponse = ~p",[ClientResponse]), + {SlavePid, _ClientResponse} -> +%% ct:pal("ClientResponse = ~p",[_ClientResponse]), {ok, List} = get_trace_list(TracerPid), Times = find_times(List), - Algs = proplists:get_value(algorithms, List, #alg{}), - ct:pal("List = ~p~n~nAlgorithms = ~p~n~nTimes = ~p",[List,Algs,Times]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), lists:foreach( - fun({Tag0,MicroSeconds,Unit}) -> + fun({Tag0,Value,Unit}) -> Tag = case Tag0 of {A,B} -> lists:concat([A," ",B]); _ when is_list(Tag0) -> lists:concat(Tag0); @@ -130,7 +133,7 @@ openssh_client_shell(Config) -> end, DataName = ["Erl server ",Tag,sp(algo(Tag,Algs))," [",Unit,"]"], - EventData = [{value, MicroSeconds}, + EventData = [{value, Value}, {suite, ?MODULE}, {name, lists:concat(DataName)} ], @@ -155,56 +158,109 @@ sp(A) -> lists:concat([" ",A]). %%%================================================================ find_times(L) -> - [{accept_to_hello, find_time([tcp_accept, - {send,hello}], L, [])/1000, - millisec}, - {kex, find_time([{send,hello}, - {send,ssh_msg_newkeys}], L, []), - microsec}, - {kex_to_auth, find_time([{send,ssh_msg_newkeys}, - {recv,ssh_msg_userauth_request}], L, []), - microsec}, - {auth, find_time([{recv,ssh_msg_userauth_request}, - {send,ssh_msg_userauth_success}], L, []), - microsec}, - {to_prompt, find_time([tcp_accept, - {recv,{ssh_msg_channel_request,"env"}}], L, []), - microsec} - - | alg_times([encrypt,decrypt], L) - ]. - - -find_time([Event|Events], [{Event,T}|TraceList], Ts) -> - %% Important that the first one found is used! - find_time(Events, TraceList, [T|Ts]); -find_time([], _, [T1,T0]) -> - now2micro_sec(now_diff(T1,T0)); -find_time(Events, [_|TraceList], Ts) -> - find_time(Events, TraceList, Ts); -find_time(_, [], _Ts) -> - throw({error,not_found}). - + Xs = [accept_to_hello, kex, kex_to_auth, auth, to_prompt], + [find_time(X,L) || X <- Xs] ++ + crypto_algs_times_sizes([encrypt,decrypt], L). + +-record(call, { + mfa, + pid, + t_call, + t_return, + args, + result + }). +%%%---------------- +-define(send(M), fun(C=#call{mfa = {ssh_message,encode,1}, + args = [M]}) -> + C#call.t_return + end). + +-define(recv(M), fun(C=#call{mfa = {ssh_message,decode,1}, + result = M}) -> + C#call.t_call + end). + +find_time(accept_to_hello, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_return + end + ], L, []), + {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_call + end, + ?send(#ssh_msg_newkeys{}) + ], L, []), + {kex, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex_to_auth, L) -> + [T0,T1] = find([?send(#ssh_msg_newkeys{}), + ?recv(#ssh_msg_userauth_request{}) + ], L, []), + {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(auth, L) -> + [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), + ?send(#ssh_msg_userauth_success{}) + ], L, []), + {auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(to_prompt, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + ?recv(#ssh_msg_channel_request{request_type="env"}) + ], L, []), + {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}. + + +find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> + try + F(C) + of + T -> find(Fs, Cs, [T|Acc]) + catch + _:_ -> find([F|Fs], Cs, Acc) + end; +find([], _, Acc) -> + lists:reverse(Acc). -alg_times(Ops, L) -> - OpAlgs = lists:usort([{Op,Alg} || Op <- Ops, - {{{Op,Alg},_,_},_} <- L]), - [begin - {[Op,"(",Alg,")"], - sum_times(OpAlg, L, 0, 0), - "microsec/kbyte" - } - end || {Op,Alg} = OpAlg <- OpAlgs]. +find_algs(L) -> + {value,#call{result={ok,Algs}}} = + lists:keysearch({ssh_transport,select_algorithm,3}, #call.mfa, L), + Algs. -sum_times(T, [{{T,start,Id={_,Nbytes}},TS0}|Events], SumBytes, SumMicroSec) -> - TS1 = proplists:get_value({T,stop,Id}, Events), - sum_times(T, Events, SumBytes+Nbytes, SumMicroSec+now2micro_sec(now_diff(TS1,TS0))); -sum_times(T, [_|Events], SumBytes, SumMicroSec) -> - sum_times(T, Events, SumBytes, SumMicroSec); -sum_times(T, [], SumBytes, SumMicroSec) -> - round(1024*SumMicroSec / SumBytes). % Microseconds per 1k bytes. +%%%---------------- +crypto_algs_times_sizes(EncDecs, L) -> + Raw = [{_Algorithm = case EncDec of + encrypt -> [encrypt," ",S#ssh.encrypt]; + decrypt -> [decrypt," ",S#ssh.decrypt] + end, + size(Data), + now2micro_sec(now_diff(T1, T0)) + } + || EncDec <- EncDecs, + #call{mfa = {ssh_transport,ED,2}, + args = [S,Data], + t_call = T0, + t_return = T1} <- L, + ED == EncDec + ], + [{Alg, round(1024*Time/Size), "microsec/kbyte"} % Microseconds per 1k bytes. + || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. + +increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> + [{Alg,SumSz+Sz,SumT+T} | Acc]; +increment(Spec, [X|Acc]) -> + [X | increment(Spec,Acc)]; % Not so many Alg, 2 or 3 +increment({Alg,Sz,T},[]) -> + [{Alg,Sz,T}]. %%%---------------------------------------------------------------- %%% @@ -213,26 +269,28 @@ sum_times(T, [], SumBytes, SumMicroSec) -> get_trace_list(TracerPid) -> TracerPid ! {get_trace_list,self()}, receive - {trace_list,L} -> {ok,lists:reverse(L)} + {trace_list,L} -> {ok, pair_events(lists:reverse(L))} after 5000 -> {error,no_reply} end. erlang_trace() -> TracerPid = spawn(fun trace_loop/0), 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), - [init_trace(MFA, TP) - || {MFA,TP} <- [{{ssh_acceptor,handle_connection,5}, []}, - {{ssh_connection_handler,hello,2}, []}, - {{ssh_message,encode,1}, []}, - {{ssh_message,decode,1}, [{['_'], [], [{return_trace}]}]}, - {{ssh_transport,select_algorithm,3}, [{['_','_','_'], [], [{return_trace}]}]}, - {{ssh_transport,encrypt,2}, [{['_','_'], [], [{return_trace}]}]}, - {{ssh_transport,decrypt,2}, [{['_','_'], [], [{return_trace}]}]} - ]], + [init_trace(MFA, tp(MFA)) + || MFA <- [{ssh_acceptor,handle_connection,5}, + {ssh_connection_handler,hello,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, + {ssh_transport,select_algorithm,3}, + {ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2} + ]], {ok, TracerPid}. +tp({_M,_F,Arity}) -> + [{lists:duplicate(Arity,'_'), [], [{return_trace}]}]. -%%%---------------- +%%%---------------------------------------------------------------- init_trace(MFA = {Module,_,_}, TP) -> case code:is_loaded(Module) of false -> code:load_file(Module); @@ -246,50 +304,43 @@ trace_loop() -> trace_loop(L) -> receive - {trace_ts, Pid, call, {M,F,Args}, TS} = Ev -> - cond_pal(Ev), - trace_loop(save_event(call, Pid, {M,F,Args}, TS, L)); - {trace_ts, Pid, return_from, {M,F,Arity}, Ret, TS} = Ev -> - cond_pal(Ev), - trace_loop(save_event(return_from, Pid, {M,F,Arity,Ret}, TS, L)); {get_trace_list, From} -> From ! {trace_list, L}, - trace_loop(L) - - ; Other -> io:format('~p got ~p~n',[self(),Other]), trace_loop(L) + trace_loop(L); + Ev -> + trace_loop([Ev|L]) end. - -%%cond_pal(Ev) -> ct:pal("~p",[Ev]). -cond_pal(Ev) -> ok. - - -save_event(_Type, _Pid, MFA, TimeStamp, L) -> - try - event_name(MFA) - of - {Tag, 'TS'} -> [{Tag,TimeStamp} | L]; - Val -> [Val | L] - catch - _:_ -> L - end. - -event_name({ssh_acceptor,handle_connection,_}) -> {tcp_accept, 'TS'}; -event_name({ssh_connection_handler,hello,[socket_control|_]}) -> {{send,hello}, 'TS'}; -event_name({ssh_connection_handler,hello,[{version_exchange,_}|_]}) -> {{recv,hello}, 'TS'}; -event_name({ssh_message,encode,[Msg]}) -> {{send,element(1,Msg)}, 'TS'}; -event_name({ssh_message,decode,1, - #ssh_msg_channel_request{request_type=ReqType}}) -> {{recv,{ssh_msg_channel_request,ReqType}}, 'TS'}; -event_name({ssh_message,decode,1,Return}) -> {{recv,element(1,Return)}, 'TS'}; -event_name({ssh_transport,select_algorithm,3,{ok,Algs}}) -> {algorithms,Algs}; -event_name({ssh_transport,encrypt,[S,Data]}) -> {{{encrypt,S#ssh.encrypt},start, {S#ssh.send_sequence,size(Data)}}, 'TS'}; -event_name({ssh_transport,encrypt,2,{S,Ret}}) -> {{{encrypt,S#ssh.encrypt},stop, {S#ssh.send_sequence,size(Ret) }}, 'TS'}; -event_name({ssh_transport,decrypt,[S,Data]}) -> {{{decrypt,S#ssh.decrypt},start, {S#ssh.recv_sequence,size(Data)}}, 'TS'}; -event_name({ssh_transport,decrypt,2,{S,Ret}}) -> {{{decrypt,S#ssh.decrypt},stop, {S#ssh.recv_sequence,size(Ret) }}, 'TS'}. +pair_events(L) -> + pair_events(L, []). + +pair_events([{trace_ts,Pid,call,{M,F,Args},TS0} | L], Acc) -> + Arity = length(Args), + {ReturnValue,TS1} = find_return(Pid, {M,F,Arity}, L), + pair_events(L, [#call{mfa = {M,F,Arity}, + pid = Pid, + t_call = TS0, + t_return = TS1, + args = Args, + result = ReturnValue} | Acc]); +pair_events([_|L], Acc) -> + pair_events(L, Acc); +pair_events([], Acc) -> + lists:reverse(Acc). + + +find_return(Pid, MFA, + [{trace_ts, Pid, return_from, MFA, ReturnValue, TS}|_]) -> + {ReturnValue, TS}; +find_return(Pid, MFA, [_|L]) -> + find_return(Pid, MFA, L); +find_return(_, _, []) -> + {undefined, undefined}. +%%%---------------------------------------------------------------- now2sec({A,B,C}) -> A*1000000 + B + C/1000000. now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C. now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}. - + -- cgit v1.2.3 From 2900f5787d81a5ad9f2f8ebcf0d51c7fe87eeb2c Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 15 Dec 2015 21:52:20 +0100 Subject: New structure of the report --- lib/ssh/test/ssh_benchmark_SUITE.erl | 47 +++++++++++++++++++++--------------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index fe22aa9f20..0a11654116 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -125,18 +125,25 @@ openssh_client_shell(Config) -> Algs = find_algs(List), ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), lists:foreach( - fun({Tag0,Value,Unit}) -> - Tag = case Tag0 of - {A,B} -> lists:concat([A," ",B]); - _ when is_list(Tag0) -> lists:concat(Tag0); - _ when is_atom(Tag0) -> Tag0 - end, - DataName = - ["Erl server ",Tag,sp(algo(Tag,Algs))," [",Unit,"]"], - EventData = [{value, Value}, + fun({Tag,Value,Unit}) -> + EventData = + case Tag of + {A,B} when A==encrypt ; A==decrypt -> + [{value, Value}, {suite, ?MODULE}, - {name, lists:concat(DataName)} - ], + {name, mk_name(["Cipher ",A," ",B," [",Unit,"]"])} + ]; + kex -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server kex ",Algs#alg.kex," [",Unit,"]"])} + ]; + _ when is_atom(Tag) -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server ",Tag," [",Unit,"]"])} + ] + end, ct:pal("ct_event:notify ~p",[EventData]), ct_event:notify(#event{name = benchmark_data, data = EventData}) @@ -150,13 +157,13 @@ openssh_client_shell(Config) -> end. -algo(kex, #alg{kex=Alg} ) -> Alg; -algo(_, _) -> "". - -sp("") -> ""; -sp(A) -> lists:concat([" ",A]). - %%%================================================================ +mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. + +char($-) -> $_; +char(C) -> C. + +%%%---------------------------------------------------------------- find_times(L) -> Xs = [accept_to_hello, kex, kex_to_auth, auth, to_prompt], [find_time(X,L) || X <- Xs] ++ @@ -239,8 +246,8 @@ find_algs(L) -> %%%---------------- crypto_algs_times_sizes(EncDecs, L) -> Raw = [{_Algorithm = case EncDec of - encrypt -> [encrypt," ",S#ssh.encrypt]; - decrypt -> [decrypt," ",S#ssh.decrypt] + encrypt -> {encrypt,S#ssh.encrypt}; + decrypt -> {decrypt,S#ssh.decrypt} end, size(Data), now2micro_sec(now_diff(T1, T0)) @@ -252,7 +259,7 @@ crypto_algs_times_sizes(EncDecs, L) -> t_return = T1} <- L, ED == EncDec ], - [{Alg, round(1024*Time/Size), "microsec/kbyte"} % Microseconds per 1k bytes. + [{Alg, round(1024*Time/Size), "microsec per kbyte"} % Microseconds per 1k bytes. || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> -- cgit v1.2.3 From 74faca0ac7e9e4f1d44ec43749aafe125d8a6371 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Wed, 16 Dec 2015 15:06:26 +0100 Subject: ssh: benchmark all common kex and cipher algorithms --- lib/ssh/test/ssh_benchmark_SUITE.erl | 81 ++++++++++++++++++++++++++++++++++-- lib/ssh/test/ssh_test_lib.erl | 35 +++++++++++++++- 2 files changed, 111 insertions(+), 5 deletions(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 0a11654116..2add99de97 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -47,6 +47,7 @@ init_per_suite(Config) -> catch crypto:stop(), try ok = crypto:start(), + report_client_algorithms(), ok = ssh:start(), {ok,TracerPid} = erlang_trace(), [{tracer_pid,TracerPid} | Config] @@ -95,6 +96,34 @@ end_per_testcase(_Func, _Conf) -> %%%================================================================ openssh_client_shell(Config) -> + CommonAlgs = ssh_test_lib:intersect_bi_dir( + ssh_test_lib:intersection(ssh:default_algorithms(), + ssh_test_lib:default_algorithms(sshc))), + KexVariants = + [ [{kex,[Kex]}] + || Kex <- proplists:get_value(kex, CommonAlgs)], + CipherVariants = + [ [{cipher,[{client2server,[Cipher]}, + {server2client,[Cipher]}]}] + || Cipher <- proplists:get_value(cipher, CommonAlgs)], + + + lists:foreach( + fun(PrefAlgs=[{kex,[Kex]}]) when Kex == 'diffie-hellman-group-exchange-sha256' -> + lists:foreach( + fun(Grp) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}, + {dh_gex_groups, [Grp]} + ]) + end, moduli()); + (PrefAlgs) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}]) + end, KexVariants ++ CipherVariants). + + +openssh_client_shell(Config, Options) -> SystemDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), KnownHosts = filename:join(UserDir, "known_hosts"), @@ -103,7 +132,8 @@ openssh_client_shell(Config) -> {ServerPid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {public_key_alg, ssh_dsa}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2} | + Options]), ct:sleep(500), Data = lists:duplicate(100000, $a), @@ -134,9 +164,10 @@ openssh_client_shell(Config) -> {name, mk_name(["Cipher ",A," ",B," [",Unit,"]"])} ]; kex -> + KexAlgStr = fmt_alg(Algs#alg.kex, List), [{value, Value}, {suite, ?MODULE}, - {name, mk_name(["Erl server kex ",Algs#alg.kex," [",Unit,"]"])} + {name, mk_name(["Erl server kex ",KexAlgStr," [",Unit,"]"])} ]; _ when is_atom(Tag) -> [{value, Value}, @@ -158,6 +189,20 @@ openssh_client_shell(Config) -> %%%================================================================ +fmt_alg(Alg, List) when is_atom(Alg) -> + fmt_alg(atom_to_list(Alg), List); +fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) -> + try + integer_to_list(find_gex_size_string(List)) + of + GexSize -> lists:concat([Alg," ",GexSize]) + catch + _:_ -> Alg + end; +fmt_alg(Alg, List) -> + Alg. + +%%%---------------------------------------------------------------- mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. char($-) -> $_; @@ -239,10 +284,16 @@ find([], _, Acc) -> find_algs(L) -> - {value,#call{result={ok,Algs}}} = + {value, #call{result={ok,Algs}}} = lists:keysearch({ssh_transport,select_algorithm,3}, #call.mfa, L), Algs. +find_gex_size_string(L) -> + %% server + {value, #call{result={ok,{Size, _}}}} = + lists:keysearch({public_key,dh_gex_group,4}, #call.mfa, L), + Size. + %%%---------------- crypto_algs_times_sizes(EncDecs, L) -> Raw = [{_Algorithm = case EncDec of @@ -290,7 +341,8 @@ erlang_trace() -> {ssh_message,decode,1}, {ssh_transport,select_algorithm,3}, {ssh_transport,encrypt,2}, - {ssh_transport,decrypt,2} + {ssh_transport,decrypt,2}, + {public_key,dh_gex_group,4} % To find dh_gex group size ]], {ok, TracerPid}. @@ -345,9 +397,30 @@ find_return(_, _, []) -> {undefined, undefined}. %%%---------------------------------------------------------------- +report_client_algorithms() -> + try + ssh_test_lib:extract_algos( ssh_test_lib:default_algorithms(sshc) ) + of + ClientAlgs -> + ct:pal("The client supports:~n~p",[ClientAlgs]) + catch + Cls:Err -> + ct:pal("Testing client about algorithms failed:~n~p ~p",[Cls,Err]) + end. + +%%%---------------------------------------------------------------- + + now2sec({A,B,C}) -> A*1000000 + B + C/1000000. now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C. now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}. +%%%================================================================ +moduli() -> + [{1023, 5, 16#CF973CD39DC7D62F2C45AAC5180491104C76E0FE5D80A10E6C06AE442F1F373167B0FCBC931F3C157B10A5557008FDE20D68051E6A4DB11CEE0B0749F76D7134B937A59DA998C42BC234A5C1A3CFCD70E624D253D7694076F7B1FD7B8D3427849C9377B3555796ACA58C69DFF542EEEC9859D3ADCE5CC88DF6F7817C9D182EB7}, + {2047, 5, 16#F7693FC11FDDEAA493D3BA36F1FFF9264AA9952209203192A88A697BE9D0E306E306A27430BD87AB9EE9DB4BC78C41950C2EB0E5E4C686E8B1BA6D6A2B1FE91EF40C5EA32C51018323E1D305FE637F35ACABDBFC40AD683F779570A76869EB90015A342B2D1F7C81602688081FCAAA8D623090258D9C5C729C8CDDC0C12CA2D561DD987DB79B6AD7A2A509EBC383BF223FD95BC5A2FCC26FB3F3A0DD3FDC1228E338D3290235A596F9465F7BF490974847E616229A9E60B8F4AA161C52F655843CCCAE8821B40C426B535DE087964778652BBD4EC601C0456AE7128B593FCC64402C891227AE6EE88CC839416FBF462B4852999C646BE0BED7D8CF2BE5E381EF}, + {4095, 2, 16#C8842271626E53546E0C712FA265713F2EE073C20A0723C96B6B182B1EAACC96233D4A199BD0E85F264078A513AD2454F284B8DF543D85019D1E70F2FF54BA43EFBC64AF465C170C3E376F5EC328F98E33E1ED8BED84FA097ABE584152B0E9827ED5CC2B1D4F5ECF2DC46F45C59816D02698EA26F319311E2B6973E83C37021CC8B416AEF653896A1764EE0CEE718A45E8B47CB960BD5907D0E843E8A8E7D4698363C3C3FB3ADC512368B72CAF16510C69052EA2AF51BE00BC8CA04DF1F00A00CC2CA4D74254A1E8738460FD244DDB446CB36554B0A24EEF3710E44DBCF39881E7D3F9AE223388084E7A49A3CB12612AE36416C0EB5628DF1477FEE4A5CF77CDC09AA0E2C989C0B7D1310AFA44B81DA79A65226C7EA510057991EABF9388DC5EA9F52FEA5D3B0872843F50878740794E523E9DC60E0EA1FC8746A7B2AA31FCA89AAA2FA907BED116C69D98F912DD5089BECF28577064225DE96FC214ED1794E7CCE8024F94036D915A123A464C951DA96A5ED7F286F205BEE71BDE2D133FD1891B31178FF25D31611A5B7839F0E68EAF0F8901A571E6917C580F31842A9F19C47E0638483B7947DDCD7864660AC2F8B2C430F1E7FC0F22FA51F96F0499332C5AD3FF9DC7F4332DD5BCCA820CC779B90C0F4C5F0CA52E96FAA187361753FBADC5C80D0492CD80A3EEA5D578772DA9FC1C0E10A0203098AF36D0ED2156BA7321EB}, + {6143, 5, 16#FD9E6B52785CD7BE64D396A599DA4B97CD0BB49183F932A97694D80CA553354DBC26E77B8A0EC002257AADDF6AD27819CE64A06416E4A80B6EA92F28EA8D5B96C774109EEE5816B4B18F84368D1B41864C11AA73D6881675D779B174F6B4E344303F3EFD11BD7DE468467242372FD00908F296F5A2B20E2684F9122D08A46D647B05E298F0BCDAB60468349CCA6DA1B9FEBBC69D256FB9A3F1980F68466364FCEF1C98C1405191A6737A3627BA7F7313A8A18FC0B8521BF3430B1C6805CB44BCEB39904DD30130D24B225B598ED83C5FD757B80189FD9D5C2F9596687C40BAB1C6ED6244944629849D074A4C33FB15DDB3F9760FC59C44BEBB0EC032177147F61789769DAAAE2123CE488F7ECF19BDA051925BA9ED11EAA72DF70C9ECC8F714B4C35728E6679E66A1B56CCAE0FBBD3F9EBF950D4D623ED78E77CC3AD604E91F304EA78CE876F036214BD6F1977BD04C9ADD707D7A3BCCE87AD5D5A11C95E7025B0EA9C649DCB37942A3970A4FB04C284E4DDB4DC90163353B98B1C254FFD28443353F17A87C02E0BDB9F05424CC44C86309F1D73706F039CDAAC3EDC1A64F38FB42707D351DB5360C2680ADC1CC8D1C4AD312ACC904382C26BE33DA0E61429A5940820356ED28586BEB629ED1521D12D25B4DA01926295F3DA504DC9F431B719AC63277BE675E6F6DD4F7499CA11A23744577D653941963E8DAB610F7F226DB52CE5C683F72AEED2B6CE35ED07C29410397A6F7F606477CCC0EDE18CD0D96A7863BC4606193A8799B5AC1EEE6AC5EE36AC3077EC8DAB30EE94434B45B78BC13D96F74D6C4056EAA528CD3C68D308344808819B12F2BFB95A5C1A7DEEE188BF139216DDB7D757D7A50D3C46CE18881D776D617DCFFAA62276045373AA4D9446D7570338F99C0CA8A08851B4F9D388B4C275D3F9B7BA25F235D4329F63F7457C2EB5C68CE2A96D19766F0ED8E19F66DF3C5E29A38795B2F92291BB6EAB6F70A7E89DC9691F28486E9CF87FF11D5DF2E6B030A30B5D476AD59A34EE7262712ED96CEF4A5CAC3F08B3563D44683F746DA094C9CDB34427AF8D8CC2AE1B23C3BEB637}, + {8191, 2, 16#DC61EF13E4F3FC10CC946EEABC33F83EFCB35E0F47E4EC25C1CCBB2C7B502B2EFB0691AA231C8476DD51BA73204E6EA10B1A970FE2CF14AF01E72E1AEA87519A91D00D1499189F94A6CDA9E29C05F11F17FE74A4919A710A2787E180744465DF81C62AA65662FDA46FA6175E8A31E5B29E66DED6701C8FC4217E91D733FE94380F046680967D4CEA7BAC8F3916CDF96AA2C474FAD9650F48403FD0B5B756D34667D36A07767FA33027AE55484D0F701C3CA16632F413A14E4B8645AFAF15B78978C19A7661EDC569BEC72394B1204B166A48FCD5F56BE29840C7794CA6D3440356F15858CDCA9B429C7EA92E17242893FDC8C9C63841A382C32F20CFAB121B4BCAFD7BF9EF07FBF7CDFFECA0CEF3A49C3E2B24FA836F3318435255655E1B281071F62D5E4CD63361299B7828F72936E3FEA9E8044562A6F6ADD5321187C3101E4669C6271598FE1A866C93FE2870A4CEB9254BA32A4719E439317EA42200A335B5CFFA7946A7D0F1BD1A69AA11288B73C71C80B77FE3707CB077DDDEA5CA36A449FAB230C9625A0B12F8275D3FF82F5DA380E7A3F11B6F155FE7E91AC960BD95D9B13F7423AB9B15CC3C4DC34EF296033F009468EA16A721AD659F56C18516025050749ABF05E6D3EBD9778142A530979291F46DAA399A86B7BCDF09CC3E6EEF101419762A306DB45AEFC96C64E83F28338D55905F6A387E0F515E580C3A9B35330E21C32198CDEE3AFB355967A098F635FCA7C49CB4E1E82464B2B390EF1F259E40B9A06235C0273F76284FE6BD534EF3AF7CB01A4A5252B8B94CADC2850B2E56D53F9A31D7C029DF967D0A30C05BC64E119BED6076818FABC8CDD93F3255693E14EFC1A740A5D63A5E847FFE87BAB1DDE0506E1762EA61EFA9F9756151ECCCADD91B98A961A901A2D8B01ABDDD29EC804E8C8D28214BBA26048F924CA66316696E51A49D02FF034D20E44914B1115339CAD3819E0CB1640F0084886FEDDE5E28C29DC48ED30A8C3D789734338F5A9DF42584326E536FD1CF30BC85B8DCBD6120D127C98FE4B3614074F13C2CA4854E6D794156C185C40EB3DA7619CE96ADAF0941BD5499848B034C2B11DFECC0BDFA81C594241F759EF53FC7CDE7F2DE4F23CF81A5A0B7D62E31DABB9198D40307F7824DD130B7D1B80E9B6D322FEEDB5ACE34944F0BFB7D016762A9B2E173BFDD69303766AFBAB45FAB75D05430B4A3515858C4B7F04E23414E4AD03842CB0A20D8FF4B59B7C852BA9A5BE982A8ADA5CB70C36CE2A4D2C31A7015C9F3275E43D192C1B2924424088907A057DA7F2D32A2149922AB2E33F2147D637A3508911CB3FEA5E1AAB4525BACF27B6DD7A3E0AFA978FC3A39DE8882FB22688C3CCC92B6E69ACB0BBF575AB3368E51A2F6A20C414C6F146727CC0045F29061E695D29F7C030CE6929EB3AD11A5CBD0CDEE37347869A3}]. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index ed76f4f795..2db55b97b4 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -541,7 +541,6 @@ default_algorithms(sshc, DaemonOptions) -> ct:fail("No server respons 2") end. - run_fake_ssh({ok,InitialState}) -> KexInitPattern = #ssh_msg_kexinit{ @@ -583,6 +582,40 @@ run_fake_ssh({ok,InitialState}) -> {server2client, to_atoms(CompS2C)}]}]. +%%%---------------------------------------------------------------- +extract_algos(Spec) -> + [{Tag,get_atoms(List)} || {Tag,List} <- Spec]. + +get_atoms(L) -> + lists:usort( + [ A || X <- L, + A <- case X of + {_,L1} when is_list(L1) -> L1; + Y when is_atom(Y) -> [Y] + end]). + + +intersection(AlgoSpec1, AlgoSpec2) -> intersect(sort_spec(AlgoSpec1), sort_spec(AlgoSpec2)). + +intersect([{Tag,S1}|Ss1], [{Tag,S2}|Ss2]) -> + [{Tag,intersect(S1,S2)} | intersect(Ss1,Ss2)]; +intersect(L1=[A1|_], L2=[A2|_]) when is_atom(A1),is_atom(A2) -> + Diff = L1 -- L2, + L1 -- Diff; +intersect(_, _) -> + []. + +intersect_bi_dir([{Tag,[{client2server,L1},{server2client,L2}]}|T]) -> + [{Tag,intersect(L1,L2)} | intersect_bi_dir(T)]; +intersect_bi_dir([H={_,[A|_]}|T]) when is_atom(A) -> + [H | intersect_bi_dir(T)]; +intersect_bi_dir([]) -> + []. + + +sort_spec(L = [{_,_}|_] ) -> [{Tag,sort_spec(Es)} || {Tag,Es} <- L]; +sort_spec(L) -> lists:usort(L). + %%-------------------------------------------------------------------- sshc(Tag) -> to_atoms( -- cgit v1.2.3 From 88b055b4de08e7358f4b49076fc842a124743f52 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 21 Dec 2015 17:12:46 +0100 Subject: Update appup for 17.5.6.8 OTP-13164 more efficient peer lists One module. Downgrade not supported. --- lib/diameter/src/diameter.appup.src | 68 +++++-------------------------------- 1 file changed, 8 insertions(+), 60 deletions(-) diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 7d66557162..e030b3c72b 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -35,41 +35,15 @@ {"1.4.3", [{restart_application, diameter}]}, %% R16B02 {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, %% R16B03 + {"1.5.1", [{restart_application, diameter}]}, {"1.6", [{restart_application, diameter}]}, %% 17.0 {<<"^1\\.(7(\\.1)?|8)$">>, %% 17.[134] [{restart_application, diameter}]}, {<<"^1.9(\\.1)?$">>, %% 17.5(.3)? [{restart_application, diameter}]}, - {"1.9.2", [{load_module, diameter_peer_fsm}, %% 17.5.5 - {load_module, diameter_watchdog}, - {load_module, diameter_stats}, - {load_module, diameter_codec}, - {load_module, diameter_lib}, - {load_module, diameter_peer}, - {load_module, diameter_reg}, - {load_module, diameter_service}, - {load_module, diameter_session}, - {load_module, diameter_sync}, - {load_module, diameter_traffic}, - {load_module, diameter_sctp}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}, - {load_module, diameter}, - {load_module, diameter_config}]}, - {"1.9.2.1", [{load_module, diameter_watchdog}, %% 17.5.6.3 - {load_module, diameter_codec}, - {load_module, diameter_traffic}, - {load_module, diameter_service}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}, - {load_module, diameter, - {load_module, diameter_config}}]} + {"1.9.2", [{restart_application, diameter}]}, %% 17.5.5 + {"1.9.2.1", [{restart_application, diameter}]}, %% 17.5.6.3 + {"1.9.2.2", [{update, diameter_service, {advanced, []}}]} %% 17.5.6.7 ], [ {"0.9", [{restart_application, diameter}]}, @@ -87,40 +61,14 @@ {"1.4.3", [{restart_application, diameter}]}, {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, + {"1.5.1", [{restart_application, diameter}]}, {"1.6", [{restart_application, diameter}]}, {<<"^1\\.(7(\\.1)?|8)$">>, [{restart_application, diameter}]}, {<<"^1.9(\\.1)?$">>, [{restart_application, diameter}]}, - {"1.9.2", [{load_module, diameter_config}, - {load_module, diameter}, - {load_module, diameter_gen_relay}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_sctp}, - {load_module, diameter_traffic}, - {load_module, diameter_sync}, - {load_module, diameter_session}, - {load_module, diameter_service}, - {load_module, diameter_reg}, - {load_module, diameter_peer}, - {load_module, diameter_lib}, - {load_module, diameter_codec}, - {load_module, diameter_stats}, - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}]}, - {"1.9.2.1", [{load_module, diameter_config}, - {load_module, diameter}, - {load_module, diameter_gen_relay}, - {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_base_rfc3588}, - {load_module, diameter_gen_acct_rfc6733}, - {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_service}, - {load_module, diameter_traffic}, - {load_module, diameter_codec}, - {load_module, diameter_watchdog}]} + {"1.9.2", [{restart_application, diameter}]}, + {"1.9.2.1", [{restart_application, diameter}]}, + {"1.9.2.2", [{restart_application, diameter}]} ] }. -- cgit v1.2.3 From 0967c22be52ee5c7dace7adb102b9b8635b2913b Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 21 Dec 2015 17:13:08 +0100 Subject: vsn -> 1.9.2.3 --- lib/diameter/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 18b77e243f..851ae5c3cf 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -16,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.9.2.2 +DIAMETER_VSN = 1.9.2.3 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) -- cgit v1.2.3 From 09a4ef659657525b7530416697f92db8a360a28f Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 7 Dec 2015 13:11:07 +0100 Subject: Remove unnecessary erlang:monitor/2 qualification See commit 862af31d. --- lib/diameter/src/base/diameter_service.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 87bc9516e0..c5eed539ab 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -180,7 +180,7 @@ stop(SvcName) -> end. stop(ok, Pid) -> - MRef = erlang:monitor(process, Pid), + MRef = monitor(process, Pid), receive {'DOWN', MRef, process, _, _} -> ok end; stop(No, _) -> No. @@ -710,7 +710,7 @@ service_options(Opts) -> mref(false = No) -> No; mref(P) -> - erlang:monitor(process, P). + monitor(process, P). init_shared(#state{options = [_, _, {_,T} | _], service_name = Svc}) -> @@ -1402,7 +1402,7 @@ rpu(Pid, Aliases, Caps, #state{service = Svc, shared_peers = PDict}) -> rpu(_, [] = No, _, _) -> No; rpu(Pid, Aliases, Caps, PDict) -> - erlang:monitor(process, Pid), + monitor(process, Pid), T = {Pid, Caps}, lists:foreach(fun(A) -> ?Dict:append(A, T, PDict) end, Aliases). -- cgit v1.2.3 From 8fd4e5f47efd13a6bad7811239438539ae383966 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 7 Dec 2015 17:06:38 +0100 Subject: Make peer handling more efficient Each service process maintains a dictionary of peers, mapping an application alias to a {pid(), #diameter_caps{}} list of connected peers. These lists are potentially large, peers were appended to the end of the list for no particular reason, and these long lists were constructed/deconstructed when filtering them for pick_peer callbacks. Many simultaneous outgoing request could then slow the VM to a crawl, with many scheduled processes mired in list manipulation. The pseudo-dicts are now replaced by plain ets tables. The reason for them was (once upon a time) to have an interface interchangeable with a plain dict for debugging purposes, but strict swapablity hasn't been the case for some time now, and in practice a swap has never taken place. Additional tables mapping Origin-Host/Realm have also been introduced, to minimize the size of the peers lists when peers are filtered on host/realm. For example, a filter like {any, [{all, [realm, host]}, realm]} is probably a very common case: preferring a Destination-Realm/Host match before falling back on Destination-Realm alone. This is now more efficiently (but not equivalently) expressed as {first, [{all, [realm, host]}, realm]} to stop the search when the best match is made, and extracts peers from host/realm tables instead of searching through the list of all peers supporting the application in question. The code to try and start with a lookup isn't exhaustive, and the 'any' filter is still as inefficient as previously. --- lib/diameter/doc/src/diameter.xml | 22 +- lib/diameter/src/base/diameter_service.erl | 494 ++++++++++++++++++++------- lib/diameter/test/diameter_traffic_SUITE.erl | 3 +- 3 files changed, 377 insertions(+), 142 deletions(-) diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index b0cff32c9a..dbbbb01138 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -466,7 +466,7 @@ Matches only those peers whose Origin-Host has the specified value, or all peers if the atom any.

-{realm, any|&dict_DiameterIdentity; +{realm, any|&dict_DiameterIdentity;}

Matches only those peers whose Origin-Realm has the @@ -499,18 +499,22 @@ Matches only those peers matched by each filter in the specified list.

Matches only those peers matched by at least one filter in the -specified list.

+specified list. +The resulting list will be in match order, peers matching the +first filter of the list sorting before those matched by the second, +and so on.

+ +{first, [&peer_filter;]} +

-The resulting peer list will be in match order, peers matching the -first filter of the list sorting before those matched by the second, -and so on. -For example, the following filter causes peers matching both the host -and realm filters to be presented before those matching only the realm -filter.

+Like any, but stops at the first filter for which there are +matches, which can be much more efficient when there are many peers. +For example, the following filter causes only peers best matching +both the host and realm filters to be presented.

-{any, [{all, [host, realm]}, realm]}
+{first, [{all, [host, realm]}, realm]}
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index c5eed539ab..d83ed9e56b 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -82,16 +82,8 @@ -define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 -define(RESTART_TC, 1000). %% if restart was this recent -%% Used to be able to swap this with anything else dict-like but now -%% rely on the fact that a service's #state{} record does not change -%% in storing in it ?STATE table and not always going through the -%% service process. In particular, rely on the fact that operations on -%% a ?Dict don't change the handle to it. --define(Dict, diameter_dict). - -%% Maintains state in a table. In contrast to previously, a service's -%% stat is not constant and is accessed outside of the service -%% process. +%% Maintain state in a table since a service's state is accessed +%% outside of the service process. -define(STATE_TABLE, ?MODULE). %% The default sequence mask. @@ -116,12 +108,11 @@ service :: #diameter_service{}, watchdogT = ets_new(watchdogs) %% #watchdog{} at start :: ets:tid(), - peerT = ets_new(peers) %% #peer{pid = TPid} at okay/reopen - :: ets:tid(), - shared_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] - :: ets:tid(), - local_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] - :: ets:tid(), + peerT, %% undefined in new code, but remain for upgrade + shared_peers, %% reasons. Replaced by local/remote. + local_peers, %% + local :: {ets:tid(), ets:tid(), ets:tid()}, + remote :: {ets:tid(), ets:tid(), ets:tid()}, monitor = false :: false | pid(), %% process to die with options :: [{sequence, diameter:sequence()} %% sequence mask @@ -149,10 +140,12 @@ %% diameter_peer_fsm. -record(peer, {pid :: pid(), - apps :: [{0..16#FFFFFFFF, diameter:app_alias()}], %% {Id, Alias} + apps :: [{0..16#FFFFFFFF, diameter:app_alias()}] %% {Id, Alias} + | [diameter:app_alias()], %% remote caps :: #diameter_caps{}, - started = now(), %% at process start - watchdog :: pid()}). %% key into watchdogT + started = now(), %% at process start or sharing + watchdog :: pid() %% key into watchdogT + | undefined}). %% undefined if remote %% --------------------------------------------------------------------------- %% # start/1 @@ -513,7 +506,7 @@ transition(Req, S) -> %% # terminate/2 %% --------------------------------------------------------------------------- -terminate(Reason, #state{service_name = Name, peerT = PeerT} = S) -> +terminate(Reason, #state{service_name = Name, local = {PeerT, _, _}} = S) -> send_event(Name, stop), ets:delete(?STATE_TABLE, Name), @@ -535,23 +528,81 @@ terminate(Reason, #state{service_name = Name, peerT = PeerT} = S) -> %% # code_change/3 %% --------------------------------------------------------------------------- -code_change(FromVsn, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}} - = S, - Extra) -> - lists:foreach(fun(A) -> - code_change(FromVsn, SvcName, Extra, A) - end, - Apps), +code_change(_FromVsn, #state{} = S, _Extra) -> + {ok, S}; + +%% Don't support downgrade since we won't in appup. +code_change({down = T, _}, _, _Extra) -> + {error, T}; + +%% Upgrade local/shared peers dicts populated in old code. Don't +code_change(_FromVsn, S0, _Extra) -> + {state, Id, SvcName, Svc, WT, PeerT, SDict, LDict, Monitor, Opts} + = S0, + + init_peers(LT = setelement(1, {PT, _, _} = init_peers(), PeerT), + fun({_,A}) -> A end), + init_peers(init_peers(RT = init_peers(), SDict), + fun(A) -> A end), + + S = #state{id = Id, + service_name = SvcName, + service = Svc, + watchdogT = WT, + peerT = PT, %% empty + shared_peers = SDict, + local_peers = LDict, + local = LT, + remote = RT, + monitor = Monitor, + options = Opts}, + + %% Replacing the table entry and deleting the old shared tables + %% can make outgoing requests return {error, no_connection} until + %% everyone is running new code. Don't delete the tables to avoid + %% crashing request processes. + ets:delete_all_objects(SDict), + ets:delete_all_objects(LDict), + ets:insert(?STATE_TABLE, S), {ok, S}. -code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> - {ok, S} = cb(A, code_change, [FromVsn, - mod_state(Alias), - Extra, - SvcName]), - mod_state(Alias, S). +%% init_peers/2 + +%% Populate app and identity bags from a new-style #peer{} sets. +init_peers({PeerT, _, _} = T, F) + when is_function(F) -> + ets:foldl(fun(#peer{pid = P, apps = As, caps = C}, N) -> + insert_peer(P, lists:map(F, As), C, T), + N+1 + end, + 0, + PeerT); + +%% Populate #peer{} table given a shared peers dict. +init_peers({PeerT, _, _}, SDict) + when is_integer(SDict) -> + dict:fold(fun(P, As, N) -> + ets:update_element(PeerT, P, {#peer.apps, As}), + N+1 + end, + 0, + diameter_dict:fold(fun(A, Ps, D) -> + init_peers(A, Ps, PeerT, D) + end, + dict:new(), + SDict)). + +%% init_peers/4 + +init_peers(App, TCs, PeerT, Dict) -> + lists:foldl(fun({P,C}, D) -> + ets:insert(PeerT, #peer{pid = P, + apps = [], + caps = C}), + dict:append(P, App, D) + end, + Dict, + TCs). %% =========================================================================== %% =========================================================================== @@ -559,9 +610,6 @@ code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> unexpected(F, A, #state{service_name = Name}) -> ?UNEXPECTED(F, A ++ [Name]). -cb(#diameter_app{module = [_|_] = M}, F, A) -> - eval(M, F, A). - eval([M|X], F, A) -> apply(M, F, A ++ X). @@ -581,10 +629,6 @@ choose(false, _, X) -> X. ets_new(Tbl) -> ets:new(Tbl, [{keypos, 2}]). -insert(Tbl, Rec) -> - ets:insert(Tbl, Rec), - Rec. - %% Using the process dictionary for the callback state was initially %% just a way to make what was horrendous trace (big state record and %% much else everywhere) somewhat more readable. There's not as much @@ -685,6 +729,8 @@ cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, lists:foreach(fun init_mod/1, Apps), S = #state{service_name = SvcName, service = Rec#diameter_service{pid = self()}, + local = init_peers(), + remote = init_peers(), monitor = mref(get_value(monitor, Opts)), options = service_options(Opts)}, {S, Acc}; @@ -694,6 +740,13 @@ cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) Type == listen -> {S, [T | Acc]}. +init_peers() -> + {ets_new(caps), %% #peer{} + ets:new(apps, [bag]), %% {Alias, TPid} + ets:new(idents, [bag])}. %% {{host, OH} | {realm, OR} | {OR, OH}, + %% Alias, + %% TPid} + service_options(Opts) -> [{sequence, proplists:get_value(sequence, Opts, ?NOMASK)}, {share_peers, get_value(share_peers, Opts)}, @@ -809,7 +862,7 @@ start(Ref, Type, Opts, State) -> %% start/5 start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, - peerT = PeerT, + local = {PeerT, _, _}, options = SvcOpts, service_name = SvcName, service = Svc0}) @@ -840,7 +893,7 @@ binary_caps(#diameter_service{capabilities = Caps} = Svc, false) -> wd(Type, Ref, T, WatchdogT, Rec) -> Pid = start_watchdog(Type, Ref, T), - insert(WatchdogT, Rec#watchdog{pid = Pid}), + ets:insert(WatchdogT, Rec#watchdog{pid = Pid}), Pid. %% Note that the service record passed into the watchdog is the merged @@ -897,8 +950,8 @@ accepted(Pid, _TPid, #state{watchdogT = WatchdogT} = S) -> #watchdog{ref = Ref, type = accept = T, peer = false, options = Opts} = Wd = fetch(WatchdogT, Pid), - insert(WatchdogT, Wd#watchdog{peer = true}),%% mark replacement as started - start(Ref, T, Opts, S). %% start new watchdog + ets:insert(WatchdogT, Wd#watchdog{peer = true}),%% mark replacement started + start(Ref, T, Opts, S). %% start new watchdog fetch(Tid, Key) -> [T] = ets:lookup(Tid, Key), @@ -924,13 +977,14 @@ watchdog(TPid, [], ?WD_SUSPECT, ?WD_OKAY, Wd, State) -> #watchdog{peer = TPid} = Wd, %% assert connection_up(Wd, State); -%% Watchdog has an unresponsive connection. +%% Watchdog has an unresponsive connection. Note that the peer table +%% entry isn't removed until DOWN. watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) -> #watchdog{peer = TPid} = Wd, %% assert watchdog_down(Wd, To, State); %% Watchdog has lost its connection. -watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) -> +watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{local = {PeerT, _, _}} = S) -> close(Wd), watchdog_down(Wd, To, S), ets:delete(PeerT, TPid); @@ -939,7 +993,7 @@ watchdog(_, [], _, _, _, _) -> ok. watchdog_down(Wd, To, #state{watchdogT = WatchdogT} = S) -> - insert(WatchdogT, Wd#watchdog{state = To}), + ets:insert(WatchdogT, Wd#watchdog{state = To}), connection_down(Wd, To, S). %% --------------------------------------------------------------------------- @@ -951,14 +1005,14 @@ watchdog_down(Wd, To, #state{watchdogT = WatchdogT} = S) -> connection_up({TPid, {Caps, SupportedApps, Pkt}}, #watchdog{pid = Pid} = Wd, - #state{peerT = PeerT} + #state{local = {PeerT, _, _}} = S) -> - Pr = #peer{pid = TPid, - apps = SupportedApps, - caps = Caps, - watchdog = Pid}, - insert(PeerT, Pr), - connection_up([Pkt], Wd#watchdog{peer = TPid}, Pr, S). + Rec = #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}, + ets:insert(PeerT, Rec), + connection_up([Pkt], Wd#watchdog{peer = TPid}, Rec, S). %% --------------------------------------------------------------------------- %% # reopen/3 @@ -968,22 +1022,23 @@ reopen({TPid, {Caps, SupportedApps, _Pkt}}, #watchdog{pid = Pid} = Wd, #state{watchdogT = WatchdogT, - peerT = PeerT}) -> - insert(PeerT, #peer{pid = TPid, - apps = SupportedApps, - caps = Caps, - watchdog = Pid}), - insert(WatchdogT, Wd#watchdog{state = ?WD_REOPEN, - peer = TPid}). + local = {PeerT, _, _}}) -> + ets:insert(PeerT, #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}), + ets:insert(WatchdogT, Wd#watchdog{state = ?WD_REOPEN, + peer = TPid}). %% --------------------------------------------------------------------------- %% # connection_up/2 %% --------------------------------------------------------------------------- -%% Watchdog has recovered as suspect connection. Note that there has +%% Watchdog has recovered a suspect connection. Note that there has %% been no new capabilties exchange in this case. -connection_up(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> +connection_up(#watchdog{peer = TPid} = Wd, #state{local = {PeerT, _, _}} + = S) -> connection_up([], Wd, fetch(PeerT, TPid), S). %% connection_up/4 @@ -994,23 +1049,23 @@ connection_up(Extra, #peer{apps = SApps, caps = Caps} = Pr, #state{watchdogT = WatchdogT, - local_peers = LDict, + local = LT, service_name = SvcName, service = #diameter_service{applications = Apps}} = S) -> - insert(WatchdogT, Wd#watchdog{state = ?WD_OKAY}), + ets:insert(WatchdogT, Wd#watchdog{state = ?WD_OKAY}), diameter_traffic:peer_up(TPid), - insert_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), + local_peer_up(SApps, {TPid, Caps}, {SvcName, Apps}, LT), report_status(up, Wd, Pr, S, Extra). -insert_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). +local_peer_up(SApps, {TPid, Caps} = TC, SA, LT) -> + insert_peer(TPid, [A || {_,A} <- SApps], Caps, LT), + lists:foreach(fun(A) -> peer_up(A, TC, SA) end, SApps). -ilp({Id, Alias}, {TC, SA}, LDict) -> - init_conn(Id, Alias, TC, SA), - ?Dict:append(Alias, TC, LDict). +peer_up({Id, Alias}, TC, SA) -> + peer_up(Id, Alias, TC, SA). -init_conn(Id, Alias, {TPid, _} = TC, {SvcName, Apps}) -> +peer_up(Id, Alias, {TPid, _} = TC, {SvcName, Apps}) -> #diameter_app{id = Id} %% assert = App = find_app(Alias, Apps), @@ -1108,17 +1163,17 @@ connection_down(#watchdog{state = ?WD_OKAY, = Pr, #state{service_name = SvcName, service = #diameter_service{applications = Apps}, - local_peers = LDict} + local = LT} = S) -> report_status(down, Wd, Pr, S, []), - remove_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), + local_peer_down(SApps, {TPid, Caps}, {SvcName, Apps}, LT), diameter_traffic:peer_down(TPid); connection_down(#watchdog{state = ?WD_OKAY, peer = TPid} = Wd, To, - #state{peerT = PeerT} + #state{local = {PeerT, _, _}} = S) when is_atom(To) -> connection_down(Wd, #peer{} = fetch(PeerT, TPid), S); @@ -1126,15 +1181,14 @@ connection_down(#watchdog{state = ?WD_OKAY, connection_down(#watchdog{}, _, _) -> ok. -remove_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). +local_peer_down(SApps, {TPid, _Caps} = TC, SA, LT) -> + delete_peer(TPid, LT), + lists:foreach(fun(A) -> peer_down(A, TC, SA) end, SApps). -rlp({Id, Alias}, {TC, SA}, LDict) -> - L = ?Dict:fetch(Alias, LDict), - down_conn(Id, Alias, TC, SA), - ?Dict:store(Alias, lists:delete(TC, L), LDict). +peer_down({Id, Alias}, TC, SA) -> + peer_down(Id, Alias, TC, SA). -down_conn(Id, Alias, TC, {SvcName, Apps}) -> +peer_down(Id, Alias, TC, {SvcName, Apps}) -> #diameter_app{id = Id} %% assert = App = find_app(Alias, Apps), @@ -1159,7 +1213,7 @@ wd_down(#watchdog{peer = B}, _) ok; %% ... or maybe it has. -wd_down(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> +wd_down(#watchdog{peer = TPid} = Wd, #state{local = {PeerT, _, _}} = S) -> connection_down(Wd, ?WD_DOWN, S), ets:delete(PeerT, TPid). @@ -1374,12 +1428,29 @@ share_peer(_, _, _, _, _) -> %% # share_peers/2 %% --------------------------------------------------------------------------- -share_peers(Pid, #state{options = [_, {_,T} | _], local_peers = PDict}) -> - is_remote(Pid, T) - andalso ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict). - -sp(Pid, Alias, Peers) -> - lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). +share_peers(Pid, #state{options = [_, {_,SP} | _], + local = {PeerT, AppT, _}}) -> + is_remote(Pid, SP) + andalso ets:foldl(fun(T, N) -> N + sp(Pid, AppT, T) end, + 0, + PeerT). + +%% An entry in the peer table doesn't mean the watchdog state is OKAY, +%% an entry in the app table does. + +sp(Pid, AppT, #peer{pid = TPid, + apps = [{_, Alias} | _] = Apps, + caps = Caps}) -> + Spec = [{{'$1', TPid}, + [{'==', '$1', {const, Alias}}], + ['$_']}], + case ets:select(AppT, Spec, 1) of + '$end_of_table' -> + 0; + _ -> + Pid ! {peer, TPid, [A || {_,A} <- Apps], Caps}, + 1 + end. is_remote(Pid, T) -> Node = node(Pid), @@ -1389,32 +1460,49 @@ is_remote(Pid, T) -> %% # remote_peer_up/4 %% --------------------------------------------------------------------------- -remote_peer_up(Pid, Aliases, Caps, #state{options = [_, _, {_,T} | _]} = S) -> - is_remote(Pid, T) - andalso rpu(Pid, Aliases, Caps, S). +remote_peer_up(TPid, Aliases, Caps, #state{options = [_, _, {_,T} | _]} = S) -> + is_remote(TPid, T) andalso rpu(TPid, Aliases, Caps, S). -rpu(Pid, Aliases, Caps, #state{service = Svc, shared_peers = PDict}) -> +rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) -> #diameter_service{applications = Apps} = Svc, Key = #diameter_app.alias, F = fun(A) -> lists:keymember(A, Key, Apps) end, - rpu(Pid, lists:filter(F, Aliases), Caps, PDict); + rpu(TPid, lists:filter(F, Aliases), Caps, RT); rpu(_, [] = No, _, _) -> No; -rpu(Pid, Aliases, Caps, PDict) -> - monitor(process, Pid), - T = {Pid, Caps}, - lists:foreach(fun(A) -> ?Dict:append(A, T, PDict) end, Aliases). +rpu(TPid, Aliases, Caps, {PeerT, _, _} = RT) -> + monitor(process, TPid), + ets:insert(PeerT, #peer{pid = TPid, + apps = Aliases, + caps = Caps}), + insert_peer(TPid, Aliases, Caps, RT). + +%% insert_peer/4 + +insert_peer(TPid, Aliases, Caps, {_PeerT, AppT, IdentT}) -> + #diameter_caps{origin_host = {_, OH}, + origin_realm = {_, OR}} + = Caps, + ets:insert(AppT, [{A, TPid} || A <- Aliases]), + H = iolist_to_binary(OH), + R = iolist_to_binary(OR), + ets:insert(IdentT, [{T, A, TPid} || T <- [{host, H}, {realm, R}, {R, H}], + A <- Aliases]). %% --------------------------------------------------------------------------- %% # remote_peer_down/2 %% --------------------------------------------------------------------------- -remote_peer_down(Pid, #state{shared_peers = PDict}) -> - lists:foreach(fun(A) -> rpd(Pid, A, PDict) end, ?Dict:fetch_keys(PDict)). +remote_peer_down(TPid, #state{remote = {PeerT, _, _} = RT}) -> + ets:delete(PeerT, TPid), + delete_peer(TPid, RT). + +%% delete_peer/2 -rpd(Pid, Alias, PDict) -> - ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). +delete_peer(TPid, {_PeerT, AppT, IdentT}) -> + ets:select_delete(AppT, [{{'_', TPid}, [], [true]}]), + ets:select_delete(IdentT, [{{'_', '_', TPid}, [], [true]}]). %% --------------------------------------------------------------------------- %% pick_peer/4 @@ -1424,12 +1512,12 @@ pick_peer(#diameter_app{alias = Alias} = App, RealmAndHost, Filter, - #state{local_peers = L, - shared_peers = S, + #state{local = LT, + remote = RT, service_name = SvcName, service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RealmAndHost, Filter, L), - peers(Alias, RealmAndHost, Filter, S), + pick_peer(peers(Alias, RealmAndHost, Filter, LT), + peers(Alias, RealmAndHost, Filter, RT), Pid, SvcName, App). @@ -1494,54 +1582,196 @@ pick_peer(Local, %% peers/4 -peers(Alias, RH, Filter, Peers) -> - case ?Dict:find(Alias, Peers) of - {ok, L} -> - filter(L, RH, Filter); - error -> +peers(Alias, RH, Filter, T) -> + filter(Alias, RH, Filter, T, true). + +%% filter/5 +%% +%% Try to limit the peers list by starting with a host/realm lookup. + +filter(Alias, RH, {neg, F}, T, B) -> + filter(Alias, RH, F, T, not B); + +filter(_, _, none, _, false) -> + []; + +filter(Alias, _, none, T, true) -> + all_peers(Alias, T); + +filter(Alias, [DR,DH] = RH, K, T, B) + when K == realm, DR == undefined; + K == host, DH == undefined -> + filter(Alias, RH, none, T, B); + +filter(Alias, [DR,_] = RH, realm = K, T, B) -> + filter(Alias, RH, {K, DR}, T, B); + +filter(Alias, [_,DH] = RH, host = K, T, B) -> + filter(Alias, RH, {K, DH}, T, B); + +filter(Alias, _, {K, D}, {PeerT, _AppT, IdentT}, true) + when K == host; + K == realm -> + try iolist_to_binary(D) of + B -> + caps(PeerT, ets:select(IdentT, [{{{K, B}, '$1', '$2'}, + [{'==', '$1', {const, Alias}}], + ['$2']}])) + catch + error:_ -> [] - end. + end; -%% filter/3 +filter(Alias, RH, {all, Filters}, T, B) + when is_list(Filters) -> + fltr_all(Alias, RH, Filters, T, B); + +filter(Alias, RH, {first, Filters}, T, B) + when is_list(Filters) -> + fltr_first(Alias, RH, Filters, T, B); + +filter(Alias, RH, Filter, T, B) -> + {Ts, Fs} = filter(all_peers(Alias, T), RH, Filter), + choose(B, Ts, Fs). + +%% fltr_all/5 + +fltr_all(Alias, RH, [{K, any} | Filters], T, B) + when K == host; + K == realm -> + fltr_all(Alias, RH, Filters, T, B); + +fltr_all(Alias, RH, [{host, _} = H, {realm, _} = R | Filters], T, B) -> + fltr_all(Alias, RH, [R, H | Filters], T, B); + +fltr_all(Alias, RH, [{realm, _} = R, {host, any} | Filters], T, B) -> + fltr_all(Alias, RH, [R | Filters], T, B); + +fltr_all(Alias, RH, [{realm, OR}, {host, OH} | Filters], T, true) -> + {PeerT, _AppT, IdentT} = T, + try {iolist_to_binary(OR), iolist_to_binary(OH)} of + BT -> + Peers = caps(PeerT, + ets:select(IdentT, [{{BT, '$1', '$2'}, + [{'==', '$1', {const, Alias}}], + ['$2']}])), + {Ts, _} = filter(Peers, RH, {all, Filters}), + Ts + catch + error:_ -> + [] + end; + +fltr_all(Alias, [undefined,_] = RH, [realm | Filters], T, B) -> + fltr_all(Alias, RH, Filters, T, B); + +fltr_all(Alias, [DR,_] = RH, [realm | Filters], T, B) -> + fltr_all(Alias, RH, [{realm, DR} | Filters], T, B); + +fltr_all(Alias, [_,undefined] = RH, [host | Filters], T, B) -> + fltr_all(Alias, RH, Filters, T, B); + +fltr_all(Alias, [_,DH] = RH, [host | Filters], T, B) -> + fltr_all(Alias, RH, [{host, DH} | Filters], T, B); + +fltr_all(Alias, RH, [{K, _} = KT, KA | Filters], T, B) + when K == host, KA == realm; + K == realm, KA == host -> + fltr_all(Alias, RH, [KA, KT | Filters], T, B); + +fltr_all(Alias, RH, [F | Filters], T, B) -> + {Ts, Fs} = filter(filter(Alias, RH, F, T, B), RH, {all, Filters}), + choose(B, Ts, Fs); + +fltr_all(Alias, RH, [], T, B) -> + filter(Alias, RH, none, T, B). + +%% fltr_first/5 %% -%% Return peers in match order. +%% Like any, but stop at the first filter with any matches. + +fltr_first(Alias, RH, [F | Filters], T, B) -> + case filter(Alias, RH, F, T, B) of + [] -> + fltr_first(Alias, RH, Filters, T, B); + [_|_] = Ts -> + Ts + end; + +fltr_first(Alias, RH, [], T, B) -> + filter(Alias, RH, none, T, not B). + +%% all_peers/2 + +all_peers(Alias, {PeerT, AppT, _}) -> + ets:select(PeerT, [{#peer{pid = P, caps = '$1', _ = '_'}, + [], + [{{P, '$1'}}]} + || {_,P} <- ets:lookup(AppT, Alias)]). + +%% caps/2 -filter(Peers, RH, Filter) -> - {Ts, _} = fltr(Peers, RH, Filter), - Ts. +caps(PeerT, Pids) -> + ets:select(PeerT, [{#peer{pid = P, caps = '$1', _ = '_'}, + [], + [{{P, '$1'}}]} + || P <- Pids]). -%% fltr/4 +%% filter/3 +%% +%% Return peers in match order. -fltr(Peers, _, none) -> +filter(Peers, _, none) -> {Peers, []}; -fltr(Peers, RH, {neg, F}) -> - {Ts, Fs} = fltr(Peers, RH, F), +filter(Peers, RH, {neg, F}) -> + {Ts, Fs} = filter(Peers, RH, F), {Fs, Ts}; -fltr(Peers, RH, {all, L}) +filter(Peers, RH, {all, L}) when is_list(L) -> lists:foldl(fun(F,A) -> fltr_all(F, A, RH) end, {Peers, []}, L); -fltr(Peers, RH, {any, L}) +filter(Peers, RH, {any, L}) when is_list(L) -> lists:foldl(fun(F,A) -> fltr_any(F, A, RH) end, {[], Peers}, L); -fltr(Peers, RH, F) -> +filter(Peers, RH, {first, L}) + when is_list(L) -> + fltr_first(Peers, RH, L); + +filter(Peers, RH, F) -> lists:partition(fun({_,C}) -> caps_filter(C, RH, F) end, Peers). +%% fltr_all/3 + fltr_all(F, {Ts0, Fs0}, RH) -> - {Ts1, Fs1} = fltr(Ts0, RH, F), + {Ts1, Fs1} = filter(Ts0, RH, F), {Ts1, Fs0 ++ Fs1}. +%% fltr_any/3 + fltr_any(F, {Ts0, Fs0}, RH) -> - {Ts1, Fs1} = fltr(Fs0, RH, F), + {Ts1, Fs1} = filter(Fs0, RH, F), {Ts0 ++ Ts1, Fs1}. +%% fltr_first/3 + +fltr_first(Peers, _, []) -> + {[], Peers}; + +fltr_first(Peers, RH, [F | Filters]) -> + case filter(Peers, RH, F) of + {[], _} -> + fltr_first(Peers, RH, Filters); + {_, _} = T -> + T + end. + %% caps_filter/3 caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> @@ -1585,8 +1815,8 @@ eq(Any, Id, PeerId) -> transports(#state{watchdogT = WatchdogT}) -> ets:select(WatchdogT, [{#watchdog{peer = '$1', _ = '_'}, - [{'is_pid', '$1'}], - ['$1']}]). + [{'is_pid', '$1'}], + ['$1']}]). %% --------------------------------------------------------------------------- %% # service_info/2 @@ -1639,7 +1869,7 @@ tagged_info(Item, S) undefined end; -tagged_info(TPid, #state{watchdogT = WatchdogT, peerT = PeerT}) +tagged_info(TPid, #state{watchdogT = WatchdogT, local = {PeerT, _, _}}) when is_pid(TPid) -> try [#peer{watchdog = Pid}] = ets:lookup(PeerT, TPid), @@ -1789,7 +2019,7 @@ keys(connect = T, Opts) -> keys(_, _) -> [{listen, accept}]. -peer_dict(#state{watchdogT = WatchdogT, peerT = PeerT}, Dict0) -> +peer_dict(#state{watchdogT = WatchdogT, local = {PeerT, _, _}}, Dict0) -> try ets:tab2list(WatchdogT) of L -> lists:foldl(fun(T,A) -> peer_acc(PeerT, A, T) end, Dict0, L) catch diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index fe6dd7b617..76e939f272 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -724,7 +724,8 @@ send_any_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) - = call(Config, Req, [{filter, {any, [host, realm]}}]). + = call(Config, Req, [{filter, {first, [{all, [host, realm]}, + realm]}}]). %% Send with a conjunctive filter. send_all_1(Config) -> -- cgit v1.2.3 From 47a7d8b9d701b81355a02f4bad8d16a327bc1588 Mon Sep 17 00:00:00 2001 From: Steve Vinoski Date: Mon, 21 Dec 2015 23:07:10 -0500 Subject: Do not allow aux work on dirty schedulers The nature of aux work is such that dirty schedulers should not attempt to perform it. Modify the code to ensure that dirty schedulers avoid aux work. Also fix an incorrect assumption about the size of a Uint in the ErtsDirtySchedId type. --- erts/emulator/beam/erl_process.c | 75 +++++++++++++++++++--------------------- erts/emulator/beam/erl_process.h | 2 +- 2 files changed, 37 insertions(+), 40 deletions(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d583118e7b..eae05f1651 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2239,6 +2239,7 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) erts_aint32_t aux_work = orig_aux_work; erts_aint32_t ignore = 0; + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #ifdef ERTS_SMP haw_thr_prgr_current_reset(awdp); #endif @@ -2972,14 +2973,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ErtsMonotonicTime current_time; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work) { - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) { + if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!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_SCHEDULER_IS_DIRTY(esdp) - && erts_thr_progress_update(esdp)) + if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } @@ -3131,19 +3131,16 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #endif aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work) { - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (!working) - sched_wall_time_change(esdp, working = 1); + if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!working) + sched_wall_time_change(esdp, working = 1); #ifdef ERTS_SMP - if (!thr_prgr_active) - erts_thr_progress_active(esdp, thr_prgr_active = 1); + if (!thr_prgr_active) + erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif - } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); #ifdef ERTS_SMP - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && aux_work && - erts_thr_progress_update(esdp)) + if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); #endif } @@ -6798,18 +6795,19 @@ suspend_scheduler(ErtsSchedulerData *esdp) & 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 (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!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 (aux_work && erts_thr_progress_update(esdp)) + erts_thr_progress_leader_update(esdp); } - 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)) { @@ -7026,17 +7024,18 @@ suspend_scheduler(ErtsSchedulerData *esdp) & 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 (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!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 (aux_work && erts_thr_progress_update(esdp)) + erts_thr_progress_leader_update(esdp); } - 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) { erts_smp_runq_lock(esdp->run_queue); evacuate_run_queue(esdp->run_queue, &sbp); @@ -9407,10 +9406,9 @@ Process *schedule(Process *p, int calls) suspend_scheduler(esdp); #endif - { + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { erts_aint32_t aux_work; - int leader_update = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 - : erts_thr_progress_update(esdp); + int leader_update = erts_thr_progress_update(esdp); aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work); if (aux_work | leader_update | ERTS_SCHED_FAIR) { erts_smp_runq_unlock(rq); @@ -9423,8 +9421,7 @@ Process *schedule(Process *p, int calls) erts_smp_runq_lock(rq); } - ERTS_SMP_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) - || !erts_thr_progress_is_blocking()); + ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); } ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 10c6fa4a67..f5f50b77ba 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -607,7 +607,7 @@ typedef enum { typedef union { struct { ErtsDirtySchedulerType type: 1; - unsigned num: 31; + Uint num: sizeof(Uint)*8 - 1; } s; Uint no; } ErtsDirtySchedId; -- cgit v1.2.3 From 0f41fa2ed0f9ac4fea2756fd29361f5e160bd3dc Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 22 Dec 2015 09:14:21 +0100 Subject: ssh: fix error (wrong suite) in test/ssh.spec --- lib/ssh/test/ssh.spec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index a3296d97a1..271a5ecbaf 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,6 +1,6 @@ {suites,"../ssh_test",all}. {skip_cases, "../ssh_test", - ssl_benchmark_SUITE, [openssh_shell,erl_shell], + ssh_benchmark_SUITE, [openssh_shell,erl_shell], "Benchmarks run separately"}. {skip_cases,"../ssh_test",ssh_ssh_SUITE, [ssh], -- cgit v1.2.3 From 537ba0cfc4cb9640f912d382a4c7730736696376 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 22 Dec 2015 10:00:10 +0100 Subject: ssh: clean test specs --- lib/ssh/test/ssh.spec | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index 271a5ecbaf..0076fc275e 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,10 +1,6 @@ {suites,"../ssh_test",all}. -{skip_cases, "../ssh_test", - ssh_benchmark_SUITE, [openssh_shell,erl_shell], - "Benchmarks run separately"}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh], - "Current implementation is timingdependent and\nhence will succeed/fail on a whim"}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh_compressed], - "Current implementation is timingdependent hence will succeed/fail on a whim"}. + +{skip_suites, "../ssh_test", [ssh_benchmark_SUITE], + "Benchmarks run separately"}. + + -- cgit v1.2.3 From 77f0f265f860130102acc1db31d99f8dd9e690c5 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 22 Dec 2015 18:32:10 +0100 Subject: Use monotonic time for call_time trace --- erts/emulator/beam/beam_bp.c | 99 ++++++++++++++------------------------------ erts/emulator/beam/beam_bp.h | 7 +--- 2 files changed, 32 insertions(+), 74 deletions(-) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 016d0aaa32..9860968687 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -75,6 +75,16 @@ extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ erts_smp_atomic32_t erts_active_bp_index; erts_smp_atomic32_t erts_staging_bp_index; +/* + * Inlined helpers + */ + +static ERTS_INLINE ErtsMonotonicTime +get_mtime(Process *c_p) +{ + return erts_get_monotonic_time(ERTS_PROC_GET_SCHDATA(c_p)); +} + /* ************************************************************************* ** Local prototypes */ @@ -97,9 +107,6 @@ static int clear_function_break(BeamInstr *pc, Uint break_flags); static BpDataTime* get_time_break(BeamInstr *pc); static GenericBpData* check_break(BeamInstr *pc, Uint break_flags); -static void bp_time_diff(bp_data_time_item_t *item, - process_breakpoint_time_t *pbt, - Uint ms, Uint s, Uint us); static void bp_meta_unref(BpMetaPid* bmp); static void bp_count_unref(BpCount* bcp); @@ -110,13 +117,8 @@ static void uninstall_breakpoint(BeamInstr* pc); /* bp_hash */ #define BP_TIME_ADD(pi0, pi1) \ do { \ - Uint r; \ (pi0)->count += (pi1)->count; \ - (pi0)->s_time += (pi1)->s_time; \ - (pi0)->us_time += (pi1)->us_time; \ - r = (pi0)->us_time / 1000000; \ - (pi0)->s_time += r; \ - (pi0)->us_time = (pi0)->us_time % 1000000; \ + (pi0)->time += (pi1)->time; \ } while(0) static void bp_hash_init(bp_time_hash_t *hash, Uint n); @@ -948,7 +950,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, void erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) { - Uint ms,s,us; + ErtsMonotonicTime time; process_breakpoint_time_t *pbt = NULL; bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; @@ -961,7 +963,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) * from the process psd */ pbt = ERTS_PROC_GET_CALL_TIME(c_p); - get_sys_now(&ms, &s, &us); + time = get_mtime(c_p); /* get pbt * timestamp = t0 @@ -976,7 +978,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) } else { ASSERT(pbt->pc); /* add time to previous code */ - bp_time_diff(&sitem, pbt, ms, s, us); + sitem.time = time - pbt->time; sitem.pid = c_p->common.id; sitem.count = 0; @@ -1002,8 +1004,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) /* Add count to this code */ sitem.pid = c_p->common.id; sitem.count = 1; - sitem.s_time = 0; - sitem.us_time = 0; + sitem.time = 0; /* this breakpoint */ ASSERT(bdt); @@ -1020,15 +1021,13 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) } pbt->pc = I; - pbt->ms = ms; - pbt->s = s; - pbt->us = us; + pbt->time = time; } void erts_trace_time_return(Process *p, BeamInstr *pc) { - Uint ms,s,us; + ErtsMonotonicTime time; process_breakpoint_time_t *pbt = NULL; bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; @@ -1041,7 +1040,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc) * from the process psd */ pbt = ERTS_PROC_GET_CALL_TIME(p); - get_sys_now(&ms,&s,&us); + time = get_mtime(p); /* get pbt * lookup bdt from code @@ -1057,7 +1056,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc) */ ASSERT(pbt->pc); - bp_time_diff(&sitem, pbt, ms, s, us); + sitem.time = time - pbt->time; sitem.pid = p->common.id; sitem.count = 0; @@ -1080,9 +1079,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc) } pbt->pc = pc; - pbt->ms = ms; - pbt->s = s; - pbt->us = us; + pbt->time = time; } } @@ -1183,10 +1180,14 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) { for(ix = 0; ix < hash.n; ix++) { item = &(hash.item[ix]); if (item->pid != NIL) { + ErtsMonotonicTime sec, usec; + usec = ERTS_MONOTONIC_TO_USEC(item->time); + sec = usec / 1000000; + usec = usec - sec*1000000; t = TUPLE4(hp, item->pid, make_small(item->count), - make_small(item->s_time), - make_small(item->us_time)); + make_small((Uint) sec), + make_small((Uint) usec)); hp += 5; *retval = CONS(hp, t, *retval); hp += 2; } @@ -1266,8 +1267,7 @@ static void bp_hash_rehash(bp_time_hash_t *hash, Uint n) { } item[hval].pid = hash->item[ix].pid; item[hval].count = hash->item[ix].count; - item[hval].s_time = hash->item[ix].s_time; - item[hval].us_time = hash->item[ix].us_time; + item[hval].time = hash->item[ix].time; } } @@ -1315,8 +1315,7 @@ static ERTS_INLINE bp_data_time_item_t * bp_hash_put(bp_time_hash_t *hash, bp_da item = &(hash->item[hval]); item->pid = sitem->pid; - item->s_time = sitem->s_time; - item->us_time = sitem->us_time; + item->time = sitem->time; item->count = sitem->count; hash->used++; @@ -1330,41 +1329,7 @@ static void bp_hash_delete(bp_time_hash_t *hash) { hash->item = NULL; } -static void bp_time_diff(bp_data_time_item_t *item, /* out */ - process_breakpoint_time_t *pbt, /* in */ - Uint ms, Uint s, Uint us) { - int ds,dus; -#ifdef DEBUG - int dms; - - - dms = ms - pbt->ms; -#endif - ds = s - pbt->s; - dus = us - pbt->us; - - /* get_sys_now may return zero difftime, - * this is ok. - */ - -#ifdef DEBUG - ASSERT(dms >= 0 || ds >= 0 || dus >= 0); -#endif - - if (dus < 0) { - dus += 1000000; - ds -= 1; - } - if (ds < 0) { - ds += 1000000; - } - - item->s_time = ds; - item->us_time = dus; -} - void erts_schedule_time_break(Process *p, Uint schedule) { - Uint ms, s, us; process_breakpoint_time_t *pbt = NULL; bp_data_time_item_t sitem, *item = NULL; bp_time_hash_t *h = NULL; @@ -1387,8 +1352,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { pbdt = get_time_break(pbt->pc); if (pbdt) { - get_sys_now(&ms,&s,&us); - bp_time_diff(&sitem, pbt, ms, s, us); + sitem.time = get_mtime(p) - pbt->time; sitem.pid = p->common.id; sitem.count = 0; @@ -1410,10 +1374,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { * timestamp it and remove the previous * timestamp in the psd. */ - get_sys_now(&ms,&s,&us); - pbt->ms = ms; - pbt->s = s; - pbt->us = us; + pbt->time = get_mtime(p); break; default : ASSERT(0); diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 97d0539ac7..2b89d6fc71 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -29,8 +29,7 @@ typedef struct { Eterm pid; Sint count; - Uint s_time; - Uint us_time; + ErtsMonotonicTime time; } bp_data_time_item_t; typedef struct { @@ -46,9 +45,7 @@ typedef struct bp_data_time { /* Call time */ } BpDataTime; typedef struct { - Uint ms; - Uint s; - Uint us; + ErtsMonotonicTime time; BeamInstr *pc; } process_breakpoint_time_t; /* used within psd */ -- cgit v1.2.3 From 2e825c3d7d7aacce3f5c0d75b8277a8ab8555d02 Mon Sep 17 00:00:00 2001 From: Tuncer Ayaz Date: Sun, 27 Dec 2015 14:35:21 +0100 Subject: Revert "musl: fix gethostbyname_r/gethostbyaddr_ selection" This reverts commit 192c4a80c7d6fe9949aecb864901c4a3d9549f36. This breaks on Debian/Hurd, Debian/kFreeBSD, and possibly other platforms as well. Will be solved differently in a follow-up commit. --- lib/erl_interface/src/connect/ei_resolve.c | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 6381b02393..3f1be2b17d 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -601,16 +601,6 @@ struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) return gethostbyaddr(addr, len, type); } -/* - * Imprecise way to select the actually available gethostbyname_r and - * gethostbyaddr_r. - * - * TODO: check this properly in configure.in - */ -#if (defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) - #define HAVE_GETHOSTBYADDR_R_8 1 -#endif - struct hostent *ei_gethostbyaddr_r(const char *addr, int length, int type, @@ -626,7 +616,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -653,7 +643,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); -- cgit v1.2.3 From b801a5b7239876742eee47f1d39d95350fdd30d8 Mon Sep 17 00:00:00 2001 From: Tuncer Ayaz Date: Sun, 27 Dec 2015 14:36:57 +0100 Subject: ei: fix breakage reported by Sergei Golovan 192c4a80c broke the build on at least Debian/Hurd and Debian/kFreeBSD, because it's not linux but still using glibc. To fix it, test for __GLIBC__ in addition to __linux__. --- lib/erl_interface/src/connect/ei_resolve.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 3f1be2b17d..414cb8be3e 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -616,7 +616,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#if (defined(__GLIBC__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -643,7 +643,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__) || defined(__ANDROID__)) +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); -- cgit v1.2.3 From 172d3bf7b28b28f3ac6ecd2348f1d8cd8db7ff7a Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 29 Dec 2015 15:26:00 +0100 Subject: Fix asynchronous BIF timer cancellation message reply --- erts/emulator/beam/erl_hl_timer.c | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 6853278828..734057a12c 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -2018,7 +2018,7 @@ bif_timer_access_request(void *vreq) static int try_access_sched_remote_btm(ErtsSchedulerData *esdp, Process *c_p, Uint32 sid, - Eterm tref, Uint32 *trefn, + Uint32 *trefn, int async, int cancel, int info, Eterm *resp) { @@ -2078,13 +2078,13 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, } else { ErtsMessage *mp; - Eterm tag, res, msg; + Eterm tag, res, msg, tref; Uint hsz; Eterm *hp; ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; ErlOffHeap *ohp; - hsz = 4; + hsz = 4 + REF_THING_SIZE; if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); @@ -2095,6 +2095,13 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, else tag = am_read_timer; + write_ref_thing(hp, + trefn[0], + trefn[1], + trefn[2]); + tref = make_internal_ref(hp); + hp += REF_THING_SIZE; + if (time_left < 0) res = am_false; else if (time_left <= (Sint64) MAX_SMALL) @@ -2145,8 +2152,8 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) info); ERTS_BIF_PREP_RET(ret, res); } - else if (try_access_sched_remote_btm(esdp, c_p, sid, - tref, trefn, + else if (try_access_sched_remote_btm(esdp, c_p, + sid, trefn, async, cancel, info, &res)) { ERTS_BIF_PREP_RET(ret, res); -- cgit v1.2.3 From a23ef6e1e6e7cbce65912953ca789ac3f758952f Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 28 Dec 2015 11:36:28 +0100 Subject: Skip time_SUITE:timestamp on timewarp test --- erts/emulator/test/time_SUITE.erl | 46 ++++++++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 33076c7461..787870588d 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -320,7 +320,41 @@ timestamp(suite) -> timestamp(doc) -> ["Test that os:timestamp works."]; timestamp(Config) when is_list(Config) -> - repeating_timestamp_check(100000). + try + repeating_timestamp_check(100000) + catch + throw : {fail, Failure} -> + %% + %% Our time warping test machines currently warps + %% time every 6:th second. If we get a warp during + %% 10 seconds, assume this is a time warping test + %% and ignore the failure. + %% + case had_time_warp(10) of + true -> + {skip, "Seems to be time warp test run..."}; + false -> + test_server:fail(Failure) + end + end. + +os_system_time_offset() -> + erlang:convert_time_unit(os:system_time() - erlang:monotonic_time(), + native, micro_seconds). + +had_time_warp(Secs) -> + had_time_warp(os_system_time_offset(), Secs). + +had_time_warp(OrigOffs, 0) -> + false; +had_time_warp(OrigOffs, N) -> + receive after 1000 -> ok end, + case OrigOffs - os_system_time_offset() of + Diff when Diff > 500000; Diff < -500000 -> + true; + _Diff -> + had_time_warp(OrigOffs, N-1) + end. repeating_timestamp_check(0) -> ok; @@ -346,15 +380,15 @@ repeating_timestamp_check(N) -> NSecs = NA*1000000+NB+round(NC/1000000), case Secs - NSecs of TooLarge when TooLarge > 3600 -> - test_server:fail( - lists:flatten( + throw({fail, + lists:flatten( io_lib:format("os:timestamp/0 is ~w s more than erlang:now/0", - [TooLarge]))); + [TooLarge]))}); TooSmall when TooSmall < -3600 -> - test_server:fail( + throw({fail, lists:flatten( io_lib:format("os:timestamp/0 is ~w s less than erlang:now/0", - [-TooSmall]))); + [-TooSmall]))}); _ -> ok end, -- cgit v1.2.3 From 1a5aaef553493a873f2bf839119670febd4570e7 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 28 Dec 2015 15:24:56 +0100 Subject: Fix stack alignment problem in ethread test on arm --- erts/test/ethread_SUITE_data/ethread_tests.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/erts/test/ethread_SUITE_data/ethread_tests.c b/erts/test/ethread_SUITE_data/ethread_tests.c index 12f7f3db7a..b51771c736 100644 --- a/erts/test/ethread_SUITE_data/ethread_tests.c +++ b/erts/test/ethread_SUITE_data/ethread_tests.c @@ -1457,6 +1457,9 @@ do { \ ASSERT(ethr_ ## A ## _read ## B(&A) == 0x33333333); \ } while (0) +ethr_atomic32_t atomic32; +ethr_atomic_t atomic; +ethr_dw_atomic_t dw_atomic; static void atomic_basic_test(void) @@ -1465,8 +1468,6 @@ atomic_basic_test(void) * Verify that each op does what it is expected * to do for at least one input. */ - ethr_atomic32_t atomic32; - ethr_atomic_t atomic; print_line("AT_AINT32_MAX=%d",AT_AINT32_MAX); print_line("AT_AINT32_MIN=%d",AT_AINT32_MIN); @@ -1629,7 +1630,6 @@ atomic_basic_test(void) /* Double word */ { - ethr_dw_atomic_t dw_atomic; ethr_dw_sint_t dw0, dw1; dw0.sint[0] = 4711; dw0.sint[1] = 4712; -- cgit v1.2.3 From 9293a250e02e63d295a841786f03c3e3a3f30e97 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 29 Dec 2015 15:45:20 +0100 Subject: Fix HL timer hard debug implementation --- erts/emulator/beam/erl_hl_timer.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 51a0d68247..fb6d249145 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1055,6 +1055,8 @@ create_hl_timer(ErtsSchedulerData *esdp, erts_aint32_t refc; Uint32 roflgs; + ERTS_HLT_HDBG_CHK_SRV(srv); + check_canceled_queue(esdp, srv); ERTS_HLT_ASSERT((esdp->no & ~ERTS_TMR_ROFLG_SID_MASK) == 0); @@ -1179,8 +1181,6 @@ create_hl_timer(ErtsSchedulerData *esdp, erts_smp_atomic32_init_nob(&tmr->head.refc, refc); erts_smp_atomic32_init_nob(&tmr->state, ERTS_TMR_STATE_ACTIVE); - ERTS_HLT_HDBG_CHK_SRV(srv); - if (!srv->next_timeout || tmr->timeout < srv->next_timeout->timeout) { if (srv->next_timeout) @@ -3099,7 +3099,8 @@ tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) & ~ERTS_HLT_PFLGS_MASK); ERTS_HLT_ASSERT(tmr == prnt); } - ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); + if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR) + ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr); if (tmr->time.tree.same_time) { ErtsHdbgHLT st_hdbg; st_hdbg.srv = hdbg->srv; -- cgit v1.2.3 From 37f58ad6bff2bf2bac4f3f20c2684e8cee66af03 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 15 Dec 2015 09:40:30 +0100 Subject: Light weight statistics of run queue lengths - statistics(total_run_queue_lengths) - statistics(run_queue_lengths) - statistics(total_active_tasks) - statistics(active_tasks) Conflicts: erts/emulator/beam/erl_process.c --- erts/doc/src/erlang.xml | 111 ++++++++++++++++++++++++++++---- erts/emulator/beam/atom.names | 4 ++ erts/emulator/beam/erl_bif_info.c | 37 ++++++++++- erts/emulator/beam/erl_process.c | 65 +++++++++++++------ erts/emulator/beam/erl_process.h | 48 +++++++++----- erts/emulator/test/statistics_SUITE.erl | 61 +++++++++++++++++- erts/preloaded/ebin/erlang.beam | Bin 101796 -> 102000 bytes erts/preloaded/src/erlang.erl | 10 ++- 8 files changed, 281 insertions(+), 55 deletions(-) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index c37ed3bea5..64eebec936 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -5684,8 +5684,31 @@ true Dest, Msg, []).

+ + Information about active processes and ports. + +

+ Returns a list where each element represents the amount + of active processes and ports on each run queue and its + associated scheduler. That is, the number of processes and + ports that are ready to run, or are currently running. The + element location in the list corresponds to the scheduler + and its run queue. The first element corresponds to scheduler + number 1 and so on. The information is not gathered + atomically. That is, the result is not necessarily a + consistent snapshot of the state, but instead quite + efficiently gathered. See also, + statistics(total_active_tasks), + statistics(run_queue_lengths), and + statistics(total_run_queue_lengths). +

+ + + + + Information about context switches.

Returns the total number of context switches since the @@ -5694,7 +5717,7 @@ true - + Information about exact reductions. @@ -5708,7 +5731,7 @@ true - + Information about garbage collection.

Returns information about garbage collection, for example:

@@ -5720,7 +5743,7 @@ true - + Information about I/O.

Returns Input, @@ -5731,7 +5754,7 @@ true - + Information about reductions. @@ -5749,16 +5772,43 @@ true - - Information about the run-queue. - -

Returns the total length of run-queues, that is, the number - of processes that are ready to run on all available run-queues.

+ + Information about the run-queues. + +

+ Returns the total length of the run-queues. That is, the number + of processes and ports that are ready to run on all available + run-queues. The information is gathered atomically. That + is, the result is a consistent snapshot of the state, but + this operation is much more expensive compared to + statistics(total_run_queue_lengths). + This especially when a large amount of schedulers is used. +

- + + Information about the run-queue lengths. + +

+ Returns a list where each element represents the amount + of processes and ports ready to run for each run queue. The + element location in the list corresponds to the run queue + of a scheduler. The first element corresponds to the run + queue of scheduler number 1 and so on. The information is + not gathered atomically. That is, the result is + not necessarily a consistent snapshot of the state, but + instead quite efficiently gathered. See also, + statistics(total_run_queue_lengths), + statistics(active_tasks), and + statistics(total_active_tasks). +

+ + + + + Information about runtime.

Returns information about runtime, in milliseconds.

@@ -5773,7 +5823,7 @@ true - + Information about each schedulers work time. @@ -5844,7 +5894,44 @@ ok - + + Information about active processes and ports. + +

+ Returns the total amount of active processes and ports in + the system. That is, the number of processes and ports that + are ready to run, or are currently running. The information + is not gathered atomically. That is, the result + is not necessarily a consistent snapshot of the state, but + instead quite efficiently gathered. See also, + statistics(active_tasks), + statistics(run_queue_lengths), and + statistics(total_run_queue_lengths). +

+ + + + + + Information about the run-queue lengths. + +

+ Returns the total length of the run-queues. That is, the number + of processes and ports that are ready to run on all available + run-queues. The information is not gathered atomically. + That is, the result is not necessarily a consistent snapshot of + the state, but much more efficiently gathered compared to + statistics(run_queue). + See also, + statistics(run_queue_lengths), + statistics(total_active_tasks), and + statistics(active_tasks). +

+ + + + + Information about wall clock.

Returns information about wall clock. wall_clock can diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 190e7817dc..fb3368eae2 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -71,6 +71,7 @@ atom absoluteURI atom ac atom accessor atom active +atom active_tasks atom all atom all_but_first atom all_names @@ -512,6 +513,7 @@ atom return_from atom return_to atom return_trace atom run_queue +atom run_queue_lengths atom runnable atom runnable_ports atom runnable_procs @@ -579,7 +581,9 @@ atom timeout_value atom Times='*' atom timestamp atom total +atom total_active_tasks atom total_heap_size +atom total_run_queue_lengths atom tpkt atom trace trace_ts traced atom trace_control_word diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index b44382cde8..414ff6711a 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3234,6 +3234,39 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); + } else if (BIF_ARG_1 == am_total_active_tasks + || BIF_ARG_1 == am_total_run_queue_lengths) { + Uint no = erts_run_queues_len(NULL, 0, BIF_ARG_1 == am_total_active_tasks); + if (IS_USMALL(0, no)) + res = make_small(no); + else { + Eterm *hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + res = uint_to_big(no, hp); + } + BIF_RET(res); + } else if (BIF_ARG_1 == am_active_tasks + || BIF_ARG_1 == am_run_queue_lengths) { + Eterm res, *hp, **hpp; + Uint sz, *szp; + int no_qs = erts_no_run_queues; + Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2); + (void) erts_run_queues_len(qszs, 0, BIF_ARG_1 == am_active_tasks); + sz = 0; + szp = &sz; + hpp = NULL; + while (1) { + int i; + for (i = 0; i < no_qs; i++) + qszs[no_qs+i] = erts_bld_uint(hpp, szp, qszs[i]); + res = erts_bld_list(hpp, szp, no_qs, &qszs[no_qs]); + if (hpp) { + erts_free(ERTS_ALC_T_TMP, qszs); + BIF_RET(res); + } + hp = HAlloc(BIF_P, sz); + szp = NULL; + hpp = &hp; + } } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); @@ -3282,7 +3315,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) res = TUPLE2(hp, b1, b2); BIF_RET(res); } else if (BIF_ARG_1 == am_run_queue) { - res = erts_run_queues_len(NULL); + res = erts_run_queues_len(NULL, 1, 0); BIF_RET(make_small(res)); } else if (BIF_ARG_1 == am_wall_clock) { UWord w1, w2; @@ -3302,7 +3335,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) Uint sz, *szp; int no_qs = erts_no_run_queues; Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2); - (void) erts_run_queues_len(qszs); + (void) erts_run_queues_len(qszs, 0, 0); sz = 0; szp = &sz; hpp = NULL; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d583118e7b..b47aae0f74 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -3149,7 +3149,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) } #ifndef ERTS_SMP - if (rq->len != 0 || rq->misc.start) + if (erts_smp_atomic32_read_dirty(&rq->len) != 0 || rq->misc.start) goto sys_woken; #else flgs = erts_smp_atomic32_read_acqb(&ssi->flags); @@ -3248,7 +3248,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) } #ifndef ERTS_SMP - if (rq->len == 0 && !rq->misc.start) + if (erts_smp_atomic32_read_dirty(&rq->len) == 0 && !rq->misc.start) goto sys_aux_work; sys_woken: #else @@ -4965,7 +4965,7 @@ erts_fprintf(stderr, "--------------------------------\n"); rq->out_of_work_count = 0; (void) ERTS_RUNQ_FLGS_READ_BSET(rq, ERTS_RUNQ_FLGS_MIGRATION_INFO, flags); - rq->max_len = rq->len; + rq->max_len = erts_smp_atomic32_read_dirty(&rq->len); for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { ErtsRunQueueInfo *rqi; rqi = (pix == ERTS_PORT_PRIO_LEVEL @@ -5123,7 +5123,7 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags) { int wo_reds = rq->wakeup_other_reds; if (wo_reds) { - int left_len = rq->len - 1; + int left_len = erts_smp_atomic32_read_dirty(&rq->len) - 1; if (left_len < 1) { int wo_reduce = wo_reds << wakeup_other.dec_shift; wo_reduce &= wakeup_other.dec_mask; @@ -5196,7 +5196,7 @@ wakeup_other_check_legacy(ErtsRunQueue *rq, Uint32 flags) { int wo_reds = rq->wakeup_other_reds; if (wo_reds) { - erts_aint32_t len = rq->len; + erts_aint32_t len = erts_smp_atomic32_read_dirty(&rq->len); if (len < 2) { rq->wakeup_other -= ERTS_WAKEUP_OTHER_DEC_LEGACY*wo_reds; if (rq->wakeup_other < 0) @@ -5292,7 +5292,7 @@ runq_supervisor(void *unused) ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); if (ERTS_RUNQ_FLGS_GET(rq) & ERTS_RUNQ_FLG_NONEMPTY) { erts_smp_runq_lock(rq); - if (rq->len != 0) + if (erts_smp_atomic32_read_dirty(&rq->len) != 0) wake_scheduler_on_empty_runq(rq); /* forced wakeup... */ erts_smp_runq_unlock(rq); } @@ -5642,7 +5642,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online } rq->out_of_work_count = 0; rq->max_len = 0; - rq->len = 0; + erts_smp_atomic32_set_nob(&rq->len, 0); rq->wakeup_other = 0; rq->wakeup_other_reds = 0; rq->halt_in_progress = 0; @@ -7939,6 +7939,9 @@ sched_thread_func(void *vesdp) erts_sched_init_time_sup(esdp); + (void) ERTS_RUNQ_FLGS_SET_NOB(esdp->run_queue, + ERTS_RUNQ_FLG_EXEC); + #ifdef ERTS_SMP tse = erts_tse_fetch(); erts_tse_prepare_timed(tse); @@ -8947,24 +8950,39 @@ resume_process_1(BIF_ALIST_1) } Uint -erts_run_queues_len(Uint *qlen) +erts_run_queues_len(Uint *qlen, int atomic_queues_read, int incl_active_sched) { int i = 0; Uint len = 0; - ERTS_ATOMIC_FOREACH_RUNQ(rq, - { - Sint pqlen = 0; - int pix; - for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) - pqlen += RUNQ_READ_LEN(&rq->procs.prio_info[pix].len); + if (atomic_queues_read) + ERTS_ATOMIC_FOREACH_RUNQ(rq, + { + Sint rq_len = (Sint) erts_smp_atomic32_read_dirty(&rq->len); + ASSERT(rq_len >= 0); + if (incl_active_sched + && (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)) { + rq_len++; + } + if (qlen) + qlen[i++] = rq_len; + len += (Uint) rq_len; + } + ); + else { + for (i = 0; i < erts_no_run_queues; i++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(i); + Sint rq_len = (Sint) erts_smp_atomic32_read_nob(&rq->len); + ASSERT(rq_len >= 0); + if (incl_active_sched + && (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)) { + rq_len++; + } + if (qlen) + qlen[i] = rq_len; + len += (Uint) rq_len; + } - if (pqlen < 0) - pqlen = 0; - if (qlen) - qlen[i++] = pqlen; - len += pqlen; } - ); return len; } @@ -9391,8 +9409,10 @@ Process *schedule(Process *p, int calls) if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) { if (flags & ERTS_RUNQ_FLG_SUSPENDED) { + (void) ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_EXEC); suspend_scheduler(esdp); - flags = ERTS_RUNQ_FLGS_GET_NOB(rq); + flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); + flags |= ERTS_RUNQ_FLG_EXEC; } if (flags & ERTS_RUNQ_FLG_CHK_CPU_BIND) { flags = ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_CHK_CPU_BIND); @@ -9483,7 +9503,10 @@ Process *schedule(Process *p, int calls) } #endif + (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_EXEC); scheduler_wait(&fcalls, esdp, rq); + flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); + flags |= ERTS_RUNQ_FLG_EXEC; #ifdef ERTS_SMP non_empty_runq(rq); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 10c6fa4a67..fd7d4183f4 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -170,8 +170,10 @@ extern int erts_sched_thread_suggested_stack_size; (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 5)) #define ERTS_RUNQ_FLG_PROTECTED \ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 6)) +#define ERTS_RUNQ_FLG_EXEC \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 7)) -#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 7) +#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 8) #define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ (ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ @@ -215,6 +217,9 @@ extern int erts_sched_thread_suggested_stack_size; #define ERTS_RUNQ_FLGS_SET(RQ, FLGS) \ ((Uint32) erts_smp_atomic32_read_bor_relb(&(RQ)->flags, \ (erts_aint32_t) (FLGS))) +#define ERTS_RUNQ_FLGS_SET_NOB(RQ, FLGS) \ + ((Uint32) erts_smp_atomic32_read_bor_nob(&(RQ)->flags, \ + (erts_aint32_t) (FLGS))) #define ERTS_RUNQ_FLGS_BSET(RQ, MSK, FLGS) \ ((Uint32) erts_smp_atomic32_read_bset_relb(&(RQ)->flags, \ (erts_aint32_t) (MSK), \ @@ -222,6 +227,9 @@ extern int erts_sched_thread_suggested_stack_size; #define ERTS_RUNQ_FLGS_UNSET(RQ, FLGS) \ ((Uint32) erts_smp_atomic32_read_band_relb(&(RQ)->flags, \ (erts_aint32_t) ~(FLGS))) +#define ERTS_RUNQ_FLGS_UNSET_NOB(RQ, FLGS) \ + ((Uint32) erts_smp_atomic32_read_band_nob(&(RQ)->flags, \ + (erts_aint32_t) ~(FLGS))) #define ERTS_RUNQ_FLGS_GET(RQ) \ ((Uint32) erts_smp_atomic32_read_acqb(&(RQ)->flags)) #define ERTS_RUNQ_FLGS_GET_NOB(RQ) \ @@ -467,7 +475,7 @@ struct ErtsRunQueue_ { int full_reds_history[ERTS_FULL_REDS_HISTORY_SIZE]; int out_of_work_count; erts_aint32_t max_len; - erts_aint32_t len; + erts_smp_atomic32_t len; int wakeup_other; int wakeup_other_reds; int halt_in_progress; @@ -728,7 +736,19 @@ erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio) ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); - len = erts_smp_atomic32_read_nob(&rqi->len); + len = erts_smp_atomic32_read_dirty(&rq->len); + +#ifdef ERTS_SMP + if (len == 0) + erts_non_empty_runq(rq); +#endif + len++; + if (rq->max_len < len) + rq->max_len = len; + ASSERT(len > 0); + erts_smp_atomic32_set_nob(&rq->len, len); + + len = erts_smp_atomic32_read_dirty(&rqi->len); ASSERT(len >= 0); if (len == 0) { ASSERT((erts_smp_atomic32_read_nob(&rq->flags) @@ -741,15 +761,6 @@ erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio) rqi->max_len = len; erts_smp_atomic32_set_relb(&rqi->len, len); - -#ifdef ERTS_SMP - if (rq->len == 0) - erts_non_empty_runq(rq); -#endif - rq->len++; - if (rq->max_len < rq->len) - rq->max_len = len; - ASSERT(rq->len > 0); } ERTS_GLB_INLINE void @@ -759,7 +770,12 @@ erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio) ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); - len = erts_smp_atomic32_read_nob(&rqi->len); + len = erts_smp_atomic32_read_dirty(&rq->len); + len--; + ASSERT(len >= 0); + erts_smp_atomic32_set_nob(&rq->len, len); + + len = erts_smp_atomic32_read_dirty(&rqi->len); len--; ASSERT(len >= 0); if (len == 0) { @@ -770,8 +786,6 @@ erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio) } erts_smp_atomic32_set_relb(&rqi->len, len); - rq->len--; - ASSERT(rq->len >= 0); } ERTS_GLB_INLINE void @@ -781,7 +795,7 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); - len = erts_smp_atomic32_read_nob(&rqi->len); + len = erts_smp_atomic32_read_dirty(&rqi->len); ASSERT(rqi->max_len >= len); rqi->max_len = len; } @@ -1678,7 +1692,7 @@ void erts_sched_notify_check_cpu_bind(void); Uint erts_active_schedulers(void); void erts_init_process(int, int, int); Eterm erts_process_status(Process *, ErtsProcLocks, Process *, Eterm); -Uint erts_run_queues_len(Uint *); +Uint erts_run_queues_len(Uint *, int, int); void erts_add_to_runq(Process *); Eterm erts_bound_schedulers_term(Process *c_p); Eterm erts_get_cpu_topology_term(Process *c_p, Eterm which); diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 56ecf4195a..53c9ba8715 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -32,7 +32,7 @@ run_queue_one/1, scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1]). + badarg/1, run_queues_lengths_active_tasks/1]). %% Internal exports. @@ -54,7 +54,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, wall_clock}, {group, runtime}, reductions, reductions_big, {group, run_queue}, scheduler_wall_time, - garbage_collection, io, badarg]. + garbage_collection, io, badarg, + run_queues_lengths_active_tasks]. groups() -> [{wall_clock, [], @@ -409,3 +410,59 @@ badarg(Config) when is_list(Config) -> ?line case catch statistics(bad_atom) of {'EXIT', {badarg, _}} -> ok end. + +tok_loop() -> + tok_loop(). + +run_queues_lengths_active_tasks(Config) -> + TokLoops = lists:map(fun (_) -> + spawn_opt(fun () -> + tok_loop() + end, + [link, {priority, low}]) + end, + lists:seq(1,10)), + + TRQLs0 = statistics(total_run_queue_lengths), + TATs0 = statistics(total_active_tasks), + true = is_integer(TRQLs0), + true = is_integer(TATs0), + true = TRQLs0 >= 0, + true = TATs0 >= 11, + + NoScheds = erlang:system_info(schedulers), + RQLs0 = statistics(run_queue_lengths), + ATs0 = statistics(active_tasks), + NoScheds = length(RQLs0), + NoScheds = length(ATs0), + true = lists:sum(RQLs0) >= 0, + true = lists:sum(ATs0) >= 11, + + SO = erlang:system_flag(schedulers_online, 1), + + TRQLs1 = statistics(total_run_queue_lengths), + TATs1 = statistics(total_active_tasks), + true = TRQLs1 >= 10, + true = TATs1 >= 11, + NoScheds = erlang:system_info(schedulers), + + RQLs1 = statistics(run_queue_lengths), + ATs1 = statistics(active_tasks), + NoScheds = length(RQLs1), + NoScheds = length(ATs1), + TRQLs2 = lists:sum(RQLs1), + TATs2 = lists:sum(ATs1), + true = TRQLs2 >= 10, + true = TATs2 >= 11, + [TRQLs2|_] = RQLs1, + [TATs2|_] = ATs1, + + erlang:system_flag(schedulers_online, SO), + + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, + TokLoops), + + ok. diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index cd2e7f18a2..58516c0ff3 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 7280b43502..5fc6d14938 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2205,7 +2205,9 @@ setelement(_Index, _Tuple1, _Value) -> spawn_opt(_Tuple) -> erlang:nif_error(undefined). --spec statistics(context_switches) -> {ContextSwitches,0} when +-spec statistics(active_tasks) -> [ActiveTasks] when + ActiveTasks :: non_neg_integer(); + (context_switches) -> {ContextSwitches,0} when ContextSwitches :: non_neg_integer(); (exact_reductions) -> {Total_Exact_Reductions, Exact_Reductions_Since_Last_Call} when @@ -2222,6 +2224,8 @@ spawn_opt(_Tuple) -> Total_Reductions :: non_neg_integer(), Reductions_Since_Last_Call :: non_neg_integer(); (run_queue) -> non_neg_integer(); + (run_queue_lengths) -> [RunQueueLenght] when + RunQueueLenght :: non_neg_integer(); (runtime) -> {Total_Run_Time, Time_Since_Last_Call} when Total_Run_Time :: non_neg_integer(), Time_Since_Last_Call :: non_neg_integer(); @@ -2229,6 +2233,10 @@ spawn_opt(_Tuple) -> SchedulerId :: pos_integer(), ActiveTime :: non_neg_integer(), TotalTime :: non_neg_integer(); + (total_active_tasks) -> ActiveTasks when + ActiveTasks :: non_neg_integer(); + (total_run_queue_lengths) -> TotalRunQueueLenghts when + TotalRunQueueLenghts :: non_neg_integer(); (wall_clock) -> {Total_Wallclock_Time, Wallclock_Time_Since_Last_Call} when Total_Wallclock_Time :: non_neg_integer(), -- cgit v1.2.3 From a6b630bc64ba2dc3661260b8951cc7bb316910f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Fri, 1 Jan 2016 19:47:05 +0100 Subject: Do not consider "." part of names in edlin Today, if you press Ctrl+W inside erl, it will erase word chars including dots. This may have made sense in the past when Erlang had packages, but today considering the most common case for dots inside erl is to work with records, considering the dot part of the word is rather a mistake. For example, imagine the following code, where [] is the cursor: 1> S#elixir_scope.name[] When I press Ctrl+W it erases all up to #: 1> S#[] This patch changes it to the dot is no longer considered part of the name: 1> S#elixir_scope.[] Which is rather expected behaviour for most use cases of dot in Erlang. --- lib/stdlib/src/edlin.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 19444c0502..0e9c457de2 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -465,7 +465,6 @@ word_char(C) when C >= $a, C =< $z -> true; word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; -word_char(C) when C =:= $. -> true; % accept dot-separated names word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> -- cgit v1.2.3 From 7c72e25926e153811ff099057bea649afa0be376 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 17 Dec 2015 14:50:43 +0100 Subject: beam_bool: Fix unsafe optimization beam_bool would make the following code unsafe (which would be reported by beam_validator): scotland(Echo) -> found(case Echo of Echo when true; Echo, Echo, Echo -> Echo; echo -> [] end, Echo = placed). found(_, _) -> million. Basically, beam_bool would see that the 'case' would always return the value of Echo. Thus: scotland(Echo) -> found(Echo, Echo = placed). The only problem is that beam_bool would also remove a 'move' instruction that would save Echo to the stack. Here is the assembly code for part of the function: {allocate_zero,1,1}. {move,{x,0},{y,0}}. %% Save Echo on stack. {bif,'=:=',{f,7},[{x,0},{atom,true}],{x,1}}. {bif,'=:=',{f,7},[{x,0},{atom,true}],{x,2}}. {bif,'=:=',{f,7},[{x,0},{atom,true}],{x,3}}. {bif,'and',{f,7},[{x,2},{x,3}],{x,2}}. {bif,'and',{f,7},[{x,1},{x,2}],{x,1}}. {jump,{f,8}}. {label,7}. {move,{atom,false},{x,1}}. {label,8}. {bif,'or',{f,6},[{atom,true},{x,1}],{x,1}}. {test,is_eq_exact,{f,6},[{x,1},{atom,true}]}. %% Jump never taken. {jump,{f,5}}. {label,6}. {test,is_eq_exact,{f,9},[{x,0},{atom,echo}]}. {move,nil,{x,0}}. {jump,{f,5}}. {label,9}. {test_heap,3,0}. {put_tuple,2,{x,0}}. {put,{atom,case_clause}}. {put,{y,0}}. {line,[{location,"t.erl",5}]}. {call_ext,1,{extfunc,erlang,error,1}}. {jump,{f,5}}. {label,5}. {test,is_eq_exact,{f,12},[{atom,placed},{y,0}]}. beam_bool would see that the is_eq_exact test at label 8 would always succeed. It could therefore remove most of the code before the jump to label 5. Unfortunately it also removed the essential move of Echo to the stack: {allocate_zero,1,1}. %% Instruction incorrectly removed: {move,{x,0},{y,0}}. {jump,{f,5}}. {label,5}. {test,is_eq_exact,{f,12},[{atom,placed},{y,0}]}. The root cause of the problem is that the 'move' instruction is included in the block of 'bif' instructions before label 8. Normally the 'move' instruction would not have been discarded, but because the left operand to the 'or' BIF is 'true', the entire block with 'bif' instructions are dropped. As far as I can see, there is no gain by including 'move' instructions in the first place. There is no way that better code will be produced. In fact, the entire optimization can be given up if 'move' instructions are found in the block. Thus we can fix this bug by never including any 'move' instructions in the block of 'bif' instructions. We can also remove all the code that deals with 'move' instructions within blocks. Reported-by: Thomas Arts --- lib/compiler/src/beam_bool.erl | 50 ++------------------------------------- lib/compiler/test/guard_SUITE.erl | 27 +++++++++++++++++++-- 2 files changed, 27 insertions(+), 50 deletions(-) diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 14b6381230..d14be83496 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -142,11 +142,6 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> - failed; - %% The optimization is not safe. (A register %% used by the instructions following the %% optimized code is either not assigned a @@ -215,37 +210,14 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> false -> throw(all_registers_not_killed); true -> ok end, - Same = assigned_same_value(Bl, NewCode), MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - ordsets:union(MustBeKilled, Same)), + MustBeKilled), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. -%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] -%% Return an ordset with a list of all y registers that are always -%% assigned the same value in the old and new code. Currently, we -%% are very conservative in that we only consider identical move -%% instructions in the same order. -%% -assigned_same_value(Old, New) -> - case reverse(New) of - [{block,Bl}|_] -> - assigned_same_value(Old, Bl, []); - _ -> - ordsets:new() - end. - -assigned_same_value([{set,[{y,_}=D],[S],move}|T1], - [{set,[{y,_}=D],[S],move}|T2], Acc) -> - assigned_same_value(T1, T2, [D|Acc]); -assigned_same_value(_, _, Acc) -> - ordsets:from_list(Acc). - -update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> @@ -314,8 +286,6 @@ split_block_1(Is, Fail, ProhibitFailLabel) -> end end. -split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> @@ -343,8 +313,6 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,move}|Is], Acc) -> - dst_regs(Is, [D|Acc]); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). @@ -411,13 +379,6 @@ bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> _Res -> throw(not_boolean_expr) end; -bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> - case {Src,Dst} of - {{tmp,_},_} -> throw(move); - {_,{tmp,_}} -> throw(move); - _ -> ok - end, - bopt_tree(Is, Forest, [Move|Pre]); bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> Ar = length(As), case safe_bool_op(N, Ar) of @@ -589,10 +550,6 @@ free_variables(Is) -> E = gb_sets:empty(), free_vars_1(Is, E, E, E). -free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), N = gb_sets:union(N0, var_list(Ds)), @@ -632,8 +589,6 @@ free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. rename_regs(Is, Regs) -> rename_regs(Is, Regs, []). -rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> - rename_regs(Is, Regs, [I|Acc]); rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> Live = live_regs(Regs0), Ss = rename_sources(Ss0, Regs0), @@ -737,8 +692,7 @@ ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> Sub1 = gb_trees:update(R, NewReg, Sub0), Sub = gb_trees:insert(NewReg, NewReg, Sub1), Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. + end. ssa_sub_list(List, Sub) -> [ssa_sub(E, Sub) || E <- List]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index b3b67155b3..3f073d79cb 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -34,7 +34,7 @@ tricky/1,rel_ops/1,rel_op_combinations/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_guards/1]). + bad_constants/1,bad_guards/1,scotland/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -52,7 +52,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards]}]. + bad_constants,bad_guards,scotland]}]. init_per_suite(Config) -> Config. @@ -1831,6 +1831,29 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% beam_bool would remove the initialization of {y,0}. +%% (Thanks to Thomas Arts and QuickCheck.) + +scotland(_Config) -> + million = do_scotland(placed), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), + ok. + +do_scotland(Echo) -> + found(case Echo of + Echo when true; Echo, Echo, Echo -> + Echo; + echo -> + [] + end, + Echo = placed). + +found(_, _) -> million. + + + %% Call this function to turn off constant propagation. id(I) -> I. -- cgit v1.2.3 From 03b00985c181f90a927b9af5316d27a534398c24 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 7 Jan 2016 17:14:04 +0100 Subject: erts: Add config test for MAP_NORESERVE for hipe on 64-bit to get a nicer error on FreeBSD and others that does not support MAP_NORESERVE for mmap. Q: How to support this? A: Implement the "literal tag" in hipe or another way to reserve virtual address space in erl_mmap.c --- erts/configure.in | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/erts/configure.in b/erts/configure.in index 20075b08c9..2f19c0f760 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2765,6 +2765,21 @@ LM_SYS_IPV6 LM_SYS_MULTICAST ERL_TIME_CORRECTION AC_CHECK_PROG(M4, m4, m4) + + +dnl HiPE cannot run on 64-bit without MAP_FIXED and MAP_NORESERVE +if test X${enable_hipe} != Xno && test X$ac_cv_sizeof_void_p != X4; then + AC_CHECK_DECLS([MAP_FIXED, MAP_NORESERVE], [], [], [#include ]) + if test X$ac_cv_have_decl_MAP_FIXED != Xyes || test X$ac_cv_have_decl_MAP_NORESERVE != Xyes; then + if test X${enable_hipe} = Xyes; then + AC_MSG_ERROR([HiPE on 64-bit needs MAP_FIXED and MAP_NORESERVE flags for mmap()]) + else + enable_hipe=no + AC_MSG_WARN([Disable HiPE due to lack of MAP_FIXED and MAP_NORESERVE flags for mmap()]) + fi + fi +fi + dnl check to auto-enable hipe here... if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then if test -z "$M4"; then -- cgit v1.2.3 From 04a9f3d11d15035c583dbf3ff3009f186611faac Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 8 Jan 2016 13:00:26 +0100 Subject: ssh: testcase for abnormal keyboard-interactive authentication --- lib/ssh/test/ssh_protocol_SUITE.erl | 81 ++++++++++++++++++++++++++++++++++++- 1 file changed, 80 insertions(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5af60adfae..98a196d705 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -48,6 +48,7 @@ all() -> [{group,tool_tests}, {group,kex}, {group,service_requests}, + {group,authentication}, {group,packet_size_error}, {group,field_size_error} ]. @@ -78,7 +79,9 @@ groups() -> bad_very_long_service_name, empty_service_name, bad_service_name_then_correct - ]} + ]}, + {authentication, [], [client_handles_keyboard_interactive_0_pwds + ]} ]. @@ -516,6 +519,82 @@ bad_service_name_length(Config, LengthExcess) -> receive_msg} ], InitialState). +%%%-------------------------------------------------------------------- +%%% This is due to a fault report (OTP-13255) with OpenSSH-6.6.1 +client_handles_keyboard_interactive_0_pwds(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + %% Start a process handling one connection on the server side: + spawn_link( + fun() -> + {ok,_} = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_service_request{name="ssh-userauth"}, receive_msg}, + {send, #ssh_msg_service_accept{name="ssh-userauth"}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="none", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_failure{authentications = "keyboard-interactive", + partial_success = false}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="keyboard-interactive", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 1, + data = <<0,0,0,10,80,97,115,115,119,111,114,100,58,32,0>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 1, + _='_'}, receive_msg}, + + %% the next is strange, but openssh 6.6.1 does this and this is what this testcase is about + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 0, + data = <<>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 0, + data = <<>>, + _='_'}, receive_msg}, + %% Here we know that the tested fault is fixed + {send, #ssh_msg_userauth_success{}}, + close_socket, + print_state + ], + InitialState) + end), + + %% and finally connect to it with a regular Erlang SSH client: + {ok,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + ). + + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ -- cgit v1.2.3 From ed7d29ca3b6e8a165bdeb182799cbba5e204326f Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Thu, 7 Jan 2016 15:21:45 +0100 Subject: ssh: handle secondary ssh_msg_userauth_info_request message --- lib/ssh/src/ssh_auth.erl | 2 +- lib/ssh/src/ssh_connection_handler.erl | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index fdbb5c152a..b71bed033a 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -477,7 +477,7 @@ keyboard_interact_get_responses(_, undefined, Password, _, _, _, _, _, 1) when Password =/= undefined -> [Password]; %% Password auth implemented with keyboard-interaction and passwd is known keyboard_interact_get_responses(_, _, _, _, _, _, _, _, 0) -> - [""]; + []; keyboard_interact_get_responses(false, undefined, undefined, _, _, _, [Prompt|_], Opts, _) -> ssh_no_io:read_line(Prompt, Opts); %% Throws error as keyboard interaction is not allowed keyboard_interact_get_responses(true, undefined, _,IoCb, Name, Instr, PromptInfos, Opts, _) -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index f082db136c..ce1931e4f4 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -648,10 +648,12 @@ userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, #state{ssh_params = #ssh{role = client}} = State) -> userauth(Msg, State); - userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State). + userauth(Msg, State); +userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, + #state{ssh_params = #ssh{role = client}} = State) -> + userauth_keyboard_interactive(Msg, State). %%-------------------------------------------------------------------- -spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, -- cgit v1.2.3 From 9394c572a28d08f3c564d6f388152c9c41968565 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 8 Jan 2016 10:42:45 +0100 Subject: ssh: update vsn.mk to 4.2.1 --- lib/ssh/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 25b19133b1..55d12abffe 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2 +SSH_VSN = 4.2.1 APP_VSN = "ssh-$(SSH_VSN)" -- cgit v1.2.3 From 9498322e15bf1cc049996813f3422462fd402502 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 8 Jan 2016 13:09:36 +0100 Subject: Update release notes --- lib/ssh/doc/src/notes.xml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 8fb689fdd5..75e1615c09 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,24 @@ notes.xml +

Ssh 4.2.1 + +
Fixed Bugs and Malfunctions + + +

+ The authentication method 'keyboard-interactive' failed + in the Erlang client when the server after successful + authentication continued by asking for zero more + passwords.

+

+ Own Id: OTP-13225

+ + +
+ +
+
Ssh 4.2
Fixed Bugs and Malfunctions -- cgit v1.2.3 From 7cf9a621c5280a3e97967c4c63ab6ca1adde69c3 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 8 Jan 2016 13:09:37 +0100 Subject: Updated OTP version --- OTP_VERSION | 2 +- otp_versions.table | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index c0aa6d4aec..60ea50e403 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.2.1 +18.2.2 diff --git a/otp_versions.table b/otp_versions.table index 9e1b5de0ad..48108ac93a 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.2.2 : ssh-4.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2.1 : erts-7.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2 : asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 crypto-3.6.2 dialyzer-2.8.2 diameter-1.11.1 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2 eunit-2.2.12 hipe-3.14 inets-6.1 jinterface-1.6.1 kernel-4.1.1 observer-2.1.1 parsetools-2.1.1 public_key-1.1 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 wx-1.6 xmerl-1.3.9 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 debugger-4.1.1 edoc-0.7.17 eldap-1.2 et-1.5.1 gs-1.6 ic-4.4 megaco-3.18 mnesia-4.13.2 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 webtool-0.9 : OTP-18.1.5 : ssh-4.1.3 # asn1-4.0 common_test-1.11 compiler-6.0.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.1 debugger-4.1.1 dialyzer-2.8.1 diameter-1.11 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 erts-7.1 et-1.5.1 eunit-2.2.11 gs-1.6 hipe-3.13 ic-4.4 inets-6.0.3 jinterface-1.6 kernel-4.1 megaco-3.18 mnesia-4.13.2 observer-2.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0.1 reltool-0.7 runtime_tools-1.9.1 sasl-2.6 snmp-5.2 ssl-7.1 stdlib-2.6 syntax_tools-1.7 test_server-3.9 tools-2.8.1 typer-0.9.9 webtool-0.9 wx-1.5 xmerl-1.3.8 : -- cgit v1.2.3 From b18d251931a43099cc18527bcf6898fff1b144f5 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 8 Jan 2016 14:56:28 +0100 Subject: erts: Refactor ERL_NIF_INIT macro --- erts/emulator/beam/erl_nif.h | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 1a21048ec9..6f1b7a7571 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -243,20 +243,20 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) # define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks; -# ifdef STATIC_ERLANG_NIF -# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* MODNAME ## _nif_init(TWinDynNifCallbacks* callbacks) -# else -# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) -# endif +# define ERL_NIF_INIT_ARGS TWinDynNifCallbacks* callbacks # define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +# define ERL_NIF_INIT_EXPORT __declspec(dllexport) #else # define ERL_NIF_INIT_GLOB +# define ERL_NIF_INIT_ARGS void # define ERL_NIF_INIT_BODY -# ifdef STATIC_ERLANG_NIF -# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(void) -# else -# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) -# endif +# define ERL_NIF_INIT_EXPORT +#endif + +#ifdef STATIC_ERLANG_NIF +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(ERL_NIF_INIT_ARGS) +#else +# define ERL_NIF_INIT_DECL(MODNAME) ERL_NIF_INIT_EXPORT ErlNifEntry* nif_init(ERL_NIF_INIT_ARGS) #endif #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -- cgit v1.2.3 From 52fc89120c2f2237ec5191e72d844a6dca150040 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 8 Jan 2016 16:41:21 +0100 Subject: erts: Cleanup erl_driver.h for windows The comment is misleading and no need to "export" static windows drivers. DRIVER_INIT for dynamic windows drivers is defined in erl_win_dyn_driver.h --- erts/emulator/beam/erl_driver.h | 7 ------- 1 file changed, 7 deletions(-) diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index bda4d5d1c6..268bda8b58 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -382,18 +382,11 @@ typedef struct erl_drv_entry { # define ERLANG_DRIVER_NAME(NAME) driver_init #endif -/* For windows dynamic drivers */ #ifndef ERL_DRIVER_TYPES_ONLY -#if defined(__WIN32__) -# define DRIVER_INIT(DRIVER_NAME) \ - __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ - __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) -#else # define DRIVER_INIT(DRIVER_NAME) \ ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) -#endif #define ERL_DRV_BUSY_MSGQ_DISABLED (~((ErlDrvSizeT) 0)) #define ERL_DRV_BUSY_MSGQ_READ_ONLY ((ErlDrvSizeT) 0) -- cgit v1.2.3 From 1117dd3651be3cf763abf6fedcd4e06a6444fa04 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 8 Jan 2016 15:22:52 +0100 Subject: erts: Allow -fvisibility=hidden for NIFs and drivers as is strongly recommended by gcc man page. We use __attribute__ ((visibility("default"))) to make sure the init functions are properly exported. --- erts/emulator/beam/erl_driver.h | 14 +++++++++++--- erts/emulator/beam/erl_nif.h | 8 +++++++- lib/crypto/c_src/crypto_callback.c | 4 ++++ 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 268bda8b58..0636171ad1 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -378,15 +378,23 @@ typedef struct erl_drv_entry { #ifdef STATIC_ERLANG_DRIVER # define ERLANG_DRIVER_NAME(NAME) NAME ## _driver_init +# define ERL_DRIVER_EXPORT #else # define ERLANG_DRIVER_NAME(NAME) driver_init +# if defined(__GNUC__) && __GNUC__ >= 4 +# define ERL_DRIVER_EXPORT __attribute__ ((visibility("default"))) +# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define ERL_DRIVER_EXPORT __global +# else +# define ERL_DRIVER_EXPORT +# endif #endif #ifndef ERL_DRIVER_TYPES_ONLY -# define DRIVER_INIT(DRIVER_NAME) \ - ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ - ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) +#define DRIVER_INIT(DRIVER_NAME) \ + ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ + ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) #define ERL_DRV_BUSY_MSGQ_DISABLED (~((ErlDrvSizeT) 0)) #define ERL_DRV_BUSY_MSGQ_READ_ONLY ((ErlDrvSizeT) 0) diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 6f1b7a7571..40c2ad6f08 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -250,7 +250,13 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; # define ERL_NIF_INIT_GLOB # define ERL_NIF_INIT_ARGS void # define ERL_NIF_INIT_BODY -# define ERL_NIF_INIT_EXPORT +# if defined(__GNUC__) && __GNUC__ >= 4 +# define ERL_NIF_INIT_EXPORT __attribute__ ((visibility("default"))) +# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define ERL_NIF_INIT_EXPORT __global +# else +# define ERL_NIF_INIT_EXPORT +# endif #endif #ifdef STATIC_ERLANG_NIF diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index aab43232c9..af9545bd63 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -43,6 +43,10 @@ #ifdef __WIN32__ # define DLLEXPORT __declspec(dllexport) +#elif defined(__GNUC__) && __GNUC__ >= 4 +# define DLLEXPORT __attribute__ ((visibility("default"))) +#elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define DLLEXPORT __global #else # define DLLEXPORT #endif -- cgit v1.2.3 From f0bc967c38d8859ff794e93082e9d2fb495f34d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 7 Jan 2016 15:25:26 +0100 Subject: Eliminate crash in v3_codegen The following code would crash v3_codegen: order(From) -> catch if From#{[] => sufficient} -> saint end. Before explaining the crash, first some background on the stack frame and the Y registers. Certain instructions, most notably the 'call' instructions, clobber all X registers. Before any such instruction, all X registers that have values that will be used after the call must be saved to Y registers (i.e. to the stack frame). adjust_stack/4 will be called when X registers must be saved. There is also another situation when X registers must be saved, namely within a 'catch' if we are about to execute any instruction that may cause an exception. Examples of such instructions are some guard BIFs (such as length/1) and construction of binaries or maps. Within a 'catch', X registers must be be saved because if an exception is thrown and catched all X registers will be destroyed. The same adjust_stack/4 function will be called for those instructions, but only if they occur within a 'catch'. There is actually one more complication. If there is code in a guard within a catch, the X registers should not be saved, because the code in a guard never clobbers any X registers that were alive before the guard code was entered. v3_codegen is written with the implicit assumption that code in guards never cause anything to be saved to Y registers. The code for building maps and binaries would incorrectly save X registers within a guard inside a 'catch'. For construction of binaries, that would mean that a useless but harmelss 'move' instruction was generated. But for construction of maps, the saving of the Y register would not be harmless. There would be a crash when attempting to merge #sr{} records. #sr{} records keeps track of the contents of X and Y registers. When two separate code paths are joined (e.g. at the end of 'case' statement), the register descriptors must be reconciled. Basically, the register descriptors for both paths must be identical. The #sr{} record for one path must not claim that {y,0} contains a certain value, while another path claims that {y,0} is dead. Thus, the crash occurs in sr_merge/2 when failing to reconcile the Y registers. To fix this bug this bug we will introduce a new function called maybe_adjust_stack/5. It will save X registers on the stack only if the code is inside a catch but not inside a guard. We will change all existing code to use this new function when appropriate. Reported-by: Thomas Arts --- lib/compiler/src/v3_codegen.erl | 58 +++++++++++++++++++-------------------- lib/compiler/test/guard_SUITE.erl | 56 +++++++++++++++++++++++++++++++++++-- 2 files changed, 82 insertions(+), 32 deletions(-) diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 34c67b16ca..2a89305f4d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1327,12 +1327,13 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% that we save any variable that will be live after this BIF call. MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = case St0#cg.in_catch andalso - St0#cg.bfail =:= 0 andalso - MayFail of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = + case MayFail of + true -> + maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); + false -> + {[],Bef} + end, Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), Int = Int1#sr{reg=Reg}, @@ -1363,11 +1364,7 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. - {Sis,Int0} = - case St0#cg.in_catch andalso St0#cg.bfail =:= 0 of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), @@ -1512,8 +1509,7 @@ set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, - #cg{in_catch=InCatch, bfail=Bfail}=St) -> +set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> %% At run-time, binaries are constructed in three stages: %% 1) First the size of the binary is calculated. %% 2) Then the binary is allocated. @@ -1532,11 +1528,7 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% First generate the code that constructs each field. Fail = {f,Bfail}, PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = - case InCatch of - true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Int0} - end, + {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), MaxRegs = max_reg(Bef#sr.reg), Aft = clear_dead(Int1, Le#l.i, Vdb), @@ -1545,14 +1537,11 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, {Sis++Code,Aft,St}; % Map single variable key set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), + SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -1573,17 +1562,13 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, % Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> %% assert key literals [] = [Var||{map_pair,{var,_}=Var,_} <- Es], Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -2038,6 +2023,19 @@ trim_free([R|Rs0]) -> end; trim_free([]) -> []. +%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. +%% Adjust the stack, but only if the code is inside a catch and not +%% inside a guard. Use this funtion before instructions that may +%% cause an exception. + +maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> + case St of + #cg{in_catch=true,bfail=0} -> + adjust_stack(Bef, Fb, Lf, Vdb); + #cg{} -> + {[],Bef} + end. + %% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. %% Do complete stack adjustment by compressing stack and adding %% variables to be saved. Try to optimise ordering on stack by diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 3f073d79cb..47eb1ba78b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -34,7 +34,8 @@ tricky/1,rel_ops/1,rel_op_combinations/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_guards/1,scotland/1]). + bad_constants/1,bad_guards/1,scotland/1, + guard_in_catch/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -52,7 +53,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards,scotland]}]. + bad_constants,bad_guards,scotland,guard_in_catch]}]. init_per_suite(Config) -> Config. @@ -1852,6 +1853,57 @@ do_scotland(Echo) -> found(_, _) -> million. +%% Building maps in a guard in a 'catch' would crash v3_codegen. + +guard_in_catch(_Config) -> + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(atom), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(atom), + + {'EXIT',{if_clause,_}} = (catch do_guard_in_catch_map_3()), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(42), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(<<1,2,3>>), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(atom), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(#{}), + + ok. + +do_guard_in_catch_map_1(From) -> + catch + if + From#{[] => sufficient} -> + saint + end. + +do_guard_in_catch_map_2(From) -> + catch + if + From#{From => sufficient} -> + saint + end. + +do_guard_in_catch_map_3() -> + try + if [] -> solo end + catch + Friendly when Friendly#{0 => []} -> minutes + after + membership + end. + +do_guard_in_catch_bin(From) -> + %% Would not crash v3_codegen, but there would be an unnecessary + %% 'move' to a Y register. + catch + if + <> -> + saint + end. %% Call this function to turn off constant propagation. -- cgit v1.2.3 From 9273afa1458017ab976a525d6f17c7d5757426bc Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Thu, 7 Jan 2016 15:00:03 +0100 Subject: Remove dead code related to missing behaviour info Dialyzer used to report unknown behaviours in the same way as unknown functions and types. This functionality has been removed in d101155, but some code remained. --- lib/dialyzer/src/dialyzer_analysis_callgraph.erl | 7 --- lib/dialyzer/src/dialyzer_cl.erl | 57 +----------------------- 2 files changed, 2 insertions(+), 62 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 826ac51775..bf6c732618 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -115,9 +115,6 @@ loop(#server_state{parent = Parent} = State, {AnalPid, ext_types, ExtTypes} -> send_ext_types(Parent, ExtTypes), loop(State, Analysis, ExtCalls); - {AnalPid, unknown_behaviours, UnknownBehaviour} -> - send_unknown_behaviours(Parent, UnknownBehaviour), - loop(State, Analysis, ExtCalls); {AnalPid, mod_deps, ModDeps} -> send_mod_deps(Parent, ModDeps), loop(State, Analysis, ExtCalls); @@ -580,10 +577,6 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_unknown_behaviours(Parent, UnknownBehaviours) -> - Parent ! {self(), unknown_behaviours, UnknownBehaviours}, - ok. - send_codeserver_plt(Parent, CServer, Plt ) -> Parent ! {self(), cserver, CServer, Plt}, ok. diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 4116866916..9354b8007e 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -49,8 +49,7 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [raw_warning()], - unknown_behaviours = [] :: [dialyzer_behaviours:behaviour()] + stored_warnings = [] :: [raw_warning()] }). %%-------------------------------------------------------------------- @@ -638,9 +637,6 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, unknown_behaviours, Behaviours} -> - NewState = store_unknown_behaviours(State, Behaviours), - cl_loop(NewState, LogCache); {BackendPid, done, NewPlt, _NewDocPlt} -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -683,11 +679,6 @@ format_log_cache(LogCache) -> store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. --spec store_unknown_behaviours(#cl_state{}, [dialyzer_behaviours:behaviour()]) -> #cl_state{}. - -store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> - St#cl_state{unknown_behaviours = Beh ++ Behs}. - -spec cl_error(string()) -> no_return(). cl_error(Msg) -> @@ -724,7 +715,6 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, print_warnings(State), print_ext_calls(State), print_ext_types(State), - print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; true -> @@ -737,8 +727,7 @@ unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of true -> unknown_functions(State) ++ - unknown_types(State) ++ - unknown_behaviours(State); + unknown_types(State); false -> [] end, WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, @@ -814,48 +803,6 @@ 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, - external_calls = Calls, - external_types = Types, - stored_warnings = Warnings, - unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings, - output_format = Format}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) - andalso DupBehaviours =/= [] of - false -> ok; - true -> - Behaviours = lists:usort(DupBehaviours), - case Warnings =:= [] andalso Calls =:= [] andalso Types =:= [] of - true -> io:nl(Output); %% Need to do a newline first - false -> ok - end, - {Prompt, Prefix} = - case Format of - formatted -> {"Unknown behaviours:\n"," "}; - raw -> {"%% Unknown behaviours:\n","%% "} - end, - io:put_chars(Output, Prompt), - do_print_unknown_behaviours(Output, Behaviours, Prefix) - end. - -do_print_unknown_behaviours(Output, [B|T], Before) -> - io:format(Output, "~s~p\n", [Before,B]), - do_print_unknown_behaviours(Output, T, Before); -do_print_unknown_behaviours(_, [], _) -> - ok. - print_warnings(#cl_state{stored_warnings = []}) -> ok; print_warnings(#cl_state{output = Output, -- cgit v1.2.3 From 7e1ff61bac96c16a1453acb5be65ba90f48aa820 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Thu, 7 Jan 2016 15:27:33 +0100 Subject: Eliminate ugly case statements --- lib/dialyzer/src/dialyzer_analysis_callgraph.erl | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index bf6c732618..8537878dfc 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -93,23 +93,14 @@ loop(#server_state{parent = Parent} = State, send_log(Parent, LogMsg), loop(State, Analysis, ExtCalls); {AnalPid, warnings, Warnings} -> - case Warnings of - [] -> ok; - SendWarnings -> - send_warnings(Parent, SendWarnings) - end, + send_warnings(Parent, Warnings), loop(State, Analysis, ExtCalls); {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); {AnalPid, done, Plt, DocPlt} -> - case ExtCalls =:= none of - true -> - send_analysis_done(Parent, Plt, DocPlt); - false -> - send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt) - end; + send_ext_calls(Parent, ExtCalls), + send_analysis_done(Parent, Plt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> @@ -569,6 +560,8 @@ send_analysis_done(Parent, Plt, DocPlt) -> Parent ! {self(), done, Plt, DocPlt}, ok. +send_ext_calls(_Parent, none) -> + ok; send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. -- cgit v1.2.3 From 56ab0f42911cc55c6a1640fa4949a267c1394c23 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Thu, 7 Jan 2016 15:57:45 +0100 Subject: Fix inadvertent deletion of callback info If a behaviour module contains an non-exported function with the same name as one of the behaviour's callbacks, the callback info was inadvertently deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning up the callback table. This bug was reported by Brujo Benavides. Fixes ERL-72 bug report. --- lib/dialyzer/src/dialyzer_plt.erl | 2 +- lib/dialyzer/test/plt_SUITE.erl | 58 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 58 insertions(+), 2 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 634871b2eb..769f26a3df 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -137,7 +137,7 @@ delete_list(#plt{info = Info, types = Types, #plt{info = table_delete_list(Info, List), types = Types, contracts = table_delete_list(Contracts, List), - callbacks = table_delete_list(Callbacks, List), + callbacks = Callbacks, exported_types = ExpTypes}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ecbac14e5d..16180a7435 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -7,12 +7,15 @@ -include("dialyzer_test_constants.hrl"). -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, + local_fun_same_as_callback/1, run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings]. +all() -> + [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings, + local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -158,6 +161,59 @@ update_plt(Config) -> {init_plt, Plt}] ++ Opts), ok. +%%% If a behaviour module contains an non-exported function with the same name +%%% as one of the behaviour's callbacks, the callback info was inadvertently +%%% deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning +%%% up the callback table. This bug was reported by Brujo Benavides. + +local_fun_same_as_callback(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = + <<"-module(bad_behaviour). + -callback bad() -> bad. + -export([publicly_bad/0]). + + %% @doc This function is here just to avoid the 'unused' warning for bad/0 + publicly_bad() -> bad(). + + %% @doc This function overlaps with the callback with the same name, and + %% that was an issue for dialyzer since it's a private function. + bad() -> bad.">>, + {ok, Beam} = compile(Config, Prog1, bad_behaviour, []), + + ErlangBeam = case code:where_is_file("erlang.beam") of + non_existing -> + filename:join([code:root_dir(), + "erts", "preloaded", "ebin", + "erlang.beam"]); + EBeam -> + EBeam + end, + Plt = filename:join(PrivDir, "plt_bad_behaviour.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + [] = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam, ErlangBeam]}, + {output_plt, Plt}] ++ Opts), + + Prog2 = + <<"-module(bad_child). + -behaviour(bad_behaviour). + + -export([bad/0]). + + %% @doc This function incorreclty implements bad_behaviour. + bad() -> not_bad.">>, + {ok, TestBeam} = compile(Config, Prog2, bad_child, []), + + [{warn_behaviour, _, + {callback_type_mismatch, + [bad_behaviour,bad,0,"'not_bad'","'bad'"]}}] = + dialyzer:run([{analysis_type, succ_typings}, + {files, [TestBeam]}, + {init_plt, Plt}] ++ Opts), + ok. + + compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), PrivDir = ?config(priv_dir,Config), -- cgit v1.2.3 From ae116fb714d54ca40bcd897195de521b0ca39f8c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 11 Jan 2016 17:20:24 +0100 Subject: erts: Workaround memset bug in test case memset seen to fail with values larger than 255 on (armata) 32-bit ARM Debian with EGLIBC 2.13-38+rpi2+deb7u8 and gcc 4.6.3-14+rpi1. --- erts/emulator/test/alloc_SUITE_data/threads.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index edad24ee6b..f0711ee6e7 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -397,7 +397,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) bp->p = (unsigned char *) ALLOC(a, bp->s); if(!bp->p) fail(t_no, "ALLOC(%lu) failed [id=%d])\n", bp->s, id); - memset((void *) bp->p, id, (size_t) bp->s); + memset((void *) bp->p, (unsigned char)id, (size_t) bp->s); } else { unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]); @@ -407,7 +407,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) if(bp->s < bp->as[bp->i]) { CHECK_BLOCK_DATA(t_no, p, bp->s, id); - memset((void *) p, id, (size_t) bp->as[bp->i]); + memset((void *) p, (unsigned char)id, (size_t) bp->as[bp->i]); } else CHECK_BLOCK_DATA(t_no, p, bp->as[bp->i], id); -- cgit v1.2.3 From ff2ef4278045c985738e3ddb4af6127c7db933e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 11 Jan 2016 15:58:57 +0100 Subject: Fix crash when attempting to update a fun as if it were a map The following example would cause an internal consistency failure in the compiler: f() -> ok. update() -> (fun f/0)#{u => 42}. The reason is that internally, v3_core will (incorrectly) rewrite update/0 to code similar to this: update() -> if is_map(fun f/0) -> maps:update(u, 42, fun f/0) end. Since funs are not allowed to be created in guards, incorrect and unsafe code would be generated. It is easy to fix the bug. There already is a is_valid_map_src/1 function in v3_core that tests whether the argument for the map update operation can possibly be a valid map. A fun is represented as a variable with a special name in Core Erlang, so it would not be recognized as unsafe. All we'll need to do to fix the bug is to look closer at variables to ensure they don't represent funs. That will ensure that the code is rewritten in the correct way: update() -> error({badmap,fun f/0}) end. Reported-by: Thomas Arts --- lib/compiler/src/v3_core.erl | 2 +- lib/compiler/test/map_SUITE.erl | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 0941ad5dd5..7d93e2ae16 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -804,7 +804,7 @@ map_op(map_field_assoc) -> #c_literal{val=assoc}; map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(#c_var{}=Var) -> not cerl:is_c_fname(Var); is_valid_map_src(_) -> false. %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 411b15eebe..cff3b5deb4 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -883,6 +883,9 @@ t_update_map_expressions(Config) when is_list(Config) -> %% Error cases. {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,_},_}} = + (catch (fun t_update_map_expressions/1)#{u => 42}), + ok. -- cgit v1.2.3 From 5ee629684383f3931827effaca70a12bc5d4cb2a Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 8 Dec 2015 12:52:30 +0000 Subject: TLS distribution: support inet_dist_connect_options Allow adding extra options for outgoing TLS distribution connnections, as supported for plain TCP connections. --- lib/ssl/src/ssl_tls_dist_proxy.erl | 10 ++++- lib/ssl/test/ssl_dist_SUITE.erl | 79 ++++++++++++++++++++++++++++++-------- 2 files changed, 71 insertions(+), 18 deletions(-) diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index d384264b53..afe0abb27f 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -89,6 +89,14 @@ listen_options(Opts0) -> Opts1 end. +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -222,7 +230,7 @@ try_connect(Port) -> setup_proxy(Ip, Port, Parent) -> process_flag(trap_exit, true), - Opts = get_ssl_options(client), + Opts = connect_options(get_ssl_options(client)), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()] ++ Opts) of {ok, World} -> {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 092015d3d8..a389442542 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -41,7 +41,7 @@ %%-------------------------------------------------------------------- all() -> [basic, payload, plain_options, plain_verify_options, nodelay_option, - listen_port_options, listen_options, use_interface]. + listen_port_options, listen_options, connect_options, use_interface]. groups() -> []. @@ -312,22 +312,7 @@ listen_port_options(Config) when is_list(Config) -> listen_options() -> [{doc, "Test inet_dist_listen_options"}]. listen_options(Config) when is_list(Config) -> - Prio = 1, - case gen_udp:open(0, [{priority,Prio}]) of - {ok,Socket} -> - case inet:getopts(Socket, [priority]) of - {ok,[{priority,Prio}]} -> - ok = gen_udp:close(Socket), - do_listen_options(Prio, Config); - _ -> - ok = gen_udp:close(Socket), - {skip, - "Can not set priority "++integer_to_list(Prio)++ - " on socket"} - end; - {error,_} -> - {skip, "Can not set priority on socket"} - end. + try_setting_priority(fun do_listen_options/2, Config). do_listen_options(Prio, Config) -> PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", @@ -364,6 +349,48 @@ do_listen_options(Prio, Config) -> stop_ssl_node(NH2), success(Config). %%-------------------------------------------------------------------- +connect_options() -> + [{doc, "Test inet_dist_connect_options"}]. +connect_options(Config) when is_list(Config) -> + try_setting_priority(fun do_connect_options/2, Config). + +do_connect_options(Prio, Config) -> + PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", + PriorityString = + case os:cmd("echo [{a,1}]") of + "[{a,1}]"++_ -> + PriorityString0; + _ -> + %% Some shells need quoting of [{}] + "'"++PriorityString0++"'" + end, + + Options = "-kernel inet_dist_connect_options " ++ PriorityString, + + NH1 = start_ssl_node([{additional_dist_opts, Options} | Config]), + NH2 = start_ssl_node([{additional_dist_opts, Options} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + PrioritiesNode1 = + apply_on_ssl_node(NH1, fun get_socket_priorities/0), + PrioritiesNode2 = + apply_on_ssl_node(NH2, fun get_socket_priorities/0), + + Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio], + ?t:format("Elevated1: ~p~n", [Elevated1]), + Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio], + ?t:format("Elevated2: ~p~n", [Elevated2]), + %% Node 1 will have a socket with elevated priority. + [_|_] = Elevated1, + %% Node 2 will not, since it only applies to outbound connections. + [] = Elevated2, + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- use_interface() -> [{doc, "Test inet_dist_use_interface"}]. use_interface(Config) when is_list(Config) -> @@ -405,6 +432,24 @@ tstsrvr_format(Fmt, ArgList) -> send_to_tstcntrl(Message) -> send_to_tstsrvr({message, Message}). +try_setting_priority(TestFun, Config) -> + Prio = 1, + case gen_udp:open(0, [{priority,Prio}]) of + {ok,Socket} -> + case inet:getopts(Socket, [priority]) of + {ok,[{priority,Prio}]} -> + ok = gen_udp:close(Socket), + TestFun(Prio, Config); + _ -> + ok = gen_udp:close(Socket), + {skip, + "Can not set priority "++integer_to_list(Prio)++ + " on socket"} + end; + {error,_} -> + {skip, "Can not set priority on socket"} + end. + get_socket_priorities() -> [Priority || {ok,[{priority,Priority}]} <- -- cgit v1.2.3 From 81b63f2c3ffc9a1aee9e84de2e9875bf3acb6623 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 8 Dec 2015 14:55:04 +0000 Subject: ssl_dist_SUITE: don't use deprecated functions Use erlang:unique_integer/1 instead of erlang:now/0 to generate a unique node name. Use rand:uniform/1 instead of random:uniform/1, so we don't need to generate a seed ourselves. --- lib/ssl/test/ssl_dist_SUITE.erl | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index a389442542..00f9ee8e3c 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -538,17 +538,13 @@ host_name() -> Host. mk_node_name(Config) -> - {A, B, C} = erlang:now(), + N = erlang:unique_integer([positive]), Case = ?config(testcase, Config), atom_to_list(?MODULE) ++ "_" ++ atom_to_list(Case) ++ "_" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). + ++ integer_to_list(N). mk_node_cmdline(ListenPort, Name, Args) -> Static = "-detached -noinput", @@ -777,12 +773,10 @@ rand_bin(N) -> rand_bin(0, Acc) -> Acc; rand_bin(N, Acc) -> - rand_bin(N-1, [random:uniform(256)-1|Acc]). + rand_bin(N-1, [rand:uniform(256)-1|Acc]). make_randfile(Dir) -> {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), - {A, B, C} = erlang:now(), - random:seed(A, B, C), ok = file:write(IoDev, rand_bin(1024)), file:close(IoDev). -- cgit v1.2.3 From cfb668cc624a1fe9a2411a41a8fe747e327d4d02 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 11 Jan 2016 10:30:27 +0100 Subject: stdlib: fix erl_eval not using non-local function handler See also ERL-32 at bugs.erlang.org. Thanks to Ben Paxton. --- lib/stdlib/src/erl_eval.erl | 31 ++++++++++++++++--------------- lib/stdlib/test/erl_eval_SUITE.erl | 13 +++++++++++-- 2 files changed, 27 insertions(+), 17 deletions(-) diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 568eb1c852..40a34aa30f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -415,7 +415,7 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> {As,Bs} = expr_list(As0, Bs0, Lf, Ef), bif(Func, As, Bs, Ef, RBs); false -> - local_func(Func, As0, Bs0, Lf, RBs) + local_func(Func, As0, Bs0, Lf, Ef, RBs) end; expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), @@ -542,33 +542,34 @@ unhide_calls([E | Es], MaxLine, D) -> unhide_calls(E, _MaxLine, _D) -> E. -%% local_func(Function, Arguments, Bindings, LocalFuncHandler, RBs) -> +%% local_func(Function, Arguments, Bindings, LocalFuncHandler, +%% ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when %% LocalFuncHandler = {value,F} | {value,F,Eas} | %% {eval,F} | {eval,F,Eas} | none. -local_func(Func, As0, Bs0, {value,F}, value) -> - {As1,_Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, value) -> + {As1,_Bs1} = expr_list(As0, Bs0, {value,F}, Ef), %% Make tail recursive calls when possible. F(Func, As1); -local_func(Func, As0, Bs0, {value,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {value,F}, Ef), ret_expr(F(Func, As1), Bs1, RBs); -local_func(Func, As0, Bs0, {value,F,Eas}, RBs) -> +local_func(Func, As0, Bs0, {value,F,Eas}, Ef, RBs) -> Fun = fun(Name, Args) -> apply(F, [Name,Args|Eas]) end, - local_func(Func, As0, Bs0, {value, Fun}, RBs); -local_func(Func, As, Bs, {eval,F}, RBs) -> + local_func(Func, As0, Bs0, {value, Fun}, Ef, RBs); +local_func(Func, As, Bs, {eval,F}, _Ef, RBs) -> local_func2(F(Func, As, Bs), RBs); -local_func(Func, As, Bs, {eval,F,Eas}, RBs) -> +local_func(Func, As, Bs, {eval,F,Eas}, _Ef, RBs) -> local_func2(apply(F, [Func,As,Bs|Eas]), RBs); %% These two clauses are for backwards compatibility. -local_func(Func, As0, Bs0, {M,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {M,F}), +local_func(Func, As0, Bs0, {M,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {M,F}, Ef), ret_expr(M:F(Func,As1), Bs1, RBs); -local_func(Func, As, _Bs, {M,F,Eas}, RBs) -> +local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. -local_func(Func, As0, _Bs0, none, _RBs) -> +local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). local_func2({value,V,Bs}, RBs) -> diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 50fc62a00e..c21c4e61ee 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,6 +39,7 @@ otp_7550/1, otp_8133/1, otp_10622/1, + otp_13228/1, funs/1, try_catch/1, eval_expr_5/1, @@ -83,7 +84,8 @@ all() -> 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, + otp_8133, otp_10622, otp_13228, + funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. groups() -> @@ -1042,6 +1044,13 @@ otp_10622(Config) when is_list(Config) -> ok. +otp_13228(doc) -> + ["OTP-13228. ERL-32: non-local function handler bug."]; +otp_13228(_Config) -> + LFH = {value, fun(foo, [io_fwrite]) -> worked end}, + EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, + {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). + funs(doc) -> ["Simple cases, just to cover some code."]; funs(suite) -> -- cgit v1.2.3 From 82d5a5cecd0a3a5f4b9446bf0703873a812c6ede Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 11 Jan 2016 13:55:31 +0100 Subject: stdlib: Fix linter crash due to missing -module declaration The Erlang Code Linter no longer crashes if there is a -deprecated() attribute but no -module() declaration. See also ERL-62 at bugs.erlang.org. --- lib/stdlib/src/erl_lint.erl | 6 +++--- lib/stdlib/test/erl_lint_SUITE.erl | 15 ++++++++++++--- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 5678e7eebe..e940ad6956 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -100,7 +100,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. -record(lint, {state=start :: 'start' | 'attribute' | 'function', - module=[], %Module + module='', %Module behaviour=[], %Behaviour exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports imports=[] :: [fa()], %Imports, an orddict() @@ -729,7 +729,7 @@ start_state(Form, St) -> %% attribute_state(Form, State) -> %% State' -attribute_state({attribute,_L,module,_M}, #lint{module=[]}=St) -> +attribute_state({attribute,_L,module,_M}, #lint{module=''}=St) -> St; attribute_state({attribute,L,module,_M}, St) -> add_error(L, redefine_module, St); diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 5347ccaf1f..375fb6bc93 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,7 +65,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_12195/1 + maps/1,maps_type/1,otp_11851/1,otp_12195/1, otp_13230/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +94,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_12195]. + maps, maps_type, otp_11851, otp_12195, otp_13230]. groups() -> [{unused_vars_warn, [], @@ -3877,6 +3877,15 @@ otp_12195(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +otp_13230(doc) -> + "OTP-13230: -deprecated without -module"; +otp_13230(Config) when is_list(Config) -> + Abstr = <<"-deprecated([{frutt,0,next_version}]).">>, + {errors,[{1,erl_lint,undefined_module}, + {1,erl_lint,{bad_deprecated,{frutt,0}}}], + []} = run_test2(Config, Abstr, []), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of -- cgit v1.2.3 From f31ae20fbb2af0eeb9c87cfa1243abafbe7773cd Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 11 Jan 2016 12:59:33 +0100 Subject: stdlib: Let dets:open_file() crash when given raw file name See also ERL-55. --- lib/stdlib/src/dets.erl | 6 ++++-- lib/stdlib/test/dets_SUITE.erl | 19 ++++++++++++++++--- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6d07f4018a..7036316242 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1124,7 +1124,9 @@ repl({delayed_write, {Delay,Size} = C}, Defs) Defs#open_args{delayed_write = C}; repl({estimated_no_objects, I}, Defs) -> repl({min_no_slots, I}, Defs); -repl({file, File}, Defs) -> +repl({file, File}, Defs) when is_list(File) -> + Defs#open_args{file = File}; +repl({file, File}, Defs) when is_atom(File) -> Defs#open_args{file = to_list(File)}; repl({keypos, P}, Defs) when is_integer(P), P > 0 -> Defs#open_args{keypos =P}; diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 7f5e06524a..e061e16e4c 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -53,7 +53,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_11709/1]). + otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1]). -export([dets_dirty_loop/0]). @@ -110,7 +110,8 @@ 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_11709 + otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709, + otp_13229 ]. groups() -> @@ -3988,6 +3989,18 @@ otp_11709(Config) when is_list(Config) -> _ = file:delete(File), ok. +otp_13229(doc) -> + ["OTP-13229. open_file() exits with badarg when given binary file name."]; +otp_13229(_Config) -> + F = <<"binfile.tab">>, + try dets:open_file(name, [{file, F}]) of + R -> + exit({open_succeeded, R}) + catch + error:badarg -> + ok + end. + %% %% Parts common to several test cases %% -- cgit v1.2.3 From a42724e6740df6290ec7f7dceb09db4f217697d8 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Wed, 13 Jan 2016 15:13:02 +0100 Subject: Deprecate module 'overload' in SASL The module is deprected and will be removed in OTP 19. The reason is that the module is not used, and that we se no obvious use case for it. --- lib/sasl/doc/src/overload.xml | 6 ++++++ lib/sasl/doc/src/sasl_app.xml | 6 +++++- lib/sasl/src/overload.erl | 2 ++ lib/stdlib/src/otp_internal.erl | 3 +++ 4 files changed, 16 insertions(+), 1 deletion(-) diff --git a/lib/sasl/doc/src/overload.xml b/lib/sasl/doc/src/overload.xml index 5c3d00afeb..2f19cd9088 100644 --- a/lib/sasl/doc/src/overload.xml +++ b/lib/sasl/doc/src/overload.xml @@ -35,6 +35,12 @@ overload An Overload Regulation Process + +

+ All functions in this module are deprecated and will be + removed in a future release. +

+

overload is a process that indirectly regulates the CPU usage in the system. The idea is that a main application calls function diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml index 8d79251c7e..bcd446a868 100644 --- a/lib/sasl/doc/src/sasl_app.xml +++ b/lib/sasl/doc/src/sasl_app.xml @@ -34,7 +34,7 @@

The SASL application provides the following services:

alarm_handler - overload + overload (deprecated) rb release_handler systools @@ -145,11 +145,15 @@

Specifies the maximum intensity for overload. Default is 0.8.

+

Note that the overload module is deprected and + will be removed in a future release.

0 ]]>

Specifies the overload weight. Default is 0.1.

+

Note that the overload module is deprected and + will be removed in a future release.

 diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl index 61b925d219..bc8ab7d5e4 100644 --- a/lib/sasl/src/overload.erl +++ b/lib/sasl/src/overload.erl @@ -19,6 +19,8 @@ %% -module(overload). +-deprecated(module). + -export([start_link/0, request/0, set_config_data/2, get_overload_info/0]). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..c254ab1e46 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -648,6 +648,9 @@ obsolete_1(httpd_conf, is_file, 1) -> obsolete_1(httpd_conf, make_integer, 1) -> {deprecated, "deprecated; use erlang:list_to_integer/1 instead"}; +obsolete_1(overload, _, _) -> + {deprecated, "deprecated; will be removed in OTP 19"}; + obsolete_1(_, _, _) -> no. -- cgit v1.2.3 From ebe42ec76748546f464076d8cf5d1238a56baf91 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 15 Dec 2015 16:37:10 +0100 Subject: erts: Introduce erts_code_purger as a system process with preloaded code. --- Makefile.in | 2 +- erts/emulator/Makefile.in | 3 +++ erts/emulator/beam/erl_init.c | 30 ++++++++++++++++++++++++++-- erts/preloaded/ebin/erts_code_purger.beam | Bin 0 -> 1132 bytes erts/preloaded/src/Makefile | 1 + erts/preloaded/src/erts.app.src | 1 + erts/preloaded/src/erts_code_purger.erl | 32 ++++++++++++++++++++++++++++++ lib/kernel/test/init_SUITE.erl | 8 +++++++- lib/sasl/src/systools_make.erl | 4 +++- 9 files changed, 76 insertions(+), 5 deletions(-) create mode 100644 erts/preloaded/ebin/erts_code_purger.beam create mode 100644 erts/preloaded/src/erts_code_purger.erl diff --git a/Makefile.in b/Makefile.in index 7ce420a8d7..0360a61e0a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -966,7 +966,7 @@ primary_bootstrap_copy: # To remove modules left by the bootstrap building, but leave (restore) # the modules in kernel which are needed for an emulator build -KERNEL_PRELOAD = otp_ring0 init erl_prim_loader prim_inet prim_file zlib prim_zip erlang +KERNEL_PRELOAD = otp_ring0 init erl_prim_loader prim_inet prim_file zlib prim_zip erlang erts_code_purger KERNEL_PRELOAD_BEAMS=$(KERNEL_PRELOAD:%=$(BOOTSTRAP_TOP)/lib/kernel/ebin/%.beam) start_scripts: diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 8cf435905b..f4b806fae9 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -591,6 +591,7 @@ ifeq ($(TARGET),win32) PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT) PRELOAD_SRC = $(TARGET)/beams.rc $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ @@ -600,11 +601,13 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam + $(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ else PRELOAD_OBJ = $(OBJDIR)/preload.o PRELOAD_SRC = $(TARGET)/preload.c $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 58ef09662c..42aca726bf 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -439,6 +439,29 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** return res; } +static Eterm +erl_system_process_otp(Eterm parent_pid, char* modname) +{ + Eterm start_mod; + Process* parent; + ErlSpawnOpts so; + Eterm res; + + start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1); + if (erts_find_function(start_mod, am_start, 0, + erts_active_code_ix()) == NULL) { + erl_exit(5, "No function %s:start/0\n", modname); + } + + parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN); + + so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC; + res = erl_create_process(parent, start_mod, am_start, NIL, &so); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN); + return res; +} + + Eterm erts_preloaded(Process* p) { @@ -1234,6 +1257,7 @@ erl_start(int argc, char **argv) ErtsTimeWarpMode time_warp_mode; int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT; ErtsDbSpinCount db_spin_count = ERTS_DB_SPNCNT_NORMAL; + Eterm otp_ring0_pid; set_default_time_adj(&time_correction, &time_warp_mode); @@ -2183,8 +2207,10 @@ erl_start(int argc, char **argv) erts_initialized = 1; - (void) erl_first_process_otp("otp_ring0", NULL, 0, - boot_argc, boot_argv); + otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0, + boot_argc, boot_argv); + + (void) erl_system_process_otp(otp_ring0_pid, "erts_code_purger"); #ifdef ERTS_SMP erts_start_schedulers(); diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam new file mode 100644 index 0000000000..176497b052 Binary files /dev/null and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index 52034a0881..31383dda83 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -41,6 +41,7 @@ PRE_LOADED_ERL_MODULES = \ zlib \ prim_zip \ otp_ring0 \ + erts_code_purger \ erlang \ erts_internal diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index 8442aaf7e8..e53b6e5bab 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -27,6 +27,7 @@ erts_internal, init, otp_ring0, + erts_code_purger, prim_eval, prim_file, prim_inet, diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl new file mode 100644 index 0000000000..1ef4d096b7 --- /dev/null +++ b/erts/preloaded/src/erts_code_purger.erl @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(erts_code_purger). + +%% Purpose : Implement system process erts_code_purger +%% to handle code module purging. + +-export([start/0]). + +-spec start() -> term(). +start() -> + receive M -> + erlang:display({"erts_code_purger got msg", M}) + end, + start(). diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 3fe618ea4c..f90eb69ef1 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -401,6 +401,7 @@ restart(Config) when is_list(Config) -> %% Ok, the node is up, now the real test test begins. ?line erlang:monitor_node(Node, true), ?line InitPid = rpc:call(Node, erlang, whereis, [init]), + ?line PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]), ?line Procs = rpc:call(Node, erlang, processes, []), ?line MaxPid = lists:last(Procs), ?line ok = rpc:call(Node, init, restart, []), @@ -418,8 +419,13 @@ restart(Config) when is_list(Config) -> InitP = pid_to_list(InitPid), ?line InitP = pid_to_list(InitPid1), + %% and same purger process! + ?line PurgerPid1 = rpc:call(Node, erlang, whereis, [erts_code_purger]), + PurgerP = pid_to_list(PurgerPid), + ?line PurgerP = pid_to_list(PurgerPid1), + ?line NewProcs0 = rpc:call(Node, erlang, processes, []), - NewProcs = lists:delete(InitPid1, NewProcs0), + NewProcs = NewProcs0 -- [InitPid1, PurgerPid1], ?line case check_processes(NewProcs, MaxPid) of true -> ok; diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 8132034172..d207dc15bb 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1469,7 +1469,9 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file, + [erl_prim_loader,erlang, + erts_code_purger, + erts_internal,init,otp_ring0,prim_eval,prim_file, prim_inet,prim_zip,zlib]. %%______________________________________________________________________ -- cgit v1.2.3 From c612edf4ada1f00b2bdb8404103e0d8307dc8f4c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 11 Jan 2016 19:17:04 +0100 Subject: erts: Refactor code:purge/1 and code:soft_purge/1 by moving code from code_server to erts_code_purger. This is more or less a copy-paste from code_server.erl to erts_code_purger.erl. All the inner mechanics of code:purge/1 and code:soft_purge/1 are unchanged. --- erts/preloaded/ebin/erts_code_purger.beam | Bin 1132 -> 9020 bytes erts/preloaded/src/erts_code_purger.erl | 283 +++++++++++++++++++++++++++++- lib/kernel/src/code_server.erl | 250 +------------------------- lib/kernel/test/code_SUITE.erl | 1 + 4 files changed, 290 insertions(+), 244 deletions(-) diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 176497b052..adfe298a44 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index 1ef4d096b7..6bb6e4fcdc 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -22,11 +22,288 @@ %% Purpose : Implement system process erts_code_purger %% to handle code module purging. --export([start/0]). +-export([start/0, purge/1, soft_purge/1]). -spec start() -> term(). start() -> - receive M -> + register(erts_code_purger, self()), + process_flag(trap_exit, true), + loop(). + +loop() -> + receive + {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> + Res = do_purge(Mod), + From ! {reply, purge, Res, Ref}; + + {soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> + Res = do_soft_purge(Mod), + From ! {reply, soft_purge, Res, Ref}; + + M -> erlang:display({"erts_code_purger got msg", M}) end, - start(). + loop(). + + +%% purge(Module) +%% Kill all processes running code from *old* Module, and then purge the +%% module. Return {WasOld, DidKill}: +%% {false, false} there was no old module to purge +%% {true, false} module purged, no process killed +%% {true, true} module purged, at least one process killed + +purge(Mod) when is_atom(Mod) -> + Ref = make_ref(), + erts_code_purger ! {purge, Mod, self(), Ref}, + receive + {reply, purge, Result, Ref} -> + Result + end. + + +do_purge(Mod) -> + case erlang:check_old_code(Mod) of + false -> + {false, false}; + true -> + true = erlang:copy_literals(Mod, true), + DidKill = check_proc_code(erlang:processes(), Mod, true), + true = erlang:copy_literals(Mod, false), + try + erlang:purge_module(Mod) + catch + _:_ -> ignore + end, + {true, DidKill} + end. + +%% soft_purge(Module) +%% Purge old code only if no procs remain that run old code. +%% Return true in that case, false if procs remain (in this +%% case old code is not purged) + +soft_purge(Mod) -> + Ref = make_ref(), + erts_code_purger ! {soft_purge, Mod, self(), Ref}, + receive + {reply, soft_purge, Result, Ref} -> + Result + end. + + +do_soft_purge(Mod) -> + case erlang:check_old_code(Mod) of + false -> + true; + true -> + true = erlang:copy_literals(Mod, true), + case check_proc_code(erlang:processes(), Mod, false) of + false -> + true = erlang:copy_literals(Mod, false), + false; + true -> + true = erlang:copy_literals(Mod, false), + try + erlang:purge_module(Mod) + catch + _:_ -> ignore + end, + true + end + end. + +%% +%% check_proc_code(Pids, Mod, Hard) - Send asynchronous +%% requests to all processes to perform a check_process_code +%% operation. Each process will check their own state and +%% reply with the result. If 'Hard' equals +%% - true, processes that refer 'Mod' will be killed. If +%% any processes were killed true is returned; otherwise, +%% false. +%% - false, and any processes refer 'Mod', false will +%% returned; otherwise, true. +%% +%% Requests will be sent to all processes identified by +%% Pids at once, but without allowing GC to be performed. +%% Check process code operations that are aborted due to +%% GC need, will be restarted allowing GC. However, only +%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at +%% a time will be allowed. This in order not to blow up +%% memory wise. +%% +%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS +%% outstanding kills. This both in order to avoid flooding +%% our message queue with 'DOWN' messages and limiting the +%% amount of memory used to keep references to all +%% outstanding kills. +%% + +%% We maybe should allow more than two outstanding +%% GC requests, but for now we play it safe... +-define(MAX_CPC_GC_PROCS, 2). +-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10). + +-record(cpc_static, {hard, module, tag}). + +-record(cpc_kill, {outstanding = [], + no_outstanding = 0, + waiting = [], + killed = false}). + +check_proc_code(Pids, Mod, Hard) -> + Tag = erlang:make_ref(), + CpcS = #cpc_static{hard = Hard, + module = Mod, + tag = Tag}, + check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true). + +check_proc_code(#cpc_static{hard = true}, 0, 0, [], + #cpc_kill{outstanding = [], waiting = [], killed = Killed}, + true) -> + %% No outstanding requests. We did a hard check, so result is whether or + %% not we killed any processes... + Killed; +check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) -> + %% No outstanding requests and we did a soft check... + Success; +check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0, + [], _KillState, false) -> + %% Failed soft check; just cleanup the remaining replies corresponding + %% to the requests we've sent... + {NoReq1, NoGcReq1} = receive + {check_process_code, {Tag, _P, GC}, _Res} -> + case GC of + false -> {NoReq0-1, NoGcReq0}; + true -> {NoReq0, NoGcReq0-1} + end + end, + check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false); +check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0, + KillState0, Success) -> + + %% Check if we should request a GC operation + {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of + GcOpAllowed when GcOpAllowed == false; + NeedGC0 == [] -> + {NoGcReq0, NeedGC0}; + _ -> + {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)} + end, + + %% Wait for a cpc reply or 'DOWN' message + {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag, + NoReq0, + NoGcReq1, + KillState0), + + %% Check the result of the reply + case Result of + aborted -> + %% Operation aborted due to the need to GC in order to + %% determine if the process is referring the module. + %% Schedule the operation for restart allowing GC... + check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1, + Success); + false -> + %% Process not referring the module; done with this process... + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1, + Success); + true -> + %% Process referring the module... + case CpcS#cpc_static.hard of + false -> + %% ... and soft check. The whole operation failed so + %% no point continuing; clean up and fail... + check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1, + false); + true -> + %% ... and hard check; schedule kill of it... + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, + cpc_sched_kill(Pid, KillState1), Success) + end; + 'DOWN' -> + %% Handled 'DOWN' message + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, + KillState1, Success) + end. + +cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) -> + receive + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end; +cpc_recv(Tag, NoReq, NoGcReq, + #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) -> + receive + {'DOWN', R, process, _, _} when R == R0; + R == R1; + R == R2; + R == R3; + R == R4 -> + cpc_handle_down(NoReq, NoGcReq, R, KillState); + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end; +cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) -> + receive + {'DOWN', R, process, _, _} -> + cpc_handle_down(NoReq, NoGcReq, R, KillState); + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end. + +cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs, + no_outstanding = N} = KillState) -> + {NoReq, NoGcReq, undefined, 'DOWN', + cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs), + no_outstanding = N-1})}. + +cpc_list_rm(R, [R|Rs]) -> + Rs; +cpc_list_rm(R0, [R1|Rs]) -> + [R1|cpc_list_rm(R0, Rs)]. + +cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) -> + {NoReq-1, NoGcReq, Pid, Res, KillState}; +cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) -> + {NoReq, NoGcReq-1, Pid, Res, KillState}. + +cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) -> + KillState; +cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs, + no_outstanding = N, + waiting = [P|Ps]} = KillState) -> + R = erlang:monitor(process, P), + exit(P, kill), + KillState#cpc_kill{outstanding = [R|Rs], + no_outstanding = N+1, + waiting = Ps, + killed = true}. + +cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState) + when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS -> + KillState#cpc_kill{waiting = [Pid|Pids]}; +cpc_sched_kill(Pid, + #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) -> + R = erlang:monitor(process, Pid), + exit(Pid, kill), + KillState#cpc_kill{outstanding = [R|Rs], + no_outstanding = N+1, + killed = true}. + +cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> + erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, + {allow_gc, AllowGc}]). + +cpc_request_gc(CpcS, [Pid|Pids]) -> + cpc_request(CpcS, Pid, true), + Pids. + +cpc_init(_CpcS, [], NoReqs) -> + NoReqs; +cpc_init(CpcS, [Pid|Pids], NoReqs) -> + cpc_request(CpcS, Pid, false), + cpc_init(CpcS, Pids, NoReqs+1). + +% end of check_proc_code() implementation. diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 4361bb7b60..1a42cc0e9f 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1281,254 +1281,22 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> absname(filename:join(Name), Dcwd). -%% do_purge(Module) -%% Kill all processes running code from *old* Module, and then purge the -%% module. Return true if any processes killed, else false. -do_purge(Mod0) -> - Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - false; - true -> - true = erlang:copy_literals(Mod, true), - Res = check_proc_code(erlang:processes(), Mod, true), - true = erlang:copy_literals(Mod, false), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - Res +is_loaded(M, Db) -> + case ets:lookup(Db, M) of + [{M,File}] -> {file,File}; + [] -> false end. -%% do_soft_purge(Module) -%% Purge old code only if no procs remain that run old code. -%% Return true in that case, false if procs remain (in this -%% case old code is not purged) +do_purge(Mod0) -> + Mod = to_atom(Mod0), + {_WasOld, DidKill} = erts_code_purger:purge(Mod), + DidKill. do_soft_purge(Mod0) -> Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - true; - true -> - true = erlang:copy_literals(Mod, true), - case check_proc_code(erlang:processes(), Mod, false) of - false -> - true = erlang:copy_literals(Mod, false), - false; - true -> - true = erlang:copy_literals(Mod, false), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - true - end - end. - -%% -%% check_proc_code(Pids, Mod, Hard) - Send asynchronous -%% requests to all processes to perform a check_process_code -%% operation. Each process will check their own state and -%% reply with the result. If 'Hard' equals -%% - true, processes that refer 'Mod' will be killed. If -%% any processes were killed true is returned; otherwise, -%% false. -%% - false, and any processes refer 'Mod', false will -%% returned; otherwise, true. -%% -%% Requests will be sent to all processes identified by -%% Pids at once, but without allowing GC to be performed. -%% Check process code operations that are aborted due to -%% GC need, will be restarted allowing GC. However, only -%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at -%% a time will be allowed. This in order not to blow up -%% memory wise. -%% -%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS -%% outstanding kills. This both in order to avoid flooding -%% our message queue with 'DOWN' messages and limiting the -%% amount of memory used to keep references to all -%% outstanding kills. -%% - -%% We maybe should allow more than two outstanding -%% GC requests, but for now we play it safe... --define(MAX_CPC_GC_PROCS, 2). --define(MAX_CPC_NO_OUTSTANDING_KILLS, 10). - --record(cpc_static, {hard, module, tag}). - --record(cpc_kill, {outstanding = [], - no_outstanding = 0, - waiting = [], - killed = false}). - -check_proc_code(Pids, Mod, Hard) -> - Tag = erlang:make_ref(), - CpcS = #cpc_static{hard = Hard, - module = Mod, - tag = Tag}, - check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true). - -check_proc_code(#cpc_static{hard = true}, 0, 0, [], - #cpc_kill{outstanding = [], waiting = [], killed = Killed}, - true) -> - %% No outstanding requests. We did a hard check, so result is whether or - %% not we killed any processes... - Killed; -check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) -> - %% No outstanding requests and we did a soft check... - Success; -check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0, - [], _KillState, false) -> - %% Failed soft check; just cleanup the remaining replies corresponding - %% to the requests we've sent... - {NoReq1, NoGcReq1} = receive - {check_process_code, {Tag, _P, GC}, _Res} -> - case GC of - false -> {NoReq0-1, NoGcReq0}; - true -> {NoReq0, NoGcReq0-1} - end - end, - check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false); -check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0, - KillState0, Success) -> - - %% Check if we should request a GC operation - {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of - GcOpAllowed when GcOpAllowed == false; - NeedGC0 == [] -> - {NoGcReq0, NeedGC0}; - _ -> - {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)} - end, - - %% Wait for a cpc reply or 'DOWN' message - {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag, - NoReq0, - NoGcReq1, - KillState0), - - %% Check the result of the reply - case Result of - aborted -> - %% Operation aborted due to the need to GC in order to - %% determine if the process is referring the module. - %% Schedule the operation for restart allowing GC... - check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1, - Success); - false -> - %% Process not referring the module; done with this process... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1, - Success); - true -> - %% Process referring the module... - case CpcS#cpc_static.hard of - false -> - %% ... and soft check. The whole operation failed so - %% no point continuing; clean up and fail... - check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1, - false); - true -> - %% ... and hard check; schedule kill of it... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - cpc_sched_kill(Pid, KillState1), Success) - end; - 'DOWN' -> - %% Handled 'DOWN' message - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - KillState1, Success) - end. - -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) -> - receive - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, - #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) -> - receive - {'DOWN', R, process, _, _} when R == R0; - R == R1; - R == R2; - R == R3; - R == R4 -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) -> - receive - {'DOWN', R, process, _, _} -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end. - -cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs, - no_outstanding = N} = KillState) -> - {NoReq, NoGcReq, undefined, 'DOWN', - cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs), - no_outstanding = N-1})}. - -cpc_list_rm(R, [R|Rs]) -> - Rs; -cpc_list_rm(R0, [R1|Rs]) -> - [R1|cpc_list_rm(R0, Rs)]. - -cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) -> - {NoReq-1, NoGcReq, Pid, Res, KillState}; -cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) -> - {NoReq, NoGcReq-1, Pid, Res, KillState}. - -cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) -> - KillState; -cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs, - no_outstanding = N, - waiting = [P|Ps]} = KillState) -> - R = erlang:monitor(process, P), - exit(P, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - waiting = Ps, - killed = true}. - -cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState) - when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS -> - KillState#cpc_kill{waiting = [Pid|Pids]}; -cpc_sched_kill(Pid, - #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) -> - R = erlang:monitor(process, Pid), - exit(Pid, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - killed = true}. - -cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> - erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, - {allow_gc, AllowGc}]). - -cpc_request_gc(CpcS, [Pid|Pids]) -> - cpc_request(CpcS, Pid, true), - Pids. - -cpc_init(_CpcS, [], NoReqs) -> - NoReqs; -cpc_init(CpcS, [Pid|Pids], NoReqs) -> - cpc_request(CpcS, Pid, false), - cpc_init(CpcS, Pids, NoReqs+1). - -% end of check_proc_code() implementation. + erts_code_purger:soft_purge(Mod). -is_loaded(M, Db) -> - case ets:lookup(Db, M) of - [{M,File}] -> {file,File}; - [] -> false - end. %% ------------------------------------------------------- %% The on_load functionality. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index dfcb20d594..071f8d1d3b 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -766,6 +766,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> OK = [erlang, os, prim_file, erl_prim_loader, init, ets, code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, + erts_code_purger, prim_zip, zlib], ErrCnt1 = case lists:member(M, OK) or erlang:is_builtin(M,F,A) of -- cgit v1.2.3 From fa44f865c3fc6253cf4691cf94839c303a3ee40f Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 15 Dec 2015 20:32:39 +0100 Subject: erts: Make erlang:purge_module/1 safe Problem: erlang:purge_module/1 is not safe in the sense that very bad things may happen if the code to be purged is still referred to by live processes. Introduce erts_internal:purge_module which is the same as the old erlang:purge_module BIF (except it returns false if no such old module). Implement erlang:purge_module in Erlang and let it invoke erts_code_purger for safe purging where all clogging processes first are killed. --- erts/emulator/beam/beam_bif_load.c | 14 ++++++++++---- erts/emulator/beam/bif.tab | 2 +- erts/preloaded/ebin/erlang.beam | Bin 102216 -> 102556 bytes erts/preloaded/ebin/erts_code_purger.beam | Bin 9020 -> 8992 bytes erts/preloaded/ebin/erts_internal.beam | Bin 6260 -> 6432 bytes erts/preloaded/ebin/init.beam | Bin 44700 -> 44728 bytes erts/preloaded/src/erlang.erl | 12 ++++++++++-- erts/preloaded/src/erts_code_purger.erl | 14 +++----------- erts/preloaded/src/erts_internal.erl | 6 ++++++ erts/preloaded/src/init.erl | 4 ++-- lib/kernel/test/code_SUITE.erl | 21 +++++++++++++++++---- 11 files changed, 49 insertions(+), 24 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 6bb70cc5a7..014ee35fd0 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1094,7 +1094,12 @@ static void copy_literals_commit(void* null) { #endif /* ERTS_SMP */ -BIF_RETTYPE purge_module_1(BIF_ALIST_1) +/* Do the actualy module purging and return: + * true for success + * false if no such old module + * BADARG if not an atom + */ +BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; BeamInstr* code; @@ -1108,7 +1113,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1); + ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1], + BIF_P, BIF_ARG_1); } code_ix = erts_active_code_ix(); @@ -1118,7 +1124,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) */ if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_RET(ret, am_false); } else { erts_rwlock_old_code(code_ix); @@ -1127,7 +1133,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) * Any code to purge? */ if (!modp->old.code_hdr) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_RET(ret, am_false); } else { /* diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 0aee8681c6..3b95ec508c 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -125,7 +125,6 @@ bif erlang:process_flag/3 bif erlang:process_info/1 bif erlang:process_info/2 bif erlang:processes/0 -bif erlang:purge_module/1 bif erlang:put/2 bif erlang:register/2 bif erlang:registered/0 @@ -643,6 +642,7 @@ bif erts_debug:map_info/1 # bif erlang:copy_literals/2 +bif erts_internal:purge_module/1 bif binary:split/2 bif binary:split/3 bif erts_debug:size_shared/1 diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 68578c3a49..4353e115ca 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index adfe298a44..553b34b105 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 4e1cb7f8a0..150e76505d 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index a44b022931..b6d1df7bbc 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index d9dc9a1976..ab54d716cc 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -1471,8 +1471,16 @@ processes() -> %% purge_module/1 -spec purge_module(Module) -> true when Module :: atom(). -purge_module(_Module) -> - erlang:nif_error(undefined). +purge_module(Module) when erlang:is_atom(Module) -> + case erts_code_purger:purge(Module) of + {false, _} -> + erlang:error(badarg, [Module]); + {true, _} -> + true + end; +purge_module(Arg) -> + erlang:error(badarg, [Arg]). + %% put/2 -spec put(Key, Val) -> term() when diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index 6bb6e4fcdc..880c86aad1 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -70,12 +70,8 @@ do_purge(Mod) -> true = erlang:copy_literals(Mod, true), DidKill = check_proc_code(erlang:processes(), Mod, true), true = erlang:copy_literals(Mod, false), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - {true, DidKill} + WasPurged = erts_internal:purge_module(Mod), + {WasPurged, DidKill} end. %% soft_purge(Module) @@ -104,11 +100,7 @@ do_soft_purge(Mod) -> false; true -> true = erlang:copy_literals(Mod, false), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, + erts_internal:purge_module(Mod), true end end. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 426749264f..6e649e8395 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -38,6 +38,7 @@ -export([request_system_task/3]). -export([check_process_code/2]). +-export([purge_module/1]). -export([flush_monitor_messages/3]). @@ -204,6 +205,11 @@ request_system_task(_Pid, _Prio, _Request) -> check_process_code(_Module, _OptionList) -> erlang:nif_error(undefined). +-spec purge_module(Module) -> boolean() when + Module :: module(). +purge_module(_Module) -> + erlang:nif_error(undefined). + %% term compare where integer() < float() = true -spec cmp_term(A,B) -> Result when diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 383c4a1ec6..ed65c57c0d 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -636,9 +636,9 @@ unload(_) -> do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())). do_unload([M|Mods]) -> - catch erlang:purge_module(M), + catch erts_internal:purge_module(M), catch erlang:delete_module(M), - catch erlang:purge_module(M), + catch erts_internal:purge_module(M), do_unload(Mods); do_unload([]) -> purge_all_hipe_refs(), diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 071f8d1d3b..772a1e6b14 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -380,8 +380,23 @@ purge(Config) when is_list(Config) -> purge_many_exits(Config) when is_list(Config) -> OldFlag = process_flag(trap_exit, true), + code:purge(code_b_test), {'EXIT',_} = (catch code:purge({})), + + CodePurgeF = fun(M, Exp) -> Exp = code:purge(M) end, + purge_many_exits_do(CodePurgeF), + + %% Let's repeat test for erlang:purge_module as it does the same thing + %% now in erts-8.0 (except for return value). + ErlangPurgeF = fun(M, _Exp) -> erlang:purge_module(M) end, + purge_many_exits_do(ErlangPurgeF), + + process_flag(trap_exit, OldFlag), + ok. + + +purge_many_exits_do(PurgeF) -> false = code:purge(code_b_test), TPids = lists:map(fun (_) -> {code_b_test:do_spawn(), @@ -400,7 +415,7 @@ purge_many_exits(Config) when is_list(Config) -> false = code_b_test:check_exit(Pid1), true = erlang:is_process_alive(Pid2) end, TPids), - true = code:purge(code_b_test), + PurgeF(code_b_test, true), lists:foreach(fun ({Pid1, Pid2}) -> false = erlang:is_process_alive(Pid1), true = code_b_test:check_exit(Pid1), @@ -409,9 +424,7 @@ purge_many_exits(Config) when is_list(Config) -> end, TPids), lists:foreach(fun ({_Pid1, Pid2}) -> receive {'EXIT', Pid2, _} -> ok end - end, TPids), - process_flag(trap_exit, OldFlag), - ok. + end, TPids). soft_purge(suite) -> []; -- cgit v1.2.3 From dc54c2a27c41930a18e0c7f2b97eda6cd4a0b1c1 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 16 Dec 2015 19:11:48 +0100 Subject: erts: Move copy_literals/2 from erlang to erts_internal as it's not a public interface. --- erts/emulator/beam/beam_bif_load.c | 5 +++-- erts/emulator/beam/bif.tab | 2 +- erts/preloaded/ebin/erlang.beam | Bin 102556 -> 102332 bytes erts/preloaded/ebin/erts_code_purger.beam | Bin 8992 -> 8996 bytes erts/preloaded/ebin/erts_internal.beam | Bin 6432 -> 6632 bytes erts/preloaded/src/erlang.erl | 9 +-------- erts/preloaded/src/erts_code_purger.erl | 10 +++++----- erts/preloaded/src/erts_internal.erl | 7 +++++++ 8 files changed, 17 insertions(+), 16 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 014ee35fd0..39a5bff04c 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1031,7 +1031,7 @@ copy_literals_t erts_clrange = {NULL, 0}; */ -BIF_RETTYPE copy_literals_2(BIF_ALIST_2) +BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2) { Module* modp; ErtsCodeIndex code_ix; @@ -1042,7 +1042,8 @@ BIF_RETTYPE copy_literals_2(BIF_ALIST_2) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD2(bif_export[BIF_copy_literals_2], BIF_P, BIF_ARG_1, BIF_ARG_2); + ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); } code_ix = erts_active_code_ix(); diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 3b95ec508c..1b8ae8cef5 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -641,7 +641,7 @@ bif erts_debug:map_info/1 # New in 19.0 # -bif erlang:copy_literals/2 +bif erts_internal:copy_literals/2 bif erts_internal:purge_module/1 bif binary:split/2 bif binary:split/3 diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 4353e115ca..d58d9c909e 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 553b34b105..74001fc799 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 150e76505d..7577522151 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index ab54d716cc..0a41951900 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -91,7 +91,7 @@ -export([bit_size/1, bitsize/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). -export([cancel_timer/1, cancel_timer/2, check_old_code/1, check_process_code/2, - check_process_code/3, copy_literals/2, crc32/1]). + check_process_code/3, crc32/1]). -export([crc32/2, crc32_combine/3, date/0, decode_packet/3]). -export([delete_element/2]). -export([delete_module/1, demonitor/1, demonitor/2, display/1]). @@ -520,13 +520,6 @@ get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> get_cpc_opts([], Async, AllowGC) -> {Async, AllowGC}. -%% copy_literals/2 --spec erlang:copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when - Module :: module(), - Bool :: boolean(). -copy_literals(_Mod, _Bool) -> - erlang:nif_error(undefined). - %% crc32/1 -spec erlang:crc32(Data) -> non_neg_integer() when Data :: iodata(). diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index 880c86aad1..c7fe3ce22f 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -67,9 +67,9 @@ do_purge(Mod) -> false -> {false, false}; true -> - true = erlang:copy_literals(Mod, true), + true = erts_internal:copy_literals(Mod, true), DidKill = check_proc_code(erlang:processes(), Mod, true), - true = erlang:copy_literals(Mod, false), + true = erts_internal:copy_literals(Mod, false), WasPurged = erts_internal:purge_module(Mod), {WasPurged, DidKill} end. @@ -93,13 +93,13 @@ do_soft_purge(Mod) -> false -> true; true -> - true = erlang:copy_literals(Mod, true), + true = erts_internal:copy_literals(Mod, true), case check_proc_code(erlang:processes(), Mod, false) of false -> - true = erlang:copy_literals(Mod, false), + true = erts_internal:copy_literals(Mod, false), false; true -> - true = erlang:copy_literals(Mod, false), + true = erts_internal:copy_literals(Mod, false), erts_internal:purge_module(Mod), true end diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 6e649e8395..30e9ba304c 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -38,6 +38,7 @@ -export([request_system_task/3]). -export([check_process_code/2]). +-export([copy_literals/2]). -export([purge_module/1]). -export([flush_monitor_messages/3]). @@ -205,6 +206,12 @@ request_system_task(_Pid, _Prio, _Request) -> check_process_code(_Module, _OptionList) -> erlang:nif_error(undefined). +-spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when + Module :: module(), + Bool :: boolean(). +copy_literals(_Mod, _Bool) -> + erlang:nif_error(undefined). + -spec purge_module(Module) -> boolean() when Module :: module(). purge_module(_Module) -> -- cgit v1.2.3 From 79efde2d8503e5055ef9e8afa5d8d63208710b1f Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 16 Dec 2015 20:03:32 +0100 Subject: erts: Make copy_literals more fail safe * Same process must do enable-disable. * System process will force it and never get 'aborted' --- erts/emulator/beam/beam_bif_load.c | 28 +++++++++++++++++----------- erts/emulator/beam/global.h | 1 + erts/preloaded/ebin/erts_code_purger.beam | Bin 8996 -> 8832 bytes erts/preloaded/src/erts_code_purger.erl | 12 +++++------- 4 files changed, 23 insertions(+), 18 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 39a5bff04c..892b2d16c2 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1013,7 +1013,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) static void copy_literals_commit(void*); #endif -copy_literals_t erts_clrange = {NULL, 0}; +copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE}; /* copy literals * @@ -1033,7 +1033,6 @@ copy_literals_t erts_clrange = {NULL, 0}; BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2) { - Module* modp; ErtsCodeIndex code_ix; Eterm res = am_true; @@ -1048,21 +1047,28 @@ BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2) code_ix = erts_active_code_ix(); - if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL || !modp->old.code_hdr) { - res = am_false; - goto done; - } - if (BIF_ARG_2 == am_true) { - if (erts_clrange.ptr != NULL) { + Module* modp = erts_get_module(BIF_ARG_1, code_ix); + if (!modp || !modp->old.code_hdr) { + res = am_false; + goto done; + } + if (erts_clrange.ptr != NULL + && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) { res = am_aborted; goto done; - } - erts_clrange.ptr = (Eterm*) modp->old.code_hdr->literals_start; - erts_clrange.sz = (Eterm*) modp->old.code_hdr->literals_end - erts_clrange.ptr; + } + erts_clrange.ptr = modp->old.code_hdr->literals_start; + erts_clrange.sz = modp->old.code_hdr->literals_end - erts_clrange.ptr; + erts_clrange.pid = BIF_P->common.id; } else if (BIF_ARG_2 == am_false) { + if (erts_clrange.pid != BIF_P->common.id) { + res = am_false; + goto done; + } erts_clrange.ptr = NULL; erts_clrange.sz = 0; + erts_clrange.pid = THE_NON_VALUE; } #ifdef ERTS_SMP diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 0bf5988244..bbf684d49d 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -990,6 +990,7 @@ Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *red typedef struct { Eterm *ptr; Uint sz; + Eterm pid; } copy_literals_t; extern copy_literals_t erts_clrange; diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 74001fc799..c5aec6bb25 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index c7fe3ce22f..791ef72f13 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -63,11 +63,10 @@ purge(Mod) when is_atom(Mod) -> do_purge(Mod) -> - case erlang:check_old_code(Mod) of + case erts_internal:copy_literals(Mod, true) of false -> {false, false}; true -> - true = erts_internal:copy_literals(Mod, true), DidKill = check_proc_code(erlang:processes(), Mod, true), true = erts_internal:copy_literals(Mod, false), WasPurged = erts_internal:purge_module(Mod), @@ -89,17 +88,16 @@ soft_purge(Mod) -> do_soft_purge(Mod) -> - case erlang:check_old_code(Mod) of + case erts_internal:copy_literals(Mod, true) of false -> true; true -> - true = erts_internal:copy_literals(Mod, true), - case check_proc_code(erlang:processes(), Mod, false) of + DoPurge = check_proc_code(erlang:processes(), Mod, false), + true = erts_internal:copy_literals(Mod, false), + case DoPurge of false -> - true = erts_internal:copy_literals(Mod, false), false; true -> - true = erts_internal:copy_literals(Mod, false), erts_internal:purge_module(Mod), true end -- cgit v1.2.3 From a4920dc4045f394f6f4ab1cc89d54d55722a66d6 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 12 Jan 2016 17:02:06 +0100 Subject: erts: Refactor check_process_code/3 Move impl from erlang to erts_internal. Cut and paste. --- erts/preloaded/ebin/erlang.beam | Bin 102332 -> 101268 bytes erts/preloaded/ebin/erts_internal.beam | Bin 6632 -> 8168 bytes erts/preloaded/src/erlang.erl | 44 ++------------------------ erts/preloaded/src/erts_internal.erl | 55 ++++++++++++++++++++++++++++++++- 4 files changed, 56 insertions(+), 43 deletions(-) diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index d58d9c909e..b6e38e4b5b 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 7577522151..4c66171965 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 0a41951900..40d5aedd24 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -460,7 +460,7 @@ check_old_code(_Module) -> CheckResult :: boolean(). check_process_code(Pid, Module) -> try - erlang:check_process_code(Pid, Module, [{allow_gc, true}]) + erts_internal:check_process_code(Pid, Module, [{allow_gc, true}]) catch error:Error -> erlang:error(Error, [Pid, Module]) end. @@ -475,51 +475,11 @@ check_process_code(Pid, Module) -> CheckResult :: boolean() | aborted. check_process_code(Pid, Module, OptionList) -> try - {Async, AllowGC} = get_cpc_opts(OptionList, sync, true), - case Async of - {async, ReqId} -> - {priority, Prio} = erlang:process_info(erlang:self(), - priority), - erts_internal:request_system_task(Pid, - Prio, - {check_process_code, - ReqId, - Module, - AllowGC}), - async; - sync -> - case Pid == erlang:self() of - true -> - erts_internal:check_process_code(Module, - [{allow_gc, AllowGC}]); - false -> - {priority, Prio} = erlang:process_info(erlang:self(), - priority), - ReqId = erlang:make_ref(), - erts_internal:request_system_task(Pid, - Prio, - {check_process_code, - ReqId, - Module, - AllowGC}), - receive - {check_process_code, ReqId, CheckResult} -> - CheckResult - end - end - end + erts_internal:check_process_code(Pid, Module, OptionList) catch error:Error -> erlang:error(Error, [Pid, Module, OptionList]) end. -% gets async and allow_gc opts and verify valid option list -get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) -> - get_cpc_opts(Options, AsyncTuple, AllowGC); -get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> - get_cpc_opts(Options, Async, AllowGC); -get_cpc_opts([], Async, AllowGC) -> - {Async, AllowGC}. - %% crc32/1 -spec erlang:crc32(Data) -> non_neg_integer() when Data :: iodata(). diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 30e9ba304c..e32d65ff59 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -37,7 +37,7 @@ -export([request_system_task/3]). --export([check_process_code/2]). +-export([check_process_code/3]). -export([copy_literals/2]). -export([purge_module/1]). @@ -49,6 +49,9 @@ -export([is_system_process/1]). +%% Auto import name clash +-export([check_process_code/2]). + %% %% Await result of send to port %% @@ -206,6 +209,56 @@ request_system_task(_Pid, _Prio, _Request) -> check_process_code(_Module, _OptionList) -> erlang:nif_error(undefined). +-spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when + Pid :: pid(), + Module :: module(), + RequestId :: term(), + Option :: {async, RequestId} | {allow_gc, boolean()}, + OptionList :: [Option], + CheckResult :: boolean() | aborted. +check_process_code(Pid, Module, OptionList) -> + {Async, AllowGC} = get_cpc_opts(OptionList, sync, true), + case Async of + {async, ReqId} -> + {priority, Prio} = erlang:process_info(erlang:self(), + priority), + erts_internal:request_system_task(Pid, + Prio, + {check_process_code, + ReqId, + Module, + AllowGC}), + async; + sync -> + case Pid == erlang:self() of + true -> + erts_internal:check_process_code(Module, + [{allow_gc, AllowGC}]); + false -> + {priority, Prio} = erlang:process_info(erlang:self(), + priority), + ReqId = erlang:make_ref(), + erts_internal:request_system_task(Pid, + Prio, + {check_process_code, + ReqId, + Module, + AllowGC}), + receive + {check_process_code, ReqId, CheckResult} -> + CheckResult + end + end + end. + +% gets async and allow_gc opts and verify valid option list +get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) -> + get_cpc_opts(Options, AsyncTuple, AllowGC); +get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> + get_cpc_opts(Options, Async, AllowGC); +get_cpc_opts([], Async, AllowGC) -> + {Async, AllowGC}. + -spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when Module :: module(), Bool :: boolean(). -- cgit v1.2.3 From 4c763443365591e170308a1c5f11a4586734ca4e Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 12 Jan 2016 16:57:59 +0100 Subject: erts: Optimize erlang:check_process_code by ignoring literals. erts_internal:check_process_code will be called again anyway (with option {copy_literals, true}) before the module is actually purged. No need to check literals twice. --- erts/emulator/beam/beam_bif_load.c | 61 ++++++++++-------------------- erts/emulator/beam/erl_process.c | 4 +- erts/emulator/beam/global.h | 5 ++- erts/preloaded/ebin/erts_code_purger.beam | Bin 8832 -> 8884 bytes erts/preloaded/ebin/erts_internal.beam | Bin 8168 -> 8536 bytes erts/preloaded/src/erts_code_purger.erl | 5 ++- erts/preloaded/src/erts_internal.erl | 42 +++++++++++--------- 7 files changed, 54 insertions(+), 63 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 892b2d16c2..a000935388 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -38,7 +38,7 @@ #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp); +static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp); static void delete_code(Module* modp); static void decrement_refc(BeamCodeHeader*); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); @@ -426,7 +426,7 @@ check_old_code_1(BIF_ALIST_1) } Eterm -erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) +erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) { Module* modp; Eterm res; @@ -441,7 +441,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) if (!modp) return am_false; erts_rlock_old_code(code_ix); - res = modp->old.code_hdr ? check_process_code(c_p, modp, allow_gc, redsp) : am_false; + res = (!modp->old.code_hdr ? am_false : + check_process_code(c_p, modp, flags, redsp)); erts_runlock_old_code(code_ix); return res; @@ -450,49 +451,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) { int reds = 0; + Uint flags; Eterm res; - Eterm olist = BIF_ARG_2; - int allow_gc = 1; if (is_not_atom(BIF_ARG_1)) goto badarg; - while (is_list(olist)) { - Eterm *lp = list_val(olist); - Eterm opt = CAR(lp); - if (is_tuple(opt)) { - Eterm* tp = tuple_val(opt); - switch (arityval(tp[0])) { - case 2: - switch (tp[1]) { - case am_allow_gc: - switch (tp[2]) { - case am_false: - allow_gc = 0; - break; - case am_true: - allow_gc = 1; - break; - default: - goto badarg; - } - break; - default: - goto badarg; - } - break; - default: - goto badarg; - } - } - else - goto badarg; - olist = CDR(lp); + if (is_not_small(BIF_ARG_2)) + goto badarg; + + flags = unsigned_val(BIF_ARG_2); + if (flags & ~ERTS_CPC_ALL) { + goto badarg; } - if (is_not_nil(olist)) - goto badarg; - res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds); + res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds); ASSERT(is_value(res)); @@ -739,7 +712,7 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) static Eterm -check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) +check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) { BeamInstr* start; char* literals; @@ -852,6 +825,12 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) /* Check heap, stack etc... */ if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) goto try_gc; + if (!(flags & ERTS_CPC_COPY_LITERALS)) { + /* Process ok. May contain old literals but we will be called + * again before module is purged. + */ + return am_false; + } if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { rp->freason = EXC_NULL; rp->fvalue = NIL; @@ -919,7 +898,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) if ((done_gc & need_gc) == need_gc) return am_true; - if (!allow_gc) + if (!(flags & ERTS_CPC_ALLOW_GC)) return am_aborted; need_gc &= ~done_gc; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9495436ba6..d36d866b2f 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10055,7 +10055,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) case ERTS_PSTT_CPC: st_res = erts_check_process_code(c_p, st->arg[0], - st->arg[1] == am_true, + unsigned_val(st->arg[1]), &reds); if (is_non_value(st_res)) { /* Needed gc, but gc was disabled */ @@ -10219,7 +10219,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3) case am_check_process_code: if (is_not_atom(st->arg[0])) goto badarg; - if (st->arg[1] != am_true && st->arg[1] != am_false) + if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL)) goto badarg; noproc_res = am_false; st->type = ERTS_PSTT_CPC; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index bbf684d49d..3f5925765d 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -985,7 +985,10 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg); Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ -Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp); +#define ERTS_CPC_ALLOW_GC (1 << 0) +#define ERTS_CPC_COPY_LITERALS (1 << 1) +#define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS) +Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp); typedef struct { Eterm *ptr; diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index c5aec6bb25..ca6c8570ed 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 4c66171965..d3d990519d 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index 791ef72f13..e492ba1812 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -283,8 +283,9 @@ cpc_sched_kill(Pid, killed = true}. cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> - erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, - {allow_gc, AllowGc}]). + erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, + {allow_gc, AllowGc}, + {copy_literals, true}]). cpc_request_gc(CpcS, [Pid|Pids]) -> cpc_request(CpcS, Pid, true), diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index e32d65ff59..84dedab930 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -202,22 +202,24 @@ port_info(_Result, _Item) -> request_system_task(_Pid, _Prio, _Request) -> erlang:nif_error(undefined). --spec check_process_code(Module, OptionList) -> boolean() when +-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)). +-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)). + +-spec check_process_code(Module, Flags) -> boolean() when Module :: module(), - Option :: {allow_gc, boolean()}, - OptionList :: [Option]. -check_process_code(_Module, _OptionList) -> + Flags :: non_neg_integer(). +check_process_code(_Module, _Flags) -> erlang:nif_error(undefined). -spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when Pid :: pid(), Module :: module(), RequestId :: term(), - Option :: {async, RequestId} | {allow_gc, boolean()}, + Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()}, OptionList :: [Option], CheckResult :: boolean() | aborted. check_process_code(Pid, Module, OptionList) -> - {Async, AllowGC} = get_cpc_opts(OptionList, sync, true), + {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC), case Async of {async, ReqId} -> {priority, Prio} = erlang:process_info(erlang:self(), @@ -227,13 +229,12 @@ check_process_code(Pid, Module, OptionList) -> {check_process_code, ReqId, Module, - AllowGC}), + Flags}), async; sync -> case Pid == erlang:self() of true -> - erts_internal:check_process_code(Module, - [{allow_gc, AllowGC}]); + erts_internal:check_process_code(Module, Flags); false -> {priority, Prio} = erlang:process_info(erlang:self(), priority), @@ -243,7 +244,7 @@ check_process_code(Pid, Module, OptionList) -> {check_process_code, ReqId, Module, - AllowGC}), + Flags}), receive {check_process_code, ReqId, CheckResult} -> CheckResult @@ -251,13 +252,20 @@ check_process_code(Pid, Module, OptionList) -> end end. -% gets async and allow_gc opts and verify valid option list -get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) -> - get_cpc_opts(Options, AsyncTuple, AllowGC); -get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> - get_cpc_opts(Options, Async, AllowGC); -get_cpc_opts([], Async, AllowGC) -> - {Async, AllowGC}. +% gets async and flag opts and verify valid option list +get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) -> + get_cpc_opts(Options, AsyncTuple, Flags); +get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) -> + get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC)); +get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) -> + get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit)); +get_cpc_opts([], Async, Flags) -> + {Async, Flags}. + +cpc_flags(OldFlags, Bit, true) -> + OldFlags bor Bit; +cpc_flags(OldFlags, Bit, false) -> + OldFlags band (bnot Bit). -spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when Module :: module(), -- cgit v1.2.3 From f5c9dd660f3f098ba1e2a4110be594013a6dff11 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Thu, 14 Jan 2016 12:07:39 +0100 Subject: Add documentation of '-path' flag to 'erl' This flag replaces the path specified in the boot script. It has always existed, but was earlier only documented in SASL (script). --- erts/doc/src/erl.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index ec4a0dee05..e8621fecc3 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -382,6 +382,11 @@ similar to . See code(3).

 + + +

Replaces the path specified in the boot script. See + script(4).

+

Starts Erlang with a remote shell connected to .

-- cgit v1.2.3 From fea8e2cade3de24f044c834e0b62f58921a4e9c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 14 Jan 2016 14:44:06 +0100 Subject: dialyzer: Update Maps tests --- lib/dialyzer/test/small_SUITE_data/results/maps1 | 4 ++++ lib/dialyzer/test/small_SUITE_data/src/maps1.erl | 12 ++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 lib/dialyzer/test/small_SUITE_data/results/maps1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 new file mode 100644 index 0000000000..5a78d66a92 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -0,0 +1,4 @@ + +maps1.erl:43: Function t3/0 has no local return +maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') +maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() | tuple() not #{} diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl index 06ced5b69e..bb2f66a498 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -39,3 +39,15 @@ t2() -> ok. update(#{ id := Id, val := Val } = M, X) when is_integer(Id) -> M#{ val := [Val,X] }. + +t3() -> + foo(#{greger => 3, #{arne=>anka} => 45}, 1). + +foo(#{} = M, b) -> %% Error + M#{alfa => 42, beta := 1337}. + +t4() -> + case #{} of + #{} -> ok; + Mod -> Mod:function(#{literal => map}, another_arg) %% Error + end. -- cgit v1.2.3 From e593432c9e590c29971a4e0dc1c6692d82c2a1d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 14 Jan 2016 11:58:40 +0100 Subject: hipe: Fix map pretty printing of pairs In commit f667931e2905797ffab63e224e56eaf07f77178a the core format changed for map pairs. Let dialyzer and hipe pretty printing of maps also adhere to those changes. An Erlang map update, M#{foo := 1, bar => 2} will now be printed as: ~{ 'foo' := 1, 'bar' => 2 | M }~ --- lib/hipe/cerl/cerl_prettypr.erl | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 7e8b7f60bd..729143eba9 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -627,12 +627,10 @@ lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), V = map_pair_val(Node), OpTxt = case concrete(map_pair_op(Node)) of - assoc -> "::<"; - exact -> "~<" + assoc -> "=>"; + exact -> ":=" end, - beside(floating(text(OpTxt)), - beside(lay(K,Ctxt),beside(floating(text(",")), beside(lay(V,Ctxt), - floating(text(">")))))). + beside(lay(K,Ctxt),beside(floating(text(OpTxt)),lay(V,Ctxt))). lay_let(Node, Ctxt) -> V = lay_value_list(let_vars(Node), Ctxt), -- cgit v1.2.3 From 48e25dfef23a51d02629b2c9fa9963fd3ba7788c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Thu, 14 Jan 2016 13:10:00 +0100 Subject: compiler, hipe: Fix pretty printing of Core Maps Literal maps could cause dialyzer to crash when pretty printing the results. Reported-by: Chris McGrath --- lib/compiler/src/cerl.erl | 11 +++++++++-- lib/hipe/cerl/cerl_prettypr.erl | 10 +++------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 010327b5e3..e7a2b8177a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1598,13 +1598,20 @@ is_c_map(#c_literal{val = V}) when is_map(V) -> is_c_map(_) -> false. --spec map_es(c_map()) -> [c_map_pair()]. +-spec map_es(c_map() | c_literal()) -> [c_map_pair()]. +map_es(#c_literal{anno=As,val=M}) when is_map(M) -> + [ann_c_map_pair(As, + #c_literal{anno=As,val='assoc'}, + #c_literal{anno=As,val=K}, + #c_literal{anno=As,val=V}) || {K,V} <- maps:to_list(M)]; map_es(#c_map{es = Es}) -> Es. --spec map_arg(c_map()) -> c_map() | c_literal(). +-spec map_arg(c_map() | c_literal()) -> c_map() | c_literal(). +map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> + #c_literal{anno=As,val=#{}}; map_arg(#c_map{arg=M}) -> M. diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 729143eba9..1a6e6999fe 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -64,8 +64,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, - c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 + map_arg/1, map_es/1, is_c_map_empty/1, + map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -499,12 +499,8 @@ lay_literal(Node, Ctxt) -> lay_cons(Node, Ctxt); V when is_tuple(V) -> lay_tuple(Node, Ctxt); - M when is_map(M), map_size(M) =:= 0 -> - text("~{}~"); M when is_map(M) -> - lay_map(c_map([c_map_pair(abstract(K),abstract(V)) - || {K,V} <- maps:to_list(M)]), - Ctxt) + lay_map(Node, Ctxt) end. lay_var(Node, Ctxt) -> -- cgit v1.2.3 From 43a7421c36d3feddb238b92426f938f11ef91174 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 14 Jan 2016 16:10:38 +0100 Subject: erts: Correct faulty doc for erlang:trace/3 The entire MFA tuple is replaced with 0, not just Arity. --- erts/doc/src/erlang.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index c37ed3bea5..20184bd7f3 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -8182,14 +8182,14 @@ timestamp() ->

When Pid is scheduled to run. The process runs in function {M, F, Arity}. On some rare occasions, the current function cannot be determined, - then the last element Arity is 0.

+ then the last element is 0.

 {trace, Pid, out, {M, F, Arity} | 0}

When Pid is scheduled out. The process was running in function {M, F, Arity}. On some rare occasions, the current function cannot be determined, then the last - element Arity is 0.

+ element is 0.

 {trace, Pid, gc_start, Info} -- cgit v1.2.3 From 64248a85e221a905aa37fbb8dd0ab1d4f4551be0 Mon Sep 17 00:00:00 2001 From: Andrew Bennett Date: Thu, 14 Jan 2016 18:26:28 +0100 Subject: crypto: Fix bug for multiple blocks for AES-ECB --- lib/crypto/c_src/crypto.c | 5 ++++- lib/crypto/test/crypto_SUITE.erl | 18 +++++++++++++++++- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 9de8dc74c2..3c73c318ed 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -2042,6 +2042,7 @@ static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ErlNifBinary key_bin, data_bin; AES_KEY aes_key; int i; + int j; unsigned char* ret_ptr; ERL_NIF_TERM ret; @@ -2064,7 +2065,9 @@ static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a } ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - AES_ecb_encrypt(data_bin.data, ret_ptr, &aes_key, i); + for (j = 0; j < data_bin.size; j += 16) { + AES_ecb_encrypt(data_bin.data+j, ret_ptr+j, &aes_key, i); + } CONSUME_REDS(env,data_bin); return ret; } diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index e84f5e1075..802c8a4df4 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1301,7 +1301,23 @@ aes_ecb() -> <<"0000000000000000">>}, {aes_ecb, <<"FEDCBA9876543210">>, - <<"FFFFFFFFFFFFFFFF">>} + <<"FFFFFFFFFFFFFFFF">>}, + %% AES ECB test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf + %% F.1.1 ECB-AES128.Encrypt, F.1.2 ECB-AES128.Decrypt + {aes_ecb, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.5 ECB-AES256.Encrypt, F.1.6 ECB-AES256.Decrypt + {aes_ecb, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")} ]. aes_ige256() -> -- cgit v1.2.3 From dd16a879b9012f4d2182eb780e002f47183e17ff Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 17 Dec 2015 13:02:21 +0100 Subject: dialyzer: Correct handling of parameters of opaque types Correction of commit d57f5e. --- lib/hipe/cerl/erl_types.erl | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cd2d2fe207..7a2abc226f 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2711,7 +2711,6 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A, A) -> true; is_compat_arg(A1, A2) -> is_specialization(A1, A2) orelse is_specialization(A2, A1). @@ -2722,6 +2721,7 @@ is_compat_arg(A1, A2) -> %% any(). For example, {_,_} is a specialization of any(), but not of %% tuple(). Does not handle variables, but any() and unions (sort of). +is_specialization(T, T) -> true; is_specialization(_, ?any) -> true; is_specialization(?any, _) -> false; is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> @@ -2747,8 +2747,8 @@ is_specialization(?tuple(Elements1, Arity, _), specialization_list(Elements1, sup_tuple_elements(List)); is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2])) + specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; is_specialization(?union(List1)=T1, ?union(List2)=T2) -> @@ -2772,13 +2772,19 @@ is_specialization(T1, ?opaque(_) = T2) -> is_specialization(T1, t_opaque_structure(T2)); is_specialization(?var(_), _) -> exit(error); is_specialization(_, ?var(_)) -> exit(error); -is_specialization(T, T) -> true; is_specialization(?none, _) -> false; is_specialization(_, ?none) -> false; is_specialization(?unit, _) -> false; is_specialization(_, ?unit) -> false; is_specialization(#c{}, #c{}) -> false. +specialization_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). + +specialization_list_list1([], []) -> true; +specialization_list_list1([L1|LL1], [L2|LL2]) -> + specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). + specialization_list(L1, L2) -> length(L1) =:= length(L2) andalso specialization_list1(L1, L2). -- cgit v1.2.3 From 898b4e182837ad5540afe6dad389d193a64f6a38 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 14 Jan 2016 10:35:01 +0100 Subject: edoc: Assign correct names to list arguments Bug reported by Josemic. See also ERL-63. --- lib/edoc/src/edoc_specs.erl | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index bb98e8b04f..f2e5891c2e 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -270,12 +270,8 @@ parms([], []) -> parms([A | As], [D | Ds]) -> [param(A, D) | parms(As, Ds)]. -param(#t_list{type = Type}, Default) -> - param(Type, Default); param(#t_paren{type = Type}, Default) -> param(Type, Default); -param(#t_nonempty_list{type = Type}, Default) -> - param(Type, Default); param(#t_record{name = #t_atom{val = Name}}, _Default) -> list_to_atom(capitalize(atom_to_list(Name))); param(T, Default) -> -- cgit v1.2.3 From 2f0941478ed566949eae5d09b4cb16edcbaaec63 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 22 Dec 2015 13:24:24 +0100 Subject: ssh: added sftp server benchmark --- lib/ssh/test/ssh_benchmark_SUITE.erl | 144 +++++++++++++++++++++++++++++------ 1 file changed, 122 insertions(+), 22 deletions(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 2add99de97..24927805e4 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -37,8 +37,8 @@ all() -> [{group, opensshc_erld} ]. groups() -> - [{opensshc_erld, [{repeat, 3}], [openssh_client_shell]}, - {erlc_opensshd, [{repeat, 3}], [erl_shell]} + [{opensshc_erld, [{repeat, 3}], [openssh_client_shell, + openssh_client_sftp]} ]. @@ -50,7 +50,7 @@ init_per_suite(Config) -> report_client_algorithms(), ok = ssh:start(), {ok,TracerPid} = erlang_trace(), - [{tracer_pid,TracerPid} | Config] + [{tracer_pid,TracerPid} | init_sftp_dirs(Config)] catch C:E -> {skip, io_lib:format("Couldn't start ~p:~p",[C,E])} @@ -71,8 +71,12 @@ init_per_group(opensshc_erld, Config) -> ssh_test_lib:setup_dsa(DataDir, UserDir), ssh_test_lib:setup_rsa(DataDir, UserDir), ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + Common = ssh_test_lib:intersect_bi_dir( + ssh_test_lib:intersection(ssh:default_algorithms(), + ssh_test_lib:default_algorithms(sshc))), [{c_kexs, ssh_test_lib:sshc(kex)}, - {c_ciphers, ssh_test_lib:sshc(cipher)} + {c_ciphers, ssh_test_lib:sshc(cipher)}, + {common_algs, Common} | Config]; _ -> {skip, "No OpenSsh client found"} @@ -94,20 +98,21 @@ init_per_testcase(_Func, Conf) -> end_per_testcase(_Func, _Conf) -> ok. + +init_sftp_dirs(Config) -> + UserDir = ?config(priv_dir, Config), + SrcDir = filename:join(UserDir, "sftp_src"), + ok = file:make_dir(SrcDir), + SrcFile = "big_data", + DstDir = filename:join(UserDir, "sftp_dst"), + ok = file:make_dir(DstDir), + N = 100 * 1024*1024, + ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:rand_bytes(N)), + [{sftp_src_dir,SrcDir}, {sftp_dst_dir,DstDir}, {src_file,SrcFile}, {sftp_size,N} + | Config]. + %%%================================================================ openssh_client_shell(Config) -> - CommonAlgs = ssh_test_lib:intersect_bi_dir( - ssh_test_lib:intersection(ssh:default_algorithms(), - ssh_test_lib:default_algorithms(sshc))), - KexVariants = - [ [{kex,[Kex]}] - || Kex <- proplists:get_value(kex, CommonAlgs)], - CipherVariants = - [ [{cipher,[{client2server,[Cipher]}, - {server2client,[Cipher]}]}] - || Cipher <- proplists:get_value(cipher, CommonAlgs)], - - lists:foreach( fun(PrefAlgs=[{kex,[Kex]}]) when Kex == 'diffie-hellman-group-exchange-sha256' -> lists:foreach( @@ -120,7 +125,8 @@ openssh_client_shell(Config) -> (PrefAlgs) -> openssh_client_shell(Config, [{preferred_algorithms, PrefAlgs}]) - end, KexVariants ++ CipherVariants). + end, variants(kex,Config) ++ variants(cipher,Config) + ). openssh_client_shell(Config, Options) -> @@ -151,7 +157,7 @@ openssh_client_shell(Config, Options) -> {SlavePid, _ClientResponse} -> %% ct:pal("ClientResponse = ~p",[_ClientResponse]), {ok, List} = get_trace_list(TracerPid), - Times = find_times(List), + Times = find_times(List, [accept_to_hello, kex, kex_to_auth, auth, to_prompt]), Algs = find_algs(List), ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), lists:foreach( @@ -189,6 +195,95 @@ openssh_client_shell(Config, Options) -> %%%================================================================ +openssh_client_sftp(Config) -> + lists:foreach( + fun(PrefAlgs) -> + openssh_client_sftp(Config, [{preferred_algorithms,PrefAlgs}]) + end, variants(cipher,Config)). + + +openssh_client_sftp(Config, Options) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + SftpSrcDir = ?config(sftp_src_dir, Config), + SrcFile = ?config(src_file, Config), + SrcSize = ?config(sftp_size, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {subsystems,[ssh_sftpd:subsystem_spec([%{cwd, SftpSrcDir}, + {root, SftpSrcDir}])]}, + {failfun, fun ssh_test_lib:failfun/2} + | Options]), + ct:sleep(500), + Cmd = lists:concat(["sftp", + " -b -", + " -P ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost:",SrcFile + ]), +%% ct:pal("Cmd = ~p",[Cmd]), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, _ClientResponse} -> + ct:pal("ClientResponse = ~p",[_ClientResponse]), + {ok, List} = get_trace_list(TracerPid), +%%ct:pal("List=~p",[List]), + Times = find_times(List, [channel_open_close]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), + lists:foreach( + fun({{A,B},Value,Unit}) when A==encrypt ; A==decrypt -> + Data = [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Sftp Cipher ",A," ",B," [",Unit,"]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + ({channel_open_close,Value,Unit}) -> + Data = [{value, round( (1024*Value) / SrcSize )}, + {suite, ?MODULE}, + {name, mk_name(["Sftp transfer [",Unit," per kbyte]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + (_) -> + skip + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + +%%%================================================================ +variants(Tag, Config) -> + TagType = + case proplists:get_value(Tag, ssh:default_algorithms()) of + [{_,_}|_] -> one_way; + [A|_] when is_atom(A) -> two_way + end, + [ [{Tag,tag_value(TagType,Alg)}] + || Alg <- proplists:get_value(Tag, ?config(common_algs,Config)) + ]. + +tag_value(two_way, Alg) -> [Alg]; +tag_value(one_way, Alg) -> [{client2server,[Alg]}, + {server2client,[Alg]}]. + +%%%---------------------------------------------------------------- fmt_alg(Alg, List) when is_atom(Alg) -> fmt_alg(atom_to_list(Alg), List); fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) -> @@ -199,7 +294,7 @@ fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) -> catch _:_ -> Alg end; -fmt_alg(Alg, List) -> +fmt_alg(Alg, _List) -> Alg. %%%---------------------------------------------------------------- @@ -209,8 +304,7 @@ char($-) -> $_; char(C) -> C. %%%---------------------------------------------------------------- -find_times(L) -> - Xs = [accept_to_hello, kex, kex_to_auth, auth, to_prompt], +find_times(L, Xs) -> [find_time(X,L) || X <- Xs] ++ crypto_algs_times_sizes([encrypt,decrypt], L). @@ -268,7 +362,13 @@ find_time(to_prompt, L) -> end, ?recv(#ssh_msg_channel_request{request_type="env"}) ], L, []), - {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}. + {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(channel_open_close, L) -> + [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), + ?send(#ssh_msg_channel_close{}) + ], L, []), + {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. + find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> -- cgit v1.2.3 From 95f121ed04a632257cd0e429cb16ba9d9a7110bb Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 22 Dec 2015 15:10:00 +0100 Subject: ssh: added cipher name to transfer speed report --- lib/ssh/test/ssh_benchmark_SUITE.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 24927805e4..781230e728 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -250,9 +250,10 @@ openssh_client_sftp(Config, Options) -> ct_event:notify(#event{name = benchmark_data, data = Data}); ({channel_open_close,Value,Unit}) -> + Cipher = fmt_alg(Algs#alg.encrypt, List), Data = [{value, round( (1024*Value) / SrcSize )}, {suite, ?MODULE}, - {name, mk_name(["Sftp transfer [",Unit," per kbyte]"])} + {name, mk_name(["Sftp transfer ",Cipher," [",Unit," per kbyte]"])} ], ct:pal("sftp ct_event:notify ~p",[Data]), ct_event:notify(#event{name = benchmark_data, -- cgit v1.2.3 From 02c266f80b87e690203b764bd518e347386fae7e Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Mon, 4 Jan 2016 15:17:41 +0100 Subject: ssh: encode/decode benchmark suites --- lib/ssh/test/ssh_benchmark_SUITE.erl | 38 ++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 781230e728..e90bfa3d16 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -307,7 +307,10 @@ char(C) -> C. %%%---------------------------------------------------------------- find_times(L, Xs) -> [find_time(X,L) || X <- Xs] ++ - crypto_algs_times_sizes([encrypt,decrypt], L). + function_algs_times_sizes([{ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2}, + {ssh_message,decode,1}, + {ssh_message,encode,1}], L). -record(call, { mfa, @@ -396,24 +399,31 @@ find_gex_size_string(L) -> Size. %%%---------------- -crypto_algs_times_sizes(EncDecs, L) -> - Raw = [{_Algorithm = case EncDec of - encrypt -> {encrypt,S#ssh.encrypt}; - decrypt -> {decrypt,S#ssh.decrypt} - end, - size(Data), - now2micro_sec(now_diff(T1, T0)) - } +function_algs_times_sizes(EncDecs, L) -> + Raw = [begin + {Tag,Size} = function_ats_result(EncDec, C), + {Tag, Size, now2micro_sec(now_diff(T1,T0))} + end || EncDec <- EncDecs, - #call{mfa = {ssh_transport,ED,2}, - args = [S,Data], - t_call = T0, - t_return = T1} <- L, + C = #call{mfa = ED, + args = Args, %%[S,Data], + t_call = T0, + t_return = T1} <- L, ED == EncDec ], [{Alg, round(1024*Time/Size), "microsec per kbyte"} % Microseconds per 1k bytes. || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. +function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) -> + {{encrypt,S#ssh.encrypt}, size(Data)}; +function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) -> + {{decrypt,S#ssh.decrypt}, size(Data)}; +function_ats_result({ssh_message,encode,1}, #call{result=Data}) -> + {encode, size(Data)}; +function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) -> + {decode, size(Data)}. + + increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> [{Alg,SumSz+Sz,SumT+T} | Acc]; increment(Spec, [X|Acc]) -> @@ -443,6 +453,8 @@ erlang_trace() -> {ssh_transport,select_algorithm,3}, {ssh_transport,encrypt,2}, {ssh_transport,decrypt,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, {public_key,dh_gex_group,4} % To find dh_gex group size ]], {ok, TracerPid}. -- cgit v1.2.3 From b9b704f8b584994cbbb4975133d6032d5d0d294e Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Mon, 4 Jan 2016 15:21:51 +0100 Subject: ssh: Optimization - inline encoding in ssh_message:encode/1, now 8 times faster. Also fixes minor error in ssh_protocol_SUITE that the new encoder found. --- lib/ssh/src/ssh_bits.erl | 141 +++++------------------------- lib/ssh/src/ssh_message.erl | 169 ++++++++++++++++++++---------------- lib/ssh/src/ssh_transport.erl | 48 +++++----- lib/ssh/test/ssh_protocol_SUITE.erl | 2 +- 4 files changed, 135 insertions(+), 225 deletions(-) diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 4da3a6018b..101bf76cd3 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -26,52 +26,30 @@ -include("ssh.hrl"). --export([encode/2]). --export([mpint/1, string/1, name_list/1]). +-export([mpint/1, name_list/1]). -export([random/1]). --define(name_list(X), - (fun(B) -> ?binary(B) end)(list_to_binary(name_concat(X)))). - - -name_concat([Name]) when is_atom(Name) -> atom_to_list(Name); -name_concat([Name]) when is_list(Name) -> Name; -name_concat([Name|Ns]) -> - if is_atom(Name) -> - [atom_to_list(Name),"," | name_concat(Ns)]; - is_list(Name) -> - [Name,"," | name_concat(Ns)] - end; -name_concat([]) -> []. - - -name_list(Ns) -> - ?name_list(Ns). +%%%---------------------------------------------------------------- +name_list([Name]) -> to_bin(Name); +name_list([Name|Ns]) -> <<(to_bin(Name))/binary, ",", (name_list(Ns))/binary>>; +name_list([]) -> <<>>. + +to_bin(A) when is_atom(A) -> list_to_binary(atom_to_list(A)); +to_bin(S) when is_list(S) -> list_to_binary(S); +to_bin(B) when is_binary(B) -> B. + +%%%---------------------------------------------------------------- +%%% Multi Precision Integer encoding +mpint(-1) -> <<0,0,0,1,16#ff>>; +mpint(0) -> <<0,0,0,0>>; +mpint(X) when X < 0 -> mpint_neg(X,0,[]); +mpint(X) -> mpint_pos(X,0,[]). - -string(Str) -> - ?string(Str). - - -%% MP representaion (SSH2) -mpint(X) when X < 0 -> - if X == -1 -> - <<0,0,0,1,16#ff>>; - true -> - mpint_neg(X,0,[]) - end; -mpint(X) -> - if X == 0 -> - <<0,0,0,0>>; - true -> - mpint_pos(X,0,[]) - end. - mpint_neg(-1,I,Ds=[MSB|_]) -> if MSB band 16#80 =/= 16#80 -> <>; true -> - (<>) + <> end; mpint_neg(X,I,Ds) -> mpint_neg(X bsr 8,I+1,[(X band 255)|Ds]). @@ -80,96 +58,17 @@ mpint_pos(0,I,Ds=[MSB|_]) -> if MSB band 16#80 == 16#80 -> <>; true -> - (<>) + <> end; mpint_pos(X,I,Ds) -> mpint_pos(X bsr 8,I+1,[(X band 255)|Ds]). -encode(List, Types) -> - list_to_binary(enc(List, Types)). - -%% -%% Encode record element -%% -enc(Xs, Ts) -> - enc(Xs, Ts, 0). - -enc(Xs, [boolean|Ts], Offset) -> - X = hd(Xs), - [?boolean(X) | enc(tl(Xs), Ts, Offset+1)]; -enc(Xs, [byte|Ts], Offset) -> - X = hd(Xs), - [?byte(X) | enc(tl(Xs), Ts,Offset+1)]; -enc(Xs, [uint16|Ts], Offset) -> - X = hd(Xs), - [?uint16(X) | enc(tl(Xs), Ts,Offset+2)]; -enc(Xs, [uint32 |Ts], Offset) -> - X = hd(Xs), - [?uint32(X) | enc(tl(Xs), Ts,Offset+4)]; -enc(Xs, [uint64|Ts], Offset) -> - X = hd(Xs), - [?uint64(X) | enc(tl(Xs), Ts,Offset+8)]; -enc(Xs, [mpint|Ts], Offset) -> - Y = mpint(hd(Xs)), - [Y | enc(tl(Xs), Ts,Offset+size(Y))]; -enc(Xs, [string|Ts], Offset) -> - X0 = hd(Xs), - Y = ?string(X0), - [Y | enc(tl(Xs),Ts,Offset+size(Y))]; -enc(Xs, [string_utf8|Ts], Offset) -> - X0 = hd(Xs), - Y = ?string_utf8(X0), - [Y | enc(tl(Xs),Ts,Offset+size(Y))]; -enc(Xs, [binary|Ts], Offset) -> - X0 = hd(Xs), - Y = ?binary(X0), - [Y | enc(tl(Xs), Ts,Offset+size(Y))]; -enc(Xs, [name_list|Ts], Offset) -> - X0 = hd(Xs), - Y = ?name_list(X0), - [Y | enc(tl(Xs), Ts, Offset+size(Y))]; -enc(Xs, [cookie|Ts], Offset) -> - [random(16) | enc(tl(Xs), Ts, Offset+16)]; -enc(Xs, [{pad,N}|Ts], Offset) -> - K = (N - (Offset rem N)) rem N, - [fill_bits(K,0) | enc(Xs, Ts, Offset+K)]; -enc(Xs, ['...'| []], _Offset) -> - X = hd(Xs), - if is_binary(X) -> - [X]; - is_list(X) -> - [list_to_binary(X)]; - X==undefined -> - [] - end; -enc([], [],_) -> - []. - - -%% -%% Create a binary with constant bytes -%% -fill_bits(N,C) -> - list_to_binary(fill(N,C)). - -fill(0,_C) -> []; -fill(1,C) -> [C]; -fill(N,C) -> - Cs = fill(N div 2, C), - Cs1 = [Cs,Cs], - if N band 1 == 0 -> - Cs1; - true -> - [C,Cs,Cs] - end. - - +%%%---------------------------------------------------------------- %% random/1 %% Generate N random bytes %% -random(N) -> - crypto:strong_rand_bytes(N). +random(N) -> crypto:strong_rand_bytes(N). diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index b6c4496be2..a0e9a4961c 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -32,16 +32,44 @@ -export([encode/1, decode/1, decode_keyboard_interactive_prompts/2]). +-define('2bin'(X), (if is_binary(X) -> X; + is_list(X) -> list_to_binary(X); + X==undefined -> <<>> + end) ). + +-define('E...'(X), ?'2bin'(X)/binary ). +-define(Eboolean(X), ?BOOLEAN(case X of + true -> ?TRUE; + false -> ?FALSE + end) ). +-define(Ebyte(X), ?BYTE(X) ). +-define(Euint32(X), ?UINT32(X) ). +-define(Estring(X), ?STRING(?'2bin'(X)) ). +-define(Estring_utf8(X), ?string_utf8(X)/binary ). +-define(Ename_list(X), ?STRING(ssh_bits:name_list(X)) ). +-define(Empint(X), (ssh_bits:mpint(X))/binary ). +-define(Ebinary(X), ?STRING(X) ). + +%% encode(Msg) -> +%% try encode1(Msg) +%% catch +%% C:E -> +%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]), +%% error(E) +%% end. + encode(#ssh_msg_global_request{ name = Name, want_reply = Bool, data = Data}) -> - ssh_bits:encode([?SSH_MSG_GLOBAL_REQUEST, - Name, Bool, Data], [byte, string, boolean, '...']); + <>; + encode(#ssh_msg_request_success{data = Data}) -> - <>; + <>; + encode(#ssh_msg_request_failure{}) -> - <>; + <>; + encode(#ssh_msg_channel_open{ channel_type = Type, sender_channel = Sender, @@ -49,9 +77,8 @@ encode(#ssh_msg_channel_open{ maximum_packet_size = Max, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN, - Type, Sender, Window, Max, Data], [byte, string, uint32, - uint32, uint32, '...']); + <>; + encode(#ssh_msg_channel_open_confirmation{ recipient_channel = Recipient, sender_channel = Sender, @@ -59,60 +86,63 @@ encode(#ssh_msg_channel_open_confirmation{ maximum_packet_size = MaxPacketSize, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_CONFIRMATION, Recipient, - Sender, InitWindowSize, MaxPacketSize, Data], - [byte, uint32, uint32, uint32, uint32, '...']); + <>; + encode(#ssh_msg_channel_open_failure{ recipient_channel = Recipient, reason = Reason, description = Desc, lang = Lang }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_OPEN_FAILURE, Recipient, - Reason, Desc, Lang], [byte, uint32, uint32, string, string]); + <>; + encode(#ssh_msg_channel_window_adjust{ recipient_channel = Recipient, bytes_to_add = Bytes }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_WINDOW_ADJUST, Recipient, Bytes], - [byte, uint32, uint32]); + <>; + encode(#ssh_msg_channel_data{ recipient_channel = Recipient, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_DATA, Recipient, Data], [byte, uint32, binary]); + <>; encode(#ssh_msg_channel_extended_data{ recipient_channel = Recipient, data_type_code = DataType, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_EXTENDED_DATA, Recipient, - DataType, Data], [byte, uint32, uint32, binary]); + <>; encode(#ssh_msg_channel_eof{recipient_channel = Recipient }) -> - <>; + <>; + encode(#ssh_msg_channel_close{ recipient_channel = Recipient }) -> - <>; + <>; + encode(#ssh_msg_channel_request{ recipient_channel = Recipient, request_type = Type, want_reply = Bool, data = Data }) -> - ssh_bits:encode([?SSH_MSG_CHANNEL_REQUEST, Recipient, Type, Bool, Data], - [byte, uint32, string, boolean, '...']); + <>; + encode(#ssh_msg_channel_success{ recipient_channel = Recipient }) -> - <>; + <>; + encode(#ssh_msg_channel_failure{ recipient_channel = Recipient }) -> - <>; + <>; encode(#ssh_msg_userauth_request{ user = User, @@ -120,36 +150,33 @@ encode(#ssh_msg_userauth_request{ method = Method, data = Data }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_REQUEST, User, Service, Method, Data], - [byte, string_utf8, string, string, '...']); + <>; + encode(#ssh_msg_userauth_failure{ authentications = Auths, partial_success = Bool }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_FAILURE, Auths, Bool], - [byte, string, boolean]); + <>; + encode(#ssh_msg_userauth_success{}) -> - <>; + <>; encode(#ssh_msg_userauth_banner{ message = Banner, language = Lang }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_BANNER, Banner, Lang], - [byte, string_utf8, string]); + <>; encode(#ssh_msg_userauth_pk_ok{ algorithm_name = Alg, key_blob = KeyBlob }) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_PK_OK, Alg, KeyBlob], - [byte, string, binary]); + <>; encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt, languge = Lang })-> - ssh_bits:encode([?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ, Prompt, Lang], - [byte, string, string]); + <>; encode(#ssh_msg_userauth_info_request{ name = Name, @@ -157,41 +184,37 @@ encode(#ssh_msg_userauth_info_request{ language_tag = Lang, num_prompts = NumPromtps, data = Data}) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_REQUEST, Name, Inst, Lang, NumPromtps, Data], - [byte, string, string, string, uint32, '...']); + <>; encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> - Responses = lists:map(fun("") -> - <<>>; - (Response) -> - ssh_bits:encode([Response], [string]) - end, Data), - Start = ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_RESPONSE, Num], - [byte, uint32]), - iolist_to_binary([Start, Responses]); + lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong + (Response, Acc) -> <> + end, + <>, + Data); encode(#ssh_msg_disconnect{ code = Code, description = Desc, language = Lang }) -> - ssh_bits:encode([?SSH_MSG_DISCONNECT, Code, Desc, Lang], - [byte, uint32, string, string]); + <>; encode(#ssh_msg_service_request{ name = Service }) -> - ssh_bits:encode([?SSH_MSG_SERVICE_REQUEST, Service], [byte, string]); + <>; encode(#ssh_msg_service_accept{ name = Service }) -> - ssh_bits:encode([?SSH_MSG_SERVICE_ACCEPT, Service], [byte, string]); + <>; encode(#ssh_msg_newkeys{}) -> - <>; + <>; encode(#ssh_msg_kexinit{ cookie = Cookie, @@ -208,19 +231,13 @@ encode(#ssh_msg_kexinit{ first_kex_packet_follows = Bool, reserved = Reserved }) -> - ssh_bits:encode([?SSH_MSG_KEXINIT, Cookie, KeyAlgs, HostKeyAlgs, EncAlgC2S, EncAlgS2C, - MacAlgC2S, MacAlgS2C, CompAlgS2C, CompAlgC2S, LangC2S, LangS2C, Bool, - Reserved], - [byte, cookie, - name_list, name_list, - name_list, name_list, - name_list, name_list, - name_list, name_list, - name_list, name_list, - boolean, uint32]); + <>; encode(#ssh_msg_kexdh_init{e = E}) -> - ssh_bits:encode([?SSH_MSG_KEXDH_INIT, E], [byte, mpint]); + <>; encode(#ssh_msg_kexdh_reply{ public_host_key = Key, @@ -229,25 +246,23 @@ encode(#ssh_msg_kexdh_reply{ }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Signature), - ssh_bits:encode([?SSH_MSG_KEXDH_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]); + <>; encode(#ssh_msg_kex_dh_gex_request{ min = Min, n = N, max = Max }) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST, Min, N, Max], - [byte, uint32, uint32, uint32]); + <>; + encode(#ssh_msg_kex_dh_gex_request_old{n = N}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST_OLD, N], - [byte, uint32]); + <>; encode(#ssh_msg_kex_dh_gex_group{p = Prime, g = Generator}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_GROUP, Prime, Generator], - [byte, mpint, mpint]); + <>; encode(#ssh_msg_kex_dh_gex_init{e = Public}) -> - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_INIT, Public], [byte, mpint]); + <>; encode(#ssh_msg_kex_dh_gex_reply{ %% Will be private key encode_host_key extracts only the public part! @@ -257,26 +272,26 @@ encode(#ssh_msg_kex_dh_gex_reply{ }) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Signature), - ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]); + <>; encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> - ssh_bits:encode([?SSH_MSG_KEX_ECDH_INIT, Q_c], [byte, mpint]); + <>; encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) -> EncKey = public_key:ssh_encode(Key, ssh2_pubkey), EncSign = encode_signature(Key, Sign), - ssh_bits:encode([?SSH_MSG_KEX_ECDH_REPLY, EncKey, Q_s, EncSign], [byte, binary, mpint, binary]); + <>; encode(#ssh_msg_ignore{data = Data}) -> - ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]); + <>; encode(#ssh_msg_unimplemented{sequence = Seq}) -> - ssh_bits:encode([?SSH_MSG_UNIMPLEMENTED, Seq], [byte, uint32]); + <>; encode(#ssh_msg_debug{always_display = Bool, message = Msg, language = Lang}) -> - ssh_bits:encode([?SSH_MSG_DEBUG, Bool, Msg, Lang], [byte, boolean, string, string]). + <>. %% Connection Messages @@ -553,10 +568,10 @@ decode_signature(<>) -> encode_signature(#'RSAPublicKey'{}, Signature) -> - ssh_bits:encode(["ssh-rsa", Signature],[string, binary]); + <>), ?Ebinary(Signature)>>; encode_signature({_, #'Dss-Parms'{}}, Signature) -> - ssh_bits:encode(["ssh-dss", Signature],[string, binary]); + <>), ?Ebinary(Signature)>>; encode_signature({#'ECPoint'{}, {namedCurve,OID}}, Signature) -> CurveName = public_key:oid2ssh_curvename(OID), - ssh_bits:encode([<<"ecdsa-sha2-",CurveName/binary>>, Signature], [binary,binary]). + <>), ?Ebinary(Signature)>>. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 18037b8461..a648c7af3d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -52,6 +52,14 @@ -export([pack/3]). -export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove +-define(Estring(X), ?STRING((if is_binary(X) -> X; + is_list(X) -> list_to_binary(X); + X==undefined -> <<>> + end))). +-define(Empint(X), (ssh_bits:mpint(X))/binary ). +-define(Ebinary(X), ?STRING(X) ). +-define(Euint32(X), ?UINT32(X) ). + %%%---------------------------------------------------------------------------- %%% %%% There is a difference between supported and default algorithms. The @@ -1084,7 +1092,7 @@ sign(SigData, Hash, #'DSAPrivateKey'{} = Key) -> sign(SigData, Hash, Key = #'ECPrivateKey'{}) -> DerEncodedSign = public_key:sign(SigData, Hash, Key), #'ECDSA-Sig-Value'{r=R, s=S} = public_key:der_decode('ECDSA-Sig-Value', DerEncodedSign), - ssh_bits:encode([R,S], [mpint,mpint]); + <>; sign(SigData, Hash, Key) -> public_key:sign(SigData, Hash, Key). @@ -1584,21 +1592,16 @@ hash(K, H, Ki, N, HASH) -> kex_h(SSH, Key, E, F, K) -> KeyBin = public_key:ssh_encode(Key, ssh2_pubkey), - L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version, - SSH#ssh.c_keyinit, SSH#ssh.s_keyinit, - KeyBin, E,F,K], - [string,string,binary,binary,binary, - mpint,mpint,mpint]), + L = <>, crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). -%% crypto:hash(sha,L). kex_h(SSH, Curve, Key, Q_c, Q_s, K) -> KeyBin = public_key:ssh_encode(Key, ssh2_pubkey), - L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version, - SSH#ssh.c_keyinit, SSH#ssh.s_keyinit, - KeyBin, Q_c, Q_s, K], - [string,string,binary,binary,binary, - mpint,mpint,mpint]), + L = <>, crypto:hash(sha(Curve), L). kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> @@ -1607,21 +1610,14 @@ kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> %% flag from 'ssh_msg_kex_dh_gex_request_old' %% It was like this before that message was supported, %% why? - Ts = [string,string,binary,binary,binary, - uint32, - mpint,mpint,mpint,mpint,mpint], - ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version, - SSH#ssh.c_keyinit,SSH#ssh.s_keyinit, - KeyBin, NBits, Prime, Gen, E,F,K], - Ts); + <>; true -> - Ts = [string,string,binary,binary,binary, - uint32,uint32,uint32, - mpint,mpint,mpint,mpint,mpint], - ssh_bits:encode([SSH#ssh.c_version,SSH#ssh.s_version, - SSH#ssh.c_keyinit,SSH#ssh.s_keyinit, - KeyBin, Min, NBits, Max, - Prime, Gen, E,F,K], Ts) + <> end, crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index fe197f8672..6b78a32a9b 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -307,7 +307,7 @@ no_common_alg_client_disconnects(Config) -> {send, hello}, {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, #ssh_msg_kexinit{ % with unsupported "SOME-UNSUPPORTED" - cookie = 247381486335508958743193106082599558706, + cookie = <<80,158,95,51,174,35,73,130,246,141,200,49,180,190,82,234>>, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = ["SOME-UNSUPPORTED"], % SIC! encryption_algorithms_client_to_server = ["aes128-ctr"], -- cgit v1.2.3 From 1bb8e4ae6eaf2f18d3b2ccc8e77cd7228e1c6e8a Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Thu, 14 Jan 2016 10:39:17 +0100 Subject: ssh: Experimental options for ssh_sftp:start_channel to set packet_size or window_size --- lib/ssh/src/ssh_sftp.erl | 28 ++++++++++++++++------------ lib/ssh/src/ssh_xfer.erl | 22 ++++++++++++++++------ 2 files changed, 32 insertions(+), 18 deletions(-) diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index dbacf730cc..eb99406626 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -99,8 +99,8 @@ start_channel(Host) when is_list(Host) -> start_channel(Host, []). start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), - {_, SftpOpts} = handle_options(Opts, [], []), - case ssh_xfer:attach(Cm, []) of + {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), + case ssh_xfer:attach(Cm, [], ChanOpts) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of @@ -123,9 +123,9 @@ start_channel(Cm, Opts) when is_pid(Cm) -> start_channel(Host, Opts) -> start_channel(Host, 22, Opts). start_channel(Host, Port, Opts) -> - {SshOpts, SftpOpts} = handle_options(Opts, [], []), + {SshOpts, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), Timeout = proplists:get_value(timeout, SftpOpts, infinity), - case ssh_xfer:connect(Host, Port, SshOpts, Timeout) of + case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of @@ -842,14 +842,18 @@ terminate(_Reason, State) -> %%==================================================================== %% Internal functions %%==================================================================== -handle_options([], Sftp, Ssh) -> - {Ssh, Sftp}; -handle_options([{timeout, _} = Opt | Rest], Sftp, Ssh) -> - handle_options(Rest, [Opt | Sftp], Ssh); -handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Ssh) -> - handle_options(Rest, [Opt | Sftp], Ssh); -handle_options([Opt | Rest], Sftp, Ssh) -> - handle_options(Rest, Sftp, [Opt | Ssh]). +handle_options([], Sftp, Chan, Ssh) -> + {Ssh, Chan, Sftp}; +handle_options([{timeout, _} = Opt | Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, [Opt|Sftp], Chan, Ssh); +handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, [Opt|Sftp], Chan, Ssh); +handle_options([{window_size, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, [Opt|Chan], Ssh); +handle_options([{packet_size, _} = Opt| Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, [Opt|Chan], Ssh); +handle_options([Opt|Rest], Sftp, Chan, Ssh) -> + handle_options(Rest, Sftp, Chan, [Opt|Ssh]). call(Pid, Msg, TimeOut) -> ssh_channel:call(Pid, {{timeout, TimeOut}, Msg}, infinity). diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index b8dff1c533..e7dd8e7098 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -24,7 +24,7 @@ -module(ssh_xfer). --export([attach/2, connect/3, connect/4]). +-export([attach/2, attach/3, connect/3, connect/4, connect/5]). -export([open/6, opendir/3, readdir/3, close/3, read/5, write/5, rename/5, remove/3, mkdir/4, rmdir/3, realpath/3, extended/4, stat/4, fstat/4, lstat/4, setstat/4, @@ -51,24 +51,34 @@ -define(XFER_WINDOW_SIZE, 4*?XFER_PACKET_SIZE). attach(CM, Opts) -> - open_xfer(CM, Opts). + open_xfer(CM, Opts, []). + +attach(CM, Opts, ChanOpts) -> + open_xfer(CM, Opts, ChanOpts). + connect(Host, Port, Opts) -> case ssh:connect(Host, Port, Opts) of - {ok, CM} -> open_xfer(CM, Opts); + {ok, CM} -> open_xfer(CM, Opts, []); Error -> Error end. connect(Host, Port, Opts, Timeout) -> + connect(Host, Port, Opts, [], Timeout). + +connect(Host, Port, Opts, ChanOpts, Timeout) -> case ssh:connect(Host, Port, Opts, Timeout) of - {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts]); + {ok, CM} -> open_xfer(CM, [{timeout, Timeout}|Opts], ChanOpts); {error, Timeout} -> {error, timeout}; Error -> Error end. -open_xfer(CM, Opts) -> + +open_xfer(CM, Opts, ChanOpts) -> TMO = proplists:get_value(timeout, Opts, infinity), - case ssh_connection:session_channel(CM, ?XFER_WINDOW_SIZE, ?XFER_PACKET_SIZE, TMO) of + WindowSize = proplists:get_value(window_size, ChanOpts, ?XFER_WINDOW_SIZE), + PacketSize = proplists:get_value(packet_size, ChanOpts, ?XFER_PACKET_SIZE), + case ssh_connection:session_channel(CM, WindowSize, PacketSize, TMO) of {ok, ChannelId} -> {ok, ChannelId, CM}; Error -> -- cgit v1.2.3 From 8abcda0fa16bb06db5020f5dcd22e09aa37f412a Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Fri, 15 Jan 2016 17:57:28 +0100 Subject: ssh: Adjusted default packet and window sizes --- lib/ssh/src/ssh_connect.hrl | 5 +++-- lib/ssh/src/ssh_xfer.erl | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 9f9f3de8fa..0c9ddad641 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -24,8 +24,9 @@ -type channel_id() :: integer(). --define(DEFAULT_PACKET_SIZE, 32768). --define(DEFAULT_WINDOW_SIZE, 2*?DEFAULT_PACKET_SIZE). +-define(DEFAULT_PACKET_SIZE, 65536). +-define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). + -define(DEFAULT_TIMEOUT, 5000). -define(MAX_PROTO_VERSION, 255). diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index e7dd8e7098..259dc71aa5 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -47,8 +47,8 @@ -define(is_set(F, Bits), ((F) band (Bits)) == (F)). --define(XFER_PACKET_SIZE, 32768). --define(XFER_WINDOW_SIZE, 4*?XFER_PACKET_SIZE). +-define(XFER_PACKET_SIZE, 65536). +-define(XFER_WINDOW_SIZE, 20*?XFER_PACKET_SIZE). attach(CM, Opts) -> open_xfer(CM, Opts, []). -- cgit v1.2.3 From 52738d8bee488c262cf514ce4df49e87dfa47bc3 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 18 Jan 2016 18:47:30 +0100 Subject: erts: Fix race between receive timeout and exit signal Must re-read 'state' after seizing proc locks as other thread may have set EXITING. --- erts/emulator/beam/erl_process.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 7b3d12ce09..d767e1bb5a 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9674,6 +9674,8 @@ Process *schedule(Process *p, int calls) erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + state = erts_smp_atomic32_read_nob(&p->state); + if (erts_sched_stat.enabled) { int prio; UWord old = ERTS_PROC_SCHED_ID(p, -- cgit v1.2.3 From 693db9ef9c5a67b36215f21c32f91a986fc5630d Mon Sep 17 00:00:00 2001 From: Steve Vinoski Date: Mon, 18 Jan 2016 14:04:24 -0500 Subject: Fix dirty scheduler check in handle_aux_work --- erts/emulator/beam/erl_process.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 96d9a2f8b4..dd8bc9a698 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2239,7 +2239,7 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) erts_aint32_t aux_work = orig_aux_work; erts_aint32_t ignore = 0; - ASSERT(!ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #ifdef ERTS_SMP haw_thr_prgr_current_reset(awdp); #endif -- cgit v1.2.3 From f6c266765cfd48416000e49f0043827d42e0e83f Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 19 Jan 2016 16:22:44 +0100 Subject: erts: Ignore unexpected messages to erts_code_purger --- erts/preloaded/ebin/erts_code_purger.beam | Bin 8884 -> 8768 bytes erts/preloaded/src/erts_code_purger.erl | 3 +-- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index ca6c8570ed..227d96d4c8 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index e492ba1812..a64860bec8 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -40,8 +40,7 @@ loop() -> Res = do_soft_purge(Mod), From ! {reply, soft_purge, Res, Ref}; - M -> - erlang:display({"erts_code_purger got msg", M}) + _Other -> ignore end, loop(). -- cgit v1.2.3 From f1e687312daa91591a2cee5038a2d9434e7db209 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 11 Dec 2015 12:04:56 +0100 Subject: stdlib: Correct a type --- lib/stdlib/src/io.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 5dc8b4541e..f510f61e9f 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -444,7 +444,7 @@ scan_erl_form(Io, Prompt, Pos0, Options) -> %% Parsing Erlang code. -type parse_ret() :: {'ok', - ExprList :: erl_parse:abstract_expr(), + ExprList :: [erl_parse:abstract_expr()], EndLocation :: location()} | {'eof', EndLocation :: location()} | {'error', -- cgit v1.2.3 From 2bf8c4726dfdf94bd6c190f1236c33a064238e02 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 11 Dec 2015 12:00:36 +0100 Subject: syntax_tools: Correct a type --- lib/syntax_tools/src/erl_recomment.erl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 72e1e2d2f5..5ce533285d 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -611,12 +611,15 @@ expand_comment(C) -> attrs :: erl_syntax:syntaxTreeAttributes(), precomments = [] :: [erl_syntax:syntaxTree()], postcomments = [] :: [erl_syntax:syntaxTree()], - subtrees = [] :: [erl_syntax:syntaxTree()]}). + subtrees = [] :: [extendedSyntaxTree()]}). + -record(list, {min = 0 :: integer(), max = 0 :: integer(), subtrees = [] :: [erl_syntax:syntaxTree()]}). +-type extendedSyntaxTree() :: #tree{} | #leaf{} | #list{}. + leaf_node(Min, Max, Value) -> #leaf{min = Min, max = Max, -- cgit v1.2.3 From 39dc426b3ee91cb1d2628f217c83147354663cc0 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 16 Dec 2015 14:31:41 +0100 Subject: doc: Update a refman example --- system/doc/reference_manual/expressions.xml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 893398b71b..e98fcbcbb9 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -245,13 +245,13 @@ lists:keysearch(Name, 1, List) handle(Msg, State) spawn(m, init, [])

Examples where ExprF is a fun:

- -Fun1 = fun(X) -> X+1 end -Fun1(3) -=> 4 - -fun lists:append/2([1,2], [3,4]) -=> [1,2,3,4] + 
+1> Fun1 = fun(X) -> X+1 end,
+Fun1(3).
+4
+2> fun lists:append/2([1,2], [3,4]).
+[1,2,3,4]
+3>

Notice that when calling a local function, there is a difference between using the implicitly or fully qualified function name. @@ -1004,7 +1004,7 @@ M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.

A badmatch exception.

-

This is if it is used in the context of the matching operator +

This is if it is used in the context of the match operator as in the example.

Or resulting in the next clause being tested in function heads and @@ -1085,7 +1085,7 @@ Ei = Value |

Used in a bit string construction, Value is an expression that is to evaluate to an integer, float, or bit string. If the expression is not a single literal or variable, it - is to be enclosed in parenthesis.

+ is to be enclosed in parentheses.

Used in a bit string matching, Value must be a variable, or an integer, float, or string.

@@ -1319,7 +1319,7 @@ catch Expr {'EXIT',{badarith,[...]}}

Notice that catch has low precedence and catch subexpressions often needs to be enclosed in a block - expression or in parenthesis:

+ expression or in parentheses:

 3> A = catch 1+2.
 ** 1: syntax error before: 'catch' **
-- 
cgit v1.2.3


From 3bd648f66080d1074533ba18fece0ea7de568d45 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 17 Dec 2015 12:09:24 +0100
Subject: dialyzer: Improve a type

---
 lib/dialyzer/src/dialyzer_utils.erl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 7fe982a992..557e10eed7 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -83,7 +83,7 @@ print_types1([{record, _Name} = Key|T], RecDict) ->
 
 %% ----------------------------------------------------------------------------
 
--type abstract_code() :: [tuple()]. %% XXX: import from somewhere
+-type abstract_code() :: [erl_parse:abstract_form()].
 -type comp_options()  :: [compile:option()].
 -type mod_or_fname()  :: module() | file:filename().
 -type fa()            :: {atom(), arity()}.
-- 
cgit v1.2.3


From 034e28c340d38a34c0e00590321380c407ff5faf Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 17 Dec 2015 12:29:51 +0100
Subject: hipe: Improve types

---
 lib/hipe/cerl/erl_types.erl | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 67cdcd35e3..69654088d5 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -316,7 +316,7 @@
 %% Auxiliary types and convenient macros
 %%
 
--type parse_form() :: {atom(), _, _} | {atom(), _, _, _} | {'op', _, _, _, _}. %% XXX: Temporarily
+-type parse_form() :: erl_parse:abstract_expr().
 -type rng_elem()   :: 'pos_inf' | 'neg_inf' | integer().
 
 -record(int_set, {set :: [integer()]}).
@@ -365,8 +365,8 @@
 -type type_key()     :: {'type' | 'opaque', atom(), arity()}.
 -type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}].
 -type type_value()   :: {module(), erl_type(), atom()}.
--type type_table() :: dict:dict(record_key(), record_value())
-                    | dict:dict(type_key(), type_value()).
+-type type_table() :: dict:dict(record_key() | type_key(),
+                                record_value() | type_value()).
 
 -type var_table() :: dict:dict(atom(), erl_type()).
 
-- 
cgit v1.2.3


From 130eb1e9f3af384f13c38e93365c5917f25fd798 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 17 Dec 2015 15:49:33 +0100
Subject: compiler: Improve type and specs

---
 lib/compiler/src/compile.erl | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index b61c104b3c..72f1a767ed 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -40,6 +40,8 @@
 
 %%----------------------------------------------------------------------
 
+-type abstract_code() :: [erl_parse:abstract_form()].
+
 -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}.
 
 -type err_info() :: {erl_anno:line() | 'none',
@@ -48,6 +50,9 @@
 -type warnings() :: [{file:filename(), [err_info()]}].
 -type mod_ret()  :: {'ok', module()}
                   | {'ok', module(), cerl:c_module()} %% with option 'to_core'
+                  | {'ok',                            %% with option 'to_pp'
+                     module() | [],                   %% module() if 'to_exp'
+                     abstract_code()}
                   | {'ok', module(), warnings()}.
 -type bin_ret()  :: {'ok', module(), binary()}
                   | {'ok', module(), binary(), warnings()}.
@@ -78,7 +83,11 @@ file(File, Opts) when is_list(Opts) ->
 file(File, Opt) ->
     file(File, [Opt|?DEFAULT_OPTIONS]).
 
-forms(File) -> forms(File, ?DEFAULT_OPTIONS).
+-spec forms(abstract_code()) -> comp_ret().
+
+forms(Forms) -> forms(Forms, ?DEFAULT_OPTIONS).
+
+-spec forms(abstract_code(), [option()] | option()) -> comp_ret().
 
 forms(Forms, Opts) when is_list(Opts) ->
     do_compile({forms,Forms}, [binary|Opts++env_default_opts()]);
@@ -106,6 +115,8 @@ noenv_file(File, Opts) when is_list(Opts) ->
 noenv_file(File, Opt) ->
     noenv_file(File, [Opt|?DEFAULT_OPTIONS]).
 
+-spec noenv_forms(abstract_code(), [option()] | option()) -> comp_ret().
+
 noenv_forms(Forms, Opts) when is_list(Opts) ->
     do_compile({forms,Forms}, [binary|Opts]);
 noenv_forms(Forms, Opt) when is_atom(Opt) ->
-- 
cgit v1.2.3


From c92ec9ea35209d443c2fb6393a1610f94ffccc1c Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 17 Dec 2015 12:40:43 +0100
Subject: stdlib: Refine the types of the abstract format

---
 lib/stdlib/src/erl_parse.yrl | 414 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 410 insertions(+), 4 deletions(-)

diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index e07ab2efc2..a525c2ae82 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -527,12 +527,418 @@ Erlang code.
 -compile([{hipe,[{regalloc,linear_scan}]}]).
 
 -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0,
-              error_info/0]).
+              abstract_type/0, error_info/0]).
+
+%% Start of Abstract Format
+
+-type anno() :: erl_anno:anno().
+
+-type abstract_form() :: af_module()
+                       | af_behavior()
+                       | af_behaviour()
+                       | af_export()
+                       | af_import()
+                       | af_export_type()
+                       | af_optional_callbacks()
+                       | af_compile()
+                       | af_file()
+                       | af_record_decl()
+                       | af_type_decl()
+                       | af_function_spec()
+                       | af_wild_attribute()
+                       | af_function_decl().
+
+-type af_module() :: {'attribute', anno(), 'module', module()}.
+
+-type af_behavior() :: {'attribute', anno(), 'behavior', behaviour()}.
+
+-type af_behaviour() :: {'attribute', anno(), 'behaviour', behaviour()}.
+
+-type behaviour() :: atom().
+
+-type af_export() :: {'attribute', anno(), 'export', af_fa_list()}.
+
+-type af_import() :: {'attribute', anno(), 'import', af_fa_list()}.
+
+-type af_fa_list() :: [{function_name(), arity()}].
+
+-type af_export_type() :: {'attribute', anno(), 'export_type', af_ta_list()}.
+
+-type af_ta_list() :: [{type_name(), arity()}].
+
+-type af_optional_callbacks() ::
+        {'attribute', anno(), 'optional_callbacks', af_fa_list()}.
+
+-type af_compile() :: {'attribute', anno(), 'compile', any()}.
+
+-type af_file() :: {'attribute', anno(), 'file', {string(), anno()}}.
+
+-type af_record_decl() ::
+        {'attribute', anno(), 'record', {record_name(), [af_field_decl()]}}.
+
+-type af_field_decl() :: af_typed_field() | af_field().
+
+-type af_typed_field() ::
+        {'typed_record_field', af_field(), abstract_type()}.
+
+-type af_field() :: {'record_field', anno(), af_field_name()}
+                  | {'record_field', anno(), af_field_name(), abstract_expr()}.
+
+-type af_type_decl() :: {'attribute', anno(), type_attr(),
+                         {type_name(), abstract_type(), [af_variable()]}}.
+
+-type type_attr() :: 'opaque' | 'type'.
+
+-type af_function_spec() :: {'attribute', anno(), spec_attr(),
+                             {{function_name(), arity()},
+                              af_function_type_list()}}
+                          | {'attribute', anno(), 'spec',
+                             {{module(), function_name(), arity()},
+                              af_function_type_list()}}.
+
+-type spec_attr() :: 'callback' | 'spec'.
+
+-type af_wild_attribute() :: {'attribute', anno(), atom(), any()}.
+
+-type af_function_decl() ::
+        {'function', anno(), function_name(), arity(), af_clause_seq()}.
+
+-type abstract_expr() :: af_literal()
+                       | af_match(abstract_expr())
+                       | af_variable()
+                       | af_tuple(abstract_expr())
+                       | af_nil()
+                       | af_cons(abstract_expr())
+                       | af_bin(abstract_expr())
+                       | af_binary_op(abstract_expr())
+                       | af_unary_op(abstract_expr())
+                       | af_record_access(abstract_expr())
+                       | af_record_update(abstract_expr())
+                       | af_record_index()
+                       | af_record_field_access(abstract_expr())
+                       | af_map_access(abstract_expr())
+                       | af_map_update(abstract_expr())
+                       | af_catch()
+                       | af_local_call()
+                       | af_remote_call()
+                       | af_list_comprehension()
+                       | af_binary_comprehension()
+                       | af_block()
+                       | af_if()
+                       | af_case()
+                       | af_try()
+                       | af_receive()
+                       | af_local_fun()
+                       | af_remote_fun()
+                       | af_fun()
+                       | af_named_fun().
+
+-type af_record_update(T) :: {'record',
+                              anno(),
+                              abstract_expr(),
+                              record_name(),
+                              [af_record_field(T)]}.
+
+-type af_catch() :: {'catch', anno(), abstract_expr()}.
+
+-type af_local_call() :: {'call', anno(), af_local_function(), af_args()}.
+
+-type af_remote_call() :: {'call', anno(), af_remote_function(), af_args()}.
+
+-type af_args() :: [abstract_expr()].
+
+-type af_local_function() :: abstract_expr().
+
+-type af_remote_function() ::
+        {'remote', anno(), abstract_expr(), abstract_expr()}.
+
+-type af_list_comprehension() ::
+        {'lc', anno(), af_template(), af_qualifier_seq()}.
+
+-type af_binary_comprehension() ::
+        {'bc', anno(), af_template(), af_qualifier_seq()}.
+
+-type af_template() :: abstract_expr().
+
+-type af_qualifier_seq() :: [af_qualifier()].
+
+-type af_qualifier() :: af_generator() | af_filter().
+
+-type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()}
+                      | {'b_generate', anno(), af_pattern(), abstract_expr()}.
+
+-type af_filter() :: abstract_expr().
+
+-type af_block() :: {'block', anno(), af_body()}.
+
+-type af_if() :: {'if', anno(), af_clause_seq()}.
+
+-type af_case() :: {'case', anno(), abstract_expr(), af_clause_seq()}.
+
+-type af_try() :: {'try',
+                   anno(),
+                   af_body() | [],
+                   af_clause_seq() | [],
+                   af_clause_seq() | [],
+                   af_body() | []}.
+
+-type af_clause_seq() :: [af_clause(), ...].
+
+-type af_receive() ::
+        {'receive', anno(), af_clause_seq()}
+      | {'receive', anno(), af_clause_seq(), abstract_expr(), af_body()}.
+
+-type af_local_fun() ::
+        {'fun', anno(), {'function', function_name(), arity()}}.
+
+-type af_remote_fun() ::
+        {'fun', anno(), {'function', module(), function_name(), arity()}}
+      | {'fun', anno(), {'function', af_atom(), af_atom(), af_integer()}}.
+
+-type af_fun() :: {'fun', anno(), {'clauses', af_clause_seq()}}.
+
+-type af_named_fun() :: {'named_fun', anno(), fun_name(), af_clause_seq()}.
+
+-type fun_name() :: atom().
+
+-type abstract_clause() :: af_clause().
+
+-type af_clause() ::
+        {'clause', anno(), [af_pattern()], af_guard_seq(), af_body()}.
+
+-type af_body() :: [abstract_expr(), ...].
+
+-type af_guard_seq() :: [af_guard()].
+
+-type af_guard() :: [af_guard_test(), ...].
+
+-type af_guard_test() :: af_literal()
+                       | af_variable()
+                       | af_tuple(af_guard_test())
+                       | af_nil()
+                       | af_cons(af_guard_test())
+                       | af_bin(af_guard_test())
+                       | af_binary_op(af_guard_test())
+                       | af_unary_op(af_guard_test())
+                       | af_record_access(af_guard_test())
+                       | af_record_index()
+                       | af_record_field_access(af_guard_test())
+                       | af_map_access(abstract_expr()) % FIXME
+                       | af_map_update(abstract_expr()) % FIXME
+                       | af_guard_call()
+                       | af_remote_guard_call().
+
+-type af_record_field_access(T) ::
+        {'record_field', anno(), T, record_name(), af_field_name()}.
+
+-type af_map_access(T) :: {'map', anno(), [af_map_field(T)]}.
+
+-type af_map_update(T) :: {'map', anno(), T, [af_map_field(T)]}.
+
+-type af_map_field(T) :: af_map_field_assoc(T) | af_map_field_exact(T).
+
+-type af_map_field_assoc(T) :: {'map_field_assoc', anno(), T, T}.
+
+-type af_map_field_exact(T) :: {'map_field_exact', anno(), T, T}.
+
+-type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}.
+
+-type af_remote_guard_call() ::
+        {'call', anno(),
+         {'remote', anno(), af_lit_atom('erlang'), af_atom()},
+         [af_guard_test()]}.
+
+-type af_pattern() :: af_literal()
+                    | af_match(af_pattern())
+                    | af_variable()
+                    | af_tuple(af_pattern())
+                    | af_nil()
+                    | af_cons(af_pattern())
+                    | af_bin(af_pattern())
+                    | af_binary_op(af_pattern())
+                    | af_unary_op(af_pattern())
+                    | af_record_access(af_pattern())
+                    | af_record_index()
+                    | af_map_pattern().
+
+-type af_record_index() ::
+        {'record_index', anno(), record_name(), af_field_name()}.
+
+-type af_record_access(T) ::
+        {'record', anno(), record_name(), [af_record_field(T)]}.
+
+-type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}.
+
+-type af_map_pattern() ::
+        {'map', anno(), [af_map_field_exact(abstract_expr)]}. % FIXME?
+
+-type abstract_type() :: af_annotated_type()
+                       | af_atom()
+                       | af_bitstring_type()
+                       | af_empty_list_type()
+                       | af_fun_type()
+                       | af_integer_range_type()
+                       | af_map_type()
+                       | af_predefined_type()
+                       | af_record_type()
+                       | af_remote_type()
+                       | af_singleton_integer_type()
+                       | af_tuple_type()
+                       | af_type_union()
+                       | af_type_variable()
+                       | af_user_defined_type().
+
+-type af_annotated_type() ::
+        {'ann_type', anno(), [af_anno() | abstract_type()]}. % [Var, Type]
+
+-type af_anno() :: af_variable().
+
+-type af_bitstring_type() ::
+        {'type', anno(), 'binary', [af_singleton_integer_type()]}.
+
+-type af_empty_list_type() :: {'type', anno(), 'nil', []}.
+
+-type af_fun_type() :: {'type', anno(), 'fun', []}
+                     | {'type', anno(), 'fun', [{'type', anno(), 'any'} |
+                                                abstract_type()]}
+                     | {'type', anno(), 'fun', af_function_type()}.
+
+-type af_integer_range_type() ::
+        {'type', anno(), 'range', [af_singleton_integer_type()]}.
+
+-type af_map_type() :: {'type', anno(), 'map', 'any'}
+                     | {'type', anno(), 'map', [af_map_pair_type()]}.
+
+-type af_map_pair_type() ::
+        {'type', anno(), 'map_field_assoc', [abstract_type()]}.
+
+-type af_predefined_type() ::
+        {'type', anno(), type_name(),  [abstract_type()]}.
+
+-type af_record_type() ::
+        {'type', anno(), 'record', [(Name :: af_atom()) % [Name, T1, ... Tk]
+                                    | af_record_field_type()]}.
+
+-type af_record_field_type() ::
+        {'type', anno(), 'field_type', [(Name :: af_atom()) |
+                                        abstract_type()]}. % [Name, Type]
+
+-type af_remote_type() ::
+        {'remote_type', anno(), [(Module :: af_atom()) |
+                                 (TypeName :: af_atom()) |
+                                 [abstract_type()]]}. % [Module, Name, [T]]
+
+-type af_tuple_type() :: {'type', anno(), 'tuple', 'any'}
+                       | {'type', anno(), 'tuple', [abstract_type()]}.
+
+-type af_type_union() :: {'type', anno(), 'union', [abstract_type()]}.
+
+-type af_type_variable() :: {'var', anno(), atom()}. % except '_'
+
+-type af_user_defined_type() ::
+        {'user_type', anno(), type_name(),  [abstract_type()]}.
+
+-type af_function_type_list() :: [af_constrained_function_type() |
+                                  af_function_type()].
+
+-type af_constrained_function_type() ::
+        {'type', anno(), 'bounded_fun', [af_function_type() | % [Ft, Fc]
+                                         af_function_constraint()]}.
+
+-type af_function_type() ::
+        {'type', anno(), 'fun',
+         [{'type', anno(), 'product', [abstract_type()]} | abstract_type()]}.
+
+-type af_function_constraint() :: [af_constraint()].
+
+-type af_constraint() :: {'type', anno(), 'constraint',
+                          af_lit_atom('is_subtype'),
+                          [af_type_variable() | abstract_type()]}. % [V, T]
+
+-type af_singleton_integer_type() :: af_integer()
+                                   | af_unary_op(af_singleton_integer_type())
+                                   | af_binary_op(af_singleton_integer_type()).
+
+-type af_literal() :: af_atom() | af_integer() | af_float() | af_string().
+
+-type af_atom() :: af_lit_atom(atom()).
+
+-type af_lit_atom(A) :: {'atom', anno(), A}.
+
+-type af_integer() :: {'integer', anno(), non_neg_integer()}.
+
+-type af_float() :: {'float', anno(), float()}.
+
+-type af_string() :: {'string', anno(), string()}.
+
+-type af_match(T) :: {'match', anno(), af_pattern(), T}.
+
+-type af_variable() :: {'var', anno(), atom()}. % | af_anon_variable()
+
+%-type af_anon_variable() :: {'var', anno(), '_'}.
+
+-type af_tuple(T) :: {'tuple', anno(), [T]}.
+
+-type af_nil() :: {'nil', anno()}.
+
+-type af_cons(T) :: {'cons', anno(), T, T}.
+
+-type af_bin(T) :: {'bin', anno(), [af_binelement(T)]}.
+
+-type af_binelement(T) :: {'bin_element',
+                           anno(),
+                           T,
+                           af_binelement_size(),
+                           type_specifier_list()}.
+
+-type af_binelement_size() :: 'default' | abstract_expr().
+
+-type af_binary_op(T) :: {'op', anno(), binary_op(), T, T}.
+
+-type binary_op() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-'
+                   | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++'
+                   | '--' | '==' | '/=' | '=<' | '<'  | '>=' | '>' | '=:='
+                   | '=/='.
+
+-type af_unary_op(T) :: {'op', anno(), unary_op(), T}.
+
+-type unary_op() :: '+' | '*' | 'bnot' | 'not'.
+
+%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
+-type type_specifier_list() :: 'default' | [type_specifier(), ...].
+
+-type type_specifier() :: type()
+                        | signedness()
+                        | endianness()
+                        | unit().
+
+-type type() :: 'integer'
+              | 'float'
+              | 'binary'
+              | 'bytes'
+              | 'bitstring'
+              | 'bits'
+              | 'utf8'
+              | 'utf16'
+              | 'utf32'.
+
+-type signedness() :: 'signed' | 'unsigned'.
+
+-type endianness() :: 'big' | 'little' | 'native'.
+
+-type unit() :: {'unit', 1..256}.
+
+-type record_name() :: atom().
+
+-type af_field_name() :: af_atom().
+
+-type function_name() :: atom().
+
+-type type_name() :: atom().
+
+%% End of Abstract Format
 
 %% XXX. To be refined.
--type abstract_clause() :: term().
--type abstract_expr() :: term().
--type abstract_form() :: term().
 -type error_description() :: term().
 -type error_info() :: {erl_anno:line(), module(), error_description()}.
 -type token() :: erl_scan:token().
-- 
cgit v1.2.3


From b21f71c1bb79d3979505ad6ad1e496472b38c6b9 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Thu, 17 Dec 2015 12:41:44 +0100
Subject: stdlib: Update erl_parse(3)

Calls to map_anno(), fold_anno(), and mapfold_anno() with lists of
erl_parse trees have been replaced. Those functions accept lists of
erl_parse trees, but it was not the intention when the functions were
introduced, and it is not documented.
---
 lib/stdlib/doc/src/erl_parse.xml | 120 ++++++++++++++++++++++++---------------
 lib/stdlib/src/erl_lint.erl      |   5 ++
 lib/stdlib/src/erl_parse.yrl     |  25 ++++----
 lib/stdlib/src/qlc_pt.erl        |  34 ++++++-----
 4 files changed, 114 insertions(+), 70 deletions(-)

diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml
index 0938b5dec3..13be488c33 100644
--- a/lib/stdlib/doc/src/erl_parse.xml
+++ b/lib/stdlib/doc/src/erl_parse.xml
@@ -4,7 +4,7 @@
 
   

     
-      19962015
+      19962016
       Ericsson AB. All Rights Reserved.
     
     
@@ -44,20 +44,32 @@
   
   
     
-      
-      
Parse tree for Erlang clause.

+      abstract_clause()
+      

+        Abstract form of an Erlang clause.

       
     
     
-      
-      
Parse tree for Erlang expression.

+      abstract_expr()
+      

+        Abstract form of an Erlang expression.

       
     
     
-      
-      
Parse tree for Erlang form.

+      abstract_form()
+      

+        Abstract form of an Erlang form.

       
     
+    
+      abstract_type()
+      

+        Abstract form of an Erlang type.

+      
+    
+    
+      
+    
     
       
     
@@ -180,7 +192,7 @@
         
Converts the Erlang data structure Data into an
           abstract form of type AbsTerm.

         
The Line option is the line that will
-          be assigned to each node of the abstract form.

+          be assigned to each node of AbsTerm.

         
The Encoding option is used for
           selecting which integer lists will be considered
           as strings. The default is to use the encoding returned by
@@ -196,47 +208,53 @@
     
       
       
-        Map a function over the annotations of an abstract form
+        Map a function over the annotations of a erl_parse tree
       
       
-        
Modifies the abstract form Abstr by applying
-          Fun on every collection of annotations of the
-          abstract form. The abstract form is traversed in a
-          depth-first, left-to-right, fashion.
+        
Modifies the erl_parse tree Abstr
+	  by applying Fun on each collection of
+	  annotations of the nodes of the erl_parse tree. The
+	  erl_parse tree is traversed in a depth-first,
+	  left-to-right, fashion.
         

       
     
     
       
       
-        Fold a function over the annotations of an abstract form
+        Fold a function over the annotations of a erl_parse tree
       
       
-        
Updates an accumulator by applying Fun on
-          every collection of annotations of the abstract form
-          Abstr. The first call to Fun has
-          AccIn as argument, and the returned accumulator
-          AccOut is passed to the next call, and so on.
-          The final value of the accumulator is returned. The abstract
-          form is traversed in a depth-first, left-to-right, fashion.
+        
Updates an accumulator by applying Fun on
+          each collection of annotations of the erl_parse tree
+          Abstr. The first call to
+          Fun has AccIn as
+          argument, and the returned accumulator
+          AccOut is passed to the next call, and
+          so on. The final value of the accumulator is returned. The
+          erl_parse tree is traversed in a depth-first, left-to-right,
+          fashion.
         

       
     
     
       
       
-        Map and fold a function over the annotations of an abstract form
+        Map and fold a function over the annotations of a
+        erl_parse tree
       
       
-        
Modifies the abstract form Abstr by applying
-          Fun on every collection of annotations of the
-          abstract form, while at the same time updating an
-          accumulator. The first call to Fun has
-          AccIn as second argument, and the returned
-          accumulator AccOut is passed to the next call,
-          and so on. The modified abstract form as well as the the
-          final value of the accumulator is returned. The abstract
-          form is traversed in a depth-first, left-to-right, fashion.
+        
Modifies the erl_parse tree Abstr
+	  by applying Fun on each collection of
+	  annotations of the nodes of the erl_parse tree, while
+	  at the same time updating an accumulator. The first call to
+	  Fun has AccIn as
+	  second argument, and the returned accumulator
+	  AccOut is passed to the next call, and
+	  so on. The modified erl_parse tree as well as the the
+	  final value of the accumulator are returned. The
+	  erl_parse tree is traversed in a depth-first,
+	  left-to-right, fashion.
         

       
     
@@ -246,12 +264,15 @@
         Create new annotations
       
       
-        
Creates an abstract form from a term which has the same
-          structure as an abstract form, but locations where the
-          abstract form has annotations. For each location, erl_anno:new/1 is
-          called, and the annotations replace the location.
+        
Assumes that Term is a term with the same
+          structure as a erl_parse tree, but with locations where a
+          erl_parse tree has collections of annotations.
+          Returns a erl_parse tree where each location L
+          has been replaced by the value returned by erl_anno:new(L).
+          The term Term is traversed in a
+          depth-first, left-to-right, fashion.
         

       
     
@@ -261,12 +282,14 @@
         Return annotations as terms
       
       
-        
Assumes that Term is a term with the same
-          structure as an abstract form, but with terms, T say, on
-          those places where an abstract form has annotations. Returns
-          an abstract form where every term T has been replaced by the
-          value returned by calling erl_anno:from_term(T). The
-          term Term is traversed in a depth-first,
+        
Assumes that Term is a term with the same
+          structure as a erl_parse tree, but with terms,
+          T say, where a erl_parse tree has collections
+          of annotations. Returns a erl_parse tree where each
+          term T has been replaced by the value returned by
+          
+          erl_anno:from_term(T). The term
+          Term is traversed in a depth-first,
           left-to-right, fashion.
         

       
@@ -277,10 +300,13 @@
         Return the representation of annotations
       
       
-        
Returns a term where every collection of annotations Anno of
-          Abstr has been replaced by the term returned by
-          calling erl_anno:to_term(Anno). The abstract form is
-          traversed in a depth-first, left-to-right, fashion.
+        
Returns a term where each collection of annotations
+          Anno of the nodes of the erl_parse tree
+          Abstr has been replaced by the term
+          returned by 
+          erl_anno:to_term(Anno). The
+          erl_parse tree is traversed in a depth-first,
+          left-to-right, fashion.
         

       
     
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 4a42754d92..9ef4acdf5f 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -696,7 +696,12 @@ set_form_file({function,L,N,A,C}, File) ->
 set_form_file(Form, _File) ->
     Form.
 
+set_file(Ts, File) when is_list(Ts) ->
+    [anno_set_file(T, File) || T <- Ts];
 set_file(T, File) ->
+    anno_set_file(T, File).
+
+anno_set_file(T, File) ->
     F = fun(Anno) -> erl_anno:set_file(File, Anno) end,
     erl_parse:map_anno(F, T).
 
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index a525c2ae82..b1c574ea60 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -2,7 +2,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -1489,11 +1489,16 @@ type_preop_prec('-') -> {600,700};
 type_preop_prec('bnot') -> {600,700};
 type_preop_prec('#') -> {700,800}.
 
+-type erl_parse_tree() :: abstract_clause()
+                        | abstract_expr()
+                        | abstract_form()
+                        | abstract_type().
+
 -spec map_anno(Fun, Abstr) -> NewAbstr when
       Fun :: fun((Anno) -> Anno),
       Anno :: erl_anno:anno(),
-      Abstr :: abstract_form() | abstract_expr(),
-      NewAbstr :: abstract_form() | abstract_expr().
+      Abstr :: erl_parse_tree(),
+      NewAbstr :: erl_parse_tree().
 
 map_anno(F0, Abstr) ->
     F = fun(A, Acc) -> {F0(A), Acc} end,
@@ -1506,8 +1511,8 @@ map_anno(F0, Abstr) ->
       Acc0 :: term(),
       AccIn :: term(),
       AccOut :: term(),
-      Abstr :: abstract_form() | abstract_expr(),
-      NewAbstr :: abstract_form() | abstract_expr().
+      Abstr :: erl_parse_tree(),
+      NewAbstr :: erl_parse_tree().
 
 fold_anno(F0, Acc0, Abstr) ->
     F = fun(A, Acc) -> {A, F0(A, Acc)} end,
@@ -1521,26 +1526,26 @@ fold_anno(F0, Acc0, Abstr) ->
       Acc1 :: term(),
       AccIn :: term(),
       AccOut :: term(),
-      Abstr :: abstract_form() | abstract_expr(),
-      NewAbstr :: abstract_form() | abstract_expr().
+      Abstr :: erl_parse_tree(),
+      NewAbstr :: erl_parse_tree().
 
 mapfold_anno(F, Acc0, Abstr) ->
     modify_anno1(Abstr, Acc0, F).
 
 -spec new_anno(Term) -> Abstr when
       Term :: term(),
-      Abstr :: abstract_form() | abstract_expr().
+      Abstr :: erl_parse_tree().
 
 new_anno(Term) ->
     map_anno(fun erl_anno:new/1, Term).
 
 -spec anno_to_term(Abstr) -> term() when
-      Abstr :: abstract_form() | abstract_expr().
+      Abstr :: erl_parse_tree().
 
 anno_to_term(Abstract) ->
     map_anno(fun erl_anno:to_term/1, Abstract).
 
--spec anno_from_term(Term) -> abstract_form() | abstract_expr() when
+-spec anno_from_term(Term) -> erl_parse_tree() when
       Term :: term().
 
 anno_from_term(Term) ->
diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl
index 9577d17a85..9f69cd5003 100644
--- a/lib/stdlib/src/qlc_pt.erl
+++ b/lib/stdlib/src/qlc_pt.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2004-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -200,7 +200,7 @@ exclude_integers_from_unique_line_numbers(Forms, NodeInfo) ->
 
 find_integers(Forms) ->
     F = fun(A) ->
-                Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms),
+                Fs1 = map_anno(fun(_) -> A end, Forms),
                 ordsets:from_list(integers(Fs1, []))
         end,
     ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))).
@@ -319,13 +319,13 @@ badarg(Forms, State) ->
     E0.
 
 lc_nodes(E, NodeInfo) ->
-    erl_parse:map_anno(fun(Anno) ->
-                               N = erl_anno:line(Anno),
-                               [{N, Data}] = ets:lookup(NodeInfo, N),
-                               NData = Data#{inside_lc => true},
-                               true = ets:insert(NodeInfo, {N, NData}),
-                               Anno
-                       end, E).
+    map_anno(fun(Anno) ->
+                     N = erl_anno:line(Anno),
+                     [{N, Data}] = ets:lookup(NodeInfo, N),
+                     NData = Data#{inside_lc => true},
+                     true = ets:insert(NodeInfo, {N, NData}),
+                     Anno
+             end, E).
 
 used_genvar_messages(MsL, S) ->
     [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]}
@@ -416,7 +416,7 @@ intro_anno(LC, Where, QId, NodeInfo) ->
                   true = ets:insert(NodeInfo, {Location,Data}),
                   Anno
           end,
-    erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)).
+    map_anno(Fun, save_anno(LC, NodeInfo)).
 
 compile_errors(FormsNoShadows) ->
     case compile_forms(FormsNoShadows, []) of
@@ -1650,7 +1650,7 @@ reset_anno(T) ->
     set_anno(T, anno0()).
 
 set_anno(T, A) ->
-    erl_parse:map_anno(fun(_L) -> A end, T).
+    map_anno(fun(_L) -> A end, T).
 
 -record(fstate, {state, bind_fun, imported}).
 
@@ -2609,7 +2609,7 @@ save_anno(Abstr, NodeInfo) ->
                 true = ets:insert(NodeInfo, Data),
                 erl_anno:new(N)
         end,
-    erl_parse:map_anno(F, Abstr).
+    map_anno(F, Abstr).
 
 next_slot(T) ->
     I = ets:update_counter(T, var_n, 1),
@@ -2633,7 +2633,7 @@ restore_anno(Abstr, NodeInfo) ->
                         Anno
                 end
         end,
-    erl_parse:map_anno(F, Abstr).
+    map_anno(F, Abstr).
 
 restore_loc(Location, #state{node_info = NodeInfo}) ->
   case ets:lookup(NodeInfo, Location) of
@@ -2872,6 +2872,14 @@ var_mapfold(F, A0, [E0 | Es0]) ->
 var_mapfold(_F, A, E) ->
     {E, A}.
 
+map_anno(F, AbstrList) when is_list(AbstrList) ->
+    [map_anno1(F, Abstr) || Abstr <- AbstrList];
+map_anno(F, Abstr) ->
+    map_anno1(F, Abstr).
+
+map_anno1(F, Abstr) ->
+    erl_parse:map_anno(F, Abstr).
+
 family_list(L) ->
     sofs:to_external(family(L)).
 
-- 
cgit v1.2.3


From 34e02fed50bbaa2af7b1828968b6ec02a54e98c8 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Wed, 20 Jan 2016 09:54:00 +0100
Subject: erts: Improve the documentation of the abstract format

---
 erts/doc/src/absform.xml | 240 ++++++++++++++++++++++++++---------------------
 1 file changed, 131 insertions(+), 109 deletions(-)

diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index 1c0c3e1319..3f47b3061b 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -4,7 +4,7 @@
 
   

     
-      20012015
+      20012016
       Ericsson AB. All Rights Reserved.
     
     
@@ -80,12 +80,15 @@
        Rep(F) = {attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}.
       If F is an attribute -export_type([Type_1/A_1, ..., Type_k/A_k]), then
        Rep(F) = {attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}.
+      If F is an attribute -optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k]), then
+       Rep(F) = {attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}.
       If F is an attribute -compile(Options), then
        Rep(F) = {attribute,LINE,compile,Options}.
       If F is an attribute -file(File,Line), then
        Rep(F) = {attribute,LINE,file,{File,Line}}.
       If F is a record declaration
-       -record(Name,{V_1, ..., V_k}), then Rep(F) =
+       -record(Name,{V_1, ..., V_k}),
+       where each V_i is a record field, then Rep(F) =
        {attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}.
        For Rep(V), see below.
       If F is a type declaration
@@ -173,12 +176,12 @@
 
   

     Patterns
-    
If Ps is a sequence of patterns P_1, ..., P_k, then
+    
If Ps is a sequence of patterns P_1, ..., P_k, then
       Rep(Ps) = [Rep(P_1), ..., Rep(P_k)]. Such sequences occur as the
       list of arguments to a function or fun.

     
Individual patterns are represented as follows:

     
-      If P is an atomic literal L, then Rep(P) = Rep(L).
+      If P is an atomic literal L, then Rep(P) = Rep(L).
       If P is a compound pattern P_1 = P_2, then
        Rep(P) = {match,LINE,Rep(P_1),Rep(P_2)}.
       If P is a variable pattern V, then
@@ -211,6 +214,10 @@
       {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}.
       If P is #Name.Field, then
        Rep(P) = {record_index,LINE,Name,Rep(Field)}.
+      If P is a map pattern #{A_1, ..., A_k}, where each
+       A_i is an association P_i_1 := P_i_2, then Rep(P) =
+       {map,LINE,[Rep(A_1), ..., Rep(A_k)]}. For Rep(A), see
+       below.
       If P is ( P_0 ), then
        Rep(P) = Rep(P_0),
        that is, patterns cannot be distinguished from their bodies.
@@ -221,11 +228,11 @@
 
   

     Expressions
-    
A body B is a sequence of expressions E_1, ..., E_k, and
-      Rep(B) = [Rep(E_1), ..., Rep(E_k)].

+    
A body B is a nonempty sequence of expressions E_1, ..., E_k,
+      and Rep(B) = [Rep(E_1), ..., Rep(E_k)].

     
An expression E is one of the following alternatives:

     
-      If P is an atomic literal L, then Rep(P) = Rep(L).
+      If E is an atomic literal L, then Rep(E) = Rep(L).
       If E is P = E_0, then
        Rep(E) = {match,LINE,Rep(P),Rep(E_0)}.
       If E is a variable V, then Rep(E) = {var,LINE,A},
@@ -256,14 +263,16 @@
        Rep(E) = {record_index,LINE,Name,Rep(Field)}.
       If E is E_0#Name.Field, then
        Rep(E) = {record_field,LINE,Rep(E_0),Name,Rep(Field)}.
-      If E is #{W_1, ..., W_k} where each
-       W_i is a map assoc or exact field, then Rep(E) =
-       {map,LINE,[Rep(W_1), ..., Rep(W_k)]}. For Rep(W), see
+      If E is a map creation #{A_1, ..., A_k},
+       where each A_i is an association E_i_1 => E_i_2
+       or E_i_1 := E_i_2, then Rep(E) =
+       {map,LINE,[Rep(A_1), ..., Rep(A_k)]}. For Rep(A), see
        below.
-      If E is E_0#{W_1, ..., W_k} where
-       W_i is a map assoc or exact field, then Rep(E) =
-       {map,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}.
-       For Rep(W), see below.
+      If E is a map update E_0#{A_1, ..., A_k},
+       where each A_i is an association E_i_1 => E_i_2
+       or E_i_1 := E_i_2, then Rep(E) =
+       {map,LINE,Rep(E_0),[Rep(A_1), ..., Rep(A_k)]}.
+       For Rep(A), see below.
       If E is catch E_0, then
        Rep(E) = {'catch',LINE,Rep(E_0)}.
       If E is E_0(E_1, ..., E_k), then
@@ -271,15 +280,15 @@
       If E is E_m:E_0(E_1, ..., E_k), then Rep(E) =
       {call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ...,  Rep(E_k)]}.
       
-      If E is a list comprehension [E_0 || W_1, ..., W_k],
-       where each W_i is a generator or a filter, then Rep(E) =
-       {lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}. For Rep(W), see
+      If E is a list comprehension [E_0 || Q_1, ..., Q_k],
+       where each Q_i is a qualifier, then Rep(E) =
+       {lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}. For Rep(Q), see
        below.
       If E is a binary comprehension
-       <<E_0 || W_1, ..., W_k>>,
-       where each W_i is a generator or a filter, then
-       Rep(E) = {bc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}.
-       For Rep(W), see below.
+       <<E_0 || Q_1, ..., Q_k>>,
+       where each Q_i is a qualifier, then
+       Rep(E) = {bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}.
+       For Rep(Q), see below.
       If E is begin B end, where B is a body, then
        Rep(E) = {block,LINE,Rep(B)}.
       If E is if Ic_1 ; ... ; Ic_k  end,
@@ -311,7 +320,7 @@
       {'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}.
       If E is try B of Cc_1 ; ... ; Cc_k  catch Tc_1 ; ... ; Tc_n after A end,
        where B and A are a bodies,
-       each Cc_i is a case clause and
+       each Cc_i is a case clause, and
        each Tc_j is a catch clause then
        Rep(E) =
       {'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1),  ..., Rep(Tc_n)],Rep(A)}.
@@ -328,10 +337,10 @@
        {'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}.
        (Before the R15 release: Rep(E) =
        {'fun',LINE,{function,Module,Name,Arity}}.)
-      If E is fun Fc_1 ; ... ; Fc_k end
+      If E is fun Fc_1 ; ... ; Fc_k end,
        where each Fc_i is a function clause then Rep(E) =
       {'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}.
-      If E is fun Name Fc_1 ; ... ; Name Fc_k end
+      If E is fun Name Fc_1 ; ... ; Name Fc_k end,
        where Name is a variable and each
        Fc_i is a function clause then Rep(E) =
        {named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}.
@@ -342,46 +351,43 @@
     
 
     

-      Generators and Filters
-      
When W is a generator or a filter (in the body of a list or
-       binary comprehension), then:

+      Qualifiers
+      
A qualifier Q is one of the following alternatives:

       
-        If W is a generator P <- E, where P is
+        If Q is a generator P <- E, where P is
 	 a pattern and E is an expression, then
-         Rep(W) = {generate,LINE,Rep(P),Rep(E)}.
-        If W is a generator P <= E, where P is
+         Rep(Q) = {generate,LINE,Rep(P),Rep(E)}.
+        If Q is a generator P <= E, where P is
 	 a pattern and E is an expression, then
-         Rep(W) = {b_generate,LINE,Rep(P),Rep(E)}.
-        If W is a filter E, which is an expression, then
-         Rep(W) = Rep(E).
+         Rep(Q) = {b_generate,LINE,Rep(P),Rep(E)}.
+        If Q is a filter E, where E is an expression, then
+         Rep(Q) = Rep(E).
       
     

 
     

       Binary Element Type Specifiers
       
A type specifier list TSL for a binary element is a sequence of type
-        specifiers TS_1 - ... - TS_k.
+        specifiers TS_1 - ... - TS_k, and
         Rep(TSL) = [Rep(TS_1), ..., Rep(TS_k)].

-      
When TS is a type specifier for a binary element, then:

       
-        If TS is an atom A, then Rep(TS) = A.
-        If TS is a couple A:Value where A is an atom
-	 and Value is an integer, then Rep(TS) =
-	 {A,Value}.
+        If TS is a type specifier A, where A is an atom,
+	 then Rep(TS) = A.
+        If TS is a type specifier A:Value,
+	 where A is an atom and Value is an integer,
+	 then Rep(TS) = {A,Value}.
       
     

 
     

-      Map Assoc and Exact Fields
-      
When W is an assoc or exact field (in the body of a map), then:

+      Associations
+      
An association A is one of the following alternatives:

       
-        If W is an assoc field K => V, where
-         K and V are both expressions,
-         then Rep(W) = {map_field_assoc,LINE,Rep(K),Rep(V)}.
+	If A is an association K => V,
+	 then Rep(A) = {map_field_assoc,LINE,Rep(K),Rep(V)}.
          
-        If W is an exact field K := V, where
-         K and V are both expressions,
-         then Rep(W) = {map_field_exact,LINE,Rep(K),Rep(V)}.
+	If A is an association K := V,
+         then Rep(A) = {map_field_exact,LINE,Rep(K),Rep(V)}.
          
       
     

@@ -393,37 +399,37 @@
       and catch clauses.

     
A clause C is one of the following alternatives:

     
-      If C is a function clause ( Ps ) -> B
+      If C is a function clause ( Ps ) -> B,
        where Ps is a pattern sequence and B is a body, then
        Rep(C) = {clause,LINE,Rep(Ps),[],Rep(B)}.
-      If C is a function clause ( Ps ) when Gs -> B
+      If C is a function clause ( Ps ) when Gs -> B,
        where Ps is a pattern sequence,
       Gs is a guard sequence and B is a body, then
        Rep(C) = {clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}.
-      If C is an if clause Gs -> B
+      If C is an if clause Gs -> B,
        where Gs is a guard sequence and B is a body, then
        Rep(C) = {clause,LINE,[],Rep(Gs),Rep(B)}.
-      If C is a case clause P -> B
+      If C is a case clause P -> B,
        where P is a pattern and B is a body, then
        Rep(C) = {clause,LINE,[Rep(P)],[],Rep(B)}.
-      If C is a case clause P when Gs -> B
+      If C is a case clause P when Gs -> B,
        where P is a pattern,
       Gs is a guard sequence and B is a body, then
        Rep(C) = {clause,LINE,[Rep(P)],Rep(Gs),Rep(B)}.
-      If C is a catch clause P -> B
+      If C is a catch clause P -> B,
        where P is a pattern and B is a body, then
        Rep(C) = {clause,LINE,[Rep({throw,P,_})],[],Rep(B)}.
-      If C is a catch clause X : P -> B
+      If C is a catch clause X : P -> B,
        where X is an atomic literal or a variable pattern,
-      P is a pattern and B is a body, then
+      P is a pattern, and B is a body, then
        Rep(C) = {clause,LINE,[Rep({X,P,_})],[],Rep(B)}.
-      If C is a catch clause P when Gs -> B
-       where P is a pattern, Gs is a guard sequence
+      If C is a catch clause P when Gs -> B,
+       where P is a pattern, Gs is a guard sequence,
        and B is a body, then
        Rep(C) = {clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}.
-      If C is a catch clause X : P when Gs -> B
+      If C is a catch clause X : P when Gs -> B,
        where X is an atomic literal or a variable pattern,
-      P is a pattern, Gs is a guard sequence
+      P is a pattern, Gs is a guard sequence,
        and B is a body, then
        Rep(C) = {clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}.
     
@@ -439,7 +445,7 @@
       [Rep(Gt_1), ..., Rep(Gt_k)].

     
A guard test Gt is one of the following alternatives:

     
-      If Gt is an atomic literal L, then Rep(Gt) = Rep(L).
+      If Gt is an atomic literal L, then Rep(Gt) = Rep(L).
       If Gt is a variable pattern V, then
        Rep(Gt) = {var,LINE,A}, where A is an atom with
        a printname consisting of the same characters as V.
@@ -467,15 +473,21 @@
        Rep(Gt) = {record_index,LINE,Name,Rep(Field)}.
       If Gt is Gt_0#Name.Field, then
        Rep(Gt) = {record_field,LINE,Rep(Gt_0),Name,Rep(Field)}.
+      If Gt is a map creation #{A_1, ..., A_k},
+       where each A_i is an association Gt_i_1 => Gt_i_2
+       or Gt_i_1 := Gt_i_2, then Rep(Gt) =
+       {map,LINE,[Rep(A_1), ..., Rep(A_k)]}. For Rep(A), see
+       above.
+      If Gt is a map update Gt_0#{A_1, ..., A_k}, where each
+       A_i is an association Gt_i_1 => Gt_i_2
+       or Gt_i_1 := Gt_i_2, then Rep(Gt) =
+       {map,LINE,Rep(Gt_0),[Rep(A_1), ..., Rep(A_k)]}.
+       For Rep(A), see above.
       If Gt is A(Gt_1, ..., Gt_k), where A is an atom, then
        Rep(Gt) = {call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}.
       If Gt is A_m:A(Gt_1, ..., Gt_k), where A_m is
        the atom erlang and A is an atom or an operator, then
        Rep(Gt) = {call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}.
-      If Gt is {A_m,A}(Gt_1, ..., Gt_k), where A_m is
-       the atom erlang and A is an atom or an operator, then
-       Rep(Gt) = {call,LINE,Rep({A_m,A}),[Rep(Gt_1), ..., Rep(Gt_k)]}.
-      
       If Gt is ( Gt_0 ), then
        Rep(Gt) = Rep(Gt_0), that is, parenthesized
        guard tests cannot be distinguished from their bodies.
@@ -487,21 +499,20 @@
   

     Types
     
-      If T is an annotated type Anno :: Type,
-       where Anno is a variable and
-       Type is a type, then Rep(T) =
-       {ann_type,LINE,[Rep(Anno),Rep(Type)]}.
+      If T is an annotated type A :: T_0,
+       where A is a variable, then Rep(T) =
+       {ann_type,LINE,[Rep(A),Rep(T_0)]}.
       If T is an atom or integer literal L, then Rep(T) = Rep(L).
       
-      If T is L Op R,
-       where Op is a binary operator and L and R
-       are types  (this is an occurrence of an expression that can be
-       evaluated to an integer at compile time), then
-       Rep(T) = {op,LINE,Op,Rep(L),Rep(R)}.
-      If T is Op A, where Op is a
-       unary operator and A is a type (this is an occurrence of
+      If T is an operator type T_1 Op T_2,
+       where Op is a binary operator (this is an occurrence of
+       an expression that can be evaluated to an integer at compile
+       time), then
+       Rep(T) = {op,LINE,Op,Rep(T_1),Rep(T_2)}.
+      If T is an operator type Op T_0, where Op is a
+       unary operator (this is an occurrence of
        an expression that can be evaluated to an integer at compile time),
-       then Rep(T) = {op,LINE,Op,Rep(A)}.
+       then Rep(T) = {op,LINE,Op,Rep(T_0)}.
       If T is a bitstring type <<_:M,_:_*N>>,
        where M and N are singleton integer types, then Rep(T) =
        {type,LINE,binary,[Rep(M),Rep(N)]}.
@@ -509,53 +520,44 @@
        {type,Line,nil,[]}.
       If T is a fun type fun(), then Rep(T) =
        {type,LINE,'fun',[]}.
-      If T is a fun type fun((...) -> B),
-       where B is a type, then
-       Rep(T) = {type,LINE,'fun',[{type,LINE,any},Rep(B)]}.
+      If T is a fun type fun((...) -> T_0), then
+       Rep(T) = {type,LINE,'fun',[{type,LINE,any},Rep(T_0)]}.
        
       If T is a fun type fun(Ft), where
        Ft is a function type,
-       then Rep(T) = Rep(Ft).
+       then Rep(T) = Rep(Ft). For Rep(Ft), see below.
       If T is an integer range type L .. H,
        where L and H are singleton integer types, then
        Rep(T) = {type,LINE,range,[Rep(L),Rep(H)]}.
       If T is a map type map(), then Rep(T) =
        {type,LINE,map,any}.
-      If T is a map type #{P_1, ..., P_k}, where each
-       P_i is a map pair type, then Rep(T) =
-       {type,LINE,map,[Rep(P_1), ..., Rep(P_k)]}.
-      If T is a map pair type K => V, where
-       K and V are types, then Rep(T) =
-       {type,LINE,map_field_assoc,[Rep(K),Rep(V)]}.
-      If T is a predefined (or built-in) type N(A_1, ..., A_k),
-       where each A_i is a type, then Rep(T) =
-       {type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}.
+      If T is a map type #{A_1, ..., A_k}, where each
+       A_i is an association type, then Rep(T) =
+       {type,LINE,map,[Rep(A_1), ..., Rep(A_k)]}.
+       For Rep(A), see below.
+      If T is a predefined (or built-in) type N(T_1, ..., T_k),
+       then Rep(T) =
+       {type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}.
       If T is a record type #Name{F_1, ..., F_k},
        where each F_i is a record field type, then Rep(T) =
        {type,LINE,record,[Rep(Name),Rep(F_1), ..., Rep(F_k)]}.
-       
-      If T is a record field type Name :: Type,
-       where Type is a type, then Rep(T) =
-       {type,LINE,field_type,[Rep(Name),Rep(Type)]}.
-      If T is a remote type M:N(A_1, ..., A_k), where
-       each A_i is a type, then Rep(T) =
-       {remote_type,LINE,[Rep(M),Rep(N),[Rep(A_1), ..., Rep(A_k)]]}.
+       For Rep(F), see below.
+      If T is a remote type M:N(T_1, ..., T_k), then Rep(T) =
+       {remote_type,LINE,[Rep(M),Rep(N),[Rep(T_1), ..., Rep(T_k)]]}.
        
       If T is a tuple type tuple(), then Rep(T) =
        {type,LINE,tuple,any}.
-      If T is a tuple type {A_1, ..., A_k}, where
-       each A_i is a type, then Rep(T) =
-       {type,LINE,tuple,[Rep(A_1), ..., Rep(A_k)]}.
-      If T is a type union T_1 | ... | T_k,
-       where each T_i is a type, then Rep(T) =
+      If T is a tuple type {T_1, ..., T_k}, then Rep(T) =
+       {type,LINE,tuple,[Rep(T_1), ..., Rep(T_k)]}.
+      If T is a type union T_1 | ... | T_k, then Rep(T) =
        {type,LINE,union,[Rep(T_1), ..., Rep(T_k)]}.
       If T is a type variable V, then Rep(T) =
        {var,LINE,A}, where A is an atom with a printname
        consisting of the same characters as V. A type variable
        is any variable except underscore (_).
-      If T is a user-defined type N(A_1, ..., A_k),
-       where each A_i is a type, then Rep(T) =
-       {user_type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}.
+      If T is a user-defined type N(T_1, ..., T_k),
+       then Rep(T) =
+       {user_type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}.
       If T is ( T_0 ), then Rep(T) = Rep(T_0),
        that is, parenthesized types cannot be distinguished from their
        bodies.
@@ -563,15 +565,17 @@
 
     

       Function Types
+      
A function type Ft is one of the following alternatives:

       
        If Ft is a constrained function type Ft_1 when Fc,
 	where Ft_1 is a function type and
 	Fc is a function constraint, then Rep(T) =
-	{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}.
-       If Ft is a function type (A_1, ..., A_n) -> B,
-        where each A_i and B are types, then
-	Rep(Ft) = {type,LINE,'fun',[{type,LINE,product,[Rep(A_1),
-	..., Rep(A_n)]},Rep(B)]}.
+	{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}.
+        For Rep(Fc), see below.
+       If Ft is a function type (T_1, ..., T_n) -> T_0,
+        where each T_i is a type, then
+	Rep(Ft) = {type,LINE,'fun',[{type,LINE,product,[Rep(T_1),
+	..., Rep(T_n)]},Rep(T_0)]}.
       
     

 
@@ -587,6 +591,24 @@
        
       
     

+
+    

+      Association Types
+      
+       If A is an association type K => V, where
+        K and V are types, then Rep(A) =
+        {type,LINE,map_field_assoc,[Rep(K),Rep(V)]}.
+      
+    

+
+    

+      Record Field Types
+      
+       If F is a record field type Name :: Type,
+	where Type is a type, then Rep(F) =
+	{type,LINE,field_type,[Rep(Name),Rep(Type)]}.
+      
+    

   

 
   

-- 
cgit v1.2.3


From 6e2d941bf278191c11f6d1cebdfab5e51419d734 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Wed, 20 Jan 2016 09:55:21 +0100
Subject: erts: Improve readability of The Abstract Format

More verbose, but hopefully more readable than before.
---
 erts/doc/src/absform.xml | 420 +++++++++++++++++++++++++----------------------
 1 file changed, 228 insertions(+), 192 deletions(-)

diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index 3f47b3061b..ccdecf44ec 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -68,34 +68,29 @@
       If D is a module declaration consisting of the forms
       F_1, ..., F_k, then
        Rep(D) = [Rep(F_1), ..., Rep(F_k)].
-      If F is an attribute -module(Mod), then
-       Rep(F) = {attribute,LINE,module,Mod}.
       If F is an attribute -behavior(Behavior), then
        Rep(F) = {attribute,LINE,behavior,Behavior}.
       If F is an attribute -behaviour(Behaviour), then
        Rep(F) = {attribute,LINE,behaviour,Behaviour}.
+      If F is an attribute -compile(Options), then
+       Rep(F) = {attribute,LINE,compile,Options}.
       If F is an attribute -export([Fun_1/A_1, ..., Fun_k/A_k]), then
        Rep(F) = {attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}.
-      If F is an attribute -import(Mod,[Fun_1/A_1, ..., Fun_k/A_k]), then
-       Rep(F) = {attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}.
       If F is an attribute -export_type([Type_1/A_1, ..., Type_k/A_k]), then
        Rep(F) = {attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}.
+      If F is an attribute -import(Mod,[Fun_1/A_1, ..., Fun_k/A_k]), then
+       Rep(F) = {attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}.
+      If F is an attribute -module(Mod), then
+       Rep(F) = {attribute,LINE,module,Mod}.
       If F is an attribute -optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k]), then
        Rep(F) = {attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}.
-      If F is an attribute -compile(Options), then
-       Rep(F) = {attribute,LINE,compile,Options}.
       If F is an attribute -file(File,Line), then
        Rep(F) = {attribute,LINE,file,{File,Line}}.
-      If F is a record declaration
-       -record(Name,{V_1, ..., V_k}),
-       where each V_i is a record field, then Rep(F) =
-       {attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}.
-       For Rep(V), see below.
-      If F is a type declaration
-       -Type Name(V_1, ..., V_k) :: T, where
-       Type is either the atom type or the atom opaque,
-       each V_i is a variable, and T is a type, then Rep(F) =
-       {attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}.
+      If F is a function declaration
+       Name Fc_1 ; ... ; Name Fc_k,
+       where each Fc_i is a function clause with a
+       pattern sequence of the same length Arity, then
+       Rep(F) = {function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}.
       
       If F is a function specification
        -Spec Name Ft_1; ...; Ft_k,
@@ -112,15 +107,20 @@
        Arity, then Rep(F) =
        {attribute,Line,spec,{{Mod,Name,Arity},[Rep(Ft_1), ..., Rep(Ft_k)]}}.
       
+      If F is a record declaration
+       -record(Name,{V_1, ..., V_k}),
+       where each V_i is a record field, then Rep(F) =
+       {attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}.
+       For Rep(V), see below.
+      If F is a type declaration
+       -Type Name(V_1, ..., V_k) :: T, where
+       Type is either the atom type or the atom opaque,
+       each V_i is a variable, and T is a type, then Rep(F) =
+       {attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}.
+      
       If F is a wild attribute -A(T), then
        Rep(F) = {attribute,LINE,A,T}.
       


-      If F is a function declaration
-       Name Fc_1 ; ... ; Name Fc_k,
-       where each Fc_i is a function clause with a
-       pattern sequence of the same length Arity, then
-       Rep(F) = {function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}.
-      
     
 
     

@@ -160,15 +160,15 @@
     
There are five kinds of atomic literals, which are represented in the
       same way in patterns, expressions and guards:

     
-      If L is an integer or character literal, then
-       Rep(L) = {integer,LINE,L}.
+      If L is an atom literal, then
+       Rep(L) = {atom,LINE,L}.
       If L is a float literal, then
        Rep(L) = {float,LINE,L}.
+      If L is an integer or character literal, then
+       Rep(L) = {integer,LINE,L}.
       If L is a string literal consisting of the characters
       C_1, ..., C_k, then
        Rep(L) = {string,LINE,[C_1, ..., C_k]}.
-      If L is an atom literal, then
-       Rep(L) = {atom,LINE,L}.
     
     
Note that negative integer and float literals do not occur as such; they are
       parsed as an application of the unary negation operator.

@@ -182,45 +182,53 @@
     
Individual patterns are represented as follows:

     
       If P is an atomic literal L, then Rep(P) = Rep(L).
+      If P is a binary pattern
+       <<P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>>, where each
+       Size_i is an expression that can be evaluated to an integer
+       and each TSL_i is a type specificer list, then
+       Rep(P) = {bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}.
+       For Rep(TSL), see below.
+       An omitted Size_i is represented by default.
+       An omitted TSL_i is represented by default.
       If P is a compound pattern P_1 = P_2, then
        Rep(P) = {match,LINE,Rep(P_1),Rep(P_2)}.
-      If P is a variable pattern V, then
-       Rep(P) = {var,LINE,A},
-       where A is an atom with a printname consisting of the same characters as
-      V.
-      If P is a universal pattern _, then
-       Rep(P) = {var,LINE,'_'}.
-      If P is a tuple pattern {P_1, ..., P_k}, then
-       Rep(P) = {tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}.
-      If P is a nil pattern [], then
-       Rep(P) = {nil,LINE}.
       If P is a cons pattern [P_h | P_t], then
        Rep(P) = {cons,LINE,Rep(P_h),Rep(P_t)}.
-      If E is a binary pattern <<P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>>, then
-       Rep(E) = {bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}.
-       For Rep(TSL), see below.
-       An omitted Size is represented by default. An omitted TSL
-       (type specifier list) is represented by default.
-      If P is P_1 Op P_2, where Op is a binary operator (this
-       is either an occurrence of ++ applied to a literal string or character
-       list, or an occurrence of an expression that can be evaluated to a number
-       at compile time),
-       then Rep(P) = {op,LINE,Op,Rep(P_1),Rep(P_2)}.
-      If P is Op P_0, where Op is a unary operator (this is an
-       occurrence of an expression that can be evaluated to a number at compile
-       time), then Rep(P) = {op,LINE,Op,Rep(P_0)}.
-      If P is a record pattern #Name{Field_1=P_1, ..., Field_k=P_k},
-       then Rep(P) =
-      {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}.
-      If P is #Name.Field, then
-       Rep(P) = {record_index,LINE,Name,Rep(Field)}.
       If P is a map pattern #{A_1, ..., A_k}, where each
        A_i is an association P_i_1 := P_i_2, then Rep(P) =
        {map,LINE,[Rep(A_1), ..., Rep(A_k)]}. For Rep(A), see
        below.
-      If P is ( P_0 ), then
+      If P is a nil pattern [], then
+       Rep(P) = {nil,LINE}.
+      If P is an operator pattern P_1 Op P_2,
+       where Op is a binary operator (this is either an occurrence
+       of ++ applied to a literal string or character
+       list, or an occurrence of an expression that can be evaluated to a number
+       at compile time),
+       then Rep(P) = {op,LINE,Op,Rep(P_1),Rep(P_2)}.
+      If P is an operator pattern Op P_0,
+       where Op is a unary operator (this is an occurrence of
+       an expression that can be evaluated to a number at compile
+       time), then Rep(P) = {op,LINE,Op,Rep(P_0)}.
+      If P is a parenthesized pattern ( P_0 ), then
        Rep(P) = Rep(P_0),
-       that is, patterns cannot be distinguished from their bodies.
+       that is, parenthesized patterns cannot be distinguished from their
+       bodies.
+      If P is a record field index pattern #Name.Field,
+       where Field is an atom, then
+       Rep(P) = {record_index,LINE,Name,Rep(Field)}.
+      If P is a record pattern
+       #Name{Field_1=P_1, ..., Field_k=P_k},
+       where each Field_i is an atom or _, then Rep(P) =
+       {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}.
+      If P is a tuple pattern {P_1, ..., P_k}, then
+       Rep(P) = {tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}.
+      If P is a universal pattern _, then
+       Rep(P) = {var,LINE,'_'}.
+      If P is a variable pattern V, then
+       Rep(P) = {var,LINE,A},
+       where A is an atom with a printname consisting of the same characters as
+      V.
     
     
Note that every pattern has the same source form as some expression, and is
       represented the same way as the corresponding expression.

@@ -233,36 +241,58 @@
     
An expression E is one of the following alternatives:

     
       If E is an atomic literal L, then Rep(E) = Rep(L).
-      If E is P = E_0, then
-       Rep(E) = {match,LINE,Rep(P),Rep(E_0)}.
-      If E is a variable V, then Rep(E) = {var,LINE,A},
-       where A is an atom with a printname consisting of the same
-       characters as V.
-      If E is a tuple skeleton {E_1, ..., E_k}, then
-       Rep(E) = {tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}.
-      If E is [], then
-       Rep(E) = {nil,LINE}.
+      If E is a binary comprehension
+       <<E_0 || Q_1, ..., Q_k>>,
+       where each Q_i is a qualifier, then
+       Rep(E) = {bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}.
+       For Rep(Q), see below.
+      If E is a binary constructor <<E_1:Size_1/TSL_1, ..., E_k:Size_k/TSL_k>>,
+       where each Size_i is an expression and each
+       TSL_i is a type specificer list, then Rep(E) =
+       {bin,LINE,[{bin_element,LINE,Rep(E_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(E_k),Rep(Size_k),Rep(TSL_k)}]}.
+       For Rep(TSL), see below.
+       An omitted Size_i is represented by default.
+       An omitted TSL_i is represented by default.
+      If E is a block expression begin B end,
+       where B is a body, then
+       Rep(E) = {block,LINE,Rep(B)}.
+      If E is a case expression case E_0 of Cc_1 ; ... ; Cc_k end,
+       where E_0 is an expression and each Cc_i is a
+       case clause then Rep(E) =
+      {'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}.
+      If E is a catch expression catch E_0, then
+       Rep(E) = {'catch',LINE,Rep(E_0)}.
       If E is a cons skeleton [E_h | E_t], then
        Rep(E) = {cons,LINE,Rep(E_h),Rep(E_t)}.
-      If E is a binary constructor <<V_1:Size_1/TSL_1, ..., V_k:Size_k/TSL_k>>, then Rep(E) =
-       {bin,LINE,[{bin_element,LINE,Rep(V_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(V_k),Rep(Size_k),Rep(TSL_k)}]}.
-       For Rep(TSL), see below.
-       An omitted Size is represented by default. An omitted TSL
-       (type specifier list) is represented by default.
-      If E is E_1 Op E_2, where Op is a binary operator,
-       then Rep(E) = {op,LINE,Op,Rep(E_1),Rep(E_2)}.
-      If E is Op E_0, where Op is a unary operator, then
-       Rep(E) = {op,LINE,Op,Rep(E_0)}.
-      If E is #Name{Field_1=E_1, ..., Field_k=E_k},
+      If E is a fun expression fun Name/Arity, then
+       Rep(E) = {'fun',LINE,{function,Name,Arity}}.
+      If E is a fun expression
+       fun Module:Name/Arity, then Rep(E) =
+       {'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}.
+       (Before the R15 release: Rep(E) =
+       {'fun',LINE,{function,Module,Name,Arity}}.)
+      If E is a fun expression fun Fc_1 ; ... ; Fc_k end,
+       where each Fc_i is a function clause then Rep(E) =
+      {'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}.
+      If E is a fun expression
+       fun Name Fc_1 ; ... ; Name Fc_k end,
+       where Name is a variable and each
+       Fc_i is a function clause then Rep(E) =
+       {named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}.
+       
+      If E is a function call E_0(E_1, ..., E_k), then
+       Rep(E) = {call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}.
+      If E is a function call E_m:E_0(E_1, ..., E_k),
        then Rep(E) =
-      {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}.
-      If E is E_0#Name{Field_1=E_1, ..., Field_k=E_k}, then
-       Rep(E) =
-      {record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}.
-      If E is #Name.Field, then
-       Rep(E) = {record_index,LINE,Name,Rep(Field)}.
-      If E is E_0#Name.Field, then
-       Rep(E) = {record_field,LINE,Rep(E_0),Name,Rep(Field)}.
+       {call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ...,  Rep(E_k)]}.
+      
+      If E is an if expression if Ic_1 ; ... ; Ic_k  end,
+       where each Ic_i is an if clause then Rep(E) =
+      {'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}.
+      If E is a list comprehension [E_0 || Q_1, ..., Q_k],
+       where each Q_i is a qualifier, then Rep(E) =
+       {lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}. For Rep(Q), see
+       below.
       If E is a map creation #{A_1, ..., A_k},
        where each A_i is an association E_i_1 => E_i_2
        or E_i_1 := E_i_2, then Rep(E) =
@@ -273,95 +303,92 @@
        or E_i_1 := E_i_2, then Rep(E) =
        {map,LINE,Rep(E_0),[Rep(A_1), ..., Rep(A_k)]}.
        For Rep(A), see below.
-      If E is catch E_0, then
-       Rep(E) = {'catch',LINE,Rep(E_0)}.
-      If E is E_0(E_1, ..., E_k), then
-       Rep(E) = {call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}.
-      If E is E_m:E_0(E_1, ..., E_k), then Rep(E) =
-      {call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ...,  Rep(E_k)]}.
-      
-      If E is a list comprehension [E_0 || Q_1, ..., Q_k],
-       where each Q_i is a qualifier, then Rep(E) =
-       {lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}. For Rep(Q), see
-       below.
-      If E is a binary comprehension
-       <<E_0 || Q_1, ..., Q_k>>,
-       where each Q_i is a qualifier, then
-       Rep(E) = {bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}.
-       For Rep(Q), see below.
-      If E is begin B end, where B is a body, then
-       Rep(E) = {block,LINE,Rep(B)}.
-      If E is if Ic_1 ; ... ; Ic_k  end,
-       where each Ic_i is an if clause then Rep(E) =
-      {'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}.
-      If E is case E_0 of Cc_1 ; ... ; Cc_k end,
-       where E_0 is an expression and each Cc_i is a
-       case clause then Rep(E) =
-      {'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}.
-      If E is try B catch Tc_1 ; ... ; Tc_k end,
+      If E is a match operator expression P = E_0,
+       where P is a pattern, then
+       Rep(E) = {match,LINE,Rep(P),Rep(E_0)}.
+      If E is nil, [], then
+       Rep(E) = {nil,LINE}.
+      If E is an operator expression E_1 Op E_2,
+       where Op is a binary operator other than the match
+       operator =, then
+       Rep(E) = {op,LINE,Op,Rep(E_1),Rep(E_2)}.
+      If E is an operator expression Op E_0,
+       where Op is a unary operator, then
+       Rep(E) = {op,LINE,Op,Rep(E_0)}.
+      If E is a parenthesized expression ( E_0 ), then
+       Rep(E) = Rep(E_0), that is, parenthesized
+       expressions cannot be distinguished from their bodies.
+      If E is a receive expression receive Cc_1 ; ... ; Cc_k end,
+       where each Cc_i is a case clause then Rep(E) =
+      {'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}.
+      If E is a receive expression
+       receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end,
+       where each Cc_i is a case clause,
+      E_0 is an expression and B_t is a body, then Rep(E) =
+      {'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}.
+      If E is a record creation
+       #Name{Field_1=E_1, ..., Field_k=E_k},
+       where each Field_i is an atom or _, then Rep(E) =
+      {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}.
+      If E is a record field access E_0#Name.Field,
+       where Field is an atom, then
+       Rep(E) = {record_field,LINE,Rep(E_0),Name,Rep(Field)}.
+      If E is a record field index #Name.Field,
+       where Field is an atom, then
+       Rep(E) = {record_index,LINE,Name,Rep(Field)}.
+      If E is a record update
+       E_0#Name{Field_1=E_1, ..., Field_k=E_k},
+       where each Field_i is an atom, then Rep(E) =
+      {record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}.
+      If E is a tuple skeleton {E_1, ..., E_k}, then
+       Rep(E) = {tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}.
+      If E is a try expression try B catch Tc_1 ; ... ; Tc_k end,
        where B is a body and each Tc_i is a catch clause then
        Rep(E) =
       {'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],[]}.
-      If E is try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end,
+      If E is a try expression
+       try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end,
        where B is a body,
        each Cc_i is a case clause and
        each Tc_j is a catch clause then Rep(E) =
       {'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],[]}.
-      If E is try B after A end,
+      If E is a try expression try B after A end,
        where B and A are bodies then Rep(E) =
       {'try',LINE,Rep(B),[],[],Rep(A)}.
-      If E is try B of Cc_1 ; ... ; Cc_k after A end,
+      If E is a try expression
+       try B of Cc_1 ; ... ; Cc_k after A end,
        where B and A are a bodies and
        each Cc_i is a case clause then Rep(E) =
       {'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[],Rep(A)}.
-      If E is try B catch Tc_1 ; ... ; Tc_k after A end,
+      If E is a try expression
+       try B catch Tc_1 ; ... ; Tc_k after A end,
        where B and A are bodies and
        each Tc_i is a catch clause then Rep(E) =
       {'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}.
-      If E is try B of Cc_1 ; ... ; Cc_k  catch Tc_1 ; ... ; Tc_n after A end,
+      If E is a try expression
+       try B of Cc_1 ; ... ; Cc_k  catch Tc_1 ; ... ; Tc_n after A end,
        where B and A are a bodies,
        each Cc_i is a case clause, and
        each Tc_j is a catch clause then
        Rep(E) =
       {'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1),  ..., Rep(Tc_n)],Rep(A)}.
-      If E is receive Cc_1 ; ... ; Cc_k end,
-       where each Cc_i is a case clause then Rep(E) =
-      {'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}.
-      If E is receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end,
-       where each Cc_i is a case clause,
-      E_0 is an expression and B_t is a body, then Rep(E) =
-      {'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}.
-      If E is fun Name / Arity, then
-       Rep(E) = {'fun',LINE,{function,Name,Arity}}.
-      If E is fun Module:Name/Arity, then Rep(E) =
-       {'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}.
-       (Before the R15 release: Rep(E) =
-       {'fun',LINE,{function,Module,Name,Arity}}.)
-      If E is fun Fc_1 ; ... ; Fc_k end,
-       where each Fc_i is a function clause then Rep(E) =
-      {'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}.
-      If E is fun Name Fc_1 ; ... ; Name Fc_k end,
-       where Name is a variable and each
-       Fc_i is a function clause then Rep(E) =
-       {named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}.
-       
-      If E is ( E_0 ), then
-       Rep(E) = Rep(E_0), that is, parenthesized
-       expressions cannot be distinguished from their bodies.
+      If E is a variable V, then Rep(E) = {var,LINE,A},
+       where A is an atom with a printname consisting of the same
+       characters as V.
     
 
     

       Qualifiers
       
A qualifier Q is one of the following alternatives:

       
+        If Q is a filter E, where E is an expression, then
+         Rep(Q) = Rep(E).
         If Q is a generator P <- E, where P is
 	 a pattern and E is an expression, then
          Rep(Q) = {generate,LINE,Rep(P),Rep(E)}.
         If Q is a generator P <= E, where P is
 	 a pattern and E is an expression, then
          Rep(Q) = {b_generate,LINE,Rep(P),Rep(E)}.
-        If Q is a filter E, where E is an expression, then
-         Rep(Q) = Rep(E).
       
     

 
@@ -399,16 +426,6 @@
       and catch clauses.

     
A clause C is one of the following alternatives:

     
-      If C is a function clause ( Ps ) -> B,
-       where Ps is a pattern sequence and B is a body, then
-       Rep(C) = {clause,LINE,Rep(Ps),[],Rep(B)}.
-      If C is a function clause ( Ps ) when Gs -> B,
-       where Ps is a pattern sequence,
-      Gs is a guard sequence and B is a body, then
-       Rep(C) = {clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}.
-      If C is an if clause Gs -> B,
-       where Gs is a guard sequence and B is a body, then
-       Rep(C) = {clause,LINE,[],Rep(Gs),Rep(B)}.
       If C is a case clause P -> B,
        where P is a pattern and B is a body, then
        Rep(C) = {clause,LINE,[Rep(P)],[],Rep(B)}.
@@ -432,6 +449,16 @@
       P is a pattern, Gs is a guard sequence,
        and B is a body, then
        Rep(C) = {clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}.
+      If C is a function clause ( Ps ) -> B,
+       where Ps is a pattern sequence and B is a body, then
+       Rep(C) = {clause,LINE,Rep(Ps),[],Rep(B)}.
+      If C is a function clause ( Ps ) when Gs -> B,
+       where Ps is a pattern sequence,
+      Gs is a guard sequence and B is a body, then
+       Rep(C) = {clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}.
+      If C is an if clause Gs -> B,
+       where Gs is a guard sequence and B is a body, then
+       Rep(C) = {clause,LINE,[],Rep(Gs),Rep(B)}.
     
   

 
@@ -446,33 +473,23 @@
     
A guard test Gt is one of the following alternatives:

     
       If Gt is an atomic literal L, then Rep(Gt) = Rep(L).
-      If Gt is a variable pattern V, then
-       Rep(Gt) = {var,LINE,A}, where A is an atom with
-       a printname consisting of the same characters as V.
-      If Gt is a tuple skeleton {Gt_1, ..., Gt_k}, then
-       Rep(Gt) = {tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}.
-      If Gt is [], then Rep(Gt) = {nil,LINE}.
-      If Gt is a cons skeleton [Gt_h | Gt_t], then
-       Rep(Gt) = {cons,LINE,Rep(Gt_h),Rep(Gt_t)}.
       If Gt is a binary constructor
-       <<Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>>, then
+       <<Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>>,
+       where each Size_i is a guard test and each
+       TSL_i is a type specificer list, then
        Rep(Gt) = {bin,LINE,[{bin_element,LINE,Rep(Gt_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(Gt_k),Rep(Size_k),Rep(TSL_k)}]}.
        For Rep(TSL), see above.
-       An omitted Size is represented by default.
-       An omitted TSL (type specifier list) is represented
-       by default.
-      If Gt is Gt_1 Op Gt_2, where Op
-       is a binary operator, then Rep(Gt) =
-       {op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}.
-      If Gt is Op Gt_0, where Op is a unary operator, then
-       Rep(Gt) = {op,LINE,Op,Rep(Gt_0)}.
-      If Gt is #Name{Field_1=Gt_1, ..., Field_k=Gt_k}, then
-       Rep(E) =
-      {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}.
-      If Gt is #Name.Field, then
-       Rep(Gt) = {record_index,LINE,Name,Rep(Field)}.
-      If Gt is Gt_0#Name.Field, then
-       Rep(Gt) = {record_field,LINE,Rep(Gt_0),Name,Rep(Field)}.
+       An omitted Size_i is represented by default.
+       An omitted TSL_i is represented by default.
+      If Gt is a cons skeleton [Gt_h | Gt_t], then
+       Rep(Gt) = {cons,LINE,Rep(Gt_h),Rep(Gt_t)}.
+      If Gt is a function call A(Gt_1, ..., Gt_k),
+       where A is an atom, then Rep(Gt) =
+       {call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}.
+      If Gt is a function call A_m:A(Gt_1, ..., Gt_k),
+       where A_m is the atom erlang and A is
+       an atom or an operator, then Rep(Gt) =
+       {call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}.
       If Gt is a map creation #{A_1, ..., A_k},
        where each A_i is an association Gt_i_1 => Gt_i_2
        or Gt_i_1 := Gt_i_2, then Rep(Gt) =
@@ -483,14 +500,33 @@
        or Gt_i_1 := Gt_i_2, then Rep(Gt) =
        {map,LINE,Rep(Gt_0),[Rep(A_1), ..., Rep(A_k)]}.
        For Rep(A), see above.
-      If Gt is A(Gt_1, ..., Gt_k), where A is an atom, then
-       Rep(Gt) = {call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}.
-      If Gt is A_m:A(Gt_1, ..., Gt_k), where A_m is
-       the atom erlang and A is an atom or an operator, then
-       Rep(Gt) = {call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}.
-      If Gt is ( Gt_0 ), then
+      If Gt is nil, [],
+       then Rep(Gt) = {nil,LINE}.
+      If Gt is an operator guard test Gt_1 Op Gt_2,
+       where Op is a binary operator other than the match
+       operator =, then
+       Rep(Gt) = {op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}.
+      If Gt is an operator guard test Op Gt_0,
+       where Op is a unary operator, then
+       Rep(Gt) = {op,LINE,Op,Rep(Gt_0)}.
+      If Gt is a parenthesized guard test ( Gt_0 ), then
        Rep(Gt) = Rep(Gt_0), that is, parenthesized
        guard tests cannot be distinguished from their bodies.
+      If Gt is a record creation
+       #Name{Field_1=Gt_1, ..., Field_k=Gt_k},
+       where each Field_i is an atom or _, then Rep(Gt) =
+      {record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}.
+      If Gt is  a record field access Gt_0#Name.Field,
+       where Field is an atom, then
+       Rep(Gt) = {record_field,LINE,Rep(Gt_0),Name,Rep(Field)}.
+      If Gt is a record field index #Name.Field,
+       where Field is an atom, then
+       Rep(Gt) = {record_index,LINE,Name,Rep(Field)}.
+      If Gt is a tuple skeleton {Gt_1, ..., Gt_k}, then
+       Rep(Gt) = {tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}.
+      If Gt is a variable pattern V, then
+       Rep(Gt) = {var,LINE,A}, where A is an atom with
+       a printname consisting of the same characters as V.
     
     
Note that every guard test has the same source form as some expression,
       and is represented the same way as the corresponding expression.

@@ -504,15 +540,6 @@
        {ann_type,LINE,[Rep(A),Rep(T_0)]}.
       If T is an atom or integer literal L, then Rep(T) = Rep(L).
       
-      If T is an operator type T_1 Op T_2,
-       where Op is a binary operator (this is an occurrence of
-       an expression that can be evaluated to an integer at compile
-       time), then
-       Rep(T) = {op,LINE,Op,Rep(T_1),Rep(T_2)}.
-      If T is an operator type Op T_0, where Op is a
-       unary operator (this is an occurrence of
-       an expression that can be evaluated to an integer at compile time),
-       then Rep(T) = {op,LINE,Op,Rep(T_0)}.
       If T is a bitstring type <<_:M,_:_*N>>,
        where M and N are singleton integer types, then Rep(T) =
        {type,LINE,binary,[Rep(M),Rep(N)]}.
@@ -535,6 +562,18 @@
        A_i is an association type, then Rep(T) =
        {type,LINE,map,[Rep(A_1), ..., Rep(A_k)]}.
        For Rep(A), see below.
+      If T is an operator type T_1 Op T_2,
+       where Op is a binary operator (this is an occurrence of
+       an expression that can be evaluated to an integer at compile
+       time), then
+       Rep(T) = {op,LINE,Op,Rep(T_1),Rep(T_2)}.
+      If T is an operator type Op T_0, where Op is a
+       unary operator (this is an occurrence of
+       an expression that can be evaluated to an integer at compile time),
+       then Rep(T) = {op,LINE,Op,Rep(T_0)}.
+      If T is ( T_0 ), then Rep(T) = Rep(T_0),
+       that is, parenthesized types cannot be distinguished from their
+       bodies.
       If T is a predefined (or built-in) type N(T_1, ..., T_k),
        then Rep(T) =
        {type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}.
@@ -558,9 +597,6 @@
       If T is a user-defined type N(T_1, ..., T_k),
        then Rep(T) =
        {user_type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}.
-      If T is ( T_0 ), then Rep(T) = Rep(T_0),
-       that is, parenthesized types cannot be distinguished from their
-       bodies.
     
 
     

-- 
cgit v1.2.3


From 858c6f7fa44f7b2dc363b359198d6522dd60e914 Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Tue, 5 Jan 2016 16:55:04 +0100
Subject: Introduce time warp safe trace timestamp formats

New timestamp options for trace, sequential trace, and
system profile:
- monotonic_timestamp
- strict_monotonic_timestamp
---
 erts/doc/src/erlang.xml                     |  64 ++-
 erts/emulator/beam/atom.names               |   2 +
 erts/emulator/beam/erl_bif_trace.c          |  41 +-
 erts/emulator/beam/erl_process.c            |   1 +
 erts/emulator/beam/erl_process.h            |  87 ++--
 erts/emulator/beam/erl_trace.c              | 700 +++++++++++++++++-----------
 erts/emulator/beam/erl_trace.h              |  32 +-
 erts/emulator/test/system_profile_SUITE.erl | 155 ++++--
 erts/emulator/test/trace_bif_SUITE.erl      | 249 ++++++----
 erts/preloaded/ebin/erlang.beam             | Bin 102000 -> 102116 bytes
 erts/preloaded/src/erlang.erl               |  13 +-
 lib/kernel/doc/src/seq_trace.xml            |  28 ++
 lib/kernel/src/kernel.app.src               |   2 +-
 lib/kernel/src/seq_trace.erl                |  14 +-
 lib/kernel/test/seq_trace_SUITE.erl         | 166 +++++--
 15 files changed, 1081 insertions(+), 473 deletions(-)

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 64eebec936..79d3f66ea8 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -7739,6 +7739,13 @@ ok
              inactive, and later active when the port
 	     callback returns.

           
+          monotonic_timestamp
+          
+            
Timestamps in profile messages will use
+	    Erlang
+	    monotonic time. The time-stamp (Ts) has the same
+	    format and value as produced by erlang:monotonic_time().

+          
           runnable_procs
           
           
If a process is put into or removed from the run queue, a
@@ -7759,6 +7766,25 @@ ok
              {profile, scheduler, Id, State, NoScheds, Ts}, is
              sent to ProfilerPid.

           
+          strict_monotonic_timestamp
+          
+            
Timestamps in profile messages will consisting of
+	    Erlang
+	    monotonic time and a monotonically increasing
+	    integer. The time-stamp (Ts) has the same format and value
+	    as produced by {erlang:monotonic_time(),
+	    erlang:unique_integer([monotonic])}.

+          
+          timestamp
+          
+            
Timestamps in profile messages will include a
+            time-stamp (Ts) that has the same form as returned by
+            erlang:now(). This is also the default if no
+	    timestamp flag is given. If cpu_timestamp has
+	    been enabled via erlang:trace/3, this will also
+	    effect the timestamp produced in profiling messages
+	    when timestamp flag is enabled.

+          
         
         
erlang:system_profile is considered experimental
           and its behavior can change in a future release.

@@ -8118,7 +8144,10 @@ timestamp() ->
           cpu_timestamp
           
             
A global trace flag for the Erlang node that makes all
-              trace time-stamps to be in CPU time, not wall clock time.
+              trace time-stamps using the timestamp flag to be
+	      in CPU time, not wall clock time. That is, cpu_timestamp
+	      will not be used if monotonic_timestamp, or
+	      strict_monotonic_timestamp is enabled.
               Only allowed with PidSpec==all. If the host
               machine OS does not support high-resolution
               CPU time measurements, trace/3 exits with
@@ -8126,6 +8155,26 @@ timestamp() ->
               not synchronize this value across cores, so be prepared
               that time might seem to go backwards when using this option.

           
+          monotonic_timestamp
+          
+            
Includes an
+	    Erlang
+	    monotonic time time-stamp in all trace messages. The
+            time-stamp (Ts) has the same format and value as produced by
+            erlang:monotonic_time(). This flag overrides
+	    the cpu_timestamp flag.

+          
+          strict_monotonic_timestamp
+          
+            
Includes an timestamp consisting of
+	    Erlang
+	    monotonic time and a monotonically increasing
+	    integer in all trace messages. The time-stamp (Ts) has the
+	    same format and value as produced by
+            {erlang:monotonic_time(),
+	    erlang:unique_integer([monotonic])}. This flag overrides
+	    the cpu_timestamp flag.

+          
           arity
           
             
Used with the call trace flag.
@@ -8172,9 +8221,16 @@ timestamp() ->
 	in the following list. Pid is the process identifier of the
 	traced process in which the traced event has occurred. The
 	third tuple element is the message tag.

-        
If flag timestamp is given, the first tuple
-          element is trace_ts instead, and the time-stamp
-          is added last in the message tuple.

+        
If flag timestamp, strict_monotonic_timestamp, or
+	monotonic_timestamp is given, the first tuple
+        element is trace_ts instead, and the time-stamp
+        is added as an extra element last in the message tuple. If
+	multiple timestamp flags are passed, timestamp has
+	precedence over strict_monotonic_timestamp which
+	in turn has precedence over monotonic_timestamp. All
+	timestamp flags are remembered, so if two are passed
+	and the one with highest precedence later is disabled
+	the other one will become active.

         
         
           {trace, Pid, 'receive', Msg}
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index fb3368eae2..07f6492948 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -370,6 +370,7 @@ atom monitor
 atom monitor_nodes
 atom monitors
 atom monotonic
+atom monotonic_timestamp
 atom more
 atom multi_scheduling
 atom multiline
@@ -559,6 +560,7 @@ atom static
 atom stderr_to_stdout
 atom stop
 atom stream
+atom strict_monotonic_timestamp
 atom sunrm
 atom suspend
 atom suspended
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 03f51132b1..08807d72c9 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -431,6 +431,9 @@ Uint
 erts_trace_flag2bit(Eterm flag) 
 {
     switch (flag) {
+    case am_timestamp: return F_NOW_TS;
+    case am_strict_monotonic_timestamp: return F_STRICT_MON_TS;
+    case am_monotonic_timestamp: return F_MON_TS;
     case am_all: return TRACEE_FLAGS;
     case am_send: return F_TRACE_SEND;
     case am_receive: return F_TRACE_RECEIVE;
@@ -439,7 +442,6 @@ erts_trace_flag2bit(Eterm flag)
     case am_set_on_first_spawn: return F_TRACE_SOS1;
     case am_set_on_link: return F_TRACE_SOL;
     case am_set_on_first_link: return F_TRACE_SOL1;
-    case am_timestamp: return F_TIMESTAMP;
     case am_running: return F_TRACE_SCHED;
     case am_exiting: return F_TRACE_SCHED_EXIT;
     case am_garbage_collection: return F_TRACE_GC;
@@ -592,7 +594,7 @@ Eterm trace_3(BIF_ALIST_3)
 	    ERTS_TRACE_FLAGS(tracee_port) |= mask;
 	else
 	    ERTS_TRACE_FLAGS(tracee_port) &= ~mask;
-	
+
 	if (!ERTS_TRACE_FLAGS(tracee_port))
 	    ERTS_TRACER_PROC(tracee_port) = NIL;
 	else if (tracer != NIL)
@@ -978,7 +980,7 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
     }
 
     if (key == am_flags) {
-	int num_flags = 19;	/* MAXIMUM number of flags. */
+	int num_flags = 21;	/* MAXIMUM number of flags. */
 	Uint needed = 3+2*num_flags;
 	Eterm flag_list = NIL;
 	Eterm* limit;
@@ -996,6 +998,9 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
 #endif
         hp = HAlloc(p, needed);
 	limit = hp+needed;
+	FLAG(F_NOW_TS, am_timestamp);
+	FLAG(F_STRICT_MON_TS, am_strict_monotonic_timestamp);
+	FLAG(F_MON_TS, am_monotonic_timestamp);
 	FLAG(F_TRACE_SEND, am_send);
 	FLAG(F_TRACE_RECEIVE, am_receive);
 	FLAG(F_TRACE_SOS, am_set_on_spawn);
@@ -1007,7 +1012,6 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
 	FLAG(F_TRACE_SCHED, am_running);
 	FLAG(F_TRACE_SCHED_EXIT, am_exiting);
 	FLAG(F_TRACE_GC, am_garbage_collection);
-	FLAG(F_TIMESTAMP, am_timestamp);
 	FLAG(F_TRACE_ARITY_ONLY, am_arity);
 	FLAG(F_TRACE_RETURN_TO, am_return_to);
 	FLAG(F_TRACE_SILENT, am_silent);
@@ -1798,7 +1802,11 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
     } else if (arg1 == am_print) {
 	current_flag = SEQ_TRACE_PRINT; 
     } else if (arg1 == am_timestamp) {
-	current_flag = SEQ_TRACE_TIMESTAMP; 
+	current_flag = SEQ_TRACE_NOW_TS; 
+    } else if (arg1 == am_strict_monotonic_timestamp) {
+	current_flag = SEQ_TRACE_STRICT_MON_TS; 
+    } else if (arg1 == am_monotonic_timestamp) {
+	current_flag = SEQ_TRACE_MON_TS; 
     }
     else
 	current_flag = 0;
@@ -1909,7 +1917,9 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
 #endif
 	) {
 	if ((item == am_send) || (item == am_receive) || 
-	    (item == am_print) || (item == am_timestamp)) {
+	    (item == am_print) || (item == am_timestamp)
+	    || (item == am_monotonic_timestamp)
+	    || (item == am_strict_monotonic_timestamp)) {
 	    hp = HAlloc(p,3);
 	    res = TUPLE2(hp, item, am_false);
 	    BIF_RET(res);
@@ -1927,7 +1937,11 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
     } else if (item == am_print) {
 	current_flag = SEQ_TRACE_PRINT; 
     } else if (item == am_timestamp) {
-	current_flag = SEQ_TRACE_TIMESTAMP; 
+	current_flag = SEQ_TRACE_NOW_TS; 
+    } else if (item == am_strict_monotonic_timestamp) {
+	current_flag = SEQ_TRACE_STRICT_MON_TS; 
+    } else if (item == am_monotonic_timestamp) {
+	current_flag = SEQ_TRACE_MON_TS; 
     } else {
 	current_flag = 0;
     }
@@ -2237,6 +2251,7 @@ static Eterm system_profile_get(Process *p) {
 	if (erts_system_profile_flags.exclusive) {
 	    res = CONS(hp, am_exclusive, res); hp += 2;
 	}
+
     	return TUPLE2(hp, system_profile, res);
     }
 }
@@ -2255,6 +2270,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
     int system_blocked = 0;
     Process *profiler_p = NULL;
     Port *profiler_port = NULL;
+    int ts;
 
     if (profiler == am_undefined || list == NIL) {
 	prev = system_profile_get(p);
@@ -2286,7 +2302,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
 	    goto error;
 	}
 
-	for (scheduler = 0, runnable_ports = 0, runnable_procs = 0, exclusive = 0;
+	for (ts = ERTS_TRACE_FLG_NOW_TIMESTAMP, scheduler = 0,
+		 runnable_ports = 0, runnable_procs = 0, exclusive = 0;
 	    is_list(list);
 	    list = CDR(list_val(list))) {
 	    
@@ -2299,6 +2316,12 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
 		exclusive = !0;
 	    } else if (t == am_scheduler) {
 		scheduler = !0;
+	    } else if (t == am_timestamp) {
+		ts = ERTS_TRACE_FLG_NOW_TIMESTAMP;
+	    } else if (t == am_strict_monotonic_timestamp) {
+		ts = ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP;
+	    } else if (t == am_monotonic_timestamp) {
+		ts = ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP;
 	    } else goto error;
 	}	
 	if (is_not_nil(list)) goto error;
@@ -2311,7 +2334,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
 	erts_system_profile_flags.runnable_ports = !!runnable_ports;
 	erts_system_profile_flags.runnable_procs = !!runnable_procs;
 	erts_system_profile_flags.exclusive = !!exclusive;
-
+	erts_system_profile_ts_type = ts;
 	erts_smp_thr_progress_unblock();
 	erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
 	
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index b47aae0f74..c1d2e8db8e 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -353,6 +353,7 @@ struct erts_system_monitor_flags_t erts_system_monitor_flags;
 /* system performance monitor */
 Eterm erts_system_profile;
 struct erts_system_profile_flags_t erts_system_profile_flags;
+int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP;
 
 #if ERTS_MAX_PROCESSES > 0x7fffffff
 #error "Need to store process_count in another type"
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index fd7d4183f4..6512710f48 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -60,6 +60,9 @@ typedef struct process Process;
 #include "erl_mseg.h"
 #include "erl_async.h"
 #include "erl_gc.h"
+#define ERTS_ONLY_INCLUDE_TRACE_FLAGS
+#include "erl_trace.h"
+#undef ERTS_ONLY_INCLUDE_TRACE_FLAGS
 
 #ifdef HIPE
 #include "hipe_process.h"
@@ -1292,6 +1295,7 @@ struct erts_system_profile_flags_t {
     unsigned int exclusive : 1;
 };
 extern struct erts_system_profile_flags_t erts_system_profile_flags;
+extern int erts_system_profile_ts_type;
 
 /* process flags */
 #define F_HIBERNATE_SCHED    (1 <<  0) /* Schedule out after hibernate op */
@@ -1307,61 +1311,90 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
 #define F_FORCE_GC           (1 << 10) /* Force gc at process in-scheduling */
 #define F_DISABLE_GC         (1 << 11) /* Disable GC */
 
+#define ERTS_TRACE_FLAGS_TS_TYPE_SHIFT			0
+
+#define F_TRACE_FLAG(N)      (1 << (ERTS_TRACE_TS_TYPE_BITS + (N)))
+
 /* process trace_flags */
-#define F_SENSITIVE          (1 << 0)
-#define F_TRACE_SEND         (1 << 1)   
-#define F_TRACE_RECEIVE      (1 << 2)
-#define F_TRACE_SOS          (1 << 3) /* Set on spawn       */
-#define F_TRACE_SOS1         (1 << 4) /* Set on first spawn */
-#define F_TRACE_SOL          (1 << 5) /* Set on link        */
-#define F_TRACE_SOL1         (1 << 6) /* Set on first link  */
-#define F_TRACE_CALLS        (1 << 7)
-#define F_TIMESTAMP          (1 << 8)
-#define F_TRACE_PROCS        (1 << 9)
-#define F_TRACE_FIRST_CHILD  (1 << 10)
-#define F_TRACE_SCHED        (1 << 11)
-#define F_TRACE_GC           (1 << 12)
-#define F_TRACE_ARITY_ONLY   (1 << 13)
-#define F_TRACE_RETURN_TO    (1 << 14) /* Return_to trace when breakpoint tracing */
-#define F_TRACE_SILENT       (1 << 15) /* No call trace msg suppress */
-#define F_TRACER             (1 << 16) /* May be (has been) tracer */
-#define F_EXCEPTION_TRACE    (1 << 17) /* May have exception trace on stack */
+
+#define F_NOW_TS             (ERTS_TRACE_FLG_NOW_TIMESTAMP \
+			      << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_STRICT_MON_TS      (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \
+			      << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_MON_TS             (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \
+			      << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_SENSITIVE          F_TRACE_FLAG(0)
+#define F_TRACE_SEND         F_TRACE_FLAG(1)
+#define F_TRACE_RECEIVE      F_TRACE_FLAG(2)
+#define F_TRACE_SOS          F_TRACE_FLAG(3) /* Set on spawn       */
+#define F_TRACE_SOS1         F_TRACE_FLAG(4) /* Set on first spawn */
+#define F_TRACE_SOL          F_TRACE_FLAG(5) /* Set on link        */
+#define F_TRACE_SOL1         F_TRACE_FLAG(6) /* Set on first link  */
+#define F_TRACE_CALLS        F_TRACE_FLAG(7)
+#define F_TRACE_PROCS        F_TRACE_FLAG(8)
+#define F_TRACE_FIRST_CHILD  F_TRACE_FLAG(9)
+#define F_TRACE_SCHED        F_TRACE_FLAG(10)
+#define F_TRACE_GC           F_TRACE_FLAG(11)
+#define F_TRACE_ARITY_ONLY   F_TRACE_FLAG(12)
+#define F_TRACE_RETURN_TO    F_TRACE_FLAG(13) /* Return_to trace when breakpoint tracing */
+#define F_TRACE_SILENT       F_TRACE_FLAG(14) /* No call trace msg suppress */
+#define F_TRACER             F_TRACE_FLAG(15) /* May be (has been) tracer */
+#define F_EXCEPTION_TRACE    F_TRACE_FLAG(16) /* May have exception trace on stack */
 
 /* port trace flags, currently the same as process trace flags */
-#define F_TRACE_SCHED_PORTS  (1 << 18) /* Trace of port scheduling */
-#define F_TRACE_SCHED_PROCS  (1 << 19) /* With virtual scheduling */
-#define F_TRACE_PORTS	     (1 << 20) /* Ports equivalent to F_TRACE_PROCS */
-#define F_TRACE_SCHED_NO     (1 << 21) /* Trace with scheduler id */
-#define F_TRACE_SCHED_EXIT   (1 << 22)
+#define F_TRACE_SCHED_PORTS  F_TRACE_FLAG(17) /* Trace of port scheduling */
+#define F_TRACE_SCHED_PROCS  F_TRACE_FLAG(18) /* With virtual scheduling */
+#define F_TRACE_PORTS	     F_TRACE_FLAG(19) /* Ports equivalent to F_TRACE_PROCS */
+#define F_TRACE_SCHED_NO     F_TRACE_FLAG(20) /* Trace with scheduler id */
+#define F_TRACE_SCHED_EXIT   F_TRACE_FLAG(21)
 
-#define F_NUM_FLAGS          23
+#define F_NUM_FLAGS          (ERTS_TRACE_TS_TYPE_BITS + 22)
 #ifdef DEBUG
 #  define F_INITIAL_TRACE_FLAGS (5 << F_NUM_FLAGS)
 #else
 #  define F_INITIAL_TRACE_FLAGS 0
 #endif
 
+/* F_TIMESTAMP_MASK is a bit-field of all all timestamp types */
+#define F_TIMESTAMP_MASK \
+    (ERTS_TRACE_TS_TYPE_MASK << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+
 #define TRACEE_FLAGS ( F_TRACE_PROCS | F_TRACE_CALLS \
 		     | F_TRACE_SOS |  F_TRACE_SOS1| F_TRACE_RECEIVE  \
 		     | F_TRACE_SOL | F_TRACE_SOL1 | F_TRACE_SEND \
-		     | F_TRACE_SCHED | F_TIMESTAMP | F_TRACE_GC \
+		     | F_TRACE_SCHED | F_TIMESTAMP_MASK | F_TRACE_GC \
 		     | F_TRACE_ARITY_ONLY | F_TRACE_RETURN_TO \
                      | F_TRACE_SILENT | F_TRACE_SCHED_PROCS | F_TRACE_PORTS \
 		     | F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \
 		     | F_TRACE_SCHED_EXIT)
 
 #define ERTS_TRACEE_MODIFIER_FLAGS \
-  (F_TRACE_SILENT | F_TIMESTAMP | F_TRACE_SCHED_NO)
+  (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO)
 #define ERTS_PORT_TRACEE_FLAGS \
   (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS)
 #define ERTS_PROC_TRACEE_FLAGS \
   ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS)
 
+#define SEQ_TRACE_FLAG(N)        (1 << (ERTS_TRACE_TS_TYPE_BITS + (N)))
+
 /* Sequential trace flags */
+
+/* SEQ_TRACE_TIMESTAMP_MASK is a bit-field */
+#define SEQ_TRACE_TIMESTAMP_MASK \
+    (ERTS_TRACE_TS_TYPE_MASK << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+
 #define SEQ_TRACE_SEND     (1 << 0)
 #define SEQ_TRACE_RECEIVE  (1 << 1)
 #define SEQ_TRACE_PRINT    (1 << 2)
-#define SEQ_TRACE_TIMESTAMP (1 << 3)
+
+#define ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT 3
+
+#define SEQ_TRACE_NOW_TS   (ERTS_TRACE_FLG_NOW_TIMESTAMP \
+			    << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define SEQ_TRACE_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \
+				 << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define SEQ_TRACE_MON_TS (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \
+			  << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
 
 #ifdef USE_VM_PROBES
 #define DT_UTAG_PERMANENT (1 << 0)
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index e1b03a057f..2243639099 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -38,6 +38,7 @@
 #include "erl_binary.h"
 #include "erl_bits.h"
 #include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
 
 #if 0
 #define DEBUG_PRINTOUTS
@@ -77,6 +78,263 @@ enum ErtsSysMsgType {
     SYS_MSG_TYPE_SYSPROF
 };
 
+#define ERTS_TRACE_TS_NOW_MAX_SIZE				\
+    4
+#define ERTS_TRACE_TS_MONOTONIC_MAX_SIZE			\
+    ERTS_MAX_SINT64_HEAP_SIZE
+#define ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE			\
+    (3 + ERTS_MAX_SINT64_HEAP_SIZE				\
+     + ERTS_MAX_UINT64_HEAP_SIZE)
+
+#define ERTS_TRACE_PATCH_TS_MAX_SIZE				\
+    (1 + ((ERTS_TRACE_TS_NOW_MAX_SIZE				\
+	   > ERTS_TRACE_TS_MONOTONIC_MAX_SIZE)			\
+	  ? ((ERTS_TRACE_TS_NOW_MAX_SIZE			\
+	      > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE)	\
+	     ? ERTS_TRACE_TS_NOW_MAX_SIZE			\
+	     : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE)		\
+	  : ((ERTS_TRACE_TS_MONOTONIC_MAX_SIZE			\
+	      > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE)	\
+	     ? ERTS_TRACE_TS_MONOTONIC_MAX_SIZE			\
+	     : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE)))
+
+#define TFLGS_TS_TYPE(p) ERTS_TFLGS2TSTYPE(ERTS_TRACE_FLAGS((p)))
+
+/*
+ * FUTURE CHANGES:
+ *
+ * The timestamp functionality has intentionally been
+ * split in two parts for future use even though it
+ * is not used like this today. take_timestamp() takes
+ * the timestamp and calculate heap need for it (which
+ * is not constant). write_timestamp() writes the
+ * timestamp to the allocated heap. That is, one typically
+ * want to take the timestamp before allocating the heap
+ * and then write it to the heap.
+ *
+ * The trace output functionality now use patch_ts_size(),
+ * write_ts(), and patch_ts(). write_ts() both takes the
+ * timestamp and writes it. Since we don't know the
+ * heap need when allocating the heap area we need to
+ * over allocate (maximum size from patch_ts_size()) and
+ * then potentially (often) shrink the heap area after the
+ * timestamp has been written. The only reason it is
+ * currently done this way is because we do not want to
+ * make major changes of the trace behavior in a patch.
+ * This is planned to be changed in next major release.
+ */
+
+typedef struct {
+    int ts_type_flag;
+    union {
+	struct {
+	    Uint ms;
+	    Uint s;
+	    Uint us;
+	} now;
+	struct {
+	    ErtsMonotonicTime time;
+	    Sint64 raw_unique;
+	} monotonic;
+    } u;
+} ErtsTraceTimeStamp;
+
+static ERTS_INLINE Uint
+take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type)
+{
+    int ts_type_flag = ts_type & -ts_type; /* least significant flag */
+
+    ASSERT(ts_type_flag == ERTS_TRACE_FLG_NOW_TIMESTAMP
+	   || ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP
+	   || ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP
+	   || ts_type_flag == 0);
+
+    tsp->ts_type_flag = ts_type_flag;
+    switch (ts_type_flag) {
+    case 0:
+	return (Uint) 0;
+    case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+#ifdef HAVE_ERTS_NOW_CPU
+	if (erts_cpu_timestamp)
+	    erts_get_now_cpu(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us);
+	else
+#endif
+	    get_now(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us);
+	return (Uint) 4;
+    case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+    case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: {
+	Uint hsz = 0;
+	ErtsMonotonicTime mtime = erts_get_monotonic_time(NULL);
+	mtime += ERTS_MONOTONIC_OFFSET_NATIVE;
+	hsz = (IS_SSMALL(mtime) ?
+	       (Uint) 0
+	       : ERTS_SINT64_HEAP_SIZE((Sint64) mtime));
+	tsp->u.monotonic.time = mtime;
+	if (ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP) {
+	    Sint64 raw_unique;
+	    hsz += 3; /* 2-tuple */
+	    raw_unique = erts_raw_get_unique_monotonic_integer();
+	    tsp->u.monotonic.raw_unique = raw_unique;
+	    hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique);
+	}
+	return hsz;
+    }
+    default:
+	ERTS_INTERNAL_ERROR("invalid timestamp type");
+	return 0;
+    }
+}
+
+static ERTS_INLINE Eterm
+write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp)
+{
+    int ts_type_flag = tsp->ts_type_flag;
+    Eterm res;
+
+    switch (ts_type_flag) {
+    case 0:
+	return NIL;
+    case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+	res = TUPLE3(*hpp,
+		     make_small(tsp->u.now.ms),
+		     make_small(tsp->u.now.s),
+		     make_small(tsp->u.now.us));
+	*hpp += 4;
+	return res;
+    case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+    case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: {
+	Sint64 mtime, raw;
+	Eterm unique, emtime;
+
+	mtime = (Sint64) tsp->u.monotonic.time;
+	emtime = (IS_SSMALL(mtime)
+		  ? make_small((Sint64) mtime)
+		  : erts_sint64_to_big((Sint64) mtime, hpp));
+
+	if (ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP)
+	    return emtime;
+
+	raw = tsp->u.monotonic.raw_unique;
+	unique = erts_raw_make_unique_monotonic_integer_value(hpp,
+							      raw);
+	res = TUPLE2(*hpp, emtime, unique);
+	*hpp += 3;
+	return res;
+    }
+    default:
+	ERTS_INTERNAL_ERROR("invalid timestamp type");
+	return THE_NON_VALUE;
+    }
+}
+
+#define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p))
+
+static ERTS_INLINE Uint
+patch_ts_size(int ts_type)
+{
+    int ts_type_flag = ts_type & -ts_type; /* least significant flag */
+    switch (ts_type_flag) {
+    case 0:
+	return 0;
+    case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+	return 1 + ERTS_TRACE_TS_NOW_MAX_SIZE;
+    case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+	return 1 + ERTS_TRACE_TS_MONOTONIC_MAX_SIZE;
+    case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP:
+	return 1 + ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE;
+    default:
+	ERTS_INTERNAL_ERROR("invalid timestamp type");
+	return 0;
+    }
+}
+
+/*
+ * Write a timestamp. The timestamp MUST be the last
+ * thing built on the heap. This since write_ts() might
+ * adjust the size of the used area.
+ */
+static Eterm
+write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer)
+{
+    ErtsTraceTimeStamp ts;
+    Sint shrink;
+    Eterm res, *ts_hp = hp;
+    Uint hsz;
+
+    ASSERT(ts_type);
+
+    hsz = take_timestamp(&ts, ts_type);
+
+    res = write_timestamp(&ts, &ts_hp);
+
+    ASSERT(ts_hp == hp + hsz);
+
+    switch (ts.ts_type_flag) {
+    case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+	shrink = ERTS_TRACE_TS_MONOTONIC_MAX_SIZE;
+	break;
+    case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP:
+	shrink = ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE;
+	break;
+    default:
+	return res;
+    }
+
+    shrink -= hsz;
+
+    ASSERT(shrink >= 0);
+
+    if (shrink) {
+	if (bp)
+	    bp->used_size -= shrink;
+#ifndef ERTS_SMP
+	else if (tracer) {
+	    Eterm *endp = ts_hp + shrink;
+	    HRelease(tracer, endp, ts_hp);
+	}
+#endif
+    }
+
+    return res;
+}
+
+/*
+ * Patch a timestamp into a tuple. The tuple MUST be the last thing
+ * built on the heap before the call, and the timestamp MUST be
+ * the last thing after the call. This since patch_ts() might adjust
+ * the size of the used area.
+ */
+
+#define PATCH_TS__(Type, Tuple, Hp, Bp, Tracer)			\
+    do {							\
+	int ts_type__ = (Type);					\
+	if (ts_type__)						\
+	    patch_ts(ts_type__, (Tuple), (Hp), (Bp), (Tracer));	\
+    } while (0)
+
+#ifdef ERTS_SMP
+#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \
+    PATCH_TS__((Type), (Tuple), (Hp), (Bp), NULL)
+#else
+#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \
+    PATCH_TS__((Type), (Tuple), (Hp), (Bp), (Tracer))
+#endif
+
+static ERTS_INLINE void
+patch_ts(int ts_type, Eterm tuple, Eterm* hp, ErlHeapFragment *bp, Process *tracer)
+{
+    Eterm *tptr = tuple_val(tuple);
+    int arity = arityval(*tptr);
+
+    ASSERT(ts_type);
+    ASSERT((tptr+arity+1) == hp);
+
+    tptr[0] = make_arityval(arity+1);
+    tptr[1] = am_trace_ts;
+
+    *hp = write_ts(ts_type, hp+1, bp, tracer);
+}
+
 #ifdef ERTS_SMP
 static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type,
 				     Eterm from,
@@ -365,23 +623,6 @@ erts_get_system_profile(void) {
     return profile;
 }
 
-
-#ifdef HAVE_ERTS_NOW_CPU
-#  define GET_NOW(m, s, u) \
-do { \
-    if (erts_cpu_timestamp) \
-	erts_get_now_cpu(m, s, u); \
-    else \
-	get_now(m, s, u); \
-} while (0)
-#else
-#  define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0)
-#endif
-
-
-
-static Eterm* patch_ts(Eterm tuple4, Eterm* hp);
-
 #ifdef ERTS_SMP
 static void
 do_send_to_port(Eterm to,
@@ -436,11 +677,11 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to,
 /* Send        {trace_ts, Pid, out, 0, Timestamp}
  * followed by {trace_ts, Pid, in, 0, NewTimestamp}
  *
- * 'NewTimestamp' is fetched from GET_NOW() through patch_ts().
+ * 'NewTimestamp' through patch_ts().
  */
 static void 
-do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
-#define LOCAL_HEAP_SIZE (4+5+5)
+do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp, int ts_type) {
+#define LOCAL_HEAP_SIZE (5+5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
     Eterm message;
     Eterm *hp;
@@ -462,9 +703,11 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
 		    SYS_MSG_TYPE_UNDEFINED,
 		    message);
 
-    message = TUPLE4(hp, am_trace_ts, pid, am_in, mfarity);
-    hp += 5;
-    hp = patch_ts(message, hp);
+
+    message = TUPLE5(hp, am_trace_ts, pid, am_in, mfarity,
+		     NIL /* Will be overwritten by timestamp */);
+    hp += 6;
+    hp[-1] = write_ts(ts_type, hp, NULL, NULL);
 
     do_send_to_port(trace_port->common.id,
 		    trace_port,
@@ -481,7 +724,7 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
  * It is assumed that 'message' is not an 'out' message.
  *
  * 'c_p' is the currently executing process, "tracee" is the traced process
- * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP), 
+ * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP_MASK), 
  * 'message' must contain a timestamp.
  */
 static void
@@ -489,8 +732,9 @@ send_to_port(Process *c_p, Eterm message,
 	     Eterm *tracer_pid, Uint *tracee_flags) {
     Port* trace_port;
 #ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4)
-    Eterm ts, *hp;
+    int ts_type;
+#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE
+    Eterm ts;
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 #endif
 
@@ -519,7 +763,7 @@ send_to_port(Process *c_p, Eterm message,
      */
 
     if ( c_p == NULL || 
-	 (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) { 
+	 (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { 
 #endif
 	do_send_to_port(*tracer_pid,
 			trace_port,
@@ -538,22 +782,12 @@ send_to_port(Process *c_p, Eterm message,
      */
     UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
-    if (*tracee_flags & F_TIMESTAMP) {
-	ASSERT(is_tuple(message));
-	hp = tuple_val(message);
-	ts = hp[arityval(hp[0])];
-    } else {
-	/* A fake schedule might be needed,
-	 * but this message does not contain a timestamp.
-	 * Create a dummy trace message with timestamp to be
-	 * passed to do_send_schedfix_to_port().
-	 */
-	Uint ms,s,us;
-	GET_NOW(&ms, &s, &us);
-	hp = local_heap;
-	ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
-	hp += 4;
-    }
+    /* A fake schedule might be needed.
+     * Create a dummy trace message with timestamp to be
+     * passed to do_send_schedfix_to_port().
+     */
+    ts_type = TFLGS_TS_TYPE(c_p);
+    ts = write_ts(ts_type, local_heap, NULL, NULL);
 
     trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
     do_send_to_port(*tracer_pid,
@@ -572,7 +806,7 @@ send_to_port(Process *c_p, Eterm message,
 	 * just after writning the real trace message, and now gets scheduled
 	 * in again.
 	 */
-	do_send_schedfix_to_port(trace_port, c_p->common.id, ts);
+	do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type);
     }
 
     erts_port_release(trace_port);
@@ -641,20 +875,19 @@ profile_send(Eterm from, Eterm message) {
 
 /* A fake schedule out/in message pair will be sent,
  * if the driver so requests.
- * If (timestamp == NIL), one is fetched from GET_NOW().
  *
  * 'c_p' is the currently executing process, may be NULL.
  */
 static void
 seq_trace_send_to_port(Process *c_p,
 		       Eterm seq_tracer,
-		       Eterm message,
-		       Eterm timestamp)
+		       Eterm message)
 {
     Port* trace_port;
 #ifndef ERTS_SMP
-    Eterm ts, *hp;
-#define LOCAL_HEAP_SIZE (4)
+    int ts_type;
+    Eterm ts;
+#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
     UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #endif
@@ -679,7 +912,7 @@ seq_trace_send_to_port(Process *c_p,
     }
 
     if (c_p == NULL
-	|| (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) {
+	|| (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) {
 #endif
 	do_send_to_port(seq_tracer,
 			trace_port,
@@ -696,20 +929,12 @@ seq_trace_send_to_port(Process *c_p,
      * with 'running' and 'timestamp'.
      */
 
-    if (timestamp != NIL) {
-	ts = timestamp;
-    } else {
-	/* A fake schedule might be needed,
-	 * but this message does not contain a timestamp.
-	 * Create a dummy trace message with timestamp to be
-	 * passed to do_send_schedfix_to_port().
-	 */
-	Uint ms,s,us;
-	GET_NOW(&ms, &s, &us);
-	hp = local_heap;
-	ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
-	hp += 4;
-    }
+    /* A fake schedule might be needed.
+     * Create a dummy trace message with timestamp to be
+     * passed to do_send_schedfix_to_port().
+     */
+    ts_type = TFLGS_TS_TYPE(c_p);
+    ts = write_ts(ts_type, local_heap, NULL, NULL);
 
     trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
     do_send_to_port(seq_tracer,
@@ -728,7 +953,7 @@ seq_trace_send_to_port(Process *c_p,
 	 * just after writing the real trace message, and now gets scheduled
 	 * in again.
 	 */
-	do_send_schedfix_to_port(trace_port, c_p->common.id, ts);
+	do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type);
     }
 
     erts_port_release(trace_port);
@@ -738,32 +963,6 @@ seq_trace_send_to_port(Process *c_p,
 #endif
 }
 
-#define TS_HEAP_WORDS 5
-#define TS_SIZE(p) ((ERTS_TRACE_FLAGS((p)) & F_TIMESTAMP) \
-		    ? TS_HEAP_WORDS \
-		    : 0)
-
-/*
- * Patch a timestamp into a tuple.  The tuple must be the last thing
- * built on the heap.
- *
- * Returns the new hp pointer.
-*/
-static Eterm*
-patch_ts(Eterm tuple, Eterm* hp)
-{
-    Uint ms, s, us;
-    Eterm* ptr = tuple_val(tuple);
-    int arity = arityval(*ptr);
-
-    ASSERT((ptr+arity+1) == hp);
-    ptr[0] = make_arityval(arity+1);
-    ptr[1] = am_trace_ts;
-    GET_NOW(&ms, &s, &us);
-    *hp = TUPLE3(hp+1, make_small(ms), make_small(s), make_small(us));
-    return hp+5;
-}
-
 static ERTS_INLINE void
 send_to_tracer(Process *tracee,
 	       ERTS_TRACER_REF_TYPE tracer_ref,
@@ -776,13 +975,13 @@ send_to_tracer(Process *tracee,
 
     erts_smp_mtx_lock(&smq_mtx);
 
-    if (ERTS_TRACE_FLAGS(tracee) & F_TIMESTAMP)
-	*hpp = patch_ts(msg, *hpp);
-
-    if (is_internal_pid(ERTS_TRACER_PROC(tracee)))
+    if (is_internal_pid(ERTS_TRACER_PROC(tracee))) {
+	PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp);
+    }
     else {
 	ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee)));
+	PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, NULL, NULL);
 	send_to_port(no_fake_sched ? NULL : tracee,
 		     msg,
 		     &ERTS_TRACER_PROC(tracee),
@@ -796,7 +995,7 @@ send_to_tracer(Process *tracee,
 static void
 trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
 {
-#define LOCAL_HEAP_SIZE (5+4+1+TS_HEAP_WORDS)
+#define LOCAL_HEAP_SIZE (5+4+1+ERTS_TRACE_PATCH_TS_MAX_SIZE)
     DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
     Eterm tmp, mess, *hp;
     ErlHeapFragment *bp = NULL;
@@ -852,7 +1051,7 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
 	    size += 4;
 	if (sched_no)
 	    size += 1;
-	size += TS_SIZE(p);
+	size += PATCH_TS_SIZE(p);
 	hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
     }
 
@@ -926,7 +1125,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
     }
 
     if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (11)
+#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -934,9 +1133,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
 	mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to);
 	hp += 6;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
 	send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -955,7 +1152,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
 
 	sz_msg = size_object(msg);
 	sz_to  = size_object(to);
-	need = sz_msg + sz_to + 6 + TS_SIZE(p);
+	need = sz_msg + sz_to + 6 + PATCH_TS_SIZE(p);
 	
 	hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
 
@@ -972,10 +1169,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    patch_ts(mess, hp);
-	}
-
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
     }
@@ -992,7 +1186,7 @@ trace_receive(Process *rp, Eterm msg)
     Eterm* hp;
 
     if (is_internal_port(ERTS_TRACER_PROC(rp))) {
-#define LOCAL_HEAP_SIZE (10)
+#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -1000,9 +1194,7 @@ trace_receive(Process *rp, Eterm msg)
 	mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg);
 	hp += 5;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, NULL, NULL);
 	send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp));
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -1021,7 +1213,7 @@ trace_receive(Process *rp, Eterm msg)
 
 	sz_msg = size_object(msg);
 
-	hsz = sz_msg + 5 + TS_SIZE(rp);
+	hsz = sz_msg + 5 + PATCH_TS_SIZE(rp);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref);
 
@@ -1031,10 +1223,7 @@ trace_receive(Process *rp, Eterm msg)
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) {
-	    patch_ts(mess, hp);
-	}
-
+	PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
     }
@@ -1084,6 +1273,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
     Eterm type_atom;
     int sz_exit;
     Eterm seq_tracer;
+    int ts_type;
 
     seq_tracer = erts_get_system_seq_tracer();
 
@@ -1111,8 +1301,10 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 	return;			/* no need to send anything */
     }
 
+    ts_type = ERTS_SEQTFLGS2TSTYPE(unsigned_val(SEQ_TRACE_T_FLAGS(token)));
+
     if (is_internal_port(seq_tracer)) {
-#define LOCAL_HEAP_SIZE (64)
+#define LOCAL_HEAP_SIZE (60 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -1128,17 +1320,17 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 	mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token),
 		      receiver, msg);
 	hp += 6;
+
 	erts_smp_mtx_lock(&smq_mtx);
-	if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) == 0) {
+	if (!ts_type) {
 	    mess = TUPLE3(hp, am_seq_trace, label, mess);
-	    seq_trace_send_to_port(NULL, seq_tracer, mess, NIL);
+	    seq_trace_send_to_port(NULL, seq_tracer, mess);
 	} else {
-	    Uint ms,s,us,ts;
-	    GET_NOW(&ms, &s, &us);
-	    ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us));
-	    hp += 4;
-	    mess = TUPLE4(hp, am_seq_trace, label, mess, ts);
-	    seq_trace_send_to_port(process, seq_tracer, mess, ts);
+	    mess = TUPLE4(hp, am_seq_trace, label, mess,
+			  NIL /* Will be overwritten by timestamp */);
+	    hp += 5;
+	    hp[-1] = write_ts(ts_type, hp, NULL, NULL);
+	    seq_trace_send_to_port(process, seq_tracer, mess);
 	}
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -1173,8 +1365,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 	sz_lastcnt_serial = 3; /* TUPLE2 */
 	sz_msg = size_object(msg);
 
-	sz_ts = ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) ? 
-		 5 : 0);
+	sz_ts = patch_ts_size(ts_type);
 	if (exitfrom != NIL) {
 	    sz_exit = 4; /* create {'EXIT',exitfrom,msg} */
 	    sz_exitfrom = size_object(exitfrom);
@@ -1218,14 +1409,20 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (sz_ts) {/* timestamp should be included */
-	    Uint ms,s,us,ts;
-	    GET_NOW(&ms, &s, &us);
-	    ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us));
-	    hp += 4;
-	    mess = TUPLE4(hp, am_seq_trace, label, mess, ts);
-	} else {
+	if (!ts_type)
 	    mess = TUPLE3(hp, am_seq_trace, label, mess);
+	else {
+	    mess = TUPLE4(hp, am_seq_trace, label, mess,
+			  NIL /* Will be overwritten by timestamp */);
+	    hp += 5;
+	    /* Write timestamp in element 6 of the 'msg' tuple */
+	    hp[-1] = write_ts(ts_type, hp, bp,
+#ifndef ERTS_SMP
+			      tracer
+#else
+			      NULL
+#endif
+		);
 	}
 
 #ifdef ERTS_SMP
@@ -1244,7 +1441,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 void 
 erts_trace_return_to(Process *p, BeamInstr *pc)
 {
-#define LOCAL_HEAP_SIZE (4+5+5)
+#define LOCAL_HEAP_SIZE (4+5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
     Eterm* hp;
     Eterm mfa;
     Eterm mess;
@@ -1269,9 +1466,7 @@ erts_trace_return_to(Process *p, BeamInstr *pc)
 
     erts_smp_mtx_lock(&smq_mtx);
 
-    if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	hp = patch_ts(mess, hp);
-    }
+    PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
 
     if (is_internal_port(ERTS_TRACER_PROC(p))) {
 	send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
@@ -1318,6 +1513,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
     Eterm mod, name;
     int arity;
     Uint meta_flags, *tracee_flags;
+    int ts_type;
 #ifdef ERTS_SMP
     Eterm tracee;
 #endif
@@ -1353,7 +1549,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
 	 *     meta trace =>
 	 *       use fixed flag set instead of process flags
 	 */	    
-	meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+	meta_flags = F_TRACE_CALLS | F_NOW_TS;
 	tracee_flags = &meta_flags;
 #ifdef ERTS_SMP
 	tracee = NIL;
@@ -1367,8 +1563,10 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
     name = fi[1];
     arity = fi[2];
     
+    ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
     if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+6+5)
+#define LOCAL_HEAP_SIZE (4+6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 	hp = local_heap;
@@ -1377,9 +1575,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
 	mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval);
 	hp += 6;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(ts_type, mess, hp, NULL, NULL);
 	send_to_port(p, mess, tracer_pid, tracee_flags);
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -1390,24 +1586,15 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
 	ERTS_TRACER_REF_TYPE tracer_ref;
 	unsigned size;
 	unsigned retval_size;
-#ifdef DEBUG
-	Eterm* limit;
-#endif
 
 	ASSERT(is_internal_pid(*tracer_pid));
 
 	ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags);
-	
+
 	retval_size = size_object(retval);
-	size = 6 + 4 + retval_size;
-	if (*tracee_flags & F_TIMESTAMP) {
-	    size += 1+4;
-	}
+	size = 6 + 4 + retval_size + patch_ts_size(ts_type);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
-	limit = hp + size;
-#endif
 
 	/*
 	 * Build the trace tuple and put it into receive queue of the tracer process.
@@ -1421,11 +1608,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
-
-	ASSERT(hp == limit);
+	PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -1448,6 +1631,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
     Eterm cv;
     Eterm mess;
     Uint meta_flags, *tracee_flags;
+    int ts_type;
 #ifdef ERTS_SMP
     Eterm tracee;
 #endif
@@ -1486,15 +1670,17 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
 	 *     meta trace =>
 	 *       use fixed flag set instead of process flags
 	 */	    
-	meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+	meta_flags = F_TRACE_CALLS | F_NOW_TS;
 	tracee_flags = &meta_flags;
 #ifdef ERTS_SMP
 	tracee = NIL;
 #endif
     }
     
+    ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
     if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+3+6+5)
+#define LOCAL_HEAP_SIZE (4+3+6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -1507,10 +1693,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
 	hp += 6;
 	ASSERT((hp - local_heap) <= LOCAL_HEAP_SIZE);
 	erts_smp_mtx_lock(&smq_mtx);
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp); /* hp += 5 */
-	    ASSERT((hp - local_heap) == LOCAL_HEAP_SIZE);
-	}
+	PATCH_TS(ts_type, mess, hp, NULL, NULL);
 	send_to_port(p, mess, tracer_pid, tracee_flags);
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -1521,24 +1704,15 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
 	ERTS_TRACER_REF_TYPE tracer_ref;
 	unsigned size;
 	unsigned value_size;
-#ifdef DEBUG
-	Eterm* limit;
-#endif
 
 	ASSERT(is_internal_pid(*tracer_pid));
 
 	ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags);
 	
 	value_size = size_object(value);
-	size = 6 + 4 + 3 + value_size;
-	if (*tracee_flags & F_TIMESTAMP) {
-	    size += 1+4;
-	}
+	size = 6 + 4 + 3 + value_size + patch_ts_size(ts_type);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
-	limit = hp + size;
-#endif
 
 	/*
 	 * Build the trace tuple and put it into receive queue of the tracer process.
@@ -1555,11 +1729,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
-
-	ASSERT(hp == limit);
+	PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -1592,6 +1762,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
     Eterm pam_result = am_true;
     Eterm mess;
     Uint meta_flags, *tracee_flags;
+    int ts_type;
 #ifdef ERTS_SMP
     Eterm tracee;
 #endif
@@ -1633,7 +1804,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 	    /* No trace messages for sensitive processes. */
 	    return 0;
 	}
-	meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+	meta_flags = F_TRACE_CALLS | F_NOW_TS;
 	tracee_flags = &meta_flags;
 #ifdef ERTS_SMP
 	tracee = NIL;
@@ -1676,12 +1847,14 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
     }
     args = transformed_args;
 
+    ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
     if (is_internal_port(*tracer_pid)) {
 #if HEAP_ON_C_STACK
-	Eterm local_heap[64+MAX_ARG];
+	Eterm local_heap[60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG];
 #else
 	Eterm *local_heap = erts_alloc(ERTS_ALC_T_TEMP_TERM,
-				       sizeof(Eterm)*(64+MAX_ARG));
+				       sizeof(Eterm)*(60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG));
 #endif
 	hp = local_heap;
 
@@ -1796,9 +1969,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 	    *hp++ = pam_result;
 	}
 	erts_smp_mtx_lock(&smq_mtx);
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(ts_type, mess, hp, NULL, NULL);
 	send_to_port(p, mess, tracer_pid, tracee_flags);
 	erts_smp_mtx_unlock(&smq_mtx);
 	erts_match_set_release_result(p);
@@ -1820,9 +1991,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 	unsigned sizes[MAX_ARG];
 	unsigned pam_result_size = 0;
 	int invalid_tracer;
-#ifdef DEBUG
-	Eterm* limit;
-#endif
 
 	ASSERT(is_internal_pid(*tracer_pid));
 	
@@ -1915,10 +2083,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 		size += sizes[i];
 	    }
 	}
-	if (*tracee_flags & F_TIMESTAMP) {
-	    size += 1 + 4;
-	    /* One element in trace tuple + timestamp tuple. */
-	}
+	size += patch_ts_size(ts_type);
 	if (pam_result != am_true) {
 	    pam_result_size = size_object(pam_result);
 	    size += 1 + pam_result_size;
@@ -1926,9 +2091,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 	}
 	
 	hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
-	limit = hp + size;
-#endif
 
 	/*
 	 * Build the the {M,F,A} tuple in the message buffer. 
@@ -1971,11 +2133,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (*tracee_flags & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
-
-	ASSERT(hp == limit);
+	PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
 	UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
@@ -2010,9 +2168,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
 	mess = TUPLE4(hp, am_trace, t_p->common.id, what, data);
 	hp += 5;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL);
 	send_to_port(
 #ifndef ERTS_SMP
 	    /* No fake schedule out and in again after an exit */
@@ -2042,7 +2198,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
 
 	sz_data = size_object(data);
 
-	need = sz_data + 5 + TS_SIZE(t_p);
+	need = sz_data + 5 + PATCH_TS_SIZE(t_p);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
 
@@ -2052,9 +2208,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -2088,9 +2242,7 @@ trace_proc_spawn(Process *p, Eterm pid,
 	mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, pid, mfa);
 	hp += 6;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
 	send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 #undef LOCAL_HEAP_SIZE
@@ -2111,7 +2263,7 @@ trace_proc_spawn(Process *p, Eterm pid,
 
 	sz_args = size_object(args);
 	sz_pid = size_object(pid);
-	need = sz_args + 4 + 6 + TS_SIZE(p);
+	need = sz_args + 4 + 6 + PATCH_TS_SIZE(p);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
 
@@ -2124,9 +2276,7 @@ trace_proc_spawn(Process *p, Eterm pid,
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -2208,11 +2358,8 @@ trace_gc(Process *p, Eterm what)
 #define LOCAL_HEAP_SIZE						\
     (sizeof(values)/sizeof(*values)) *				\
 	(2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) +	\
-	5/*4-tuple */ + TS_HEAP_WORDS
+	5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE
     DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
-#ifdef DEBUG
-    Eterm* limit;
-#endif
 
     ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm));
 
@@ -2227,7 +2374,7 @@ trace_gc(Process *p, Eterm what)
 					    sizeof(values)/sizeof(*values),
 					    tags,
 					    values);
-	size += 5/*4-tuple*/ + TS_SIZE(p);
+	size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
 #endif
     } else {
 	ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
@@ -2242,15 +2389,12 @@ trace_gc(Process *p, Eterm what)
 					    sizeof(values)/sizeof(*values),
 					    tags,
 					    values);
-	size += 5/*4-tuple*/ + TS_SIZE(p);
+	size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
 
 	hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
     }
 
-#ifdef DEBUG
-    limit = hp + size;
     ASSERT(size <= LOCAL_HEAP_SIZE);
-#endif
 
     msg = erts_bld_atom_uword_2tup_list(&hp,
 				       NULL,
@@ -2263,14 +2407,14 @@ trace_gc(Process *p, Eterm what)
 
     erts_smp_mtx_lock(&smq_mtx);
 
-    if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	hp = patch_ts(msg, hp);
-    }
-    ASSERT(hp == limit);
-    if (is_internal_port(ERTS_TRACER_PROC(p)))
+    if (is_internal_port(ERTS_TRACER_PROC(p))) {
+	PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, NULL, NULL);
 	send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
-    else
+    }
+    else {
+	PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, msg, bp);
+    }
     erts_smp_mtx_unlock(&smq_mtx);
     UnUseTmpHeap(LOCAL_HEAP_SIZE,p);
 #undef LOCAL_HEAP_SIZE
@@ -2574,19 +2718,18 @@ monitor_generic(Process *p, Eterm type, Eterm spec) {
 
 void
 profile_scheduler(Eterm scheduler_id, Eterm state) {
-    Eterm *hp, msg, timestamp;
-    Uint Ms, s, us;
+    Eterm *hp, msg;
+    ErlHeapFragment *bp = NULL;
 
 #ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 7)
+#define LOCAL_HEAP_SIZE (7 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
     UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
     hp = local_heap;
 #else
-    ErlHeapFragment *bp;
     Uint hsz;
 
-    hsz = 4 + 7;
+    hsz = 7 + patch_ts_size(erts_system_profile_ts_type)-1;
 	
     bp = new_message_buffer(hsz);
     hp = bp->mem;
@@ -2606,10 +2749,13 @@ profile_scheduler(Eterm scheduler_id, Eterm state) {
 	break;
     }
 
-    GET_NOW(&Ms, &s, &us);
-    timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
-    msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state,
-		 make_small(active_sched), timestamp); hp += 7;
+    msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id,
+		 state, make_small(active_sched),
+		 NIL /* Will be overwritten by timestamp */);
+    hp += 7;
+
+    /* Write timestamp in element 6 of the 'msg' tuple */
+    hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
 
 #ifndef ERTS_SMP
     profile_send(NIL, msg);
@@ -2680,7 +2826,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
     Eterm* hp;
 
     if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
+#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -2689,9 +2835,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
 	mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name);
 	hp += 6;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
 	/* No fake schedule */
 	send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2705,7 +2849,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
 	
 	ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
 
-	sz_data = 6 + TS_SIZE(p);
+	sz_data = 6 + PATCH_TS_SIZE(p);
 
 	ERTS_GET_TRACER_REF(tracer_ref,
 			    ERTS_TRACER_PROC(p),
@@ -2718,9 +2862,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -2744,7 +2886,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
 		       || erts_thr_progress_is_blocking());
 
     if (is_internal_port(ERTS_TRACER_PROC(t_p))) {
-#define LOCAL_HEAP_SIZE (5+5)
+#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -2752,9 +2894,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
 	mess = TUPLE4(hp, am_trace, t_p->common.id, what, data);
 	hp += 5;
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL);
 	/* No fake schedule */
 	send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p));
 	UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2768,7 +2908,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
 
 	ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p)));
 
-	sz_data = 5 + TS_SIZE(t_p);
+	sz_data = 5 + PATCH_TS_SIZE(t_p);
 
 	ERTS_GET_TRACER_REF(tracer_ref,
 			    ERTS_TRACER_PROC(t_p),
@@ -2781,9 +2921,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+	PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref);
 
 	ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
@@ -2811,7 +2949,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
     Eterm sched_id = am_undefined;
     
     if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
+#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
 	DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
 	UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
@@ -2834,9 +2972,8 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
 	hp += ws;
 	
 	erts_smp_mtx_lock(&smq_mtx);
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
+
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
 	
 	/* No fake scheduling */
 	send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
@@ -2856,7 +2993,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
 			    ERTS_TRACER_PROC(p),
 			    ERTS_TRACE_FLAGS(p));
 
-	hp = ERTS_ALLOC_SYSMSG_HEAP(ws+TS_SIZE(p), &bp, &off_heap, tracer_ref);
+	hp = ERTS_ALLOC_SYSMSG_HEAP(ws+PATCH_TS_SIZE(p), &bp, &off_heap, tracer_ref);
 
 	if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) {
 #ifdef ERTS_SMP
@@ -2874,10 +3011,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
 
 	erts_smp_mtx_lock(&smq_mtx);
 
-	if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
-	    hp = patch_ts(mess, hp);
-	}
-
+	PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
 	ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
     }
@@ -2887,13 +3021,12 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
 
 void
 profile_runnable_port(Port *p, Eterm status) {
-    Uint Ms, s, us;
-    Eterm *hp, msg, timestamp;
-
+    Eterm *hp, msg;
+    ErlHeapFragment *bp = NULL;
     Eterm count = make_small(0);
 
 #ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 6)
+#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
 
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
     UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2901,10 +3034,9 @@ profile_runnable_port(Port *p, Eterm status) {
     hp = local_heap;
     
 #else
-    ErlHeapFragment *bp;
     Uint hsz;
 
-    hsz = 4 + 6;
+    hsz = 6 + patch_ts_size(erts_system_profile_ts_type)-1;
 
     bp = new_message_buffer(hsz);
     hp = bp->mem;
@@ -2912,9 +3044,12 @@ profile_runnable_port(Port *p, Eterm status) {
 
     erts_smp_mtx_lock(&smq_mtx);
 
-    GET_NOW(&Ms, &s, &us);
-    timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
-    msg = TUPLE5(hp, am_profile, p->common.id, status, count, timestamp); hp += 6;
+    msg = TUPLE5(hp, am_profile, p->common.id, status, count,
+		 NIL /* Will be overwritten by timestamp */);
+    hp += 6;
+
+    /* Write timestamp in element 5 of the 'msg' tuple */
+    hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
 
 #ifndef ERTS_SMP
     profile_send(p->common.id, msg);
@@ -2929,20 +3064,19 @@ profile_runnable_port(Port *p, Eterm status) {
 /* Process profiling */
 void 
 profile_runnable_proc(Process *p, Eterm status){
-    Uint Ms, s, us;
-    Eterm *hp, msg, timestamp;
+    Eterm *hp, msg;
     Eterm where = am_undefined;
+    ErlHeapFragment *bp = NULL;
 
 #ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 6 + 4)
+#define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
 
     DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
     UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
 
     hp = local_heap;
 #else
-    ErlHeapFragment *bp;
-    Uint hsz = 4 + 6 + 4;
+    Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1;
 #endif
 	
     if (!p->current) {
@@ -2951,7 +3085,7 @@ profile_runnable_proc(Process *p, Eterm status){
 
 #ifdef ERTS_SMP
     if (!p->current) {
-	hsz = 4 + 6;
+	hsz -= 4;
     }
 
     bp = new_message_buffer(hsz);
@@ -2966,9 +3100,13 @@ profile_runnable_proc(Process *p, Eterm status){
 	
     erts_smp_mtx_lock(&smq_mtx);
 
-    GET_NOW(&Ms, &s, &us);
-    timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
-    msg = TUPLE5(hp, am_profile, p->common.id, status, where, timestamp); hp += 6;
+    msg = TUPLE5(hp, am_profile, p->common.id, status, where,
+		 NIL /* Will be overwritten by timestamp */);
+    hp += 6;
+
+    /* Write timestamp in element 5 of the 'msg' tuple */
+    hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
+
 #ifndef ERTS_SMP
     profile_send(p->common.id, msg);
     UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 7405490f76..a0058264d7 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -18,8 +18,38 @@
  * %CopyrightEnd%
  */
 
+#ifndef ERL_TRACE_H__FLAGS__
+#define ERL_TRACE_H__FLAGS__
+/*
+ * NOTE! The bits used for these flags matter. The flag with
+ * the least significant bit will take precedence!
+ *
+ * The "now timestamp" has highest precedence due to
+ * compatibility reasons.
+ */
+#define ERTS_TRACE_FLG_NOW_TIMESTAMP			(1 << 0)
+#define ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP	(1 << 1)
+#define ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP		(1 << 2)
+
+/*
+ * The bits used effects trace flags (of processes and ports)
+ * as well as sequential trace flags. If changed make sure
+ * these arn't messed up...
+ */
+#define ERTS_TRACE_TS_TYPE_BITS 			3
+#define ERTS_TRACE_TS_TYPE_MASK					\
+    ((1 << ERTS_TRACE_TS_TYPE_BITS) - 1)
+
+#define ERTS_TFLGS2TSTYPE(TFLGS)				\
+    ((int) (((TFLGS) >> ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) 	\
+	    & ERTS_TRACE_TS_TYPE_MASK))
+#define ERTS_SEQTFLGS2TSTYPE(SEQTFLGS)				\
+    ((int) (((SEQTFLGS) >> ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)	\
+	    & ERTS_TRACE_TS_TYPE_MASK))
+
+#endif /* ERL_TRACE_H__FLAGS__ */
 
-#ifndef ERL_TRACE_H__
+#if !defined(ERL_TRACE_H__) && !defined(ERTS_ONLY_INCLUDE_TRACE_FLAGS)
 #define ERL_TRACE_H__
 
 struct binary;
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index e4b6511d1f..2ecb4a28a7 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -113,13 +113,27 @@ runnable_procs(suite) ->
 runnable_procs(doc) ->
     ["Tests system_profiling with runnable_procs."];
 runnable_procs(Config) when is_list(Config) ->
+    lists:foreach(fun (TsType) ->
+			  Arg = case TsType of
+				    no_timestamp ->
+					{timestamp, []};
+				    _ ->
+					{TsType, [TsType]}
+				end,
+			  do_runnable_procs(Arg),
+			  receive after 1000 -> ok end
+		  end,
+		  [no_timestamp, timestamp, monotonic_timestamp,
+		   strict_monotonic_timestamp]).
+
+do_runnable_procs({TsType, TsTypeFlag}) ->
     Pid = start_profiler_process(),
     % start a ring of processes
     % FIXME: Set #laps and #nodes in config file
     Nodes = 10,
     Laps = 10,
     Master = ring(Nodes),
-    undefined = erlang:system_profile(Pid, [runnable_procs]),
+    undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag),
     % loop a message
     ok = ring_message(Master, message, Laps),
     Events = get_profiler_events(),
@@ -127,9 +141,9 @@ runnable_procs(Config) when is_list(Config) ->
     erlang:system_profile(undefined, []),
     put(master, Master),
     put(laps, Laps),
-    true = has_runnable_event(Events),
+    true = has_runnable_event(TsType, Events),
     Pids = sort_events_by_pid(Events),
-    ok = check_events(Pids),
+    ok = check_events(TsType, Pids),
     erase(),
     exit(Pid,kill),
     ok.
@@ -139,8 +153,22 @@ runnable_ports(suite) ->
 runnable_ports(doc) ->
     ["Tests system_profiling with runnable_port."];
 runnable_ports(Config) when is_list(Config) ->
+    lists:foreach(fun (TsType) ->
+			  Arg = case TsType of
+				    no_timestamp ->
+					{timestamp, []};
+				    _ ->
+					{TsType, [TsType]}
+				end,
+			  do_runnable_ports(Arg, Config),
+			  receive after 1000 -> ok end
+		  end,
+		  [no_timestamp, timestamp, monotonic_timestamp,
+		   strict_monotonic_timestamp]).
+
+do_runnable_ports({TsType, TsTypeFlag}, Config) ->
     Pid = start_profiler_process(),
-    undefined = erlang:system_profile(Pid, [runnable_ports]),
+    undefined = erlang:system_profile(Pid, [runnable_ports]++TsTypeFlag),
     EchoPid = echo(Config),
     % FIXME: Set config to number_of_echos
     Laps = 10,
@@ -149,9 +177,9 @@ runnable_ports(Config) when is_list(Config) ->
     Events = get_profiler_events(),
     kill_em_all = kill_echo(EchoPid),
     erlang:system_profile(undefined, []),
-    true = has_runnable_event(Events),
+    true = has_runnable_event(TsType, Events),
     Pids = sort_events_by_pid(Events),
-    ok = check_events(Pids),
+    ok = check_events(TsType, Pids),
     erase(),
     exit(Pid,kill),
     ok.
@@ -166,8 +194,19 @@ scheduler(Config) when is_list(Config) ->
 	{_,    1} -> {skipped, "No need for scheduler test when only one scheduler online."};
 	_ ->
 	    Nodes = 10,
-	    ok = check_block_system(Nodes),
-	    ok = check_multi_scheduling_block(Nodes)
+	    lists:foreach(fun (TsType) ->
+				  Arg = case TsType of
+					    no_timestamp ->
+						{timestamp, []};
+					    _ ->
+						{TsType, [TsType]}
+					end,
+				  ok = check_block_system(Arg, Nodes),
+				  ok = check_multi_scheduling_block(Arg, Nodes),
+				  receive after 1000 -> ok end
+			      end,
+			  [no_timestamp, timestamp, monotonic_timestamp,
+			   strict_monotonic_timestamp])
     end.
 
 % the profiler pid should not be profiled
@@ -195,9 +234,9 @@ dont_profile_profiler(Config) when is_list(Config) ->
 
 %%% Check scheduler profiling
 
-check_multi_scheduling_block(Nodes) ->
+check_multi_scheduling_block({TsType, TsTypeFlag}, Nodes) ->
     Pid = start_profiler_process(),
-    undefined = erlang:system_profile(Pid, [scheduler]),
+    undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag),
     {ok, Supervisor} = start_load(Nodes),
     wait(600),
     erlang:system_flag(multi_scheduling, block),
@@ -205,23 +244,23 @@ check_multi_scheduling_block(Nodes) ->
     erlang:system_flag(multi_scheduling, unblock),
     {Pid, [scheduler]} = erlang:system_profile(undefined, []),
     Events = get_profiler_events(),
-    true = has_scheduler_event(Events),
+    true = has_scheduler_event(TsType, Events),
     stop_load(Supervisor),
     exit(Pid,kill),
     erase(),
     ok.
 
-check_block_system(Nodes) ->
+check_block_system({TsType, TsTypeFlag}, Nodes) ->
     Dummy = spawn(?MODULE, profiler_process, [[]]),
     Pid = start_profiler_process(),
-    undefined = erlang:system_profile(Pid, [scheduler]),
+    undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag),
     {ok, Supervisor} = start_load(Nodes),
     wait(300),
     undefined = erlang:system_monitor(Dummy, [busy_port]),
     {Dummy, [busy_port]} = erlang:system_monitor(undefined, []),
     {Pid, [scheduler]} = erlang:system_profile(undefined, []),
     Events = get_profiler_events(),
-    true = has_scheduler_event(Events),
+    true = has_scheduler_event(TsType, Events),
     stop_load(Supervisor),
     exit(Pid,kill),
     exit(Dummy,kill),
@@ -230,40 +269,49 @@ check_block_system(Nodes) ->
 
 %%% Check events
 
-check_events([]) -> ok;
-check_events([Pid | Pids]) ->
+check_events(_TsType, []) -> ok;
+check_events(TsType, [Pid | Pids]) ->
     Master = get(master),
     Laps = get(laps),
     CheckPids = get(pids),
     {Events, N} = get_pid_events(Pid),
     ok = check_event_flow(Events),
-    ok = check_event_ts(Events),
+    ok = check_event_ts(TsType, Events),
     IsMember = lists:member(Pid, CheckPids),
     case Pid of
     	Master ->
 	    io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]),
 	    N = Laps*2 + 2,
-    	    check_events(Pids);
+    	    check_events(TsType, Pids);
 	Pid when IsMember == true ->
 	    io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]),
 	    N = Laps*2,
-    	    check_events(Pids);
+    	    check_events(TsType, Pids);
 	Pid ->
-	    check_events(Pids)
+	    check_events(TsType, Pids)
     end.
 
 %% timestamp consistency check for descending timestamps
 
-check_event_ts(Events) ->
-    check_event_ts(Events, undefined).
-check_event_ts([], _) -> ok;
-check_event_ts([Event | Events], undefined) ->
-    check_event_ts(Events, Event);
-check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) ->
-    Time = timer:now_diff(TS1, TS0),
+check_event_ts(TsType, Events) ->
+    check_event_ts(TsType, Events, undefined).
+check_event_ts(_TsType, [], _) -> ok;
+check_event_ts(TsType, [Event | Events], undefined) ->
+    check_event_ts(TsType, Events, Event);
+check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) ->
+    Time = case TsType of
+	       timestamp ->
+		   timer:now_diff(TS1, TS0);
+	       monotonic_timestamp ->
+		   TS1 - TS0;
+	       strict_monotonic_timestamp ->
+		   {MT1, _} = TS1,
+		   {MT0, _} = TS0,
+		   MT1 - MT0
+	   end,
     if 
     	Time < 0.0 -> timestamp_error;
-    	true -> check_event_ts(Events, Event)
+    	true -> check_event_ts(TsType, Events, Event)
     end.
 
 %% consistency check for active vs. inactive activity (runnable)
@@ -428,6 +476,44 @@ port_echo_loop(Port) ->
 %% Helpers
 %%%
 
+check_ts(no_timestamp, Ts) ->
+    try
+	no_timestamp = Ts
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(timestamp, Ts) ->
+    try
+	{Ms,S,Us} = Ts,
+	true = is_integer(Ms),
+	true = is_integer(S),
+	true = is_integer(Us)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(monotonic_timestamp, Ts) ->
+    try
+	true = is_integer(Ts)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(strict_monotonic_timestamp, Ts) ->
+    try
+	{MT, UMI} = Ts,
+	true = is_integer(MT),
+	true = is_integer(UMI)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok.
+
 start_load(N) ->
    Pid = spawn_link(?MODULE, run_load, [N, []]),
    {ok, Pid}.
@@ -454,21 +540,24 @@ list_load() ->
     end,
     list_load().
 
-
-has_scheduler_event(Events) ->
+has_scheduler_event(TsType, Events) ->
     lists:any(
     	fun (Pred) ->
 	    case Pred of 
-	    	{profile, scheduler, _ID, _Activity, _NR, _TS} -> true;
+	    	{profile, scheduler, _ID, _Activity, _NR, TS} ->
+		    check_ts(TsType, TS),
+		    true;
 		_ -> false
 	    end
 	end, Events).
 
-has_runnable_event(Events) ->
+has_runnable_event(TsType, Events) ->
     lists:any(
     	fun (Pred) ->
 	    case Pred of
-	    	{profile, _Pid, _Activity, _MFA, _TS} -> true;
+	    	{profile, _Pid, _Activity, _MFA, TS} ->
+		    check_ts(TsType, TS),
+		    true;
 	    	_ -> false
 	    end
         end, Events).
diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl
index a12c41a3aa..760666d077 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -67,7 +67,8 @@ trace_on_and_off(Config) when is_list(Config) ->
     ?line Pid = spawn(?MODULE, bif_process, []),
     ?line Self = self(),
     ?line 1 = erlang:trace(Pid, true, [call,timestamp]),
-    ?line {flags,[timestamp,call]} =  erlang:trace_info(Pid,flags),
+    ?line {flags, Flags} = erlang:trace_info(Pid,flags),
+    ?line [call,timestamp] = lists:sort(Flags),
     ?line {tracer, Self} = erlang:trace_info(Pid,tracer),
     ?line 1 = erlang:trace(Pid, false, [timestamp]),
     ?line {flags,[call]} =  erlang:trace_info(Pid,flags),
@@ -111,93 +112,145 @@ do_trace_bif(Flags) ->
 
 trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps.";
 trace_bif_timestamp(Config) when is_list(Config) ->
-    do_trace_bif_timestamp([]).
-
+    do_trace_bif_timestamp([], timestamp, [timestamp]),
+    do_trace_bif_timestamp([], timestamp,
+			   [timestamp,
+			    monotonic_timestamp,
+			    strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([], strict_monotonic_timestamp,
+			   [strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([], strict_monotonic_timestamp,
+			   [monotonic_timestamp, strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]).
+    
 trace_bif_timestamp_local(doc) -> 
     "Test tracing BIFs with timestamps and local flag.";
 trace_bif_timestamp_local(Config) when is_list(Config) ->
-    do_trace_bif_timestamp([local]).
-
-do_trace_bif_timestamp(Flags) ->
-    ?line Pid=spawn(?MODULE, bif_process, []),
-    ?line 1 = erlang:trace(Pid, true, [call,timestamp]),
-    ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags),
-
-    ?line Pid ! {do_bif, time, []},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}),
-
-    ?line Pid ! {do_bif, statistics, [runtime]},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,statistics, [runtime]}}),
-
-    ?line Pid ! {do_time_bif},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,time, []}}),
-
-    ?line Pid ! {do_statistics_bif},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,statistics, [runtime]}}),
+    do_trace_bif_timestamp([local], timestamp, [timestamp]),
+    do_trace_bif_timestamp([local], timestamp,
+			   [timestamp,
+			    monotonic_timestamp,
+			    strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([local], strict_monotonic_timestamp,
+			   [strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([local], strict_monotonic_timestamp,
+			   [monotonic_timestamp, strict_monotonic_timestamp]),
+    do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]).
+
+do_trace_bif_timestamp(Flags, TsType, TsFlags) ->
+    io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
+    Pid=spawn(?MODULE, bif_process, []),
+    1 = erlang:trace(Pid, true, [call]++TsFlags),
+    erlang:trace_pattern({erlang,'_','_'}, [], Flags),
+
+    Ts0 = make_ts(TsType),
+    Pid ! {do_bif, time, []},
+    Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
+			       Ts0,TsType),
+
+    Pid ! {do_bif, statistics, [runtime]},
+    Ts2 = receive_trace_msg_ts({trace_ts,Pid,call,
+				{erlang,statistics, [runtime]}},
+			       Ts1, TsType),
+
+    Pid ! {do_time_bif},
+    Ts3 = receive_trace_msg_ts({trace_ts,Pid,call,
+				{erlang,time, []}},
+			       Ts2, TsType),
+
+    Pid ! {do_statistics_bif},
+    Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
+				{erlang,statistics, [runtime]}},
+			       Ts3, TsType),
+
+    check_ts(TsType, Ts4, make_ts(TsType)),
 
     %% We should be able to turn off the timestamp.
-    ?line 1 = erlang:trace(Pid, false, [timestamp]),
+    1 = erlang:trace(Pid, false, TsFlags),
 
-    ?line Pid ! {do_statistics_bif},
-    ?line receive_trace_msg({trace,Pid,call,
-			     {erlang,statistics, [runtime]}}),
+    Pid ! {do_statistics_bif},
+    receive_trace_msg({trace,Pid,call,
+		       {erlang,statistics, [runtime]}}),
 
-    ?line Pid ! {do_bif, statistics, [runtime]},
-    ?line receive_trace_msg({trace,Pid,call,
-			     {erlang,statistics, [runtime]}}),
+    Pid ! {do_bif, statistics, [runtime]},
+    receive_trace_msg({trace,Pid,call,
+		       {erlang,statistics, [runtime]}}),
 
-    ?line 1 = erlang:trace(Pid, false, [call]),
-    ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags),
+    1 = erlang:trace(Pid, false, [call]),
+    erlang:trace_pattern({erlang,'_','_'}, false, Flags),
 
-    ?line exit(Pid, die),
+    exit(Pid, die),
     ok.
 
 trace_bif_return(doc) -> 
     "Test tracing BIF's with return/return_to trace.";
 trace_bif_return(Config) when is_list(Config) ->
-    ?line Pid=spawn(?MODULE, bif_process, []),
-    ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]),
-    ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], 
-			       [local]),
-
-
-    ?line Pid ! {do_bif, time, []},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}),
-    ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
-					    {erlang,time,0}}),
-    ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
-					  {?MODULE, bif_process,0}}),
-
-
-    ?line Pid ! {do_bif, statistics, [runtime]},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,statistics, [runtime]}}),
-    ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
-					    {erlang,statistics,1}}),
-    ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
-					  {?MODULE, bif_process,0}}),
-
-
-    ?line Pid ! {do_time_bif},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,time, []}}),
-    ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
-					    {erlang,time,0}}),
-    ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
-					  {?MODULE, bif_process,0}}),
-
-
-
-    ?line Pid ! {do_statistics_bif},
-    ?line receive_trace_msg_ts({trace_ts,Pid,call,
-			     {erlang,statistics, [runtime]}}),
-    ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
-					    {erlang,statistics,1}}),
-    ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
-					  {?MODULE, bif_process,0}}),
+    do_trace_bif_return(timestamp, [timestamp]),
+    do_trace_bif_return(timestamp,
+			[timestamp,
+			 monotonic_timestamp,
+			 strict_monotonic_timestamp]),
+    do_trace_bif_return(strict_monotonic_timestamp,
+			[strict_monotonic_timestamp]),
+    do_trace_bif_return(strict_monotonic_timestamp,
+			[monotonic_timestamp, strict_monotonic_timestamp]),
+    do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]).
+
+do_trace_bif_return(TsType, TsFlags) ->
+    io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
+    Pid=spawn(?MODULE, bif_process, []),
+    1 = erlang:trace(Pid, true, [call,return_to]++TsFlags),
+    erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], 
+			 [local]),
+
+    Ts0 = make_ts(TsType),
+    Pid ! {do_bif, time, []},
+    Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
+			       Ts0, TsType),
+    Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+					    {erlang,time,0}},
+					   Ts1, TsType),
+    Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
+					  {?MODULE, bif_process,0}},
+					 Ts2, TsType),
+    
+    
+    Pid ! {do_bif, statistics, [runtime]},
+    Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
+				{erlang,statistics, [runtime]}},
+			       Ts3, TsType),
+    Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+					    {erlang,statistics,1}},
+					   Ts4, TsType),
+    Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
+					  {?MODULE, bif_process,0}},
+					 Ts5, TsType),
+    
+    
+    Pid ! {do_time_bif},
+    Ts7 = receive_trace_msg_ts({trace_ts,Pid,call,
+				{erlang,time, []}},
+			       Ts6, TsType),
+    Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+					    {erlang,time,0}},
+					   Ts7, TsType),
+    Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
+					  {?MODULE, bif_process,0}},
+					 Ts8, TsType),
+
+
+
+    Pid ! {do_statistics_bif},
+    Ts10 = receive_trace_msg_ts({trace_ts,Pid,call,
+				 {erlang,statistics, [runtime]}},
+				Ts9, TsType),
+    Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+					     {erlang,statistics,1}},
+					    Ts10, TsType),
+    Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, 
+					   {?MODULE, bif_process,0}},
+					  Ts11, TsType),
+    check_ts(TsType, Ts12, make_ts(TsType)),
     ok.
     
     
@@ -213,10 +266,11 @@ receive_trace_msg(Mess) ->
 	    ?t:fail()
     end.
 
-receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) ->
+receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) ->
     receive
-	{trace_ts, Pid, call, {erlang, F, A}, _Ts} ->
-	    ok;
+	{trace_ts, Pid, call, {erlang, F, A}, Ts} ->
+	    check_ts(TsType, PrevTs, Ts),
+	    Ts;
 	Other ->
 	    io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
 		      "Got: ~p~n",
@@ -227,10 +281,11 @@ receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) ->
 	    ?t:fail()
     end.
 
-receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) ->
+receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) ->
     receive
-	{trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} ->
-	    ok;
+	{trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} ->
+	    check_ts(TsType, PrevTs, Ts),
+	    Ts;
 	Other ->
 	    io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
 		      "Got: ~p~n",
@@ -241,10 +296,11 @@ receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) ->
 	    ?t:fail()
     end.
 
-receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) ->
+receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) ->
     receive
-	{trace_ts, Pid, return_to, {M, F, A}, _Ts} ->
-	    ok;
+	{trace_ts, Pid, return_to, {M, F, A}, Ts} ->
+	    check_ts(TsType, PrevTs, Ts),
+	    Ts;
 	Other ->
 	    io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
 		      "Got: ~p~n",
@@ -255,6 +311,33 @@ receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) ->
 	    ?t:fail()
     end.
 
+make_ts(timestamp) ->
+    erlang:now();
+make_ts(monotonic_timestamp) ->
+    erlang:monotonic_time();
+make_ts(strict_monotonic_timestamp) ->
+    MT = erlang:monotonic_time(),
+    UMI = erlang:unique_integer([monotonic]),
+    {MT, UMI}.
+
+check_ts(timestamp, PrevTs, Ts) ->
+    {Ms, S, Us} = Ts,
+    true = is_integer(Ms),
+    true = is_integer(S),
+    true = is_integer(Us),
+    true = PrevTs < Ts,
+    Ts;
+check_ts(monotonic_timestamp, PrevTs, Ts) ->
+    true = is_integer(Ts),
+    true = PrevTs =< Ts,
+    Ts;
+check_ts(strict_monotonic_timestamp, PrevTs, Ts) ->
+    {MT, UMI} = Ts,
+    true = is_integer(MT),
+    true = is_integer(UMI),
+    true = PrevTs < Ts,
+    Ts.
+
 bif_process() ->
     receive
 	{do_bif, Name, Args} ->
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 58516c0ff3..36862802ca 100644
Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 5fc6d14938..063b9a1f26 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -185,6 +185,8 @@
       'receive' |
       'print' |
       'timestamp' |
+      'monotonic_timestamp' |
+      'strict_monotonic_timestamp' |
       'label' |
       'serial'.
 
@@ -198,7 +200,10 @@
       'exclusive' |
       'runnable_ports' |
       'runnable_procs' |
-      'scheduler'.
+      'scheduler' |
+      'timestamp' |
+      'monotonic_timestamp' |
+      'strict_monotonic_timestamp'.
 
 -type system_monitor_option() ::
       'busy_port' |
@@ -230,6 +235,8 @@
       garbage_collection |
       timestamp |
       cpu_timestamp |
+      monotonic_timestamp |
+      strict_monotonic_timestamp |
       arity |
       set_on_spawn |
       set_on_first_spawn |
@@ -258,6 +265,8 @@
       running |
       garbage_collection |
       timestamp |
+      monotonic_timestamp |
+      strict_monotonic_timestamp |
       arity.
 
 -type trace_info_return() ::
@@ -2178,6 +2187,8 @@ send(_Dest,_Msg,_Options) ->
                     ('receive') -> {'receive', boolean()};
                     (print) -> {print, boolean()};
                     (timestamp) -> {timestamp, boolean()};
+                    (monotonic_timestamp) -> {timestamp, boolean()};
+                    (strict_monotonic_timestamp) -> {strict_monotonic_timestamp, boolean()};
                     (label) -> [] | {label, non_neg_integer()};
                     (serial) -> [] | {serial, {non_neg_integer(), non_neg_integer()}}.
 seq_trace_info(_What) ->
diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml
index 3439111035..9f191d488d 100644
--- a/lib/kernel/doc/src/seq_trace.xml
+++ b/lib/kernel/doc/src/seq_trace.xml
@@ -127,6 +127,34 @@ seq_trace:set_token(OldToken), % activate the trace token again
               enables/disables a timestamp to be generated for each
               traced event. Default is false.

           
+          set_token(strict_monotonic_timestamp, Bool)
+          
+            
A trace token flag (true | false) which
+            enables/disables a strict monotonic timestamp to be generated
+	    for each traced event. Default is false. Timestamps will
+	    consist of
+	    Erlang
+	    monotonic time and a monotonically increasing
+	    integer. The time-stamp has the same format and value
+	    as produced by {erlang:monotonic_time(),
+	    erlang:unique_integer([monotonic])}.

+          
+          set_token(monotonic_timestamp, Bool)
+          
+            
A trace token flag (true | false) which
+            enables/disables a strict monotonic timestamp to be generated
+	    for each traced event. Default is false. Timestamps
+	    will use
+	    Erlang
+	    monotonic time. The time-stamp has the same
+	    format and value as produced by erlang:monotonic_time().

+          
+	  
If multiple timestamp flags are passed, timestamp has
+	  precedence over strict_monotonic_timestamp which
+	  in turn has precedence over monotonic_timestamp. All
+	  timestamp flags are remembered, so if two are passed
+	  and the one with highest precedence later is disabled
+	  the other one will become active.

         
       
     
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index b5555ca1a5..419dc0a2fc 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -116,6 +116,6 @@
   {applications, []},
   {env, [{error_logger, tty}]},
   {mod, {kernel, []}},
-  {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]}
+  {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]}
  ]
 }.
diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl
index 07ccd3e494..a7a782c29c 100644
--- a/lib/kernel/src/seq_trace.erl
+++ b/lib/kernel/src/seq_trace.erl
@@ -23,7 +23,9 @@
 -define(SEQ_TRACE_SEND, 1).       %(1 << 0)
 -define(SEQ_TRACE_RECEIVE, 2).    %(1 << 1)
 -define(SEQ_TRACE_PRINT, 4).      %(1 << 2)
--define(SEQ_TRACE_TIMESTAMP, 8).  %(1 << 3)
+-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3)
+-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4)
+-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5)
 
 -export([set_token/1,
 	 set_token/2,
@@ -37,7 +39,7 @@
 
 %%---------------------------------------------------------------------------
 
--type flag()       :: 'send' | 'receive' | 'print' | 'timestamp'.
+-type flag()       :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'.
 -type component()  :: 'label' | 'serial' | flag().
 -type value()      :: (Integer :: non_neg_integer())
                     | {Previous :: non_neg_integer(),
@@ -135,5 +137,9 @@ decode_flags(Flags) ->
     Print = (Flags band ?SEQ_TRACE_PRINT) > 0,
     Send = (Flags band ?SEQ_TRACE_SEND) > 0,
     Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0,
-    Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0,
-    [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}].
+    NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0,
+    StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0,
+    MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0,
+    [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs},
+     {strict_monotonic_timestamp, StrictMonTs},
+     {monotonic_timestamp, MonTs}].
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
index 7df0bc3d2f..6a63f7bc9c 100644
--- a/lib/kernel/test/seq_trace_SUITE.erl
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -35,6 +35,11 @@
 						%-define(line_trace, 1).
 -include_lib("test_server/include/test_server.hrl").
 
+-define(TIMESTAMP_MODES, [no_timestamp,
+			  timestamp,
+			  monotonic_timestamp,
+			  strict_monotonic_timestamp]).
+
 -define(default_timeout, ?t:minutes(1)).
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -75,6 +80,17 @@ end_per_testcase(_Case, Config) ->
 token_set_get(doc) -> [];
 token_set_get(suite) -> [];
 token_set_get(Config) when is_list(Config) ->
+    do_token_set_get(timestamp),
+    do_token_set_get(monotonic_timestamp),
+    do_token_set_get(strict_monotonic_timestamp).
+    
+do_token_set_get(TsType) ->
+    io:format("Testing ~p~n", [TsType]),
+    Flags = case TsType of
+		timestamp -> 15;
+		strict_monotonic_timestamp -> 23;
+		monotonic_timestamp -> 39
+	    end,
     ?line Self = self(),
     ?line seq_trace:reset_trace(),
     %% Test that initial seq_trace is disabled
@@ -88,22 +104,22 @@ token_set_get(Config) when is_list(Config) ->
     ?line {send,true} = seq_trace:get_token(send),
     ?line false = seq_trace:set_token('receive',true),
     ?line {'receive',true} = seq_trace:get_token('receive'),
-    ?line false = seq_trace:set_token(timestamp,true),
-    ?line {timestamp,true} = seq_trace:get_token(timestamp),
+    ?line false = seq_trace:set_token(TsType,true),
+    ?line {TsType,true} = seq_trace:get_token(TsType),
     %% Check the whole token
-    ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set
+    ?line {Flags,17,0,Self,0} = seq_trace:get_token(), % all flags are set
     %% Test setting and reading the 'serial' field
     ?line {0,0} = seq_trace:set_token(serial,{3,5}),
     ?line {serial,{3,5}} = seq_trace:get_token(serial),
     %% Check the whole token, test that a whole token can be set and get
-    ?line {15,17,5,Self,3} = seq_trace:get_token(),
-    ?line seq_trace:set_token({15,19,7,Self,5}),
-    ?line {15,19,7,Self,5} = seq_trace:get_token(),
+    ?line {Flags,17,5,Self,3} = seq_trace:get_token(),
+    ?line seq_trace:set_token({Flags,19,7,Self,5}),
+    ?line {Flags,19,7,Self,5} = seq_trace:get_token(),
     %% Check that receive timeout does not reset token
     ?line receive after 0 -> ok end,
-    ?line {15,19,7,Self,5} = seq_trace:get_token(),
+    ?line {Flags,19,7,Self,5} = seq_trace:get_token(),
     %% Check that token can be unset
-    ?line {15,19,7,Self,5} = seq_trace:set_token([]),
+    ?line {Flags,19,7,Self,5} = seq_trace:set_token([]),
     ?line [] = seq_trace:get_token(),
     %% Check that Previous serial counter survived unset token
     ?line 0 = seq_trace:set_token(label, 17),
@@ -139,30 +155,42 @@ tracer_set_get(Config) when is_list(Config) ->
 print(doc) -> [];
 print(suite) -> [];
 print(Config) when is_list(Config) ->
+    lists:foreach(fun do_print/1, ?TIMESTAMP_MODES).
+    
+do_print(TsType) ->
     ?line start_tracer(),
-    ?line seq_trace:set_token(print,true),
+    ?line set_token_flags([print, TsType]),
     ?line seq_trace:print(0,print1),
     ?line seq_trace:print(1,print2),
     ?line seq_trace:print(print3),
     ?line seq_trace:reset_trace(),
-    ?line [{0,{print,_,_,[],print1}},
-	   {0,{print,_,_,[],print3}}] = stop_tracer(2).
+    ?line [{0,{print,_,_,[],print1}, Ts0},
+	   {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2),
+    check_ts(TsType, Ts0),
+    check_ts(TsType, Ts1).
     
 send(doc) -> [];
 send(suite) -> [];
 send(Config) when is_list(Config) ->
+    lists:foreach(fun do_send/1, ?TIMESTAMP_MODES).
+
+do_send(TsType) ->
     ?line seq_trace:reset_trace(),
     ?line start_tracer(),
     ?line Receiver = spawn(?MODULE,one_time_receiver,[]),
-    ?line seq_trace:set_token(send,true),
+    ?line set_token_flags([send, TsType]),
     ?line Receiver ! send,
     ?line Self = self(),
     ?line seq_trace:reset_trace(),
-    ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1).
+    ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
+    check_ts(TsType, Ts).
 
 distributed_send(doc) -> [];
 distributed_send(suite) -> [];
 distributed_send(Config) when is_list(Config) ->
+    lists:foreach(fun do_distributed_send/1, ?TIMESTAMP_MODES).
+
+do_distributed_send(TsType) ->
     ?line {ok,Node} = start_node(seq_trace_other,[]),
     ?line {_,Dir} = code:is_loaded(?MODULE),
     ?line Mdir = filename:dirname(Dir),
@@ -170,30 +198,39 @@ distributed_send(Config) when is_list(Config) ->
     ?line seq_trace:reset_trace(),
     ?line start_tracer(),
     ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
-    ?line seq_trace:set_token(send,true),
+    ?line set_token_flags([send,TsType]),
     ?line Receiver ! send,
     ?line Self = self(),
     ?line seq_trace:reset_trace(),
     ?line stop_node(Node),
-    ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1).
+    ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
+    check_ts(TsType, Ts).
+    
 
 recv(doc) -> [];
 recv(suite) -> [];
 recv(Config) when is_list(Config) ->
+    lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES).
+
+do_recv(TsType) ->
     ?line seq_trace:reset_trace(),
     ?line start_tracer(),
     ?line Receiver = spawn(?MODULE,one_time_receiver,[]),
-    ?line seq_trace:set_token('receive',true),
+    ?line set_token_flags(['receive',TsType]),
     ?line Receiver ! 'receive',
     %% let the other process receive the message:
     ?line receive after 1 -> ok end,
     ?line Self = self(),
     ?line seq_trace:reset_trace(),
-    ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1).
+    ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = stop_tracer(1),
+    check_ts(TsType, Ts).
 
 distributed_recv(doc) -> [];
 distributed_recv(suite) -> [];
 distributed_recv(Config) when is_list(Config) ->
+    lists:foreach(fun do_distributed_recv/1, ?TIMESTAMP_MODES).
+
+do_distributed_recv(TsType) ->
     ?line {ok,Node} = start_node(seq_trace_other,[]),
     ?line {_,Dir} = code:is_loaded(?MODULE),
     ?line Mdir = filename:dirname(Dir),
@@ -201,7 +238,7 @@ distributed_recv(Config) when is_list(Config) ->
     ?line seq_trace:reset_trace(),
     ?line rpc:call(Node,?MODULE,start_tracer,[]),
     ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
-    ?line seq_trace:set_token('receive',true),
+    ?line set_token_flags(['receive',TsType]),
     ?line Receiver ! 'receive',
     %% let the other process receive the message:
     ?line receive after 1 -> ok end,
@@ -210,16 +247,20 @@ distributed_recv(Config) when is_list(Config) ->
     ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]),
     ?line stop_node(Node),
     ?line ok = io:format("~p~n",[Result]),
-    ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result.
+    ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result,
+    check_ts(TsType, Ts).
 
 trace_exit(doc) -> [];
 trace_exit(suite) -> [];
 trace_exit(Config) when is_list(Config) ->
+    lists:foreach(fun do_trace_exit/1, ?TIMESTAMP_MODES).
+
+do_trace_exit(TsType) ->
     ?line seq_trace:reset_trace(),
     ?line start_tracer(),
     ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]),
     ?line process_flag(trap_exit, true),
-    ?line seq_trace:set_token(send,true),
+    ?line set_token_flags([send, TsType]),
     ?line Receiver ! {before, exit},
     %% let the other process receive the message:
     ?line receive
@@ -233,13 +274,18 @@ trace_exit(Config) when is_list(Config) ->
     ?line Result = stop_tracer(2),
     ?line seq_trace:reset_trace(),
     ?line ok = io:format("~p~n", [Result]),
-    ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}}, 
+    ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0}, 
 	   {0, {send, {1,2}, Receiver, Self,
-	       {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result.
+	       {'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result,
+    check_ts(TsType, Ts0),
+    check_ts(TsType, Ts1).
 
 distributed_exit(doc) -> [];
 distributed_exit(suite) -> [];
 distributed_exit(Config) when is_list(Config) ->
+    lists:foreach(fun do_distributed_exit/1, ?TIMESTAMP_MODES).
+
+do_distributed_exit(TsType) ->
     ?line {ok, Node} = start_node(seq_trace_other, []),
     ?line {_, Dir} = code:is_loaded(?MODULE),
     ?line Mdir = filename:dirname(Dir),
@@ -248,7 +294,7 @@ distributed_exit(Config) when is_list(Config) ->
     ?line rpc:call(Node, ?MODULE, start_tracer,[]),
     ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]),
     ?line process_flag(trap_exit, true),
-    ?line seq_trace:set_token(send, true),
+    ?line set_token_flags([send, TsType]),
     ?line Receiver ! {before, exit},
     %% let the other process receive the message:
     ?line receive
@@ -264,7 +310,8 @@ distributed_exit(Config) when is_list(Config) ->
     ?line stop_node(Node),
     ?line ok = io:format("~p~n", [Result]),
     ?line [{0, {send, {1, 2}, Receiver, Self, 
-		{'EXIT', Receiver, {exit, {before, exit}}}}}] = Result.
+		{'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result,
+    check_ts(TsType, Ts).
 
 call(doc) -> 
     "Tests special forms {is_seq_trace} and {get_seq_token} "
@@ -361,14 +408,22 @@ port(doc) ->
     "Send trace messages to a port.";
 port(suite) -> [];
 port(Config) when is_list(Config) ->
+    lists:foreach(fun (TsType) -> do_port(TsType, Config) end,
+		  ?TIMESTAMP_MODES).
+
+do_port(TsType, Config) ->
+    io:format("Testing ~p~n",[TsType]),
     ?line Port = load_tracer(Config),
     ?line seq_trace:set_system_tracer(Port),
 
-    ?line seq_trace:set_token(print, true),
+    ?line set_token_flags([print, TsType]),
     ?line Small = [small,term],
     ?line seq_trace:print(0, Small),
     ?line case get_port_message(Port) of
-	      {seq_trace,0,{print,_,_,[],Small}} ->
+	      {seq_trace,0,{print,_,_,[],Small}} when TsType == no_timestamp ->
+		  ok;
+	      {seq_trace,0,{print,_,_,[],Small},Ts0} when TsType /= no_timestamp ->
+		  check_ts(TsType, Ts0),
 		  ok;
 	      Other ->
 		  ?line seq_trace:reset_trace(),
@@ -382,7 +437,10 @@ port(Config) when is_list(Config) ->
     ?line seq_trace:print(0, OtherSmall),
     ?line seq_trace:reset_trace(),
     ?line case get_port_message(Port) of
-	      {seq_trace,0,{print,_,_,[],OtherSmall}} ->
+	      {seq_trace,0,{print,_,_,[],OtherSmall}} when TsType == no_timestamp ->
+		  ok;
+	      {seq_trace,0,{print,_,_,[],OtherSmall}, Ts1} when TsType /= no_timestamp ->
+		  check_ts(TsType, Ts1),
 		  ok;
 	      Other1 ->
 		  ?line ?t:fail({unexpected,Other1})
@@ -399,6 +457,8 @@ port(Config) when is_list(Config) ->
 	      Other2 ->
 		  ?line ?t:fail({unexpected,Other2})
 	  end,
+    unlink(Port),
+    exit(Port,kill),
     ok.
 
 get_port_message(Port) ->
@@ -734,7 +794,7 @@ simple_tracer(Data, DN) ->
 	{seq_trace,Label,Info,Ts} ->
 	    simple_tracer([{Label,Info,Ts}|Data], DN+1);
 	{seq_trace,Label,Info} ->
-	    simple_tracer([{Label,Info}|Data], DN+1);
+	    simple_tracer([{Label,Info, no_timestamp}|Data], DN+1);
 	{stop,N,From} when DN >= N ->
 	    From ! {tracerlog,lists:reverse(Data)}
     end.
@@ -759,7 +819,55 @@ start_tracer() ->
     seq_trace:set_system_tracer(Pid),
     Pid.
 
-    
+
+set_token_flags([]) ->
+    ok;
+set_token_flags([no_timestamp|Flags]) ->
+    seq_trace:set_token(timestamp, false),
+    seq_trace:set_token(monotonic_timestamp, false),
+    seq_trace:set_token(strict_monotonic_timestamp, false),
+    set_token_flags(Flags);
+set_token_flags([Flag|Flags]) ->
+    seq_trace:set_token(Flag, true),
+    set_token_flags(Flags).
+
+check_ts(no_timestamp, Ts) ->
+    try
+	no_timestamp = Ts
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(timestamp, Ts) ->
+    try
+	{Ms,S,Us} = Ts,
+	true = is_integer(Ms),
+	true = is_integer(S),
+	true = is_integer(Us)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(monotonic_timestamp, Ts) ->
+    try
+	true = is_integer(Ts)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok;
+check_ts(strict_monotonic_timestamp, Ts) ->
+    try
+	{MT, UMI} = Ts,
+	true = is_integer(MT),
+	true = is_integer(UMI)
+    catch
+	_ : _ ->
+	    ?t:fail({unexpected_timestamp, Ts})
+    end,
+    ok.
 	
 start_node(Name, Param) ->
     test_server:start_node(Name, slave, [{args, Param}]).
-- 
cgit v1.2.3


From dc8e62f33ad0ca7a772ec74d67b6d3e157f639b4 Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Wed, 13 Jan 2016 18:33:42 +0100
Subject: Introduce time warp safe replacement for safe_fixed option

The new time warp safe option is safe_fixed_monotonic_time which
gives erlang:monotonic_time().

The safe_fixed option was also slightly changed. It now gives
erlang:timestamp() instead of erlang:now(). This has however
not been documented, so it is considered a compatible change.

The above effects both ets, and dets.

This commit also include the bugfix OTP-13239 for
dets:info(Tab, safe_fixed). The timestamp in the result returned
by dets:info(Tab, safe_fixed) was unintentionally broken as a
result of the time API rewrites in OTP 18.0.
---
 erts/emulator/beam/erl_db.c       | 46 ++++++++++++++++++++++++++++----------
 erts/emulator/beam/erl_db_util.h  |  5 ++++-
 erts/emulator/beam/erl_time_sup.c | 47 ++++++++++++++++++++++++++++++---------
 erts/emulator/beam/sys.h          |  4 ++++
 lib/stdlib/doc/src/dets.xml       | 31 +++++++++++++++++++++++---
 lib/stdlib/doc/src/ets.xml        | 41 ++++++++++++++++++++++++++++------
 lib/stdlib/src/dets.erl           | 36 +++++++++++++++++++++++-------
 lib/stdlib/src/ets.erl            |  2 +-
 lib/stdlib/src/stdlib.app.src     |  2 +-
 lib/stdlib/test/dets_SUITE.erl    | 24 ++++++++++++++++++++
 lib/stdlib/test/ets_SUITE.erl     | 35 ++++++++++++++++++++++++-----
 11 files changed, 223 insertions(+), 50 deletions(-)

diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 878ee32b47..645f9e3c28 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1376,7 +1376,6 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
 	    status |= DB_ORDERED_SET;
 	    status &= ~(DB_SET | DB_BAG | DB_DUPLICATE_BAG);
 	}
-	/*TT*/
 	else if (is_tuple(val)) {
 	    Eterm *tp = tuple_val(val);
 	    if (arityval(tp[0]) == 2) {
@@ -3466,10 +3465,10 @@ static void fix_table_locked(Process* p, DbTable* tb)
 #endif
     erts_refc_inc(&tb->common.ref,1);
     fix = tb->common.fixations;
-    if (fix == NULL) { 
-	get_now(&(tb->common.megasec),
-		&(tb->common.sec), 
-		&(tb->common.microsec));
+    if (fix == NULL) {
+	tb->common.time.monotonic
+	    = erts_get_monotonic_time(ERTS_PROC_GET_SCHDATA(p));
+	tb->common.time.offset = erts_get_time_offset();
     }
     else {
 	for (; fix != NULL; fix = fix->next) {
@@ -3731,6 +3730,7 @@ static int free_table_cont(Process *p,
 static Eterm table_info(Process* p, DbTable* tb, Eterm What)
 {
     Eterm ret = THE_NON_VALUE;
+    int use_monotonic;
 
     if (What == am_size) {
 	ret = make_small(erts_smp_atomic_read_nob(&tb->common.nitems));
@@ -3788,7 +3788,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
 	    ret = am_true;
 	else
 	    ret = am_false;
-    } else if (What == am_atom_put("safe_fixed",10)) {
+    } else if ((use_monotonic
+		= ERTS_IS_ATOM_STR("safe_fixed_monotonic_time",
+				   What))
+	       || ERTS_IS_ATOM_STR("safe_fixed", What)) {
 #ifdef ERTS_SMP
 	erts_smp_mtx_lock(&tb->common.fixlock);
 #endif
@@ -3797,7 +3800,19 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
 	    Eterm *hp;
 	    Eterm tpl, lst;
 	    DbFixation *fix;
-	    need = 7;
+	    Sint64 mtime;
+	    
+	    need = 3;
+	    if (use_monotonic) {
+		mtime = (Sint64) tb->common.time.monotonic;
+		mtime += ERTS_MONOTONIC_OFFSET_NATIVE;
+		if (!IS_SSMALL(mtime))
+		    need += ERTS_SINT64_HEAP_SIZE(mtime);
+	    }
+	    else {
+		mtime = 0;
+		need += 4;
+	    }
 	    for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
 		need += 5;
 	    }
@@ -3809,11 +3824,18 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
 		lst = CONS(hp,tpl,lst);
 		hp += 2;
 	    }
-	    tpl = TUPLE3(hp,
-			 make_small(tb->common.megasec),
-			 make_small(tb->common.sec),
-			 make_small(tb->common.microsec));
-	    hp += 4;
+	    if (use_monotonic)
+		tpl = (IS_SSMALL(mtime)
+		       ? make_small(mtime)
+		       : erts_sint64_to_big(mtime, &hp));
+	    else {
+		Uint ms, s, us;
+		erts_make_timestamp_value(&ms, &s, &us,
+					  tb->common.time.monotonic,
+					  tb->common.time.offset);
+		tpl = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
+		hp += 4;
+	    }
 	    ret = TUPLE2(hp, tpl, lst);
 	} else {
 	    ret = am_false;
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 1ccdc0305b..0903a40460 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -229,7 +229,10 @@ typedef struct db_table_common {
     DbTableMethod* meth;      /* table methods */
     erts_smp_atomic_t nitems; /* Total number of items in table */
     erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */
-    Uint megasec,sec,microsec; /* Last fixation time */
+    struct {                  /* Last fixation time */
+	ErtsMonotonicTime monotonic;
+	ErtsMonotonicTime offset;
+    } time;
     DbFixation* fixations;    /* List of processes who have done safe_fixtable,
                                  "local" fixations not included. */ 
     /* All 32-bit fields */
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 7327e0b48c..2c87b8e81c 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1747,6 +1747,39 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp)
     return mtime;    
 }
 
+ErtsMonotonicTime
+erts_get_time_offset(void)
+{
+    return get_time_offset();
+}
+
+static ERTS_INLINE void
+make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+		     ErtsMonotonicTime mtime, ErtsMonotonicTime offset)
+{
+    ErtsMonotonicTime stime, as;
+    Uint ms;
+
+    stime = ERTS_MONOTONIC_TO_USEC(mtime + offset);
+
+    as = stime / ERTS_MONOTONIC_TIME_MEGA;
+    *megasec = ms = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA);
+    *sec = (Uint) (as - (((ErtsMonotonicTime) ms)
+			 * ERTS_MONOTONIC_TIME_MEGA));
+    *microsec = (Uint) (stime - as*ERTS_MONOTONIC_TIME_MEGA);
+
+    ASSERT(((ErtsMonotonicTime) ms)*ERTS_MONOTONIC_TIME_TERA
+	   + ((ErtsMonotonicTime) *sec)*ERTS_MONOTONIC_TIME_MEGA
+	   + *microsec == stime);
+}
+
+void
+erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+			  ErtsMonotonicTime mtime, ErtsMonotonicTime offset)
+{
+    make_timestamp_value(megasec, sec, microsec, mtime, offset);
+}
+
 void
 get_sys_now(Uint* megasec, Uint* sec, Uint* microsec)
 {
@@ -2220,22 +2253,14 @@ BIF_RETTYPE time_offset_1(BIF_ALIST_1)
 BIF_RETTYPE timestamp_0(BIF_ALIST_0)
 {
     Eterm *hp, res;
-    ErtsMonotonicTime stime, mtime, all_sec, offset;
+    ErtsMonotonicTime mtime, offset;
     Uint mega_sec, sec, micro_sec;
 
     mtime = time_sup.r.o.get_time();
     offset = get_time_offset();
     update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime);
-    stime = ERTS_MONOTONIC_TO_USEC(mtime + offset);
-    all_sec = stime / ERTS_MONOTONIC_TIME_MEGA;
-    mega_sec = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA);
-    sec = (Uint) (all_sec - (((ErtsMonotonicTime) mega_sec)
-			     * ERTS_MONOTONIC_TIME_MEGA));
-    micro_sec = (Uint) (stime - all_sec*ERTS_MONOTONIC_TIME_MEGA);
-
-    ASSERT(((ErtsMonotonicTime) mega_sec)*ERTS_MONOTONIC_TIME_TERA
-	   + ((ErtsMonotonicTime) sec)*ERTS_MONOTONIC_TIME_MEGA
-	   + micro_sec == stime);
+
+    make_timestamp_value(&mega_sec, &sec, µ_sec, mtime, offset);
 
     /*
      * Mega seconds is the only value that potentially
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index ec94e3a596..03e30573de 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -819,6 +819,10 @@ int local_to_univ(Sint *year, Sint *month, Sint *day,
 void get_now(Uint*, Uint*, Uint*);
 struct ErtsSchedulerData_;
 ErtsMonotonicTime erts_get_monotonic_time(struct ErtsSchedulerData_ *);
+ErtsMonotonicTime erts_get_time_offset(void);
+void
+erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+			  ErtsMonotonicTime mtime, ErtsMonotonicTime offset);
 void get_sys_now(Uint*, Uint*, Uint*);
 void set_break_quit(void (*)(void), void (*)(void));
 
diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml
index a0d3f95b6a..48400733d1 100644
--- a/lib/stdlib/doc/src/dets.xml
+++ b/lib/stdlib/doc/src/dets.xml
@@ -399,15 +399,40 @@
               kept in RAM.

           
           
-            
{safe_fixed, SafeFixed}. If the table
-              is fixed, SafeFixed is a tuple {FixedAtTime, [{Pid,RefCount}]}. FixedAtTime is the time when
+            
{safe_fixed_monotonic_time, SafeFixed}. If the table
+              is fixed, SafeFixed is a tuple {FixedAtTime, [{Pid,RefCount}]}.
+	      FixedAtTime is the time when
               the table was first fixed, and Pid is the pid of
               the process that fixes the table RefCount times.
               There may be any number of processes in the list. If the
               table is not fixed, SafeFixed is the atom false.

+	      
FixedAtTime will correspond to the result
+	      returned by
+	      erlang:monotonic_time/0
+	      at the time of fixation. The usage of safe_fixed_monotonic_time is
+	      time warp
+	      safe.

           
           
-            
{version, integer(), the version of the format of
+            

+	      {safe_fixed, SafeFixed}. The same as
+	      {safe_fixed_monotonic_time, SafeFixed} with the exception
+	      of the format and value of FixedAtTime.
+	    

+	    

+	      FixedAtTime will correspond to the result returned by
+	      erlang:timestamp/0
+	      at the time of fixation. Note that when the system is using
+	      single or multi
+	      time warp
+	      modes this might produce strange results. This
+	      since the usage of safe_fixed is not
+	      time warp
+	      safe. Time warp safe code need to use
+	      safe_fixed_monotonic_time instead.

+          
+          
+            
{version, integer()}, the version of the format of
               the table.

           
         
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 7b01109ff8..447fe51130 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -488,14 +488,39 @@ Error: fun containing local Erlang function calls
           Item=fixed, Value=boolean()          


 
            Indicates if the table is fixed by any process or not.
-          
-            
Item=safe_fixed, Value={FirstFixed,Info}|false              


+          
+            
Item=safe_fixed|safe_fixed_monotonic_time, Value={FixationTime,Info}|false              


 

-            
If the table has been fixed using safe_fixtable/2,
-              the call returns a tuple where FirstFixed is the
+            
If the table has been fixed using
+	    safe_fixtable/2,
+              the call returns a tuple where FixationTime is the
               time when the table was first fixed by a process, which
               may or may not be one of the processes it is fixed by
               right now.

+	    
The format and value of FixationTime depends on
+	    Item:

+	    
+	      safe_fixed
+	      
FixationTime will correspond to the result
+	      returned by
+	      erlang:timestamp/0
+	      at the time of fixation. Note that when the system is using
+	      single or multi
+	      time warp
+	      modes this might produce strange results. This
+	      since the usage of safe_fixed is not
+	      time warp
+	      safe. Time warp safe code need to use
+	      safe_fixed_monotonic_time instead.

+
+	      safe_fixed_monotonic_time
+	      
FixationTime will correspond to the result
+	      returned by
+	      erlang:monotonic_time/0
+	      at the time of fixation. The usage of safe_fixed_monotonic_time is
+	      time warp
+	      safe.

+	    
             
Info is a possibly empty lists of tuples
               {Pid,RefCount}, one tuple for every process the
               table is fixed by right now. RefCount is the value
@@ -1135,9 +1160,11 @@ clean_all_with_value(Tab,X,Key) ->
           table but never releases it, the memory used by the deleted
           objects will never be freed. The performance of operations on
           the table will also degrade significantly.

-        
Use info/2 to retrieve information about which
-          processes have fixed which tables. A system with a lot of
-          processes fixing tables may need a monitor which sends alarms
+        
Use
+	info(Tab,
+	safe_fixed_monotonic_time) to retrieve information
+	about which processes have fixed which tables. A system with a lot
+	of processes fixing tables may need a monitor which sends alarms
           when tables have been fixed for too long.

         
Note that for tables of the ordered_set type,
           safe_fixtable/2 is not necessary as calls to
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 6d07f4018a..2d037ff795 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -372,7 +372,7 @@ info(Tab) ->
       Item :: 'access' | 'auto_save' | 'bchunk_format'
             | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory'
             | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file'
-            | 'safe_fixed' | 'size' | 'type' | 'version',
+            | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version',
       Value :: term().
 
 info(Tab, owner) ->
@@ -1964,7 +1964,9 @@ do_safe_fixtable(Head, Pid, true) ->
     case Head#head.fixed of 
 	false -> 
 	    link(Pid),
-	    Fixed = {utime_now(), [{Pid, 1}]},
+	    MonTime = erlang:monotonic_time(),
+	    TimeOffset = erlang:time_offset(),
+	    Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]},
 	    Ftab = dets_utils:get_freelists(Head),
 	    Head#head{fixed = Fixed, freelists = {Ftab, Ftab}};
 	{TimeStamp, Counters} ->
@@ -2091,7 +2093,22 @@ finfo(H, no_keys) ->
 finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)};
 finfo(H, pid) -> {H, self()};
 finfo(H, ram_file) -> {H, H#head.ram_file};
-finfo(H, safe_fixed) -> {H, H#head.fixed};
+finfo(H, safe_fixed) ->
+    {H,
+     case H#head.fixed of
+	 false ->
+	     false;
+	 {{FixMonTime, TimeOffset}, RefList} ->
+	     {make_timestamp(FixMonTime, TimeOffset), RefList}
+     end};
+finfo(H, safe_fixed_monotonic_time) ->
+    {H,
+     case H#head.fixed of
+	 false ->
+	     false;
+	 {{FixMonTime, _TimeOffset}, RefList} ->
+	     {FixMonTime, RefList}
+     end};
 finfo(H, size) -> 
     case catch write_cache(H) of
 	{H2, []} ->
@@ -3275,11 +3292,14 @@ err(Error) ->
 time_now() ->
     erlang:monotonic_time(1000000).
 
--compile({inline, [utime_now/0]}).
-utime_now() ->
-    Time = time_now(),
-    UniqueCounter = erlang:unique_integer([monotonic]),
-    {Time, UniqueCounter}.
+make_timestamp(MonTime, TimeOffset) ->
+    ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset,
+						native,
+						micro_seconds),
+    MegaSecs = ErlangSystemTime div 1000000000000,
+    Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000,
+    MicroSecs = ErlangSystemTime rem 1000000,
+    {MegaSecs, Secs, MicroSecs}.
 
 %%%%%%%%%%%%%%%%%  DEBUG functions %%%%%%%%%%%%%%%%
 
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 847def2fd8..1fca3624dc 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -146,7 +146,7 @@ info(_) ->
       Tab :: tab(),
       Item :: compressed | fixed | heir | keypos | memory
             | name | named_table | node | owner | protection
-            | safe_fixed | size | stats | type
+            | safe_fixed | safe_fixed_monotonic_time | size | stats | type
 	    | write_concurrency | read_concurrency,
       Value :: term().
 
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 7f9bbbf649..b8a7973cf2 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -105,7 +105,7 @@
                dets]},
   {applications, [kernel]},
   {env, []},
-  {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3",
+  {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3",
 			  "compiler-5.0"]}
 ]}.
 
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index 7f5e06524a..35e587afcc 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -1876,9 +1876,33 @@ fixtable(Config, Version) when is_list(Config) ->
     {ok, _} = dets:open_file(T, [{type, duplicate_bag} | Args]),
     %% In a fixed table, delete and re-insert an object.
     ok = dets:insert(T, {1, a, b}),
+    SysBefore = erlang:timestamp(),
+    MonBefore = erlang:monotonic_time(),
     dets:safe_fixtable(T, true),
+    MonAfter = erlang:monotonic_time(),
+    SysAfter = erlang:timestamp(),
+    Self = self(),
+    {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time),
+    {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed),
+    true = is_integer(FixMonTime),
+    true = MonBefore =< FixMonTime,
+    true = FixMonTime =< MonAfter,
+    {FstMs,FstS,FstUs} = FixSysTime,
+    true = is_integer(FstMs),
+    true = is_integer(FstS),
+    true = is_integer(FstUs),
+    case erlang:system_info(time_warp_mode) of
+	no_time_warp ->
+	    true = timer:now_diff(FixSysTime, SysBefore) >= 0,
+	    true = timer:now_diff(SysAfter, FixSysTime) >= 0;
+	_ ->
+	    %% ets:info(Tab,safe_fixed) not timewarp safe...
+	    ignore
+    end,
     ok = dets:match_delete(T, {1, a, b}),
     ok = dets:insert(T, {1, a, b}),
+    {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time),
+    {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed),
     dets:safe_fixtable(T, false),
     1 = length(dets:match_object(T, '_')),
 
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index ae431d66d9..30a158d9e1 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -3989,15 +3989,37 @@ safe_fixtable_do(Opts) ->
     ?line true = ets:safe_fixtable(Tab, true),
     ?line receive after 1 -> ok end,
     ?line true = ets:safe_fixtable(Tab, false),
-    ?line false = ets:info(Tab,safe_fixed),
-    ?line true = ets:safe_fixtable(Tab, true),
+    false = ets:info(Tab,safe_fixed_monotonic_time),
+    false = ets:info(Tab,safe_fixed),
+    SysBefore = erlang:timestamp(),
+    MonBefore = erlang:monotonic_time(),
+    true = ets:safe_fixtable(Tab, true),
+    MonAfter = erlang:monotonic_time(),
+    SysAfter = erlang:timestamp(),
     Self = self(),
-    ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
+    {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time),
+    {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed),
+    true = is_integer(FixMonTime),
+    true = MonBefore =< FixMonTime,
+    true = FixMonTime =< MonAfter,
+    {FstMs,FstS,FstUs} = FixSysTime,
+    true = is_integer(FstMs),
+    true = is_integer(FstS),
+    true = is_integer(FstUs),
+    case erlang:system_info(time_warp_mode) of
+	no_time_warp ->
+	    true = timer:now_diff(FixSysTime, SysBefore) >= 0,
+	    true = timer:now_diff(SysAfter, FixSysTime) >= 0;
+	_ ->
+	    %% ets:info(Tab,safe_fixed) not timewarp safe...
+	    ignore
+    end,
     %% Test that an unjustified 'unfix' is a no-op.
     {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end),
     {'DOWN', MRef, process, Pid, normal} = receive M -> M end,
-    ?line true = ets:info(Tab,fixed),
-    ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
+    true = ets:info(Tab,fixed),
+    {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time),
+    {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed),
     %% badarg's
     ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)),
     ?line true = ets:info(Tab,fixed),
@@ -4043,6 +4065,7 @@ info_do(Opts) ->
     ?line undefined = ets:info(non_existing_table_xxyy,type),
     ?line undefined = ets:info(non_existing_table_xxyy,node),
     ?line undefined = ets:info(non_existing_table_xxyy,named_table),
+    ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed_monotonic_time),
     ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed),
     ?line verify_etsmem(EtsMem).
 
@@ -5532,7 +5555,7 @@ otp_8166_zombie_creator(T,Deleted) ->
 						  [{'=<','$1', Deleted}],
 						  [true]}]),
 	    Pid ! zombies_created,
-	    repeat_while(fun() -> case ets:info(T,safe_fixed) of
+	    repeat_while(fun() -> case ets:info(T,safe_fixed_monotonic_time) of
 				      {_,[_P1,_P2]} ->
 					  false;
 				      _ -> 
-- 
cgit v1.2.3


From 7189317ef89dfedaa35a804dfedd4fc27bf28d14 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Wed, 13 Jan 2016 12:59:15 +0100
Subject: erl_prim_loader: Remove unused 'cache' field

The #prim_state.cache' field is unused. The actual cache is kept
in the process dictionary.
---
 erts/preloaded/src/erl_prim_loader.erl | 1 -
 1 file changed, 1 deletion(-)

diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 5f88029585..3ef48ad61e 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -57,7 +57,6 @@
 -type host() :: atom().
 
 -record(prim_state, {debug :: boolean(),
-		     cache,
 		     primary_archive}).
 -type prim_state() :: #prim_state{}.
 
-- 
cgit v1.2.3


From ca1964e765595dfe9089759adb5ef5eded4f2bf1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Wed, 13 Jan 2016 13:35:53 +0100
Subject: erl_prim_loader: Correct purging of the archive cache

prim_do_release_archives/3 can't make up its mind whether the
primary archive should be released or not. The key in the process
dictionary is kept, while #prim_state.primary_archive is cleared.

It seems that intent was the primary archive should be preserved,
because the function was intended to be called by a timeout routine
every sixth minute (it is not because of a bug in setting up
the timeout).

Therefore, rewrite the code to preserve the primary archive and
simplify it while at it. Also, rename prim_release_archives/1 to
prim_purge_cache/0 to make it clearer what it is doing.
---
 erts/preloaded/src/erl_prim_loader.erl | 47 +++++++++++-----------------------
 1 file changed, 15 insertions(+), 32 deletions(-)

diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 3ef48ad61e..ac461bc6c7 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -435,10 +435,6 @@ efile_set_primary_archive(#state{prim_state = PS} = State, File,
 					  FileInfo, ParserFun),
     {Res,State#state{prim_state = PS2}}.
 
-efile_release_archives(#state{prim_state = PS} = State) ->
-    {Res, PS2} = prim_release_archives(PS),
-    {Res,State#state{prim_state = PS2}}.
-
 efile_list_dir(#state{prim_state = PS} = State, Dir) ->
     {Res, PS2} = prim_list_dir(PS, Dir),
     {Res, State#state{prim_state = PS2}}.
@@ -463,8 +459,8 @@ efile_exit_port(State, _Port, _Reason) ->
 efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) ->
     if
 	N =< 0 ->
-	    {_Res, State2} = efile_release_archives(State),
-	    State2#state{n_timeouts = ?N_TIMEOUTS};
+	    prim_purge_cache(),
+	    State#state{n_timeouts = ?N_TIMEOUTS};
 	true ->
 	    State#state{n_timeouts = N - 1}
     end.
@@ -733,32 +729,19 @@ prim_init() ->
         end,
     cache_new(#prim_state{debug = Deb}).
 
-prim_release_archives(PS) ->
-    debug(PS, release_archives),
-    {Res, PS2} = prim_do_release_archives(PS, get(), []),
-    debug(PS2, {return, Res}),
-    {Res, PS2}.
-
-prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) ->
-    Res = 
-	case DictVal of
-	    {primary, _PrimZip, _FI, _ParserFun} ->
-		ok; % Keep primary archive
-	    {Cache, _FI} ->
-		debug(PS, {release, cache, ArchiveFile}),
-		erase(ArchiveFile),
-		clear_cache(ArchiveFile, Cache)
-	end,
-    case Res of
-	ok ->
-	    prim_do_release_archives(PS, KeyVals, Acc);
-	{error, Reason} ->
-	    prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc])
-    end;
-prim_do_release_archives(PS, [], []) ->
-    {ok, PS#prim_state{primary_archive = undefined}};
-prim_do_release_archives(PS, [], Errors) ->
-    {{error, Errors}, PS#prim_state{primary_archive = undefined}}.
+prim_purge_cache() ->
+    do_prim_purge_cache(get()).
+
+do_prim_purge_cache([{Key,Val}|T]) ->
+    case Val of
+	{Cache,_FI} ->
+	    catch clear_cache(Key, Cache);
+	_ ->
+	    ok
+    end,
+    do_prim_purge_cache(T);
+do_prim_purge_cache([]) ->
+    ok.
 
 prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) ->
     debug(PS, {set_primary_archive, clean}),
-- 
cgit v1.2.3


From b662e8abbdf63390af5173752ea87d7c952f5185 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Wed, 13 Jan 2016 13:41:53 +0100
Subject: erl_prim_loader: Correct timeout handling for efile

The timeout routine for efile was never called. While at it,
eliminate the n_timeouts field and simplify the logic.
---
 erts/preloaded/src/erl_prim_loader.erl | 24 ++++++++----------------
 1 file changed, 8 insertions(+), 16 deletions(-)

diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index ac461bc6c7..e1c014fee6 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -65,12 +65,10 @@
          hosts = []        :: [host()], % hosts list (to boot from)
          data              :: 'noport' | port(), % data port etc
          timeout           :: timeout(),	 % idle timeout
-	 %% Number of timeouts before archives are released
-	 n_timeouts        :: non_neg_integer(),
          prim_state        :: prim_state()}).    % state for efile code loader
 
--define(IDLE_TIMEOUT, 60000).  %% tear inet connection after 1 minutes
--define(N_TIMEOUTS, 6).        %% release efile archive after 6 minutes
+-define(EFILE_IDLE_TIMEOUT, (6*60*1000)).	%purge archives
+-define(INET_IDLE_TIMEOUT, (60*1000)). 		%tear down connection timeout
 
 %% Defines for inet as prim_loader
 -define(INET_FAMILY, inet).
@@ -142,8 +140,7 @@ start_inet(Parent) ->
     State = #state {loader = inet,
                     hosts = AL,
                     data = Tcp,
-                    timeout = ?IDLE_TIMEOUT,
-		    n_timeouts = ?N_TIMEOUTS,
+                    timeout = ?INET_IDLE_TIMEOUT,
                     prim_state = PS},
     loop(State, Parent, []).
 
@@ -163,7 +160,7 @@ start_efile(Parent) ->
     PS = prim_init(),
     State = #state {loader = efile,
                     data = Port,
-                    timeout = infinity,
+                    timeout = ?EFILE_IDLE_TIMEOUT,
                     prim_state = PS},
     loop(State, Parent, []).
 
@@ -456,14 +453,9 @@ efile_exit_port(State, Port, Reason) when State#state.data =:= Port ->
 efile_exit_port(State, _Port, _Reason) ->
     State.
 
-efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) ->
-    if
-	N =< 0 ->
-	    prim_purge_cache(),
-	    State#state{n_timeouts = ?N_TIMEOUTS};
-	true ->
-	    State#state{n_timeouts = N - 1}
-    end.
+efile_timeout_handler(State, _Parent) ->
+    prim_purge_cache(),
+    State.
 
 %%% --------------------------------------------------------
 %%% Functions which handle inet prim_loader
@@ -604,7 +596,7 @@ inet_get_file_from_port1(_File, [], State) ->
 inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport ->
     {ok,Tcp} = find_master(State#state.hosts),     %% reconnect
     inet_send_and_rcv(Msg, Tag, State#state{data = Tcp,
-					    timeout = ?IDLE_TIMEOUT});
+					    timeout = ?INET_IDLE_TIMEOUT});
 inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) ->
     prim_inet:send(Tcp, term_to_binary(Msg)),
     receive
-- 
cgit v1.2.3


From 56eded8ac675bf0e6f955c291be845f668d2b795 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Wed, 13 Jan 2016 15:11:43 +0100
Subject: erl_prim_loader: Rename release_archives/0

Rename release_archives/0 to purge_archive_cache/0 to make it
clearer what it does and what it doesn't do. Also add a comment
about its intended purpose.

Note that release_archives/0 is not documented and is part of the
experimental archive feature. Furthermore, the only uses I could find
were in the test suite. I did not find any uses in the external
applications relx and rebar3 applications that are known to use
archives. Therefore, I think that the increased clarity is worth
the small risk of breaking code.
---
 erts/preloaded/src/erl_prim_loader.erl    | 23 +++++++++++++++--------
 lib/kernel/test/erl_prim_loader_SUITE.erl |  4 ++--
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index e1c014fee6..824ed3435d 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -50,7 +50,10 @@
          prim_read_file_info/3, prim_get_cwd/2]).
 
 %% Used by escript and code
--export([set_primary_archive/4, release_archives/0]).
+-export([set_primary_archive/4]).
+
+%% Used by test suites
+-export([purge_archive_cache/0]).
 
 -include_lib("kernel/include/file.hrl").
 
@@ -225,10 +228,13 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun)
   when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) ->
     request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}).
 
--spec release_archives() -> 'ok' | {'error', _}.
+%% NOTE: Does not close the primary archive. Only closes all
+%% open zip files kept in the cache. Should be called before an archive
+%% file is to be removed (for example in the test suites).
 
-release_archives() ->
-    request(release_archives).
+-spec purge_archive_cache() -> 'ok' | {'error', _}.
+purge_archive_cache() ->
+    request(purge_archive_cache).
 
 request(Req) ->
     Loader = whereis(erl_prim_loader),
@@ -332,8 +338,8 @@ handle_request(Req, Paths, St0) ->
 	{set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
 	    handle_set_primary_archive(St0, File, ArchiveBin,
 				       FileInfo, ParserFun);
-	release_archives ->
-	    handle_release_archives(St0);
+	purge_archive_cache ->
+	    handle_purge_archive_cache(St0);
 	_ ->
 	    ignore
     end.
@@ -346,8 +352,9 @@ handle_get_file(State = #state{loader = inet}, Paths, File) ->
 handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) ->
     ?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State).
 
-handle_release_archives(State= #state{loader = efile}) ->
-    ?SAFE2(efile_release_archives(State), State).
+handle_purge_archive_cache(#state{loader = efile}=State) ->
+    prim_purge_cache(),
+    {ok,State}.
 
 handle_list_dir(State = #state{loader = efile}, Dir) ->
     ?SAFE2(efile_list_dir(State, Dir), State);
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
index ffcde5e458..e9ff79af19 100644
--- a/lib/kernel/test/erl_prim_loader_SUITE.erl
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -392,7 +392,7 @@ local_archive(Config) when is_list(Config) ->
     ?line ok = test_archive(Node, Archive, KernelDir, BeamName),
 
     %% Cleanup
-    ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []),
+    ok = rpc:call(Node, erl_prim_loader, purge_archive_cache, []),
     ?line ok = file:delete(Archive),
     ok.
 
@@ -550,7 +550,7 @@ virtual_dir_in_archive(Config) when is_list(Config) ->
     ?line {ok, [EbinBase]} = erl_prim_loader:list_dir(AppDir),
     
     %% Cleanup
-    ?line ok = erl_prim_loader:release_archives(),
+    ok = erl_prim_loader:purge_archive_cache(),
     ?line ok = file:delete(Archive),
     ok.
 
-- 
cgit v1.2.3


From 907618a797dcdbbcaa020edcdb2c0305eba2bb0f Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Wed, 20 Jan 2016 14:04:03 +0100
Subject: dialyzer: Correct a test case

---
 lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
index b6cab5e24b..1677b4efb8 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl
@@ -781,7 +781,8 @@ add_mod_info({attribute,_Line,record,{RecName,Fields}},
 	true ->
 	    ModInfo;
 	false ->
-	    TypedRecord = {attribute,0,type,{{record,RecName},Fields,[]}},
+            A = erl_anno:new(0),
+	    TypedRecord = {attribute,A,type,{{record,RecName},Fields,[]}},
 	    add_mod_info(TypedRecord, ModInfo)
     end;
 add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}},
-- 
cgit v1.2.3


From 1b883a0a8163545f107c7f315990417726b54235 Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Wed, 20 Jan 2016 15:01:06 +0100
Subject: common_test: Fix a Dialyzer warning

---
 lib/common_test/src/ct_make.erl | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl
index f4b81a0ef6..e7a9cfa843 100644
--- a/lib/common_test/src/ct_make.erl
+++ b/lib/common_test/src/ct_make.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
 %% 
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -324,10 +324,11 @@ check_includes(File, IncludePath, ObjMTime) ->
     end.
     
 check_includes2(Epp, File, ObjMTime) ->
+    A1 = erl_anno:new(1),
     case epp:parse_erl_form(Epp) of
-	{ok, {attribute, 1, file, {File, 1}}} ->
+	{ok, {attribute, A1, file, {File, A1}}} ->
 	    check_includes2(Epp, File, ObjMTime);
-	{ok, {attribute, 1, file, {IncFile, 1}}} ->
+	{ok, {attribute, A1, file, {IncFile, A1}}} ->
 	    case file:read_file_info(IncFile) of
 		{ok, #file_info{mtime=MTime}} when MTime>ObjMTime ->
 		    epp:close(Epp),
-- 
cgit v1.2.3


From e5949b5cd2a6d0f691097de189e0f95f34ac404d Mon Sep 17 00:00:00 2001
From: Hans Bolinder 
Date: Wed, 20 Jan 2016 15:01:18 +0100
Subject: tools: Fix a Dialyzer warning

---
 lib/tools/src/make.erl | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl
index 5d5a1ef2bd..26378f28a0 100644
--- a/lib/tools/src/make.erl
+++ b/lib/tools/src/make.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
 %% 
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -299,10 +299,11 @@ check_includes(File, IncludePath, ObjMTime) ->
     end.
     
 check_includes2(Epp, File, ObjMTime) ->
+    A1 = erl_anno:new(1),
     case epp:parse_erl_form(Epp) of
-	{ok, {attribute, 1, file, {File, 1}}} ->
+	{ok, {attribute, A1, file, {File, A1}}} ->
 	    check_includes2(Epp, File, ObjMTime);
-	{ok, {attribute, 1, file, {IncFile, 1}}} ->
+	{ok, {attribute, A1, file, {IncFile, A1}}} ->
 	    case file:read_file_info(IncFile) of
 		{ok, #file_info{mtime=MTime}} when MTime>ObjMTime ->
 		    epp:close(Epp),
-- 
cgit v1.2.3


From 53dcd92be965d35ef53a27efda0597b2961921ba Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Wed, 20 Jan 2016 19:42:31 +0100
Subject: erts: Update docs for erlang:purge_module/1

---
 erts/doc/src/erlang.xml | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 8ddbd95de5..72d08a03fe 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4870,6 +4870,12 @@ os_prompt%
code(3)) and is not to be used elsewhere.

+ +

As from ERTS 8.0 (OTP 19), any lingering processes + that still execute the old code will be killed by this function. + In earlier versions, such incorrect use could cause much + more fatal failures, like emulator crash.

+

Failure: badarg if there is no old code for Module.

-- cgit v1.2.3 From 40053b5f68655d76c0138e9be4306228ec14cd1e Mon Sep 17 00:00:00 2001 From: Michael Santos Date: Wed, 20 Jan 2016 15:16:06 -0500 Subject: Fix typo in Windows build scripts --- erts/etc/win32/cygwin_tools/vc/cc.sh | 2 +- erts/etc/win32/msys_tools/vc/cc.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/etc/win32/cygwin_tools/vc/cc.sh b/erts/etc/win32/cygwin_tools/vc/cc.sh index 48a579d5f0..651b6e098d 100755 --- a/erts/etc/win32/cygwin_tools/vc/cc.sh +++ b/erts/etc/win32/cygwin_tools/vc/cc.sh @@ -267,7 +267,7 @@ for x in $SOURCES; do echo echo after_sed=`date '+%s'` - echo Made dependencises for $x':' `expr $after_sed '-' $start_time` 's' >&2 + echo Made dependencies for $x':' `expr $after_sed '-' $start_time` 's' >&2 fi else cat $MSG_FILE diff --git a/erts/etc/win32/msys_tools/vc/cc.sh b/erts/etc/win32/msys_tools/vc/cc.sh index ac89aac34e..72005862ed 100644 --- a/erts/etc/win32/msys_tools/vc/cc.sh +++ b/erts/etc/win32/msys_tools/vc/cc.sh @@ -268,7 +268,7 @@ for x in $SOURCES; do echo echo after_sed=`date '+%s'` - echo Made dependencises for $x':' `expr $after_sed '-' $start_time` 's' >&2 + echo Made dependencies for $x':' `expr $after_sed '-' $start_time` 's' >&2 fi else cat $MSG_FILE -- cgit v1.2.3 From 3fab95dc101e5765db66ae8b8479c181a934912d Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 19 Jan 2016 16:36:08 +0100 Subject: ssl: In interop tests always check if SSL/TLS version is supported by OpenSSL As sslv3 is being faced out we need to test for old version support as well as newer versions. --- lib/ssl/test/ssl_test_lib.erl | 62 +++++++++++++++++++++++++---------- lib/ssl/test/ssl_to_openssl_SUITE.erl | 33 ++++--------------- 2 files changed, 51 insertions(+), 44 deletions(-) diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 9a76d603b1..77c29668b5 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1158,23 +1158,27 @@ cipher_restriction(Config0) -> end. check_sane_openssl_version(Version) -> - case {Version, os:cmd("openssl version")} of - {_, "OpenSSL 1.0.2" ++ _} -> - true; - {_, "OpenSSL 1.0.1" ++ _} -> - true; - {'tlsv1.2', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.2', "OpenSSL 0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 0" ++ _} -> - false; - {_, _} -> - true + case supports_ssl_tls_version(Version) of + true -> + case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.2" ++ _} -> + true; + {_, "OpenSSL 1.0.1" ++ _} -> + true; + {'tlsv1.2', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 0" ++ _} -> + false; + {_, _} -> + true + end; + false -> + false end. - enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; enough_openssl_crl_support(_) -> true. @@ -1198,7 +1202,9 @@ version_flag('tlsv1.1') -> version_flag('tlsv1.2') -> "-tls1_2"; version_flag(sslv3) -> - "-ssl3". + "-ssl3"; +version_flag(sslv2) -> + "-ssl2". filter_suites(Ciphers0) -> Version = tls_record:highest_protocol_version([]), @@ -1249,3 +1255,25 @@ portable_open_port(Exe, Args) -> ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [AbsPath, Args]), open_port({spawn_executable, AbsPath}, [{args, Args}, stderr_to_stdout]). + +supports_ssl_tls_version(Version) -> + VersionFlag = version_flag(Version), + Exe = "openssl", + Args = ["s_client", VersionFlag], + Port = ssl_test_lib:portable_open_port(Exe, Args), + do_supports_ssl_tls_version(Port). + +do_supports_ssl_tls_version(Port) -> + receive + {Port, {data, "unknown option" ++ _}} -> + false; + {Port, {data, Data}} -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + do_supports_ssl_tls_version(Port) + end + after 500 -> + true + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 13523730b0..bcdefb5fca 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -175,7 +175,12 @@ special_init(TestCase, Config) check_sane_openssl_renegotaite(Config, Version); special_init(ssl2_erlang_server_openssl_client, Config) -> - check_sane_openssl_sslv2(Config); + case ssl_test_lib:supports_ssl_tls_version(sslv2) of + true -> + Config; + false -> + {skip, "sslv2 not supported by openssl"} + end; special_init(TestCase, Config) when TestCase == erlang_client_alpn_openssl_server_alpn; @@ -1756,32 +1761,6 @@ check_sane_openssl_renegotaite(Config) -> Config end. -check_sane_openssl_sslv2(Config) -> - Exe = "openssl", - Args = ["s_client", "-ssl2"], - Port = ssl_test_lib:portable_open_port(Exe, Args), - case supports_sslv2(Port) of - true -> - Config; - false -> - {skip, "sslv2 not supported by openssl"} - end. - -supports_sslv2(Port) -> - receive - {Port, {data, "unknown option -ssl2" ++ _}} -> - false; - {Port, {data, Data}} -> - case lists:member("error", string:tokens(Data, ":")) of - true -> - false; - false -> - supports_sslv2(Port) - end - after 500 -> - true - end. - workaround_openssl_s_clinent() -> %% http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=683159 %% https://bugs.archlinux.org/task/33919 -- cgit v1.2.3 From 613a8d74d1641ee67d3d9e7333c9711ff8a1f446 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 20 Jan 2016 12:36:49 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 51424 -> 49964 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index 6ee26b7575..f6057b45d4 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ -- cgit v1.2.3 From 5ae72e324513fe1b724b7eaa3a707302338646c7 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 19 Jan 2016 12:12:45 +0100 Subject: ssl: Fix timing releated bug --- lib/ssl/src/tls_connection.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b2b85eaf8d..c3f0206d25 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -764,6 +764,8 @@ handle_tls_handshake(Handle, StateName, case Handle(Packet, FsmReturn) of {next_state, NextStateName, State, _Timeout} -> handle_tls_handshake(Handle, NextStateName, State); + {next_state, NextStateName, State} -> + handle_tls_handshake(Handle, NextStateName, State); {stop, _,_} = Stop -> Stop end; -- cgit v1.2.3 From a25e3e814febd5459e77435cb972f5baa5eebbf5 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Thu, 21 Jan 2016 10:16:28 +0100 Subject: ssl: Prepare for release --- lib/ssl/src/ssl.appup.src | 6 ++++++ lib/ssl/vsn.mk | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 11728128c4..057906bcb3 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,9 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, @@ -8,6 +11,9 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index aa1af21990..9f79a7fb34 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.2 +SSL_VSN = 7.2.1 -- cgit v1.2.3 From 290dffee0f7af744c86d69234fb2d8ed1c4b8a6b Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 12 Jan 2016 10:20:41 +0100 Subject: Snmp agent vacmViewTreeFamily with non 'null' mask bugfix Adresses problems desciribed in http://erlang.org/pipermail/erlang-bugs/2015-April/004891.html http://erlang.org/pipermail/erlang-patches/2015-April/004766.html The original patch also suggested the following fix. However we need more information to be able to understand if this is correct or not, and it does not have priority at the moment for us to investigate. @@ -816,7 +816,7 @@ next_node(D, {tree, Tree, {table_entry, _MibName}}, "~n RevOidSoFar: ~p" "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]), OidSoFar = lists:reverse(RevOidSoFar), - case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar ++ Oid, MibView) of true -> ?vdebug("next_node(tree,table_entry) -> not in mib view",[]), false; --- lib/snmp/src/agent/snmp_view_based_acm_mib.erl | 2 ++ lib/snmp/src/agent/snmpa_acm.erl | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 586b7c7171..9e6aa74d45 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -34,6 +34,8 @@ %% Internal exports -export([check_vacm/1]). +%% +-export([emask2imask/1]). -include("snmp_types.hrl"). diff --git a/lib/snmp/src/agent/snmpa_acm.erl b/lib/snmp/src/agent/snmpa_acm.erl index 7327575846..0264c6a992 100644 --- a/lib/snmp/src/agent/snmpa_acm.erl +++ b/lib/snmp/src/agent/snmpa_acm.erl @@ -280,7 +280,7 @@ validate_mib_view(Oid, MibView) -> end. get_largest_family([{SubTree, Mask, Type} | T], Oid, Res) -> - case check_mask(Oid, SubTree, Mask) of + case check_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> get_largest_family(T, Oid, add_res(length(SubTree), SubTree, Type, Res)); false -> get_largest_family(T, Oid, Res) @@ -345,7 +345,7 @@ validate_all_mib_view([], _MibView) -> %% intelligent. %%----------------------------------------------------------------- is_definitely_not_in_mib_view(Oid, [{SubTree, Mask,?view_included}|T]) -> - case check_maybe_mask(Oid, SubTree, Mask) of + case check_maybe_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> false; false -> is_definitely_not_in_mib_view(Oid, T) end; -- cgit v1.2.3 From da89d3fa551d80c0b16cfd6d46580274cd644ace Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 19 Jan 2016 17:06:30 +0100 Subject: Fix inet driver multi timers using new time API --- erts/emulator/drivers/common/inet_drv.c | 139 +++----------------------------- 1 file changed, 13 insertions(+), 126 deletions(-) diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 89011d89ad..43cb15a25f 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1048,7 +1048,7 @@ typedef union { #endif typedef struct _multi_timer_data { - ErlDrvNowData when; + ErlDrvTime when; ErlDrvTermData caller; void (*timeout_function)(ErlDrvData drv_data, ErlDrvTermData caller); struct _multi_timer_data *next; @@ -12144,115 +12144,18 @@ make_noninheritable_handle(SOCKET s) * Multi-timers */ -static void absolute_timeout(unsigned millis, ErlDrvNowData *out) -{ - unsigned rest; - unsigned long millipart; - unsigned long secpart; - unsigned long megasecpart; - unsigned tmo_secs = (millis / 1000U); - unsigned tmo_millis = (millis % 1000); - driver_get_now(out); - rest = (out->microsecs) % 1000; - millipart = ((out->microsecs) / 1000UL); - if (rest >= 500) { - ++millipart; - } - secpart = out->secs; - megasecpart = out->megasecs; - millipart += tmo_millis; - secpart += (millipart / 1000000UL); - millipart %= 1000000UL; - secpart += tmo_secs; - megasecpart += (secpart / 1000000UL); - secpart %= 1000000UL; - out->megasecs = megasecpart; - out->secs = secpart; - out->microsecs = (millipart * 1000UL); -} - -static unsigned relative_timeout(ErlDrvNowData *in) -{ - ErlDrvNowData now; - unsigned rest; - unsigned long millipart, in_millis, in_secs, in_megasecs; - - driver_get_now(&now); - - in_secs = in->secs; - in_megasecs = in->megasecs; - - rest = (now.microsecs) % 1000; - millipart = ((now.microsecs) / 1000UL); - if (rest >= 500) { - ++millipart; - } - in_millis = ((in->microsecs) / 1000UL); - if ( in_millis < millipart ) { - if (in_secs > 0) { - --in_secs; - } else { - in_secs = (1000000UL - 1UL); - if (in_megasecs <= now.megasecs) { - return 0; - } else { - --in_megasecs; - } - } - in_millis += 1000UL; - } - in_millis -= millipart; - - if (in_secs < now.secs) { - if (in_megasecs <= now.megasecs) { - return 0; - } else { - --in_megasecs; - } - in_secs += 1000000; - } - in_secs -= now.secs; - if (in_megasecs < now.megasecs) { - return 0; - } else { - in_megasecs -= now.megasecs; - } - return (unsigned) ((in_megasecs * 1000000000UL) + - (in_secs * 1000UL) + - in_millis); -} - -#ifdef DEBUG -static int nowcmp(ErlDrvNowData *d1, ErlDrvNowData *d2) -{ - /* Assume it's not safe to do signed conversion on megasecs... */ - if (d1->megasecs < d2->megasecs) { - return -1; - } else if (d1->megasecs > d2->megasecs) { - return 1; - } else if (d1->secs != d2->secs) { - return ((int) d1->secs) - ((int) d2->secs); - } - return ((int) d1->microsecs) - ((int) d2->microsecs); -} -#endif - static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, ErlDrvData data) { - unsigned next_timeout; + ErlDrvTime next_timeout; if (!*first) { ASSERT(0); return; } #ifdef DEBUG { - ErlDrvNowData chk; - driver_get_now(&chk); - chk.microsecs /= 10000UL; - chk.microsecs *= 10000UL; - chk.microsecs += 10000; - ASSERT(nowcmp(&chk,&((*first)->when)) >= 0); + ErlDrvTime chk = erl_drv_monotonic_time(ERL_DRV_MSEC); + ASSERT(chk >= (*first)->when); } #endif do { @@ -12264,9 +12167,9 @@ static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, return; } (*first)->prev = NULL; - next_timeout = relative_timeout(&((*first)->when)); - } while (next_timeout == 0); - driver_set_timer(port,next_timeout); + next_timeout = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC); + } while (next_timeout <= 0); + driver_set_timer(port, (unsigned long) next_timeout); } static void clean_multi_timers(MultiTimerData **first, ErlDrvPort port) @@ -12289,8 +12192,10 @@ static void remove_multi_timer(MultiTimerData **first, ErlDrvPort port, MultiTim driver_cancel_timer(port); *first = p->next; if (*first) { - unsigned ntmo = relative_timeout(&((*first)->when)); - driver_set_timer(port,ntmo); + ErlDrvTime ntmo = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC); + if (ntmo < 0) + ntmo = 0; + driver_set_timer(port, (unsigned long) ntmo); } } if (p->next != NULL) { @@ -12304,26 +12209,14 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, void (*timeout_fun)(ErlDrvData drv_data, ErlDrvTermData caller)) { -#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs) -#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs) MultiTimerData *mtd, *p, *s; mtd = ALLOC(sizeof(MultiTimerData)); - absolute_timeout(timeout, &(mtd->when)); + mtd->when = erl_drv_monotonic_time(ERL_DRV_MSEC) + ((ErlDrvTime) timeout) + 1; mtd->timeout_function = timeout_fun; mtd->caller = caller; mtd->next = mtd->prev = NULL; for(p = *first,s = NULL; p != NULL; s = p, p = p->next) { - if (p->when.megasecs >= mtd->when.megasecs) { - break; - } - } - for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) { - if (p->when.secs >= mtd->when.secs) { - break; - } - } - for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) { - if (p->when.microsecs >= mtd->when.microsecs) { + if (p->when >= mtd->when) { break; } } @@ -12353,12 +12246,6 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, } return mtd; } -#undef eq_mega -#undef eq_sec - - - - /*----------------------------------------------------------------------------- -- cgit v1.2.3 From 3f33428db9aea0d767295322c4e882a5c6bbf7db Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 19 Jan 2016 17:05:55 +0100 Subject: Introduce time management in native APIs --- erts/doc/src/erl_driver.xml | 112 +++++++++++++++++++ erts/doc/src/erl_nif.xml | 112 +++++++++++++++++++ erts/emulator/beam/erl_driver.h | 92 +++++----------- erts/emulator/beam/erl_drv_nif.h | 84 ++++++++++++++ erts/emulator/beam/erl_nif.c | 20 ++++ erts/emulator/beam/erl_nif.h | 62 +++-------- erts/emulator/beam/erl_nif_api_funcs.h | 6 + erts/emulator/beam/erl_time.h | 4 + erts/emulator/beam/erl_time_sup.c | 145 ++++++++++++++++++++++++ erts/emulator/beam/io.c | 23 ++++ erts/emulator/sys/win32/erl_win_dyn_driver.h | 14 +++ erts/emulator/test/nif_SUITE.erl | 153 +++++++++++++++++++++++++- erts/emulator/test/nif_SUITE_data/nif_SUITE.c | 94 +++++++++++++++- 13 files changed, 809 insertions(+), 112 deletions(-) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index e717fc0c4e..e338e95938 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -347,6 +347,16 @@ the driver does not handle sizes that overflow an int all will work as before.

 + Time Measurement +

Support for time measurement in drivers: + + ErlDrvTime + ErlDrvTimeUnit + erl_drv_monotonic_time() + erl_drv_time_offset() + erl_drv_convert_time_unit() +

+
@@ -860,6 +870,24 @@ typedef struct ErlIOVec { erl_drv_tsd_get().

+ ErlDrvTime + +

A signed 64-bit integer type for representation of time.

+ + ErlDrvTimeUnit + +

An enumeration of time units supported by the driver API:

+ + ERL_DRV_SEC +

Seconds

 + ERL_DRV_MSEC +

Milliseconds

 + ERL_DRV_USEC +

Microseconds

 + ERL_DRV_NSEC +

Nanoseconds

 + +
@@ -1023,6 +1051,10 @@ typedef struct ErlIOVec { Read a system timestamp +

This function is deprecated! Do not use it! + Use the documented + time measurement functionality + instead.

This function reads a timestamp into the memory pointed to by the parameter now. See the description of ErlDrvNowData for specification of its fields.

@@ -2997,6 +3029,86 @@ ERL_DRV_MAP int sz + + ErlDrvTimeerl_drv_monotonic_time(ErlDrvTimeUnit time_unit) + Get Erlang Monotonic Time + + +

Arguments:

+ + time_unit + Time unit of returned value. + +

+ Returns + Erlang + monotonic time. Note that it is not uncommon with + negative values. +

+

Returns ERL_DRV_TIME_ERROR if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.

+

See also:

+ + ErlDrvTime + ErlDrvTimeUnit + + + + + + ErlDrvTimeerl_drv_time_offset(ErlDrvTimeUnit time_unit) + Get current Time Offset + + +

Arguments:

+ + time_unit + Time unit of returned value. + +

Returns the current time offset between + Erlang monotonic time + and + Erlang system time + converted into the time_unit passed as argument.

+

Returns ERL_DRV_TIME_ERROR if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.

+

See also:

+ + ErlDrvTime + ErlDrvTimeUnit + + + + + + ErlDrvTimeerl_drv_convert_time_unit(ErlDrvTime val, ErlDrvTimeUnit from, ErlDrvTimeUnit to) + Convert time unit of a time value + + +

Arguments:

+ + val + Value to convert time unit for. + from + Time unit of val. + to + Time unit of returned value. + +

Converts the val value of time unit from to + the corresponding value of time unit to. The result is + rounded using the floor function.

+

Returns ERL_DRV_TIME_ERROR if called with an invalid + time unit argument.

+

See also:

+ + ErlDrvTime + ErlDrvTimeUnit + + + +
SEE ALSO diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 2d8706169f..420c9fea38 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -317,6 +317,17 @@ ok libraries might however fail if deprecated features are used.

+ Time Measurement +

Support for time measurement in NIF libraries: + + ErlNifTime + ErlNifTimeUnit + enif_monotonic_time() + enif_time_offset() + enif_convert_time_unit() +

+ + Long-running NIFs

Native functions @@ -560,6 +571,25 @@ typedef enum {

A native signed 64-bit integer type.

 ErlNifUInt64

A native unsigned 64-bit integer type.

 + + ErlNifTime + +

A signed 64-bit integer type for representation of time.

+ + ErlNifTimeUnit + +

An enumeration of time units supported by the NIF API:

+ + ERL_NIF_SEC +

Seconds

 + ERL_NIF_MSEC +

Milliseconds

 + ERL_NIF_USEC +

Microseconds

 + ERL_NIF_NSEC +

Nanoseconds

 + +
@@ -1486,6 +1516,88 @@ enif_map_iterator_destroy(env, &iter);

Same as erl_drv_tsd_set.

+ + + + ErlNifTimeenif_monotonic_time(ErlNifTimeUnit time_unit) + Get Erlang Monotonic Time + + +

Arguments:

+ + time_unit + Time unit of returned value. + +

+ Returns + Erlang + monotonic time. Note that it is not uncommon with + negative values. +

+

Returns ERL_NIF_TIME_ERROR if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.

+

See also:

+ + ErlNifTime + ErlNifTimeUnit + + + + + + ErlNifTimeenif_time_offset(ErlNifTimeUnit time_unit) + Get current Time Offset + + +

Arguments:

+ + time_unit + Time unit of returned value. + +

Returns the current time offset between + Erlang monotonic time + and + Erlang system time + converted into the time_unit passed as argument.

+

Returns ERL_NIF_TIME_ERROR if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.

+

See also:

+ + ErlNifTime + ErlNifTimeUnit + + + + + + ErlNifTimeenif_convert_time_unit(ErlNifTime val, ErlNifTimeUnit from, ErlNifTimeUnit to) + Convert time unit of a time value + + +

Arguments:

+ + val + Value to convert time unit for. + from + Time unit of val. + to + Time unit of returned value. + +

Converts the val value of time unit from to + the corresponding value of time unit to. The result is + rounded using the floor function.

+

Returns ERL_NIF_TIME_ERROR if called with an invalid + time unit argument.

+

See also:

+ + ErlNifTime + ErlNifTimeUnit + + + +
SEE ALSO diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index dbb4d719c1..7ab58e336b 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -37,47 +37,6 @@ # endif #endif -#ifdef SIZEOF_CHAR -# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR -# undef SIZEOF_CHAR -#endif -#ifdef SIZEOF_SHORT -# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT -# undef SIZEOF_SHORT -#endif -#ifdef SIZEOF_INT -# define SIZEOF_INT_SAVED__ SIZEOF_INT -# undef SIZEOF_INT -#endif -#ifdef SIZEOF_LONG -# define SIZEOF_LONG_SAVED__ SIZEOF_LONG -# undef SIZEOF_LONG -#endif -#ifdef SIZEOF_LONG_LONG -# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG -# undef SIZEOF_LONG_LONG -#endif -#ifdef HALFWORD_HEAP_EMULATOR -# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR -# undef HALFWORD_HEAP_EMULATOR -#endif -#include "erl_int_sizes_config.h" -#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR -# error SIZEOF_CHAR mismatch -#endif -#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT -# error SIZEOF_SHORT mismatch -#endif -#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT -# error SIZEOF_INT mismatch -#endif -#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG -# error SIZEOF_LONG mismatch -#endif -#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG -# error SIZEOF_LONG_LONG mismatch -#endif - /* This is OK to override by the NIF/driver implementor */ #if defined(HALFWORD_HEAP_EMULATOR_SAVED__) && !defined(HALFWORD_HEAP_EMULATOR) #define HALFWORD_HEAP_EMULATOR HALFWORD_HEAP_EMULATOR_SAVED__ @@ -134,7 +93,7 @@ typedef struct { #define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed) #define ERL_DRV_EXTENDED_MAJOR_VERSION 3 -#define ERL_DRV_EXTENDED_MINOR_VERSION 2 +#define ERL_DRV_EXTENDED_MINOR_VERSION 3 /* * The emulator will refuse to load a driver with a major version @@ -176,28 +135,12 @@ typedef struct { /* * Integer types */ -#if defined(__WIN32__) && (SIZEOF_VOID_P == 8) -typedef unsigned __int64 ErlDrvTermData; -typedef unsigned __int64 ErlDrvUInt; -typedef signed __int64 ErlDrvSInt; -#else -typedef unsigned long ErlDrvTermData; -typedef unsigned long ErlDrvUInt; -typedef signed long ErlDrvSInt; -#endif -#if defined(__WIN32__) -typedef unsigned __int64 ErlDrvUInt64; -typedef __int64 ErlDrvSInt64; -#elif SIZEOF_LONG == 8 -typedef unsigned long ErlDrvUInt64; -typedef long ErlDrvSInt64; -#elif SIZEOF_LONG_LONG == 8 -typedef unsigned long long ErlDrvUInt64; -typedef long long ErlDrvSInt64; -#else -#error No 64-bit integer type -#endif +typedef ErlNapiUInt64 ErlDrvUInt64; +typedef ErlNapiSInt64 ErlDrvSInt64; +typedef ErlNapiUInt ErlDrvUInt; +typedef ErlNapiSInt ErlDrvSInt; +typedef ErlNapiUInt ErlDrvTermData; #if defined(__WIN32__) || defined(_WIN32) typedef ErlDrvUInt ErlDrvSizeT; @@ -250,6 +193,17 @@ typedef struct { unsigned long microsecs; } ErlDrvNowData; +typedef ErlDrvSInt64 ErlDrvTime; + +#define ERL_DRV_TIME_ERROR ((ErlDrvSInt64) ERTS_NAPI_TIME_ERROR__) + +typedef enum { + ERL_DRV_SEC = ERTS_NAPI_SEC__, + ERL_DRV_MSEC = ERTS_NAPI_MSEC__, + ERL_DRV_USEC = ERTS_NAPI_USEC__, + ERL_DRV_NSEC = ERTS_NAPI_NSEC__ +} ErlDrvTimeUnit; + /* * Error codes that can be return from driver. */ @@ -685,8 +639,16 @@ EXTERN long driver_async(ErlDrvPort ix, EXTERN int driver_lock_driver(ErlDrvPort ix); /* Get the current 'now' timestamp (analogue to erlang:now()) */ -EXTERN int driver_get_now(ErlDrvNowData *now); - +EXTERN int driver_get_now(ErlDrvNowData *now) ERL_DRV_DEPRECATED_FUNC; + +/* Erlang Monotonic Time */ +EXTERN ErlDrvTime erl_drv_monotonic_time(ErlDrvTimeUnit time_unit); +/* Time offset between Erlang Monotonic Time and Erlang System Time */ +EXTERN ErlDrvTime erl_drv_time_offset(ErlDrvTimeUnit time_unit); +/* Time unit conversion */ +EXTERN ErlDrvTime erl_drv_convert_time_unit(ErlDrvTime val, + ErlDrvTimeUnit from, + ErlDrvTimeUnit to); /* These were removed from the ANSI version, now they're back. */ diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index e2385f63f4..f6b946ae82 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -50,6 +50,90 @@ typedef enum { } ErlDrvDirtyJobFlags; #endif +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif +#ifdef HALFWORD_HEAP_EMULATOR +# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR +# undef HALFWORD_HEAP_EMULATOR +#endif +#include "erl_int_sizes_config.h" +#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR +# error SIZEOF_CHAR mismatch +#endif +#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT +# error SIZEOF_SHORT mismatch +#endif +#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT +# error SIZEOF_INT mismatch +#endif +#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG +# error SIZEOF_LONG mismatch +#endif +#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG +# error SIZEOF_LONG_LONG mismatch +#endif + +#if !defined(__GNUC__) && (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +typedef unsigned __int64 ErlNapiUInt64; +typedef signed __int64 ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807i64 +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1i64) +#elif SIZEOF_LONG == 8 +typedef unsigned long ErlNapiUInt64; +typedef signed long ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807L +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1L) +#elif SIZEOF_LONG_LONG == 8 +typedef unsigned long long ErlNapiUInt64; +typedef signed long long ErlNapiSInt64; +#define ERL_NAPI_SINT64_MAX__ 9223372036854775807LL +#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1LL) +#else +# error No 64-bit integer type +#endif + +#if SIZEOF_VOID_P == 8 +typedef ErlNapiUInt64 ErlNapiUInt; +typedef ErlNapiSInt64 ErlNapiSInt; +#elif SIZEOF_VOID_P == 4 +# if SIZEOF_LONG == SIZEOF_VOID_P +typedef unsigned long ErlNapiUInt; +typedef signed long ErlNapiSInt; +# elif SIZEOF_INT == SIZEOF_VOID_P +typedef unsigned int ErlNapiUInt; +typedef signed int ErlNapiSInt; +# else +# error No 32-bit integer type +# endif +#else +# error Not support arch +#endif + +#define ERTS_NAPI_TIME_ERROR__ ERL_NAPI_SINT64_MIN__ + +#define ERTS_NAPI_SEC__ 0 +#define ERTS_NAPI_MSEC__ 1 +#define ERTS_NAPI_USEC__ 2 +#define ERTS_NAPI_NSEC__ 3 + #endif /* __ERL_DRV_NIF_H__ */ diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index d7a2076d85..3141b05e2b 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1175,6 +1175,26 @@ void enif_thread_exit(void *resp) { erl_drv_thread_exit(resp); } int enif_thread_join(ErlNifTid tid, void **respp) { return erl_drv_thread_join(tid,respp); } int enif_getenv(const char *key, char *value, size_t *value_size) { return erl_drv_getenv(key, value, value_size); } +ErlNifTime enif_monotonic_time(ErlNifTimeUnit time_unit) +{ + return (ErlNifTime) erts_napi_monotonic_time((int) time_unit); +} + +ErlNifTime enif_time_offset(ErlNifTimeUnit time_unit) +{ + return (ErlNifTime) erts_napi_time_offset((int) time_unit); +} + +ErlNifTime +enif_convert_time_unit(ErlNifTime val, + ErlNifTimeUnit from, + ErlNifTimeUnit to) +{ + return (ErlNifTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val, + (int) from, + (int) to); +} + int enif_fprintf(void* filep, const char* format, ...) { int ret; diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 5e39343e9b..75070ad901 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -49,9 +49,10 @@ ** add ErlNifFunc flags ** 2.8: 18.0 add enif_has_pending_exception ** 2.9: 18.2 enif_getenv +** 2.10: Time API */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 9 +#define ERL_NIF_MINOR_VERSION 10 /* * The emulator will refuse to load a nif-lib with a major version @@ -67,63 +68,36 @@ #include -#ifdef SIZEOF_CHAR -# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR -# undef SIZEOF_CHAR -#endif -#ifdef SIZEOF_SHORT -# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT -# undef SIZEOF_SHORT -#endif -#ifdef SIZEOF_INT -# define SIZEOF_INT_SAVED__ SIZEOF_INT -# undef SIZEOF_INT -#endif -#ifdef SIZEOF_LONG -# define SIZEOF_LONG_SAVED__ SIZEOF_LONG -# undef SIZEOF_LONG -#endif -#ifdef SIZEOF_LONG_LONG -# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG -# undef SIZEOF_LONG_LONG -#endif -#ifdef HALFWORD_HEAP_EMULATOR -# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR -# undef HALFWORD_HEAP_EMULATOR -#endif -#include "erl_int_sizes_config.h" - #ifdef __cplusplus extern "C" { #endif -#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) -typedef unsigned __int64 ErlNifUInt64; -typedef __int64 ErlNifSInt64; -#elif SIZEOF_LONG == 8 -typedef unsigned long ErlNifUInt64; -typedef long ErlNifSInt64; -#elif SIZEOF_LONG_LONG == 8 -typedef unsigned long long ErlNifUInt64; -typedef long long ErlNifSInt64; -#else -#error No 64-bit integer type -#endif +typedef ErlNapiUInt64 ErlNifUInt64; +typedef ErlNapiSInt64 ErlNifSInt64; +typedef ErlNapiUInt ErlNifUInt; +typedef ErlNapiSInt ErlNifSInt; #ifdef HALFWORD_HEAP_EMULATOR # define ERL_NIF_VM_VARIANT "beam.halfword" typedef unsigned int ERL_NIF_TERM; #else # define ERL_NIF_VM_VARIANT "beam.vanilla" -# if SIZEOF_LONG == SIZEOF_VOID_P -typedef unsigned long ERL_NIF_TERM; -# elif SIZEOF_LONG_LONG == SIZEOF_VOID_P -typedef unsigned long long ERL_NIF_TERM; -# endif +typedef ErlNifUInt ERL_NIF_TERM; #endif typedef ERL_NIF_TERM ERL_NIF_UINT; +typedef ErlNifSInt64 ErlNifTime; + +#define ERL_NIF_TIME_ERROR ((ErlNifSInt64) ERTS_NAPI_TIME_ERROR__) + +typedef enum { + ERL_NIF_SEC = ERTS_NAPI_SEC__, + ERL_NIF_MSEC = ERTS_NAPI_MSEC__, + ERL_NIF_USEC = ERTS_NAPI_USEC__, + ERL_NIF_NSEC = ERTS_NAPI_NSEC__ +} ErlNifTimeUnit; + struct enif_environment_t; typedef struct enif_environment_t ErlNifEnv; diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 08b9afc6af..1448a508a2 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -160,6 +160,9 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env, ERL_NIF_TERM* reason)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason)); ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* value_size)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_monotonic_time, (ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_time_offset, (ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_convert_time_unit, (ErlNifTime, ErlNifTimeUnit, ErlNifTimeUnit)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -312,6 +315,9 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception) # define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_exception) # define enif_getenv ERL_NIF_API_FUNC_MACRO(enif_getenv) +# define enif_monotonic_time ERL_NIF_API_FUNC_MACRO(enif_monotonic_time) +# define enif_time_offset ERL_NIF_API_FUNC_MACRO(enif_time_offset) +# define enif_convert_time_unit ERL_NIF_API_FUNC_MACRO(enif_convert_time_unit) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 43e543e035..93a0d556bf 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -133,6 +133,10 @@ typedef struct { extern ErtsTimeSupData erts_time_sup__; +ErtsMonotonicTime erts_napi_monotonic_time(int time_unit); +ErtsMonotonicTime erts_napi_time_offset(int time_unit); +ErtsMonotonicTime erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to); + ERTS_GLB_INLINE Uint64 erts_time_unit_conversion(Uint64 value, Uint32 from_time_unit, diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 2c87b8e81c..5f12c7809a 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -33,6 +33,8 @@ #include "global.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" +#include "erl_driver.h" +#include "erl_nif.h" static erts_smp_mtx_t erts_timeofday_mtx; static erts_smp_mtx_t erts_get_time_mtx; @@ -57,6 +59,7 @@ static int time_sup_initialized = 0; #define ERTS_MONOTONIC_TIME_TERA \ (ERTS_MONOTONIC_TIME_GIGA*ERTS_MONOTONIC_TIME_KILO) +static void init_time_napi(void); static void schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset); @@ -948,6 +951,8 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode) ErtsMonotonicTime abs_native_offset, native_offset; #endif + init_time_napi(); + erts_hl_timer_init(); ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX); @@ -2197,6 +2202,146 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto return ret; } + +/* + * Time Native API (drivers and NIFs) + */ + +#define ERTS_NAPI_TIME_ERROR ((ErtsMonotonicTime) ERTS_NAPI_TIME_ERROR__) + +static void +init_time_napi(void) +{ + /* Verify that time native api constants are as expected... */ + + ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlDrvTime)); + ASSERT(ERL_DRV_TIME_ERROR == (ErlDrvTime) ERTS_NAPI_TIME_ERROR); + ASSERT(ERL_DRV_TIME_ERROR < (ErlDrvTime) 0); + ASSERT(ERTS_NAPI_SEC__ == (int) ERL_DRV_SEC); + ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_DRV_MSEC); + ASSERT(ERTS_NAPI_USEC__ == (int) ERL_DRV_USEC); + ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_DRV_NSEC); + + ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlNifTime)); + ASSERT(ERL_NIF_TIME_ERROR == (ErlNifTime) ERTS_NAPI_TIME_ERROR); + ASSERT(ERL_NIF_TIME_ERROR < (ErlNifTime) 0); + ASSERT(ERTS_NAPI_SEC__ == (int) ERL_NIF_SEC); + ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_NIF_MSEC); + ASSERT(ERTS_NAPI_USEC__ == (int) ERL_NIF_USEC); + ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_NIF_NSEC); +} + +ErtsMonotonicTime +erts_napi_monotonic_time(int time_unit) +{ + ErtsSchedulerData *esdp; + ErtsMonotonicTime mtime; + + /* At least for now only allow schedulers to do this... */ + esdp = erts_get_scheduler_data(); + if (!esdp) + return ERTS_NAPI_TIME_ERROR; + + mtime = time_sup.r.o.get_time(); + update_last_mtime(esdp, mtime); + + switch (time_unit) { + case ERTS_NAPI_SEC__: + mtime = ERTS_MONOTONIC_TO_SEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_SEC; + break; + case ERTS_NAPI_MSEC__: + mtime = ERTS_MONOTONIC_TO_MSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_MSEC; + break; + case ERTS_NAPI_USEC__: + mtime = ERTS_MONOTONIC_TO_USEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_USEC; + break; + case ERTS_NAPI_NSEC__: + mtime = ERTS_MONOTONIC_TO_NSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_NSEC; + break; + default: + return ERTS_NAPI_TIME_ERROR; + } + + return mtime; +} + +ErtsMonotonicTime +erts_napi_time_offset(int time_unit) +{ + ErtsSchedulerData *esdp; + ErtsSystemTime offs; + + /* At least for now only allow schedulers to do this... */ + esdp = erts_get_scheduler_data(); + if (!esdp) + return ERTS_NAPI_TIME_ERROR; + + offs = get_time_offset(); + switch (time_unit) { + case ERTS_NAPI_SEC__: + offs = ERTS_MONOTONIC_TO_SEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_SEC; + break; + case ERTS_NAPI_MSEC__: + offs = ERTS_MONOTONIC_TO_MSEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_MSEC; + break; + case ERTS_NAPI_USEC__: + offs = ERTS_MONOTONIC_TO_USEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_USEC; + break; + case ERTS_NAPI_NSEC__: + offs = ERTS_MONOTONIC_TO_NSEC(offs); + offs -= ERTS_MONOTONIC_OFFSET_NSEC; + break; + default: + return ERTS_NAPI_TIME_ERROR; + } + return offs; +} + +ErtsMonotonicTime +erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to) +{ + ErtsMonotonicTime ffreq, tfreq, denom; + /* + * Convertion between time units using floor function. + * + * Note that this needs to work also for negative + * values. Ordinary integer division on a negative + * value will give ceiling... + */ + + switch ((int) from) { + case ERTS_NAPI_SEC__: ffreq = 1; break; + case ERTS_NAPI_MSEC__: ffreq = 1000; break; + case ERTS_NAPI_USEC__: ffreq = 1000*1000; break; + case ERTS_NAPI_NSEC__: ffreq = 1000*1000*1000; break; + default: return ERTS_NAPI_TIME_ERROR; + } + + switch ((int) to) { + case ERTS_NAPI_SEC__: tfreq = 1; break; + case ERTS_NAPI_MSEC__: tfreq = 1000; break; + case ERTS_NAPI_USEC__: tfreq = 1000*1000; break; + case ERTS_NAPI_NSEC__: tfreq = 1000*1000*1000; break; + default: return ERTS_NAPI_TIME_ERROR; + } + + if (tfreq >= ffreq) + return val * (tfreq / ffreq); + + denom = ffreq / tfreq; + if (val >= 0) + return val / denom; + + return (val - (denom - 1)) / denom; +} + /* Built in functions */ BIF_RETTYPE monotonic_time_0(BIF_ALIST_0) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index c64c8802b9..2bd31ee97e 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -50,6 +50,7 @@ #include "erl_map.h" #include "erl_bif_unique.h" #include "erl_hl_timer.h" +#include "erl_time.h" extern ErlDrvEntry fd_driver_entry; #ifndef __OSE__ @@ -6762,6 +6763,28 @@ driver_get_now(ErlDrvNowData *now_data) return 0; } +ErlDrvTime +erl_drv_monotonic_time(ErlDrvTimeUnit time_unit) +{ + return (ErlDrvTime) erts_napi_monotonic_time((int) time_unit); +} + +ErlDrvTime +erl_drv_time_offset(ErlDrvTimeUnit time_unit) +{ + return (ErlDrvTime) erts_napi_time_offset((int) time_unit); +} + +ErlDrvTime +erl_drv_convert_time_unit(ErlDrvTime val, + ErlDrvTimeUnit from, + ErlDrvTimeUnit to) +{ + return (ErlDrvTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val, + (int) from, + (int) to); +} + static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) { RefThing *refp; diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index baac7c903e..9c699fdba0 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -103,6 +103,11 @@ WDD_TYPEDEF(ErlDrvSInt, driver_pdl_inc_refc, (ErlDrvPDL)); WDD_TYPEDEF(ErlDrvSInt, driver_pdl_dec_refc, (ErlDrvPDL)); WDD_TYPEDEF(void, driver_system_info, (ErlDrvSysInfo *, size_t)); WDD_TYPEDEF(int, driver_get_now, (ErlDrvNowData *)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_monotonic_time, (ErlDrvTimeUnit)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_time_offset, (ErlDrvTimeUnit)); +WDD_TYPEDEF(ErlDrvTime, erl_drv_convert_time_unit, (ErlDrvTime, + ErlDrvTimeUnit, + ErlDrvTimeUnit)); WDD_TYPEDEF(int, driver_monitor_process, (ErlDrvPort port, ErlDrvTermData process, ErlDrvMonitor *monitor)); @@ -217,6 +222,9 @@ typedef struct { WDD_FTYPE(driver_pdl_dec_refc) *driver_pdl_dec_refc; WDD_FTYPE(driver_system_info) *driver_system_info; WDD_FTYPE(driver_get_now) *driver_get_now; + WDD_FTYPE(erl_drv_monotonic_time) *erl_drv_monotonic_time; + WDD_FTYPE(erl_drv_time_offset) *erl_drv_time_offset; + WDD_FTYPE(erl_drv_convert_time_unit) *erl_drv_convert_time_unit; WDD_FTYPE(driver_monitor_process) *driver_monitor_process; WDD_FTYPE(driver_demonitor_process) *driver_demonitor_process; WDD_FTYPE(driver_get_monitored_process) *driver_get_monitored_process; @@ -328,6 +336,9 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_pdl_dec_refc (WinDynDriverCallbacks.driver_pdl_dec_refc) #define driver_system_info (WinDynDriverCallbacks.driver_system_info) #define driver_get_now (WinDynDriverCallbacks.driver_get_now) +#define erl_drv_monotonic_time (WinDynDriverCallbacks.erl_drv_monotonic_time) +#define erl_drv_time_offset (WinDynDriverCallbacks.erl_drv_time_offset) +#define erl_drv_convert_time_unit (WinDynDriverCallbacks.erl_drv_convert_time_unit) #define driver_monitor_process \ (WinDynDriverCallbacks.driver_monitor_process) #define driver_demonitor_process \ @@ -463,6 +474,9 @@ do { \ ((W).driver_pdl_dec_refc) = driver_pdl_dec_refc; \ ((W).driver_system_info) = driver_system_info; \ ((W).driver_get_now) = driver_get_now; \ +((W).erl_drv_monotonic_time) = erl_drv_monotonic_time; \ +((W).erl_drv_time_offset) = erl_drv_time_offset; \ +((W).erl_drv_convert_time_unit) = erl_drv_convert_time_unit; \ ((W).driver_monitor_process) = driver_monitor_process; \ ((W).driver_demonitor_process) = driver_demonitor_process; \ ((W).driver_get_monitored_process) = driver_get_monitored_process; \ diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index af2b955184..3d478654b1 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -42,7 +42,8 @@ otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, nif_exception/1, call_nif_exception/1, - nif_nan_and_inf/1, nif_atom_too_long/1 + nif_nan_and_inf/1, nif_atom_too_long/1, + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1 ]). -export([many_args_100/100]). @@ -72,7 +73,8 @@ all() -> otp_9828, otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, - nif_exception, nif_nan_and_inf, nif_atom_too_long + nif_exception, nif_nan_and_inf, nif_atom_too_long, + nif_monotonic_time, nif_time_offset, nif_convert_time_unit ]. groups() -> @@ -1783,6 +1785,148 @@ nif_raise_exceptions(NifFunc) -> end end, ok, ExcTerms). +-define(ERL_NIF_TIME_ERROR, -9223372036854775808). +-define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]). + +nif_monotonic_time(Config) -> + ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit), + mtime_loop(1000000). + +mtime_loop(0) -> + ok; +mtime_loop(N) -> + chk_mtime(?TIME_UNITS), + mtime_loop(N-1). + +chk_mtime([]) -> + ok; +chk_mtime([TU|TUs]) -> + A = erlang:monotonic_time(TU), + B = monotonic_time(TU), + C = erlang:monotonic_time(TU), + try + true = A =< B, + true = B =< C + catch + _ : _ -> + ?t:fail({monotonic_time_missmatch, TU, A, B, C}) + end, + chk_mtime(TUs). + +nif_time_offset(Config) -> + ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit), + toffs_loop(1000000). + +toffs_loop(0) -> + ok; +toffs_loop(N) -> + chk_toffs(?TIME_UNITS), + toffs_loop(N-1). + +chk_toffs([]) -> + ok; +chk_toffs([TU|TUs]) -> + TO = erlang:time_offset(TU), + NifTO = time_offset(TU), + case TO =:= NifTO of + true -> + ok; + false -> + case erlang:system_info(time_warp_mode) of + no_time_warp -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO}); + _ -> + %% Most frequent time offset change + %% is currently only every 15:th + %% second so this should currently + %% work... + NTO = erlang:time_offset(TU), + case NifTO =:= NTO of + true -> + ok; + false -> + ?t:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) + end + end + end, + chk_toffs(TUs). + +nif_convert_time_unit(Config) -> + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, seconds, invalid_time_unit), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds), + ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit), + lists:foreach(fun (Offset) -> + lists:foreach(fun (Diff) -> + chk_ctu(Diff+(Offset*1000*1000*1000)) + end, + [999999999999, + 99999999999, + 9999999999, + 999999999, + 99999999, + 9999999, + 999999, + 99999, + 999, + 99, + 9, + 1, + 11, + 101, + 1001, + 10001, + 100001, + 1000001, + 10000001, + 100000001, + 1000000001, + 100000000001, + 1000000000001, + 5, + 50, + 500, + 5000, + 50000, + 500000, + 5000000, + 50000000, + 500000000, + 5000000000, + 50000000000, + 500000000000]) + end, + [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, + 1, 2, 3, 4, 5, 475, 1000, 4711]), + ctu_loop(1000000). + +ctu_loop(0) -> + ok; +ctu_loop(N) -> + chk_ctu(erlang:monotonic_time(nano_seconds)), + ctu_loop(N-1). + +chk_ctu(Time) -> + chk_ctu(Time, ?TIME_UNITS). + +chk_ctu(_Time, []) -> + ok; +chk_ctu(Time, [FromTU|FromTUs]) -> + chk_ctu(Time, FromTU, ?TIME_UNITS), + chk_ctu(Time, FromTUs). + +chk_ctu(_Time, _FromTU, []) -> + ok; +chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> + T = erlang:convert_time_unit(Time, nano_seconds, FromTU), + TE = erlang:convert_time_unit(T, FromTU, ToTU), + TN = convert_time_unit(T, FromTU, ToTU), + case TE =:= TN of + false -> + ?t:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); + true -> + chk_ctu(Time, FromTU, ToTUs) + end. + %% The NIFs: lib_version() -> undefined. call_history() -> ?nif_stub. @@ -1852,6 +1996,11 @@ make_map_remove_nif(_,_) -> ?nif_stub. maps_from_list_nif(_) -> ?nif_stub. sorted_list_from_maps_nif(_) -> ?nif_stub. +%% Time +monotonic_time(_) -> ?nif_stub. +time_offset(_) -> ?nif_stub. +convert_time_unit(_,_,_) -> ?nif_stub. + nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 98e1efe18f..8ebce4fef4 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -34,6 +34,10 @@ static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; static ERL_NIF_TERM atom_binary_resource_type; +static ERL_NIF_TERM atom_seconds; +static ERL_NIF_TERM atom_milli_seconds; +static ERL_NIF_TERM atom_micro_seconds; +static ERL_NIF_TERM atom_nano_seconds; typedef struct @@ -138,6 +142,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); atom_binary_resource_type = enif_make_atom(env,"binary_resource_type"); + atom_seconds = enif_make_atom(env,"seconds"); + atom_milli_seconds = enif_make_atom(env,"milli_seconds"); + atom_micro_seconds = enif_make_atom(env,"micro_seconds"); + atom_nano_seconds = enif_make_atom(env,"nano_seconds"); *priv_data = data; return 0; @@ -1885,6 +1893,87 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER return enif_make_tuple2(env, list_f, list_b); } + +static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_monotonic_time(time_unit)); +} + +static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifTimeUnit time_unit; + + if (argc != 1) + return atom_false; + + if (enif_compare(argv[0], atom_seconds) == 0) + time_unit = ERL_NIF_SEC; + else if (enif_compare(argv[0], atom_milli_seconds) == 0) + time_unit = ERL_NIF_MSEC; + else if (enif_compare(argv[0], atom_micro_seconds) == 0) + time_unit = ERL_NIF_USEC; + else if (enif_compare(argv[0], atom_nano_seconds) == 0) + time_unit = ERL_NIF_NSEC; + else + time_unit = 4711; /* invalid time unit */ + return enif_make_int64(env, enif_time_offset(time_unit)); +} + +static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifSInt64 i64; + ErlNifTime val; + ErlNifTimeUnit from, to; + + if (argc != 3) + return atom_false; + + if (!enif_get_int64(env, argv[0], &i64)) + return enif_make_badarg(env); + + val = (ErlNifTime) i64; + + if (enif_compare(argv[1], atom_seconds) == 0) + from = ERL_NIF_SEC; + else if (enif_compare(argv[1], atom_milli_seconds) == 0) + from = ERL_NIF_MSEC; + else if (enif_compare(argv[1], atom_micro_seconds) == 0) + from = ERL_NIF_USEC; + else if (enif_compare(argv[1], atom_nano_seconds) == 0) + from = ERL_NIF_NSEC; + else + from = 4711; /* invalid time unit */ + + if (enif_compare(argv[2], atom_seconds) == 0) + to = ERL_NIF_SEC; + else if (enif_compare(argv[2], atom_milli_seconds) == 0) + to = ERL_NIF_MSEC; + else if (enif_compare(argv[2], atom_micro_seconds) == 0) + to = ERL_NIF_USEC; + else if (enif_compare(argv[2], atom_nano_seconds) == 0) + to = ERL_NIF_NSEC; + else + to = 4711; /* invalid time unit */ + + return enif_make_int64(env, enif_convert_time_unit(val, from, to)); +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -1954,7 +2043,10 @@ static ErlNifFunc nif_funcs[] = {"make_map_update_nif", 3, make_map_update_nif}, {"make_map_remove_nif", 2, make_map_remove_nif}, {"maps_from_list_nif", 1, maps_from_list_nif}, - {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif} + {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, + {"monotonic_time", 1, monotonic_time}, + {"time_offset", 1, time_offset}, + {"convert_time_unit", 3, convert_time_unit} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) -- cgit v1.2.3 From c6dcb32548ee0bb4cf5db7ef01593668358cf8b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 21 Jan 2016 15:04:26 +0100 Subject: PER: Correct compilation of named INTEGERs When a constrained INTEGER has more than 16536 values and named values, the compiler would crash when compiling to the PER format. Example: Longitude ::= INTEGER { oneMicrodegreeEast(10), oneMicrodegreeWest(-10), unavailable(1800000001) } (-1799999999..1800000001) Reported-by: Ingars --- lib/asn1/src/asn1ct_imm.erl | 33 ++++++++++++++++++--------------- lib/asn1/test/asn1_SUITE_data/Prim.asn1 | 7 +++++++ lib/asn1/test/testPrim.erl | 29 +++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 15 deletions(-) diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 527f4f0ba9..e09256cde9 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1120,38 +1120,41 @@ per_enc_constrained(Val0, Lb, Ub, false) -> per_enc_constrained(Val0, Lb, Ub, true) -> {Prefix,Val} = sub_lb(Val0, Lb), Range = Ub - Lb + 1, + Check = {ult,Val,Range}, if Range < 256 -> NumBits = per_num_bits(Range), - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1]}], {Prefix,Check,Put}; Range =:= 256 -> NumBits = 8, - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1,align]}], {Prefix,Check,Put}; Range =< 65536 -> - Check = {ult,Val,Range}, Put = [{put_bits,Val,16,[1,align]}], {Prefix,Check,Put}; true -> - {var,VarBase} = Val, - Bin = {var,VarBase++"@bin"}, - BinSize0 = {var,VarBase++"@bin_size0"}, - BinSize = {var,VarBase++"@bin_size"}, - Check = {ult,Val,Range}, RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)), BitsNeeded = per_num_bits(RangeOctsLen), - Enc = [{call,binary,encode_unsigned,[Val],Bin}, - {call,erlang,byte_size,[Bin],BinSize0}, - {sub,BinSize0,1,BinSize}, - {'cond',[['_', - {put_bits,BinSize,BitsNeeded,[1]}, - {put_bits,Bin,binary,[8,align]}]]}], - {Prefix,Check,Enc} + {Prefix,Check,per_enc_constrained_huge(BitsNeeded, Val)} end. +per_enc_constrained_huge(BitsNeeded, {var,VarBase}=Val) -> + Bin = {var,VarBase++"@bin"}, + BinSize0 = {var,VarBase++"@bin_size0"}, + BinSize = {var,VarBase++"@bin_size"}, + [{call,binary,encode_unsigned,[Val],Bin}, + {call,erlang,byte_size,[Bin],BinSize0}, + {sub,BinSize0,1,BinSize}, + {'cond',[['_', + {put_bits,BinSize,BitsNeeded,[1]}, + {put_bits,Bin,binary,[8,align]}]]}]; +per_enc_constrained_huge(BitsNeeded, Val) when is_integer(Val) -> + Bin = binary:encode_unsigned(Val), + BinSize = erlang:byte_size(Bin), + [{put_bits,BinSize-1,BitsNeeded,[1]}, + {put_bits,Val,8*BinSize,[1,align]}]. + per_enc_unconstrained(Val, Aligned) -> case Aligned of false -> []; diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index b4c011fd39..4fe0901683 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -60,4 +60,11 @@ BEGIN e BOOLEAN, magic INTEGER } + + Longitude ::= INTEGER { + oneMicrodegreeEast(10), + oneMicrodegreeWest(-10), + unavailable(1800000001) + } (-1799999999..1800000001) + END diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 8fa9973ea5..dc2e0fa2e7 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -78,8 +78,37 @@ int(Rules) -> roundtrip('ASeq', {'ASeq',false,250,true,200,true,199,true,77788}), roundtrip('ASeq', {'ASeq',true,0,false,0,true,0,true,68789}), + %%========================================================== + %% Longitude ::= INTEGER { + %% oneMicrodegreeEast(10), + %% oneMicrodegreeWest(-10), + %% unavailable(1800000001) + %% } (-1799999999..1800000001) + %%========================================================== + + Enc10 = encoding(Rules, oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', 10, oneMicrodegreeEast), + + Enc20 = encoding(Rules, oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', -10, oneMicrodegreeWest), + + Enc30 = roundtrip('Longitude', unavailable), + Enc30 = roundtrip('Longitude', 1800000001, unavailable), + ok. +encoding(Rules, Type) -> + asn1_test_lib:hex_to_bin(encoding_1(Rules, Type)). + +encoding_1(ber, oneMicrodegreeEast) -> "02010A"; +encoding_1(per, oneMicrodegreeEast) -> "C06B49D2 09"; +encoding_1(uper, oneMicrodegreeEast) -> "6B49D209"; + +encoding_1(ber, oneMicrodegreeWest) -> "0201F6"; +encoding_1(per, oneMicrodegreeWest) -> "C06B49D1 F5"; +encoding_1(uper, oneMicrodegreeWest) -> "6B49D1F5". enum(Rules) -> -- cgit v1.2.3 From 7b06942e7e08583bdb2e5c35a2d8b94a165e1cf7 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Thu, 21 Jan 2016 17:29:39 +0100 Subject: ssl: Fix typos that broke alpn tests --- lib/ssl/test/ssl_to_openssl_SUITE.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index bcdefb5fca..ecf6c4d6b8 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1445,7 +1445,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert", CertFile, "-key" ++ KeyFile], + "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1480,7 +1480,7 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Exe = "openssl", - Args = ["s_client", "-alpn", "http/1.0,spdy/2" "-msg" "-port", + Args = ["s_client", "-alpn", "http/1.0,spdy/2", "-msg", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-host", "localhost"], @@ -1512,7 +1512,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", "spdy/3", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert" ++ CertFile ++ "-key" ++ KeyFile], + "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), -- cgit v1.2.3 From 66a80a7ab735a22249ffbbb7c88eccebba906194 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 21 Jan 2016 19:53:59 +0100 Subject: erts: Add checks for thread safe allocation Assert thread unsafe allocator is only created on non-smp and only called by the main thread. Removed test of unsafe allocator in custom thread. --- erts/emulator/beam/erl_alloc.c | 12 ++++++++++-- erts/emulator/beam/erl_alloc_util.c | 5 +++++ erts/emulator/beam/erl_init.c | 11 ++++++----- erts/emulator/beam/global.h | 3 +++ erts/emulator/test/alloc_SUITE_data/threads.c | 17 +---------------- 5 files changed, 25 insertions(+), 23 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 5544712e8d..e7523ac989 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -968,6 +968,10 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else #endif { +#ifdef ERTS_SMP + erl_exit(ERTS_ABORT_EXIT, "%salloc is not thread safe\n", + init->init.util.name_prefix); +#else af->alloc = erts_alcu_alloc; if (init->init.util.fix_type_size) af->realloc = erts_realloc_fixed_size; @@ -976,6 +980,7 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else af->realloc = erts_alcu_realloc; af->free = erts_alcu_free; +#endif } af->extra = NULL; ai->alloc_util = 1; @@ -3402,8 +3407,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) init.enable = 1; init.atype = GOODFIT; init.init.util.name_prefix = (char *) a1; - init.init.util.ts = a2 ? 1 : 0; - +#ifdef ERTS_SMP + init.init.util.ts = 1; +#else + init.init.util.ts = a2 ? 1 : 0; +#endif if ((char **) a3) { char **argv = (char **) a3; int i = 0; diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index eedfd1e13d..3230b6ef34 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -5337,6 +5337,11 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { void *res; +#ifdef ERTS_SMP + ASSERT(!"This is not thread safe"); +#elif defined(USE_THREADS) + ASSERT(erts_equal_tids(erts_main_thread, erts_thr_self())); +#endif res = do_erts_alcu_alloc(type, extra, size); DEBUG_CHECK_ALIGNMENT(res); return res; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 42aca726bf..39957eb58b 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -152,7 +152,7 @@ volatile int erts_writing_erl_crash_dump = 0; int erts_initialized = 0; #if defined(USE_THREADS) && !defined(ERTS_SMP) -static erts_tid_t main_thread; +erts_tid_t erts_main_thread; #endif int erts_use_sender_punish; @@ -744,6 +744,10 @@ early_init(int *argc, char **argv) /* char envbuf[21]; /* enough for any 64-bit integer */ size_t envbufsz; +#if defined(USE_THREADS) && !defined(ERTS_SMP) + erts_main_thread = erts_thr_self(); +#endif + erts_save_emu_args(*argc, argv); erts_sched_compact_load = 1; @@ -797,9 +801,6 @@ early_init(int *argc, char **argv) /* (erts_aint32_t) ((Uint16) -1)); erts_pre_init_process(); -#if defined(USE_THREADS) && !defined(ERTS_SMP) - main_thread = erts_thr_self(); -#endif /* * We need to know the number of schedulers to use before we @@ -2285,7 +2286,7 @@ system_cleanup(int flush_async) if (!flush_async || !erts_initialized #if defined(USE_THREADS) && !defined(ERTS_SMP) - || !erts_equal_tids(main_thread, erts_thr_self()) + || !erts_equal_tids(erts_main_thread, erts_thr_self()) #endif ) return; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3f5925765d..ad9fdfc878 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1168,6 +1168,9 @@ extern ErtsModifiedTimings erts_modified_timings[]; extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; +#if defined(USE_THREADS) && !defined(ERTS_SMP) +extern erts_tid_t erts_main_thread; +#endif extern int erts_compat_rel; extern int erts_use_sender_punish; void erts_short_init(void); diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index 2f5f841e3d..44d982b6c7 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -96,16 +96,11 @@ static void fail(int t_no, char *frmt, ...) exit_thread(t_no, 0); } -static Allctr_t *alloc_not_ts = NULL; static Allctr_t *alloc_ts_1 = NULL; static Allctr_t *alloc_ts_2 = NULL; static void stop_allocators(void) { - if (alloc_not_ts) { - STOP_ALC(alloc_not_ts); - alloc_not_ts = NULL; - } if (alloc_ts_1) { STOP_ALC(alloc_ts_1); alloc_ts_1 = NULL; @@ -155,7 +150,6 @@ testcase_run(TestCaseState_t *tcs) if (!IS_THREADS_ENABLED) testcase_skipped(tcs, "Threads not enabled"); - alloc_not_ts = NULL; alloc_ts_1 = NULL; alloc_ts_2 = NULL; @@ -163,9 +157,6 @@ testcase_run(TestCaseState_t *tcs) sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); - memcpy((void *) argv, argv_org, sizeof(argv_org)); - alloc_not_ts = START_ALC("threads_not_ts", 0, argv); - ASSERT(tcs, alloc_not_ts); memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_1 = START_ALC("threads_ts_1", 1, argv); ASSERT(tcs, alloc_ts_1); @@ -173,7 +164,6 @@ testcase_run(TestCaseState_t *tcs) alloc_ts_2 = START_ALC("threads_ts_2", 1, argv); ASSERT(tcs, alloc_ts_2); - ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2)); @@ -190,12 +180,7 @@ testcase_run(TestCaseState_t *tcs) threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; - if (i == 1) { - alc = "threads_not_ts"; - threads[i].arg.no_ops_per_bl *= 2; - threads[i].arg.a = alloc_not_ts; - } - else if (i % 2 == 0) { + if (i % 2 == 0) { alc = "threads_ts_1"; threads[i].arg.a = alloc_ts_1; } -- cgit v1.2.3 From e9d6797e15e687828e5ef0d33fb790181d657779 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 21 Jan 2016 19:54:46 +0100 Subject: erts: Fix faulty assert for non-smp --- erts/emulator/beam/erl_message.c | 2 +- erts/emulator/beam/sys.h | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index b3e74e3e6a..88efb2c59f 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1504,7 +1504,7 @@ erts_factory_message_create(ErtsHeapFactory* factory, } if (on_heap) { - ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); ASSERT(ohp == &proc->off_heap); factory->mode = FACTORY_HALLOC; factory->p = proc; diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 53f8313daa..37fcfd1c52 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -196,6 +196,12 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f # define ASSERT(e) ((void) 1) #endif +#ifdef ERTS_SMP +# define ERTS_SMP_ASSERT(e) ASSERT(e) +#else +# define ERTS_SMP_ASSERT(e) ((void)1) +#endif + /* ERTS_UNDEF can be used to silence false warnings about * "variable may be used uninitialized" while keeping the variable * marked as undefined by valgrind. -- cgit v1.2.3 From 89098ea8beb9e60faa59c3f2ea9ffc918ef87ae8 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Fri, 22 Jan 2016 10:24:13 +0100 Subject: Fix testcase --- erts/emulator/test/statistics_SUITE.erl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 53c9ba8715..a6305d453c 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -440,6 +440,10 @@ run_queues_lengths_active_tasks(Config) -> SO = erlang:system_flag(schedulers_online, 1), + %% Give newly suspended schedulers some time to + %% migrate away work from their run queues... + receive after 1000 -> ok end, + TRQLs1 = statistics(total_run_queue_lengths), TATs1 = statistics(total_active_tasks), true = TRQLs1 >= 10, -- cgit v1.2.3 From c623e64625cc4154d9d314f46446c681e2e4e697 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 13 Jan 2016 07:54:33 +0100 Subject: code_server: Tighten type of modules parameters The following functions in the 'code' module only allow the module argument to an atom: load_file/1 load_binary/3 ensure_loaded/1 delete/1 purge/1 soft_purge/1 get_object_code/1 Therefore, there is no reason that the corresponding implementation in code_server should allow the module to be either an atom or a string. Only accept an atom and remove the helper functions to_atom/1 and do_mod_call/4. --- lib/kernel/src/code_server.erl | 120 ++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 79 deletions(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 1a42cc0e9f..c354cafa1f 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -246,13 +246,8 @@ handle_call({dir,Dir}, {_From,_Tag}, S) -> Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, Caller, St) -> - case modp(Mod) of - false -> - {reply,{error,badarg},St}; - true -> - load_file(Mod, Caller, St) - end; +handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) -> + load_file(Mod, Caller, St); handle_call({add_path,Where,Dir0}, {_From,_Tag}, #state{namedb=Namedb,path=Path0}=S) -> @@ -291,7 +286,7 @@ handle_call({load_abs,File,Mod}, Caller, S) -> load_abs(File, Mod, Caller, S) end; -handle_call({load_binary,Mod,File,Bin}, Caller, S) -> +handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> @@ -307,59 +302,44 @@ handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> Status = hipe_result_to_status(Result), {reply,Status,S}; -handle_call({ensure_loaded,Mod0}, Caller, St0) -> - Fun = fun (M, St) -> - case erlang:module_loaded(M) of - true -> - {reply,{module,M},St}; - false when St#state.mode =:= interactive -> - load_file(M, Caller, St); - false -> - {reply,{error,embedded},St} - end - end, - do_mod_call(Fun, Mod0, {error,badarg}, St0); - -handle_call({delete,Mod0}, {_From,_Tag}, S) -> - Fun = fun (M, St) -> - case catch erlang:delete_module(M) of - true -> - ets:delete(St#state.moddb, M), - {reply,true,St}; - _ -> - {reply,false,St} - end - end, - do_mod_call(Fun, Mod0, false, S); +handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},St}; + false when St#state.mode =:= interactive -> + load_file(Mod, Caller, St); + false -> + {reply,{error,embedded},St} + end; -handle_call({purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_purge(M),St} - end, Mod0, false, St0); +handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + case catch erlang:delete_module(Mod) of + true -> + ets:delete(St#state.moddb, Mod), + {reply,true,St}; + _ -> + {reply,false,St} + end; + +handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_purge(Mod),St}; -handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_soft_purge(M),St} - end, Mod0, true, St0); +handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,is_loaded(M, St#state.moddb),St} - end, Mod0, false, St0); +handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,is_loaded(Mod, St#state.moddb),St}; handle_call(all_loaded, {_From,_Tag}, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) -> - Fun = fun(M, St) -> - Path = St#state.path, - case mod_to_bin(Path, atom_to_list(M)) of - {_,Bin,FName} -> {reply,{M,Bin,FName},St}; - Error -> {reply,Error,St} - end - end, - do_mod_call(Fun, Mod0, error, St0); +handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + Path = St#state.path, + case mod_to_bin(Path, Mod) of + {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; + Error -> {reply,Error,St} + end; handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> Db = S#state.moddb, @@ -383,17 +363,6 @@ handle_call(Other,{_From,_Tag}, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. -do_mod_call(Action, Module, _Error, St) when is_atom(Module) -> - Action(Module, St); -do_mod_call(Action, Module, Error, St) -> - try list_to_atom(Module) of - Atom when is_atom(Atom) -> - Action(Atom, St) - catch - error:badarg -> - {reply,Error,St} - end. - %% -------------------------------------------------------------- %% Path handling functions. %% -------------------------------------------------------------- @@ -1091,9 +1060,9 @@ add_paths(_,_,Path,_) -> {ok,Path}. do_load_binary(Module, File, Binary, Caller, St) -> - case modp(Module) andalso modp(File) andalso is_binary(Binary) of + case modp(File) andalso is_binary(Binary) of true -> - case erlang:module_loaded(to_atom(Module)) of + case erlang:module_loaded(Module) of true -> do_purge(Module); false -> ok end, @@ -1123,10 +1092,9 @@ load_abs(File, Mod0, Caller, St) -> end. try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> - M = to_atom(Mod), - case pending_on_load(M, From, St0) of + case pending_on_load(Mod, From, St0) of no -> - try_load_module_1(File, M, Bin, Caller, St0); + try_load_module_1(File, Mod, Bin, Caller, St0); {yes,St} -> {noreply,St} end. @@ -1212,8 +1180,7 @@ int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. -load_file(Mod0, {From,_}=Caller, St0) -> - Mod = to_atom(Mod0), +load_file(Mod, {From,_}=Caller, St0) -> case pending_on_load(Mod, From, St0) of no -> load_file_1(Mod, Caller, St0); {yes,St} -> {noreply,St} @@ -1228,7 +1195,7 @@ load_file_1(Mod, Caller, #state{path=Path}=St) -> end. mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, to_list(Mod) ++ objfile_extension()), + File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); @@ -1288,13 +1255,11 @@ is_loaded(M, Db) -> [] -> false end. -do_purge(Mod0) -> - Mod = to_atom(Mod0), +do_purge(Mod) -> {_WasOld, DidKill} = erts_code_purger:purge(Mod), DidKill. -do_soft_purge(Mod0) -> - Mod = to_atom(Mod0), +do_soft_purge(Mod) -> erts_code_purger:soft_purge(Mod). @@ -1412,6 +1377,3 @@ archive_extension() -> to_list(X) when is_list(X) -> X; to_list(X) when is_atom(X) -> atom_to_list(X). - -to_atom(X) when is_atom(X) -> X; -to_atom(X) when is_list(X) -> list_to_atom(X). -- cgit v1.2.3 From 168b7456a249b7f6ea2955059786619968829e4f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 20 Jan 2016 16:46:36 +0100 Subject: Avoid testing for pending on_load twice --- lib/kernel/src/code_server.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index c354cafa1f..ceb3507f17 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1191,7 +1191,7 @@ load_file_1(Mod, Caller, #state{path=Path}=St) -> error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> - try_load_module(File, Mod, Binary, Caller, St) + try_load_module_1(File, Mod, Binary, Caller, St) end. mod_to_bin([Dir|Tail], Mod) -> -- cgit v1.2.3 From b219b9c52ec30d13b2e8eaf246247edb965aac6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 22 Jan 2016 16:10:34 +0100 Subject: Remove redundant test that hipe_unified_loader is loaded For some reason, there is a test in code_server that hipe_unified_loader is loaded before trying to call it. The test was added in R9B, but it is not clear why. Before starting the code server, the 'code' module would always load hipe_unified_loader; thus there is now way that the test can ever fail. --- lib/kernel/src/code_server.erl | 25 +++---------------------- 1 file changed, 3 insertions(+), 22 deletions(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index ceb3507f17..3fbbb98b94 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1113,9 +1113,10 @@ try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> try_load_module_3(File, Mod, Bin, Caller, undefined, St); try_load_module_2(File, Mod, Bin, Caller, Architecture, #state{moddb=Db}=St) -> - case catch load_native_code(Mod, Bin, Architecture) of + case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), + put(?ANY_NATIVE_CODE_LOADED, true), + ets:insert(Db, {Mod,File}), {reply,Module,St}; no_native -> try_load_module_3(File, Mod, Bin, Caller, Architecture, St); @@ -1138,26 +1139,6 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture, {reply,Error,St} end. -load_native_code(Mod, Bin, Architecture) -> - %% During bootstrapping of Open Source Erlang, we don't have any hipe - %% loader modules, but the Erlang emulator might be hipe enabled. - %% Therefore we must test for that the loader modules are available - %% before trying to to load native code. - case erlang:module_loaded(hipe_unified_loader) of - false -> - no_native; - true -> - Result = hipe_unified_loader:load_native_code(Mod, Bin, - Architecture), - case Result of - {module,_} -> - put(?ANY_NATIVE_CODE_LOADED, true); - _ -> - ok - end, - Result - end. - hipe_result_to_status(Result) -> case Result of {module,_} -> -- cgit v1.2.3 From 6347b50048d721688bd0f7da2460a4d8f82275be Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Thu, 21 Jan 2016 11:39:06 +0100 Subject: snmp: Prepare for release As long as it is not prioritized to make an snmp_upgrade_SUITE it is not worth trying to do anything but restart_application --- lib/snmp/src/app/snmp.appup.src | 67 ++++++----------------------------------- 1 file changed, 10 insertions(+), 57 deletions(-) diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 77418f920f..ca61782639 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,71 +1,24 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - - +%% -*- erlang -*- {"%VSN%", %% ----- U p g r a d e ------------------------------------------------------- - %% Instruction examples: %% {restart_application, snmp} %% {load_module, snmp_pdus, soft_purge, soft_purge, []} %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ], - + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ], + %% ------D o w n g r a d e --------------------------------------------------- - %% Instruction examples: %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} - + [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ] - -}. + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ] +}. -- cgit v1.2.3 From 0236a875929729eca1933cbb854267f584734b26 Mon Sep 17 00:00:00 2001 From: Dmytro Lytovchenko Date: Thu, 21 Jan 2016 17:26:56 +0100 Subject: Moved do_list_to_integer from bif.c to big.c --- erts/emulator/beam/bif.c | 157 ----------------------------------------------- erts/emulator/beam/big.c | 153 +++++++++++++++++++++++++++++++++++++++++++++ erts/emulator/beam/big.h | 8 +++ 3 files changed, 161 insertions(+), 157 deletions(-) diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index bb9165cd79..d519216fbd 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2907,163 +2907,6 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) /* convert a list of ascii ascii integer value to an integer */ -#define LTI_BAD_STRUCTURE 0 -#define LTI_NO_INTEGER 1 -#define LTI_SOME_INTEGER 2 -#define LTI_ALL_INTEGER 3 - -static int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest) -{ - Sint i = 0; - Uint ui = 0; - int skip = 0; - int neg = 0; - Sint n = 0; - int m; - int lg2; - Eterm res; - Eterm* hp; - Eterm *hp_end; - Eterm lst = orig_list; - Eterm tail = lst; - int error_res = LTI_BAD_STRUCTURE; - - if (is_nil(lst)) { - error_res = LTI_NO_INTEGER; - error: - *rest = tail; - *integer = make_small(0); - return error_res; - } - if (is_not_list(lst)) - goto error; - - /* if first char is a '-' then it is a negative integer */ - if (CAR(list_val(lst)) == make_small('-')) { - neg = 1; - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } else if (CAR(list_val(lst)) == make_small('+')) { - /* ignore plus */ - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } - - /* Calculate size and do type check */ - - while(1) { - if (is_not_small(CAR(list_val(lst)))) { - break; - } - if (unsigned_val(CAR(list_val(lst))) < '0' || - unsigned_val(CAR(list_val(lst))) > '9') { - break; - } - ui = ui * 10; - ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; - n++; - lst = CDR(list_val(lst)); - if (is_nil(lst)) { - break; - } - if (is_not_list(lst)) { - break; - } - } - - tail = lst; - if (!n) { - error_res = LTI_NO_INTEGER; - goto error; - } - - - /* If n <= 8 then we know it's a small int - ** since 2^27 = 134217728. If n > 8 then we must - ** construct a bignum and let that routine do the checking - */ - - if (n <= SMALL_DIGITS) { /* It must be small */ - if (neg) i = -(Sint)ui; - else i = (Sint)ui; - res = make_small(i); - } else { - /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 - which we round up to (3 + 1/3) */ - lg2 = (n+1)*3 + (n+1)/3 + 1; - m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ - m = BIG_NEED_SIZE(m); /* number of words + thing */ - - hp = HAlloc(p, m); - hp_end = hp + m; - - lst = orig_list; - if (skip) - lst = CDR(list_val(lst)); - - /* load first digits (at least one digit) */ - if ((i = (n % D_DECIMAL_EXP)) == 0) - i = D_DECIMAL_EXP; - n -= i; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - res = small_to_big(m, hp); /* load first digits */ - - while(n) { - i = D_DECIMAL_EXP; - n -= D_DECIMAL_EXP; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_times_small(res, D_DECIMAL_BASE, hp); - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_plus_small(res, m, hp); - } - - if (neg) { - if (is_small(res)) - res = make_small(-signed_val(res)); - else { - Uint *big = big_val(res); /* point to thing */ - *big = bignum_header_neg(*big); - } - } - - if (is_not_small(res)) { - res = big_plus_small(res, 0, hp); /* includes conversion to small */ - - if (is_not_small(res)) { - hp += (big_arity(res)+1); - } - } - HRelease(p,hp_end,hp); - } - *integer = res; - *rest = tail; - if (tail != NIL) { - return LTI_SOME_INTEGER; - } - return LTI_ALL_INTEGER; -} BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) { Eterm res; diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 02d37e24df..29e677d2e5 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2732,3 +2732,156 @@ bytebuf_to_integer_1_done: return res; } + +int do_list_to_integer(Process *p, Eterm orig_list, + Eterm *integer, Eterm *rest) +{ + Sint i = 0; + Uint ui = 0; + int skip = 0; + int neg = 0; + Sint n = 0; + int m; + int lg2; + Eterm res; + Eterm* hp; + Eterm *hp_end; + Eterm lst = orig_list; + Eterm tail = lst; + int error_res = LTI_BAD_STRUCTURE; + + if (is_nil(lst)) { + error_res = LTI_NO_INTEGER; + error: + *rest = tail; + *integer = make_small(0); + return error_res; + } + if (is_not_list(lst)) + goto error; + + /* if first char is a '-' then it is a negative integer */ + if (CAR(list_val(lst)) == make_small('-')) { + neg = 1; + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } else if (CAR(list_val(lst)) == make_small('+')) { + /* ignore plus */ + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } + + /* Calculate size and do type check */ + + while(1) { + if (is_not_small(CAR(list_val(lst)))) { + break; + } + if (unsigned_val(CAR(list_val(lst))) < '0' || + unsigned_val(CAR(list_val(lst))) > '9') { + break; + } + ui = ui * 10; + ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; + n++; + lst = CDR(list_val(lst)); + if (is_nil(lst)) { + break; + } + if (is_not_list(lst)) { + break; + } + } + + tail = lst; + if (!n) { + error_res = LTI_NO_INTEGER; + goto error; + } + + + /* If n <= 8 then we know it's a small int + ** since 2^27 = 134217728. If n > 8 then we must + ** construct a bignum and let that routine do the checking + */ + + if (n <= SMALL_DIGITS) { /* It must be small */ + if (neg) i = -(Sint)ui; + else i = (Sint)ui; + res = make_small(i); + } else { + /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 + which we round up to (3 + 1/3) */ + lg2 = (n+1)*3 + (n+1)/3 + 1; + m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ + m = BIG_NEED_SIZE(m); /* number of words + thing */ + + hp = HAlloc(p, m); + hp_end = hp + m; + + lst = orig_list; + if (skip) + lst = CDR(list_val(lst)); + + /* load first digits (at least one digit) */ + if ((i = (n % D_DECIMAL_EXP)) == 0) + i = D_DECIMAL_EXP; + n -= i; + m = 0; + while(i--) { + m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + lst = CDR(list_val(lst)); + } + res = small_to_big(m, hp); /* load first digits */ + + while(n) { + i = D_DECIMAL_EXP; + n -= D_DECIMAL_EXP; + m = 0; + while(i--) { + m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + lst = CDR(list_val(lst)); + } + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_times_small(res, D_DECIMAL_BASE, hp); + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_plus_small(res, m, hp); + } + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } + } + HRelease(p,hp_end,hp); + } + *integer = res; + *rest = tail; + if (tail != NIL) { + return LTI_SOME_INTEGER; + } + return LTI_ALL_INTEGER; +} diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 94f9bce10e..85807d6eea 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -173,4 +173,12 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); +#define LTI_BAD_STRUCTURE 0 +#define LTI_NO_INTEGER 1 +#define LTI_SOME_INTEGER 2 +#define LTI_ALL_INTEGER 3 + +int do_list_to_integer(Process *p, Eterm orig_list, + Eterm *integer, Eterm *rest); + #endif -- cgit v1.2.3 From 1ddab9c7b66237ea6dd429fb75e4c81247d88920 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 25 Jan 2016 13:12:50 +0100 Subject: Eliminate run-time system crash in code:load_abs/1 The run-time system would terminate if code:load_abs/1 was called with a filename containing any non-latin1 characters. The reason is that code_server would attempt to construct a module name from the filename using list_to_atom/1 and that atoms currently are limited to the latin1 character set. But how should the error be reported? I have decided to that the simplest and least confusing way is to move the call to list_to_atom/1 to 'code' module and let it crash the calling process. The resulting stack back trace will make it clear what the reason for the crash was. --- lib/kernel/src/code.erl | 4 +++- lib/kernel/src/code_server.erl | 9 ++------- lib/kernel/test/code_SUITE.erl | 1 + 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 352c02562b..7d0102d4ef 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -142,7 +142,9 @@ ensure_loaded(Mod) when is_atom(Mod) -> %% XXX File as an atom is allowed only for backwards compatibility. -spec load_abs(Filename) -> load_ret() when Filename :: file:filename(). -load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}). +load_abs(File) when is_list(File); is_atom(File) -> + Mod = list_to_atom(filename:basename(File)), + call({load_abs,File,Mod}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' -spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index e461c95d19..614219794c 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -313,7 +313,7 @@ handle_call(get_path, {_From,_Tag}, S) -> {reply,S#state.path,S}; %% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, Caller, S) -> +handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) -> case modp(File) of false -> {reply,{error,badarg},S}; @@ -1222,15 +1222,10 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. -load_abs(File, Mod0, Caller, St) -> +load_abs(File, Mod, Caller, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), - Mod = if Mod0 =:= [] -> - list_to_atom(filename:basename(FileName0, Ext)); - true -> - Mod0 - end, case erl_prim_loader:get_file(FileName) of {ok,Bin,_} -> try_load_module(FileName, Mod, Bin, Caller, St); diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index ef5303defd..8f97b6c6f8 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -323,6 +323,7 @@ load_abs(Config) when is_list(Config) -> {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), {'EXIT', _} = (catch code:load_abs({})), + {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), code:stick_dir(TestDir), {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), -- cgit v1.2.3 From 70e92b321feb10b5976c9a9f571a273155ebcf79 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 25 Jan 2016 15:45:13 +0100 Subject: erts: Fix harmless dialyzer warnings --- erts/preloaded/ebin/erts_code_purger.beam | Bin 8768 -> 8776 bytes erts/preloaded/ebin/erts_internal.beam | Bin 8536 -> 8536 bytes erts/preloaded/src/erts_code_purger.erl | 2 +- erts/preloaded/src/erts_internal.erl | 4 ++-- 4 files changed, 3 insertions(+), 3 deletions(-) diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 227d96d4c8..541bc7e7cc 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index d3d990519d..c19d59ab3f 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl index a64860bec8..d1e64342e0 100644 --- a/erts/preloaded/src/erts_code_purger.erl +++ b/erts/preloaded/src/erts_code_purger.erl @@ -31,7 +31,7 @@ start() -> loop(). loop() -> - receive + _ = receive {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> Res = do_purge(Mod), From ! {reply, purge, Res, Ref}; diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 84dedab930..2b15abe0fb 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -49,7 +49,7 @@ -export([is_system_process/1]). -%% Auto import name clash +%% Auto-import name clash -export([check_process_code/2]). %% @@ -196,7 +196,7 @@ port_info(_Result, _Item) -> -spec request_system_task(Pid, Prio, Request) -> 'ok' when Prio :: 'max' | 'high' | 'normal' | 'low', Request :: {'garbage_collect', term()} - | {'check_process_code', term(), module(), boolean()}, + | {'check_process_code', term(), module(), non_neg_integer()}, Pid :: pid(). request_system_task(_Pid, _Prio, _Request) -> -- cgit v1.2.3 From 332d61900b466c3bb9f3892d272043e2ad3ffb90 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 25 Jan 2016 10:35:20 +0100 Subject: Fix a race bug affecting dets_SUITE:open_file/2 The Dets server pretends the file is open before internal_open() has been called, which means that unless the internal_open message is applied first, other processes can find the pid by calling dets_server:get_pid() and do things before Head has been initialized properly. --- lib/stdlib/src/dets.erl | 10 +++++++- lib/stdlib/test/dets_SUITE.erl | 53 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 60 insertions(+), 3 deletions(-) diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 7036316242..6887bda67c 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1291,7 +1291,15 @@ init(Parent, Server) -> open_file_loop(#head{parent = Parent, server = Server}). open_file_loop(Head) -> - open_file_loop(Head, 0). + %% The Dets server pretends the file is open before + %% internal_open() has been called, which means that unless the + %% internal_open message is applied first, other processes can + %% find the pid by calling dets_server:get_pid() and do things + %% before Head has been initialized properly. + receive + ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> + do_apply_op(Op, From, Head, 0) + end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> open_file_loop2(Head, N); diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index e061e16e4c..b101054229 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -53,7 +53,8 @@ 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_11709/1, otp_13229/1]). + otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1, + otp_13260/1]). -export([dets_dirty_loop/0]). @@ -111,7 +112,7 @@ all() -> 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_11709, - otp_13229 + otp_13229, otp_13260 ]. groups() -> @@ -4001,6 +4002,54 @@ otp_13229(_Config) -> ok end. +otp_13260(doc) -> + ["OTP-13260. Race when opening a table."]; +otp_13260(Config) -> + [ok] = lists:usort([otp_13260_1(Config) || _ <- lists:seq(1, 3)]), + ok. + +otp_13260_1(Config) -> + Tab = otp_13260, + File = filename(Tab, Config), + N = 20, + P = self(), + Pids = [spawn_link(fun() -> counter(P, Tab, File) end) || + _ <- lists:seq(1, N)], + Rs = rec(Pids), + true = lists:all(fun(R) -> is_integer(R) end, Rs), + wait_for_close(Tab). + +rec([]) -> + []; +rec([Pid | Pids]) -> + receive {Pid, R} -> + [R | rec(Pids)] + end. + +%% One may have to run the test several times to trigger the bug. +counter(P, Tab, File) -> + Key = key, + N = case catch dets:update_counter(Tab, Key, 1) of + {'EXIT', _} -> + {ok, Tab} = dets:open_file(Tab, [{file, File}]), + ok = dets:insert(Tab, {Key, 1}), + dets:update_counter(Tab, Key, 1); + N1 when is_integer(N1) -> + N1; + DetsBug -> + DetsBug + end, + P ! {self(), N}. + +wait_for_close(Tab) -> + case dets:info(Tab, owner) of + undefined -> + ok; + _ -> + timer:sleep(100), + wait_for_close(Tab) + end. + %% %% Parts common to several test cases %% -- cgit v1.2.3 From ccb54d17f2154ec7043ae4d725f5f6c38c158270 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Thu, 10 Sep 2015 10:47:26 +0100 Subject: Delete a couple of leftover chars in Dialyzer doc --- lib/dialyzer/doc/src/dialyzer.xml | 2 +- system/doc/reference_manual/typespec.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 3fd34241b2..619db125b1 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -254,7 +254,7 @@ analysis that finds data races performs intra-procedural data flow analysis and can sometimes explode in time. Enable it at your own risk. -i *** + *** Warn about underspecified functions (the -spec is strictly more allowing than the success typing). *** diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index a238e3135a..8915302088 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -69,7 +69,7 @@

For integers and atoms, it is allowed for singleton types; for example, the integers - -1 and 42, or the atoms 'foo' and 'bar'). + -1 and 42, or the atoms 'foo' and 'bar'. All other types are built using unions of either predefined types or singleton types. In a type union between a type and one -- cgit v1.2.3 From 48fc6ff5f6fcf4e1cace205e9ce120a3232a68bb Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Thu, 17 Sep 2015 23:44:40 +0100 Subject: Clarify that dialyzer_callgraph:callgraph() type is opaque --- lib/dialyzer/src/dialyzer_callgraph.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index ede29b42bc..211242e506 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -122,7 +122,7 @@ %% Exported Types --type callgraph() :: #callgraph{}. +-opaque callgraph() :: #callgraph{}. -type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. -- cgit v1.2.3 From bf799ffa828a82c6abd85f1569195890bd887ad1 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Mon, 21 Sep 2015 16:07:52 +0100 Subject: Refactor usage of opaques() type --- lib/dialyzer/src/dialyzer_contracts.erl | 5 ++--- lib/hipe/cerl/erl_bif_types.erl | 2 +- lib/hipe/cerl/erl_types.erl | 7 +++---- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 83b3ef72f2..e03e4d5bb4 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -167,8 +167,7 @@ process_contract_remote_types(CodeServer) -> dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, CodeServer). --type opaques() :: [erl_types:erl_type()] | 'universe'. --type opaques_fun() :: fun((module()) -> opaques()). +-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). -type fun_types() :: dict:dict(label(), erl_types:type_table()). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 622c235638..e36643e090 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -137,7 +137,7 @@ type(M, F, A) -> type(M, F, A, Xs) -> type(M, F, A, Xs, 'universe'). --type opaques() :: 'universe' | [erl_types:erl_type()]. +-type opaques() :: erl_types:opaques(). -type arg_types() :: [erl_types:erl_type()]. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 69654088d5..14b4ba215e 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -225,7 +225,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). %%-define(DEBUG, true). @@ -2425,8 +2425,7 @@ t_inf(T1, T2) -> t_inf(T1, T2, 'universe'). %% 'match' should be used from t_find_unknown_opaque() only --type t_inf_opaques() :: 'universe' - | [erl_type()] | {'match', [erl_type() | 'universe']}. +-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. -spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). @@ -3604,7 +3603,7 @@ t_is_instance(ConcreteType, Type) -> t_unopaque(T) -> t_unopaque(T, 'universe'). --spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type(). +-spec t_unopaque(erl_type(), opaques()) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of -- cgit v1.2.3 From d4d083d9e9c6d48519404eda51761fce01f8f0e3 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Tue, 22 Sep 2015 01:38:39 +0100 Subject: Refactor dialyzer_analysis_callgraph --- lib/dialyzer/src/dialyzer_analysis_callgraph.erl | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 826ac51775..b063005b4a 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -93,11 +93,7 @@ loop(#server_state{parent = Parent} = State, send_log(Parent, LogMsg), loop(State, Analysis, ExtCalls); {AnalPid, warnings, Warnings} -> - case Warnings of - [] -> ok; - SendWarnings -> - send_warnings(Parent, SendWarnings) - end, + send_warnings(Parent, Warnings), loop(State, Analysis, ExtCalls); {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), @@ -105,11 +101,11 @@ loop(#server_state{parent = Parent} = State, {AnalPid, done, Plt, DocPlt} -> case ExtCalls =:= none of true -> - send_analysis_done(Parent, Plt, DocPlt); + ok; false -> - send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt) - end; + send_ext_calls(Parent, ExtCalls) + end, + send_analysis_done(Parent, Plt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> -- cgit v1.2.3 From 7dcecb535129bf9fbfddc08f639363aee3278810 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Thu, 17 Sep 2015 22:07:54 +0100 Subject: Split race_data_server out of dialyzer_callgraph ... in order to reduce size of module dialyzer_callgraph, down from ~850 to ~750 lines. --- lib/dialyzer/src/Makefile | 2 + lib/dialyzer/src/dialyzer.app.src | 1 + lib/dialyzer/src/dialyzer_callgraph.erl | 107 +++----------------- lib/dialyzer/src/dialyzer_race_data_server.erl | 134 +++++++++++++++++++++++++ 4 files changed, 153 insertions(+), 91 deletions(-) create mode 100644 lib/dialyzer/src/dialyzer_race_data_server.erl diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index 770af2140f..fd75cd5cd8 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -61,6 +61,7 @@ MODULES = \ dialyzer_gui_wx \ dialyzer_options \ dialyzer_plt \ + dialyzer_race_data_server \ dialyzer_races \ dialyzer_succ_typings \ dialyzer_timing \ @@ -140,6 +141,7 @@ $(EBIN)/dialyzer_explanation.beam: dialyzer.hrl $(EBIN)/dialyzer_gui_wx.beam: dialyzer.hrl dialyzer_gui_wx.hrl $(EBIN)/dialyzer_options.beam: dialyzer.hrl $(EBIN)/dialyzer_plt.beam: dialyzer.hrl +$(EBIN)/dialyzer_race_data_server.beam: dialyzer.hrl $(EBIN)/dialyzer_races.beam: dialyzer.hrl $(EBIN)/dialyzer_succ_typings.beam: dialyzer.hrl $(EBIN)/dialyzer_typesig.beam: dialyzer.hrl diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 7794cb46c6..003d7f2ba4 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -37,6 +37,7 @@ dialyzer_gui_wx, dialyzer_options, dialyzer_plt, + dialyzer_race_data_server, dialyzer_races, dialyzer_succ_typings, dialyzer_typesig, diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 211242e506..50abb22009 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -113,12 +113,7 @@ calls :: ets:tid() | 'undefined', % race race_detection = false :: boolean(), - race_data_server = new_race_data_server() :: pid()}). - --record(race_data_state, {race_code = dict:new() :: dict:dict(), - public_tables = [] :: [label()], - named_tables = [] :: [string()], - beh_api_calls = [] :: [{mfa(), mfa()}]}). + race_data_server = dialyzer_race_data_server:new() :: pid()}). %% Exported Types @@ -616,45 +611,30 @@ digraph_reaching_subgraph(Funs, DG) -> renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG, RaceCode, PublicTables, NamedTables) -> - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_info, {RaceCode, PublicTables, NamedTables}}, RaceDataServer), CG. -renew_race_info({RaceCode, PublicTables, NamedTables}, - #race_data_state{} = State) -> - State#race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables}. - -spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph(). renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) -> Fun = dialyzer_races:get_curr_fun(Races), FunArgs = dialyzer_races:get_curr_fun_args(Races), Code = lists:reverse(dialyzer_races:get_race_list(Races)), - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_code, {Fun, FunArgs, Code}}, RaceDataServer), CG. -renew_race_code_handler({Fun, FunArgs, Code}, - #race_data_state{race_code = RaceCode} = State) -> - State#race_data_state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. - -spec renew_race_public_tables(label(), callgraph()) -> callgraph(). renew_race_public_tables(VarLabel, #callgraph{race_data_server = RaceDataServer} = CG) -> ok = - race_data_server_cast({renew_race_public_tables, VarLabel}, RaceDataServer), + dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer), CG. -renew_race_public_tables_handler(VarLabel, - #race_data_state{public_tables = PT} - = State) -> - State#race_data_state{public_tables = ordsets:add_element(VarLabel, PT)}. - -spec cleanup(callgraph()) -> callgraph(). cleanup(#callgraph{digraph = Digraph, @@ -664,18 +644,18 @@ cleanup(#callgraph{digraph = Digraph, #callgraph{digraph = Digraph, name_map = NameMap, rev_name_map = RevNameMap, - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec duplicate(callgraph()) -> callgraph(). duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) -> Callgraph#callgraph{ - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec dispose_race_server(callgraph()) -> ok. dispose_race_server(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_cast(stop, RaceDataServer). + dialyzer_race_data_server:stop(RaceDataServer). -spec get_digraph(callgraph()) -> digraph:graph(). @@ -685,17 +665,17 @@ get_digraph(#callgraph{digraph = Digraph}) -> -spec get_named_tables(callgraph()) -> [string()]. get_named_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_named_tables, RaceDataServer). + dialyzer_race_data_server:call(get_named_tables, RaceDataServer). -spec get_public_tables(callgraph()) -> [label()]. get_public_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_public_tables, RaceDataServer). + dialyzer_race_data_server:call(get_public_tables, RaceDataServer). -spec get_race_code(callgraph()) -> dict:dict(). get_race_code(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_race_code, RaceDataServer). + dialyzer_race_data_server:call(get_race_code, RaceDataServer). -spec get_race_detection(callgraph()) -> boolean(). @@ -705,12 +685,12 @@ get_race_detection(#callgraph{race_detection = RD}) -> -spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}]. get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_behaviour_api_calls, RaceDataServer). + dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer). -spec race_code_new(callgraph()) -> callgraph(). race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast(race_code_new, RaceDataServer), + ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer), CG. -spec put_digraph(digraph:graph(), callgraph()) -> callgraph(). @@ -721,7 +701,7 @@ put_digraph(Digraph, Callgraph) -> -spec put_race_code(dict:dict(), callgraph()) -> callgraph(). put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_race_code, RaceCode}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer), CG. -spec put_race_detection(boolean(), callgraph()) -> callgraph(). @@ -733,78 +713,23 @@ put_race_detection(RaceDetection, Callgraph) -> put_named_tables(NamedTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_named_tables, NamedTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer), CG. -spec put_public_tables([label()], callgraph()) -> callgraph(). put_public_tables(PublicTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_public_tables, PublicTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer), CG. -spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph(). put_behaviour_api_calls(Calls, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_behaviour_api_calls, Calls}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer), CG. - -new_race_data_server() -> - spawn_link(fun() -> race_data_server_loop(#race_data_state{}) end). - -race_data_server_loop(State) -> - receive - {call, From, Ref, Query} -> - Reply = race_data_server_handle_call(Query, State), - From ! {Ref, Reply}, - race_data_server_loop(State); - {cast, stop} -> - ok; - {cast, Message} -> - NewState = race_data_server_handle_cast(Message, State), - race_data_server_loop(NewState) - end. - -race_data_server_call(Query, Server) -> - Ref = make_ref(), - Server ! {call, self(), Ref, Query}, - receive - {Ref, Reply} -> Reply - end. - -race_data_server_cast(Message, Server) -> - Server ! {cast, Message}, - ok. - -race_data_server_handle_cast(race_code_new, State) -> - State#race_data_state{race_code = dict:new()}; -race_data_server_handle_cast({Tag, Data}, State) -> - case Tag of - renew_race_info -> renew_race_info(Data, State); - renew_race_code -> renew_race_code_handler(Data, State); - renew_race_public_tables -> renew_race_public_tables_handler(Data, State); - put_race_code -> State#race_data_state{race_code = Data}; - put_public_tables -> State#race_data_state{public_tables = Data}; - put_named_tables -> State#race_data_state{named_tables = Data}; - put_behaviour_api_calls -> State#race_data_state{beh_api_calls = Data} - end. - -race_data_server_handle_call(Query, - #race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables, - beh_api_calls = BehApiCalls} - = State) -> - case Query of - dup -> spawn_link(fun() -> race_data_server_loop(State) end); - get_race_code -> RaceCode; - get_public_tables -> PublicTables; - get_named_tables -> NamedTables; - get_behaviour_api_calls -> BehApiCalls - end. - %%============================================================================= %% Utilities for 'dot' %%============================================================================= diff --git a/lib/dialyzer/src/dialyzer_race_data_server.erl b/lib/dialyzer/src/dialyzer_race_data_server.erl new file mode 100644 index 0000000000..3600491809 --- /dev/null +++ b/lib/dialyzer/src/dialyzer_race_data_server.erl @@ -0,0 +1,134 @@ +%% -*- erlang-indent-level: 2 -*- +%%----------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : dialyzer_race_data_server.erl +%%% Author : Tobias Lindahl +%%% Description : +%%% +%%% Created : 18 Sep 2015 by Luca Favatella +%%%------------------------------------------------------------------- +-module(dialyzer_race_data_server). + +-export([new/0, + duplicate/1, + stop/1, + call/2, + cast/2]). + +-include("dialyzer.hrl"). + +%%---------------------------------------------------------------------- + +-record(state, {race_code = dict:new() :: dict:dict(), + public_tables = [] :: [label()], + named_tables = [] :: [string()], + beh_api_calls = [] :: [{mfa(), mfa()}]}). + +%%---------------------------------------------------------------------- + +-spec new() -> pid(). + +new() -> + spawn_link(fun() -> loop(#state{}) end). + +-spec duplicate(pid()) -> pid(). + +duplicate(Server) -> + call(dup, Server). + +-spec stop(pid()) -> ok. + +stop(Server) -> + cast(stop, Server). + +-spec call(atom(), pid()) -> term(). + +call(Query, Server) -> + Ref = make_ref(), + Server ! {call, self(), Ref, Query}, + receive + {Ref, Reply} -> Reply + end. + +-spec cast(atom() | {atom(), term()}, pid()) -> ok. + +cast(Message, Server) -> + Server ! {cast, Message}, + ok. + +%%---------------------------------------------------------------------- + +loop(State) -> + receive + {call, From, Ref, Query} -> + Reply = handle_call(Query, State), + From ! {Ref, Reply}, + loop(State); + {cast, stop} -> + ok; + {cast, Message} -> + NewState = handle_cast(Message, State), + loop(NewState) + end. + +handle_cast(race_code_new, State) -> + State#state{race_code = dict:new()}; +handle_cast({Tag, Data}, State) -> + case Tag of + renew_race_info -> renew_race_info_handler(Data, State); + renew_race_code -> renew_race_code_handler(Data, State); + renew_race_public_tables -> renew_race_public_tables_handler(Data, State); + put_race_code -> State#state{race_code = Data}; + put_public_tables -> State#state{public_tables = Data}; + put_named_tables -> State#state{named_tables = Data}; + put_behaviour_api_calls -> State#state{beh_api_calls = Data} + end. + +handle_call(Query, + #state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables, + beh_api_calls = BehApiCalls} + = State) -> + case Query of + dup -> spawn_link(fun() -> loop(State) end); + get_race_code -> RaceCode; + get_public_tables -> PublicTables; + get_named_tables -> NamedTables; + get_behaviour_api_calls -> BehApiCalls + end. + +%%---------------------------------------------------------------------- + +renew_race_info_handler({RaceCode, PublicTables, NamedTables}, + #state{} = State) -> + State#state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables}. + +renew_race_code_handler({Fun, FunArgs, Code}, + #state{race_code = RaceCode} = State) -> + State#state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. + +renew_race_public_tables_handler(VarLabel, + #state{public_tables = PT} = State) -> + State#state{public_tables = ordsets:add_element(VarLabel, PT)}. -- cgit v1.2.3 From f79348f3838c67b1d22b3824e9c6a5b4f91e8395 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Sat, 26 Sep 2015 13:34:16 +0100 Subject: Clarify computation of exported types in Dialyzer Superfluous usage of insert_temp_exported_types had been in since 6452b57. (Change in commit 8a3ea1f module dialyzer_analysis_callgraph is a correct simplification and is not relevant.) --- lib/dialyzer/src/dialyzer_analysis_callgraph.erl | 5 ++--- lib/dialyzer/src/dialyzer_utils.erl | 13 ++++++------- lib/typer/src/typer.erl | 12 +++++++----- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index b063005b4a..ab3e622356 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -161,8 +161,7 @@ analysis_start(Parent, Analysis, LegalWarnings) -> MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), ?timing(State#analysis_state.timing_server, "remote", begin TmpCServer3 = diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 557e10eed7..5fc1c0e691 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -297,8 +297,8 @@ get_record_fields([], _RecDict, Acc) -> %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), - TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), - TempRecords1 = process_opaque_types0(TempRecords, TempExpTypes), + ExpTypes = dialyzer_codeserver:get_exported_types(CServer), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), ModuleFun = fun(Module, Record) -> RecordFun = @@ -310,7 +310,7 @@ process_record_remote_types(CServer) -> Site = {record, {Module, Name, Arity}}, [{FieldName, Field, erl_types:t_from_form(Field, - TempExpTypes, + ExpTypes, Site, TempRecords1)} || {FieldName, Field, _} <- Fields] @@ -323,9 +323,8 @@ process_record_remote_types(CServer) -> dict:map(RecordFun, Record) end, NewRecords = dict:map(ModuleFun, TempRecords1), - ok = check_record_fields(NewRecords, TempExpTypes), - CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), - dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1). + ok = check_record_fields(NewRecords, ExpTypes), + dialyzer_codeserver:finalize_records(NewRecords, CServer). %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 562530c868..5c82750a21 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -137,11 +137,14 @@ extract(#analysis{macros = Macros, NewCodeServer = try NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1), + NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1), + case sets:size(NewExpTypes) of 0 -> ok end, OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT? MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), - CodeServer3 = dialyzer_utils:process_record_remote_types(CodeServer2), - dialyzer_contracts:process_contract_remote_types(CodeServer3) + CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), + CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -845,8 +848,7 @@ collect_info(Analysis) -> %% io:format("Merged Records ~p",[MergedRecords]), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), dialyzer_contracts:process_contract_remote_types(TmpCServer3) catch -- cgit v1.2.3 From fa89f452f528321114593e0c79efba87fc4478d7 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 26 Jan 2016 10:24:04 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 49964 -> 49956 bytes erts/preloaded/ebin/erlang.beam | Bin 101268 -> 101288 bytes erts/preloaded/ebin/erts_code_purger.beam | Bin 8768 -> 8744 bytes erts/preloaded/ebin/erts_internal.beam | Bin 8536 -> 8512 bytes erts/preloaded/ebin/init.beam | Bin 44728 -> 44700 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1452 -> 1448 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1324 -> 1320 bytes erts/preloaded/ebin/prim_file.beam | Bin 44892 -> 44884 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72612 -> 72608 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23284 -> 23280 bytes erts/preloaded/ebin/zlib.beam | Bin 14160 -> 14156 bytes 11 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index f6057b45d4..f007880683 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index b6e38e4b5b..b99b28f3a1 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 227d96d4c8..37e6b181d6 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index d3d990519d..2380930767 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index b6d1df7bbc..67159713f5 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index 328520844d..fd80258d0e 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index 8d6c1927fd..0e51a1bfc7 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index 1221c513db..663f5d46e6 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index fa617f1f51..d8a8061bae 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 83e1e49974..1d69c2e583 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 8f654e3abf..2ffd839f8a 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From f4f0d3641264b75f2d4c465ed93e2d06e0961e4c Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 3 Jul 2015 16:13:52 +0200 Subject: erl_docgen: Fix spec anno's for maps OTP-12955 --- lib/erl_docgen/src/docgen_otp_specs.erl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 37baa7c2f9..e154323f07 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -729,5 +729,9 @@ annos_type([E=#xmlElement{name = typevar}]) -> annos_elem(E); annos_type([#xmlElement{name = paren, content = Es}]) -> annos(get_elem(type, Es)); +annos_type([#xmlElement{name = map, content = Es}]) -> + lists:flatmap(fun(E) -> annos_type([E]) end, Es); +annos_type([#xmlElement{name = map_field, content = Es}]) -> + lists:flatmap(fun annos_elem/1, get_elem(type,Es)); annos_type(_) -> []. -- cgit v1.2.3 From 32b045c47a1cbba3e89a29d669af826d3ed639c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Tue, 26 Jan 2016 10:58:26 +0100 Subject: Update release notes --- lib/diameter/doc/src/notes.xml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 838b1ad7dc..2fc30db324 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,27 @@ first.

+
diameter 1.9.2.3 + +
Fixed Bugs and Malfunctions + + +

+ Make peer handling more efficient.

+

+ Inefficient lookup and manipulation of peer lists could + result in poor performance when many outgoing requests + were sent simultaneously, or when many peers connected + simultaneously. Filtering peer lists on realm/host is now + also more efficient in many cases.

+

+ Own Id: OTP-13164

+ + +
+ +
+
diameter 1.9.2.2
Fixed Bugs and Malfunctions -- cgit v1.2.3 From 05cef5e3a267b3515acb834130675e0cbf69bf78 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Tue, 26 Jan 2016 10:58:27 +0100 Subject: Updated OTP version --- OTP_VERSION | 2 +- otp_versions.table | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index cb5558ccf6..946c38138e 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.5.6.7 +17.5.6.8 diff --git a/otp_versions.table b/otp_versions.table index fc605e425d..726ca6bff7 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-17.5.6.8 : diameter-1.9.2.3 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1.5 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.7 : diameter-1.9.2.2 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1.5 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.6 : erts-6.4.1.5 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 kernel-3.2.0.1 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 ssl-6.0.1.1 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.6.5 : erts-6.4.1.4 kernel-3.2.0.1 ssl-6.0.1.1 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 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.5 debugger-4.0.3.1 dialyzer-2.7.4 diameter-1.9.2.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.9 jinterface-1.5.12 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16.1 sasl-2.4.1 snmp-5.1.2 ssh-3.2.4 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : -- cgit v1.2.3 From 6945881b99aeadaf9ed4ec1f8c7811538cee1405 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 13 Oct 2015 14:03:38 +0200 Subject: [edoc] Correct documentation Fix mistakes found by 'xmllint'. --- lib/edoc/doc/overview.edoc | 7 +++---- lib/edoc/src/edoc.erl | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index 3639bb43a5..d2bba9d744 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -755,7 +755,7 @@ following escape sequences may be used:
=== Function specifications === -Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying functions we recommend that Erlang specifications as described in Types and Function Specification should be added to the source @@ -764,7 +764,6 @@ marker="dialyzer:dialyzer">Dialyzer's can be utilized in the process of keeping the documentation consistent and up-to-date. Erlang specifications will be used unless there is also a function specification (a `@spec' tag followed by a type) with the same name. - The following grammar describes the form of the specifications following a `@spec' tag. A '`?'' suffix implies that the element is optional. @@ -973,12 +972,12 @@ contain any annotations at all. === Type definitions === -Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying types we recommend that Erlang types as described in Types and Function Specification should be added to the source code instead. Erlang types will be used unless there is a type alias with the same -name. +name. The following grammar (see above for auxiliary definitions) describes the form of the definitions that may follow a `@type' tag: diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 90f1fc3071..d2494b69fe 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -555,7 +555,6 @@ read_source(Name) -> %%
Specifies a list of pre-defined Erlang preprocessor (`epp') %% macro definitions, used if the `preprocess' option is turned on. %% The default value is the empty list.
-%%
%%
{@type {report_missing_types, boolean()@}} %%
%%
If the value is `true', warnings are issued for missing types. @@ -563,6 +562,7 @@ read_source(Name) -> %% `no_report_missing_types' is an alias for %% `{report_missing_types, false}'. %%
+%% %% %% @see get_doc/2 %% @see //syntax_tools/erl_syntax -- cgit v1.2.3 From bdf30e175b7290cb86c101ca7db103e19d05cbd8 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Wed, 20 Jan 2016 19:23:42 +0100 Subject: ssl: Only start a new session validator if the old one has finished its work If the session table is big the validator may not have finshed before the validation interval is up, in this case we should not start a new validator adding to the cpu load. --- lib/ssl/src/ssl_manager.erl | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 00e95f5c5b..311dac4619 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -263,7 +263,9 @@ init([Name, Opts]) -> session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = - max_session_cache_size(session_cache_server_max) + max_session_cache_size(session_cache_server_max), + session_client_invalidator = undefined, + session_server_invalidator = undefined }}. %%-------------------------------------------------------------------- @@ -378,13 +380,17 @@ handle_cast({invalidate_pem, File}, handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache_client = ClientCache, session_cache_server = ServerCache, - session_lifetime = LifeTime + session_lifetime = LifeTime, + session_client_invalidator = Client, + session_server_invalidator = Server } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(ClientCache, CacheCb, LifeTime), - start_session_validator(ServerCache, CacheCb, LifeTime), - {noreply, State#state{session_validation_timer = Timer}}; + CPid = start_session_validator(ClientCache, CacheCb, LifeTime, Client), + SPid = start_session_validator(ServerCache, CacheCb, LifeTime, Server), + {noreply, State#state{session_validation_timer = Timer, + session_client_invalidator = CPid, + session_server_invalidator = SPid}}; handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb @@ -471,9 +477,11 @@ validate_session(Port, Session, LifeTime) -> invalidate_session(Port, Session) end. -start_session_validator(Cache, CacheCb, LifeTime) -> +start_session_validator(Cache, CacheCb, LifeTime, undefined) -> spawn_link(?MODULE, init_session_validator, - [[get(ssl_manager), Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]); +start_session_validator(_,_,_, Pid) -> + Pid. init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> put(ssl_manager, SslManagerName), @@ -708,6 +716,6 @@ crl_db_info(_, UserCRLDb) -> %% Only start a session invalidator if there is not %% one already active invalidate_session_cache(undefined, CacheCb, Cache) -> - start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}); + start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}, undefined); invalidate_session_cache(Pid, _CacheCb, _Cache) -> Pid. -- cgit v1.2.3 From b33819468f741b608afd03076bf1c14dafaa3887 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Thu, 24 Sep 2015 23:09:08 +0100 Subject: Delete dead sequential code in dialyzer_worker --- lib/dialyzer/src/dialyzer_worker.erl | 24 ++---------------------- 1 file changed, 2 insertions(+), 22 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 979e3a621d..39d88375b8 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,7 @@ -module(dialyzer_worker). --export([launch/4, sequential/4]). +-export([launch/4]). -export_type([worker/0]). @@ -30,7 +30,6 @@ -type mode() :: dialyzer_coordinator:mode(). -type coordinator() :: dialyzer_coordinator:coordinator(). -type init_data() :: dialyzer_coordinator:init_data(). --type result() :: dialyzer_coordinator:result(). -type job() :: dialyzer_coordinator:job(). -record(state, { @@ -170,22 +169,3 @@ continue_compilation(Label, Data) -> collect_warnings(#state{job = Job, init_data = InitData}) -> dialyzer_succ_typings:collect_warnings(Job, InitData). - -%%------------------------------------------------------------------------------ - --type extra() :: label() | 'unused'. - --spec sequential(mode(), job(), init_data(), extra()) -> result(). - -sequential('compile', Job, InitData, Extra) -> - case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of - {ok, EstimatedSize, Data} -> - {EstimatedSize, continue_compilation(Extra, Data)}; - {error, _Reason} = Error -> {0, Error} - end; -sequential('typesig', Job, InitData, _Extra) -> - dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData); -sequential('dataflow', Job, InitData, _Extra) -> - dialyzer_succ_typings:refine_one_module(Job, InitData); -sequential('warnings', Job, InitData, _Extra) -> - dialyzer_succ_typings:collect_warnings(Job, InitData). -- cgit v1.2.3 From 7a2fc5f7ace6f0c3fc03e1f74f6cedf95c7968fd Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Thu, 24 Sep 2015 23:31:10 +0100 Subject: Reflect more init-loop OTP pattern in dialyzer_worker Also clarify in which modes the states `updating` and `waiting` can happen in the loop. --- lib/dialyzer/src/dialyzer_worker.erl | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 39d88375b8..bae12b21c3 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -59,16 +59,21 @@ launch(Mode, Job, InitData, Coordinator) -> job = Job, init_data = InitData, coordinator = Coordinator}, - InitState = - case Mode of - X when X =:= 'typesig'; X =:= 'dataflow' -> initializing; - X when X =:= 'compile'; X =:= 'warnings' -> running - end, - spawn_link(fun() -> loop(InitState, State) end). + spawn_link(fun() -> init(State) end). %%-------------------------------------------------------------------- -loop(updating, State) -> +init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> + DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), + ?debug("Deps ~p: ~p\n",[SCC, DependsOn]), + loop(updating, State#state{depends_on = DependsOn}); +init(#state{mode = Mode} = State) when + Mode =:= 'compile'; Mode =:= 'warnings' -> + loop(running, State). + +loop(updating, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Update: ~p\n",[State#state.job]), NextStatus = case waits_more_success_typings(State) of @@ -76,11 +81,8 @@ loop(updating, State) -> false -> running end, loop(NextStatus, State); -loop(initializing, #state{job = SCC, init_data = InitData} = State) -> - DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), - ?debug("Deps ~p: ~p\n",[State#state.job, DependsOn]), - loop(updating, State#state{depends_on = DependsOn}); -loop(waiting, State) -> +loop(waiting, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Wait: ~p\n",[State#state.job]), NewState = wait_for_success_typings(State), loop(updating, NewState); -- cgit v1.2.3 From 30361077904295cbc7471c44d4b15ae86bfb2f05 Mon Sep 17 00:00:00 2001 From: Luca Favatella Date: Fri, 25 Sep 2015 00:02:51 +0100 Subject: Clarify usage of coordinator by analysis_callgraph * Comment in dialyzer_analysis_callgraph what the call to dialyzer_coordinator does; * Delegate activation request to each dialyzer_worker; * There is no reason for the dialyzer_coordinator to request activation on behalf of the workers: let each worker request its own activation as it leads to more consistent dialyzer_worker module (activation is request as soon as status running is hit - reguardless of mode) and it reduces lines of code. * Clarify types in coordinator and worker e.g. make opaque and make type more strict. --- lib/dialyzer/src/dialyzer_analysis_callgraph.erl | 40 +++++++++++++++--------- lib/dialyzer/src/dialyzer_coordinator.erl | 19 +++++------ lib/dialyzer/src/dialyzer_worker.erl | 6 ++-- 3 files changed, 36 insertions(+), 29 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index ab3e622356..59d2c2b3be 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -31,14 +31,17 @@ -export([start/3]). +%%% Export for dialyzer_coordinator... -export([compile_init_result/0, - add_to_result/4, - start_compilation/2, + add_to_result/4]). +%%% ... and export for dialyzer_worker. +-export([start_compilation/2, continue_compilation/2]). -export_type([compile_init_data/0, - one_file_result/0, - compile_result/0]). + one_file_mid_error/0, + one_file_result_ok/0, + compile_result/0]). -include("dialyzer.hrl"). @@ -254,6 +257,10 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T1, _} = statistics(wall_clock), Callgraph = dialyzer_callgraph:new(), CompileInit = make_compile_init(State, Callgraph), + %% Spawn a worker per file - where each worker calls + %% start_compilation on its file, asks next label to coordinator and + %% calls continue_compilation - and let coordinator aggregate + %% results using (compile_init_result and) add_to_result. {{Failed, Modules}, NextLabel} = ?timing(Timing, "compile", _C1, dialyzer_coordinator:parallel_job(compile, Files, @@ -285,16 +292,18 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, send_log(Parent, Msg2), {Callgraph, CServer2}. --type compile_init_data() :: #compile_init{}. --type error_reason() :: string(). --type compile_result() :: {[{file:filename(), error_reason()}], - [module()]}. %%opaque --type one_file_result() :: {error, error_reason()} | - {ok, [dialyzer_callgraph:callgraph_edge()], - [mfa_or_funlbl()], module()}. %%opaque --type compile_mid_data() :: {module(), cerl:cerl(), - dialyzer_callgraph:callgraph(), - dialyzer_codeserver:codeserver()}. +-opaque compile_init_data() :: #compile_init{}. +-type error_reason() :: string(). +-opaque compile_result() :: {[{file:filename(), error_reason()}], + [module()]}. +-type one_file_mid_error() :: {error, error_reason()}. +-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()], + [mfa_or_funlbl()], module()}. +-type one_file_result() :: one_file_mid_error() | + one_file_result_ok(). +-type compile_mid_data() :: {module(), cerl:cerl(), + dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver()}. -spec compile_init_result() -> compile_result(). @@ -435,7 +444,8 @@ store_core(Mod, Core, Callgraph, CServer) -> CoreSize = cerl_trees:size(CoreTree), {ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}. --spec continue_compilation(integer(), compile_mid_data()) -> one_file_result(). +-spec continue_compilation(integer(), compile_mid_data()) -> + one_file_result_ok(). continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) -> {LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel), diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 3290161ca1..87cbd25b30 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,8 +29,8 @@ %%% Export for dialyzer main process -export([parallel_job/4]). -%%% Exports for all possible workers --export([wait_activation/0, job_done/3]). +%%% Export for all possible workers +-export([job_done/3]). %%% Exports for the typesig and dataflow analysis workers -export([sccs_to_pids/2, request_activation/1]). @@ -46,7 +46,7 @@ -type regulator() :: pid(). -type scc_to_pid() :: ets:tid() | 'unused'. --type coordinator() :: {collector(), regulator(), scc_to_pid()}. %%opaque +-opaque coordinator() :: {collector(), regulator(), scc_to_pid()}. -type timing() :: dialyzer_timing:timing_server(). -type scc() :: [mfa_or_funlbl()]. @@ -75,8 +75,9 @@ -type result() :: compile_result() | typesig_result() | dataflow_result() | warnings_result(). --type job_result() :: dialyzer_analysis_callgraph:one_file_result() | - typesig_result() | dataflow_result() | warnings_result(). +-type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() | + dialyzer_analysis_callgraph:one_file_result_ok() | + typesig_result() | dataflow_result() | warnings_result(). -record(state, {mode :: mode(), active = 0 :: integer(), @@ -119,7 +120,7 @@ spawn_jobs(Mode, Jobs, InitData, Timing) -> Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator), case TypesigOrDataflow of true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok; - false -> request_activation(Regulator, Pid) + false -> ok end, Count + 1 end, @@ -218,10 +219,6 @@ request_activation({_Collector, Regulator, _SCCtoPID}) -> Regulator ! {req, self()}, wait_activation(). -request_activation(Regulator, Pid) -> - Regulator ! {req, Pid}, - ok. - spawn_regulator() -> InitTickets = dialyzer_utils:parallelism(), spawn_link(fun() -> regulator_loop(InitTickets, queue:new()) end). diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index bae12b21c3..b9ab27c11d 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -25,7 +25,7 @@ -export_type([worker/0]). --type worker() :: pid(). %%opaque +-opaque worker() :: pid(). -type mode() :: dialyzer_coordinator:mode(). -type coordinator() :: dialyzer_coordinator:coordinator(). @@ -87,7 +87,7 @@ loop(waiting, #state{mode = Mode} = State) when NewState = wait_for_success_typings(State), loop(updating, NewState); loop(running, #state{mode = 'compile'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Compile: ~s\n",[State#state.job]), Result = case start_compilation(State) of @@ -99,7 +99,7 @@ loop(running, #state{mode = 'compile'} = State) -> end, report_to_coordinator(Result, State); loop(running, #state{mode = 'warnings'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Warning: ~s\n",[State#state.job]), Result = collect_warnings(State), report_to_coordinator(Result, State); -- cgit v1.2.3 From 76d78818252f0223ee3cffe232a6333428d401a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?D=C3=A1niel=20Szoboszlay?= Date: Wed, 14 Oct 2015 15:45:32 +0200 Subject: Check the result of EC_GROUP_new_curve_* calls The FIPS-enabled OpenSSL on RHEL disallows the use of < 256 bit prime fields (like secp128r1 or secp160k1), and the EC_GROUP_new_cuve_GFp call would return a NULL pointer for such fields. Not checking for this failure could result in a segfault in the NIF code. --- lib/crypto/c_src/crypto.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 3c73c318ed..4966701e41 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -3569,6 +3569,9 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) } else goto out_err; + if (!group) + goto out_err; + if (enif_inspect_binary(env, prime[2], &seed)) { EC_GROUP_set_seed(group, seed.data, seed.size); } -- cgit v1.2.3 From b721bebe663ca3abc747591b28726a367bdb9758 Mon Sep 17 00:00:00 2001 From: JP Date: Mon, 21 Sep 2015 22:52:46 +0000 Subject: erts: Fix sendfile:ing of large files on FreeBSD If the file was larger than the OS send buffer the call would fail before this patch. --- erts/emulator/drivers/unix/unix_efile.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 06ba986044..61148dd58d 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -39,6 +39,11 @@ #ifdef HAVE_SYS_UIO_H #include #include +#if defined(HAVE_SENDFILE) && (defined(__FreeBSD__) || defined(__DragonFly__)) +/* Need to define __BSD_VISIBLE in order to expose prototype of sendfile */ +#define __BSD_VISIBLE 1 +#include +#endif #endif #if defined(HAVE_SENDFILE) && (defined(__linux__) || (defined(__sun) && defined(__SVR4))) #include -- cgit v1.2.3 From db61a493f72cc13f3e9b709b8e86da7e3d246f2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Jan 2016 12:02:18 +0100 Subject: Remove first argument of code_server:call() Remove the first argument for code_server:call(). It makes no sense. The only caller is 'code'. Note that the code_server module is undocumented and that code_server:call() is an internal helper function. --- lib/kernel/src/code.erl | 2 +- lib/kernel/src/code_server.erl | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index ae28c97b47..b2940dc479 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -305,7 +305,7 @@ get_mode() -> call(get_mode). %%----------------------------------------------------------------- call(Req) -> - code_server:call(code_server, Req). + code_server:call(Req). -spec start_link() -> {'ok', pid()} | {'error', 'crash'}. start_link() -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 3fbbb98b94..6f2ed737f7 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -22,7 +22,7 @@ %% This file holds the server part of the code_server. -export([start_link/1, - call/2, + call/1, system_continue/3, system_terminate/4, system_code_change/4, @@ -133,8 +133,8 @@ split_paths([C|T], S, Path, Paths) -> split_paths([], _S, Path, Paths) -> lists:reverse(Paths, [lists:reverse(Path)]). -call(Name, Req) -> - Name ! {code_call, self(), Req}, +call(Req) -> + ?MODULE ! {code_call, self(), Req}, receive {?MODULE, Reply} -> Reply -- cgit v1.2.3 From cd6903be0740db0c0061533cfb46729b43016316 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 27 Jan 2016 15:13:00 +0100 Subject: erts: When erts_alloc fails, the emulator no longer aborts --- erts/emulator/beam/erl_alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index c3f4fe5a63..2a97069ac2 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1923,7 +1923,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) va_start(argp, n); size = va_arg(argp, Uint); va_end(argp); - erl_exit(1, + erl_exit(-1, "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", allctr_str, op, size, t_str); break; -- cgit v1.2.3 From b42d79a563993bacafcd3e4be24f324406e65c26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Jan 2016 14:52:15 +0100 Subject: Simplify starting of code server There is unnecessary knowledge about the -nostick option in the 'kernel' module. -nostick can be handled entirely in the 'code' module. There is no need to have both code:start_link/0 and code:start_link/1. code:start_link/0 is sufficient. Also get rid of error handling for things that cannot happen: The 'init' module has made sure that init:get_argument(root) can't fail, so there is no need for any error-reporting code. (See e1dc0aa4.) We also don't need to test the return value from code_server:start_link/1, because it will always return {ok,Pid} (or crash). --- lib/kernel/src/code.erl | 74 +++++++++++++++++------------------------- lib/kernel/src/code_server.erl | 8 +---- lib/kernel/src/kernel.erl | 8 +---- 3 files changed, 31 insertions(+), 59 deletions(-) diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index b2940dc479..6529a78034 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -60,7 +60,7 @@ del_path/1, replace_path/2, rehash/0, - start_link/0, start_link/1, + start_link/0, which/1, where_is_file/1, where_is_file/2, @@ -309,11 +309,7 @@ call(Req) -> -spec start_link() -> {'ok', pid()} | {'error', 'crash'}. start_link() -> - start_link([stick]). - --spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}. -start_link(Flags) -> - do_start(Flags). + do_start(). %%----------------------------------------------------------------- %% In the init phase, code must not use any modules not yet loaded, @@ -325,36 +321,21 @@ start_link(Flags) -> %% us, so the module is loaded. %%----------------------------------------------------------------- -do_start(Flags) -> +do_start() -> maybe_warn_for_cache(), load_code_server_prerequisites(), - Mode = get_mode(Flags), - case init:get_argument(root) of - {ok,[[Root0]]} -> - Root = filename:join([Root0]), % Normalize. Use filename - case code_server:start_link([Root,Mode]) of - {ok,_Pid} = Ok2 -> - if - Mode =:= interactive -> - case lists:member(stick, Flags) of - true -> do_stick_dirs(); - _ -> ok - end; - true -> - ok - end, - %% Quietly load native code for all modules loaded so far - Architecture = erlang:system_info(hipe_architecture), - load_native_code_for_all_loaded(Architecture), - Ok2; - Other -> - Other - end; - Other -> - error_logger:error_msg("Can not start code server ~w ~n", [Other]), - {error, crash} - end. + {ok,[[Root0]]} = init:get_argument(root), + Mode = start_get_mode(), + Root = filename:join([Root0]), % Normalize. + Res = code_server:start_link([Root,Mode]), + + maybe_stick_dirs(Mode), + + %% Quietly load native code for all modules loaded so far. + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), + Res. %% Make sure that all modules that the code_server process calls %% (directly or indirectly) are loaded. Otherwise the code_server @@ -374,6 +355,16 @@ load_code_server_prerequisites() -> _ = [M = M:module_info(module) || M <- Needed], ok. +maybe_stick_dirs(interactive) -> + case init:get_argument(nostick) of + {ok,[[]]} -> + ok; + _ -> + do_stick_dirs() + end; +maybe_stick_dirs(_) -> + ok. + do_stick_dirs() -> do_s(compiler), do_s(stdlib), @@ -391,19 +382,12 @@ do_s(Lib) -> ok end. -get_mode(Flags) -> - case lists:member(embedded, Flags) of - true -> +start_get_mode() -> + case init:get_argument(mode) of + {ok,[["embedded"]]} -> embedded; - _Otherwise -> - case init:get_argument(mode) of - {ok,[["embedded"]]} -> - embedded; - {ok,[["minimal"]]} -> - minimal; - _Else -> - interactive - end + _ -> + interactive end. %% Find out which version of a particular module we would diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 6f2ed737f7..83b14a6ee4 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -58,7 +58,7 @@ start_link(Args) -> %% Init the code_server process. %% ----------------------------------------------------------- -init(Ref, Parent, [Root,Mode0]) -> +init(Ref, Parent, [Root,Mode]) -> register(?MODULE, self()), process_flag(trap_exit, true), @@ -69,12 +69,6 @@ init(Ref, Parent, [Root,Mode0]) -> end, erlang:pre_loaded()), ets:insert(Db, init:fetch_loaded()), - Mode = - case Mode0 of - minimal -> interactive; - _ -> Mode0 - end, - IPath = case Mode of interactive -> diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 5f33f25a0d..40544da6c3 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -98,7 +98,7 @@ init([]) -> {kernel_config, start_link, []}, permanent, 2000, worker, [kernel_config]}, Code = {code_server, - {code, start_link, get_code_args()}, + {code, start_link, []}, permanent, 2000, worker, [code]}, File = {file_server_2, {file_server, start_link, []}, @@ -158,12 +158,6 @@ init(safe) -> {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. - start_dist_ac() -> Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], case application:get_env(kernel, start_dist_ac) of -- cgit v1.2.3 From 480239fc11d72cf3434e61b541ffec9cb98c2db3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Jan 2016 12:39:05 +0100 Subject: code_server: Don't export internal system_* functions There is no reason to export system_continue/3 and system_terminate/4 from code_server. Servers that use proc_lib and 'sys' to handle system message do need those functions exported, but code_server contains a modified copy of the system message handling code from 'sys', and that code only make local calls to system_continue/3 and system_terminate/4. --- lib/kernel/src/code_server.erl | 2 -- lib/kernel/test/code_SUITE.erl | 13 +------------ 2 files changed, 1 insertion(+), 14 deletions(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 83b14a6ee4..77d531b2bd 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -23,8 +23,6 @@ -export([start_link/1, call/1, - system_continue/3, - system_terminate/4, system_code_change/4, error_msg/2, info_msg/2 ]). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 772a1e6b14..10c1278062 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -850,18 +850,7 @@ check_funs({'$M_EXPR','$F_EXPR',1}, {code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,filter,2}, - {code_server,try_archive_subdirs,3}, - {code_server,all_archive_subdirs,1}, - {code_server,archive_subdirs,1}, - {code_server,insert_name,3}, - {code_server,replace_name,2}, - {code_server,update,2}, - {code_server,maybe_update,2}, - {code_server,do_add,4}, - {code_server,add_path,4}, - {code_server,handle_call,3}, - {code_server,loop,1}, - {code_server,system_continue,3}]) -> 0; + {code_server,try_archive_subdirs,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{erlang,apply,2}, {erlang,spawn_link,1}, -- cgit v1.2.3 From c14d4186d7fa6565d187da15bf39b6d71cb717bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Jan 2016 10:32:41 +0100 Subject: code_server: Add types to the state record --- lib/kernel/src/code_server.erl | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 77d531b2bd..2743214bef 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -33,13 +33,15 @@ -define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded). --record(state, {supervisor, - root, - path, - moddb, - namedb, - mode = interactive, - on_load = []}). +-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}. + +-record(state, {supervisor :: pid(), + root :: file:name_all(), + path :: [file:name_all()], + moddb :: ets:tab(), + namedb :: ets:tab(), + mode = interactive :: 'interactive' | 'embedded', + on_load = [] :: [on_load_item()]}). -type state() :: #state{}. start_link(Args) -> @@ -80,7 +82,8 @@ init(Ref, Parent, [Root,Mode]) -> end, Path = add_loader_path(IPath, Mode), - State = #state{root = Root, + State = #state{supervisor = Parent, + root = Root, path = Path, moddb = Db, namedb = init_namedb(Path), @@ -89,7 +92,7 @@ init(Ref, Parent, [Root,Mode]) -> put(?ANY_NATIVE_CODE_LOADED, false), Parent ! {Ref,{ok,self()}}, - loop(State#state{supervisor = Parent}). + loop(State). get_user_lib_dirs() -> case os:getenv("ERL_LIBS") of -- cgit v1.2.3 From 28f7a47ab4d533cc72090484eb3a7e5713fa58bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 25 Jan 2016 15:56:59 +0100 Subject: code: Correct the types for error returns The specifications for functions that load code in the 'code' module (e.g. code:load_file/1) have some problems: * The specs claim that the functions can return {error,on_load}, but they never do. However, they can return {error,on_load_failure} if the -on_load function in a module fails. * The specs claim that the functions can return {error,native_code}, but they never do. While we are it, also extend the on_load_errors/1 test case to test that the load functions return {error,on_load_failure} when an -on_load function fails. --- lib/kernel/src/code.erl | 5 ++--- lib/kernel/test/code_SUITE.erl | 11 +++++++++++ .../code_SUITE_data/on_load_errors/simple_on_load_error.erl | 5 +++++ 3 files changed, 18 insertions(+), 3 deletions(-) create mode 100644 lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 7d0102d4ef..7237550786 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -77,10 +77,9 @@ %%---------------------------------------------------------------------------- -type load_error_rsn() :: 'badfile' - | 'native_code' | 'nofile' | 'not_purged' - | 'on_load' + | 'on_load_failure' | 'sticky_directory'. -type load_ret() :: {'error', What :: load_error_rsn()} | {'module', Module :: module()}. @@ -135,7 +134,7 @@ load_file(Mod) when is_atom(Mod) -> -spec ensure_loaded(Module) -> {module, Module} | {error, What} when Module :: module(), - What :: embedded | badfile | native_code | nofile | on_load. + What :: embedded | badfile | nofile | on_load_failure. ensure_loaded(Mod) when is_atom(Mod) -> call({ensure_loaded,Mod}). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 8f97b6c6f8..2b77ec8972 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1600,6 +1600,17 @@ on_load_errors(Config) when is_list(Config) -> ok end, + %% Make sure that the code loading functions return the correct + %% error code. + Simple = simple_on_load_error, + SimpleList = atom_to_list(Simple), + {error,on_load_failure} = code:load_file(Simple), + {error,on_load_failure} = code:ensure_loaded(Simple), + {ok,SimpleCode} = file:read_file("simple_on_load_error.beam"), + {error,on_load_failure} = code:load_binary(Simple, "", SimpleCode), + {error,on_load_failure} = code:load_abs(SimpleList), + {error,on_load_failure} = code:load_abs(SimpleList, Simple), + ok. do_on_load_error(ReturnValue) -> diff --git a/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl new file mode 100644 index 0000000000..603c282257 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl @@ -0,0 +1,5 @@ +-module(simple_on_load_error). +-on_load(on_load/0). + +on_load() -> + nope. -- cgit v1.2.3 From fbfe12dad837300942fc4bf0a3f927b25eaf50a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 26 Jan 2016 08:11:00 +0100 Subject: Update documentation for code-loading functions Some of the error reasons were not explained. --- lib/kernel/doc/src/code.xml | 61 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 47 insertions(+), 14 deletions(-) diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index eb0f4b7a06..1bd52040a0 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -287,6 +287,46 @@ was given to set_path/1).

+
+ + Error Reasons for Code-Loading Functions + +

Functions that load code (such as load_file/1) will + return {error,Reason} if the load operation fails. + Here follows a description of the common reasons.

+ + + badfile + +

The object code has an incorrect format or the module + name in the object code is not the expected module name.

+ + + nofile + +

No file with object code was found.

+ + + not_purged + +

The object code could not be loaded because an old version + of the code already existed.

+ + + on_load_failure + +

The module has an + -on_load function + that failed when it was called.

+ + + sticky_directory + +

The object code resides in a sticky directory.

+ + + +
@@ -411,12 +451,8 @@ be used to load object code with a module name that is different from the file name.

Returns {module, Module} if successful, or - {error, nofile} if no object code is found, or - {error, sticky_directory} if the object code resides in - a sticky directory. Also if the loading fails, an error tuple is - returned. See - erlang:load_module/2 - for possible values of What.

+ {error, Reason} if loading fails. + See Error Reasons for Code-Loading Functions for a description of the possible error reasons.

@@ -428,7 +464,7 @@

Does the same as load_file(Module), but Filename is either an absolute file name, or a - relative file name. The code path is not searched. It returns + relative file name. The code path is not searched. It returns a value in the same way as load_file/1. Note that Filename should not contain the extension (for @@ -444,7 +480,8 @@ load_file/1, unless the module is already loaded. In embedded mode, however, it does not load a module which is not - already loaded, but returns {error, embedded} instead.

+ already loaded, but returns {error, embedded} instead. + See Error Reasons for Code-Loading Functions for a description of other possible error reasons.

 @@ -461,12 +498,8 @@ comes. Accordingly, Filename is not opened and read by the code server.

Returns {module, Module} if successful, or - {error, sticky_directory} if the object code resides in - a sticky directory, or {error, badarg} if any argument - is invalid. Also if the loading fails, an error tuple is - returned. See - erlang:load_module/2 - for possible values of What.

+ {error, Reason} if loading fails. + See Error Reasons for Code-Loading Functions for a description of the possible error reasons.

 -- cgit v1.2.3 From 98b1292ee49c5940318962f393f125850d870d96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Jan 2016 12:12:18 +0100 Subject: code_server: Add specs for all exported functions --- lib/kernel/src/code_server.erl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 2743214bef..5e026bb5b3 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -44,6 +44,7 @@ on_load = [] :: [on_load_item()]}). -type state() :: #state{}. +-spec start_link([term()]) -> {'ok', pid()}. start_link(Args) -> Ref = make_ref(), Parent = self(), @@ -128,6 +129,7 @@ split_paths([C|T], S, Path, Paths) -> split_paths([], _S, Path, Paths) -> lists:reverse(Paths, [lists:reverse(Path)]). +-spec call(term()) -> term(). call(Req) -> ?MODULE ! {code_call, self(), Req}, receive @@ -1333,13 +1335,13 @@ strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc); strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]); strip_mod_info([], Acc) -> Acc. -% error_msg(Format) -> -% error_msg(Format,[]). +-spec error_msg(io:format(), [term()]) -> 'ok'. error_msg(Format, Args) -> Msg = {notify,{error, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, ok. +-spec info_msg(io:format(), [term()]) -> 'ok'. info_msg(Format, Args) -> Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, -- cgit v1.2.3 From 27b489736a6bd147bd694e83fc0948cbf9d2bce6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pe=CC=81ter=20Go=CC=88mo=CC=88ri?= Date: Sat, 12 Dec 2015 22:20:01 +0100 Subject: Use file read buffering in dbg:trace_client Trace files are typically large but contain small terms so we can expect a performance gain from read buffering. dbg:trace_client with a dummy handler ran more then 3x faster on a sample 200MB trace file. fprof:profile can also gain a bit. --- lib/runtime_tools/src/dbg.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index d2a7d734c1..22b531e6ee 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1269,7 +1269,7 @@ gen_reader(follow_file, Filename) -> %% Opens a file and returns a reader (lazy list). gen_reader_file(ReadFun, Filename) -> - case file:open(Filename, [read, raw, binary]) of + case file:open(Filename, [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader(ReadFun, File); Error -> @@ -1294,7 +1294,7 @@ mk_reader(ReadFun, Source) -> mk_reader_wrap([]) -> []; mk_reader_wrap([Hd | _] = WrapFiles) -> - case file:open(wrap_name(Hd), [read, raw, binary]) of + case file:open(wrap_name(Hd), [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader_wrap(WrapFiles, File); Error -> -- cgit v1.2.3 From 4a413c8e8d5d9652c2beabfc7897c87092bd3427 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Wed, 25 Nov 2015 13:22:26 +0100 Subject: Extend cerl_trees:mapfold with a 'pre-order' operation When manipulating Core Erlang trees it may be useful to perform some operation when a node is visited, before inspecting children nodes. The definition of cerl_tree:mapfold/3 does not allow that, as it applies the given function only after all the recursive calls on the children nodes have been completed. This patch adds a new argument to mapfold: a function that is applied when a node is first entered. As an example of its use, consider the case where one wants to move a 'call' node earlier, by adding 'let' node and replacing the 'call' node with the defined variable. The name of that variable must be specified before one traverses the inner tree (especially if such replacements can be nested). --- lib/compiler/src/cerl_trees.erl | 223 ++++++++++++++++++++++------------------ 1 file changed, 125 insertions(+), 98 deletions(-) diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 58bb18e34a..b86be95cab 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -27,7 +27,7 @@ -module(cerl_trees). -export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2, - map/2, mapfold/3, size/1, variables/1]). + map/2, mapfold/3, mapfold/4, size/1, variables/1]). -import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, @@ -340,136 +340,162 @@ fold_pairs(_, S, []) -> %% starting with the given value Initial, while doing a %% post-order traversal of the tree, much like fold/3. %% +%% This is the same as mapfold/4, with an identity function as the +%% pre-operation. +%% %% @see map/2 %% @see fold/3 +%% @see mapfold/4 -spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), term(), cerl:cerl()) -> {cerl:cerl(), term()}. mapfold(F, S0, T) -> + mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). + + +%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> +%% {cerl(), term()} +%% +%% Pre = Post = (cerl(), term()) -> {cerl(), term()} +%% +%% @doc Does a combined map/fold operation on the nodes of the +%% tree. It begins by calling Pre on the tree, using the +%% Initial value. It then deconstructs the top node of +%% the returned tree and recurses on the children, using the returned +%% value as the new initial and carrying the returned values from one +%% call to the next. Finally it reassembles the top node from the +%% children, calls Post on it and returns the result. + +-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + term(), cerl:cerl()) -> {cerl:cerl(), term()}. + +mapfold(Pre, Post, S00, T0) -> + {T, S0} = Pre(T0, S00), case type(T) of literal -> case concrete(T) of [_ | _] -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons(T, T1, T2), S2); V when tuple_size(V) > 0 -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple(T, Ts), S1); _ -> - F(T, S0) + Post(T, S0) end; var -> - F(T, S0); + Post(T, S0); values -> - {Ts, S1} = mapfold_list(F, S0, values_es(T)), - F(update_c_values(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)), + Post(update_c_values(T, Ts), S1); cons -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons_skel(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons_skel(T, T1, T2), S2); tuple -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple_skel(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple_skel(T, Ts), S1); map -> - {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); + {M , S1} = mapfold(Pre, Post, S0, map_arg(T)), + {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)), + Post(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)), - {Val, S3} = mapfold(F, S2, map_pair_val(T)), - F(update_c_map_pair(T,Op,Key,Val), S3); + {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)), + {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)), + {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)), + Post(update_c_map_pair(T,Op,Key,Val), S3); 'let' -> - {Vs, S1} = mapfold_list(F, S0, let_vars(T)), - {A, S2} = mapfold(F, S1, let_arg(T)), - {B, S3} = mapfold(F, S2, let_body(T)), - F(update_c_let(T, Vs, A, B), S3); + {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)), + {A, S2} = mapfold(Pre, Post, S1, let_arg(T)), + {B, S3} = mapfold(Pre, Post, S2, let_body(T)), + Post(update_c_let(T, Vs, A, B), S3); seq -> - {A, S1} = mapfold(F, S0, seq_arg(T)), - {B, S2} = mapfold(F, S1, seq_body(T)), - F(update_c_seq(T, A, B), S2); + {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)), + {B, S2} = mapfold(Pre, Post, S1, seq_body(T)), + Post(update_c_seq(T, A, B), S2); apply -> - {E, S1} = mapfold(F, S0, apply_op(T)), - {As, S2} = mapfold_list(F, S1, apply_args(T)), - F(update_c_apply(T, E, As), S2); + {E, S1} = mapfold(Pre, Post, S0, apply_op(T)), + {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)), + Post(update_c_apply(T, E, As), S2); call -> - {M, S1} = mapfold(F, S0, call_module(T)), - {N, S2} = mapfold(F, S1, call_name(T)), - {As, S3} = mapfold_list(F, S2, call_args(T)), - F(update_c_call(T, M, N, As), S3); + {M, S1} = mapfold(Pre, Post, S0, call_module(T)), + {N, S2} = mapfold(Pre, Post, S1, call_name(T)), + {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)), + Post(update_c_call(T, M, N, As), S3); primop -> - {N, S1} = mapfold(F, S0, primop_name(T)), - {As, S2} = mapfold_list(F, S1, primop_args(T)), - F(update_c_primop(T, N, As), S2); + {N, S1} = mapfold(Pre, Post, S0, primop_name(T)), + {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)), + Post(update_c_primop(T, N, As), S2); 'case' -> - {A, S1} = mapfold(F, S0, case_arg(T)), - {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), - F(update_c_case(T, A, Cs), S2); + {A, S1} = mapfold(Pre, Post, S0, case_arg(T)), + {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)), + Post(update_c_case(T, A, Cs), S2); clause -> - {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), - {G, S2} = mapfold(F, S1, clause_guard(T)), - {B, S3} = mapfold(F, S2, clause_body(T)), - F(update_c_clause(T, Ps, G, B), S3); + {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)), + {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)), + {B, S3} = mapfold(Pre, Post, S2, clause_body(T)), + Post(update_c_clause(T, Ps, G, B), S3); alias -> - {V, S1} = mapfold(F, S0, alias_var(T)), - {P, S2} = mapfold(F, S1, alias_pat(T)), - F(update_c_alias(T, V, P), S2); + {V, S1} = mapfold(Pre, Post, S0, alias_var(T)), + {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)), + Post(update_c_alias(T, V, P), S2); 'fun' -> - {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), - {B, S2} = mapfold(F, S1, fun_body(T)), - F(update_c_fun(T, Vs, B), S2); + {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)), + {B, S2} = mapfold(Pre, Post, S1, fun_body(T)), + Post(update_c_fun(T, Vs, B), S2); 'receive' -> - {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), - {E, S2} = mapfold(F, S1, receive_timeout(T)), - {A, S3} = mapfold(F, S2, receive_action(T)), - F(update_c_receive(T, Cs, E, A), S3); + {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)), + {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)), + {A, S3} = mapfold(Pre, Post, S2, receive_action(T)), + Post(update_c_receive(T, Cs, E, A), S3); 'try' -> - {E, S1} = mapfold(F, S0, try_arg(T)), - {Vs, S2} = mapfold_list(F, S1, try_vars(T)), - {B, S3} = mapfold(F, S2, try_body(T)), - {Evs, S4} = mapfold_list(F, S3, try_evars(T)), - {H, S5} = mapfold(F, S4, try_handler(T)), - F(update_c_try(T, E, Vs, B, Evs, H), S5); + {E, S1} = mapfold(Pre, Post, S0, try_arg(T)), + {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)), + {B, S3} = mapfold(Pre, Post, S2, try_body(T)), + {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)), + {H, S5} = mapfold(Pre, Post, S4, try_handler(T)), + Post(update_c_try(T, E, Vs, B, Evs, H), S5); 'catch' -> - {B, S1} = mapfold(F, S0, catch_body(T)), - F(update_c_catch(T, B), S1); + {B, S1} = mapfold(Pre, Post, S0, catch_body(T)), + Post(update_c_catch(T, B), S1); binary -> - {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), - F(update_c_binary(T, Ds), S1); + {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)), + Post(update_c_binary(T, Ds), S1); bitstr -> - {Val, S1} = mapfold(F, S0, bitstr_val(T)), - {Size, S2} = mapfold(F, S1, bitstr_size(T)), - {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), - {Type, S4} = mapfold(F, S3, bitstr_type(T)), - {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), - F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); + {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)), + {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)), + {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)), + {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)), + {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)), + Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); letrec -> - {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), - {B, S2} = mapfold(F, S1, letrec_body(T)), - F(update_c_letrec(T, Ds, B), S2); + {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)), + {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)), + Post(update_c_letrec(T, Ds, B), S2); module -> - {N, S1} = mapfold(F, S0, module_name(T)), - {Es, S2} = mapfold_list(F, S1, module_exports(T)), - {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), - {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), - F(update_c_module(T, N, Es, As, Ds), S4) + {N, S1} = mapfold(Pre, Post, S0, module_name(T)), + {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)), + {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)), + {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)), + Post(update_c_module(T, N, Es, As, Ds), S4) end. -mapfold_list(F, S0, [T | Ts]) -> - {T1, S1} = mapfold(F, S0, T), - {Ts1, S2} = mapfold_list(F, S1, Ts), +mapfold_list(Pre, Post, S0, [T | Ts]) -> + {T1, S1} = mapfold(Pre, Post, S0, T), + {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts), {[T1 | Ts1], S2}; -mapfold_list(_, S, []) -> +mapfold_list(_, _, S, []) -> {[], S}. -mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> - {T3, S1} = mapfold(F, S0, T1), - {T4, S2} = mapfold(F, S1, T2), - {Ps1, S3} = mapfold_pairs(F, S2, Ps), +mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) -> + {T3, S1} = mapfold(Pre, Post, S0, T1), + {T4, S2} = mapfold(Pre, Post, S1, T2), + {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps), {[{T3, T4} | Ps1], S3}; -mapfold_pairs(_, S, []) -> +mapfold_pairs(_, _, S, []) -> {[], S}. @@ -640,8 +666,8 @@ vars_in_list([], _, A) -> vars_in_defs(Ds, S) -> vars_in_defs(Ds, S, []). -vars_in_defs([{_, F} | Ds], S, A) -> - vars_in_defs(Ds, S, ordsets:union(variables(F, S), A)); +vars_in_defs([{_, Post} | Ds], S, A) -> + vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A)); vars_in_defs([], _, A) -> A. @@ -703,13 +729,14 @@ label(T, N, Env) -> %% Constant literals are not labeled. {T, N}; var -> - case dict:find(var_name(T), Env) of - {ok, L} -> - {As, _} = label_ann(T, L), - N1 = N; - error -> - {As, N1} = label_ann(T, N) - end, + {As, N1} = + case dict:find(var_name(T), Env) of + {ok, L} -> + {A, _} = label_ann(T, L), + {A, N}; + error -> + label_ann(T, N) + end, {set_ann(T, As), N1}; values -> {Ts, N1} = label_list(values_es(T), N, Env), -- cgit v1.2.3 From ba8d87765f490d99c9768dd116bb1a2e75354cc6 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Thu, 28 Jan 2016 15:44:15 +0100 Subject: inets: Use re instead of inets_regexp --- lib/inets/src/http_lib/http_uri.erl | 8 +- lib/inets/src/http_server/httpd.erl | 18 +- lib/inets/src/http_server/httpd_conf.erl | 34 +- lib/inets/src/http_server/httpd_script_env.erl | 2 +- lib/inets/src/http_server/httpd_util.erl | 29 +- lib/inets/src/http_server/mod_actions.erl | 20 +- lib/inets/src/http_server/mod_alias.erl | 26 +- lib/inets/src/http_server/mod_auth.erl | 40 +-- lib/inets/src/http_server/mod_auth_plain.erl | 14 +- lib/inets/src/http_server/mod_browser.erl | 21 +- lib/inets/src/http_server/mod_dir.erl | 11 +- lib/inets/src/http_server/mod_disk_log.erl | 25 +- lib/inets/src/http_server/mod_esi.erl | 31 +- lib/inets/src/http_server/mod_htaccess.erl | 35 +-- lib/inets/src/http_server/mod_security.erl | 8 +- lib/inets/src/inets_app/Makefile | 1 - lib/inets/src/inets_app/inets.app.src | 1 - lib/inets/src/inets_app/inets_regexp.erl | 414 ------------------------- lib/inets/src/tftp/tftp_engine.erl | 4 +- lib/inets/src/tftp/tftp_lib.erl | 4 +- lib/inets/test/httpd_1_1.erl | 42 +-- lib/inets/test/httpd_poll.erl | 6 +- lib/inets/test/httpd_test_lib.erl | 10 +- lib/inets/test/httpd_time_test.erl | 22 +- 24 files changed, 198 insertions(+), 628 deletions(-) delete mode 100644 lib/inets/src/inets_app/inets_regexp.erl diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 79591eec29..bd8ca5f489 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -179,10 +179,10 @@ parse_host_port(_Scheme, DefaultPort, HostPort, _Opts) -> {Host, int_port(Port)}. split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> - case inets_regexp:first_match(UriPart, SplitChar) of - {match, Match, _} -> - {string:substr(UriPart, 1, Match - SkipLeft), - string:substr(UriPart, Match + SkipRight, length(UriPart))}; + case re:run(UriPart, SplitChar, [{capture, first}]) of + {match, [{Match, _}]} -> + {string:substr(UriPart, 1, Match + 1 - SkipLeft), + string:substr(UriPart, Match + 1 + SkipRight, length(UriPart))}; nomatch -> NoMatchResult end. diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index cf02c0e072..e6377b4882 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -43,7 +43,7 @@ %%%======================================================================== parse_query(String) -> - {ok, SplitString} = inets_regexp:split(String,"[&;]"), + SplitString = re:split(String,"[&;]", [{return, list}]), foreach(SplitString). reload_config(Config = [Value| _], Mode) when is_tuple(Value) -> @@ -239,14 +239,14 @@ unblock(Addr, Port, Profile) when is_integer(Port) -> foreach([]) -> []; foreach([KeyValue|Rest]) -> - {ok, Plus2Space, _} = inets_regexp:gsub(KeyValue,"[\+]"," "), - case inets_regexp:split(Plus2Space,"=") of - {ok,[Key|Value]} -> - [{http_uri:decode(Key), - http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; - {ok,_} -> - foreach(Rest) - end. + Plus2Space = re:replace(KeyValue,"[\+]"," ", [{return,list}, global]), + case re:split(Plus2Space,"=", [{return, list}]) of + [Key|Value] -> + [{http_uri:decode(Key), + http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; + _ -> + foreach(Rest) + end. make_name(Addr, Port, Profile) -> diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 7d31989244..d592984669 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -232,7 +232,7 @@ load("KeepAliveTimeout " ++ Timeout, []) -> end; load("Modules " ++ Modules, []) -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}}; load("ServerAdmin " ++ ServerAdmin, []) -> @@ -876,7 +876,7 @@ bootstrap([]) -> bootstrap([Line|Config]) -> case Line of "Modules " ++ Modules -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), TheMods = [list_to_atom(X) || X <- ModuleList], case verify_modules(TheMods) of ok -> @@ -1001,7 +1001,7 @@ read_config_file(Stream, SoFar) -> %% Ignore commented lines for efficiency later .. read_config_file(Stream, SoFar); Line -> - {ok, NewLine, _}=inets_regexp:sub(clean(Line),"[\t\r\f ]"," "), + NewLine = re:replace(clean(Line),"[\t\r\f ]"," ", [{return,list}]), case NewLine of [] -> %% Also ignore empty lines .. @@ -1028,12 +1028,12 @@ parse_mime_types(Stream, MimeTypesList, "") -> parse_mime_types(Stream, MimeTypesList, [$#|_]) -> parse_mime_types(Stream, MimeTypesList); parse_mime_types(Stream, MimeTypesList, Line) -> - case inets_regexp:split(Line, " ") of - {ok, [NewMimeType|Suffixes]} -> + case re:split(Line, " ", [{return, list}]) of + [NewMimeType|Suffixes] -> parse_mime_types(Stream, lists:append(suffixes(NewMimeType,Suffixes), MimeTypesList)); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -1204,9 +1204,8 @@ error_report(Where,M,F,Error) -> error_logger:error_report([{?MODULE, Where}, {apply, {M, F, []}}, Error]). white_space_clean(String) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). %%%========================================================================= @@ -1243,22 +1242,23 @@ is_file(_Type,_Access,FileInfo,_File) -> {error,FileInfo}. make_integer(String) -> - case inets_regexp:match(string:strip(String),"[0-9]+") of - {match, _, _} -> + case re:run(string:strip(String),"[0-9]+", [{capture, none}]) of + match -> {ok, list_to_integer(string:strip(String))}; nomatch -> {error, nomatch} end. clean(String) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). custom_clean(String,MoreBefore,MoreAfter) -> - {ok,CleanedString,_} = inets_regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++ - "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""), - CleanedString. + re:replace(String, + "^[ \t\n\r\f"++MoreBefore++ + "]*|[ \t\n\r\f"++MoreAfter++"]*\$","", + [{return,list}, global]). + check_enum(_Enum,[]) -> {error, not_valid}; diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 21b22f4420..232bf96bd4 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -104,7 +104,7 @@ create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } | create_http_header_elements(ScriptType, [{Name, Value} | Headers], Acc) when is_list(Value) -> - {ok, NewName, _} = inets_regexp:gsub(Name,"-","_"), + NewName = re:replace(Name,"-","_", [{return,list}, global]), Element = http_env_element(ScriptType, NewName, Value), create_http_header_elements(ScriptType, Headers, [Element | Acc]). diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index fc69baf829..9133309689 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -430,11 +430,11 @@ flatlength([],L) -> %% split_path split_path(Path) -> - case inets_regexp:match(Path,"[\?].*\$") of + case re:run(Path,"[\?].*\$", [{capture, first}]) of %% A QUERY_STRING exists! - {match,Start,Length} -> - {http_uri:decode(string:substr(Path,1,Start-1)), - string:substr(Path,Start,Length)}; + {match,[{Start,Length}]} -> + {http_uri:decode(string:substr(Path,1,Start)), + string:substr(Path,Start+1,Length)}; %% A possible PATH_INFO exists! nomatch -> split_path(Path,[]) @@ -532,25 +532,8 @@ remove_ws(Rest) -> %% split -split(String,RegExp,Limit) -> - case inets_regexp:parse(RegExp) of - {error,Reason} -> - {error,Reason}; - {ok,_} -> - {ok,do_split(String,RegExp,Limit)} - end. - -do_split(String, _RegExp, 1) -> - [String]; - -do_split(String,RegExp,Limit) -> - case inets_regexp:first_match(String,RegExp) of - {match,Start,Length} -> - [string:substr(String,1,Start-1)| - do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)]; - nomatch -> - [String] - end. +split(String,RegExp,N) -> + {ok, re:split(String, RegExp, [{parts, N}, {return, list}])}. %% make_name/2, make_name/3 %% Prefix -> string() diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl index d879328876..154fde294e 100644 --- a/lib/inets/src/http_server/mod_actions.erl +++ b/lib/inets/src/http_server/mod_actions.erl @@ -81,18 +81,18 @@ script(RequestURI, Method, [_ | Rest]) -> %% load load("Action "++ Action, []) -> - case inets_regexp:split(Action, " ") of - {ok,[MimeType, CGIScript]} -> - {ok,[],{action, {MimeType, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Action)++" is an invalid Action")} + case re:split(Action, " ", [{return, list}]) of + [MimeType, CGIScript] -> + {ok,[],{action, {MimeType, CGIScript}}}; + _ -> + {error,?NICE(string:strip(Action)++" is an invalid Action")} end; load("Script " ++ Script,[]) -> - case inets_regexp:split(Script, " ") of - {ok,[Method, CGIScript]} -> - {ok,[],{script, {Method, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Script)++" is an invalid Script")} + case re:split(Script, " ", [{return, list}]) of + [Method, CGIScript] -> + {ok,[],{script, {Method, CGIScript}}}; + _ -> + {error,?NICE(string:strip(Script)++" is an invalid Script")} end. store({action, {MimeType, CGIScript}} = Conf, _) when is_list(MimeType), diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 8dd4871821..77045259d3 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -146,7 +146,7 @@ real_script_name(_ConfigDB, _RequestURI, []) -> real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture,[]}]) of + case re:run(RequestURI, MP, [{capture, none}]) of match -> ActualName = re:replace(RequestURI, MP, Replacement, [{return,list}]), @@ -156,10 +156,10 @@ real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) end; real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) -> - case inets_regexp:match(RequestURI, "^" ++ FakeName) of - {match,_,_} -> - {ok, ActualName, _} = - inets_regexp:sub(RequestURI, "^" ++ FakeName, RealName), + case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of + match -> + ActualName = + re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]), httpd_util:split_script_path(default_index(ConfigDB, ActualName)); nomatch -> real_script_name(ConfigDB, RequestURI, Rest) @@ -206,26 +206,26 @@ path(Data, ConfigDB, RequestURI) -> %% load load("DirectoryIndex " ++ DirectoryIndex, []) -> - {ok, DirectoryIndexes} = inets_regexp:split(DirectoryIndex," "), + DirectoryIndexes = re:split(DirectoryIndex," ", [{return, list}]), {ok,[], {directory_index, DirectoryIndexes}}; load("Alias " ++ Alias, []) -> - case inets_regexp:split(Alias," ") of - {ok, [FakeName, RealName]} -> + case re:split(Alias," ", [{return, list}]) of + [FakeName, RealName] -> {ok,[],{alias,{FakeName,RealName}}}; - {ok, _} -> + _ -> {error,?NICE(string:strip(Alias)++" is an invalid Alias")} end; load("ReWrite " ++ Rule, Acc) -> load_re_write(Rule, Acc, "ReWrite", re_write); load("ScriptAlias " ++ ScriptAlias, []) -> - case inets_regexp:split(ScriptAlias, " ") of - {ok, [FakeName, RealName]} -> + case re:split(ScriptAlias, " ", [{return, list}]) of + [FakeName, RealName] -> %% Make sure the path always has a trailing slash.. RealName1 = filename:join(filename:split(RealName)), {ok, [], {script_alias, {FakeName, RealName1++"/"}}}; - {ok, _} -> + _ -> {error, ?NICE(string:strip(ScriptAlias)++ - " is an invalid ScriptAlias")} + " is an invalid ScriptAlias")} end; load("ScriptReWrite " ++ Rule, Acc) -> load_re_write(Rule, Acc, "ScriptReWrite", script_re_write). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 6195e1c69f..b03629cabe 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -168,38 +168,38 @@ load("AuthDBType " ++ Type, end; load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> + case re:split(Require," ", [{return, list}]) of + ["user" | Users] -> {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> + [{require_user,Users}|DirData]}} | Rest]}; + ["group"|Groups] -> {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> + [{require_group,Groups}|DirData]}} | Rest]}; + _ -> {error,?NICE(string:strip(Require) ++" is an invalid require")} end; load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> + case re:split(Allow," ", [{return, list}]) of + ["from","all"] -> {ok,[{directory, {Directory, [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{directory, {Directory, [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> + _ -> {error,?NICE(string:strip(Allow) ++" is an invalid allow")} end; load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> + case re:split(Deny," ", [{return, list}]) of + ["from", "all"] -> {ok,[{{directory, Directory, [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{{directory, Directory, [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> + _ -> {error,?NICE(string:strip(Deny) ++" is an invalid deny")} end; @@ -561,12 +561,12 @@ secret_path(_Path, [], to_be_found) -> secret_path(_Path, [], Directory) -> {yes, Directory}; secret_path(Path, [[NewDirectory] | Rest], Directory) -> - case inets_regexp:match(Path, NewDirectory) of - {match, _, _} when Directory =:= to_be_found -> + case re:run(Path, NewDirectory, [{capture, first}]) of + {match, _} when Directory =:= to_be_found -> secret_path(Path, Rest, NewDirectory); - {match, _, Length} when Length > length(Directory)-> + {match, [{_, Length}]} when Length > length(Directory)-> secret_path(Path, Rest,NewDirectory); - {match, _, _Length} -> + {match, _} -> secret_path(Path, Rest, Directory); nomatch -> secret_path(Path, Rest, Directory) @@ -588,8 +588,8 @@ validate_addr(_RemoteAddr, none) -> % When called from 'deny' validate_addr(_RemoteAddr, []) -> false; validate_addr(RemoteAddr, [HostRegExp | Rest]) -> - case inets_regexp:match(RemoteAddr, HostRegExp) of - {match,_,_} -> + case re:run(RemoteAddr, HostRegExp, [{capture, none}]) of + match -> true; nomatch -> validate_addr(RemoteAddr,Rest) diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index e85d3b8776..1a3120e03c 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -244,11 +244,11 @@ parse_group(Stream, GroupList, "") -> parse_group(Stream, GroupList, [$#|_]) -> parse_group(Stream, GroupList); parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), + case re:split(Line, ":", [{return, list}]) of + [Group,Users] -> + UserList = re:split(Users," ", [{return, list}]), parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -278,10 +278,10 @@ parse_passwd(Stream, PasswdList, "") -> parse_passwd(Stream, PasswdList, [$#|_]) -> parse_passwd(Stream, PasswdList); parse_passwd(Stream, PasswdList, Line) -> - case inets_regexp:split(Line,":") of - {ok, [User,Password]} -> + case re:split(Line,":", [{return, list}]) of + [User,Password] -> parse_passwd(Stream, [{User,Password, []}|PasswdList]); - {ok,_} -> + _ -> {error, ?NICE(Line)} end. diff --git a/lib/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl index ca643ab728..e3c41793ae 100644 --- a/lib/inets/src/http_server/mod_browser.erl +++ b/lib/inets/src/http_server/mod_browser.erl @@ -98,9 +98,9 @@ getBrowser1(Info) -> getBrowser(AgentString) -> LAgentString = http_util:to_lower(AgentString), - case inets_regexp:first_match(LAgentString,"^[^ ]*") of - {match,Start,Length} -> - Browser = lists:sublist(LAgentString,Start,Length), + case re:run(LAgentString,"^[^ ]*", [{capture, first}]) of + {match,[{Start,Length}]} -> + Browser = lists:sublist(LAgentString,Start+1,Length), case browserType(Browser) of {mozilla,Vsn} -> {getMozilla(LAgentString, @@ -164,8 +164,8 @@ operativeSystem(OpString,[{RetVal,RegExps}|Rest]) -> controlOperativeSystem(_OpString,[]) -> false; controlOperativeSystem(OpString,[Regexp|Regexps]) -> - case inets_regexp:match(OpString,Regexp) of - {match,_,_} -> + case re:run(OpString,Regexp, [{capture, none}]) of + match -> true; nomatch -> controlOperativeSystem(OpString,Regexps) @@ -182,18 +182,19 @@ controlOperativeSystem(OpString,[Regexp|Regexps]) -> getMozilla(_AgentString,[],Default) -> Default; getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) -> - case inets_regexp:match(AgentString,AgentRegExp) of - {match,_,_} -> + case re:run(AgentString,AgentRegExp, [{capture, none}]) of + match -> {Agent,getMozVersion(AgentString,AgentRegExp)}; nomatch -> getMozilla(AgentString,Rest,Default) end. getMozVersion(AgentString, AgentRegExp) -> - case inets_regexp:match(AgentString,AgentRegExp++"[0-9\.\ \/]*") of - {match,Start,Length} when length(AgentRegExp) < Length -> + case re:run(AgentString,AgentRegExp++"[0-9\.\ \/]*", + [{capture, first}]) of + {match, [{Start,Length}]} when length(AgentRegExp) < Length -> %% Ok we got the number split it out - RealStart = Start+length(AgentRegExp), + RealStart = Start+1+length(AgentRegExp), RealLength = Length-length(AgentRegExp), VsnString = string:substr(AgentString,RealStart,RealLength), %% case string:strip(VsnString,both,$\ ) of diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl index 9d848ac013..2d8f27af3c 100644 --- a/lib/inets/src/http_server/mod_dir.erl +++ b/lib/inets/src/http_server/mod_dir.erl @@ -125,12 +125,13 @@ header(Path,RequestURI) -> RequestURI ++ "\n
      Name                   Last modified         "
 	"Size  Description 
\n",
-    case inets_regexp:sub(RequestURI,"[^/]*\$","") of
-	{ok,"/",_} ->
+    case re:replace(RequestURI,"[^/]*\$","", [{return,list}]) of
+	"/" ->
 	    Header;
-	{ok,ParentRequestURI,_} ->
-	    {ok,ParentPath,_} =
-		inets_regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""),
+	ParentRequestURI ->
+	    ParentPath =
+		re:replace(string:strip(Path,right,$/),"[^/]*\$","",
+			   [{return,list}]),
 	    Header++format(ParentPath,ParentRequestURI)
     end.
 
diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl
index a0ff929a34..5e395a2118 100644
--- a/lib/inets/src/http_server/mod_disk_log.erl
+++ b/lib/inets/src/http_server/mod_disk_log.erl
@@ -138,8 +138,8 @@ do(Info) ->
 %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
 %%-------------------------------------------------------------------------
 load("TransferDiskLogSize " ++ TransferDiskLogSize, []) ->
-    case inets_regexp:split(TransferDiskLogSize," ") of
-	{ok,[MaxBytes,MaxFiles]} ->
+    try re:split(TransferDiskLogSize, " ",  [{return, list}]) of
+	[MaxBytes, MaxFiles] ->
 	    case make_integer(MaxBytes) of
 		{ok,MaxBytesInteger} ->
 		    case make_integer(MaxFiles) of
@@ -151,17 +151,20 @@ load("TransferDiskLogSize " ++ TransferDiskLogSize, []) ->
 			     ?NICE(string:strip(TransferDiskLogSize)++
 				   " is an invalid TransferDiskLogSize")}
 		    end;
-		{error,_} ->
+		_ ->
 		    {error,?NICE(string:strip(TransferDiskLogSize)++
-				 " is an invalid TransferDiskLogSize")}
+				     " is an invalid TransferDiskLogSize")}
 	    end
+    catch _:_ ->
+	    {error,?NICE(string:strip(TransferDiskLogSize) ++
+			     " is an invalid TransferDiskLogSize")}   
     end;
 load("TransferDiskLog " ++ TransferDiskLog,[]) ->
     {ok,[],{transfer_disk_log,string:strip(TransferDiskLog)}};
  
 load("ErrorDiskLogSize " ++  ErrorDiskLogSize, []) ->
-    case inets_regexp:split(ErrorDiskLogSize," ") of
-	{ok,[MaxBytes,MaxFiles]} ->
+    try re:split(ErrorDiskLogSize," ", [{return, list}]) of
+	[MaxBytes,MaxFiles] ->
 	    case make_integer(MaxBytes) of
 		{ok,MaxBytesInteger} ->
 		    case make_integer(MaxFiles) of
@@ -176,13 +179,16 @@ load("ErrorDiskLogSize " ++  ErrorDiskLogSize, []) ->
 		    {error,?NICE(string:strip(ErrorDiskLogSize)++
 				 " is an invalid ErrorDiskLogSize")}
 	    end
+    catch _:_ ->
+	    {error,?NICE(string:strip(ErrorDiskLogSize) ++
+			     " is an invalid TransferDiskLogSize")}   
     end;
 load("ErrorDiskLog " ++ ErrorDiskLog, []) ->
     {ok, [], {error_disk_log, string:strip(ErrorDiskLog)}};
 
 load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) ->
-    case inets_regexp:split(SecurityDiskLogSize, " ") of
-	{ok, [MaxBytes, MaxFiles]} ->
+    try re:split(SecurityDiskLogSize, " ", [{return, list}]) of
+	[MaxBytes, MaxFiles] ->
 	    case make_integer(MaxBytes) of
 		{ok, MaxBytesInteger} ->
 		    case make_integer(MaxFiles) of
@@ -198,6 +204,9 @@ load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) ->
 		    {error, ?NICE(string:strip(SecurityDiskLogSize) ++
 				  " is an invalid SecurityDiskLogSize")}
 	    end
+    catch _:_ ->
+	    {error,?NICE(string:strip(SecurityDiskLogSize) ++
+			     " is an invalid SecurityDiskLogSize")}   	
     end;
 load("SecurityDiskLog " ++ SecurityDiskLog, []) ->
     {ok, [], {security_disk_log, string:strip(SecurityDiskLog)}};
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
index b9a0797977..f8baa90fd4 100644
--- a/lib/inets/src/http_server/mod_esi.erl
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -96,26 +96,27 @@ do(ModData) ->
 %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS
 %%-------------------------------------------------------------------------
 load("ErlScriptAlias " ++ ErlScriptAlias, []) ->
-    case inets_regexp:split(ErlScriptAlias," ") of
-	{ok, [ErlName | StrModules]} ->
+    try re:split(ErlScriptAlias," ", [{return, list}]) of
+	[ErlName | StrModules] ->
 	    Modules = lists:map(fun(Str) -> 
 					list_to_atom(string:strip(Str)) 
 				end, StrModules),
-	    {ok, [], {erl_script_alias, {ErlName, Modules}}};
-	{ok, _} ->
+	    {ok, [], {erl_script_alias, {ErlName, Modules}}}
+    catch _:_ ->
 	    {error, ?NICE(string:strip(ErlScriptAlias) ++
-			 " is an invalid ErlScriptAlias")}
+			      " is an invalid ErlScriptAlias")}
     end;
 load("EvalScriptAlias " ++ EvalScriptAlias, []) ->
-    case inets_regexp:split(EvalScriptAlias, " ") of
-	{ok, [EvalName | StrModules]} ->
+    try re:split(EvalScriptAlias, " ",  [{return, list}]) of
+	[EvalName | StrModules] ->
 	    Modules = lists:map(fun(Str) -> 
 					list_to_atom(string:strip(Str)) 
 				end, StrModules),
-	    {ok, [], {eval_script_alias, {EvalName, Modules}}};
-	{ok, _} ->
+	    {ok, [], {eval_script_alias, {EvalName, Modules}}}
+    catch 
+	_:_ ->
 	    {error, ?NICE(string:strip(EvalScriptAlias) ++
-			  " is an invalid EvalScriptAlias")}
+			      " is an invalid EvalScriptAlias")}
     end;
 load("ErlScriptTimeout " ++ Timeout, [])->
     case catch list_to_integer(string:strip(Timeout)) of
@@ -224,8 +225,8 @@ match_esi_script(_, [], _) ->
     no_match;
 match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) ->
     AliasMatchStr = alias_match_str(Alias, AliasType),
-    case inets_regexp:first_match(RequestURI, AliasMatchStr) of
-	{match, 1, Length} ->
+    case re:run(RequestURI, AliasMatchStr, [{capture, first}]) of
+	{match, [{0, Length}]} ->
 	    {string:substr(RequestURI, Length + 1), Modules};
 	nomatch ->
 	    match_esi_script(RequestURI, Rest, AliasType)
@@ -567,9 +568,9 @@ generate_webpage(ESIBody) ->
 is_authorized(_ESIBody, [all]) ->
     true;
 is_authorized(ESIBody, Modules) ->
-    case inets_regexp:match(ESIBody, "^[^\:(%3A)]*") of
-	{match, Start, Length} ->
-	    lists:member(list_to_atom(string:substr(ESIBody, Start, Length)),
+    case re:run(ESIBody, "^[^\:(%3A)]*", [{capture, first}]) of
+	{match, [{Start, Length}]} ->
+	    lists:member(list_to_atom(string:substr(ESIBody, Start+1, Length)),
 			 Modules);
 	nomatch ->
 	    false
diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl
index c6ae20ced7..f229c96f2d 100644
--- a/lib/inets/src/http_server/mod_htaccess.erl
+++ b/lib/inets/src/http_server/mod_htaccess.erl
@@ -327,9 +327,9 @@ memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)->
 %ipadresses or subnet addresses.
 memberNetwork(Networks,UserNetwork)->
     case lists:filter(fun(Net)->
-			      case inets_regexp:match(UserNetwork,
-						formatRegexp(Net)) of
-				  {match,1,_}->
+			      case re:run(UserNetwork,
+					  formatRegexp(Net), [{capture, first}]) of
+				  {match,[{0,_}]}->
 				      true;
 				  _NotSubNet ->
 				      false
@@ -638,13 +638,8 @@ getHtAccessFileNames(Info)->
 %HtAccessFileNames=["accessfileName1",..."AccessFileName2"]
 %----------------------------------------------------------------------
 getData(Path,Info,HtAccessFileNames)->	    
-    case inets_regexp:split(Path,"/") of
-	{error,Error}->
-	    {error,Error};
-	{ok,SplittedPath}->
-	    getData2(HtAccessFileNames,SplittedPath,Info)
-	end.
-
+    SplittedPath = re:split(Path, "/", [{return, list}]),
+    getData2(HtAccessFileNames,SplittedPath,Info).
 
 %----------------------------------------------------------------------
 %Add to together the data in the Splittedpath up to the path 
@@ -942,20 +937,16 @@ getAuthorizationType(AuthType)->
 %Returns a list of the specified methods to limit or the atom all
 %----------------------------------------------------------------------
 getLimits(Limits)->
-    case inets_regexp:split(Limits,">")of
-	{ok,[_NoEndOnLimit]}->
+    case re:split(Limits,">", [{return, list}])of
+	[_NoEndOnLimit]->
 	    error;
-	{ok, [Methods | _Crap]}->
-	    case inets_regexp:split(Methods," ") of
-		{ok,[]}->
+	[Methods | _Crap]->
+	    case re:split(Methods," ",  [{return, list}]) of
+		[[]]->
 		    all;
-		{ok,SplittedMethods}->
-		    SplittedMethods;
-		{error, _Error}->
-		    error
-	    end;
-	{error,_Error}->
-	    error
+		SplittedMethods ->
+		    SplittedMethods
+	    end
     end.
 
 
diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl
index 20f87619c1..1f936d598a 100644
--- a/lib/inets/src/http_server/mod_security.erl
+++ b/lib/inets/src/http_server/mod_security.erl
@@ -273,12 +273,12 @@ secret_path(_Path, [], to_be_found) ->
 secret_path(_Path, [], Dir) ->
     {yes, Dir};
 secret_path(Path, [[NewDir]|Rest], Dir) ->
-    case inets_regexp:match(Path, NewDir) of
-	{match, _, _} when Dir =:= to_be_found ->
+    case re:run(Path, NewDir, [{capture, first}]) of
+	{match, _} when Dir =:= to_be_found ->
 	    secret_path(Path, Rest, NewDir);
-	{match, _, Length} when Length > length(Dir) ->
+	{match, [{_, Length}]} when Length > length(Dir) ->
 	    secret_path(Path, Rest, NewDir);
-	{match, _, _} ->
+	{match, _} ->
 	    secret_path(Path, Rest, Dir);
 	nomatch ->
 	    secret_path(Path, Rest, Dir)
diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile
index 82cda6aaf0..0a4b625b6a 100644
--- a/lib/inets/src/inets_app/Makefile
+++ b/lib/inets/src/inets_app/Makefile
@@ -47,7 +47,6 @@ MODULES = \
 	inets_service \
 	inets_app \
 	inets_sup \
-	inets_regexp \
 	inets_trace \
 	inets_lib \
 	inets_time_compat
diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src
index 2b9b8f5f32..e95f276bc4 100644
--- a/lib/inets/src/inets_app/inets.app.src
+++ b/lib/inets/src/inets_app/inets.app.src
@@ -26,7 +26,6 @@
             inets_sup,
             inets_app,
 	    inets_service,	                  
-	    inets_regexp,	                  
 	    inets_trace,
             inets_lib,
             inets_time_compat,
diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl
deleted file mode 100644
index fc1608bc5a..0000000000
--- a/lib/inets/src/inets_app/inets_regexp.erl
+++ /dev/null
@@ -1,414 +0,0 @@
-%%
-%% %CopyrightBegin%
-%% 
-%% Copyright Ericsson AB 2009. All Rights Reserved.
-%% 
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%%     http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%% 
-%% %CopyrightEnd%
-%%
-
--module(inets_regexp).
-
--export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]).
-
-
-%%%=========================================================================
-%%%  API
-%%%=========================================================================
-
-%% parse(RegExp) -> {ok, RE} | {error, E}.
-%% Parse the regexp described in the string RegExp.
-
-parse(S) ->
-    case (catch reg(S)) of
-	{R, []} -> 
-	    {ok, R};
-	{_R, [C|_]} -> 
-	    {error, {illegal, [C]}};
-	{error, E} -> 
-	    {error, E}
-    end.
-
-
-%% Find the longest match of RegExp in String.
-
-match(S, RegExp) when is_list(RegExp) ->
-    case parse(RegExp) of
-	{ok,RE} -> match(S, RE);
-	{error,E} -> {error,E}
-    end;
-match(S, RE) ->
-    case match(RE, S, 1, 0, -1) of
-	{Start,Len} when Len >= 0 ->
-	    {match, Start, Len};
-	{_Start,_Len} -> 
-	    nomatch
-    end.
-
-%% Find the first match of RegExp in String.
-
-first_match(S, RegExp) when is_list(RegExp) ->
-    case parse(RegExp) of
-	{ok, RE} -> 
-	    first_match(S, RE);
-	{error, E} -> 
-	    {error, E}
-    end;
-first_match(S, RE) ->
-    case first_match(RE, S, 1) of
-	{Start,Len} when Len >= 0 ->
-	    {match, Start,Len};
-	nomatch -> 
-	    nomatch
-    end.
-
-first_match(RE, S, St) when S =/= [] ->
-    case re_apply(S, St, RE) of
-	{match, P, _Rest} -> 
-	    {St, P-St};
-	nomatch -> 
-	    first_match(RE, tl(S), St+1)
-    end;
-first_match(_RE, [], _St) -> 
-    nomatch.
-
-
-match(RE, S, St, Pos, L) ->
-    case first_match(RE, S, St) of
-	{St1, L1} ->
-	    Nst = St1 + 1,
-	    if L1 > L -> 
-		    match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1);
-	       true -> 
-		    match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L)
-	    end;
-	nomatch -> 
-	    {Pos, L}
-    end.
-
-
-%% Split a string into substrings where the RegExp describes the
-%% field seperator. The RegExp " " is specially treated.
-
-split(String, " ") ->				%This is really special
-    {ok, RE} = parse("[ \t]+"),
-    case split_apply(String, RE, true) of
-	[[]|Ss] -> 
-	    {ok,Ss};
-	Ss -> 
-	    {ok,Ss}
-    end;
-split(String, RegExp) when is_list(RegExp) ->
-    case parse(RegExp) of
-	{ok, RE} -> 
-	    {ok, split_apply(String, RE, false)};
-	{error, E} -> 
-	    {error,E}
-    end;
-split(String, RE) -> 
-    {ok, split_apply(String, RE, false)}.
-
-
-%% Substitute the first match of the regular expression RegExp 
-%% with the string Replace in String. Accept pre-parsed regular
-%% expressions.
-
-sub(String, RegExp, Rep) when is_list(RegExp) ->
-    case parse(RegExp) of
-	{ok, RE} -> 
-	    sub(String, RE, Rep);
-	{error, E} -> 
-	    {error, E}
-    end;
-sub(String, RE, Rep) ->
-    Ss = sub_match(String, RE, 1),
-    {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}.
-
-
-%% Substitute every match of the regular expression RegExp with 
-%% the string New in String. Accept pre-parsed regular expressions.
-
-gsub(String, RegExp, Rep) when is_list(RegExp) ->
-    case parse(RegExp) of
-	{ok, RE} -> 
-	    gsub(String, RE, Rep);
-	{error, E} -> 
-	    {error, E}
-    end;
-gsub(String, RE, Rep) ->
-    Ss = matches(String, RE, 1),
-    {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}.
-
-
-%%%========================================================================
-%%% Internal functions
-%%%========================================================================
-
-%% This is the regular expression grammar used. It is equivalent to the
-%% one used in AWK, except that we allow ^ $ to be used anywhere and fail
-%% in the matching.
-%%
-%% reg -> reg1 : '$1'.
-%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}.
-%% reg1 -> reg2 : '$1'.
-%% reg2 -> reg2 reg3 : {concat,'$1','$2'}.
-%% reg2 -> reg3 : '$1'.
-%% reg3 -> reg3 "*" : {kclosure,'$1'}.
-%% reg3 -> reg3 "+" : {pclosure,'$1'}.
-%% reg3 -> reg3 "?" : {optional,'$1'}.
-%% reg3 -> reg4 : '$1'.
-%% reg4 -> "(" reg ")" : '$2'.
-%% reg4 -> "\\" char : '$2'.
-%% reg4 -> "^" : bos.
-%% reg4 -> "$" : eos.
-%% reg4 -> "." : char.
-%% reg4 -> "[" class "]" : {char_class,char_class('$2')}
-%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')}
-%% reg4 -> "\"" chars "\"" : char_string('$2')
-%% reg4 -> char : '$1'.
-%% reg4 -> empty : epsilon.
-%%  The grammar of the current regular expressions. The actual parser
-%%  is a recursive descent implementation of the grammar.
-
-reg(S) -> reg1(S).
-
-%% reg1 -> reg2 reg1'
-%% reg1' -> "|" reg2
-%% reg1' -> empty
-
-reg1(S0) ->
-    {L,S1} = reg2(S0),
-    reg1p(S1, L).
-
-reg1p([$||S0], L) ->
-    {R,S1} = reg2(S0),
-    reg1p(S1, {'or',L,R});
-reg1p(S, L) -> {L,S}.
-
-%% reg2 -> reg3 reg2'
-%% reg2' -> reg3
-%% reg2' -> empty
-
-reg2(S0) ->
-    {L,S1} = reg3(S0),
-    reg2p(S1, L).
-
-reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) ->
-    {R,S1} = reg3([C|S0]),
-    reg2p(S1, {concat,L,R});
-reg2p(S, L) -> {L,S}.
-
-%% reg3 -> reg4 reg3'
-%% reg3' -> "*" reg3'
-%% reg3' -> "+" reg3'
-%% reg3' -> "?" reg3'
-%% reg3' -> empty
-
-reg3(S0) ->
-    {L,S1} = reg4(S0),
-    reg3p(S1, L).
-
-reg3p([$*|S], L) -> reg3p(S, {kclosure,L});
-reg3p([$+|S], L) -> reg3p(S, {pclosure,L});
-reg3p([$?|S], L) -> reg3p(S, {optional,L});
-reg3p(S, L) -> {L,S}.
-
-reg4([$(|S0]) ->
-    case reg(S0) of
-	{R,[$)|S1]} -> {R,S1};
-	{_R,_S} -> throw({error,{unterminated,"("}})
-    end;
-reg4([$\\,O1,O2,O3|S]) 
-  when ((O1 >= $0) andalso 
-	(O1 =< $7) andalso 
-	(O2 >= $0) andalso 
-	(O2 =< $7) andalso 
-	(O3 >= $0) andalso 
-	(O3 =< $7)) ->
-    {(O1*8 + O2)*8 + O3 - 73*$0,S};
-reg4([$\\,C|S]) -> 
-    {escape_char(C),S};
-reg4([$\\]) -> 
-    throw({error, {unterminated,"\\"}});
-reg4([$^|S]) -> 
-    {bos,S};
-reg4([$$|S]) -> 
-    {eos,S};
-reg4([$.|S]) -> 
-    {{comp_class,"\n"},S};
-reg4("[^" ++ S0) ->
-    case char_class(S0) of
-	{Cc,[$]|S1]} -> {{comp_class,Cc},S1};
-	{_Cc,_S} -> throw({error,{unterminated,"["}})
-    end;
-reg4([$[|S0]) ->
-    case char_class(S0) of
-	{Cc,[$]|S1]} -> {{char_class,Cc},S1};
-	{_Cc,_S1} -> throw({error,{unterminated,"["}})
-    end;
-reg4([C|S]) 
-  when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> 
-    {C, S};
-reg4([C|_S]) -> 
-    throw({error,{illegal,[C]}});
-reg4([]) -> 
-    {epsilon,[]}.
-
-escape_char($n) -> $\n;				%\n = LF
-escape_char($r) -> $\r;				%\r = CR
-escape_char($t) -> $\t;				%\t = TAB
-escape_char($v) -> $\v;				%\v = VT
-escape_char($b) -> $\b;				%\b = BS
-escape_char($f) -> $\f;				%\f = FF
-escape_char($e) -> $\e;				%\e = ESC
-escape_char($s) -> $\s;				%\s = SPACE
-escape_char($d) -> $\d;				%\d = DEL
-escape_char(C) -> C.
-
-char_class([$]|S]) -> char_class(S, [$]]);
-char_class(S) -> char_class(S, []).
-
-char($\\, [O1,O2,O3|S]) when
-  O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 ->
-    {(O1*8 + O2)*8 + O3 - 73*$0,S};
-char($\\, [C|S]) -> {escape_char(C),S};
-char(C, S) -> {C,S}.
-
-char_class([C1|S0], Cc) when C1 =/= $] ->
-    case char(C1, S0) of
-	{Cf,[$-,C2|S1]} when C2 =/= $] ->
-	    case char(C2, S1) of
-		{Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); 
-		{Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}})
-	    end;
-	{C,S1} -> char_class(S1, [C|Cc])
-    end;
-char_class(S, Cc) -> {Cc,S}.
-
-
-%% re_apply(String, StartPos, RegExp) -> re_app_res().
-%%
-%%  Apply the (parse of the) regular expression RegExp to String.  If
-%%  there is a match return the position of the remaining string and
-%%  the string if else return 'nomatch'. BestMatch specifies if we want
-%%  the longest match, or just a match.
-%%
-%%  StartPos should be the real start position as it is used to decide
-%%  if we ae at the beginning of the string.
-%%
-%%  Pass two functions to re_apply_or so it can decide, on the basis
-%%  of BestMatch, whether to just any take any match or try both to
-%%  find the longest. This is slower but saves duplicatng code.
-
-re_apply(S, St, RE) -> re_apply(RE, [], S, St).
-
-re_apply(epsilon, More, S, P) ->		%This always matches
-    re_apply_more(More, S, P);
-re_apply({'or',RE1,RE2}, More, S, P) ->
-    re_apply_or(re_apply(RE1, More, S, P),
-		re_apply(RE2, More, S, P));
-re_apply({concat,RE1,RE2}, More, S0, P) ->
-    re_apply(RE1, [RE2|More], S0, P);
-re_apply({kclosure,CE}, More, S, P) ->
-    %% Be careful with the recursion, explicitly do one call before
-    %% looping.
-    re_apply_or(re_apply_more(More, S, P),
-		re_apply(CE, [{kclosure,CE}|More], S, P));
-re_apply({pclosure,CE}, More, S, P) ->
-    re_apply(CE, [{kclosure,CE}|More], S, P);
-re_apply({optional,CE}, More, S, P) ->
-    re_apply_or(re_apply_more(More, S, P),
-		re_apply(CE, More, S, P));
-re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1);
-re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P);
-re_apply(eos, More, [], P) -> re_apply_more(More, [], P);
-re_apply({char_class,Cc}, More, [C|S], P) ->
-    case in_char_class(C, Cc) of
-	true -> re_apply_more(More, S, P+1);
-	false -> nomatch
-    end;
-re_apply({comp_class,Cc}, More, [C|S], P) ->
-    case in_char_class(C, Cc) of
-	true -> nomatch;
-	false -> re_apply_more(More, S, P+1)
-    end;
-re_apply(C, More, [C|S], P) when is_integer(C) ->
-    re_apply_more(More, S, P+1);
-re_apply(_RE, _More, _S, _P) -> nomatch.
-
-%% re_apply_more([RegExp], String, Length) -> re_app_res().
-
-re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P);
-re_apply_more([], S, P) -> {match,P,S}.
-
-%% in_char_class(Char, Class) -> bool().
-
-in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true;
-in_char_class(C, [C|_Cc]) -> true;
-in_char_class(C, [_|Cc]) -> in_char_class(C, Cc);
-in_char_class(_C, []) -> false.
-
-%% re_apply_or(Match1, Match2) -> re_app_res().
-%%  If we want the best match then choose the longest match, else just
-%%  choose one by trying sequentially.
-
-re_apply_or({match,P1,S1},   {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1};
-re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2};
-re_apply_or(nomatch, R2) -> R2;
-re_apply_or(R1, nomatch) -> R1.
-
-
-matches(S, RE, St) ->
-    case first_match(RE, S, St) of
-	{St1,0} -> 
-	    [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)];
-	{St1,L1} -> 
-	    [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)];
-	nomatch -> 
-	    []
-    end.
-
-sub_match(S, RE, St) ->
-    case first_match(RE, S, St) of
-	{St1,L1} -> [{St1,L1}];
-	nomatch -> []
-    end.
-
-sub_repl([{St,L}|Ss], Rep, S, Pos) ->
-    Rs = sub_repl(Ss, Rep, S, St+L),
-    string:substr(S, Pos, St-Pos) ++ 
-	sub_repl(Rep, string:substr(S, St, L), Rs);
-sub_repl([], _Rep, S, Pos) -> 
-    string:substr(S, Pos).
-
-sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest);
-sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)];
-sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)];
-sub_repl([], _M, Rest) -> Rest.
-
-split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []).
-
-split_apply([], _P, _RE, true, []) -> 
-    [];
-split_apply([], _P, _RE, _T, Sub) -> 
-    [lists:reverse(Sub)];
-split_apply(S, P, RE, T, Sub) ->
-    case re_apply(S, P, RE) of
-	{match,P,_Rest} ->
-	    split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]);
-	{match,P1,Rest} ->
-	    [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])];
-	nomatch ->
-	    split_apply(tl(S), P+1, RE, T, [hd(S)|Sub])
-    end.
diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl
index d0510e795b..8d282a1e9d 100644
--- a/lib/inets/src/tftp/tftp_engine.erl
+++ b/lib/inets/src/tftp/tftp_engine.erl
@@ -1153,8 +1153,8 @@ match_callback(Filename, Callbacks) ->
     end.
 
 do_match_callback(Filename, [C | Tail]) when is_record(C, callback) ->
-    case catch inets_regexp:match(Filename, C#callback.internal) of
-        {match, _, _} ->
+    case catch re:run(Filename, C#callback.internal, [{capture, none}]) of
+        match ->
             {ok, C};
         nomatch ->
             do_match_callback(Filename, Tail);
diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/inets/src/tftp/tftp_lib.erl
index 71327f8023..01dea97d07 100644
--- a/lib/inets/src/tftp/tftp_lib.erl
+++ b/lib/inets/src/tftp/tftp_lib.erl
@@ -184,7 +184,7 @@ do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) ->
         callback ->
             case Val of
                 {RegExp, Mod, State} when is_list(RegExp), is_atom(Mod) ->
-                    case inets_regexp:parse(RegExp) of
+                    case re:compile(RegExp) of
                         {ok, Internal} ->
                             Callback = #callback{regexp   = RegExp,
                                                  internal = Internal,
@@ -253,7 +253,7 @@ do_parse_config(Options, Config) when is_record(Config, config) ->
 
 add_default_callbacks(Callbacks) ->
     RegExp = "",
-    {ok, Internal} = inets_regexp:parse(RegExp),
+    {ok, Internal} = re:compile(RegExp),
     File = #callback{regexp   = RegExp,
 		     internal = Internal,
 		     module   = tftp_file,
diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl
index dd9d21bbfc..ae5fcba47b 100644
--- a/lib/inets/test/httpd_1_1.erl
+++ b/lib/inets/test/httpd_1_1.erl
@@ -361,18 +361,18 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, BodySize)
 
 
 validateMultiPartRangeRequest(Body, ValidBody, Boundary)->
-    case inets_regexp:split(Body,"--"++Boundary++"--") of
+    case re:split(Body,"--"++Boundary++"--", [{return, list}]) of
 	%%Last is the epilogue and must be ignored 
-	{ok,[First | _Last]}->
+	[First | _Last]->
 	    %%First is now the actuall http request body.
-	    case inets_regexp:split(First, "--" ++ Boundary) of
+	    case re:split(First, "--" ++ Boundary, [{return, list}]) of
 		%%Parts is now a list of ranges and the heads for each range
 		%%Gues we try to split out the body
-		{ok,Parts}->
+		Parts->
 		    case lists:flatten(lists:map(fun splitRange/1,Parts)) of
 			ValidBody->
 			    ok;
-		       ParsedBody->
+			ParsedBody->
 			    error = ParsedBody
 		    end
 	    end;
@@ -382,8 +382,8 @@ validateMultiPartRangeRequest(Body, ValidBody, Boundary)->
 
 
 splitRange(Part)->	    
-    case inets_regexp:split(Part, "\r\n\r\n") of
-	{ok,[_, Body]} ->
+    case re:split(Part, "\r\n\r\n", [{return, list}]) of
+	[_, Body] ->
 	    string:substr(Body, 1, length(Body) - 2);
 	_ ->
 	    []
@@ -403,13 +403,13 @@ getRangeSize(Head)->
 	{multiPart, BoundaryString}->
 	    {multiPart, BoundaryString};
 	_X1 ->
-	    case inets_regexp:match(Head, ?CONTENT_RANGE "bytes=.*\r\n") of
-		{match, Start, Lenght} ->
+	    case re:run(Head, ?CONTENT_RANGE "bytes=.*\r\n", [{capture, first}]) of
+		{match, [{Start, Lenght}]} ->
 		    %% Get the range data remove the fieldname and the
 		    %% end of line.
-		    RangeInfo = string:substr(Head, Start + 20, 
-					      Lenght - (20 - 2)),
-		    rangeSize(RangeInfo);
+		    RangeInfo = string:substr(Head, Start + 1 + 20, 
+					      Lenght - (20 +2)),
+		    rangeSize(string:strip(RangeInfo));
 		_X2 ->
 		    error
 	    end
@@ -445,10 +445,10 @@ num(_CharVal, false) ->
     true.
 
 controlMimeType(Head)->
-    case inets_regexp:match(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n") of
-	{match,Start,Length}->
+    case re:run(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n", [{capture, first}]) of
+	{match, [{Start,Length}]}->
 	    FieldNameLen = length(?CONTENT_TYPE "multipart/byteranges"),
-	    case clearBoundary(string:substr(Head, Start + FieldNameLen,
+	    case clearBoundary(string:substr(Head, Start + 1 + FieldNameLen,
 					     Length - (FieldNameLen+2))) of
 		error ->
 		    error;
@@ -462,10 +462,10 @@ controlMimeType(Head)->
     end.
 
 clearBoundary(Boundary)->
-    case inets_regexp:match(Boundary, "boundary=.*\$") of
-	{match, Start1, Length1}->
+    case re:run(Boundary, "boundary=.*\$", [{capture, first}]) of
+	{match, [{Start1, Length1}]}->
 	    BoundLen = length("boundary="),
-	    string:substr(Boundary, Start1 + BoundLen, Length1 - BoundLen);
+	    string:substr(Boundary, Start1 + 1 + BoundLen, Length1 - BoundLen);
 	_ ->
 	    error
     end.
@@ -480,12 +480,12 @@ end_of_header(HeaderPart) ->
     end.
 
 get_body_size(Head) ->
-    case inets_regexp:match(Head,?CONTENT_LENGTH ".*\r\n") of
- 	{match, Start, Length} ->
+    case re:run(Head,?CONTENT_LENGTH ".*\r\n", [{capture, first}]) of
+ 	{match, [{Start, Length}]} ->
  	    %% 15 is length of Content-Length, 
  	    %% 17 Is length of Content-Length and \r\
  	    S = list_to_integer(
- 		  string:strip(string:substr(Head, Start + 15, Length-17))),
+ 		  string:strip(string:substr(Head, Start +1 + 15, Length-17))),
  	    S;
  	_->
  	    0
diff --git a/lib/inets/test/httpd_poll.erl b/lib/inets/test/httpd_poll.erl
index aca7b70376..4a570fb512 100644
--- a/lib/inets/test/httpd_poll.erl
+++ b/lib/inets/test/httpd_poll.erl
@@ -259,11 +259,11 @@ validate(ExpStatusCode,Socket,Response) ->
     vtrace("validate -> Entry with ~p bytes response",[Sz]),
     Size = trash_the_rest(Socket,Sz),
     close(Socket),
-    case inets_regexp:split(Response," ") of
-	{ok,["HTTP/1.0",ExpStatusCode|_]} ->
+    case re:split(Response," ", [{return, list}]) of
+	["HTTP/1.0",ExpStatusCode|_] ->
 	    vlog("response (~p bytes) was ok",[Size]),
 	    ok;
-	{ok,["HTTP/1.0",StatusCode|_]} -> 
+	["HTTP/1.0",StatusCode|_] -> 
 	    verror("unexpected response status received: ~s => ~s",
 		   [StatusCode,status_to_message(StatusCode)]),
 	    log("unexpected result to GET of '~s': ~s => ~s",
diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl
index cb2e86c81e..8cc6f3bbd6 100644
--- a/lib/inets/test/httpd_test_lib.erl
+++ b/lib/inets/test/httpd_test_lib.erl
@@ -96,10 +96,10 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti
     try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of
 	{ok, Socket} ->
 	    ok = inets_test_lib:send(SocketType, Socket, RequestStr),
-	    State = case inets_regexp:match(RequestStr, "printenv") of
+	    State = case re:run(RequestStr, "printenv", [{capture, none}]) of
 			nomatch ->
 			    #state{};
-			_ ->
+			match ->
 			    #state{print = true}
 		    end,
 	    
@@ -311,10 +311,10 @@ do_validate(Header, [_Unknown | Rest], N, P) ->
     do_validate(Header, Rest, N, P).
 
 is_expect(RequestStr) ->
-    case inets_regexp:match(RequestStr, "xpect:100-continue") of
-	{match, _, _}->
+    case re:run(RequestStr, "xpect:100-continue", [{capture, none}]) of
+	match->
 	    true;
-	_ ->
+	nomatch ->
 	    false
     end.
 
diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl
index 7c0acb5a99..1b4d74b28e 100644
--- a/lib/inets/test/httpd_time_test.erl
+++ b/lib/inets/test/httpd_time_test.erl
@@ -386,31 +386,31 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) ->
     %% Sz = sz(Response),
     %% trash_the_rest(Socket, Sz),
     %% inets_test_lib:close(SocketType, Socket),
-    case inets_regexp:split(Response," ") of
-        {ok, ["HTTP/1.0", ExpStatusCode|_]} ->
+    case re:split(Response," ", [{return, list}]) of
+        ["HTTP/1.0", ExpStatusCode|_] ->
             ok;
-        {ok, ["HTTP/1.0", StatusCode|_]} -> 
+        ["HTTP/1.0", StatusCode|_] -> 
 	    error_msg("Unexpected status code: ~p (~s). "
 		      "Expected status code: ~p (~s)", 
 		      [StatusCode,    status_to_message(StatusCode),
 		       ExpStatusCode, status_to_message(ExpStatusCode)]),
             exit({unexpected_response_code, StatusCode, ExpStatusCode});
-	{ok, ["HTTP/1.1", ExpStatusCode|_]} ->
+	["HTTP/1.1", ExpStatusCode|_] ->
             ok;
-        {ok, ["HTTP/1.1", StatusCode|_]} -> 
+	["HTTP/1.1", StatusCode|_] -> 
 	    error_msg("Unexpected status code: ~p (~s). "
 		      "Expected status code: ~p (~s)", 
 		      [StatusCode,    status_to_message(StatusCode),
 		       ExpStatusCode, status_to_message(ExpStatusCode)]),
             exit({unexpected_response_code, StatusCode, ExpStatusCode});
-        {ok, Unexpected} -> 
-	    error_msg("Unexpected response split: ~p (~s)", 
-		      [Unexpected, Response]),
-            exit({unexpected_response, Unexpected, Response});
-        {error, Reason} -> 
+	{error, Reason} -> 
 	    error_msg("Failed processing response: ~p (~s)", 
 		      [Reason, Response]),
-            exit({failed_response_processing, Reason, Response})
+            exit({failed_response_processing, Reason, Response});
+	Unexpected ->
+	    error_msg("Unexpected response split: ~p (~s)", 
+		      [Unexpected, Response]),
+            exit({unexpected_response, Unexpected, Response})
     end.
 
 
-- 
cgit v1.2.3


From 03abb57fdcfe2e95f0f15b1bdb043d54662876c8 Mon Sep 17 00:00:00 2001
From: Ingela Anderton Andin 
Date: Thu, 28 Jan 2016 15:46:08 +0100
Subject: inets: Traverse all aliases looking for the longest match

Before the first matching alias was returned, but we want the longest one to
be returned.
---
 lib/inets/src/http_server/mod_alias.erl | 44 ++++++++++++++++++++++++---------
 1 file changed, 32 insertions(+), 12 deletions(-)

diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl
index 77045259d3..727f6e0ce3 100644
--- a/lib/inets/src/http_server/mod_alias.erl
+++ b/lib/inets/src/http_server/mod_alias.erl
@@ -113,32 +113,52 @@ real_name(ConfigDB, RequestURI, []) ->
 	httpd_util:split_path(default_index(ConfigDB, RealName)),
     {ShortPath, Path, AfterPath};
 
-real_name(ConfigDB, RequestURI, [{MP,Replacement}|Rest])
+real_name(ConfigDB, RequestURI, [{MP,Replacement}| _] = Aliases)
   when element(1, MP) =:= re_pattern ->
-    case re:run(RequestURI, MP, [{capture,[]}]) of
-	match ->
+    case longest_match(Aliases, RequestURI) of
+	{match, {MP, Replacement}} ->
 	    NewURI = re:replace(RequestURI, MP, Replacement, [{return,list}]),
 	    {ShortPath,_} = httpd_util:split_path(NewURI),
 	    {Path,AfterPath} =
 		httpd_util:split_path(default_index(ConfigDB, NewURI)),
 	    {ShortPath, Path, AfterPath};
 	nomatch ->
-	    real_name(ConfigDB, RequestURI, Rest)
+	    real_name(ConfigDB, RequestURI, [])
     end;
 
-real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) ->
-     case inets_regexp:match(RequestURI, "^" ++ FakeName) of
-	{match, _, _} ->
-	    {ok, ActualName, _} = inets_regexp:sub(RequestURI,
-					     "^" ++ FakeName, RealName),
+real_name(ConfigDB, RequestURI,  [{_,_}|_] = Aliases) ->
+    case longest_match(Aliases, RequestURI) of
+	{match, {FakeName, RealName}} ->
+	    ActualName = re:replace(RequestURI,
+				    "^" ++ FakeName, RealName, [{return,list}]),
  	    {ShortPath, _AfterPath} = httpd_util:split_path(ActualName),
 	    {Path, AfterPath} =
-	       httpd_util:split_path(default_index(ConfigDB, ActualName)),
+		httpd_util:split_path(default_index(ConfigDB, ActualName)),
 	    {ShortPath, Path, AfterPath};
-	 nomatch ->
-	     real_name(ConfigDB, RequestURI, Rest)
+	nomatch ->
+	    real_name(ConfigDB, RequestURI, [])
     end.
 
+longest_match(Aliases, RequestURI) ->
+    longest_match(Aliases, RequestURI, _LongestNo = 0, _LongestAlias = undefined).
+
+longest_match([{FakeName, RealName} | Rest], RequestURI, LongestNo, LongestAlias) ->
+    case re:run(RequestURI, "^" ++ FakeName, [{capture, first}]) of
+	{match, [{_, Length}]} ->
+	    if
+		Length > LongestNo ->
+		    longest_match(Rest, RequestURI, Length, {FakeName, RealName});
+		true ->
+		    longest_match(Rest, RequestURI, LongestNo, LongestAlias)
+	    end;
+	nomatch ->
+	    longest_match(Rest, RequestURI, LongestNo, LongestAlias)
+    end;
+longest_match([], _RequestURI, 0, _LongestAlias) ->
+    nomatch;
+longest_match([], _RequestURI, _LongestNo, LongestAlias) ->
+    {match, LongestAlias}.
+
 %% real_script_name
 
 real_script_name(_ConfigDB, _RequestURI, []) ->
-- 
cgit v1.2.3


From 042677624b1d7b3f4c99be4e1483180e7fe8b2c0 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson 
Date: Thu, 28 Jan 2016 15:09:35 +0100
Subject: erts: Fix bug concerning line information for hipe modules

Line table was left uninitialized for hipe (stub) modules
causing process_info(OtherPid, current_location) to crash.
---
 erts/emulator/beam/beam_load.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index b70e5b9a2d..a6dce2d1d2 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -6249,6 +6249,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     code[MI_LITERALS_END] = 0;
     code[MI_LITERALS_OFF_HEAP] = 0;
     code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+    code[MI_LINE_TABLE] = 0;
     code[MI_MD5_PTR] = 0;
     ci = MI_FUNCTIONS + n + 1;
 
-- 
cgit v1.2.3


From a6a766143bd5332ff0173a9a3c05e3b36d20297c Mon Sep 17 00:00:00 2001
From: Ingela Anderton Andin 
Date: Thu, 28 Jan 2016 15:49:04 +0100
Subject: inets: Prepare for release

---
 lib/inets/vsn.mk | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index a6aeedfe12..ee5f41aaec 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
 # %CopyrightEnd%
 
 APPLICATION = inets
-INETS_VSN   = 6.0.1
+INETS_VSN   = 6.1.1
 PRE_VSN     =
 APP_VSN     = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
-- 
cgit v1.2.3


From 279cb5b1bba53b93384093530ae781fcf203756b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?D=C3=A1niel=20Szoboszlay?= 
Date: Mon, 12 Oct 2015 16:24:56 +0200
Subject: Only use supported EC curves in crypto tests

Avoid hardcoding EC curve names in tests where it basically doesn't
matter which curve is used. Take one of the supported curbes instead.
Also, when testing ECDH key generation, skip unsupported curves.

These changes are to simplify dealing with exotic libcrypto builds
that don't support certain curves (for example RHEL disallows < 256
bit curves). The crypto application is only able to detect the
supported curves on a very coarse level (ECC support in general and
GF2m curves), so it may be necessary to edit the list of curves in the
crypto_ec_curves modules. But that should be the only necessary
modification to make the crypto tests pass.
---
 lib/crypto/test/crypto_SUITE.erl     | 202 +++++++++++++++++++----------------
 lib/crypto/test/old_crypto_SUITE.erl |  44 +-------
 2 files changed, 111 insertions(+), 135 deletions(-)

diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 802c8a4df4..307fc4b019 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -1901,7 +1901,7 @@ dss_params() ->
      18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669].
 
 ec_key_named() ->
-    Curve = secp112r2,
+    Curve = hd(crypto:ec_curves()),
     {D2_pub, D2_priv} = crypto:generate_key(ecdh, Curve),
     {[D2_priv, Curve], [D2_pub, Curve]}.
 
@@ -2070,88 +2070,94 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv
      SessionKey}.
 ecdh() ->
     %% http://csrc.nist.gov/groups/STM/cavp/
-    [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"),
-            hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"),
-            secp192r1,
-            hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")},
-     {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"),
-            hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"),
-            secp192r1,
-            hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")},
-     {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"),
-            hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"),
-            secp224r1,
-            hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")},
-     {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"),
-            hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"),
-            secp224r1,
-            hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")},
-     {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"),
-            hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"),
-            secp256r1,
-            hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")},
-     {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"),
-            hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"),
-            secp256r1,
-            hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")},
-     {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"),
-            hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"),
-            secp384r1,
-            hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")},
-     {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"),
-            hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"),
-            secp384r1,
-            hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")},
-     {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"),
-            hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"),
-            secp521r1,
-            hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")},
-     {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"),
-            hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"),
-            secp521r1,
-            hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")},
-
-     %% RFC-6954, Appendix A
-     {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E",
-			 "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"),
-            hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"),
-            brainpoolP224r1,
-            hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")},
-     {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B",
-			 "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"),
-            hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"),
-            brainpoolP224r1,
-            hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")},
-     {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5",
-			 "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"),
-            hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"),
-            brainpoolP256r1,
-            hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")},
-     {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B",
-			 "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"),
-            hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"),
-            brainpoolP256r1,
-            hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")},
-     {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068",
-			 "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"),
-            hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"),
-            brainpoolP384r1,
-            hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")},
-     {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4",
-			 "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"),
-            hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"),
-            brainpoolP384r1,
-            hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")},
-     {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD",
-			 "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"),
-            hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"),
-            brainpoolP512r1,
-            hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")},
-     {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F",
-			 "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"),
-            hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"),
-            brainpoolP512r1,
-            hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}].
+    Curves = crypto:ec_curves(),
+    TestCases =
+        [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"),
+          hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"),
+          secp192r1,
+          hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")},
+         {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"),
+          hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"),
+          secp192r1,
+          hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")},
+         {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"),
+          hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"),
+          secp224r1,
+          hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")},
+         {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"),
+          hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"),
+          secp224r1,
+          hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")},
+         {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"),
+          hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"),
+          secp256r1,
+          hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")},
+         {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"),
+          hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"),
+          secp256r1,
+          hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")},
+         {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"),
+          hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"),
+          secp384r1,
+          hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")},
+         {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"),
+          hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"),
+          secp384r1,
+          hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")},
+         {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"),
+          hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"),
+          secp521r1,
+          hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")},
+         {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"),
+          hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"),
+          secp521r1,
+          hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")},
+
+         %% RFC-6954, Appendix A
+         {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E",
+                             "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"),
+          hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"),
+          brainpoolP224r1,
+          hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")},
+         {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B",
+                             "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"),
+          hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"),
+          brainpoolP224r1,
+          hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")},
+         {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5",
+                             "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"),
+          hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"),
+          brainpoolP256r1,
+          hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")},
+         {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B",
+                             "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"),
+          hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"),
+          brainpoolP256r1,
+          hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")},
+         {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068",
+                             "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"),
+          hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"),
+          brainpoolP384r1,
+          hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")},
+         {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4",
+                             "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"),
+          hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"),
+          brainpoolP384r1,
+          hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")},
+         {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD",
+                             "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"),
+          hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"),
+          brainpoolP512r1,
+          hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")},
+         {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F",
+                             "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"),
+          hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"),
+          brainpoolP512r1,
+          hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}],
+    lists:filter(fun ({_Type, _Pub, _Priv, Curve, _SharedSecret}) ->
+                         lists:member(Curve, Curves)
+                 end,
+                 TestCases).
 
 dh() ->
     {dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}.
@@ -2178,18 +2184,24 @@ ecc() ->
 %% information about the curves see
 %%       http://csrc.nist.gov/encryption/dss/ecdsa/NISTReCur.pdf
 %%
-    [{ecdh,secp192r1,1,
-      hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012",
-		   "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")},
-     {ecdh,secp192r1,2,
-      hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888",
-		   "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")},
-     {ecdh,secp192r1,3,
-      hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA",
-		   "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")},
-     {ecdh,secp192r1,4,
-      hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA",
-		   "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}].
+    Curves = crypto:ec_curves(),
+    TestCases =
+        [{ecdh,secp192r1,1,
+          hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012",
+                       "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")},
+         {ecdh,secp192r1,2,
+          hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888",
+                       "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")},
+         {ecdh,secp192r1,3,
+          hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA",
+                       "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")},
+         {ecdh,secp192r1,4,
+          hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA",
+                       "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}],
+    lists:filter(fun ({_Type, Curve, _Priv, _Pub}) ->
+                         lists:member(Curve, Curves)
+                 end,
+                 TestCases).
 
 no_padding() ->
     Public = [_, Mod] = rsa_public(),
diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl
index b5894b070d..1e7f3a1438 100644
--- a/lib/crypto/test/old_crypto_SUITE.erl
+++ b/lib/crypto/test/old_crypto_SUITE.erl
@@ -1888,48 +1888,12 @@ ec(Config) when is_list(Config) ->
 
 ec_do() ->
     %% test for a name curve
-    {D2_pub, D2_priv} = crypto:generate_key(ecdh, secp112r2),
-    PrivECDH = [D2_priv, secp112r2],
-    PubECDH = [D2_pub, secp112r2],
+    NamedCurve = hd(crypto:ec_curves()),
+    {D2_pub, D2_priv} = crypto:generate_key(ecdh, NamedCurve),
+    PrivECDH = [D2_priv, NamedCurve],
+    PubECDH = [D2_pub, NamedCurve],
     %%TODO: find a published test case for a EC key
 
-    %% test for a full specified curve and public key,
-    %% taken from csca-germany_013_self_signed_cer.pem
-    PubKey = <<16#04, 16#4a, 16#94, 16#49, 16#81, 16#77, 16#9d, 16#df,
-	       16#1d, 16#a5, 16#e7, 16#c5, 16#27, 16#e2, 16#7d, 16#24,
-	       16#71, 16#a9, 16#28, 16#eb, 16#4d, 16#7b, 16#67, 16#75,
-	       16#ae, 16#09, 16#0a, 16#51, 16#45, 16#19, 16#9b, 16#d4,
-	       16#7e, 16#a0, 16#81, 16#e5, 16#5e, 16#d4, 16#a4, 16#3f,
-	       16#60, 16#7c, 16#6a, 16#50, 16#ee, 16#36, 16#41, 16#8a,
-	       16#87, 16#ff, 16#cd, 16#a6, 16#10, 16#39, 16#ca, 16#95,
-	       16#76, 16#7d, 16#ae, 16#ca, 16#c3, 16#44, 16#3f, 16#e3, 16#2c>>,
-    <> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9,
-                          16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d,
-			  16#72, 16#6e, 16#3b, 16#f6, 16#23, 16#d5, 16#26, 16#20,
-			  16#28, 16#20, 16#13, 16#48, 16#1d, 16#1f, 16#6e, 16#53, 16#77>>,
-    <> = <<16#7d, 16#5a, 16#09, 16#75, 16#fc, 16#2c, 16#30, 16#57,
-			  16#ee, 16#f6, 16#75, 16#30, 16#41, 16#7a, 16#ff, 16#e7,
-			  16#fb, 16#80, 16#55, 16#c1, 16#26, 16#dc, 16#5c, 16#6c,
-			  16#e9, 16#4a, 16#4b, 16#44, 16#f3, 16#30, 16#b5, 16#d9>>,
-    <> = <<16#26, 16#dc, 16#5c, 16#6c, 16#e9, 16#4a, 16#4b, 16#44,
-			  16#f3, 16#30, 16#b5, 16#d9, 16#bb, 16#d7, 16#7c, 16#bf,
-			  16#95, 16#84, 16#16, 16#29, 16#5c, 16#f7, 16#e1, 16#ce,
-			  16#6b, 16#cc, 16#dc, 16#18, 16#ff, 16#8c, 16#07, 16#b6>>,
-    BasePoint = <<16#04, 16#8b, 16#d2, 16#ae, 16#b9, 16#cb, 16#7e, 16#57,
-		  16#cb, 16#2c, 16#4b, 16#48, 16#2f, 16#fc, 16#81, 16#b7,
-		  16#af, 16#b9, 16#de, 16#27, 16#e1, 16#e3, 16#bd, 16#23,
-		  16#c2, 16#3a, 16#44, 16#53, 16#bd, 16#9a, 16#ce, 16#32,
-		  16#62, 16#54, 16#7e, 16#f8, 16#35, 16#c3, 16#da, 16#c4,
-		  16#fd, 16#97, 16#f8, 16#46, 16#1a, 16#14, 16#61, 16#1d,
-		  16#c9, 16#c2, 16#77, 16#45, 16#13, 16#2d, 16#ed, 16#8e,
-		  16#54, 16#5c, 16#1d, 16#54, 16#c7, 16#2f, 16#04, 16#69, 16#97>>,
-    <> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9,
-			      16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d,
-			      16#71, 16#8c, 16#39, 16#7a, 16#a3, 16#b5, 16#61, 16#a6,
-			      16#f7, 16#90, 16#1e, 16#0e, 16#82, 16#97, 16#48, 16#56, 16#a7>>,
-    CoFactor = 1,
-    Curve = {{prime_field,P},{A,B,none},BasePoint, Order,CoFactor},
-
     Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>,
     Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH),
     ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH),
-- 
cgit v1.2.3


From 62ad9fb02820b7563402702e6026d9f4213149c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?D=C3=A1niel=20Szoboszlay?= 
Date: Tue, 13 Oct 2015 14:39:35 +0200
Subject: Ensure testing ssl with supported ciphers only

There are two problematic areas: EC curve selection and
interoperability tests with OpenSSL.

The tests shouldn't assume any particular EC curve is available, but
should always check the list of curves reported by
tls_v1:ecc_curves/1.

And during interoperability tests the tests shouldn't assume that any
cipher suite supported by Erlang is also supported by OpenSSL. There
are OpenSSL packages where the command line openssl tool only supports
a subset of the ciphers available in libcrypto. The actual list of
supported cipher suites thus shall be queried from OpenSSL.
---
 lib/ssl/test/erl_make_certs.erl |  4 +++-
 lib/ssl/test/ssl_test_lib.erl   | 12 +++++++++++-
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl
index 8e909a5b74..f5cada9021 100644
--- a/lib/ssl/test/erl_make_certs.erl
+++ b/lib/ssl/test/erl_make_certs.erl
@@ -334,7 +334,9 @@ make_key(dsa, _Opts) ->
     gen_dsa2(128, 20);  %% Bytes i.e. {1024, 160}
 make_key(ec, _Opts) ->
     %% (OBS: for testing only)
-    gen_ec2(secp256k1).
+    CurveOid = hd(tls_v1:ecc_curves(0)),
+    NamedCurve = pubkey_cert_records:namedCurves(CurveOid),
+    gen_ec2(NamedCurve).
     
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% RSA key generation  (OBS: for testing only)
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 77c29668b5..afd21f0d2f 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -818,7 +818,17 @@ rsa_suites(CounterPart) ->
 		    (_) ->
 			 false
 		 end,
-		 ssl:cipher_suites()).
+                 common_ciphers(CounterPart)).
+
+common_ciphers(crypto) ->
+    ssl:cipher_suites();
+common_ciphers(openssl) ->
+    OpenSslSuites =
+        string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"),
+    [ssl:suite_definition(S)
+     || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])),
+        lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites)
+    ].
 
 rsa_non_signed_suites() ->
     lists:filter(fun({rsa, _, _}) ->
-- 
cgit v1.2.3


From 901b9703c898be4e6fd5a797a4b304bccafeee4b Mon Sep 17 00:00:00 2001
From: Luis Rascao 
Date: Sun, 13 Dec 2015 17:38:46 +0000
Subject: Check for already started beam_lib crypto server

When starting the beam_lib crypto server, don't crash
when it is already running. Some other process might
have already called it.
---
 lib/stdlib/src/beam_lib.erl | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index cbbab088f4..503a2b416f 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -931,7 +931,10 @@ call_crypto_server(Req) ->
     end.
 
 call_crypto_server_1(Req) ->
-    {ok, _} = gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []),
+    case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of
+	{ok, _} -> ok;
+	{error, {already_started, _}} -> ok
+    end,
     erlang:yield(),
     call_crypto_server(Req).
 
-- 
cgit v1.2.3


From aa62ef506163c3b56d64aa0c77350775697b5999 Mon Sep 17 00:00:00 2001
From: Rickard Green 
Date: Fri, 29 Jan 2016 11:56:18 +0100
Subject: Remove faulty asserts

---
 erts/emulator/beam/erl_gc.c | 2 --
 1 file changed, 2 deletions(-)

diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 6839c24c25..06acece471 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -729,9 +729,7 @@ erts_garbage_collect_hibernate(Process* p)
      */
     erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
     ErtsGcQuickSanityCheck(p);
-    ASSERT(p->mbuf == NULL);
     ASSERT(p->stop == p->hend);	/* Stack must be empty. */
-    ASSERT(!p->abandoned_heap);
 
     /*
      * Do it.
-- 
cgit v1.2.3


From eb75295eb95602d0930ce9070447537b7ace22df Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= 
Date: Fri, 29 Jan 2016 12:47:17 +0100
Subject: Eliminate redundant double is_function test

When tuple funs were still supported, the idiom for allowing
real funs with a certain arity but not tuple funs was:

  is_function(Fun) andalso is_function(Fun, Arity)

The reason that both tests were needed is because:

  is_function({M,F}) would return 'false'
  is_function({M,F}, Arity) would return 'true'

In 53ec991d19, is_function/2 was updated to only return 'false'
for tuples, so the call to is_function/1 can be removed.
---
 lib/stdlib/src/beam_lib.erl    |  4 +---
 lib/stdlib/src/file_sorter.erl | 22 +++++++++-------------
 lib/stdlib/src/qlc.erl         | 14 +++++++-------
 3 files changed, 17 insertions(+), 23 deletions(-)

diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 6e00401dce..46aaf84d35 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -972,9 +972,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) ->
 handle_call({crypto_key_fun, F}, {_,_} = From, S) ->
     case S#state.crypto_key_f of
 	undefined ->
-	    %% Don't allow tuple funs here. (They weren't allowed before,
-	    %% so there is no reason to allow them now.)
-	    if is_function(F), is_function(F, 1) ->
+	    if is_function(F, 1) ->
 		    {Result, Fun, Reply} = 
 			case catch F(init) of
 			    ok ->
diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl
index 47adb133b0..aed857aa77 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -305,7 +305,6 @@ options(Option) ->
 
 options([{format, Format} | L], Opts) when Format =:= binary; 
                                            Format =:= term;
-                                           is_function(Format),
                                            is_function(Format, 1) ->
     options(L, Opts#opts{format = Format});
 options([{format, binary_term} | L], Opts) ->
@@ -324,7 +323,7 @@ options([{tmpdir, Dir} | L],  Opts) ->
         FileName -> 
             options(L, Opts#opts{tmpdir = {dir, FileName}})
     end;
-options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) ->
+options([{order, Fun} | L], Opts) when is_function(Fun, 2) ->
     options(L, Opts#opts{order = Fun});
 options([{order, Order} | L], Opts) when Order =:= ascending; 
                                          Order =:= descending ->
@@ -409,7 +408,7 @@ merge_terms_fun(RFun) ->
             case RFun(read) of
                 end_of_input ->
                     eof;
-                {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) ->
+                {Objs, NRFun} when is_function(NRFun, 1) ->
                     {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W),
                     {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)};
                 Error ->
@@ -425,13 +424,12 @@ merge_bins_fun(FileName) ->
             Fun(A)
     end.
 
-wrap_output_terms(term, OutFun, _Z) when is_function(OutFun),
-                                         is_function(OutFun, 1) ->
+wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) ->
     {fun_wterms(OutFun), true};
 wrap_output_terms(term, File, Z) when File =/= undefined ->
     {file_wterms(name, File, Z++[write]), false};
 wrap_output_terms(_Format, Output, _Z) ->
-    {Output, is_function(Output) and is_function(Output, 1)}.
+    {Output, is_function(Output, 1)}.
 
 binary_term_fun() ->
     fun binary_to_term/1.
@@ -1309,8 +1307,7 @@ infun(W) ->
             {end_of_input, W1};
         {end_of_input, Value} ->
             {end_of_input, W1#w{inout_value = {value, Value}}};
-        {Objs, NFun} when is_function(NFun), 
-                          is_function(NFun, 1), 
+        {Objs, NFun} when is_function(NFun, 1),
                           is_list(Objs) ->
             {cont, W#w{in = NFun}, Objs};
         Error ->
@@ -1333,7 +1330,7 @@ outfun(A, W) ->
     try (W#w.out)(A) of
         Reply when A =:= close ->
             Reply;
-        NF when is_function(NF), is_function(NF, 1) ->
+        NF when is_function(NF, 1) ->
             W#w{out = NF};
         Error ->
             error(Error, W1)
@@ -1358,7 +1355,7 @@ is_keyposs([Bad | _]) ->
 is_keyposs(Bad) ->
     {badarg, Bad}.
 
-is_input(Fun) when is_function(Fun), is_function(Fun, 1) ->
+is_input(Fun) when is_function(Fun, 1) ->
     {true, Fun};
 is_input(Files) ->
     is_files(Files).
@@ -1378,7 +1375,7 @@ is_files([], L) ->
 is_files(Bad, _L) ->
     {badarg, Bad}.
 
-maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) ->
+maybe_output(Fun) when is_function(Fun, 1) ->
     {true, Fun};
 maybe_output(File) ->
     case read_file_info(File) of
@@ -1587,7 +1584,6 @@ fun_rterms(InFun) ->
        (read) ->
             case InFun(read) of
                 {Ts, NInFun} when is_list(Ts), 
-                                  is_function(NInFun),
                                   is_function(NInFun, 1) ->
                     {to_bin(Ts, []), fun_rterms(NInFun)};
                 Else ->
@@ -1600,7 +1596,7 @@ fun_wterms(OutFun) ->
             OutFun(close);
        (L) ->
             case OutFun(wterms_arg(L)) of
-                NOutFun when is_function(NOutFun), is_function(NOutFun, 1) ->
+                NOutFun when is_function(NOutFun, 1) ->
                     fun_wterms(NOutFun);
                 Else ->
                     Else
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index 3ba3a88038..24e64efee7 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -808,21 +808,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) ->
                 {ok, U};
             {pre_fun, U=undefined} ->
                 {ok, U};
-            {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+            {info_fun, Fun} when is_function(Fun, 1) ->
                 {ok, Fun};
-            {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+            {pre_fun, Fun} when is_function(Fun, 1) ->
                 {ok, Fun};
-            {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) ->
+            {post_fun, Fun} when is_function(Fun, 0) ->
                 {ok, Fun};
-            {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) ->
+            {lookup_fun, Fun} when is_function(Fun, 2) ->
                 {ok, Fun};
             {max_lookup, Max} when is_integer(Max), Max >= 0 ->
                 {ok, Max};
             {max_lookup, infinity} ->
                 {ok, -1};
-            {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) ->
+            {format_fun, Fun} when is_function(Fun, 1) ->
                 {ok, Fun};
-            {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) ->
+            {parent_fun, Fun} when is_function(Fun, 0) ->
                 {ok, Fun};
             {key_equality, KE='=='} ->
                 {ok, KE};
@@ -885,7 +885,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) ->
             {depth, Depth} when Depth =:= infinity;
                                 is_integer(Depth), Depth >= 0 ->
                 {ok, Depth};
-            {order, Order} when is_function(Order), is_function(Order, 2);
+            {order, Order} when is_function(Order, 2);
                                 (Order =:= ascending);
                                 (Order =:= descending) ->
                 {ok, Order};
-- 
cgit v1.2.3


From 734b6ffe3353692a5d8164a5459c1531cfb6930e Mon Sep 17 00:00:00 2001
From: Anders Svensson 
Date: Fri, 29 Jan 2016 13:39:11 +0100
Subject: Add missing appup after 17.5.6.8 merge

In commit b8c6a119.
---
 lib/diameter/src/diameter.appup.src | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index de0f324f47..ba0e79907c 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -45,6 +45,7 @@
   {"1.9.2",   [{restart_application, diameter}]},  %% 17.5.5
   {"1.9.2.1", [{restart_application, diameter}]},  %% 17.5.6.3
   {"1.9.2.2", [{restart_application, diameter}]},  %% 17.5.6.7
+  {"1.9.2.3", [{restart_application, diameter}]},  %% 17.5.6.8
   {"1.10",    [{load_module, diameter_codec},      %% 18.0
                {load_module, diameter_peer_fsm},
                {load_module, diameter_watchdog},
@@ -89,6 +90,7 @@
   {"1.9.2",   [{restart_application, diameter}]},
   {"1.9.2.1", [{restart_application, diameter}]},
   {"1.9.2.2", [{restart_application, diameter}]},
+  {"1.9.2.3", [{restart_application, diameter}]},
   {"1.10",    [{load_module, diameter_gen_relay},
                {load_module, diameter_gen_base_accounting},
                {load_module, diameter_gen_base_rfc3588},
-- 
cgit v1.2.3


From f2d65a198fcebf2fb1603ed95f4aa09007a85711 Mon Sep 17 00:00:00 2001
From: Erlang/OTP 
Date: Fri, 29 Jan 2016 15:13:44 +0100
Subject: Update release notes

---
 lib/inets/doc/src/notes.xml | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index c98ec1a9dc..44e1ea9abe 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,23 @@
     notes.xml
   
   
-  
Inets 6.1
+  
Inets 6.1.1
+
+    
Fixed Bugs and Malfunctions
+      
+        
+          

+	    mod_alias now traverses all aliases picking the longest
+	    match and not the first match.

+          

+	    Own Id: OTP-13248

+        
+      
+    

+
+

+
+
Inets 6.1
 
     
Fixed Bugs and Malfunctions
       
-- 
cgit v1.2.3


From d96471b3f404f7341279d8598dd74d92fb1a923c Mon Sep 17 00:00:00 2001
From: Erlang/OTP 
Date: Fri, 29 Jan 2016 15:13:45 +0100
Subject: Updated OTP version

---
 OTP_VERSION        | 2 +-
 otp_versions.table | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/OTP_VERSION b/OTP_VERSION
index 60ea50e403..3cac390ba4 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-18.2.2
+18.2.3
diff --git a/otp_versions.table b/otp_versions.table
index 48108ac93a..723f8fdf25 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,4 @@
+OTP-18.2.3 : inets-6.1.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
 OTP-18.2.2 : ssh-4.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
 OTP-18.2.1 : erts-7.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 :
 OTP-18.2 : asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 crypto-3.6.2 dialyzer-2.8.2 diameter-1.11.1 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2 eunit-2.2.12 hipe-3.14 inets-6.1 jinterface-1.6.1 kernel-4.1.1 observer-2.1.1 parsetools-2.1.1 public_key-1.1 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 wx-1.6 xmerl-1.3.9 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 debugger-4.1.1 edoc-0.7.17 eldap-1.2 et-1.5.1 gs-1.6 ic-4.4 megaco-3.18 mnesia-4.13.2 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 webtool-0.9 :
-- 
cgit v1.2.3


From 9bd516dd7e3950f80768030b0e975be4bb1b1648 Mon Sep 17 00:00:00 2001
From: Richard Jones 
Date: Tue, 1 Sep 2015 16:41:03 +0100
Subject: Fix noproc crash during release installation

When release_handler_1:get_supervised_procs/0 does a recursive walk of
the supervision tree, it calls sys:get_status/1 on supervisors, to check
if they are suspended or running.

This fixes a race condition where a list of supervisor pids is gathered,
one of them (legitimately) exits before release_handler can examine it,
then sys:get_status/1 is called with a dead pid, causing an exit(noproc)

See: http://erlang.org/pipermail/erlang-questions/2015-August/085712.html

(To recreate this problem for testing, I added a timer:sleep into the
release_handler_1 code, and killed a supervisor during
get_supervised_procs being called).
---
 lib/sasl/src/release_handler_1.erl | 67 +++++++++++++++++++++++++-------------
 1 file changed, 44 insertions(+), 23 deletions(-)

diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl
index 536ac924d4..5e9a35ab4c 100644
--- a/lib/sasl/src/release_handler_1.erl
+++ b/lib/sasl/src/release_handler_1.erl
@@ -587,12 +587,12 @@ get_supervised_procs() ->
       get_application_names()).
 
 get_supervised_procs(_, Root, Procs, {ok, SupMod}) ->
-    get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++
+    get_procs(maybe_supervisor_which_children(Root, SupMod, Root), Root) ++
         [{undefined, undefined, Root, [SupMod]} |  Procs];
 get_supervised_procs(Application, Root, Procs, {error, _}) ->
     error_logger:error_msg("release_handler: cannot find top supervisor for "
                            "application ~w~n", [Application]),
-    get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs.
+    get_procs(maybe_supervisor_which_children(Root, Application, Root), Root) ++ Procs.
 
 get_application_names() ->
     lists:map(fun({Application, _Name, _Vsn}) ->
@@ -613,33 +613,54 @@ get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods)
     [{Sup, Name, Pid, Mods} | get_procs(T, Sup)];
 get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) ->
     [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++
-        get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid);
+        get_procs(maybe_supervisor_which_children(Pid, Name, Pid), Pid);
 get_procs([_H | T], Sup) ->
     get_procs(T, Sup);
 get_procs(_, _Sup) ->
     [].
 
+maybe_supervisor_which_children(Proc, Name, Pid) ->
+    case get_proc_state(Proc) of
+        noproc ->
+            %% process exited before we could interrogate it.
+            %% not necessarily a bug, but reporting a warning as a curiosity.
+            error_logger:warning_msg("release_handler: a process (~p) exited"
+                                     " during supervision tree interrogation."
+                                     " Continuing ...~n", [Proc]),
+            [];
+
+        suspended ->
+            error_logger:error_msg("release_handler: a which_children call"
+                                   " to ~p (~w) was avoided. This supervisor"
+                                   " is suspended and should likely be upgraded"
+                                   " differently. Exiting ...~n", [Name, Pid]),
+            error(suspended_supervisor);
+
+        running ->
+            case catch supervisor:which_children(Pid) of
+                Res when is_list(Res) ->
+                    Res;
+                Other ->
+                    error_logger:error_msg("release_handler: ~p~nerror during"
+                                           " a which_children call to ~p (~w)."
+                                           " [State: running] Exiting ... ~n",
+                                           [Other, Name, Pid]),
+                    error(which_children_failed)
+            end
+    end.
+
 get_proc_state(Proc) ->
-    {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc),
-    State.
-
-maybe_supervisor_which_children(suspended, Name, Pid) ->
-    error_logger:error_msg("release_handler: a which_children call"
-                           " to ~p (~w) was avoided. This supervisor"
-                           " is suspended and should likely be upgraded"
-                           " differently. Exiting ...~n", [Name, Pid]),
-    error(suspended_supervisor);
-
-maybe_supervisor_which_children(State, Name, Pid) ->
-    case catch supervisor:which_children(Pid) of
-        Res when is_list(Res) ->
-            Res;
-        Other ->
-            error_logger:error_msg("release_handler: ~p~nerror during"
-                                   " a which_children call to ~p (~w)."
-                                   " [State: ~p] Exiting ... ~n",
-                                   [Other, Name, Pid, State]),
-            error(which_children_failed)
+    %% sys:send_system_msg can exit with {noproc, {m,f,a}}.
+    %% This happens if a supervisor exits after which_children has provided
+    %% its pid for interrogation.
+    %% ie. Proc may no longer be running at this point.
+    try sys:get_status(Proc) of
+        %% as per sys:get_status/1, SysState can only be running | suspended.
+        {status, _, {module, _}, [_, State, _, _, _]} when State == running ;
+                                                           State == suspended ->
+            State
+    catch exit:{noproc, {sys, get_status, [Proc]}} ->
+        noproc
     end.
 
 maybe_get_dynamic_mods(Name, Pid) ->
-- 
cgit v1.2.3


From 18955a72ddf9190f9850cb6b143fd39ff8ab6168 Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:11:15 +0100
Subject: hipe_x86_signal: cleanups

- remove glibc < 2.3 code
- move glibc-2.2 comment to glibc >= 2.3 block
- remove obsolete "only supports" comment
- remove support for broken sigaltstack() in pre-2.4 Linux kernels
---
 erts/emulator/hipe/hipe_x86_signal.c | 80 +++---------------------------------
 1 file changed, 6 insertions(+), 74 deletions(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index b7dae88417..6887bdacbc 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -38,9 +38,6 @@
  *
  * Our solution is to override the C library's signal handler setup
  * procedure with our own which enforces the SA_ONSTACK flag.
- *
- * XXX: This code only supports Linux with glibc-2.1 or above,
- * and Solaris 8.
  */
 #ifdef HAVE_CONFIG_H
 #include "config.h"
@@ -55,27 +52,6 @@
 #include "hipe_signal.h"
 
 #if __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3)
-/* See comment below for glibc 2.2. */
-#ifndef __USE_GNU
-#define __USE_GNU		/* to un-hide RTLD_NEXT */
-#endif
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION __sigaction
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym");
-    abort();
-}
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
-#endif	/* glibc 2.3 */
-
-#if __GLIBC__ == 2 && (__GLIBC_MINOR__ == 2 /*|| __GLIBC_MINOR__ == 3*/)
 /*
  * __libc_sigaction() is the core routine.
  * Without libpthread, sigaction() and __sigaction() are both aliases
@@ -100,16 +76,14 @@ static void do_init(void)
  * old BSD or SysV interfaces.
  * glibc's internal calls to __sigaction() appear to be mostly safe.
  * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.92 on RedHat 7.0, glibc-2.2.2 on RedHat 7.1,
- * glibc-2.2.4 on RedHat 7.2, and glibc-2.2.5 on RedHat 7.3.
  */
-#if 0
-/* works with 2.2.5 and 2.2.4, but not 2.2.2 or 2.1.92 */
+#ifndef __USE_GNU
 #define __USE_GNU		/* to un-hide RTLD_NEXT */
+#endif
 #include 
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
+extern int __sigaction(int, const struct sigaction*, struct sigaction*);
 #define __SIGACTION __sigaction
 static void do_init(void)
 {
@@ -120,45 +94,7 @@ static void do_init(void)
     abort();
 }
 #define INIT()	do { if (!init_done()) do_init(); } while (0)
-#else
-/* semi-works with all 2.2 versions so far */
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __next_sigaction __sigaction	/* pthreads-aware version */
-#undef __SIGACTION	/* we can't override __sigaction() */
-#define INIT()		do{}while(0)
-#endif
-#endif	/* glibc 2.2 */
-
-#if __GLIBC__ == 2 && __GLIBC_MINOR__ == 1
-/*
- * __sigaction() is the core routine.
- * Without libpthread, sigaction() is an alias for __sigaction().
- * libpthread redefines sigaction() as a non-trivial wrapper around
- * __sigaction().
- * glibc has internal calls to both sigaction() and __sigaction().
- *
- * Overriding __sigaction() would be ideal, but doing so breaks
- * libpthread (threads hang). Instead we override sigaction() and
- * use dlsym RTLD_NEXT to find glibc's version of sigaction().
- * glibc's internal calls to __sigaction() appear to be mostly safe.
- * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.3 on RedHat 6.2.
- */
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
-#undef __SIGACTION
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym");
-    abort();
-}
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
-#endif	/* glibc 2.1 */
+#endif	/* glibc >= 2.3 */
 
 /* Is there no standard identifier for Darwin/MacOSX ? */
 #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
@@ -339,12 +275,8 @@ static void hipe_sigaltstack(void *ss_sp)
     ss.ss_flags = SS_ONSTACK;
     ss.ss_size = SIGSTKSZ;
     if (sigaltstack(&ss, NULL) < 0) {
-	/* might be a broken pre-2.4 Linux kernel, try harder */
-	ss.ss_flags = 0;
-	if (sigaltstack(&ss, NULL) < 0) {
-	    perror("sigaltstack");
-	    abort();
-	}
+	perror("sigaltstack");
+	abort();
     }
 }
 
-- 
cgit v1.2.3


From 050480b2326ea3583231a0de02fb087bf51db82a Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:13:21 +0100
Subject: hipe_x86_signal: cleanups

- add block for NetBSD, define dummy INIT() macro
- eliminate ifndef NetBSD around INIT() invocation
---
 erts/emulator/hipe/hipe_x86_signal.c | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index 6887bdacbc..741f570c50 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -192,6 +192,15 @@ static void do_init(void)
 #define INIT()	do { if (!init_done()) do_init(); } while (0)
 #endif /* __FreeBSD__ */
 
+#if defined(__NetBSD__)
+/*
+ * Note: This is only stub code to allow the build to succeed.
+ * Whether this actually provides the needed overrides for safe
+ * signal delivery or not is unknown.
+ */
+#define INIT()	do { } while (0)
+#endif /* __NetBSD__ */
+
 #if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__))
 /*
  * Unknown libc -- assume musl.  Note: musl deliberately does not provide a musl-specific
@@ -243,6 +252,7 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio
     return __next_sigaction(signum, act, oldact);
 }
 #endif
+
 /*
  * This overrides the C library's core sigaction() procedure, catching
  * all its internal calls.
@@ -313,9 +323,7 @@ void hipe_signal_init(void)
     struct sigaction sa;
     int i;
 
-#ifndef __NetBSD__
     INIT();
-#endif
 
     hipe_sigaltstack_init();
 
-- 
cgit v1.2.3


From 97ea79864fc9d55fa3679597d4c2dbe8e518e06a Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:14:09 +0100
Subject: hipe_x86_signal: cleanups

- rename __SIGACTION to LIBC_SIGACTION, to avoid defining _-prefixed symbols
---
 erts/emulator/hipe/hipe_x86_signal.c | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index 741f570c50..6bb442490e 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -84,7 +84,7 @@
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
 extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION __sigaction
+#define LIBC_SIGACTION __sigaction
 static void do_init(void)
 {
     __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
@@ -121,7 +121,7 @@ static void do_init(void)
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
 extern int _sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION _sigaction
+#define LIBC_SIGACTION _sigaction
 static void do_init(void)
 {
     __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
@@ -157,7 +157,7 @@ static void do_init(void)
 #include 
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
-#define __SIGACTION _sigaction
+#define LIBC_SIGACTION _sigaction
 static void do_init(void)
 {
     __next_sigaction = dlsym(RTLD_NEXT, "_sigaction");
@@ -179,7 +179,7 @@ static void do_init(void)
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
 extern int _sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION _sigaction
+#define LIBC_SIGACTION _sigaction
 static void do_init(void)
 {
     __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
@@ -213,7 +213,7 @@ static void do_init(void)
 #include 
 static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
 #define init_done()	(__next_sigaction != 0)
-#define __SIGACTION __libc_sigaction
+#define LIBC_SIGACTION __libc_sigaction
 static void do_init(void)
 {
     __next_sigaction = dlsym(RTLD_NEXT, "__libc_sigaction");
@@ -257,8 +257,8 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio
  * This overrides the C library's core sigaction() procedure, catching
  * all its internal calls.
  */
-#ifdef __SIGACTION
-int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact)
+#if defined(LIBC_SIGACTION)
+int LIBC_SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact)
 {
     return my_sigaction(signum, act, oldact);
 }
-- 
cgit v1.2.3


From 202c3dac37587e468b4c968a392c0b97668dda7e Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:15:00 +0100
Subject: hipe_x86_signal: cleanups

- rename __next_sigaction to next_sigaction, to avoid defining _-prefixed symbols
- factor out common code for declaring and initializing next_sigaction,
  system-specific code now only needs to #define NEXT_SIGACTION
---
 erts/emulator/hipe/hipe_x86_signal.c | 89 +++++++++++-------------------------
 1 file changed, 27 insertions(+), 62 deletions(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index 6bb442490e..2e7e64eae3 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -80,20 +80,9 @@
 #ifndef __USE_GNU
 #define __USE_GNU		/* to un-hide RTLD_NEXT */
 #endif
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
+#define NEXT_SIGACTION "__sigaction"
 extern int __sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION __sigaction
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym");
-    abort();
-}
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
 #endif	/* glibc >= 2.3 */
 
 /* Is there no standard identifier for Darwin/MacOSX ? */
@@ -117,21 +106,10 @@ static void do_init(void)
  * The other _sigaction, _sigaction_no_bind I don't understand the purpose
  * of and don't modify.
  */
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
+#define NEXT_SIGACTION "sigaction"
 extern int _sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION _sigaction
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym_darwin");
-    abort();
-}
 #define _NSIG NSIG
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
 #endif /* __DARWIN__ */
 
 #if defined(__sun__)
@@ -154,20 +132,9 @@ static void do_init(void)
  * our init routine has had a chance to find _sigaction()'s address.
  * This forces us to initialise at the first call.
  */
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
+#define NEXT_SIGACTION "_sigaction"
 #define LIBC_SIGACTION _sigaction
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "_sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym");
-    abort();
-}
 #define _NSIG NSIG
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
 #endif /* __sun__ */
 
 #if defined(__FreeBSD__)
@@ -175,21 +142,10 @@ static void do_init(void)
  * This is a copy of Darwin code for FreeBSD.
  * CAVEAT: detailed semantics are not verified yet.
  */
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
+#define NEXT_SIGACTION "sigaction"
 extern int _sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION _sigaction
-static void do_init(void)
-{
-    __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
-    if (__next_sigaction != 0)
-	return;
-    perror("dlsym_freebsd");
-    abort();
-}
 #define _NSIG NSIG
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
 #endif /* __FreeBSD__ */
 
 #if defined(__NetBSD__)
@@ -198,7 +154,7 @@ static void do_init(void)
  * Whether this actually provides the needed overrides for safe
  * signal delivery or not is unknown.
  */
-#define INIT()	do { } while (0)
+#undef NEXT_SIGACTION
 #endif /* __NetBSD__ */
 
 #if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__))
@@ -210,30 +166,39 @@ static void do_init(void)
  * There are libc-internal calls to __libc_sigaction which install handlers, so we must
  * override __libc_sigaction rather than __sigaction.
  */
-#include 
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done()	(__next_sigaction != 0)
+#define NEXT_SIGACTION "__libc_sigaction"
 #define LIBC_SIGACTION __libc_sigaction
+#ifndef _NSIG
+#define _NSIG NSIG
+#endif
+#endif	/* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */
+
+#if defined(NEXT_SIGACTION)
+/*
+ * Initialize a function pointer to the libc core sigaction routine,
+ * to be used by our wrappers.
+ */
+#include 
+static int (*next_sigaction)(int, const struct sigaction*, struct sigaction*);
 static void do_init(void)
 {
-    __next_sigaction = dlsym(RTLD_NEXT, "__libc_sigaction");
-    if (__next_sigaction != 0)
+    next_sigaction = dlsym(RTLD_NEXT, NEXT_SIGACTION);
+    if (next_sigaction != 0)
 	return;
     perror("dlsym");
     abort();
 }
-#ifndef _NSIG
-#define _NSIG NSIG
-#endif
-#define INIT()	do { if (!init_done()) do_init(); } while (0)
-#endif	/* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */
+#define INIT()	do { if (!next_sigaction) do_init(); } while (0)
+#else	/* !defined(NEXT_SIGACTION) */
+#define INIT()	do { } while (0)
+#endif	/* !defined(NEXT_SIGACTION) */
 
-#if !defined(__NetBSD__)
+#if defined(NEXT_SIGACTION)
 /*
  * This is our wrapper for sigaction(). sigaction() can be called before
  * hipe_signal_init() has been executed, especially when threads support
  * has been linked with the executable. Therefore, we must initialise
- * __next_sigaction() dynamically, the first time it's needed.
+ * next_sigaction() dynamically, the first time it's needed.
  */
 static int my_sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
 {
@@ -249,7 +214,7 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio
 	newact.sa_flags |= SA_ONSTACK;
 	act = &newact;
     }
-    return __next_sigaction(signum, act, oldact);
+    return next_sigaction(signum, act, oldact);
 }
 #endif
 
-- 
cgit v1.2.3


From 2d86df7cf1c5645fa80ef091b1f9a39ce44f764d Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:15:40 +0100
Subject: hipe_x86_signal: cleanups

- move extern declarations of LIBC_SIGACTION() from system-specific
  blocks to the common LIBC_SIGACTION block
---
 erts/emulator/hipe/hipe_x86_signal.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index 2e7e64eae3..b44899401b 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -81,7 +81,6 @@
 #define __USE_GNU		/* to un-hide RTLD_NEXT */
 #endif
 #define NEXT_SIGACTION "__sigaction"
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION __sigaction
 #endif	/* glibc >= 2.3 */
 
@@ -107,7 +106,6 @@ extern int __sigaction(int, const struct sigaction*, struct sigaction*);
  * of and don't modify.
  */
 #define NEXT_SIGACTION "sigaction"
-extern int _sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION _sigaction
 #define _NSIG NSIG
 #endif /* __DARWIN__ */
@@ -143,7 +141,6 @@ extern int _sigaction(int, const struct sigaction*, struct sigaction*);
  * CAVEAT: detailed semantics are not verified yet.
  */
 #define NEXT_SIGACTION "sigaction"
-extern int _sigaction(int, const struct sigaction*, struct sigaction*);
 #define LIBC_SIGACTION _sigaction
 #define _NSIG NSIG
 #endif /* __FreeBSD__ */
@@ -218,11 +215,12 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio
 }
 #endif
 
+#if defined(LIBC_SIGACTION)
 /*
  * This overrides the C library's core sigaction() procedure, catching
  * all its internal calls.
  */
-#if defined(LIBC_SIGACTION)
+extern int LIBC_SIGACTION(int, const struct sigaction*, struct sigaction*);
 int LIBC_SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact)
 {
     return my_sigaction(signum, act, oldact);
-- 
cgit v1.2.3


From 6823fb17e3cd9429f9e562d3e2e096bc1bb3ebe7 Mon Sep 17 00:00:00 2001
From: Mikael Pettersson 
Date: Sun, 31 Jan 2016 15:16:31 +0100
Subject: hipe_x86_signal: cleanups

- replace system-specific #ifndef around sigaction() override with a test
  for OVERRIDE_SIGACTION, #define or #undef that as appropriate in each
  system-specific block
---
 erts/emulator/hipe/hipe_x86_signal.c | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index b44899401b..10a40ce901 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -82,6 +82,7 @@
 #endif
 #define NEXT_SIGACTION "__sigaction"
 #define LIBC_SIGACTION __sigaction
+#define OVERRIDE_SIGACTION
 #endif	/* glibc >= 2.3 */
 
 /* Is there no standard identifier for Darwin/MacOSX ? */
@@ -107,6 +108,7 @@
  */
 #define NEXT_SIGACTION "sigaction"
 #define LIBC_SIGACTION _sigaction
+#undef OVERRIDE_SIGACTION
 #define _NSIG NSIG
 #endif /* __DARWIN__ */
 
@@ -132,6 +134,7 @@
  */
 #define NEXT_SIGACTION "_sigaction"
 #define LIBC_SIGACTION _sigaction
+#define OVERRIDE_SIGACTION
 #define _NSIG NSIG
 #endif /* __sun__ */
 
@@ -142,6 +145,7 @@
  */
 #define NEXT_SIGACTION "sigaction"
 #define LIBC_SIGACTION _sigaction
+#undef OVERRIDE_SIGACTION
 #define _NSIG NSIG
 #endif /* __FreeBSD__ */
 
@@ -152,6 +156,7 @@
  * signal delivery or not is unknown.
  */
 #undef NEXT_SIGACTION
+#undef OVERRIDE_SIGACTION
 #endif /* __NetBSD__ */
 
 #if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__))
@@ -165,6 +170,7 @@
  */
 #define NEXT_SIGACTION "__libc_sigaction"
 #define LIBC_SIGACTION __libc_sigaction
+#define OVERRIDE_SIGACTION
 #ifndef _NSIG
 #define _NSIG NSIG
 #endif
@@ -227,10 +233,10 @@ int LIBC_SIGACTION(int signum, const struct sigaction *act, struct sigaction *ol
 }
 #endif
 
+#if defined(OVERRIDE_SIGACTION)
 /*
  * This catches the application's own sigaction() calls.
  */
-#if !defined(__DARWIN__) && !defined(__NetBSD__) && !defined(__FreeBSD__)
 int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
 {
     return my_sigaction(signum, act, oldact);
-- 
cgit v1.2.3


From 6b2b36f3ef1a6715b971b81c03edf534a64c6c55 Mon Sep 17 00:00:00 2001
From: Stavros Aronis 
Date: Mon, 23 Nov 2015 15:00:22 +0100
Subject: dialyzer: Remove t_parameterized_module/0 from erl_types

Parameterized modules are no longer supported, so module() can only be
an atom().
---
 .../test/behaviour_SUITE_data/results/supervisor_incorrect_return | 2 +-
 lib/dialyzer/test/opaque_SUITE_data/results/simple                | 4 ++--
 lib/dialyzer/test/r9c_SUITE_data/results/mnesia                   | 2 +-
 lib/dialyzer/test/small_SUITE_data/results/app_call               | 2 +-
 lib/dialyzer/test/small_SUITE_data/results/maps1                  | 2 +-
 lib/hipe/cerl/erl_types.erl                                       | 8 +-------
 6 files changed, 7 insertions(+), 13 deletions(-)

diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
index 4103a2d8b4..89eb295604 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
@@ -1,2 +1,2 @@
 
-supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour
+supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple
index 5f58f69730..391c37664e 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/simple
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple
@@ -70,8 +70,8 @@ simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness
 simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a()
 simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
 simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i()
-simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i()
-simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i()
+simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
+simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i()
 simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments
 simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument
 simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument
diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
index 220b18ca7a..bf67447ee7 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
+++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia
@@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | '
 mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'}
 mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_}
 mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed
-mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom() | tuple(),_}} | {'ok',_}
+mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom(),_}} | {'ok',_}
 mnesia_tm.erl:1522: Function commit_participant/5 has no local return
 mnesia_tm.erl:2169: Function system_terminate/4 has no local return
diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call
index cc1a63f944..1af649815a 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/app_call
+++ b/lib/dialyzer/test/small_SUITE_data/results/app_call
@@ -1,3 +1,3 @@
 
-app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42
+app_call.erl:6: The call M:'foo'() requires that M is of type atom() not 42
 app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]}
diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1
index 5a78d66a92..e88c91f21f 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/maps1
+++ b/lib/dialyzer/test/small_SUITE_data/results/maps1
@@ -1,4 +1,4 @@
 
 maps1.erl:43: Function t3/0 has no local return
 maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b')
-maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() | tuple() not #{}
+maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{}
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 14b4ba215e..fae12d7421 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -172,7 +172,6 @@
 	 t_number_vals/1, t_number_vals/2,
 	 t_opaque_from_records/1,
 	 t_opaque_structure/1,
-	 %% t_parameterized_module/0,
 	 t_pid/0,
 	 t_port/0,
 	 t_maybe_improper_list/0,
@@ -1785,7 +1784,7 @@ t_mfa() ->
 -spec t_module() -> erl_type().
 
 t_module() ->
-  t_sup(t_atom(), t_parameterized_module()).
+  t_atom().
 
 -spec t_node() -> erl_type().
 
@@ -1811,11 +1810,6 @@ t_iolist(N, T) when N > 0 ->
 t_iolist(0, T) ->
   t_maybe_improper_list(t_any(), t_sup(T, t_nil())).
 
--spec t_parameterized_module() -> erl_type().
-
-t_parameterized_module() ->
-  t_tuple().
-
 -spec t_timeout() -> erl_type().
 
 t_timeout() ->
-- 
cgit v1.2.3


From d76ee58c07f32dfc0652844ec2b513af2105ffa1 Mon Sep 17 00:00:00 2001
From: Lukas Larsson 
Date: Wed, 22 Oct 2014 17:15:31 +0200
Subject: erts: Add ERTS_WRITE_UNLIKELY

ERTS_WRITE_UNLIKELY can be used to place global variables in
a specific section where only data that is very rarely modified
sits. This is used to improve cache locality.
---
 erts/emulator/beam/erl_alloc.c   |  4 ++--
 erts/emulator/beam/erl_process.c | 24 ++++++++++++------------
 erts/emulator/beam/sys.h         | 11 +++++++++++
 3 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 5544712e8d..51b522c9e0 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -103,9 +103,9 @@ static Uint install_debug_functions(void);
 
 static int lock_all_physical_memory = 0;
 
-ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1];
+ErtsAllocatorFunctions_t ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]);
 ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1];
-ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1];
+ErtsAllocatorThrSpec_t ERTS_WRITE_UNLIKELY(erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]);
 
 #define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B))
 #define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B))
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 7d194f9840..3902632ef8 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -148,14 +148,14 @@ extern BeamInstr beam_apply[];
 extern BeamInstr beam_exit[];
 extern BeamInstr beam_continue_exit[];
 
-int erts_default_spo_flags = 0;
-int erts_eager_check_io = 1;
-int erts_sched_compact_load;
-int erts_sched_balance_util = 0;
-Uint erts_no_schedulers;
+int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = 0;
+int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1;
+int ERTS_WRITE_UNLIKELY(erts_sched_compact_load);
+int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0;
+Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers);
 #ifdef ERTS_DIRTY_SCHEDULERS
-Uint erts_no_dirty_cpu_schedulers;
-Uint erts_no_dirty_io_schedulers;
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers);
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers);
 #endif
 
 static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0};
@@ -295,7 +295,7 @@ do {							\
 erts_sched_stat_t erts_sched_stat;
 
 #ifdef USE_THREADS
-static erts_tsd_key_t sched_data_key;
+static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key);
 #endif
 
 static erts_smp_atomic32_t function_calls;
@@ -335,10 +335,10 @@ static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info;
 
 static Uint last_reductions;
 static Uint last_exact_reductions;
-Eterm erts_system_monitor;
-Eterm erts_system_monitor_long_gc;
-Uint erts_system_monitor_long_schedule;
-Eterm erts_system_monitor_large_heap;
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor);
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc);
+Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule);
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap);
 struct erts_system_monitor_flags_t erts_system_monitor_flags;
 
 /* system performance monitor */
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 279e4db0af..e77b4b2dc8 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -136,6 +136,17 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
 #  define ERTS_LIKELY(BOOL)   (BOOL)
 #  define ERTS_UNLIKELY(BOOL) (BOOL)
 #endif
+
+#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
+#ifndef __llvm__
+#  define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") ))
+#else
+#  define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") ))
+#endif
+#else
+#  define ERTS_WRITE_UNLIKELY(X) X
+#endif
+
 #ifdef __GNUC__
 #  if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
 #    define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
-- 
cgit v1.2.3


From eea5f896780e07f7ca76685061d01e7be5a7abaa Mon Sep 17 00:00:00 2001
From: Lukas Larsson 
Date: Thu, 11 Sep 2014 18:26:26 +0200
Subject: erts, kernel: Add os:perf_counter function

The perf_counter is a very very cheap and high resolution timer
that can be used to timestamp system events. It does not have
monoticity guarantees, but should on most OS's expose a monotonous
time.

A special instruction has been created for this counter to further
speed up fetching it.

OTP-12908
---
 erts/doc/src/erlang.xml               | 11 +++++
 erts/emulator/beam/beam_emu.c         | 32 +++++++++++++++
 erts/emulator/beam/bif.tab            |  2 +
 erts/emulator/beam/erl_time.h         |  2 +
 erts/emulator/beam/erl_time_sup.c     | 76 ++++++++++++++++++++++++++++++++++-
 erts/emulator/beam/ops.tab            |  9 +++++
 erts/emulator/sys/unix/erl_unix_sys.h | 30 +++++++++++++-
 erts/emulator/sys/unix/sys_time.c     |  2 +
 erts/emulator/sys/win32/erl_win_sys.h |  2 +
 erts/preloaded/src/erlang.erl         |  5 ++-
 erts/preloaded/src/erts_internal.erl  |  7 +++-
 lib/kernel/doc/src/os.xml             | 25 ++++++++++++
 lib/kernel/src/os.erl                 | 16 +++++++-
 lib/kernel/test/os_SUITE.erl          | 46 +++++++++++++++++++--
 14 files changed, 256 insertions(+), 9 deletions(-)

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index d0d35ea25f..6915b35fcb 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -131,6 +131,17 @@
 	  
 	  
 
+	  perf_counter
+	  
Symbolic representation of the performance counter
+          time unit used by the Erlang runtime system.

+
+          
The perf_counter time unit behaves much in the same way
+          as the native time unit. That is it might differ inbetween
+          run-time restarts. You get values of this type by calling
+          os:perf_counter()
+          

+          
+
 	
 
 	
The time_unit/0 type may be extended. Use
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 4d7b00b032..a0979c7b0e 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -4895,6 +4895,38 @@ do {						\
      }
  }
 
+ /* This is optimised as an instruction because
+    it has to be very very fast */
+ OpCase(i_perf_counter): {
+    BeamInstr* next;
+    ErtsSysHrTime ts;
+    PreFetch(0, next);
+
+    sys_perf_counter(&ts);
+
+    if (IS_SSMALL(ts)) {
+        r(0) = make_small((Sint)ts);
+    } else {
+        TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0);
+        r(0) = make_big(HTOP);
+#if defined(ARCH_32) || HALFWORD_HEAP
+        if (ts >= (((Uint64) 1) << 32)) {
+            *HTOP = make_pos_bignum_header(2);
+            BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff));
+            BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff));
+            HTOP += 3;
+        }
+        else
+#endif
+        {
+                *HTOP = make_pos_bignum_header(1);
+                BIG_DIGIT(HTOP, 0) = (Uint) ts;
+                HTOP += 2;
+        }
+    }
+    NextPF(0, next);
+ }
+
  OpCase(i_debug_breakpoint): {
      HEAVY_SWAPOUT;
      I = call_error_handler(c_p, I-3, reg, am_breakpoint);
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 1b8ae8cef5..4efc055aaf 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -170,6 +170,7 @@ bif erts_internal:term_type/1
 bif erts_internal:map_hashmap_children/1
 
 bif erts_internal:time_unit/0
+bif erts_internal:perf_counter_unit/0
 
 bif erts_internal:is_system_process/1
 
@@ -369,6 +370,7 @@ bif os:getpid/0
 bif os:timestamp/0
 bif os:system_time/0
 bif os:system_time/1
+bif os:perf_counter/0
 
 #
 # Bifs in the erl_ddll module (the module actually does not exist)
diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h
index 93a0d556bf..446adcf4af 100644
--- a/erts/emulator/beam/erl_time.h
+++ b/erts/emulator/beam/erl_time.h
@@ -142,6 +142,8 @@ erts_time_unit_conversion(Uint64 value,
 			  Uint32 from_time_unit,
 			  Uint32 to_time_unit);
 
+ErtsSysHrTime erts_perf_counter_unit(void);
+
 #if ERTS_GLB_INLINE_INCL_FUNC_DEF
 
 ERTS_GLB_INLINE Uint64
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 668dbb5daa..6509c6a805 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1749,7 +1749,7 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp)
 {
     ErtsMonotonicTime mtime = time_sup.r.o.get_time();
     update_last_mtime(esdp, mtime);
-    return mtime;    
+    return mtime;
 }
 
 ErtsMonotonicTime
@@ -2435,9 +2435,81 @@ BIF_RETTYPE os_system_time_0(BIF_ALIST_0)
     BIF_RET(make_time_val(BIF_P, stime));
 }
 
-BIF_RETTYPE os_system_time_1(BIF_ALIST_0)
+BIF_RETTYPE os_system_time_1(BIF_ALIST_1)
 {
     ErtsSystemTime stime = erts_os_system_time();
     BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0));
 }
 
+BIF_RETTYPE
+os_perf_counter_0(BIF_ALIST_0)
+{
+    ErtsSysHrTime pcounter;
+    sys_perf_counter(&pcounter);
+    BIF_RET(make_time_val(BIF_P, pcounter));
+}
+
+BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0)
+{
+    BIF_RET(make_time_val(BIF_P, SYS_PERF_COUNTER_UNIT));
+}
+
+/* What resolution to spin to in micro seconds */
+#define RESOLUTION 100
+/* How many iterations to spin */
+#define ITERATIONS 1
+/* How many significant figures to round to */
+#define SIGFIGS 3
+
+static ErtsSysHrTime perf_counter_unit = 0;
+
+static ErtsSysHrTime erts_calculate_perf_counter_unit(void);
+static ErtsSysHrTime erts_calculate_perf_counter_unit() {
+    int i;
+    ErtsSysHrTime pre, post;
+    double value = 0;
+    double round_factor;
+#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME)
+    struct timespec basetime,comparetime;
+#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg)
+#define __GETUSEC(arg) (arg.tv_nsec / 1000)
+#else
+    SysTimeval basetime,comparetime;
+#define __GETTIME(arg) sys_gettimeofday(arg)
+#define __GETUSEC(arg) arg.tv_usec
+#endif
+
+    for (i = 0; i < ITERATIONS; i++) {
+        /* Make sure usec just flipped over at current resolution */
+        __GETTIME(&basetime);
+        do {
+            __GETTIME(&comparetime);
+        } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+        sys_perf_counter(&pre);
+
+        __GETTIME(&basetime);
+        do {
+            __GETTIME(&comparetime);
+        } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+        sys_perf_counter(&post);
+
+        value += post - pre;
+    }
+    /* After this value is ticks per us */
+    value /= (RESOLUTION*ITERATIONS);
+
+    /* We round to 3 significant figures */
+    round_factor = pow(10.0, SIGFIGS - ceil(log10(value)));
+    value = ((ErtsSysHrTime)(value * round_factor + 0.5)) / round_factor;
+
+    /* convert to ticks per second */
+    return 1000000 * value;
+}
+
+ErtsSysHrTime erts_perf_counter_unit() {
+    if (perf_counter_unit == 0)
+        perf_counter_unit = erts_calculate_perf_counter_unit();
+    return perf_counter_unit;
+}
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 081c4108a0..9e53b4bfcc 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -988,6 +988,13 @@ move Discarded x==0 | move Something x==0 => move Something x=0
 
 %endif
 
+call_ext u==0 u$func:os:perf_counter/0 => \
+    i_perf_counter
+call_ext_last u==0 u$func:os:perf_counter/0 D => \
+    i_perf_counter | deallocate_return D
+call_ext_only u==0 u$func:os:perf_counter/0 => \
+    i_perf_counter | return
+
 #
 # The general case for BIFs that have no special instructions.
 # A BIF used in the tail must be followed by a return instruction.
@@ -1027,6 +1034,8 @@ i_apply_fun_only
 
 i_hibernate
 
+i_perf_counter
+
 call_bif e
 
 #
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index 0352ee1b3c..9f137048de 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -101,6 +101,10 @@
 #endif
 #include 
 
+#ifdef HAVE_MACH_ABSOLUTE_TIME
+#include 
+#endif
+
 #ifdef HAVE_POSIX_MEMALIGN
 #  define ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC 1
 #endif
@@ -266,7 +270,31 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
 #endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */
 
 /*
- *
+ * Functions for getting the performance counter
+ */
+
+#if defined(__x86_64__)
+ /*  available on all x86_64. Best if used when we have constant_tsc and
+     nonstop_tsc cpu features. It may have been a good idea to put the
+     cpuid instruction before the rdtsc, but I decided against it
+     because it is not really needed for msacc, and it slows it down by
+     quite a bit. As a result though, this timestamp becomes much less
+     accurate as it might be re-ordered to be executed way before this
+     function is called.
+ */
+#define sys_perf_counter(ts) do {                                       \
+        __asm__ __volatile__ ("rdtsc\n\t"                               \
+                              "shl $32, %%rdx\n\t"                      \
+                              "or %%rdx, %0" : "=a" (*ts) : : "rdx");   \
+    } while(0)
+#define SYS_PERF_COUNTER_UNIT erts_perf_counter_unit()
+#else
+#define sys_perf_counter(ts) *(ts) = erts_get_perf_counter()
+#define SYS_PERF_COUNTER_UNIT 1000000000LL
+#endif
+
+/*
+ * Functions for measuring CPU time
  */
 
 #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c
index 2e1914f564..6fc4fc7dc4 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -912,6 +912,8 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
 
 #ifdef HAVE_GETHRVTIME_PROCFS_IOCTL
 
+/* The code below only has effect on solaris < 10,
+   needed in order for gehhrvtime to work properly */
 int sys_start_hrvtime(void)
 {
     long msacct = PR_MSACCT;
diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h
index 7e8dd8a4ca..1ab9eadefd 100644
--- a/erts/emulator/sys/win32/erl_win_sys.h
+++ b/erts/emulator/sys/win32/erl_win_sys.h
@@ -238,6 +238,8 @@ erts_sys_hrtime(void)
 
 extern void sys_gettimeofday(SysTimeval *tv);
 extern clock_t sys_times(SysTimes *buffer);
+#define sys_perf_counter(ts) *(ts) = erts_sys_hrtime()
+#define SYS_PERF_COUNTER_UNIT ERTS_I64_LITERAL(1000000000)
 
 extern char *win_build_environment(char *);
 
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index bca366681d..6f56a81eec 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -71,7 +71,8 @@
       | 'milli_seconds'
       | 'micro_seconds'
       | 'nano_seconds'
-      | 'native'.
+      | 'native'
+      | 'perf_counter'.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Native code BIF stubs and their types
@@ -1347,6 +1348,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
     try
 	FU = case FromUnit of
 		 native -> erts_internal:time_unit();
+                 perf_counter -> erts_internal:perf_counter_unit();
 		 nano_seconds -> 1000*1000*1000;
 		 micro_seconds -> 1000*1000;
 		 milli_seconds -> 1000;
@@ -1355,6 +1357,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
 	     end,
 	TU = case ToUnit of
 		 native -> erts_internal:time_unit();
+                 perf_counter -> erts_internal:perf_counter_unit();
 		 nano_seconds -> 1000*1000*1000;
 		 micro_seconds -> 1000*1000;
 		 milli_seconds -> 1000;
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 84dedab930..c3a14d272d 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -45,7 +45,7 @@
 
 -export([await_result/1, gather_io_bytes/2]).
 
--export([time_unit/0]).
+-export([time_unit/0, perf_counter_unit/0]).
 
 -export([is_system_process/1]).
 
@@ -345,6 +345,11 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) ->
 time_unit() ->
     erlang:nif_error(undefined).
 
+-spec erts_internal:perf_counter_unit() -> pos_integer().
+
+perf_counter_unit() ->
+    erlang:nif_error(undefined).
+
 -spec erts_internal:is_system_process(Pid) -> boolean() when
       Pid :: pid().
 
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
index 682d4a2eac..165160a909 100644
--- a/lib/kernel/doc/src/os.xml
+++ b/lib/kernel/doc/src/os.xml
@@ -37,6 +37,7 @@
       use these functions can be of help in enabling a program to run on
       most platforms.

   
+
   
     
       
@@ -209,6 +210,30 @@ format_utc_timestamp() ->
 	and os:system_time/1.

       
     
+    
+      
+      Returns a performance counter
+      
+        
Returns the current performance counter value in perf_counter
+	time unit.
+        This is a highly optimized call that might not be traceable.
+        

+      
+    
+    
+      
+      Returns a performance counter
+      
Returns a performance counter that can be used as a very fast and
+      high resolution timestamp. This counter is read directly from the hardware or operating
+      system with the same guarantees. This means that two consecutive calls
+      to the function are not guaranteed to be monotonic, though it most likely will be.
+      The performance counter till be converted to the resolution passed as an argument.

+      
1> T1 = os:perf_counter(1000),receive after 10000 -> ok end,T2 = os:perf_counter(1000).
+176525861
+2> T2 - T1.
+10004

+      
+    
     
       
       Return the OS family and, in some cases, OS name of the current operating system
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index 0022959c11..4947088635 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -27,7 +27,9 @@
 
 %%% BIFs
 
--export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1,
+-export([getenv/0, getenv/1, getenv/2, getpid/0,
+         perf_counter/0, perf_counter/1,
+         putenv/2, system_time/0, system_time/1,
 	 timestamp/0, unsetenv/1]).
 
 -spec getenv() -> [string()].
@@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) ->
 getpid() ->
     erlang:nif_error(undef).
 
+-spec perf_counter() -> Counter when
+      Counter :: integer().
+
+perf_counter() ->
+    erlang:nif_error(undef).
+
+-spec perf_counter(Unit) -> integer() when
+      Unit :: erlang:time_unit().
+
+perf_counter(Unit) ->
+      erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit).
+
 -spec putenv(VarName, Value) -> true when
       VarName :: string(),
       Value :: string().
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index 83a95019e7..e6e8568394 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -20,10 +20,11 @@
 -module(os_SUITE).
 
 -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_group/2,end_per_group/2,
+	 init_per_testcase/2,end_per_testcase/2]).
 -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1,
 	 find_executable/1, unix_comment_in_command/1, deep_list_command/1,
-         large_output_command/1]).
+         large_output_command/1, perf_counter_api/1]).
 
 -include_lib("test_server/include/test_server.hrl").
 
@@ -32,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
 all() ->
     [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command,
      find_executable, unix_comment_in_command, deep_list_command,
-     large_output_command].
+     large_output_command, perf_counter_api].
 
 groups() ->
     [].
@@ -49,6 +50,11 @@ init_per_group(_GroupName, Config) ->
 end_per_group(_GroupName, Config) ->
     Config.
 
+init_per_testcase(_TC,Config) ->
+    Config.
+
+end_per_testcase(_,_Config) ->
+    ok.
 
 space_in_cwd(doc) ->
     "Test that executing a command in a current working directory "
@@ -278,6 +284,40 @@ large_output_command(Config) when is_list(Config) ->
     AAA = lists:duplicate(7000, $a),
     comp(AAA,os:cmd("echo " ++ AAA)).
 
+%% Test that the os:perf_counter api works as expected
+perf_counter_api(_Config) ->
+
+    true = is_integer(os:perf_counter()),
+    true = os:perf_counter() > 0,
+
+    T1 = os:perf_counter(),
+    timer:sleep(100),
+    T2 = os:perf_counter(),
+    TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nano_seconds),
+    ct:pal("T1: ~p~n"
+           "T2: ~p~n"
+           "TsDiff: ~p~n",
+           [T1,T2,TsDiff]),
+
+    %% We allow a 15% diff
+    true = TsDiff < 115000000,
+    true = TsDiff > 85000000,
+
+    T1Ms = os:perf_counter(1000),
+    timer:sleep(100),
+    T2Ms = os:perf_counter(1000),
+    MsDiff = T2Ms - T1Ms,
+    ct:pal("T1Ms: ~p~n"
+           "T2Ms: ~p~n"
+           "MsDiff: ~p~n",
+           [T1Ms,T2Ms,MsDiff]),
+
+    %% We allow a 15% diff
+    true = MsDiff < 115,
+    true = MsDiff > 85.
+
+%% Util functions
+
 comp(Expected, Got) ->
     case strip_nl(Got) of
 	Expected ->
-- 
cgit v1.2.3


From 664ed2a6fd2b324bb6b56db3d3eca853cfda8f61 Mon Sep 17 00:00:00 2001
From: Lukas Larsson 
Date: Fri, 12 Sep 2014 16:38:00 +0200
Subject: erts: Add microstate accounting

Microstate accounting is a way to track which state the
different threads within ERTS are in. The main usage area
is to pin point performance bottlenecks by checking which
states the threads are in and then from there figuring out
why and where to optimize.

Since checking whether microstate accounting is on or off is
relatively expensive if done in a short loop only a few of the
states are enabled by default and more states can be enabled
through configure.

I've done some benchmarking and the overhead with it turned off
is not noticible and with it on it is a fraction of a percent.
If you enable the extra states, depending on the benchmark,
the ovehead when turned off is about 1% and when turned on
somewhere inbetween 5-15%.

OTP-12345
---
 erts/configure.in                           |  15 +
 erts/doc/src/erlang.xml                     | 177 +++++++++-
 erts/emulator/Makefile.in                   |   3 +-
 erts/emulator/beam/atom.names               |   4 +
 erts/emulator/beam/beam_emu.c               |  43 ++-
 erts/emulator/beam/bif.c                    |  48 ++-
 erts/emulator/beam/erl_alloc.h              |  18 +-
 erts/emulator/beam/erl_alloc.types          |   1 +
 erts/emulator/beam/erl_async.c              |  34 +-
 erts/emulator/beam/erl_bif_info.c           |  12 +
 erts/emulator/beam/erl_gc.c                 |   7 +
 erts/emulator/beam/erl_init.c               |   3 +
 erts/emulator/beam/erl_lock_check.c         |   2 +
 erts/emulator/beam/erl_msacc.c              | 486 ++++++++++++++++++++++++++++
 erts/emulator/beam/erl_msacc.h              | 409 +++++++++++++++++++++++
 erts/emulator/beam/erl_port_task.c          |   3 +
 erts/emulator/beam/erl_process.c            |  48 ++-
 erts/emulator/beam/erl_threads.h            |  34 +-
 erts/emulator/beam/global.h                 |   2 +
 erts/emulator/beam/io.c                     |  32 ++
 erts/emulator/beam/time.c                   |  20 +-
 erts/emulator/sys/common/erl_poll.c         |  36 ++-
 erts/emulator/sys/win32/erl_poll.c          |   4 +
 erts/emulator/test/statistics_SUITE.erl     |  95 +++++-
 erts/preloaded/src/erlang.erl               |  13 +
 erts/preloaded/src/erts_internal.erl        |  28 ++
 lib/runtime_tools/doc/src/Makefile          |   2 +-
 lib/runtime_tools/doc/src/msacc.xml         | 305 +++++++++++++++++
 lib/runtime_tools/doc/src/ref_man.xml       |   1 +
 lib/runtime_tools/doc/src/specs.xml         |   1 +
 lib/runtime_tools/src/Makefile              |   4 +-
 lib/runtime_tools/src/msacc.erl             | 355 ++++++++++++++++++++
 lib/runtime_tools/src/runtime_tools.app.src |   3 +-
 lib/runtime_tools/test/Makefile             |   3 +-
 lib/runtime_tools/test/msacc_SUITE.erl      | 132 ++++++++
 35 files changed, 2331 insertions(+), 52 deletions(-)
 create mode 100644 erts/emulator/beam/erl_msacc.c
 create mode 100644 erts/emulator/beam/erl_msacc.h
 create mode 100644 lib/runtime_tools/doc/src/msacc.xml
 create mode 100644 lib/runtime_tools/src/msacc.erl
 create mode 100644 lib/runtime_tools/test/msacc_SUITE.erl

diff --git a/erts/configure.in b/erts/configure.in
index 2f19c0f760..d84651f4f9 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -342,6 +342,21 @@ AS_HELP_STRING([--disable-saved-compile-time], [disable saved compile time]),
 
 AC_DEFINE_UNQUOTED(ERTS_SAVED_COMPILE_TIME, $save_compile_time, [Save compile time?])
 
+AC_ARG_WITH(microstate-accounting,
+AS_HELP_STRING([--with-microstate-accounting={yes|extra}],
+               [enable microstate account, possibly with extra detailed states])
+AS_HELP_STRING([--without-microstate-accounting],
+               [don't enable microstate accounting]),
+[],[with_microstate_accounting=yes])
+
+case "$with_microstate_accounting" in
+    yes) AC_DEFINE(ERTS_ENABLE_MSACC,[1],
+		[Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+    extra) AC_DEFINE(ERTS_ENABLE_MSACC,[2],
+		[Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+    *) ;;
+esac
+
 dnl Magic test for clearcase.
 OTP_RELEASE=
 if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 6915b35fcb..ddca492040 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -5870,6 +5870,146 @@ true
+ Information about microstate accounting. + + +

+ Microstate accounting can be used to measure how much time the Erlang + runtime system spends doing various tasks. It is designed to be as + lightweight as possible, but there will be some overhead when this + is enabled. Microstate accounting is meant to be a profiling tool + to help figure out performance bottlenecks. + To start/stop/reset microstate_accounting you use + the system_flag + + microstate_accounting. +

+

+ erlang:statistics(microstate_accounting) returns a list of maps + representing some of the OS threads within ERTS. Each map contains + type and id fields that can be used to identify what + thread it is, and also a counters field that contains data about how + much time has been spent in the various states.

+ 
+> erlang:statistics(microstate_accounting).
+[#{counters => #{aux => 1899182914,
+                 check_io => 2605863602,
+                 emulator => 45731880463,
+                 gc => 1512206910,
+                 other => 5421338456,
+                 port => 221631,
+                 sleep => 5150294100},
+   id => 1,
+   type => scheduler}|...]
+
+

The time unit is the same as returned by + + os:perf_counter/0. + So to convert it to milliseconds you could do something like this:

+ 
+lists:map(
+  fun(#{ counters := Cnt } = M) ->
+          MsCnt = maps:map(fun(_K, PerfCount) ->
+                                   erlang:convert_time_unit(PerfCount, perf_counter, 1000)
+                           end, Cnt),
+         M#{ counters := MsCnt }
+  end, erlang:statistics(microstate_accounting)).
+
+

+ It is important to note that these values are not guaranteed to be + the exact time spent in each state. This is because of various + optimisation done in order to keep the overhead as small as possible. +

+ +

Currently the following MSAcc_Thread_Type are available:

+ + scheduler + The main execution threads that do most of the work. + asyncAsync threads are used by various + linked-in drivers (mainly the file drivers) do offload non-cpu + intensive work. + auxTakes care of any work that is not + specifically assigned to a scheduler. + +

Currently the following MSAcc_Thread_States are available. + All states are exclusive, meaning that a thread cannot be in two states + at once. So if you add the numbers of all counters in a thread + you will get the total run-time for that thread.

+ + aux + Time spent handling auxiliary jobs. + check_io + Time spent checking for new I/O events. + emulator + Time spent executing erlang processes. + gc + Time spent doing garbage collection. When extra states are + enabled this is the time spent doing non-fullsweep garbage + collections. + other + Time spent doing unaccounted things. + port + Time spent executing ports. + sleep + Time spent sleeping. + +

It is possible to add more fine grained MSAcc_Thread_States + through configure. + (e.g. ./configure --with-microstate-accounting=extra). + Enabling these states will cause a performance degradation when + microstate accounting is turned off and increase the overhead when + it is turned on.

+ + alloc + Time spent managing memory. Without extra states this time is + spread out over all other states. + bif + Time spent in bifs. Without extra states this time is part of + the emulator state. + busy_wait + Time spent busy waiting. This is also the state where a + scheduler no longer reports that it is active when using + + erlang:statistics(scheduler_wall_time). + So if you add all other states but this and sleep and then divide that + by all time in the thread you should get something very similar to the + scheduler_wall_time fraction. Without extra states this time is part + of the other state. + ets + Time spent executing ETS bifs. Without extra states this time is + part of the emulator state. + gc_full + Time spent doing fullsweep garbage collection. Without extra + states this time is part of the gc state. + nif + Time spent in nifs. Without extra states this time is part of + the emulator state. + send + Time spent sending messages (processes only). Without extra + states this time is part of the emulator state. + timers + Time spent managing timers. Without extra states this time is + part of the other state. + +

There is a utility module called + msacc in + runtime_tools that can be used to more easily analyse these + statistics.

+ +

+ Returns undefined if the system flag + + microstate_accounting + is turned off. +

+

The list of thread information is unsorted and may appear in + different order between calls.

+

The threads and states are subject to change without any + prior notice.

 + + + + Information about reductions. @@ -5887,7 +6027,7 @@ true - + Information about the run-queues.

@@ -5903,7 +6043,7 @@ true - + Information about the run-queue lengths.

@@ -5923,7 +6063,7 @@ true - + Information about runtime.

Returns information about runtime, in milliseconds.

@@ -5938,7 +6078,7 @@ true - + Information about each schedulers work time. @@ -6009,7 +6149,7 @@ ok - + Information about active processes and ports.

@@ -6027,7 +6167,7 @@ ok - + Information about the run-queue lengths.

@@ -6046,7 +6186,7 @@ ok - + Information about wall clock.

Returns information about wall clock. wall_clock can @@ -6280,6 +6420,17 @@ ok + Set system flag microstate_accounting +

+ Turns on/off microstate accounting measurements. By passing reset it is possible to reset + all counters to 0.

+

For more information see, + erlang:statistics(microstate_accounting). +

+ + + + Sets system flag min_heap_size.

Sets the default minimum heap size for processes. The size @@ -6294,7 +6445,7 @@ ok - + Sets system flag min_bin_vheap_size.

Sets the default minimum binary virtual heap size for @@ -6311,7 +6462,7 @@ ok - + Sets system flag multi_scheduling.

@@ -6349,7 +6500,7 @@ ok - + Sets system flag scheduler_bind_type. @@ -6467,7 +6618,7 @@ ok - + Sets system flag scheduler_wall_time.

Turns on or off scheduler wall time measurements.

@@ -6477,7 +6628,7 @@ ok - + Sets system flag schedulers_online.

@@ -6502,7 +6653,7 @@ ok - + Sets system flag trace_control_word.

Sets the value of the node trace control word to diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index f4b806fae9..12148ad9c7 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -776,7 +776,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \ $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \ - $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o + $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ + $(OBJDIR)/erl_msacc.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 1629a92aa9..6fb08ee896 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -102,6 +102,7 @@ atom asynchronous atom atom atom atom_used atom attributes +atom await_microstate_accounting_modifications atom await_port_send_result atom await_proc_exit atom await_result @@ -172,6 +173,7 @@ atom const atom context_switches atom control atom copy +atom counters atom cpu atom cpu_timestamp atom cr @@ -269,6 +271,7 @@ atom get_tcw atom getenv atom gather_gc_info_result atom gather_io_bytes +atom gather_microstate_accounting_result atom gather_sched_wall_time_result atom getting_linked atom getting_unlinked @@ -360,6 +363,7 @@ atom merge_trap atom meta atom meta_match_spec atom micro_seconds +atom microstate_accounting atom milli_seconds atom min_heap_size atom min_bin_vheap_size diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a0979c7b0e..14b81a0a6e 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -113,6 +113,9 @@ do { \ #define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif +#define GET_BIF_MODULE(p) ((Eterm) (((Export *) p)->code[0])) +#define GET_BIF_FUNCTION(p) ((Eterm) (((Export *) p)->code[1])) +#define GET_BIF_ARITY(p) ((Eterm) (((Export *) p)->code[2])) #define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4])) #define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm)))) @@ -1249,6 +1252,8 @@ void process_main(void) Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; + ERTS_MSACC_DECLARE_CACHE_X(); /* a cached value of the tsd pointer for msacc */ + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ @@ -1302,6 +1307,8 @@ void process_main(void) ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_MSACC_UPDATE_CACHE_X(); + if (erts_system_monitor_long_schedule != 0) { start_time = erts_timestamp_millis(); start_time_i = c_p->i; @@ -2741,11 +2748,21 @@ do { \ */ OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); + Eterm (*bf)(Process*, Eterm*, BeamInstr*); Eterm result; BeamInstr *next; ErlHeapFragment *live_hf_end; + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if (GET_BIF_MODULE(Arg(0)) == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } + + bf = GET_BIF_ADDRESS(Arg(0)); + PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; if (FCALLS <= 0) { @@ -2768,6 +2785,12 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); if (is_value(result)) { r(0) = result; CHECK_TERM(r(0)); @@ -3452,6 +3475,8 @@ do { \ BifFunction vbf; ErlHeapFragment *live_hf_end; + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); c_p->current = I-3; /* current and vbf set to please handle_error */ SWAPOUT; @@ -3476,6 +3501,8 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); goto apply_bif_or_nif_epilogue; @@ -3490,6 +3517,13 @@ do { \ * code[3]: &&apply_bif * code[4]: Function pointer to BIF function */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if ((Eterm)I[-3] == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ c_p->i = I; /* In case we apply check_process_code/2. */ @@ -3516,7 +3550,12 @@ do { \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); } - + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); apply_bif_or_nif_epilogue: diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index bb9165cd79..7e8eb44680 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -44,6 +44,7 @@ #include "erl_ptab.h" #include "erl_bits.h" #include "erl_bif_unique.h" +#include "erl_msacc.h" Export *erts_await_result; static Export* flush_monitor_messages_trap = NULL; @@ -54,6 +55,9 @@ Export* erts_format_cpu_topology_trap = NULL; static Export dsend_continue_trap_export; Export *erts_convert_time_unit_trap = NULL; +static Export *await_msacc_mod_trap = NULL; +static erts_smp_atomic32_t msacc; + static Export *await_sched_wall_time_mod_trap; static erts_smp_atomic32_t sched_wall_time; @@ -2143,7 +2147,11 @@ BIF_RETTYPE send_3(BIF_ALIST_3) int connect = !0; Eterm l = opts; Sint result; + DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + + ERTS_MSACC_PUSH_STATE_M_X(); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); ctx->suspend = !0; @@ -2172,7 +2180,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) ref = NIL; #endif + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND); result = do_send(p, to, msg, &ref, ctx); + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -2288,8 +2299,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) Eterm ref; Sint result; DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND); UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); - #ifdef DEBUG ref = NIL; #endif @@ -2300,7 +2311,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; result = do_send(p, to, msg, &ref, ctx); - + + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -4586,6 +4599,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) default: ERTS_INTERNAL_ERROR("Unknown state"); } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { + erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE; + erts_aint32_t old = erts_smp_atomic32_xchg_nob(&msacc, new); + Eterm ref = erts_msacc_request(BIF_P, new, &threads); + if (is_non_value(ref)) + BIF_RET(old ? am_true : am_false); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } else if (BIF_ARG_2 == am_reset) { + Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads); + erts_aint32_t old = erts_smp_atomic32_read_nob(&msacc); + ASSERT(is_value(ref)); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } +#endif } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4915,8 +4953,12 @@ void erts_init_bif(void) await_port_send_result_trap = erts_export_put(am_erts_internal, am_await_port_send_result, 3); await_sched_wall_time_mod_trap - = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + await_msacc_mod_trap + = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3); + erts_smp_atomic32_init_nob(&sched_wall_time, 0); + erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED()); } #ifdef HARDDEBUG diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 14e80960f5..71e4713624 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -233,12 +233,14 @@ ERTS_ALC_INLINE void *erts_alloc(ErtsAlcType_t type, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, size); if (!res) erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); + ERTS_MSACC_POP_STATE_X(); return res; } @@ -246,6 +248,7 @@ ERTS_ALC_INLINE void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, @@ -253,37 +256,48 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) size); if (!res) erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size); + ERTS_MSACC_POP_STATE_X(); return res; } ERTS_ALC_INLINE void erts_free(ErtsAlcType_t type, void *ptr) { + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); (*erts_allctrs[ERTS_ALC_T2A(type)].free)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr); + ERTS_MSACC_POP_STATE_X(); } ERTS_ALC_INLINE void *erts_alloc_fnf(ErtsAlcType_t type, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index e0bc71c88a..6b7eff1428 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -361,6 +361,7 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap +type MSACC LONG_LIVED SYSTEM microstate_accounting # # Types used by system specific code diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index be0bc0cfec..cdeeb5281b 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -400,13 +400,19 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a) ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); #endif if (!p) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } else { if (async_ready(p, a->async_data)) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } #if ERTS_USE_ASYNC_READY_Q erts_port_release(p); @@ -460,6 +466,8 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) { ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; erts_tse_t *tse = erts_tse_fetch(); + ERTS_DECLARE_DUMMY(Uint no); + #ifdef ERTS_SMP ErtsThrPrgrCallbacks callbacks; @@ -483,10 +491,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) /* Inform main thread that we are done initializing... */ erts_mtx_lock(&async->init.data.mtx); - async->init.data.no_initialized++; + no = async->init.data.no_initialized++; erts_cnd_signal(&async->init.data.cnd); erts_mtx_unlock(&async->init.data.mtx); + erts_msacc_init_thread("async", no, 0); + return tse; } @@ -494,6 +504,7 @@ static void *async_main(void* arg) { ErtsAsyncQ *aq = (ErtsAsyncQ *) arg; erts_tse_t *tse = async_thread_init(aq); + ERTS_MSACC_DECLARE_CACHE(); while (1) { ErtsThrQPrepEnQ_t *prep_enq; @@ -501,11 +512,14 @@ static void *async_main(void* arg) if (is_nil(a->port)) break; /* Time to die */ + ERTS_MSACC_UPDATE_CACHE(); + #if ERTS_ASYNC_PRINT_JOB erts_fprintf(stderr, "<- %ld\n", a->async_id); #endif - + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); a->async_invoke(a->async_data); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); async_reply(a, prep_enq); } @@ -628,10 +642,13 @@ long driver_async(ErlDrvPort ix, unsigned int* key, unsigned int qix; #if ERTS_USE_ASYNC_READY_Q Uint sched_id; + ERTS_MSACC_PUSH_STATE(); sched_id = erts_get_scheduler_id(); if (!sched_id) sched_id = 1; +#else + ERTS_MSACC_PUSH_STATE(); #endif prt = erts_drvport2port(ix); @@ -684,12 +701,17 @@ long driver_async(ErlDrvPort ix, unsigned int* key, return id; } #endif - + + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_invoke)(a->async_data); + ERTS_MSACC_POP_STATE(); if (async_ready(prt, a->async_data)) { - if (a->async_free != NULL) + if (a->async_free != NULL) { + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_free)(a->async_data); + ERTS_MSACC_POP_STATE(); + } } erts_free(ERTS_ALC_T_ASYNC, (void *) a); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 06e7dc8661..017339e1f6 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -64,6 +64,7 @@ static Export* alloc_sizes_trap = NULL; static Export* gather_io_bytes_trap = NULL; static Export *gather_sched_wall_time_res_trap; +static Export *gather_msacc_res_trap; static Export *gather_gc_info_res_trap; #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) @@ -3260,6 +3261,14 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) szp = NULL; hpp = &hp; } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + res = erts_msacc_request(BIF_P, ERTS_MSACC_GATHER, &threads); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP2(gather_msacc_res_trap, BIF_P, res, threads); +#endif } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); @@ -4396,6 +4405,9 @@ erts_bif_info_init(void) = erts_export_put(am_erlang, am_gather_gc_info_result, 1); gather_io_bytes_trap = erts_export_put(am_erts_internal, am_gather_io_bytes, 2); + gather_msacc_res_trap + = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2); + process_info_init(); os_info_init(); } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 06acece471..21b03ae8bd 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -576,6 +576,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, int reds; ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif @@ -588,6 +589,8 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) live_hf_end = p->live_hf_end; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC); + esdp = erts_get_scheduler_data(); if (IS_TRACED_FL(p, F_TRACE_GC)) { @@ -624,9 +627,11 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, } else { do_major_collection: + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL); DTRACE2(gc_major_start, pidbuf, need); reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); DTRACE2(gc_major_end, pidbuf, reclaimed_now); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); } reset_active_writer(p); @@ -669,6 +674,8 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; + ERTS_MSACC_POP_STATE_M(); + #ifdef CHECK_FOR_HOLES /* * We intentionally do not rescan the areas copied by the GC. diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 42aca726bf..520b504fcb 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -394,6 +394,7 @@ erl_init(int ncpu, #endif packet_parser_init(); erl_nif_init(); + erts_msacc_init(); } static Eterm @@ -1193,6 +1194,7 @@ early_init(int *argc, char **argv) /* erts_thr_late_init(&elid); } #endif + erts_msacc_early_init(); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_late_init(); @@ -2220,6 +2222,7 @@ erl_start(int argc, char **argv) #else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + erts_msacc_init_thread("scheduler", 1, 1); erts_thr_set_main_status(1, 1); #if ERTS_USE_ASYNC_READY_Q esdp->aux_work_data.async_ready.queue diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index f7b4bd8041..598bf84c0b 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -137,6 +137,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "mmap_init_atoms", NULL }, { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, + { "msacc_list_mutex", NULL }, + { "msacc_unmanaged_mutex", NULL }, #ifdef ERTS_SMP { "atom_tab", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c new file mode 100644 index 0000000000..bf1c06dea7 --- /dev/null +++ b/erts/emulator/beam/erl_msacc.c @@ -0,0 +1,486 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Microstate accounting. + * + * We keep track of the different states that the + * Erlang VM threads are in, in order to provide + * performance/debugging statistics. There is a + * small overhead in enabling this, but in the big + * scheme of things it should be negligible. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_MSACC_STATE_STRINGS 1 + +#include "sys.h" +#include "global.h" +#include "erl_threads.h" +#include "erl_bif_unique.h" +#include "erl_map.h" +#include "erl_msacc.h" + +#if ERTS_ENABLE_MSACC + +static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp); +static void erts_msacc_reset(ErtsMsAcc *msacc); +static ErtsMsAcc* get_msacc(void); + +#ifdef USE_THREADS +erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key); +#else +ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL; +#endif +int ERTS_WRITE_UNLIKELY(erts_msacc_enabled); + +static Eterm *erts_msacc_state_atoms = NULL; +static erts_rwmtx_t msacc_mutex; +static ErtsMsAcc *msacc_managed = NULL; +#ifdef USE_THREADS +static ErtsMsAcc *msacc_unmanaged = NULL; +static Uint msacc_unmanaged_count = 0; +#endif + +/* we have to split initiation as atoms are not inited in early init */ +void erts_msacc_early_init(void) { +#ifndef ERTS_MSACC_ALWAYS_ON + erts_msacc_enabled = 0; +#endif + erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex"); +#ifdef USE_THREADS + erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key"); +#else + erts_msacc = NULL; +#endif +} + +void erts_msacc_init(void) { + int i; + erts_msacc_state_atoms = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(Eterm)*ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + erts_msacc_state_atoms[i] = am_atom_put(erts_msacc_states[i], + strlen(erts_msacc_states[i])); + } +} + +void erts_msacc_init_thread(char *type, int id, int managed) { + ErtsMsAcc *msacc; + + msacc = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMsAcc)); + + msacc->type = strdup(type); + msacc->id = make_small(id); + msacc->unmanaged = !managed; + msacc->tid = erts_thr_self(); + msacc->perf_counter = 0; + +#ifdef USE_THREADS + erts_rwmtx_rwlock(&msacc_mutex); + if (!managed) { + erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex"); + msacc->next = msacc_unmanaged; + msacc_unmanaged = msacc; + msacc_unmanaged_count++; + ERTS_MSACC_TSD_SET(msacc); + } else { + msacc->next = msacc_managed; + msacc_managed = msacc; + } + erts_rwmtx_rwunlock(&msacc_mutex); +#else + msacc_managed = msacc; +#endif + + erts_msacc_reset(msacc); + +#ifdef ERTS_MSACC_ALWAYS_ON + ERTS_MSACC_TSD_SET(msacc); + sys_perf_counter(&msacc->perf_counter); + msacc->state = ERTS_MSACC_STATE_OTHER; +#endif +} + +/* + * Creates a structure looking like this + * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}} + */ +static +Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp) { + int i; + Eterm *hp; + Eterm key, state_key, state_map; + Eterm res = THE_NON_VALUE; + flatmap_t *map; + + if (szp) { + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(3); + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + (void)erts_bld_sint64(NULL,szp,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + (void)erts_bld_uint64(NULL,szp,msacc->state_counters[i]); + *szp += 3; /* tuple to put state+perf counter in */ +#endif + } + } + + if (hpp) { + Eterm counters[ERTS_MSACC_STATE_COUNT]; + hp = *hpp; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + Eterm counter = erts_bld_sint64(&hp,NULL,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->state_counters[i]); + counters[i] = TUPLE2(hp,counter,counter__); + hp += 3; +#else + counters[i] = counter; +#endif + } + + key = TUPLE3(hp,am_counters,am_id,am_type); + hp += 4; + + state_key = make_tuple(hp); + hp[0] = make_arityval(ERTS_MSACC_STATE_COUNT); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[1+i] = erts_msacc_state_atoms[i]; + hp += 1 + ERTS_MSACC_STATE_COUNT; + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = ERTS_MSACC_STATE_COUNT; + map->keys = state_key; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[i] = counters[i]; + hp += ERTS_MSACC_STATE_COUNT; + state_map = make_flatmap(map); + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = 3; + map->keys = key; + hp[0] = state_map; + hp[1] = msacc->id; + hp[2] = am_atom_put(msacc->type,strlen(msacc->type)); + hp += 3; + + *hpp = hp; + res = make_flatmap(map); + } + + return res; +} + +typedef struct { + int action; + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Uint req_sched; + erts_smp_atomic32_t refc; +} ErtsMSAccReq; + +static ErtsMsAcc* get_msacc(void) { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + msacc = msacc_managed; + while (!erts_equal_tids(msacc->tid,erts_thr_self())) { + msacc = msacc->next; + ASSERT(msacc != NULL); + } + erts_rwmtx_runlock(&msacc_mutex); + return msacc; +} + +static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + Process *rp = msaccrp->proc; + ErtsMessage *msgp = NULL; + Eterm **hpp, *hp; + Eterm ref_copy = NIL, msg; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no + ? ERTS_PROC_LOCK_MAIN : 0); + + sz = 0; + hpp = NULL; + szp = &sz; + + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, msaccrp->ref); + else + *szp += REF_THING_SIZE; + + if (msaccrp->action != ERTS_MSACC_GATHER) + msg = ref_copy; + else { + msg = erts_msacc_gather_stats(msacc, hpp, szp); + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + msgp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + hpp = &hp; + szp = NULL; + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); + + erts_queue_message(rp, &rp_locks, msgp, msg, NIL); + + if (esdp && msaccrp->req_sched == esdp->no) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + +} + +static void +reply_msacc(void *vmsaccrp) +{ + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsMSAccReq *msaccrp = (ErtsMSAccReq *) vmsaccrp; + + ASSERT(!msacc || !msacc->unmanaged); + + if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) { + msacc = get_msacc(); + + sys_perf_counter(&msacc->perf_counter); + + msacc->state = ERTS_MSACC_STATE_OTHER; + + ERTS_MSACC_TSD_SET(msacc); + + } else if (msaccrp->action == ERTS_MSACC_DISABLE && msacc) { + ERTS_MSACC_TSD_SET(NULL); + } else if (msaccrp->action == ERTS_MSACC_RESET) { + msacc = msacc ? msacc : get_msacc(); + erts_msacc_reset(msacc); + } else if (msaccrp->action == ERTS_MSACC_GATHER && !msacc) { + msacc = get_msacc(); + } + + ASSERT(!msacc || !msacc->unmanaged); + + send_reply(msacc, msaccrp); + + erts_proc_dec_refc(msaccrp->proc); + + if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0) + erts_free(ERTS_ALC_T_MSACC, vmsaccrp); +} + +static void erts_msacc_reset(ErtsMsAcc *msacc) { + int i; + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + msacc->perf_counters[i] = 0; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[i] = 0; +#endif + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); +} + +#endif /* ERTS_ENABLE_MSACC */ + + +/* + * This function is responsible for enabling, disabling, resetting and + * gathering data related to microstate accounting. + * + * Managed threads and unmanaged threads are handled differently. + * - managed threads get a misc_aux job telling them to switch on msacc + * - unmanaged have some fields protected by a mutex that has to be taken + * before any values can be updated + * + * For performance reasons there is also a global value erts_msacc_enabled + * that controls the state of all threads. Statistics gathering is only on + * if erts_msacc_enabled && msacc is true. + */ +Eterm +erts_msacc_request(Process *c_p, int action, Eterm *threads) +{ +#ifdef ERTS_ENABLE_MSACC + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + Eterm ref; + ErtsMSAccReq *msaccrp; + Eterm *hp; + + +#ifdef ERTS_MSACC_ALWAYS_ON + if (action == ERTS_MSACC_ENABLE || action == ERTS_MSACC_DISABLE) + return THE_NON_VALUE; +#else + /* take care of double enable, and double disable here */ + if (msacc && action == ERTS_MSACC_ENABLE) { + return THE_NON_VALUE; + } else if (!msacc && action == ERTS_MSACC_DISABLE) { + return THE_NON_VALUE; + } +#endif + + ref = erts_make_ref(c_p); + + msaccrp = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMSAccReq)); + hp = &msaccrp->ref_heap[0]; + + msaccrp->action = action; + msaccrp->proc = c_p; + msaccrp->ref = STORE_NC(&hp, NULL, ref); + msaccrp->req_sched = esdp->no; + +#ifdef ERTS_SMP + *threads = erts_no_schedulers; + *threads += 1; /* aux thread */ +#else + *threads = 1; +#endif + + erts_smp_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads); + + erts_proc_add_refc(c_p, *threads); + + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_msacc, + (void *) msaccrp); +#ifdef ERTS_SMP + /* aux thread */ + erts_schedule_misc_aux_work(0, reply_msacc, (void *) msaccrp); +#endif + +#ifdef USE_THREADS + /* Manage unmanaged threads */ + switch (action) { + case ERTS_MSACC_GATHER: { + Uint unmanaged_count; + ErtsMsAcc *msacc, **unmanaged; + int i = 0; + + /* we copy a list of pointers here so that we do not have to have + the msacc_mutex when sending messages */ + erts_rwmtx_rlock(&msacc_mutex); + unmanaged_count = msacc_unmanaged_count; + unmanaged = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(ErtsMsAcc*)*unmanaged_count); + + for (i = 0, msacc = msacc_unmanaged; + i < unmanaged_count; + i++, msacc = msacc->next) { + unmanaged[i] = msacc; + } + erts_rwmtx_runlock(&msacc_mutex); + + for (i = 0; i < unmanaged_count; i++) { + erts_mtx_lock(&unmanaged[i]->mtx); + if (unmanaged[i]->perf_counter) { + ErtsSysHrTime perf_counter; + /* if enabled update stats */ + sys_perf_counter(&perf_counter); + unmanaged[i]->perf_counters[unmanaged[i]->state] += + perf_counter - unmanaged[i]->perf_counter; + unmanaged[i]->perf_counter = perf_counter; + } + erts_mtx_unlock(&unmanaged[i]->mtx); + send_reply(unmanaged[i],msaccrp); + } + erts_free(ERTS_ALC_T_MSACC,unmanaged); + /* We have just sent unmanaged_count messages, so bump no of threads */ + *threads += unmanaged_count; + break; + } + case ERTS_MSACC_RESET: { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) + erts_msacc_reset(msacc); + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_ENABLE: { + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + sys_perf_counter(&msacc->perf_counter); + /* we assume the unmanaged thread is sleeping */ + msacc->state = ERTS_MSACC_STATE_SLEEP; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_DISABLE: { + ErtsSysHrTime perf_counter; + erts_rwmtx_rlock(&msacc_mutex); + /* make sure to update stats with latest results */ + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + sys_perf_counter(&perf_counter); + msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter; + msacc->perf_counter = 0; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + default: { ASSERT(0); } + } + +#endif + + *threads = make_small(*threads); + + reply_msacc((void *) msaccrp); + +#ifndef ERTS_MSACC_ALWAYS_ON + /* enable/disable the global value */ + if (action == ERTS_MSACC_ENABLE) { + erts_msacc_enabled = 1; + } else if (action == ERTS_MSACC_DISABLE) { + erts_msacc_enabled = 0; + } +#endif + + return ref; +#else + return THE_NON_VALUE; +#endif +} diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h new file mode 100644 index 0000000000..de72fe9597 --- /dev/null +++ b/erts/emulator/beam/erl_msacc.h @@ -0,0 +1,409 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MSACC_H__ +#define ERL_MSACC_H__ + +/* Can be enabled/disabled via configure */ +#if ERTS_ENABLE_MSACC == 2 +#define ERTS_MSACC_EXTENDED_STATES 1 +#endif + +/* Uncomment this to also count the number of + transitions to a state. This will add a count + to the counter map. */ +/* #define ERTS_MSACC_STATE_COUNTERS 1 */ + +/* Uncomment this to make msacc to always be on, + this reduces overhead a little bit when profiling */ +/* #define ERTS_MSACC_ALWAYS_ON 1 */ + +#define ERTS_MSACC_DISABLE 0 +#define ERTS_MSACC_ENABLE 1 +#define ERTS_MSACC_RESET 2 +#define ERTS_MSACC_GATHER 3 + +/* + * When adding a new state, you have to: + * * Add it here + * * Increment ERTS_MSACC_STATE_COUNT + * * Add string value to erts_msacc_states + * * Have to be in alphabetical order! + * * Only add states to the non-extended section after + * careful benchmarking to make sure the overhead + * when disabled is minimal. + */ + +#ifndef ERTS_MSACC_EXTENDED_STATES +#define ERTS_MSACC_STATE_AUX 0 +#define ERTS_MSACC_STATE_CHECK_IO 1 +#define ERTS_MSACC_STATE_EMULATOR 2 +#define ERTS_MSACC_STATE_GC 3 +#define ERTS_MSACC_STATE_OTHER 4 +#define ERTS_MSACC_STATE_PORT 5 +#define ERTS_MSACC_STATE_SLEEP 6 + +#define ERTS_MSACC_STATE_COUNT 7 + +#if ERTS_MSACC_STATE_STRINGS && ERTS_ENABLE_MSACC +static char *erts_msacc_states[] = { + "aux", + "check_io", + "emulator", + "gc", + "other", + "port", + "sleep" +}; +#endif + +#else + +#define ERTS_MSACC_STATE_ALLOC 0 +#define ERTS_MSACC_STATE_AUX 1 +#define ERTS_MSACC_STATE_BIF 2 +#define ERTS_MSACC_STATE_BUSY_WAIT 3 +#define ERTS_MSACC_STATE_CHECK_IO 4 +#define ERTS_MSACC_STATE_EMULATOR 5 +#define ERTS_MSACC_STATE_ETS 6 +#define ERTS_MSACC_STATE_GC 7 +#define ERTS_MSACC_STATE_GC_FULL 8 +#define ERTS_MSACC_STATE_NIF 9 +#define ERTS_MSACC_STATE_OTHER 10 +#define ERTS_MSACC_STATE_PORT 11 +#define ERTS_MSACC_STATE_SEND 12 +#define ERTS_MSACC_STATE_SLEEP 13 +#define ERTS_MSACC_STATE_TIMERS 14 + +#define ERTS_MSACC_STATE_COUNT 15 + +#if ERTS_MSACC_STATE_STRINGS +static char *erts_msacc_states[] = { + "alloc", + "aux", + "bif", + "busy_wait", + "check_io", + "emulator", + "ets", + "gc", + "gc_full", + "nif", + "other", + "port", + "send", + "sleep", + "timers" +}; +#endif + +#endif + +typedef struct erl_msacc_t_ ErtsMsAcc; + +struct erl_msacc_t_ { + + /* the the values below are protected by mtx iff unmanaged = 1 */ + ErtsSysHrTime perf_counter; + ErtsSysHrTime perf_counters[ERTS_MSACC_STATE_COUNT]; +#ifdef ERTS_MSACC_STATE_COUNTERS + Uint64 state_counters[ERTS_MSACC_STATE_COUNT]; +#endif + Uint state; + + /* protected by msacc_mutex in erl_msacc.c, and should be constant */ + int unmanaged; + erts_mtx_t mtx; + ErtsMsAcc *next; + erts_tid_t tid; + Eterm id; + char *type; +}; + +#if ERTS_ENABLE_MSACC + +#define ERTS_MSACC_INLINE ERTS_GLB_INLINE + +#ifdef USE_THREADS +extern erts_tsd_key_t erts_msacc_key; +#else +extern ErtsMsAcc *erts_msacc; +#endif + +#ifdef ERTS_MSACC_ALWAYS_ON +#define erts_msacc_enabled 1 +#else +extern int erts_msacc_enabled; +#endif + +#ifdef USE_THREADS +#define ERTS_MSACC_TSD_GET() erts_tsd_get(erts_msacc_key) +#define ERTS_MSACC_TSD_SET(tsd) erts_tsd_set(erts_msacc_key,tsd) +#else +#define ERTS_MSACC_TSD_GET() erts_msacc +#define ERTS_MSACC_TSD_SET(tsd) erts_msacc = tsd +#endif + +void erts_msacc_early_init(void); +void erts_msacc_init(void); +void erts_msacc_init_thread(char *type, int id, int liberty); + +/* The defines below are used to instrument the vm code + * with different state changes. There are two variants + * of each define. One that has a cached ErtsMsAcc * + * that it can use, and one that does not. + * The cached values are necessary to have in order to get + * low enough overhead when running without msacc enabled. + * + * The two most common patterns to use the function with are: + * + * ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Note that the erts_msacc_push* function declare new variables, so + * to conform with C89 we have to call it in the beginning of a function. + * We might not want to change state it the beginning though, so we use this: + * + * ERTS_MSACC_PUSH_STATE(); + * ... some other code ... + * ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Notice that we used the cached version of set_state as push_state already + * read the erts_msacc_enabled to the cache. + * + * Most macros also have other variants with the suffix _m which means that + * they are known to only be called in managed threads, or with the _x suffix + * which means that it should only be used in an emulator compiled with + * extended states. + * + * Here is a listing of the entire api: + * + * void ERTS_MSACC_DECLARE_CACHE() + * void ERTS_MSACC_UPDATE_CACHE() + * void ERTS_MSACC_IS_ENABLED() + * void ERTS_MSACC_IS_ENABLED_CACHED() + * + * void ERTS_MSACC_PUSH_STATE() + * void ERTS_MSACC_SET_STATE(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE(int state) + * + * void ERTS_MSACC_PUSH_STATE_CACHED() + * void ERTS_MSACC_SET_STATE_CACHED(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(int state) + * void ERTS_MSACC_POP_STATE() + * + * void ERTS_MSACC_PUSH_STATE_M() + * void ERTS_MSACC_PUSH_STATE_CACHED_M() + * void ERTS_MSACC_SET_STATE_CACHED_M(int state) + * void ERTS_MSACC_SET_STATE_M(int state) + * void ERTS_MSACC_POP_STATE_M() + * void ERTS_MSACC_PUSH_AND_SET_STATE_M(int state) + * + * Most functions are also available with an _x suffix that are only enabled + * when using the extra states. If they are not, just add them to the end + * of this file. + */ + +/* cache handling functions */ +#define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled) +#define ERTS_MSACC_DECLARE_CACHE() \ + ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL) +#define ERTS_MSACC_UPDATE_CACHE() \ + __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL + + +/* The defines below implicitly declare and load a new cache */ +#define ERTS_MSACC_PUSH_STATE() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_SET_STATE(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) \ + ERTS_MSACC_PUSH_STATE(); ERTS_MSACC_SET_STATE_CACHED(state) + +/* The defines below need an already declared cache to work */ +#define ERTS_MSACC_PUSH_STATE_CACHED() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_um__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_CACHED(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) \ + ERTS_MSACC_PUSH_STATE_CACHED(); ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_POP_STATE() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, __erts_msacc_state, 0) + +/* Only use these defines when we know that we have in a managed thread */ +#define ERTS_MSACC_PUSH_STATE_M() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_M(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_M(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_POP_STATE_M() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0) +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \ + ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state) + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment); +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment); + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc); +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc) { + Uint state; + if (msacc->unmanaged) + erts_mtx_lock(&msacc->mtx); + state = msacc->state; + if (msacc->unmanaged) + erts_mtx_unlock(&msacc->mtx); + return state; +} + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) { + return msacc->state; +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) { + if (ERTS_UNLIKELY(msacc->unmanaged)) { + erts_mtx_lock(&msacc->mtx); + msacc->state = new_state; + if (ERTS_LIKELY(!msacc->perf_counter)) { + erts_mtx_unlock(&msacc->mtx); + return; + } + } + + erts_msacc_set_state_m__(msacc,new_state,increment); + + if (ERTS_UNLIKELY(msacc->unmanaged)) + erts_mtx_unlock(&msacc->mtx); +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) { + ErtsSysHrTime prev_perf_counter; + Sint64 diff; + + if (new_state == msacc->state) + return; + + prev_perf_counter = msacc->perf_counter; + sys_perf_counter(&msacc->perf_counter); + diff = msacc->perf_counter - prev_perf_counter; + ASSERT(diff >= 0); + msacc->perf_counters[msacc->state] += diff; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[new_state] += increment; +#endif + msacc->state = new_state; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#else + +#define ERTS_MSACC_IS_ENABLED() 0 +#define erts_msacc_early_init() +#define erts_msacc_init() +#define erts_msacc_init_thread(type, id, liberty) +#define ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + + +#endif /* ERTS_ENABLE_MSACC */ + +#ifndef ERTS_MSACC_EXTENDED_STATES + +#define ERTS_MSACC_PUSH_STATE_X() +#define ERTS_MSACC_POP_STATE_X() +#define ERTS_MSACC_SET_STATE_X(state) +#define ERTS_MSACC_SET_STATE_M_X(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_UPDATE_CACHE_X() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() 0 +#define ERTS_MSACC_DECLARE_CACHE_X() +#define ERTS_MSACC_PUSH_STATE_M_X() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) +#define ERTS_MSACC_POP_STATE_M_X() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) + +#else + +#define ERTS_MSACC_PUSH_STATE_X() ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_POP_STATE_X() ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE_X(state) ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_M_X(state) ERTS_MSACC_SET_STATE_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE_X() ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE_X() ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M_X() ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M_X() ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + +#endif /* !ERTS_MSACC_EXTENDED_STATES */ + +#endif /* ERL_MSACC_H__ */ diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 2c09834d19..197b328fe2 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1648,6 +1648,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int active; Uint64 start_time = 0; ErtsSchedulerData *esdp = runq->scheduler; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1690,6 +1691,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) state = erts_atomic32_read_nob(&pp->state); pp->reds = ERTS_PORT_REDS_EXECUTE; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); goto begin_handle_tasks; while (1) { @@ -1822,6 +1824,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (io_tasks_executed) { diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 3902632ef8..8e1ebe795c 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -941,6 +941,12 @@ sched_wall_time_change(ErtsSchedulerData *esdp, int working) } } } + if (!working) { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT); + } else { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER); + } + } typedef struct { @@ -1696,15 +1702,17 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin int need_thr_progress = 0; ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; int more_work = 0; - + ERTS_MSACC_PUSH_STATE_M_X(); #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_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ALLOC); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, &wakeup, &more_work); + ERTS_MSACC_POP_STATE_M_X(); if (more_work) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD) & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { @@ -2176,12 +2184,15 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ if (!(aux_work & ~ignore)) { \ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ + ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_MSACC_POP_STATE_M(); \ return aux_work; \ } \ } erts_aint32_t aux_work = orig_aux_work; erts_aint32_t ignore = 0; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_AUX); ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #ifdef ERTS_SMP @@ -2272,6 +2283,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) haw_thr_prgr_current_check_progress(awdp); #endif + ERTS_MSACC_UPDATE_CACHE(); + ERTS_MSACC_POP_STATE_M(); return aux_work; #undef HANDLE_AUX_WORK @@ -2779,6 +2792,8 @@ aux_thread(void *unused) ssi->event = erts_tse_fetch(); + erts_msacc_init_thread("aux", 1, 1); + callbacks.arg = (void *) ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = thr_prgr_prep_wait; @@ -2789,6 +2804,7 @@ aux_thread(void *unused) init_aux_work_data(awdp, NULL, NULL); awdp->ssi = ssi; + sched_prep_spin_wait(ssi); while (1) { @@ -2842,6 +2858,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #ifdef ERTS_SMP int thr_prgr_active = 1; erts_aint32_t flgs; +#endif + ERTS_MSACC_PUSH_STATE_M(); +#ifdef ERTS_SMP ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -2898,6 +2917,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, 1); } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } @@ -2959,7 +2979,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) - 1) + 1; } else timeout = -1; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); res = erts_tse_twait(ssi->event, timeout); + ERTS_MSACC_POP_STATE_M(); current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : erts_get_monotonic_time(esdp); } while (res == EINTR); @@ -3028,9 +3050,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (working) sched_wall_time_change(esdp, working = 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + ASSERT(!erts_port_task_have_outstanding_io_tasks()); erl_sys_schedule(1); /* Might give us something to do */ + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -3051,6 +3077,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); @@ -3148,8 +3175,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + erl_sys_schedule(0); + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -7926,6 +7957,8 @@ sched_thread_func(void *vesdp) callbacks.wait = thr_prgr_wait; callbacks.finalize_wait = thr_prgr_fin_wait; + erts_msacc_init_thread("scheduler", no, 1); + erts_thr_progress_register_managed_thread(esdp, &callbacks, 0); erts_alloc_register_scheduler(vesdp); #endif @@ -9204,6 +9237,8 @@ Process *schedule(Process *p, int calls) Uint32 flags; erts_aint32_t state = 0; /* Supress warning... */ + ERTS_MSACC_DECLARE_CACHE(); + #ifdef USE_VM_PROBES if (p != NULL && DTRACE_ENABLED(process_unscheduled)) { DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE); @@ -9308,6 +9343,8 @@ Process *schedule(Process *p, int calls) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + if (state & ERTS_PSFLG_FREE) { #ifdef ERTS_SMP ASSERT(esdp->free_process == p); @@ -9468,7 +9505,7 @@ Process *schedule(Process *p, int calls) scheduler_wait(&fcalls, esdp, rq); flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); flags |= ERTS_RUNQ_FLG_EXEC; - + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP non_empty_runq(rq); #endif @@ -9483,6 +9520,8 @@ Process *schedule(Process *p, int calls) * Schedule system-level activities. */ + ERTS_MSACC_PUSH_STATE_CACHED_M(); + erts_smp_atomic32_set_relb(&function_calls, 0); fcalls = 0; @@ -9490,7 +9529,9 @@ Process *schedule(Process *p, int calls) erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); erl_sys_schedule(1); + ERTS_MSACC_POP_STATE_M(); current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -9568,9 +9609,12 @@ Process *schedule(Process *p, int calls) case 0: /* No process at all */ default: ASSERT(qmask == 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); goto check_activities_to_run; } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR); + BM_START_TIMER(system); /* diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 34f91e2ec8..e689547d1d 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -2056,6 +2056,8 @@ erts_atomic64_read_dirty(erts_atomic64_t *var) #endif /* !USE_THREADS */ +#include "erl_msacc.h" + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void @@ -2414,6 +2416,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) { #ifdef USE_THREADS int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_unlock(&mtx->lc); #endif @@ -2432,6 +2435,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) #endif if (res != 0 && res != EINTR) erts_thr_fatal_error(res, "wait on condition variable"); + ERTS_MSACC_POP_STATE(); #endif } @@ -3488,7 +3492,11 @@ ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) { #ifdef USE_THREADS - return ethr_event_wait(&((ethr_ts_event *) ep)->event); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_wait(&((ethr_ts_event *) ep)->event); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3497,7 +3505,11 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) { #ifdef USE_THREADS - return ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3506,8 +3518,12 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_twait(&((ethr_ts_event *) ep)->event, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_twait(&((ethr_ts_event *) ep)->event, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3516,9 +3532,13 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_stwait(&((ethr_ts_event *) ep)->event, - spincount, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_stwait(&((ethr_ts_event *) ep)->event, + spincount, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 3f5925765d..e8a7573e86 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1448,6 +1448,8 @@ ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr) #endif +Eterm erts_msacc_request(Process *c_p, int action, Eterm *threads); + /* ** Call_trace uses this API for the parameter matching functions */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 07578fd24e..41b0fcdd1b 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -706,6 +706,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ error_number = error_type = 0; if (driver->start) { + ERTS_MSACC_PUSH_STATE_M(); if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(port, am_in, am_start); } @@ -716,6 +717,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ DTRACE3(driver_start, process_str, driver->name, port_str); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) @@ -735,6 +737,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); port->caller = NIL; if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(port, am_out, am_start); @@ -1710,6 +1713,7 @@ call_driver_outputv(int bang_op, else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); ErlDrvSizeT size = evp->size; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); @@ -1730,6 +1734,8 @@ call_driver_outputv(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -1810,6 +1816,7 @@ call_driver_output(int bang_op, send_badsig(prt); else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); @@ -1829,6 +1836,8 @@ call_driver_output(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -3473,6 +3482,7 @@ static void flush_port(Port *p) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->flush != NULL) { + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_flush)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) @@ -3482,9 +3492,11 @@ static void flush_port(Port *p) if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_flush); } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->flush)((ErlDrvData)p->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_out, am_flush); } @@ -3532,6 +3544,7 @@ terminate_port(Port *prt) drv = prt->drv_ptr; if ((drv != NULL) && (drv->stop != NULL)) { int fpe_was_unmasked = erts_block_fpe(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_stop)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(connected_id, prt) @@ -3540,6 +3553,7 @@ terminate_port(Port *prt) #endif (*drv->stop)((ErlDrvData)prt->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); #ifdef ERTS_SMP if (prt->xports) erts_port_handle_xports(prt); @@ -3850,6 +3864,7 @@ call_driver_control(Eterm caller, ErlDrvSizeT *from_size) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->control) return ERTS_PORT_OP_BADARG; @@ -3863,6 +3878,8 @@ call_driver_control(Eterm caller, command, size); } #endif + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); prt->caller = caller; cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data, @@ -3873,6 +3890,8 @@ call_driver_control(Eterm caller, *from_size); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres < 0) return ERTS_PORT_OP_BADARG; @@ -4260,6 +4279,7 @@ call_driver_call(Eterm caller, unsigned *ret_flagsp) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->call) return ERTS_PORT_OP_BADARG; @@ -4275,6 +4295,8 @@ call_driver_call(Eterm caller, } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + prt->caller = caller; cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data, command, @@ -4285,6 +4307,8 @@ call_driver_call(Eterm caller, ret_flagsp); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres <= 0 || ((byte) (*resp_bufp)[0]) != VERSION_MAGIC) return ERTS_PORT_OP_BADARG; @@ -4988,6 +5012,7 @@ int get_port_flags(ErlDrvPort ix) void erts_raw_port_command(Port* p, byte* buf, Uint len) { int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -5008,9 +5033,11 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len) DTRACE4(driver_output, "-raw-", port_str, p->name, len); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); } int async_ready(Port *p, void* data) @@ -5022,6 +5049,7 @@ int async_ready(Port *p, void* data) if (p) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->ready_async != NULL) { + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_ready_async)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) @@ -5030,6 +5058,7 @@ int async_ready(Port *p, void* data) #endif (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); need_free = 0; + ERTS_MSACC_POP_STATE_M(); } erts_port_driver_callback_epilogue(p, NULL); @@ -7053,6 +7082,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor); ErlDrvMonitor drv_monitor; int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ASSERT(prt->drv_ptr != NULL); @@ -7064,6 +7094,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) callback = prt->drv_ptr->process_exit; ASSERT(callback != NULL); ref_to_driver_monitor(ref,&drv_monitor); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); DRV_MONITOR_UNLOCK_PDL(prt); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_process_exit)) { @@ -7075,6 +7106,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); erts_unblock_fpe(fpe_was_unmasked); DRV_MONITOR_LOCK_PDL(prt); + ERTS_MSACC_POP_STATE_M(); /* remove monitor *after* callback */ rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref); DRV_MONITOR_UNLOCK_PDL(prt); diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 0ab6661c9f..48cb39333a 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -278,9 +278,14 @@ ErtsMonotonicTime erts_check_next_timeout_time(ErtsSchedulerData *esdp) { ErtsTimerWheel *tiw = esdp->timer_wheel; + ErtsMonotonicTime time; + ERTS_MSACC_DECLARE_CACHE_X(); if (tiw->true_next_timeout_time) return tiw->next_timeout_time; - return find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS); + time = find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_POP_STATE_M_X(); + return time; } #ifndef ERTS_TW_DEBUG @@ -336,6 +341,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { int tiw_pos_ix, slots, yielded_slot_restarted, yield_count; ErtsMonotonicTime bump_to, tmp_slots, old_pos; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; @@ -371,6 +377,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; tiw->pos = bump_to; tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -382,6 +389,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE; tiw->true_next_timeout_time = 1; tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos); + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -400,8 +408,10 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) p = tiw->at_once.head; } - if (tiw->pos >= bump_to) + if (tiw->pos >= bump_to) { + ERTS_MSACC_POP_STATE_M_X(); break; + } if (tiw->nto == 0) goto empty_wheel; @@ -478,6 +488,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = tiw_pos_ix; tiw->yield_slots_left = slots; tiw->yield_start_pos = old_pos; + ERTS_MSACC_POP_STATE_M_X(); return; /* Yield! */ } @@ -500,6 +511,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) /* Search at most two seconds ahead... */ (void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2)); + ERTS_MSACC_POP_STATE_M_X(); } Uint @@ -569,6 +581,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, ErtsMonotonicTime timeout_pos) { ErtsMonotonicTime timeout_time; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); p->u.func.timeout = timeout; p->u.func.cancel = cancel; @@ -612,6 +625,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, tiw->true_next_timeout_time = 1; tiw->next_timeout_time = timeout_time; } + ERTS_MSACC_POP_STATE_M_X(); } void @@ -620,11 +634,13 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) { ErlCancelProc cancel; void *arg; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); remove_timer(tiw, p); cancel = p->u.func.cancel; arg = p->u.func.arg; if (cancel) (*cancel)(arg); + ERTS_MSACC_POP_STATE_M_X(); } } diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 21fa214364..36ee94111c 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -74,6 +74,7 @@ #include "erl_thr_progress.h" #include "erl_driver.h" #include "erl_alloc.h" +#include "erl_msacc.h" #if !defined(ERTS_POLL_USE_EPOLL) \ && !defined(ERTS_POLL_USE_DEVPOLL) \ @@ -2238,6 +2239,7 @@ static ERTS_INLINE int check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) { int res; + ERTS_MSACC_PUSH_STATE_M(); if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0 && timeout_time == ERTS_POLL_NO_TIMEOUT) { /* Nothing to poll and zero timeout; done... */ @@ -2259,6 +2261,7 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); timerfd_set(ps, &its); res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1); res = timerfd_clear(ps, res, max_res); @@ -2268,10 +2271,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) } #else /* !ERTS_POLL_USE_TIMERFD */ timeout = (int) get_timeout(ps, 1000, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); #endif /* !ERTS_POLL_USE_TIMERFD */ #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ @@ -2279,10 +2284,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (max_res > ps->res_events_len) grow_res_events(ps, max_res); timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); #endif /* ----------------------------------------- */ } @@ -2306,26 +2313,33 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (poll_res.dp_nfds > ps->res_events_len) grow_res_events(ps, poll_res.dp_nfds); poll_res.dp_fds = ps->res_events; + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } poll_res.dp_timeout = timeout; res = ioctl(ps->kp_fd, DP_POLL, &poll_res); #elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */ struct timespec ts; timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL); #elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */ timeout = (int) get_timeout(ps, 1000, timeout_time); + + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = poll(ps->poll_fds, ps->no_poll_fds, timeout); #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ SysTimeval to; @@ -2334,18 +2348,22 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds); ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ERTS_SELECT(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, &to); #ifdef ERTS_SMP - if (timeout) + if (timeout) { erts_thr_progress_finalize_wait(NULL); + ERTS_MSACC_POP_STATE_M(); + } if (res < 0 && errno == EBADF && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { @@ -2380,10 +2398,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) return res; #endif /* ----------------------------------------- */ } + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); + } return res; } } diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 466f4a3b48..660ded297a 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -27,6 +27,7 @@ #include "erl_alloc.h" #include "erl_poll.h" #include "erl_time.h" +#include "erl_msacc.h" /* * Some debug macros @@ -1188,16 +1189,19 @@ int erts_poll_wait(ErtsPollSet ps, if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; int num_h = 2; + ERTS_MSACC_PUSH_STATE_M(); HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); WaitForMultipleObjects(num_h, harr, FALSE, timeout); #ifdef ERTS_SMP erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); ERTS_POLLSET_LOCK(ps); HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); woke_up(ps); diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 53c9ba8715..a1b63716a9 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -32,7 +32,7 @@ run_queue_one/1, scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1, run_queues_lengths_active_tasks/1]). + badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). %% Internal exports. @@ -55,7 +55,8 @@ all() -> [{group, wall_clock}, {group, runtime}, reductions, reductions_big, {group, run_queue}, scheduler_wall_time, garbage_collection, io, badarg, - run_queues_lengths_active_tasks]. + run_queues_lengths_active_tasks, + msacc]. groups() -> [{wall_clock, [], @@ -466,3 +467,93 @@ run_queues_lengths_active_tasks(Config) -> TokLoops), ok. + +msacc(doc) -> + "Tests that statistics(microstate_statistics) works."; +msacc(Config) -> + + %% Test if crypto nif is available + Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end, + TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"), + + false = erlang:system_flag(microstate_accounting, true), + + msacc_test(TmpFile), + + true = erlang:system_flag(microstate_accounting, false), + + %% Make sure that all states were triggered at least once + maps:map(fun(nif, 0) -> + case Niff of + ok -> + ct:fail({zero_state,nif}); + nok -> + ok + end; + (aux, 0) -> + %% aux will be zero if we do not have smp support + %% or no async threads + case erlang:system_info(smp_support) orelse + erlang:system_info(thread_pool_size) > 0 of + false -> + ok; + true -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({zero_state,aux}) + end; + (Key, 0) -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({zero_state,Key}); + (_,_) -> ok + end,msacc_sum_states()), + + erlang:system_flag(microstate_accounting, reset), + + msacc_test(TmpFile), + + %% Make sure all counters are zero after stopping and resetting + maps:map(fun(_Key, 0) -> ok; + (Key,_) -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({non_zero_state,Key}) + end,msacc_sum_states()). + +%% This test tries to make sure to trigger all of the different available states +msacc_test(TmpFile) -> + + %% We write some data + [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)], + + %% Do some ETS operations + Tid = ets:new(table, []), + ets:insert(Tid, {1, hello}), + ets:delete(Tid), + + %% Collect some garbage + [erlang:garbage_collect() || _ <- lists:seq(1,100)], + + %% Send some messages + [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)], + + %% Setup some timers + Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)], + + %% Do some nif work + catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)], + + %% Cancel some timers + [erlang:cancel_timer(R) || R <- Refs], + + %% Wait for a while + timer:sleep(100). + +msacc_sum_states() -> + Stats = erlang:statistics(microstate_accounting), + [#{ counters := C }|_] = Stats, + InitialCounters = maps:map(fun(_,_) -> 0 end,C), + lists:foldl(fun(#{ counters := Counters }, Cnt) -> + maps:fold(fun(Key, Value, Acc) -> + NewValue = Value+maps:get(Key,Acc), + maps:update(Key, NewValue, Acc) + end, Cnt, Counters) + end,InitialCounters,Stats). diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 6f56a81eec..ab51cf385c 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2217,6 +2217,16 @@ spawn_opt(_Tuple) -> (io) -> {{input, Input}, {output, Output}} when Input :: non_neg_integer(), Output :: non_neg_integer(); + (microstate_accounting) -> [MSAcc_Thread] | undefined when + MSAcc_Thread :: #{ type => MSAcc_Thread_Type, + id => MSAcc_Thread_Id, + counters => MSAcc_Counters}, + MSAcc_Thread_Type :: scheduler | async | aux, + MSAcc_Thread_Id :: non_neg_integer(), + MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, + MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers; (reductions) -> {Total_Reductions, Reductions_Since_Last_Call} when Total_Reductions :: non_neg_integer(), @@ -2271,6 +2281,9 @@ subtract(_,_) -> (fullsweep_after, Number) -> OldNumber when Number :: non_neg_integer(), OldNumber :: non_neg_integer(); + (microstate_accounting, Action) -> OldState when + Action :: true | false | reset, + OldState :: true | false; (min_heap_size, MinHeapSize) -> OldMinHeapSize when MinHeapSize :: non_neg_integer(), OldMinHeapSize :: non_neg_integer(); diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index c3a14d272d..a15355bb10 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -49,6 +49,9 @@ -export([is_system_process/1]). +-export([await_microstate_accounting_modifications/3, + gather_microstate_accounting_result/2]). + %% Auto import name clash -export([check_process_code/2]). @@ -355,3 +358,28 @@ perf_counter_unit() -> is_system_process(_Pid) -> erlang:nif_error(undefined). + +-spec await_microstate_accounting_modifications(Ref, Result, Threads) -> boolean() when + Ref :: reference(), + Result :: boolean(), + Threads :: pos_integer(). + +await_microstate_accounting_modifications(Ref, Result, Threads) -> + _ = microstate_accounting(Ref,Threads), + Result. + +-spec gather_microstate_accounting_result(Ref, Threads) -> [#{}] when + Ref :: reference(), + Threads :: pos_integer(). + +gather_microstate_accounting_result(Ref, Threads) -> + microstate_accounting(Ref, Threads). + +microstate_accounting(_Ref, 0) -> + []; +microstate_accounting(Ref, Threads) -> + receive + Ref -> microstate_accounting(Ref, Threads - 1); + {Ref, Res} -> + [Res | microstate_accounting(Ref, Threads - 1)] + end. diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0292333f0a..38725807ae 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -41,7 +41,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 system_information.xml +XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml diff --git a/lib/runtime_tools/doc/src/msacc.xml b/lib/runtime_tools/doc/src/msacc.xml new file mode 100644 index 0000000000..129da3d230 --- /dev/null +++ b/lib/runtime_tools/doc/src/msacc.xml @@ -0,0 +1,305 @@ + + + + +

+ + 20142014 + Ericsson AB. All Rights Reserved. + + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + + Microstate Accounting + Lukas Larsson + + 1 + + + 14-09-30 + A + msacc.xml +
+ msacc + Convenience functions for microstate accounting + +

This module implements some convenience functions for analyzing + microstate accounting data. For details about how to use the basic api and + what the different states represent see + + erlang:statistics(microstate_accounting).

+ +

Basic Scenario

+ 
1> msacc:start(1000).
+ok
+2> msacc:print().
+Average thread real-time    : 1000513 us
+Accumulated system run-time :    2213 us
+Average scheduler run-time  :    1076 us
+
+        Thread      aux check_io emulator       gc    other     port    sleep
+
+Stats per thread:
+     async( 0)    0.00%    0.00%    0.00%    0.00%    0.00%    0.00%  100.00%
+     async( 1)    0.00%    0.00%    0.00%    0.00%    0.00%    0.00%  100.00%
+       aux( 1)    0.00%    0.00%    0.00%    0.00%    0.00%    0.00%   99.99%
+ scheduler( 1)    0.00%    0.03%    0.13%    0.00%    0.01%    0.00%   99.82%
+ scheduler( 2)    0.00%    0.00%    0.00%    0.00%    0.03%    0.00%   99.97%
+
+Stats per type:
+         async    0.00%    0.00%    0.00%    0.00%    0.00%    0.00%  100.00%
+           aux    0.00%    0.00%    0.00%    0.00%    0.00%    0.00%   99.99%
+     scheduler    0.00%    0.02%    0.06%    0.00%    0.02%    0.00%   99.89%
+ok
+
+

This first command enables microstate accounting for 1000 milliseconds. + See start/0, + stop/0, + reset/0 and + start/1 for more details. + The second command prints the statistics gathered during that time. + First three general statistics are printed.

+ + Average real-time + The average time spent collecting data in the threads. + This should be close to the time which data was collected. + + System run-time + The total run-time of all threads in the system. + This is what you get if you call msacc:stats(total_runtime,Stats). + + Average scheduler run-time + The average run-time for the schedulers. + This is the average amount of time the schedulers did not sleep. + +

Then one column per state is printed with a the percentage of time this + thread spent in the state out of it's own real-time. After the thread + specific time, the accumulated time for each type of thread is printed in + a similar format.

+

Since we have the average real-time and the percentage spent in each + state we can easily calculate the time spent in each state by multiplying + Average thread real-time with Thread state %, i.e. to + get the time Scheduler 1 spent in the emulator state we do + 1000513us * 0.13% = 1300us.

+ + + + + + + + + + +

A map containing the different microstate accounting states and + the number of microseconds spent in it.

 + + + + + + +

A map containing information about a specific thread. The + percentages in the map can be either run-time or real-time depending + on if runtime or realtime was requested from + stats/2. system is the + percentage of total system time for this specific thread.

 + + + +

A map containing the different microstate accounting states. Each + value in the map contains another map with the percentage of time that + this thread has spent in the specific state. Both the percentage of + system time and the time for that specific thread is part of + the map.

 + + + + + + + + + +

The different states that a thread can be in. See + + erlang:statistics(microstate_accounting) for details. +

+ + + +

The different options that can be given to + print/2. +

+ + + + + + Check if microstate accounting is available + +

This function checks whether microstate accounting + is available or not.

+ + + + + Start microstate accounting. + +

Start microstate accounting. Returns whether it was + previously enabled or disabled.

+ + + + + Start microstate accounting for a time. + +

Resets all counters and then starts microstate accounting + for the given milliseconds.

+ + + + + Stop microstate accounting. + +

Stop microstate accounting. + Returns whether is was previously enabled or disabled.

+ + + + + Reset microstate accounting counters + +

Reset microstate accounting counters. + Returns whether is was enabled or disabled.

+ + + + + Print microstate statistics + +

+ Prints the current microstate accounting to standard out. + Same as + + msacc:print(msacc:stats(),#{}). + +

+ + + + + Print microstate statistics + +

Print the given microstate statistics values to stdout. + Same as + + msacc:print(DataOrStats,#{}). + +

+ + + + + Print microstate statistics + +

Print the given microstate statistics values to standard out. + With many states this can be quite verbose. See the top of this + reference manual for a brief description of what the fields mean.

+

It is possible to print more specific types of statistics by + first manipulating the DataOrStats using + stats/2. + For instance if you want to print the percentage of run-time for each + thread you can do:

+ 
msacc:print(msacc:stats(runtime,msacc:stats())).
+

If you want to only print run-time per thread type you can do:

+ 
msacc:print(msacc:stats(type,msacc:stats(runtime,msacc:stats()))).
+

Options

+ + systemPrint percentage of time spent in each + state out of system time as well as thread time. + Default: false. + + + + + + Print microstate statistics + +

Print the given microstate statistics values to the given file + or device. The other arguments behave the same way as for + print/2.

+ + + + + + +

Returns a runtime system independent version of the microstate + statistics data presented by + + erlang:statistics(microstate_accounting). + All counters have been normalized to be in microsecond resolution.

+ + + + + + +

Returns the system time for the given microstate statistics values. + System time is the accumulated time of all threads.

+ + realtime + Returns all time recorded for all threads. + runtime + Returns all time spent doing work for all threads, i.e. + all time not spent in the sleep state. + + + + + + + +

Returns fractions of real-time or run-time spent in the various + threads from the given microstate statistics values.

+ + + + + + +

Returns a list of microstate statistics values where the values + for all threads of the same type has been merged.

+ + + + + + +

Dumps the current microstate statistics counters to a file that can + be parsed with + file:consult/1.

+ + + + + + +

Read a file dump produced by + to_file(Filename).

+ + + + diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml index ea0c0832a4..8657a07a30 100644 --- a/lib/runtime_tools/doc/src/ref_man.xml +++ b/lib/runtime_tools/doc/src/ref_man.xml @@ -36,6 +36,7 @@ + diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml index d4c3c9dfe6..978bd39e55 100644 --- a/lib/runtime_tools/doc/src/specs.xml +++ b/lib/runtime_tools/doc/src/specs.xml @@ -1,4 +1,5 @@ + diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 99b90f9ec5..3b41184f4e 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -45,7 +45,9 @@ MODULES= \ percept_profile \ system_information \ observer_backend \ - ttb_autostart + ttb_autostart\ + msacc + HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl new file mode 100644 index 0000000000..612effa5aa --- /dev/null +++ b/lib/runtime_tools/src/msacc.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% @doc Microstate accounting utility function +%% +%% This module provides a user interface for analysing +%% erlang:statistics(microstate_accounting) data. +%% + +-module(msacc). +-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1, + from_file/1, stats/0, stats/2, print/0, print/1, print/2, + print/3]). + +-type msacc_data() :: [msacc_data_thread()]. + +-type msacc_data_thread() :: #{ '$type' => msacc_data, + type => msacc_type(), id => msacc_id(), + counters => msacc_data_counters() }. +-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. + +-type msacc_stats() :: [msacc_stats_thread()]. +-type msacc_stats_thread() :: #{ '$type' => msacc_stats, + type => msacc_type(), id => msacc_id(), + system => float(), + counters => msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), + system => float()}}. + + +-type msacc_type() :: scheduler | aux | async. +-type msacc_id() :: non_neg_integer(). +-type msacc_state() :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers. + +-type msacc_print_options() :: #{ system => boolean() }. + +-spec available() -> boolean(). +available() -> + try + [_|_] = erlang:statistics(microstate_accounting), + true + catch _:_ -> + false + end. + +-spec start() -> boolean(). +start() -> + erlang:system_flag(microstate_accounting, true). + +-spec stop() -> boolean(). +stop() -> + erlang:system_flag(microstate_accounting, false). + +-spec reset() -> boolean(). +reset() -> + erlang:system_flag(microstate_accounting, reset). + +-spec start(Time) -> true when + Time :: timeout(). +start(Tmo) -> + stop(), reset(), start(), + timer:sleep(Tmo), + stop(). + +-spec to_file(Filename) -> ok | {error, file:posix()} when + Filename :: file:name_all(). +to_file(Filename) -> + file:write_file(Filename, io_lib:format("~p.~n",[stats()])). + +-spec from_file(Filename) -> msacc_data() when + Filename :: file:name_all(). +from_file(Filename) -> + {ok, [Stats]} = file:consult(Filename), + Stats. + +-spec print() -> ok. +print() -> + print(stats()). + +-spec print(DataOrStats) -> ok when + DataOrStats :: msacc_data() | msacc_stats(). +print(Stats) -> + print(Stats, #{}). + +-spec print(DataOrStats, Options) -> ok when + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Stats, Options) -> + print(group_leader(), Stats, Options). + +-spec print(FileOrDevice, DataOrStats, Options) -> ok when + FileOrDevice :: file:filename() | io:device(), + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Filename, Stats, Options) when is_list(Filename) -> + case file:open(Filename,[write]) of + {ok, D} -> print(D, Stats, Options),file:close(D); + Error -> Error + end; +print(Device, Stats, Options) -> + DefaultOpts = #{ system => false }, + print_int(Device, Stats, maps:merge(DefaultOpts, Options)). +print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) -> + TypeStats = stats(type, Stats), + io:format(Device, "~s", [print_stats_overview(Stats, Options)]), + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads( + stats(realtime, Stats), Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, TypeStats), Options)]); +print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + msacc:stats(type, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type(Stats, Options)]). + + +-spec stats() -> msacc_data(). +stats() -> + Fun = fun F(K,{PerfCount,StateCount}) -> + %% Need to handle ERTS_MSACC_STATE_COUNTERS + {F(K,PerfCount),StateCount}; + F(_K,PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000000) + end, + UsStats = lists:map( + fun(#{ counters := Cnt } = M) -> + UsCnt = maps:map(Fun,Cnt), + M#{ '$type' => msacc_data, counters := UsCnt } + end, erlang:statistics(microstate_accounting)), + statssort(UsStats). + +-spec stats(Analysis, Stats) -> non_neg_integer() when + Analysis :: system_realtime | system_runtime, + Stats :: msacc_data(); + (Analysis, Stats) -> msacc_stats() when + Analysis :: realtime | runtime, + Stats :: msacc_data(); + (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when + Analysis :: type, + StatsOrData :: msacc_data() | msacc_stats(). +stats(system_realtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(Cnt, Acc) + end, 0, Stats); +stats(system_runtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(maps:remove(sleep, Cnt), Acc) + end, 0, Stats); +stats(realtime, Stats) -> + RealTime = stats(system_realtime, Stats), + statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]); +stats(runtime, Stats) -> + RunTime = stats(system_runtime, Stats), + statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime) + || T = #{ counters := Cnt } <- Stats]); +stats(type, Stats) -> + statssort(merge_threads(Stats, [])). + +print_stats_overview(Stats, _Options) -> + RunTime = stats(system_runtime, Stats), + RealTime = stats(system_realtime, Stats) div length(Stats), + SchedStats = [S || #{ type := scheduler } = S <- Stats], + AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats), + NumSize = if + RealTime > RunTime -> length(integer_to_list(RealTime)); + true -> length(integer_to_list(RunTime)) + end, + [io_lib:format("Average thread real-time : ~*B us~n", + [NumSize, RealTime]), + io_lib:format("Accumulated system run-time : ~*B us~n", + [NumSize, RunTime]), + io_lib:format("Average scheduler run-time : ~*B us~n", + [NumSize, AvgSchedRunTime]), + io_lib:format("~n",[])]. + +print_stats_threads(Stats, Options) -> + [io_lib:format("~nStats per thread:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + +print_stats_type(Stats, Options) -> + [io_lib:format("~nStats per type:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + + +print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) -> + [io_lib:format("~14s", ["Thread"]), + map(fun(Counter, _) when PrintSys-> + io_lib:format("~9s ", [atom_to_list(Counter)]); + (Counter, _) -> + io_lib:format("~9s", [atom_to_list(Counter)]) + end, Cnt), + io_lib:format("~n",[])]. + +print_thread_info(#{ '$type' := msacc_stats, + counters := Cnt } = Thread, #{ system := PrintSys }) -> + [case maps:find(id, Thread) of + error -> + io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]); + {ok, Id} -> + io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id]) + end, + map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys -> + io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]); + (_Key, #{ thread := ThreadPerc }) -> + io_lib:format("~8.2f%", [ThreadPerc]) + end, Cnt), + io_lib:format("~n",[])]. + +get_total(Cnt, Base) -> + maps:fold(fun(_, {Val,_}, Time) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + Time + Val; + (_, Val, Time) -> Time + Val + end, Base, Cnt). + +get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread, + SystemTime) -> + ThreadTime = get_total(Cnt, 0), + Thread#{ '$type' := msacc_stats, + system => percentage(ThreadTime,SystemTime), + counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}. +get_thread_perc(Cnt, ThreadTime, SystemTime) -> + maps:map(fun F(Key, {Val, C}) -> + M = F(Key, Val), + M#{ cnt => C }; + F(_Key, Val) -> + #{ thread => percentage(Val, ThreadTime), + system => percentage(Val, SystemTime) } + end, Cnt). + +%% This code is a little bit messy as it has to be able to deal with +%% both [msacc_data()] and [msacc_stats()]. +merge_threads([#{ '$type' := msacc_stats, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]); + #{ '$type' := msacc_stats, counters := Cnt0, + threads := Threads, system := System } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0), + system := System + maps:get(system, M0), + threads := Threads + 1}, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], [#{ '$type' := msacc_stats, + system := System, + threads := Threads, + counters := Cnt} = M0|R]) -> + Counters = maps:map(fun(_,#{ thread := Thr } = Map) -> + Map#{ thread := Thr / Threads } + end, Cnt), + M = maps:remove(threads, M0), + [M#{ system := System, counters := Counters} | merge_threads([],R)]; +merge_threads([], []) -> + []; +%% The clauses below deal with msacc_data() +merge_threads([#{ '$type' := msacc_data, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0)|Acc]); + #{ '$type' := msacc_data, counters := Cnt0 } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0) }, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], Acc) -> + Acc. + +add_counters(M1, M2) -> + maps:map( + fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2, + cnt => Cnt1 + Cnt2 }; + (Key, #{ thread := Thr1, system := Sys1}) -> + #{ thread := Thr2, system := Sys2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2}; + (Key, {V1,C1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2}; + (Key, V1) -> maps:get(Key, M2) + V1 + end, M1). + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +keyfind(Key, Value, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + H; + _ -> + keyfind(Key, Value, T) + end; +keyfind(_, _, []) -> + false. + +keyreplace(Key, Value, NewMap, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + [NewMap|T]; + _ -> + [H|keyreplace(Key, Value, NewMap, T)] + end; +keyreplace(_, _, _, []) -> + []. + +statssort(Stats) -> + lists:sort(fun(#{ type := Type1, id := Id1}, + #{ type := Type2, id := Id2}) -> + {Type1, Id1} < {Type2, Id2}; + (#{ type := Type1}, #{ type := Type2}) -> + Type1 < Type2 + end, Stats). + +map(Fun,Map) -> + [ Fun(K,V) || {K,V} <- maps:to_list(Map) ]. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index ad10655aa0..aeda103e72 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {vsn, "%VSN%"}, {modules, [appmon_info, dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, - ttb_autostart,dyntrace,system_information]}, + ttb_autostart,dyntrace,system_information, + msacc]}, {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, {env, []}, diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index dcb9082231..71ac8b1157 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -7,7 +7,8 @@ MODULES = \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ - erts_alloc_config_SUITE + erts_alloc_config_SUITE \ + msacc_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/test/msacc_SUITE.erl b/lib/runtime_tools/test/msacc_SUITE.erl new file mode 100644 index 0000000000..145a6d07fb --- /dev/null +++ b/lib/runtime_tools/test/msacc_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(msacc_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Test server callbacks +-export([suite/0, all/0]). + +%% Test cases +-export([ + %% API-test + api_file/1, + api_start_stop/1, + api_timer/1, + api_print/1 + ]). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- +all() -> + [ + api_start_stop, + api_file, + api_timer, + api_print + ]. + +suite() -> [ + {timetrap,{minutes,1}}, + {ct_hooks,[ts_install_cth]} + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +api_timer(_Config) -> + + %% Run msacc for about 100ms + msacc:start(100), + + %% Verify that scheduler 1 executed+slept for about 100ms + [Sched1] = [S || S = #{ type := scheduler, id := 1 } <- msacc:stats()], + + #{ counters := Cnt } = Sched1, + + %% Time should be in us + Time = maps:fold(fun(_,V,Acc) -> V + Acc end, 0, Cnt), + + if Time < 120000 andalso Time > 80000 -> ok; + true -> ct:fail({inaccurate_time, Time, msacc:stats()}) + end. + +%% We just do a basic check that none of the apis crash +api_start_stop(_Config) -> + msacc:start(), + timer:sleep(100), + msacc:stop(), + Runtime = msacc:stats(system_runtime, msacc:stats()), + Realtime = msacc:stats(system_realtime, msacc:stats()), + true = Runtime < Realtime, + + RuntimeCnt = msacc:stats(runtime, msacc:stats()), + RealtimeCnt = msacc:stats(realtime, msacc:stats()), + TypeCnt = msacc:stats(type, msacc:stats()), + + %% These should be very similar + RuntimeTypeCnt = msacc:stats(type, RuntimeCnt), + TypeRuntimeCnt = msacc:stats(runtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RuntimeTypeCnt, + TypeRuntimeCnt}) + end + end, lists:zip(RuntimeTypeCnt, TypeRuntimeCnt)), + + %% These should be very similar + RealtimeTypeCnt = msacc:stats(type, RealtimeCnt), + TypeRealtimeCnt = msacc:stats(realtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RealtimeTypeCnt, + TypeRealtimeCnt}) + end + end,lists:zip(RealtimeTypeCnt, TypeRealtimeCnt)), + + msacc:reset(). + +api_file(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + File = filename:join(PrivDir, "msacc.stats"), + Stats = msacc:stats(), + ok = msacc:to_file(File), + Stats = msacc:from_file(File), + + PrintFile = filename:join(PrivDir, "msacc.txt"), + msacc:print(PrintFile, Stats, #{}). + +%% We just check that it is possible to print in a couple of different ways +api_print(_Config) -> + msacc:start(100), + io:format("msacc:print(msacc:stats()).~n"), + msacc:print(msacc:stats()), + io:format("msacc:print(msacc:stats(),#{ system => true }).~n"), + msacc:print(msacc:stats(), #{ system => true }), + io:format("msacc:print(msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(runtime, msacc:stats())), + io:format("msacc:print(msacc:stats(type,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats())), + io:format("msacc:print(msacc:stats(realtime,msacc:stats())).~n"), + msacc:print(msacc:stats(realtime, msacc:stats())), + io:format("msacc:stats(type,msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats(runtime, msacc:stats()))). -- cgit v1.2.3 From c62f0216c37340e8716938b9408a40cd5b4e1d62 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 15 Jul 2015 11:34:13 +0200 Subject: erts: Fix msacc win32 debug compile error --- erts/emulator/beam/beam_emu.c | 2 +- erts/emulator/beam/erl_msacc.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 14b81a0a6e..4be311ae82 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1252,7 +1252,7 @@ void process_main(void) Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; - ERTS_MSACC_DECLARE_CACHE_X(); /* a cached value of the tsd pointer for msacc */ + ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */ ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h index de72fe9597..1b4b7a408a 100644 --- a/erts/emulator/beam/erl_msacc.h +++ b/erts/emulator/beam/erl_msacc.h @@ -228,7 +228,7 @@ void erts_msacc_init_thread(char *type, int id, int liberty); #define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled) #define ERTS_MSACC_DECLARE_CACHE() \ ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \ - ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER + ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER; #define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL) #define ERTS_MSACC_UPDATE_CACHE() \ __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL -- cgit v1.2.3 From 49458ee51bbbdcb06d776a846ce61a4eb274df04 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 15 Jul 2015 11:34:35 +0200 Subject: erts: use correct function for perf counter on non-x86 --- erts/emulator/sys/unix/erl_unix_sys.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 9f137048de..3a03d6be49 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -289,7 +289,7 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) } while(0) #define SYS_PERF_COUNTER_UNIT erts_perf_counter_unit() #else -#define sys_perf_counter(ts) *(ts) = erts_get_perf_counter() +#define sys_perf_counter(ts) *(ts) = erts_sys_hrtime() #define SYS_PERF_COUNTER_UNIT 1000000000LL #endif -- cgit v1.2.3 From 2181f97655906dac3b18333c149c384e1dc81c2b Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 15 Jul 2015 13:56:58 +0200 Subject: erts: Fix hrtime for windows --- erts/emulator/sys/win32/sys_time.c | 1 + 1 file changed, 1 insertion(+) diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index 9e5f78703a..3b4fd26d63 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -397,6 +397,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func; erts_sys_time_data__.r.o.os_times = os_times_func; + erts_sys_time_data__.r.o.sys_hrtime = sys_hrtime_func; init_resp->os_monotonic_time_unit = time_unit; init_resp->have_os_monotonic_time = 1; init_resp->have_corrected_os_monotonic_time = 0; -- cgit v1.2.3 From dc1e3933e633d9d7527e6df044895d12d3845e14 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 16 Jul 2015 11:24:51 +0200 Subject: erts: Add rdtscp instruction check --- erts/include/internal/ethr_internal.h | 1 - erts/include/internal/ethread.h | 5 +++++ erts/lib_src/common/ethr_aux.c | 15 +++++++++++++++ 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h index d4ded6ff05..693b34df61 100644 --- a/erts/include/internal/ethr_internal.h +++ b/erts/include/internal/ethr_internal.h @@ -92,7 +92,6 @@ void ethr_run_exit_handlers__(void); void ethr_ts_event_destructor__(void *vtsep); #if defined(ETHR_X86_RUNTIME_CONF__) -int ethr_x86_have_cpuid__(void); void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx); #endif diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 4eeb7097f4..9956473057 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -282,6 +282,10 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file, (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1)) # define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0)) +# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \ + (__builtin_expect(ethr_runtime__.conf.have_rdtscp != 0, 1)) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \ + (__builtin_expect(ethr_runtime__.conf.have_rdtscp == 0, 0)) #endif #if (defined(__GNUC__) \ @@ -300,6 +304,7 @@ typedef struct { #if defined(ETHR_X86_RUNTIME_CONF__) int have_dw_cmpxchg; int have_sse2; + int have_rdtscp; #endif #if defined(ETHR_PPC_RUNTIME_CONF__) int have_lwsync; diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index 56fecf81b8..fbd870c2b5 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -139,6 +139,21 @@ x86_init(void) #endif /* bit 26 of edx is set if we have sse2 */ ethr_runtime__.conf.have_sse2 = (edx & (1 << 26)); + + /* check if we have extended feature set */ + eax = 0x80000000; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + if (eax >= 0x80000001) { + /* Get the extended feature set */ + eax = 0x80000001; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + } else { + eax = ebx = ecx = edx = 0; + } + + /* bit 27 of edx is set if we have rdtscp */ + ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27)); } #endif /* ETHR_X86_RUNTIME_CONF__ */ -- cgit v1.2.3 From 0399f5fc547ef035c4eb5e383f30b28ae73d936e Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 16 Jul 2015 11:27:00 +0200 Subject: erts: Refactor perf counter internal interface perf counter is now part of the function pointer interface and also the function returns the value instead of writing to a memory buffer. --- erts/emulator/beam/beam_emu.c | 4 +- erts/emulator/beam/erl_msacc.c | 14 ++--- erts/emulator/beam/erl_msacc.h | 8 +-- erts/emulator/beam/erl_time.h | 2 +- erts/emulator/beam/erl_time_sup.c | 66 +------------------- erts/emulator/sys/unix/erl_unix_sys.h | 35 +++++------ erts/emulator/sys/unix/sys_time.c | 112 ++++++++++++++++++++++++++++++++++ erts/emulator/sys/win32/erl_win_sys.h | 16 ++++- 8 files changed, 158 insertions(+), 99 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4be311ae82..9f143c22bf 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4938,10 +4938,10 @@ do { \ it has to be very very fast */ OpCase(i_perf_counter): { BeamInstr* next; - ErtsSysHrTime ts; + ErtsSysPerfCounter ts; PreFetch(0, next); - sys_perf_counter(&ts); + ts = erts_sys_perf_counter(); if (IS_SSMALL(ts)) { r(0) = make_small((Sint)ts); diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index bf1c06dea7..71e3fd8b6e 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -117,7 +117,7 @@ void erts_msacc_init_thread(char *type, int id, int managed) { #ifdef ERTS_MSACC_ALWAYS_ON ERTS_MSACC_TSD_SET(msacc); - sys_perf_counter(&msacc->perf_counter); + msacc->perf_counter = erts_sys_perf_counter(); msacc->state = ERTS_MSACC_STATE_OTHER; #endif } @@ -278,7 +278,7 @@ reply_msacc(void *vmsaccrp) if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) { msacc = get_msacc(); - sys_perf_counter(&msacc->perf_counter); + msacc->perf_counter = erts_sys_perf_counter(); msacc->state = ERTS_MSACC_STATE_OTHER; @@ -412,9 +412,9 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads) for (i = 0; i < unmanaged_count; i++) { erts_mtx_lock(&unmanaged[i]->mtx); if (unmanaged[i]->perf_counter) { - ErtsSysHrTime perf_counter; + ErtsSysPerfCounter perf_counter; /* if enabled update stats */ - sys_perf_counter(&perf_counter); + perf_counter = erts_sys_perf_counter(); unmanaged[i]->perf_counters[unmanaged[i]->state] += perf_counter - unmanaged[i]->perf_counter; unmanaged[i]->perf_counter = perf_counter; @@ -439,7 +439,7 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads) erts_rwmtx_rlock(&msacc_mutex); for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { erts_mtx_lock(&msacc->mtx); - sys_perf_counter(&msacc->perf_counter); + msacc->perf_counter = erts_sys_perf_counter(); /* we assume the unmanaged thread is sleeping */ msacc->state = ERTS_MSACC_STATE_SLEEP; erts_mtx_unlock(&msacc->mtx); @@ -448,12 +448,12 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads) break; } case ERTS_MSACC_DISABLE: { - ErtsSysHrTime perf_counter; + ErtsSysPerfCounter perf_counter; erts_rwmtx_rlock(&msacc_mutex); /* make sure to update stats with latest results */ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { erts_mtx_lock(&msacc->mtx); - sys_perf_counter(&perf_counter); + perf_counter = erts_sys_perf_counter(); msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter; msacc->perf_counter = 0; erts_mtx_unlock(&msacc->mtx); diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h index 1b4b7a408a..284388f7aa 100644 --- a/erts/emulator/beam/erl_msacc.h +++ b/erts/emulator/beam/erl_msacc.h @@ -121,8 +121,8 @@ typedef struct erl_msacc_t_ ErtsMsAcc; struct erl_msacc_t_ { /* the the values below are protected by mtx iff unmanaged = 1 */ - ErtsSysHrTime perf_counter; - ErtsSysHrTime perf_counters[ERTS_MSACC_STATE_COUNT]; + ErtsSysPerfCounter perf_counter; + ErtsSysPerfCounter perf_counters[ERTS_MSACC_STATE_COUNT]; #ifdef ERTS_MSACC_STATE_COUNTERS Uint64 state_counters[ERTS_MSACC_STATE_COUNT]; #endif @@ -324,14 +324,14 @@ void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) ERTS_MSACC_INLINE void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) { - ErtsSysHrTime prev_perf_counter; + ErtsSysPerfCounter prev_perf_counter; Sint64 diff; if (new_state == msacc->state) return; prev_perf_counter = msacc->perf_counter; - sys_perf_counter(&msacc->perf_counter); + msacc->perf_counter = erts_sys_perf_counter(); diff = msacc->perf_counter - prev_perf_counter; ASSERT(diff >= 0); msacc->perf_counters[msacc->state] += diff; diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 446adcf4af..5242063550 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -142,7 +142,7 @@ erts_time_unit_conversion(Uint64 value, Uint32 from_time_unit, Uint32 to_time_unit); -ErtsSysHrTime erts_perf_counter_unit(void); +ErtsSysPerfCounter erts_perf_counter_unit(void); #if ERTS_GLB_INLINE_INCL_FUNC_DEF diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 6509c6a805..98159fdf72 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -2444,72 +2444,10 @@ BIF_RETTYPE os_system_time_1(BIF_ALIST_1) BIF_RETTYPE os_perf_counter_0(BIF_ALIST_0) { - ErtsSysHrTime pcounter; - sys_perf_counter(&pcounter); - BIF_RET(make_time_val(BIF_P, pcounter)); + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter())); } BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0) { - BIF_RET(make_time_val(BIF_P, SYS_PERF_COUNTER_UNIT)); -} - -/* What resolution to spin to in micro seconds */ -#define RESOLUTION 100 -/* How many iterations to spin */ -#define ITERATIONS 1 -/* How many significant figures to round to */ -#define SIGFIGS 3 - -static ErtsSysHrTime perf_counter_unit = 0; - -static ErtsSysHrTime erts_calculate_perf_counter_unit(void); -static ErtsSysHrTime erts_calculate_perf_counter_unit() { - int i; - ErtsSysHrTime pre, post; - double value = 0; - double round_factor; -#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME) - struct timespec basetime,comparetime; -#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg) -#define __GETUSEC(arg) (arg.tv_nsec / 1000) -#else - SysTimeval basetime,comparetime; -#define __GETTIME(arg) sys_gettimeofday(arg) -#define __GETUSEC(arg) arg.tv_usec -#endif - - for (i = 0; i < ITERATIONS; i++) { - /* Make sure usec just flipped over at current resolution */ - __GETTIME(&basetime); - do { - __GETTIME(&comparetime); - } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); - - sys_perf_counter(&pre); - - __GETTIME(&basetime); - do { - __GETTIME(&comparetime); - } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); - - sys_perf_counter(&post); - - value += post - pre; - } - /* After this value is ticks per us */ - value /= (RESOLUTION*ITERATIONS); - - /* We round to 3 significant figures */ - round_factor = pow(10.0, SIGFIGS - ceil(log10(value))); - value = ((ErtsSysHrTime)(value * round_factor + 0.5)) / round_factor; - - /* convert to ticks per second */ - return 1000000 * value; -} - -ErtsSysHrTime erts_perf_counter_unit() { - if (perf_counter_unit == 0) - perf_counter_unit = erts_calculate_perf_counter_unit(); - return perf_counter_unit; + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter_unit())); } diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 3a03d6be49..8b1822ca9f 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -161,6 +161,7 @@ typedef long long ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsSysHrTime ErtsSysPerfCounter; #define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63) #define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN) @@ -209,6 +210,7 @@ ErtsSystemTime erts_os_system_time(void); * It may or may not be monotonic. */ ErtsSysHrTime erts_sys_hrtime(void); +#define ERTS_HRTIME_UNIT (1000*1000*1000) struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ @@ -217,6 +219,8 @@ struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *); #endif + ErtsSysPerfCounter (*perf_counter)(void); + ErtsSysPerfCounter perf_counter_unit; int ticks_per_sec; }; @@ -273,25 +277,18 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) * Functions for getting the performance counter */ -#if defined(__x86_64__) - /* available on all x86_64. Best if used when we have constant_tsc and - nonstop_tsc cpu features. It may have been a good idea to put the - cpuid instruction before the rdtsc, but I decided against it - because it is not really needed for msacc, and it slows it down by - quite a bit. As a result though, this timestamp becomes much less - accurate as it might be re-ordered to be executed way before this - function is called. - */ -#define sys_perf_counter(ts) do { \ - __asm__ __volatile__ ("rdtsc\n\t" \ - "shl $32, %%rdx\n\t" \ - "or %%rdx, %0" : "=a" (*ts) : : "rdx"); \ - } while(0) -#define SYS_PERF_COUNTER_UNIT erts_perf_counter_unit() -#else -#define sys_perf_counter(ts) *(ts) = erts_sys_hrtime() -#define SYS_PERF_COUNTER_UNIT 1000000000LL -#endif +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); +#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter() +{ + return (*erts_sys_time_data__.r.o.perf_counter)(); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ /* * Functions for measuring CPU time diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index 6fc4fc7dc4..9738a8c352 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -65,6 +65,8 @@ # include #endif +static void init_perf_counter(void); + /******************* Routines for time measurement *********************/ #undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ @@ -404,6 +406,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) # error Missing erts_os_system_time() implementation #endif + init_perf_counter(); + } void @@ -908,6 +912,114 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) #endif +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Performance counter functions * +\* */ + + +/* What resolution to spin to in micro seconds */ +#define RESOLUTION 100 +/* How many iterations to spin */ +#define ITERATIONS 1 +/* How many significant figures to round to */ +#define SIGFIGS 3 + +static ErtsSysPerfCounter calculate_perf_counter_unit(void) { + int i; + ErtsSysPerfCounter pre, post; + double value = 0; + double round_factor; +#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME) + struct timespec basetime,comparetime; +#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg) +#define __GETUSEC(arg) (arg.tv_nsec / 1000) +#else + SysTimeval basetime,comparetime; +#define __GETTIME(arg) sys_gettimeofday(arg) +#define __GETUSEC(arg) arg.tv_usec +#endif + + for (i = 0; i < ITERATIONS; i++) { + /* Make sure usec just flipped over at current resolution */ + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + pre = erts_sys_perf_counter(); + + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + post = erts_sys_perf_counter(); + + value += post - pre; + } + /* After this value is ticks per us */ + value /= (RESOLUTION*ITERATIONS); + + /* We round to 3 significant figures */ + round_factor = pow(10.0, SIGFIGS - ceil(log10(value))); + value = ((ErtsSysPerfCounter)(value * round_factor + 0.5)) / round_factor; + + /* convert to ticks per second */ + return 1000000 * value; +} + +static int have_rdtscp(void) +{ +#if defined(ETHR_X86_RUNTIME_CONF__) + /* On early x86 cpu's the tsc varies with + the current speed of the cpu, which means that the time per + tick vary depending on the current load of the cpu. We do not + want this as it would give very scewed numbers when the cpu is + mostly idle. + If we have the rdtscp feature it is a sign that the cpu is + relatively modern, and thus the tsc quite stable so we use it then. + + If this test is not good enough, I don't know what we'll do. + Maybe fallback on erts_sys_hrtime always, but that would be a shame as + rdtsc is about 3 times faster than hrtime... */ + return ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__; +#else + return 0; +#endif +} + +static ErtsSysPerfCounter rdtsc(void) +{ + /* It may have been a good idea to put the cpuid instruction before + the rdtsc, but I decided against it because it is not really + needed for msacc, and it slows it down by quite a bit (5-7 times slower). + As a result though, this timestamp becomes much less + accurate as it might be re-ordered to be executed way before or after this + function is called. + */ + ErtsSysPerfCounter ts; +#if defined(__x86_64__) + __asm__ __volatile__ ("rdtsc\n\t" + "shl $32, %%rdx\n\t" + "or %%rdx, %0" : "=a" (ts) : : "rdx"); +#elif defined(__i386__) + __asm__ __volatile__ ("rdtsc\n\t" + : "=A" (ts) ); +#endif + return ts; +} + +static void init_perf_counter(void) +{ + if (have_rdtscp()) { + erts_sys_time_data__.r.o.perf_counter = rdtsc; + erts_sys_time_data__.r.o.perf_counter_unit = calculate_perf_counter_unit(); + } else { + erts_sys_time_data__.r.o.perf_counter = erts_sys_hrtime; + erts_sys_time_data__.r.o.perf_counter_unit = ERTS_HRTIME_UNIT; + } +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ #ifdef HAVE_GETHRVTIME_PROCFS_IOCTL diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 1ab9eadefd..99c1066ab3 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -183,6 +183,7 @@ typedef LONGLONG ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsMonotonicTime ErtsSysPerfCounter; ErtsSystemTime erts_os_system_time(void); @@ -213,6 +214,7 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void); ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *); ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void); +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -234,12 +236,22 @@ erts_sys_hrtime(void) return (*erts_sys_time_data__.r.o.sys_hrtime)(); } +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter(void) +{ + return (*erts_sys_time_data__.r.o.sys_hrtime)(); +} + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter_unit(void) +{ + return 1000 * 1000 * 1000; +} + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ extern void sys_gettimeofday(SysTimeval *tv); extern clock_t sys_times(SysTimes *buffer); -#define sys_perf_counter(ts) *(ts) = erts_sys_hrtime() -#define SYS_PERF_COUNTER_UNIT ERTS_I64_LITERAL(1000000000) extern char *win_build_environment(char *); -- cgit v1.2.3 From 6090f9c7e9b0ddbccef357641c1455475b348e94 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 16 Jul 2015 15:36:44 +0200 Subject: erts: Add power saving cpu feature tests and use them --- erts/emulator/sys/unix/sys_time.c | 16 ++++++------- erts/include/internal/ethread.h | 50 +++++++++++++++++++++++++++++---------- erts/lib_src/common/ethr_aux.c | 29 ++++++++++++++++++----- 3 files changed, 69 insertions(+), 26 deletions(-) diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index 9738a8c352..03d39c7ce6 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -971,18 +971,18 @@ static ErtsSysPerfCounter calculate_perf_counter_unit(void) { static int have_rdtscp(void) { #if defined(ETHR_X86_RUNTIME_CONF__) - /* On early x86 cpu's the tsc varies with - the current speed of the cpu, which means that the time per - tick vary depending on the current load of the cpu. We do not - want this as it would give very scewed numbers when the cpu is - mostly idle. - If we have the rdtscp feature it is a sign that the cpu is - relatively modern, and thus the tsc quite stable so we use it then. + /* On early x86 cpu's the tsc varies with the current speed of the cpu, + which means that the time per tick vary depending on the current + load of the cpu. We do not want this as it would give very scewed + numbers when the cpu is mostly idle. + The linux kernel seems to think that checking for constant and + reliable is enough to trust the counter so we do the same. If this test is not good enough, I don't know what we'll do. Maybe fallback on erts_sys_hrtime always, but that would be a shame as rdtsc is about 3 times faster than hrtime... */ - return ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__; + return ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ && + ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__; #else return 0; #endif diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 9956473057..e5c5cdfa33 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -274,18 +274,40 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file, || (defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64)))) # define ETHR_X86_RUNTIME_CONF__ -# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg == 0, 0)) -# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0)) -# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \ - (__builtin_expect(ethr_runtime__.conf.have_rdtscp != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \ - (__builtin_expect(ethr_runtime__.conf.have_rdtscp == 0, 0)) +# define ETHR_X86_RUNTIME_CONF_HAVE_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature != 0, 1)) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature == 0, 0)) + +# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(constant_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_TSC_RELIABLE_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc_s3) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc_s3) + #endif #if (defined(__GNUC__) \ @@ -305,6 +327,10 @@ typedef struct { int have_dw_cmpxchg; int have_sse2; int have_rdtscp; + int have_constant_tsc; + int have_tsc_reliable; + int have_nonstop_tsc; + int have_nonstop_tsc_s3; #endif #if defined(ETHR_PPC_RUNTIME_CONF__) int have_lwsync; diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index fbd870c2b5..3e7aad16c7 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -144,16 +144,33 @@ x86_init(void) eax = 0x80000000; ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); - if (eax >= 0x80000001) { - /* Get the extended feature set */ - eax = 0x80000001; + if (eax < 0x80000001) + return; + + if (eax >= 0x80000007) { + /* Advanced Power Management Information */ + eax = 0x80000007; ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); - } else { - eax = ebx = ecx = edx = 0; + + /* I got the values below from: + http://lxr.free-electrons.com/source/arch/x86/include/asm/cpufeature.h + They can be gotten from the intel/amd manual as well. + */ + + ethr_runtime__.conf.have_constant_tsc = (edx & (1 << 8)); + ethr_runtime__.conf.have_tsc_reliable = (edx & (1 << 23)); + ethr_runtime__.conf.have_nonstop_tsc = (edx & (1 << 24)); + ethr_runtime__.conf.have_nonstop_tsc_s3 = (edx & (1 << 30)); + } - + + /* Extended Processor Info and Feature Bits */ + eax = 0x80000001; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + /* bit 27 of edx is set if we have rdtscp */ ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27)); + } #endif /* ETHR_X86_RUNTIME_CONF__ */ -- cgit v1.2.3 From a378360ea8d18264e11f201b6d00ed66b9fcfd32 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Thu, 13 Aug 2015 17:24:47 +0200 Subject: erts: Fix msacc testcase on some windowses --- erts/emulator/test/statistics_SUITE.erl | 69 +++++++++++++++++++++------------ 1 file changed, 45 insertions(+), 24 deletions(-) diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a1b63716a9..821cb5d897 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -482,30 +482,51 @@ msacc(Config) -> true = erlang:system_flag(microstate_accounting, false), - %% Make sure that all states were triggered at least once - maps:map(fun(nif, 0) -> - case Niff of - ok -> - ct:fail({zero_state,nif}); - nok -> - ok - end; - (aux, 0) -> - %% aux will be zero if we do not have smp support - %% or no async threads - case erlang:system_info(smp_support) orelse - erlang:system_info(thread_pool_size) > 0 of - false -> - ok; - true -> - ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), - ct:fail({zero_state,aux}) - end; - (Key, 0) -> - ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), - ct:fail({zero_state,Key}); - (_,_) -> ok - end,msacc_sum_states()), + MsaccStats = erlang:statistics(microstate_accounting), + + case os:type() of + {win32, _} -> + %% Some windows have a very poor accuracy on their + %% timing primitives, so we just make sure that + %% some state besides sleep has been triggered. + Sum = lists:sum( + lists:map(fun({sleep, _V}) -> 0; + ({_, V}) -> V + end, maps:to_list(msacc_sum_states())) + ), + if Sum > 0 -> + ok; + true -> + ct:fail({no_states_triggered, MsaccStats}) + end; + _ -> + + %% Make sure that all states were triggered at least once + maps:map(fun(nif, 0) -> + case Niff of + ok -> + ct:fail({zero_state,nif}); + nok -> + ok + end; + (aux, 0) -> + %% aux will be zero if we do not have smp support + %% or no async threads + case erlang:system_info(smp_support) orelse + erlang:system_info(thread_pool_size) > 0 + of + false -> + ok; + true -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,aux}) + end; + (Key, 0) -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,Key}); + (_,_) -> ok + end, msacc_sum_states()) + end, erlang:system_flag(microstate_accounting, reset), -- cgit v1.2.3 From 0bf37ca78b6200f8b82b20234f0b882154a094ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 18 Dec 2015 15:26:35 +0100 Subject: Silence compiler --- erts/emulator/beam/beam_bp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 2a23da4f25..5d471d168b 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -864,7 +864,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, Eterm* cpp; int return_to_trace = 0; BeamInstr w; - BeamInstr *cp_save; + BeamInstr *cp_save = c_p->cp; Uint32 flags; Uint need = 0; Eterm* E = c_p->stop; -- cgit v1.2.3 From 5e60a53cf306eb29a1f8396e773205d02a419ef6 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 21 Jan 2016 19:57:08 +0100 Subject: erts: Make msacc alloctor type thread safe LONG_LIVED is not thread safe on non-smp and can only be used by scheduler. --- erts/emulator/beam/erl_alloc.types | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 6b7eff1428..5f153ac0ab 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -361,7 +361,7 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap -type MSACC LONG_LIVED SYSTEM microstate_accounting +type MSACC DRIVER SYSTEM microstate_accounting # # Types used by system specific code -- cgit v1.2.3 From f12da3c4abe70bd932484895af6e23436b308f53 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 2 Feb 2016 10:51:31 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 49956 -> 49984 bytes erts/preloaded/ebin/erlang.beam | Bin 101404 -> 101988 bytes erts/preloaded/ebin/erts_code_purger.beam | Bin 8744 -> 8764 bytes erts/preloaded/ebin/erts_internal.beam | Bin 8512 -> 9412 bytes erts/preloaded/ebin/init.beam | Bin 44700 -> 44724 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1448 -> 1468 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1320 -> 1340 bytes erts/preloaded/ebin/prim_file.beam | Bin 44884 -> 44908 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72608 -> 72632 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23280 -> 23308 bytes erts/preloaded/ebin/zlib.beam | Bin 14156 -> 14176 bytes 11 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index f007880683..2a54c10273 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index a89de716bd..f1e48b3282 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 37e6b181d6..3d73b0cb1b 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index 2380930767..24fa68506b 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index 67159713f5..2f66b5f970 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index fd80258d0e..057fe79054 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index 0e51a1bfc7..33f5de7d3f 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index 663f5d46e6..b96927b72b 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index d8a8061bae..767a48d781 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 1d69c2e583..2bc85bbcbf 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 2ffd839f8a..0b4afc0a39 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From c96b6c2f58642b457d806c0a8a5bed03d16e35f1 Mon Sep 17 00:00:00 2001 From: Dmytro Lytovchenko Date: Thu, 21 Jan 2016 17:20:47 +0100 Subject: Better list_to_integer Now tries to use whole width of signed long (Sint) and this halves amount of multiplications needed to parse long integers. New code is 2-3 times faster than the old code for large inputs (tens and hundreds of digits), behavior should not change for small inputs. Test ran 10k times with GC forced between attempts. Was (R17): 720 el base 10: 0.14682 sec; base 16: 0.192722 sec; base 36: 0.337118 sec. 2800 el base 10: 1.794133 sec; base 16: 2.735106 sec; base 36: 4.761108 sec. 6500 el base 10: 9.316434 sec; base 16: 14.109469 sec; base 36: 25.319263 sec. Now (R19 Dev) 720 el base 10: 0.10265 sec; base 16: 0.10851 sec; base 36: 0.160478 sec. 2800 el base 10: 1.002793 sec; base 16: 1.360649 sec; base 36: 2.174309 sec. 6500 el base 10: 4.722197 sec; base 16: 6.60522 sec; base 36: 10.552795 sec. Added test for corner cases and sign bit corruption. Replaced macros with inline and hid it inside C file to not pollute global namespace Old bug in #define LG2_LOOKUP: Replaced with inline function and table recalculated for all bases 2 to 36 (was 2 to 64) --- erts/emulator/beam/bif.c | 48 ++--- erts/emulator/beam/big.c | 346 +++++++++++++++++++++-------------- erts/emulator/beam/big.h | 22 +-- erts/emulator/test/num_bif_SUITE.erl | 99 +++++++--- 4 files changed, 316 insertions(+), 199 deletions(-) diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d519216fbd..34611ad6ab 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2904,8 +2904,11 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) /**********************************************************************/ -/* convert a list of ascii ascii integer value to an integer */ - +/* + * Converts a list of ascii base10 digits to an integer fully or partially. + * Returns result and the remaining tail. + * On error returns: {error,not_a_list}, or {error, no_integer} + */ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) { @@ -2913,9 +2916,8 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) Eterm tail; Eterm *hp; /* must be a list */ - switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) { - /* HAlloc after do_list_to_integer as it - might HAlloc itself (bignum) */ + switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) { + /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */ case LTI_BAD_STRUCTURE: hp = HAlloc(BIF_P,3); BIF_RET(TUPLE2(hp, am_error, am_not_a_list)); @@ -2930,13 +2932,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) { - /* Using do_list_to_integer is about twice as fast as using + /* Using erts_list_to_integer is about twice as fast as using erts_chars_to_integer because we do not have to copy the entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { + if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, + &res, &dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); @@ -2944,14 +2947,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) { - /* Bif implementation is about 50% faster than pure erlang, and since we have erts_chars_to_integer now it is simpler as well. This could be optmized further if we did not have to copy the list to buf. */ int i; - Eterm res; - char *buf = NULL; + Eterm res, dummy; int base; i = erts_list_length(BIF_ARG_1); @@ -2959,31 +2960,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); base = signed_val(BIF_ARG_2); - + if (base < 2 || base > 36) BIF_ERROR(BIF_P, BADARG); - /* Take fast path if base it 10 */ - if (base == 10) - return list_to_integer_1(BIF_P,&BIF_ARG_1); - - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); - - if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto list_to_integer_1_error; - buf[i] = '\0'; /* null terminal */ - - if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) - goto list_to_integer_1_error; - - erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (erts_list_to_integer(BIF_P, BIF_ARG_1, base, + &res, &dummy) != LTI_ALL_INTEGER) { + BIF_ERROR(BIF_P,BADARG); + } BIF_RET(res); - - list_to_integer_1_error: - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - - } +} /**********************************************************************/ diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 29e677d2e5..11838e24ef 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -48,7 +48,7 @@ _t_dst = (dst)+((sz)-1); \ _t_src = (src)+((sz)-1); \ while(_t_sz--) *_t_dst-- = *_t_src--; \ - } \ + } \ } while(0) /* add a and b with carry in + out */ @@ -423,6 +423,25 @@ #endif +/* Forward declaration of lookup tables (See below in this file) used in list to + * integer conversions for different bases. Also used in bignum printing. + */ +static const byte digits_per_sint_lookup[36-1]; +static const byte digits_per_small_lookup[36-1]; +static const Sint largest_power_of_base_lookup[36-1]; + +static ERTS_INLINE byte get_digits_per_signed_int(Uint base) { + return digits_per_sint_lookup[base-2]; +} + +static ERTS_INLINE byte get_digits_per_small(Uint base) { + return digits_per_small_lookup[base-2]; +} + +static ERTS_INLINE Sint get_largest_power_of_base(Uint base) { + return largest_power_of_base_lookup[base-2]; +} + /* ** compare two number vectors */ @@ -1719,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) short sign = BIG_SIGN(xp); ErtsDigit rem; Uint n = 0; + const Uint digits_per_Sint = get_digits_per_signed_int(10); + const Sint largest_pow_of_base = get_largest_power_of_base(10); - if (xl == 1 && *dx < D_DECIMAL_BASE) { + if (xl == 1 && *dx < largest_pow_of_base) { rem = *dx; if (rem == 0) { (*write_func)(arg, '0'); n++; @@ -1738,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) MOVE_DIGITS(tmp, dx, xl); while(1) { - tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); + tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { (*write_func)(arg, (rem % 10)+'0'); n++; @@ -1746,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) } break; } else { - int i = D_DECIMAL_EXP; + Uint i = digits_per_Sint; while(i--) { (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; @@ -2522,63 +2543,100 @@ int term_equals_2pow32(Eterm x) } } +static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) { + return (ch < '0' + || (ch > ('0' + base - 1) + && !(base > 10 + && ((ch >= 'a' && ch < ('a' + base - 10)) + || (ch >= 'A' && ch < ('A' + base - 10)))))); +} -#define IS_VALID_CHARACTER(CHAR,BASE) \ - (CHAR < '0' \ - || (CHAR > ('0' + BASE - 1) \ - && !(BASE > 10 \ - && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ - || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) -#define CHARACTER_FROM_BASE(CHAR) \ - ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) -#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) -#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) -#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) +static ERTS_INLINE byte c2int_digit_from_base(byte ch) { + return ch <= '9' ? ch - '0' + : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a')); +} /* - * for i in 2..64 do - * lg2_lookup[i-2] = log2(i) - * end - * How many bits are needed to store string of size n + * How many bits are needed to store 1 digit of given base in binary + * Wo.Alpha formula: Table [log2[n], {n,2,36}] */ -const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, - 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, - 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, - 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, - 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, - 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, - 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, - 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; +static const double lg2_lookup[36-1] = { + 1.0, 1.58496, 2.0, 2.32193, 2.58496, 2.80735, 3.0, 3.16993, 3.32193, + 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, 4.08746, 4.16993, 4.24793, + 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489, + 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993 +}; +static ERTS_INLINE double lookup_log2(Uint base) { + return lg2_lookup[base - 2]; +} /* - * for i in 2..64 do - * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; - * end - * How many characters can fit in 31 bits + * How many digits can fit into a signed int (Sint) for given base, we take + * one digit away just to be on the safer side (some corner cases). */ -const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, - 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5 }; +static const byte digits_per_sint_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[31 / log[2,n]]-1, {n, 2, 36}] */ + 30, 18, 14, 12, 10, 10, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[63 / log[2,n]]-1, {n, 2, 36}] */ + 62, 38, 30, 26, 23, 21, 20, 18, 17, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; /* - * for i in 2..64 do - * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); - * end - * How much can the characters which fit in 31 bit represent + * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit */ -const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u, - 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u, - 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u, - 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u, - 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u, - 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u, - 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u, - 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u, - 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u, - 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u, - 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u, - 992436543u, 1073741824u }; +static const byte digits_per_small_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */ + 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */ + 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; + +/* + * Largest power of base which can be represented in a signed int (Sint). + * Calculated by base 2..36 to the power of corresponding element from + * digits_per_sint_lookup. + */ +static const Sint largest_power_of_base_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */ + 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728, + 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625, + 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632, + 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000, + 28629151, 33554432, 39135393, 45435424, 52521875, 1679616 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}] + * with LL added after each element manually */ + 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL, + 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL, + 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL, + 505447028499293771LL, 184884258895036416LL, 665416609183179841LL, + 155568095557812224LL, 437893890380859375LL, 72057594037927936LL, + 168377826559400929LL, 374813367582081024LL, 42052983462257059LL, + 81920000000000000LL, 154472377739119461LL, 282810057883082752LL, + 21914624432020321LL, 36520347436056576LL, 59604644775390625LL, + 95428956661682176LL, 150094635296999121LL, 232218265089212416LL, + 12200509765705829LL, 17714700000000000LL, 25408476896404831LL, + 36028797018963968LL, 50542106513726817LL, 70188843638032384LL, + 96549157373046875LL, 131621703842267136LL +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, Uint size, const int base) { @@ -2588,8 +2646,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, int neg = 0; byte b; Eterm *hp, *hp_end; - int m; + Sint m; int lg2; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + const Sint largest_pow_of_base = get_largest_power_of_base(base); if (size == 0) goto bytebuf_to_integer_1_error; @@ -2604,57 +2665,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, size--; } + /* Trim leading zeroes */ + if (size) { + while (*bytes == '0') { + bytes++; + size--; + if (!size) { + /* All zero! */ + res = make_small(0); + goto bytebuf_to_integer_1_done; + } + } + } + if (size == 0) goto bytebuf_to_integer_1_error; - if (size < SMALL_DIGITS && base <= 10) { - /* * - * Take shortcut if we know that all chars are '0' < b < '9' and - * fit in a small. This improves speed by about 10% over the generic - * small case. - * */ - while (size--) { - b = *bytes++; + if (size < digits_per_small) { + if (base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; - if (b < '0' || b > ('0'+base-1)) - goto bytebuf_to_integer_1_error; + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; - i = i * base + b - '0'; - } + i = i * base + b - '0'; + } - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (c2int_is_invalid_char(b, base)) + goto bytebuf_to_integer_1_error; + + i = i * base + c2int_digit_from_base(b); + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; } /* * Calculate the maximum number of bits which will * be needed to represent the binary */ - lg2 = ((size+2)*LG2_LOOKUP(base)+1); - - if (lg2 < SMALL_BITS) { - /* Take shortcut if we know it will fit in a small. - * This improves speed by about 30%. - */ - while (size) { - b = *bytes++; - size--; - - if (IS_VALID_CHARACTER(b,base)) - goto bytebuf_to_integer_1_error; - - i = i * base + CHARACTER_FROM_BASE(b); - - } - - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; - - } + lg2 = ((size+2)*lookup_log2(base)+1); /* Start calculating bignum */ m = (lg2 + D_EXP-1)/D_EXP; @@ -2663,8 +2735,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, hp = HAlloc(BIF_P, m); hp_end = hp + m; - if ((i = (size % D_BASE_EXP(base))) == 0) - i = D_BASE_EXP(base); + if ((i = (size % digits_per_Sint)) == 0) + i = digits_per_Sint; n = size - i; m = 0; @@ -2672,34 +2744,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } res = small_to_big(m, hp); while (n) { - i = D_BASE_EXP(base); - n -= D_BASE_EXP(base); + i = digits_per_Sint; + n -= digits_per_Sint; m = 0; while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } if (is_small(res)) { res = small_to_big(signed_val(res), hp); } - res = big_times_small(res, D_BASE_BASE(base), hp); + res = big_times_small(res, largest_pow_of_base, hp); if (is_small(res)) { res = small_to_big(signed_val(res), hp); } @@ -2730,31 +2802,35 @@ bytebuf_to_integer_1_error: bytebuf_to_integer_1_done: return res; - } -int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest) +/* Converts list of digits with given 'base' to integer sequentially. Returns + * result in 'integer_out', remaining tail goes to 'tail_out' and returns result + * code if the list was consumed fully or partially or there was an error + */ +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out) { Sint i = 0; Uint ui = 0; int skip = 0; int neg = 0; Sint n = 0; - int m; + Sint m; int lg2; Eterm res; - Eterm* hp; - Eterm *hp_end; Eterm lst = orig_list; Eterm tail = lst; int error_res = LTI_BAD_STRUCTURE; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); if (is_nil(lst)) { error_res = LTI_NO_INTEGER; error: - *rest = tail; - *integer = make_small(0); + *tail_out = tail; + *integer_out = make_small(0); return error_res; } if (is_not_list(lst)) @@ -2784,15 +2860,16 @@ int do_list_to_integer(Process *p, Eterm orig_list, /* Calculate size and do type check */ while(1) { + byte ch; if (is_not_small(CAR(list_val(lst)))) { break; } - if (unsigned_val(CAR(list_val(lst))) < '0' || - unsigned_val(CAR(list_val(lst))) > '9') { + ch = unsigned_val(CAR(list_val(lst))); + if (c2int_is_invalid_char(ch, base)) { break; } - ui = ui * 10; - ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; + ui = ui * base; + ui = ui + c2int_digit_from_base(ch); n++; lst = CDR(list_val(lst)); if (is_nil(lst)) { @@ -2810,23 +2887,24 @@ int do_list_to_integer(Process *p, Eterm orig_list, } - /* If n <= 8 then we know it's a small int - ** since 2^27 = 134217728. If n > 8 then we must - ** construct a bignum and let that routine do the checking - */ + /* If length fits inside Sint then we know it's a small int. Else we + * must construct a bignum and let that routine do the checking + */ - if (n <= SMALL_DIGITS) { /* It must be small */ - if (neg) i = -(Sint)ui; - else i = (Sint)ui; + if (n <= digits_per_small) { /* It must be small */ + i = neg ? -(Sint)ui : (Sint)ui; res = make_small(i); } else { - /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 - which we round up to (3 + 1/3) */ - lg2 = (n+1)*3 + (n+1)/3 + 1; + const Sint largest_pow_of_base = get_largest_power_of_base(base); + Eterm *hp; + Eterm *hp_end; + + /* Convert from log_base to log2 using lookup table */ + lg2 = ((n+2)*lookup_log2(base)+1); m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ m = BIG_NEED_SIZE(m); /* number of words + thing */ - hp = HAlloc(p, m); + hp = HAlloc(BIF_P, m); hp_end = hp + m; lst = orig_list; @@ -2834,27 +2912,29 @@ int do_list_to_integer(Process *p, Eterm orig_list, lst = CDR(list_val(lst)); /* load first digits (at least one digit) */ - if ((i = (n % D_DECIMAL_EXP)) == 0) - i = D_DECIMAL_EXP; + if ((i = (n % digits_per_Sint)) == 0) + i = digits_per_Sint; n -= i; m = 0; while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); lst = CDR(list_val(lst)); } res = small_to_big(m, hp); /* load first digits */ while(n) { - i = D_DECIMAL_EXP; - n -= D_DECIMAL_EXP; + i = digits_per_Sint; + n -= digits_per_Sint; m = 0; while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); lst = CDR(list_val(lst)); } if (is_small(res)) res = small_to_big(signed_val(res), hp); - res = big_times_small(res, D_DECIMAL_BASE, hp); + res = big_times_small(res, largest_pow_of_base, hp); if (is_small(res)) res = small_to_big(signed_val(res), hp); res = big_plus_small(res, m, hp); @@ -2876,10 +2956,10 @@ int do_list_to_integer(Process *p, Eterm orig_list, hp += (big_arity(res)+1); } } - HRelease(p,hp_end,hp); + HRelease(BIF_P, hp_end, hp); } - *integer = res; - *rest = tail; + *integer_out = res; + *tail_out = tail; if (tail != NIL) { return LTI_SOME_INTEGER; } diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 85807d6eea..9c92de6b55 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit; #error "can not determine machine size" #endif -#define D_DECIMAL_EXP 9 -#define D_DECIMAL_BASE 1000000000 - typedef Uint dsize_t; /* Vector size type */ #define D_EXP (ERTS_SIZEOF_ETERM*8) @@ -173,12 +170,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); -#define LTI_BAD_STRUCTURE 0 -#define LTI_NO_INTEGER 1 -#define LTI_SOME_INTEGER 2 -#define LTI_ALL_INTEGER 3 - -int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest); - +/* How list_to_integer classifies the input, was it even a string? */ +typedef enum { + LTI_BAD_STRUCTURE = 0, + LTI_NO_INTEGER = 1, + LTI_SOME_INTEGER = 2, + LTI_ALL_INTEGER = 3 +} LTI_result_t; + +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out); #endif diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 90b6a36262..d0840fe731 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1997-2014. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% @@ -36,22 +36,22 @@ %% integer_to_binary/2 %% binary_to_integer/1 --export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, t_abs/1, t_float/1, t_float_to_string/1, t_integer_to_string/1, - t_string_to_integer/1, + t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, t_round/1, t_trunc/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc]. + t_trunc, t_list_to_integer_edge_cases]. -groups() -> +groups() -> [{t_string_to_float, [], [t_string_to_float_safe, t_string_to_float_risky]}]. @@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) -> 5.5 = abs(id(5.5)), 0.0 = abs(id(0.0)), 100.0 = abs(id(-100.0)), - + %% Integers. 5 = abs(id(5)), 0 = abs(id(0)), @@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) -> BigNum = abs(BigNum), BigNum = abs(-BigNum), ok. - + t_float(Config) when is_list(Config) -> 0.0 = float(id(0)), 2.5 = float(id(2.5)), @@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) -> %% Extremly big bignums. Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), {'EXIT', {badarg, _}} = (catch float(Big)), - + ok. @@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), ok. - + test_fts(Expect, Float) -> Expect = float_to_list(Float), BinExpect = list_to_binary(Expect), @@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) -> 256 = round(id(255.6)), -1033 = round(id(-1033.3)), -1034 = round(id(-1033.6)), - + % OTP-3722: X = id((1 bsl 27) - 1), MX = -X, @@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_binary(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_list(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), @@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), - + % Default base error cases lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:binary_to_integer( list_to_binary(Value))), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,["1.0"," 1"," -1","","+"]), - + % Custom base error cases lists:foreach(fun({Value,Base}) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer( list_to_binary(Value),Base)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, @@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) -> ok. +%% Tests edge cases for list_to_integer; compares with known good values + +t_list_to_integer_edge_cases(Config) when is_list(Config) -> + %% Take integer literals and compare to their representation in ExtTerm + T = [ + {16, "0", <<131,97,0>>}, + {16, "-0", <<131,97,0>>}, + + {16, "f", <<131,97,15>>}, + {16, "-f", <<131,98,255,255,255,241>>}, + + {16, "0000000000000000000000000000000000000000000000000f", + <<131,97,15>>}, + {16, "-0000000000000000000000000000000000000000000000000f", + <<131,98,255,255,255,241>>}, + + {16, "ffffffff", <<131,110,4,0,255,255,255,255>>}, + {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>}, + + {16, "7fffffff", <<131,110,4,0,255,255,255,127>>}, + {16, "-7fffffff", <<131,98,128,0,0,1>>}, + + {16, "ffffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,255>>}, + {16, "-ffffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,255>>}, + + {16, "7fffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,127>>}, + {16, "-7fffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,127>>}, + + %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4 + %% bits we may corrupt sign bit and fall out of SMALL_INT range. + {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>}, + {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>}, + + %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we + %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead) + {2, "100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,0,0,0,0,0,0,0,0,8>>}, + {2, "-100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,1,0,0,0,0,0,0,0,8>>} + ], + [begin + io:format("~s base ~p vs ~p~n", [Str, Base, Bin]), + FromStr = list_to_integer(Str, Base), + FromStr = binary_to_term(Bin) + end || {Base, Str, Bin} <- T], + ok. + test_sti(Num) -> [begin io:format("Testing ~p:~p",[Num,Base]), - test_sti(Num,Base) + test_sti(Num,Base) end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> -- cgit v1.2.3 From 18f0707c218ebdeb6024ecffd7704d3582e0b91c Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 2 Feb 2016 16:20:19 +0100 Subject: Use nano second time unit in tracing --- erts/doc/src/erl_driver.xml | 5 +++-- erts/doc/src/erlang.xml | 9 +++++---- erts/emulator/beam/erl_trace.c | 3 ++- erts/emulator/test/trace_bif_SUITE.erl | 4 ++-- lib/kernel/doc/src/seq_trace.xml | 5 +++-- 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index e338e95938..34dc8af238 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -1052,8 +1052,9 @@ typedef struct ErlIOVec {

This function is deprecated! Do not use it! - Use the documented - time measurement functionality + Use erl_drv_monotonic_time() + (perhaps in combination with + erl_drv_time_offset()) instead.

This function reads a timestamp into the memory pointed to by the parameter now. See the description of ErlDrvNowData for diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 79d3f66ea8..c9eb838230 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -7744,7 +7744,8 @@ ok

Timestamps in profile messages will use Erlang monotonic time. The time-stamp (Ts) has the same - format and value as produced by erlang:monotonic_time().

+ format and value as produced by + erlang:monotonic_time(nano_seconds).

runnable_procs @@ -7772,7 +7773,7 @@ ok Erlang monotonic time and a monotonically increasing integer. The time-stamp (Ts) has the same format and value - as produced by {erlang:monotonic_time(), + as produced by {erlang:monotonic_time(nano_seconds), erlang:unique_integer([monotonic])}.

 timestamp @@ -8161,7 +8162,7 @@ timestamp() -> Erlang monotonic time time-stamp in all trace messages. The time-stamp (Ts) has the same format and value as produced by - erlang:monotonic_time(). This flag overrides + erlang:monotonic_time(nano_seconds). This flag overrides the cpu_timestamp flag.

strict_monotonic_timestamp @@ -8171,7 +8172,7 @@ timestamp() -> monotonic time and a monotonically increasing integer in all trace messages. The time-stamp (Ts) has the same format and value as produced by - {erlang:monotonic_time(), + {erlang:monotonic_time(nano_seconds), erlang:unique_integer([monotonic])}. This flag overrides the cpu_timestamp flag.

diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 2243639099..8a4c0ab1f2 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -165,7 +165,8 @@ take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type) case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: { Uint hsz = 0; ErtsMonotonicTime mtime = erts_get_monotonic_time(NULL); - mtime += ERTS_MONOTONIC_OFFSET_NATIVE; + mtime = ERTS_MONOTONIC_TO_NSEC(mtime); + mtime += ERTS_MONOTONIC_OFFSET_NSEC; hsz = (IS_SSMALL(mtime) ? (Uint) 0 : ERTS_SINT64_HEAP_SIZE((Sint64) mtime)); diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 760666d077..96b7dd159f 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -314,9 +314,9 @@ receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsTy make_ts(timestamp) -> erlang:now(); make_ts(monotonic_timestamp) -> - erlang:monotonic_time(); + erlang:monotonic_time(nano_seconds); make_ts(strict_monotonic_timestamp) -> - MT = erlang:monotonic_time(), + MT = erlang:monotonic_time(nano_seconds), UMI = erlang:unique_integer([monotonic]), {MT, UMI}. diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 9f191d488d..f4fcd222ec 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -136,7 +136,7 @@ seq_trace:set_token(OldToken), % activate the trace token again Erlang monotonic time and a monotonically increasing integer. The time-stamp has the same format and value - as produced by {erlang:monotonic_time(), + as produced by {erlang:monotonic_time(nano_seconds), erlang:unique_integer([monotonic])}.

set_token(monotonic_timestamp, Bool) @@ -147,7 +147,8 @@ seq_trace:set_token(OldToken), % activate the trace token again will use Erlang monotonic time. The time-stamp has the same - format and value as produced by erlang:monotonic_time().

+ format and value as produced by + erlang:monotonic_time(nano_seconds).

If multiple timestamp flags are passed, timestamp has precedence over strict_monotonic_timestamp which -- cgit v1.2.3 From 543330e6b1da49f022bf1541a01bb3a87a8c9e9c Mon Sep 17 00:00:00 2001 From: Luis Rascao Date: Sat, 10 Oct 2015 15:52:40 +0100 Subject: tools: Fix wrong instrumentation of binary comprehensions When cover instruments binary comprehensions it's generating a {block, ...} abstract code term inside a {bc, ...} term that is causing the evaluation to fail at runtime. Removing the block statement eliminates the error. The template of a bit string comprehension cannot have a counter since it is not allowed to be a block. --- lib/tools/src/cover.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 0ae5c7978d..d16ca7f406 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -2005,7 +2005,7 @@ munge_expr({lc,Line,Expr,Qs}, Vars) -> {{lc,Line,MungedExpr,MungedQs}, Vars3}; munge_expr({bc,Line,Expr,Qs}, Vars) -> {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]} = Expr, - Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}|Es]}, + Expr2 = {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]}, {MungedExpr,Vars2} = munge_expr(Expr2, Vars), {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), {{bc,Line,MungedExpr,MungedQs}, Vars3}; -- cgit v1.2.3 From 4d12129c7a6e4179af0efe6c22496812bc435a11 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 28 Jan 2016 09:28:32 +0100 Subject: tools: Add a Cover test --- lib/tools/test/cover_SUITE.erl | 42 +++++++++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 483ea9774e..8264747a3b 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, otp_8340,otp_8188,compile_beam_opts,eep37, - analyse_no_beam, line_0, compile_beam_no_file], + analyse_no_beam, line_0, compile_beam_no_file, + otp_13277], StartStop = [start, compile, analyse, misc, stop, distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, @@ -1252,7 +1253,7 @@ otp_8340(doc) -> ["OTP-8340. Bug."]; otp_8340(suite) -> []; otp_8340(Config) when is_list(Config) -> - ?line [{{t,1},1},{{t,2},1},{{t,4},1}] = + ?line [{{t,1},1},{{t,4},1}] = analyse_expr(<<"<< \n" " <<3:2, \n" " SeqId:62>> \n" @@ -1546,8 +1547,10 @@ comprehension_8188(Cf) -> " true]. \n" % 2 " two() -> 2">>, Cf), % 1 - ?line [{{t,1},1}, - {{t,2},2}, + %% The template cannot have a counter since it is not allowed to + %% be a block. + ?line [% {{t,1},1}, + %% {{t,2},2}, {{t,3},1}, {{t,4},1}, {{t,5},0}, @@ -1556,8 +1559,8 @@ comprehension_8188(Cf) -> {{t,12},3}, {{t,13},2}, {{t,14},2}] = - analyse_expr(<<"<< \n" % 1 - " << (X*2) >> || \n" % 2 + analyse_expr(<<"<< \n" % 1 (now: 0) + " << (X*2) >> || \n" % 2 (now: 0) " <> <= << (case two() of\n" " 2 -> 1;\n" % 1 " _ -> 2\n" % 0 @@ -1571,8 +1574,8 @@ comprehension_8188(Cf) -> " true >>.\n" % 2 "two() -> 2">>, Cf), - ?line [{{t,1},1}, - {{t,2},4}, + ?line [% {{t,1},1}, + %% {{t,2},4}, {{t,4},1}, {{t,6},1}, {{t,7},0}, @@ -1580,8 +1583,8 @@ comprehension_8188(Cf) -> {{t,11},2}, {{t,12},4}, {{t,13},1}] = - analyse_expr(<<"<< \n" % 1 - " << (2)\n" % 4 + analyse_expr(<<"<< \n" % 1 (now: 0) + " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <> <= << 1,\n" % 1 " (case two() of \n" @@ -1745,6 +1748,23 @@ do_scan(Str) -> {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), [ T | do_scan(C) ]. +otp_13277(doc) -> + ["PR 856. Fix a bc bug."]; +otp_13277(Config) -> + Test = <<"-module(t). + -export([t/0]). + + pad(A, L) -> + P = << <<\"#\">> || _ <- lists:seq(1, L) >>, + <>. + + t() -> + pad(<<\"hi\">>, 2). + ">>, + ?line File = cc_mod(t, Test, Config), + ?line <<"hi##">> = t:t(), + ?line ok = file:delete(File), + ok. %%--Auxiliary------------------------------------------------------------ -- cgit v1.2.3 From 4f567ddbe4eccfb4803a94675207efc65199615b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 30 Jan 2016 07:21:52 +0100 Subject: v3_core: Eliminate double processing of patterns Internally in the v3_core pass, an #imatch{} record represents a match expression: Pattern = Expression If Pattern is a single, unbound variable, #imatch{} will be rewritten to #iset{}; otherwise it will be rewritten to #icase{}. To determine how #imatch{} should be translated, the pattern is processed using upattern/3. The return value from upattern/3 is thrown away (after having been used for determing how the #imatch{} record should be translated). That means that every pattern in an #imatch{} is processed twice, which is wasteful. We can easily avoid the double processing of patterns by introducing a new helper function that determines whether the pattern is a new variable. --- lib/compiler/src/v3_core.erl | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 8074456be2..72649e5c9f 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1853,27 +1853,22 @@ uguard(Pg, Gs0, Ks, St0) -> %% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}. uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> - %% Optimise for simple set of unbound variable. - case upattern(P0, Ks, St0) of - {#c_var{},[],_Pvs,_Pus,_} -> - %% Throw our work away and just set to iset. + case upat_is_new_var(P0, Ks) of + true -> + %% Assignment to a new variable. uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0); - _Other -> - %% Throw our work away and set to icase. - if - Les =:= [] -> - %% Need to explicitly return match "value", make - %% safe for efficiency. - {La0,Lps,St1} = force_safe(Arg, St0), - La = mark_compiler_generated(La0), - Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, - uexprs(Lps ++ [#icase{anno=A, - args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); - true -> - Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, - uexprs([#icase{anno=A,args=[Arg], - clauses=[Mc],fc=Fc}], Ks, St0) - end + false when Les =:= [] -> + %% Need to explicitly return match "value", make + %% safe for efficiency. + {La0,Lps,St1} = force_safe(Arg, St0), + La = mark_compiler_generated(La0), + Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, + uexprs(Lps ++ [#icase{anno=A, + args=[La0],clauses=[Mc],fc=Fc}], Ks, St1); + false -> + Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, + uexprs([#icase{anno=A,args=[Arg], + clauses=[Mc],fc=Fc}], Ks, St0) end; uexprs([Le0|Les0], Ks, St0) -> {Le1,St1} = uexpr(Le0, Ks, St0), @@ -1881,6 +1876,15 @@ uexprs([Le0|Les0], Ks, St0) -> {[Le1|Les1],St2}; uexprs([], _, St) -> {[],St}. +%% upat_is_new_var(Pattern, [KnownVar]) -> true|false. +%% Test whether the pattern is a single, previously unknown +%% variable. + +upat_is_new_var(#c_var{name=V}, Ks) -> + not is_element(V, Ks); +upat_is_new_var(_, _) -> + false. + %% Mark a "safe" as compiler-generated. mark_compiler_generated(#c_cons{anno=A,hd=H,tl=T}) -> ann_c_cons([compiler_generated|A], mark_compiler_generated(H), -- cgit v1.2.3 From 4422cb32637a341eac2dc03172e4aa859be67f34 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Wed, 3 Feb 2016 12:10:06 +0100 Subject: Add supervisor:get_callback_module/1 This function is used by release_handler during upgrade. This was earlier implemented in the release_handler, but it required a copy og the definition of the supervisor's internal state, which caused problems when this state was updated. --- lib/sasl/src/release_handler_1.erl | 33 ++------------------------------- lib/sasl/src/sasl.app.src | 2 +- lib/stdlib/src/supervisor.erl | 14 ++++++++++++++ 3 files changed, 17 insertions(+), 32 deletions(-) diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 536ac924d4..86e3bddc1c 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -655,48 +655,19 @@ maybe_get_dynamic_mods(Name, Pid) -> error(get_modules_failed) end. -%% XXXX -%% Note: The following is a terrible hack done in order to resolve the -%% problem stated in ticket OTP-3452. - -%% XXXX NOTE WELL: This record is from supervisor.erl. Also the record -%% name is really `state'. --record(supervisor_state, {name, - strategy, - children = [], - dynamics = [], - intensity, - period, - restarts = [], - module, - args}). - %% Return the name of the call-back module that implements the %% (top) supervisor SupPid. %% Returns: {ok, Module} | {error,undefined} %% get_supervisor_module(SupPid) -> - case catch get_supervisor_module1(SupPid) of - {ok, Module} when is_atom(Module) -> + case catch supervisor:get_callback_module(SupPid) of + Module when is_atom(Module) -> {ok, Module}; _Other -> io:format("~w: reason: ~w~n", [SupPid, _Other]), {error, undefined} end. -get_supervisor_module1(SupPid) -> - {status, _Pid, {module, _Mod}, - [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), - %% supervisor Misc field changed at R13B04, handle old and new variants here - State = case Misc of - [_Name, State1, _Type, _Time] -> - State1; - [_Header, _Data, {data, [{"State", State2}]}] -> - State2 - end, - %% Cannot use #supervisor_state{module = Module} = State. - {ok, element(#supervisor_state.module, State)}. - %%----------------------------------------------------------------- %% Func: do_soft_purge/3 %% Args: Mod = atom() diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 705bb73fc5..507e2dc229 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -46,6 +46,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.6","kernel-4.1", + {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", "erts-6.0"]}]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 92a0c29011..6a5005b4b6 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -33,6 +33,9 @@ terminate/2, code_change/3]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- -export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). @@ -250,6 +253,17 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + [_Header, _Data, {data, [{"State", State}]}] = Misc, + State#state.module. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. -- cgit v1.2.3 From 264a5e804d6e23bf6c6916887669760cbf243caa Mon Sep 17 00:00:00 2001 From: Rory Byrne Date: Thu, 28 May 2015 19:41:25 +0100 Subject: Speed up supervisor:count_children/1; simple_one_for_one Speed up supervisor:count_children/1 for simple_one_for_one supervisors. This is achieved by avoiding looping through all the child process and verifying that each one is alive. For a supervisor with 100,000 'temporary' children the count-time will drop from approx 25ms to about 0.005ms. For a supervisor with 100,000 'permanent' or 'transient' children the count-time will drop from approx 30ms to about 0.005ms. This avoids having the supervisor block for an extended period while the count takes place. Under normal circumstances the accuracy of the result should also improve since the duration is too short for many processes to die during the count. --- lib/sasl/test/release_handler_SUITE.erl | 2 +- lib/stdlib/doc/src/supervisor.xml | 5 +++- lib/stdlib/src/supervisor.erl | 49 +++++++++++++++---------------- lib/stdlib/test/supervisor_SUITE.erl | 52 ++++++++++++++++++++++++++++++++- lib/stdlib/test/supervisor_deadlock.erl | 14 +++++++-- 5 files changed, 90 insertions(+), 32 deletions(-) diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index d57de2593a..ee620dcdb4 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1363,7 +1363,7 @@ upgrade_supervisor(Conf) when is_list(Conf) -> %% Check that the restart strategy and child spec is updated {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}]]} = rpc:call(Node,sys,get_status,[a_sup]), - {state,_,RestartStrategy,[Child],_,_,_,_,_,_} = State, + {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State, one_for_all = RestartStrategy, % changed from one_for_one {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000 diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 24ff251ce3..815bf4a489 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -543,7 +543,10 @@

active - the count of all actively running child processes - managed by this supervisor.

+ managed by this supervisor. In the case of simple_one_for_one + supervisors, no check is carried out to ensure that each child process + is still alive, though the result provided here is likely to be very + accurate unless the supervisor is heavily overloaded.

supervisors - the count of all children marked as diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 6a5005b4b6..cecdebd0c8 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -116,6 +116,7 @@ intensity :: non_neg_integer(), period :: pos_integer(), restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -518,39 +519,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), Reply = case CT of - supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; - worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICTS:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -820,8 +808,15 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of @@ -832,7 +827,9 @@ restart(simple_one_for_one, Child, State) -> NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICTS:store(restarting(OldPid), A, + NRestarts = State#state.dynamic_restarts + 1, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = ?DICTS:store(restarting(OldPid), A, Dynamics)}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 8cb2a5194a..903ca76575 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -67,6 +67,7 @@ %% Misc tests -export([child_unlink/1, tree/1, count_children/1, + count_restarting_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, @@ -90,7 +91,8 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children, do_not_save_start_parameters_for_temporary_children, + count_children, count_restarting_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, @@ -1458,6 +1460,54 @@ count_children(Config) when is_list(Config) -> [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], [1,0,0,0] = get_child_counts(sup_test). +%%------------------------------------------------------------------------- +%% Test count_children when some children are restarting +count_restarting_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child = {child, {supervisor_deadlock, start_child_noreg, []}, + permanent, brutal_kill, worker, []}, + %% 2 sek delay on failing restart (see supervisor_deadlock.erl) -> + %% MaxR=20, MaxT=10 should ensure a restart loop when starting and + %% restarting 3 instances of the child (as below) + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 20, 10}, [Child]}}), + + %% Ets table with state read by supervisor_deadlock.erl + ets:new(supervisor_deadlock,[set,named_table,public]), + ets:insert(supervisor_deadlock,{fail_start,false}), + + [1,0,0,0] = get_child_counts(SupPid), + {ok, Ch1_1} = supervisor:start_child(SupPid, []), + [1,1,0,1] = get_child_counts(SupPid), + {ok, Ch1_2} = supervisor:start_child(SupPid, []), + [1,2,0,2] = get_child_counts(SupPid), + {ok, Ch1_3} = supervisor:start_child(SupPid, []), + [1,3,0,3] = get_child_counts(SupPid), + + supervisor_deadlock:restart_child(Ch1_1), + supervisor_deadlock:restart_child(Ch1_2), + supervisor_deadlock:restart_child(Ch1_3), + test_server:sleep(400), + [1,3,0,3] = get_child_counts(SupPid), + [Ch2_1, Ch2_2, Ch2_3] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(Ch2_1), + supervisor_deadlock:restart_child(Ch2_2), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,1,0,3] = get_child_counts(SupPid), + + ets:insert(supervisor_deadlock,{fail_start,false}), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,3,0,3] = get_child_counts(SupPid), + + ok = supervisor:terminate_child(SupPid, Ch2_3), + [1,2,0,2] = get_child_counts(SupPid), + [Ch3_1, Ch3_2] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + ok = supervisor:terminate_child(SupPid, Ch3_1), + [1,1,0,1] = get_child_counts(SupPid), + ok = supervisor:terminate_child(SupPid, Ch3_2), + [1,0,0,0] = get_child_counts(SupPid). + %%------------------------------------------------------------------------- %% Temporary children shall not be restarted so they should not save %% start parameters, as it potentially can take up a huge amount of diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl index 288547a972..8d3d1c6f30 100644 --- a/lib/stdlib/test/supervisor_deadlock.erl +++ b/lib/stdlib/test/supervisor_deadlock.erl @@ -11,9 +11,11 @@ init([child]) -> %% terminates immediately {ok, []}; [{fail_start, true}] -> - %% Restart frequency is MaxR=8, MaxT=10, so this will - %% ensure that restart intensity is not reached -> restart - %% loop + %% A restart frequency of MaxR=8, MaxT=10 should ensure + %% that restart intensity is not reached -> restart loop. + %% (Note that if we use simple_one_for_one, and start + %% 'many' child instances, the restart frequency must be + %% ajusted accordingly.) timer:sleep(2000), % NOTE: this could be a gen_server call timeout {stop, error} @@ -41,5 +43,11 @@ code_change(_OldVsn, State, _Extra) -> start_child() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [child], []). +start_child_noreg() -> + gen_server:start_link(?MODULE, [child], []). + restart_child() -> gen_server:cast(supervisor_deadlock, restart). + +restart_child(Pid) -> + gen_server:cast(Pid, restart). -- cgit v1.2.3 From a4d6c798135440eadfba4832ac3cf77b06b6ac4f Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Thu, 4 Feb 2016 15:59:33 +0100 Subject: Fix bug causing run-queue mask to become inconsistent --- erts/emulator/beam/erl_process.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index f50b217d4a..0db81de570 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1091,7 +1091,7 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLGS_GET_USR_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) #define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \ - (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) + (((PSFLGS) >> ERTS_PSFLGS_PRQ_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) /* The sequential tracing token is a tuple of size 5: * -- cgit v1.2.3 From adf757e0372bac386cca7302a3075cfb44d328fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Feb 2016 12:03:02 +0100 Subject: Update primary bootstrap --- bootstrap/bin/start.boot | Bin 5287 -> 5306 bytes bootstrap/bin/start_clean.boot | Bin 5287 -> 5306 bytes bootstrap/lib/compiler/ebin/beam_bool.beam | Bin 16352 -> 15652 bytes bootstrap/lib/compiler/ebin/cerl.beam | Bin 31688 -> 31940 bytes bootstrap/lib/compiler/ebin/cerl_trees.beam | Bin 20360 -> 20676 bytes bootstrap/lib/compiler/ebin/v3_codegen.beam | Bin 56164 -> 55864 bytes bootstrap/lib/compiler/ebin/v3_core.beam | Bin 53116 -> 53280 bytes bootstrap/lib/kernel/ebin/code.beam | Bin 7312 -> 7136 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 26468 -> 22536 bytes bootstrap/lib/kernel/ebin/kernel.app | 2 +- bootstrap/lib/kernel/ebin/kernel.beam | Bin 3776 -> 3632 bytes bootstrap/lib/kernel/ebin/os.beam | Bin 3636 -> 3776 bytes bootstrap/lib/kernel/ebin/seq_trace.beam | Bin 1332 -> 1440 bytes bootstrap/lib/stdlib/ebin/beam_lib.beam | Bin 18520 -> 18560 bytes bootstrap/lib/stdlib/ebin/dets.beam | Bin 53116 -> 53688 bytes bootstrap/lib/stdlib/ebin/edlin.beam | Bin 10196 -> 10184 bytes bootstrap/lib/stdlib/ebin/erl_eval.beam | Bin 30624 -> 30640 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89344 -> 89528 bytes bootstrap/lib/stdlib/ebin/file_sorter.beam | Bin 30436 -> 30368 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11764 -> 11796 bytes bootstrap/lib/stdlib/ebin/qlc.beam | Bin 70124 -> 70108 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 76072 -> 76248 bytes bootstrap/lib/stdlib/ebin/sofs.beam | Bin 40656 -> 40656 bytes bootstrap/lib/stdlib/ebin/stdlib.app | 2 +- 24 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot index e8f9a4fe12..73381d4d8b 100644 Binary files a/bootstrap/bin/start.boot and b/bootstrap/bin/start.boot differ diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot index e8f9a4fe12..73381d4d8b 100644 Binary files a/bootstrap/bin/start_clean.boot and b/bootstrap/bin/start_clean.boot differ diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam index 15ca7ee757..e677c125a3 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bool.beam and b/bootstrap/lib/compiler/ebin/beam_bool.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam index 32e0485ff8..88857b8905 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl.beam and b/bootstrap/lib/compiler/ebin/cerl.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam index 7233eee9de..37120929ba 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_trees.beam and b/bootstrap/lib/compiler/ebin/cerl_trees.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam index aa4b5f9585..322469639f 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_codegen.beam and b/bootstrap/lib/compiler/ebin/v3_codegen.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam index 2082153b33..6e6496c7f9 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_core.beam and b/bootstrap/lib/compiler/ebin/v3_core.beam differ diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index e380d59305..42f71e7a20 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index 2b12bfe427..9b250ba708 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index a409bf6f3a..14f526c30c 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam index 1dae85119a..9fd407c287 100644 Binary files a/bootstrap/lib/kernel/ebin/kernel.beam and b/bootstrap/lib/kernel/ebin/kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam index ed3e5a2683..9ebe6c770f 100644 Binary files a/bootstrap/lib/kernel/ebin/os.beam and b/bootstrap/lib/kernel/ebin/os.beam differ diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam index 775f43ce2f..68d1b50f84 100644 Binary files a/bootstrap/lib/kernel/ebin/seq_trace.beam and b/bootstrap/lib/kernel/ebin/seq_trace.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index 9ad11640b5..4caf4f6455 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam index d9d34914f9..b255a4e10f 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets.beam and b/bootstrap/lib/stdlib/ebin/dets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam index 136c2d5196..8b1719eb0a 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin.beam and b/bootstrap/lib/stdlib/ebin/edlin.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam index c8358c42b8..b58781d3f8 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_eval.beam and b/bootstrap/lib/stdlib/ebin/erl_eval.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 0cdf78b62b..ff2d94324a 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam index 78d9d727eb..d23ec4d0ee 100644 Binary files a/bootstrap/lib/stdlib/ebin/file_sorter.beam and b/bootstrap/lib/stdlib/ebin/file_sorter.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index a8ee669a95..66b712b1d1 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam index 51529c5570..e0aeaf3d23 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc.beam and b/bootstrap/lib/stdlib/ebin/qlc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 915c8dfc91..af12a888b6 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam index 7cc095b953..5514b0d4f9 100644 Binary files a/bootstrap/lib/stdlib/ebin/sofs.beam and b/bootstrap/lib/stdlib/ebin/sofs.beam differ diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 3e166b2b4b..7287cbd451 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", "compiler-5.0"]} ]}. -- cgit v1.2.3 From 42a363dbdf2c212833159edaa3391efc4d33c73c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Feb 2016 12:25:41 +0100 Subject: compile_SUITE: Replace confusing files/2 with get_files/3 The files/2 function is confusing. The second argument names the output directory, not the name of the source module. It is common trap to attempt to point a different source file using files/2. Introduce the new get_files/3 which explicitly names the module name. --- lib/compiler/test/compile_SUITE.erl | 42 ++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 806cb58bab..212cbcb16b 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -86,7 +86,7 @@ file_1(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {Simple, Target} = files(Config, "file_1"), + {Simple, Target} = get_files(Config, simple, "file_1"), ?line {ok, Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -179,7 +179,7 @@ big_file(Config) when is_list(Config) -> outdir(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "outdir"), + {Simple, Target} = get_files(Config, simple, "outdir"), ?line {ok, simple} = compile:file(Simple, [{outdir, filename:dirname(Target)}]), ?line true = exists(Target), ?line passed = run(Target, test, []), @@ -192,7 +192,7 @@ outdir(Config) when is_list(Config) -> binary(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "binary"), + {Simple, Target} = get_files(Config, simple, "binary"), ?line {ok, simple, Binary} = compile:file(Simple, [binary]), ?line code:load_binary(simple, Target, Binary), ?line passed = simple:test(), @@ -206,7 +206,7 @@ binary(Config) when is_list(Config) -> makedep(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple,Target} = files(Config, "makedep"), + {Simple,Target} = get_files(Config, simple, "makedep"), ?line DataDir = ?config(data_dir, Config), ?line SimpleRootname = filename:rootname(Simple), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), @@ -282,7 +282,7 @@ makedep_modify_target(Mf, Target) -> cond_and_ifdef(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {Simple, Target} = files(Config, "cond_and_ifdef"), + {Simple, Target} = get_files(Config, simple, "cond_and_ifdef"), ?line IncludeDir = filename:join(filename:dirname(Simple), "include"), ?line Options = [{outdir, filename:dirname(Target)}, {d, need_foo}, {d, foo_value, 42}, @@ -434,7 +434,7 @@ other_output(Config) when is_list(Config) -> encrypted_abstr(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line {Simple,Target} = files(Config, "encrypted_abstr"), + {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), Res = case has_crypto() of false -> @@ -582,17 +582,17 @@ do_listing(Source, TargetDir, Type, Ext) -> Target = filename:join(TargetDir, SourceBase ++ Ext), true = exists(Target). -files(Config, Name) -> - ?line code:delete(simple), - ?line code:purge(simple), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, "simple"), - ?line TargetDir = filename:join(PrivDir, Name), - ?line ok = file:make_dir(TargetDir), - ?line Target = filename:join(TargetDir, "simple"++code:objfile_extension()), - {Simple, Target}. - +get_files(Config, Module, OutputName) -> + code:delete(Module), + code:purge(Module), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Src = filename:join(DataDir, atom_to_list(Module)), + TargetDir = filename:join(PrivDir, OutputName), + ok = file:make_dir(TargetDir), + File = atom_to_list(Module) ++ code:objfile_extension(), + Target = filename:join(TargetDir, File), + {Src, Target}. run(Target, Func, Args) -> ?line Module = list_to_atom(filename:rootname(filename:basename(Target))), @@ -715,7 +715,7 @@ init(ReplyTo, Fun, _Filler) -> ReplyTo ! {result, Fun()}. env(Config) when is_list(Config) -> - ?line {Simple,Target} = files(Config, "file_1"), + {Simple,Target} = get_files(Config, simple, env), ?line {ok,Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -724,9 +724,9 @@ env(Config) when is_list(Config) -> env_1(Simple, Target) after true = os:putenv("ERL_COMPILER_OPTIONS", "ignore_me"), - file:set_cwd(Cwd), - file:delete(Target), - file:del_dir(filename:dirname(Target)) + file:set_cwd(Cwd), + file:delete(Target), + file:del_dir(filename:dirname(Target)) end, ok. -- cgit v1.2.3 From 6233c5db89867fae35f69bd7b8ef94b32cec605d Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 3 Feb 2016 15:22:04 +0100 Subject: mnesia: Avoid deadlock possibility in mnesia:del_table_copy schema del_table_copy grabs a write lock in a new process in prepare_op/3 to change 'where_to_read' when a table copy is updated. When del_table_copy(schema, Node) is called all copies located on Node are deleted, and thus many locks are taken. Since this was done outside of the schema-transaction, mnesia's deadlock prevention algorithms was sidestepped and a deadlock could occur. Fix by always grabbing write-locks for all changed tabs early and in the same transaction, this might slow done the operation some but it must be done and it also cleans up the code. --- lib/mnesia/src/mnesia_schema.erl | 82 +++++++------------------------ lib/mnesia/test/mnesia_isolation_test.erl | 71 +++++++++++++++++++++----- 2 files changed, 77 insertions(+), 76 deletions(-) diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 593360415d..2acddccf6e 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1297,6 +1297,7 @@ make_del_table_copy(Tab, Node) -> _ -> ensure_active(Cs), verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}] end. @@ -1324,6 +1325,7 @@ remove_node_from_tabs([Tab|Rest], Node) -> remove_node_from_tabs(Rest, Node)]; _Ns -> verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}| remove_node_from_tabs(Rest, Node)] end @@ -1355,6 +1357,7 @@ do_move_table(schema, _FromNode, _ToNode) -> mnesia:abort({bad_type, schema}); do_move_table(Tab, FromNode, ToNode) when is_atom(FromNode), is_atom(ToNode) -> TidTs = get_tid_ts_and_lock(schema, write), + %% get_tid_ts_and_lock(Tab, write), write locked by load_table in mnesia_loader insert_schema_ops(TidTs, make_move_table(Tab, FromNode, ToNode)); do_move_table(Tab, FromNode, ToNode) -> mnesia:abort({badarg, Tab, FromNode, ToNode}). @@ -1993,28 +1996,11 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> {true, optional} end; -prepare_op(Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> +prepare_op(_Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - - if - %% Schema table lock is always required to run a schema op. - %% No need to look it. - node(Tid#tid.pid) == node(), Tab /= schema -> - Self = self(), - Pid = spawn_link(fun() -> lock_del_table(Tab, Node, Cs, Self) end), - put(mnesia_lock, Pid), - receive - {Pid, updated} -> - {true, optional}; - {Pid, FailReason} -> - mnesia:abort(FailReason); - {'EXIT', Pid, Reason} -> - mnesia:abort(Reason) - end; - true -> - {true, optional} - end; + set_where_to_read(Tab, Node, Cs), + {true, optional}; prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) when N == node() -> @@ -2228,46 +2214,6 @@ receive_sync(Nodes, Pids) -> {abort, Else} end. -lock_del_table(Tab, NewNode, Cs0, Father) -> - Ns = val({schema, active_replicas}), - process_flag(trap_exit,true), - Lock = fun() -> - mnesia:write_lock_table(Tab), - %% Sigh using cs record - Set = fun(Node) -> - [Cs] = normalize_cs([Cs0], Node), - rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs]) - end, - Res = [Set(Node) || Node <- Ns], - Filter = fun(ok) -> - false; - ({badrpc, {'EXIT', {undef, _}}}) -> - %% This will be the case we talks with elder nodes - %% than 3.8.2, they will set where_to_read without - %% getting a lock. - false; - (_) -> - true - end, - case lists:filter(Filter, Res) of - [] -> - Father ! {self(), updated}, - %% When transaction is commited the process dies - %% and the lock is released. - receive _ -> ok end; - Err -> - Father ! {self(), {bad_commit, Err}} - end, - ok - end, - case mnesia:transaction(Lock) of - {atomic, ok} -> ok; - {aborted, R} -> Father ! {self(), R} - end, - unlink(Father), - unlink(whereis(mnesia_tm)), - exit(normal). - set_where_to_read(Tab, Node, Cs) -> case mnesia_lib:val({Tab, where_to_read}) of Node -> @@ -2418,13 +2364,19 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> insert_cstruct(Tid, Cs2, true) % Don't care about the version end; -undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) - when Node == node() -> - WriteLocker = get(mnesia_lock), - WriteLocker =/= undefined andalso (WriteLocker ! die), +undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - mnesia_lib:set({Tab, where_to_read}, Node); + if node() =:= Node -> + mnesia_lib:set({Tab, where_to_read}, Node); + true -> + case mnesia_lib:val({Tab, where_to_read}) of + nowhere -> + mnesia_lib:set_remote_where_to_read(Tab); + true -> + ignore + end + end; undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index b66da6e390..4dd0c01d05 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -39,7 +39,7 @@ groups() -> [{locking, [], [no_conflict, simple_queue_conflict, advanced_queue_conflict, simple_deadlock_conflict, - advanced_deadlock_conflict, lock_burst, + advanced_deadlock_conflict, schema_deadlock, lock_burst, {group, sticky_locks}, {group, unbound_locking}, {group, admin_conflict}, nasty]}, {sticky_locks, [], [basic_sticky_functionality]}, @@ -148,20 +148,32 @@ simple_queue_conflict(Config) when is_list(Config) -> fun_loop(Fun, AllSharedLocks, OneExclusiveLocks), ok. -wait_for_lock(Pid, _Nodes, 0) -> +wait_for_lock(Pid, Nodes, Retry) -> + wait_for_lock(Pid, Nodes, Retry, queue). + +wait_for_lock(Pid, _Nodes, 0, queue) -> Queue = mnesia:system_info(lock_queue), ?error("Timeout while waiting for lock on Pid ~p in queue ~p~n", [Pid, Queue]); -wait_for_lock(Pid, Nodes, N) -> - rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), - List = [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes], +wait_for_lock(Pid, _Nodes, 0, held) -> + Held = mnesia:system_info(held_locks), + ?error("Timeout while waiting for lock on Pid ~p (held) ~p~n", [Pid, Held]); +wait_for_lock(Pid, Nodes, N, Where) -> + rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), + List = case Where of + queue -> + [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes]; + held -> + [rpc:call(Node, mnesia, system_info, [held_locks]) || Node <- Nodes] + end, Q = lists:append(List), - check_q(Pid, Q, Nodes, N). + check_q(Pid, Q, Nodes, N, Where). -check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count) -> ok; -check_q(Pid, [_ | Tail], N, Count) -> check_q(Pid, Tail, N, Count); -check_q(Pid, [], N, Count) -> - timer:sleep(500), - wait_for_lock(Pid, N, Count - 1). +check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [{_Oid, _Op, {tid,_,Pid}} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [_ | Tail], N, Count, Where) -> check_q(Pid, Tail, N, Count, Where); +check_q(Pid, [], N, Count, Where) -> + timer:sleep(200), + wait_for_lock(Pid, N, Count - 1, Where). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,6 +282,43 @@ advanced_deadlock_conflict(Config) when is_list(Config) -> ?match([], mnesia:system_info(lock_queue)), ok. +%% Verify (and regression test) deadlock in del_table_copy(schema, Node) +schema_deadlock(Config) when is_list(Config) -> + Ns = [Node1, Node2] = ?acquire_nodes(2, Config), + ?match({atomic, ok}, mnesia:create_table(a, [{disc_copies, Ns}])), + ?match({atomic, ok}, mnesia:create_table(b, [{disc_copies, Ns}])), + + Tester = self(), + + Deadlocker = fun() -> + mnesia:write({a,1,1}), %% grab write lock on A + receive + continue -> + mnesia:write({b,1,1}), %% grab write lock on B + end_trans + end + end, + + ?match(stopped, rpc:call(Node2, mnesia, stop, [])), + timer:sleep(500), %% Let Node1 reconfigure + sys:get_status(mnesia_monitor), + + DoingTrans = spawn_link(fun() -> Tester ! {self(),mnesia:transaction(Deadlocker)} end), + wait_for_lock(DoingTrans, [Node1], 10, held), + %% Will grab write locks on schema, a, and b + DoingSchema = spawn_link(fun() -> Tester ! {self(), mnesia:del_table_copy(schema, Node2)} end), + timer:sleep(500), %% Let schema trans start, and try to grab locks + DoingTrans ! continue, + + ?match(ok, receive {DoingTrans, {atomic, end_trans}} -> ok after 5000 -> timeout end), + ?match(ok, receive {DoingSchema, {atomic, ok}} -> ok after 5000 -> timeout end), + + sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async + ?match([], mnesia:system_info(held_locks)), + ?match([], mnesia:system_info(lock_queue)), + ok. + + one_oid(Tab) -> {Tab, 1}. other_oid(Tab) -> {Tab, 2}. -- cgit v1.2.3 From bf11b8fc3e9ac0f3cd48d8a3a834bd7d709ecc9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Feb 2016 12:38:19 +0100 Subject: compile_SUITE: Use get_files/3 in more places --- lib/compiler/test/compile_SUITE.erl | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 212cbcb16b..b68d039681 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -161,11 +161,8 @@ module_mismatch(Config) when is_list(Config) -> big_file(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, "big.erl"), - ?line Target = filename:join(PrivDir, "big.beam"), - ?line ok = file:set_cwd(PrivDir), + {Big,Target} = get_files(Config, big, "big_file"), + ok = file:set_cwd(filename:dirname(Target)), ?line compile_and_verify(Big, Target, []), ?line compile_and_verify(Big, Target, [debug_info]), ?line compile_and_verify(Big, Target, [no_postopt]), @@ -362,21 +359,18 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> listings_big(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Big = filename:join(DataDir, big), - ?line TargetDir = filename:join(PrivDir, listings_big), - ?line ok = file:make_dir(TargetDir), + {Big,Target} = get_files(Config, big, listings_big), + TargetDir = filename:dirname(Target), ?line do_listing(Big, TargetDir, 'S'), ?line do_listing(Big, TargetDir, 'E'), ?line do_listing(Big, TargetDir, 'P'), ?line do_listing(Big, TargetDir, dkern, ".kernel"), - ?line Target = filename:join(TargetDir, big), - {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), + TargetNoext = filename:rootname(Target, code:objfile_extension()), + {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), %% Cleanup. - ?line ok = file:delete(Target ++ ".beam"), + ok = file:delete(Target), ?line lists:foreach(fun(F) -> ok = file:delete(F) end, filelib:wildcard(filename:join(TargetDir, "*"))), ?line ok = file:del_dir(TargetDir), @@ -385,11 +379,7 @@ listings_big(Config) when is_list(Config) -> other_output(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(8)), - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(DataDir, simple), - ?line TargetDir = filename:join(PrivDir, other_output), - ?line ok = file:make_dir(TargetDir), + {Simple,_Target} = get_files(Config, simple, "other_output"), io:put_chars("to_pp"), ?line {ok,[],PP} = compile:file(Simple, [to_pp,binary,time]), -- cgit v1.2.3 From 6fbe8cd45ee7f9f63dd0cad38dd6529598dcb21e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Feb 2016 13:10:38 +0100 Subject: Move record compilation errors to erl_lint_SUITE The two bad record usage test cases in compile_SUITE do not belong there, as the errors are detected in erl_lint. Move the test to the erl_lint_SUITE. --- lib/compiler/test/compile_SUITE.erl | 29 +++------------------ .../test/compile_SUITE_data/bad_record_use.erl | 29 --------------------- .../test/compile_SUITE_data/bad_record_use2.erl | 30 ---------------------- lib/stdlib/test/erl_lint_SUITE.erl | 17 ++++++++++-- 4 files changed, 18 insertions(+), 87 deletions(-) delete mode 100644 lib/compiler/test/compile_SUITE_data/bad_record_use.erl delete mode 100644 lib/compiler/test/compile_SUITE_data/bad_record_use2.erl diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index b68d039681..ab9910f555 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -29,7 +29,7 @@ file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, - bad_record_use1/1, bad_record_use2/1, strict_record/1, + strict_record/1, missing_testheap/1, cover/1, env/1, core/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1 @@ -48,13 +48,12 @@ all() -> [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, - {group, bad_record_use}, strict_record, + strict_record, missing_testheap, cover, env, core, asm, sys_pre_attributes, dialyzer, warnings]. groups() -> - [{bad_record_use, [], - [bad_record_use1, bad_record_use2]}]. + []. init_per_suite(Config) -> Config. @@ -599,28 +598,6 @@ exists(Name) -> end. -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use1(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - -%% Tests that the compiler does not accept -%% bad use of records. -bad_record_use2(Config) when is_list(Config) -> - ?line {ok, Cwd} = file:get_cwd(), - ?line file:set_cwd(?config(data_dir, Config)), - ?line true=exists("bad_record_use2.erl"), - ?line Ret=c:c(bad_record_use), - ?line file:set_cwd(Cwd), - ?line error=Ret, - ok. - strict_record(Config) when is_list(Config) -> ?line Priv = ?config(priv_dir, Config), ?line file:set_cwd(?config(data_dir, Config)), diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use.erl deleted file mode 100644 index 0fb6fc3045..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bad_record_use). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - NewRecord=#bad_use{a=1, b=2, a=2}. - diff --git a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl b/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl deleted file mode 100644 index 7c898af00f..0000000000 --- a/lib/compiler/test/compile_SUITE_data/bad_record_use2.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bad_record_use2). --export([test/0]). - --record(bad_use, {a=undefined, - b=undefined, - c=undefined}). - -test() -> - R=#bad_use{a=1, b=2}, - R2=R#bad_use{a=1, b=2, a=2}, - ok. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c5e2e5609d..32247ba492 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,8 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1 + maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1, + record_errors/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +95,8 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_11879, otp_13230]. + maps, maps_type, otp_11851, otp_11879, otp_13230, + record_errors]. groups() -> [{unused_vars_warn, [], @@ -3881,6 +3883,17 @@ otp_13230(Config) when is_list(Config) -> []} = run_test2(Config, Abstr, []), ok. +record_errors(Config) when is_list(Config) -> + Ts = [{rec1, + <<"-record(r, {a,b}). + b() -> #r{a=foo,b=42,a=bar}. + u(R) -> R#r{a=1,b=2,a=2}. + ">>, + [], + {errors,[{2,erl_lint,{redefine_field,r,a}}, + {3,erl_lint,{redefine_field,r,a}}],[]}}], + run(Config, Ts). + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of -- cgit v1.2.3 From 0ec1cf3249f4f043525ee8ad3470023b36f6e7ec Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 5 Feb 2016 15:03:42 +0100 Subject: ssl: Big handshake messages needs to be fragmented on TLS record level --- lib/ssl/src/ssl_record.erl | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 75cfecdf5e..ce6b8fb84f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -311,9 +311,19 @@ set_pending_cipher_state(#connection_states{pending_read = Read, %% %% Description: Encodes a handshake message to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - +encode_handshake(Frag, Version, + #connection_states{current_write = + #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) + end. %%-------------------------------------------------------------------- -spec encode_alert_record(#alert{}, ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. -- cgit v1.2.3 From abde1d03db03536af19fdb274f1119bbfaba262b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 8 Feb 2016 07:06:31 +0100 Subject: Eliminate crash because of unsafe delaying of sub-binary creation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The following code would fail to compile: decode(<>) -> <> = Bin, case C1 of X when X =:= 1 orelse X =:= 2 -> Bin2 = <<>>; _ -> Bin2 = B1 end, case Code of 1 -> decode(Bin2); _ -> Bin2 end. The error message would be: t: function decode/1+28: Internal consistency check failed - please report this bug. Instruction: return Error: {match_context,{x,0}}: The beam_bsm pass would delay the creation of a sub-binary when it was unsafe to do so. The culprit was the btb_follow_branch/3 function that for performance reasons cached labels that had already been checked. The problem was the safety of a label also depends on the contents of the registers. Therefore, the key for caching needs to be both the label and the register contents. Reported-by: José Valim --- lib/compiler/src/beam_bsm.erl | 5 +++-- lib/compiler/test/bs_match_SUITE.erl | 32 ++++++++++++++++++++++++++++++-- 2 files changed, 33 insertions(+), 4 deletions(-) diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 4f76350269..62356928ae 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -421,7 +421,8 @@ btb_follow_branches([], _, D) -> D. btb_follow_branch(0, _Regs, D) -> D; btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> - case gb_sets:is_member(Lbl, Br0) of + Key = {Lbl,Regs}, + case gb_sets:is_member(Key, Br0) of true -> %% We have already followed this branch and it was OK. D; @@ -432,7 +433,7 @@ btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> btb_reaches_match_1(Is, Regs, D), %% Since we got back, this branch is OK. - D#btb{ok_br=gb_sets:insert(Lbl, Br),must_not_save=MustNotSave, + D#btb{ok_br=gb_sets:insert(Key, Br),must_not_save=MustNotSave, must_save=MustSave} end. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index b4601b0798..7fb0a16540 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -36,7 +36,8 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, no_partition/1,calling_a_binary/1,binary_in_map/1, - match_string_opt/1,map_and_binary/1]). + match_string_opt/1,map_and_binary/1, + unsafe_branch_caching/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -62,7 +63,8 @@ groups() -> otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, no_partition,calling_a_binary,binary_in_map, - match_string_opt,map_and_binary]}]. + match_string_opt,map_and_binary, + unsafe_branch_caching]}]. init_per_suite(Config) -> @@ -1243,6 +1245,32 @@ do_map_and_binary(#{time := _} = T) -> do_map_and_binary(#{hour := Hour, min := Min} = T) -> {Hour, Min, T}. +%% Unsafe caching of branch outcomes in beam_bsm would cause the +%% delayed creation of sub-binaries optimization to be applied even +%% when it was unsafe. + +unsafe_branch_caching(_Config) -> + <<>> = do_unsafe_branch_caching(<<42,1>>), + <<>> = do_unsafe_branch_caching(<<42,2>>), + <<>> = do_unsafe_branch_caching(<<42,3>>), + <<17,18>> = do_unsafe_branch_caching(<<42,3,17,18>>), + <<>> = do_unsafe_branch_caching(<<1,3,42,2>>), + + ok. + +do_unsafe_branch_caching(<>) -> + <> = Bin, + case C1 of + X when X =:= 1 orelse X =:= 2 -> + Bin2 = <<>>; + _ -> + Bin2 = B1 + end, + case Code of + 1 -> do_unsafe_branch_caching(Bin2); + _ -> Bin2 + end. + check(F, R) -> R = F(). -- cgit v1.2.3 From 05e77dac85c5c1686865e015078dfc16bec5f013 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 10:19:04 +0100 Subject: tools: Correct a Cover test --- lib/tools/test/cover_SUITE.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 8264747a3b..71570a55fa 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1549,7 +1549,7 @@ comprehension_8188(Cf) -> %% The template cannot have a counter since it is not allowed to %% be a block. - ?line [% {{t,1},1}, + ?line [{{t,1},1}, %% {{t,2},2}, {{t,3},1}, {{t,4},1}, @@ -1559,7 +1559,7 @@ comprehension_8188(Cf) -> {{t,12},3}, {{t,13},2}, {{t,14},2}] = - analyse_expr(<<"<< \n" % 1 (now: 0) + analyse_expr(<<"<< \n" % 1 " << (X*2) >> || \n" % 2 (now: 0) " <> <= << (case two() of\n" " 2 -> 1;\n" % 1 @@ -1574,7 +1574,7 @@ comprehension_8188(Cf) -> " true >>.\n" % 2 "two() -> 2">>, Cf), - ?line [% {{t,1},1}, + ?line [{{t,1},1}, %% {{t,2},4}, {{t,4},1}, {{t,6},1}, @@ -1583,7 +1583,7 @@ comprehension_8188(Cf) -> {{t,11},2}, {{t,12},4}, {{t,13},1}] = - analyse_expr(<<"<< \n" % 1 (now: 0) + analyse_expr(<<"<< \n" % 1 " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <> <= << 1,\n" % 1 -- cgit v1.2.3 From 4884986bc945978177b02a7e81c50a5ea2f007fa Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 26 Nov 2015 15:18:39 +0100 Subject: dialyzer: Fix a bug concerning the option 'plt_remove' [James Fish:] Dialyzer always asserts that files and directories passed in its options exist. Therefore it is not possible to remove a beam/module from a PLT when the beam file no longer exists. Dialyzer should not to check files exist on disk when removing from the PLT. --- lib/dialyzer/src/dialyzer_options.erl | 36 +++++++++++++++++++++-------- lib/dialyzer/test/plt_SUITE.erl | 43 +++++++++++++++++++++++++++++++---- 2 files changed, 65 insertions(+), 14 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index ce84c17f43..dd81dd01ed 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -72,9 +72,15 @@ preprocess_opts([Opt|Opts]) -> [Opt|preprocess_opts(Opts)]. postprocess_opts(Opts = #options{}) -> + check_file_existence(Opts), Opts1 = check_output_plt(Opts), adapt_get_warnings(Opts1). +check_file_existence(#options{analysis_type = plt_remove}) -> ok; +check_file_existence(#options{files = Files, files_rec = FilesRec}) -> + assert_filenames_exist(Files), + assert_filenames_exist(FilesRec). + check_output_plt(Opts = #options{analysis_type = Mode, from = From, output_plt = OutPLT}) -> case is_plt_mode(Mode) of @@ -126,14 +132,14 @@ build_options([{OptionName, Value} = Term|Rest], Options) -> apps -> OldValues = Options#options.files_rec, AppDirs = get_app_dirs(Value), - assert_filenames(Term, AppDirs), + assert_filenames_form(Term, AppDirs), build_options(Rest, Options#options{files_rec = AppDirs ++ OldValues}); files -> - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files = Value}); files_rec -> OldValues = Options#options.files_rec, - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files_rec = Value ++ OldValues}); analysis_type -> NewOptions = @@ -210,16 +216,26 @@ get_app_dirs(Apps) when is_list(Apps) -> get_app_dirs(Apps) -> bad_option("Use a list of otp applications", Apps). -assert_filenames(Term, [FileName|Left]) when length(FileName) >= 0 -> +assert_filenames(Term, Files) -> + assert_filenames_form(Term, Files), + assert_filenames_exist(Files). + +assert_filenames_form(Term, [FileName|Left]) when length(FileName) >= 0 -> + assert_filenames_form(Term, Left); +assert_filenames_form(_Term, []) -> + ok; +assert_filenames_form(Term, [_|_]) -> + bad_option("Malformed or non-existing filename", Term). + +assert_filenames_exist([FileName|Left]) -> case filelib:is_file(FileName) orelse filelib:is_dir(FileName) of true -> ok; - false -> bad_option("No such file, directory or application", FileName) + false -> + bad_option("No such file, directory or application", FileName) end, - assert_filenames(Term, Left); -assert_filenames(_Term, []) -> - ok; -assert_filenames(Term, [_|_]) -> - bad_option("Malformed or non-existing filename", Term). + assert_filenames_exist(Left); +assert_filenames_exist([]) -> + ok. assert_filename(FileName) when length(FileName) >= 0 -> ok; diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index 16180a7435..6ebe23b54b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -8,14 +8,13 @@ -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, local_fun_same_as_callback/1, - run_plt_check/1, run_succ_typings/1]). + remove_plt/1, run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> - [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings, - local_fun_same_as_callback]. +all() -> [build_plt, beam_tests, update_plt, run_plt_check, + remove_plt, run_succ_typings, local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -213,6 +212,42 @@ local_fun_same_as_callback(Config) when is_list(Config) -> {init_plt, Plt}] ++ Opts), ok. +%%% [James Fish:] +%%% Dialyzer always asserts that files and directories passed in its +%%% options exist. Therefore it is not possible to remove a beam/module +%%% from a PLT when the beam file no longer exists. Dialyzer should not to +%%% check files exist on disk when removing from the PLT. +remove_plt(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = <<"-module(m1). + -export([t/0]). + t() -> + m2:a(a).">>, + {ok, Beam1} = compile(Config, Prog1, m1, []), + + Prog2 = <<"-module(m2). + -export([a/1]). + a(A) when is_integer(A) -> A.">>, + {ok, Beam2} = compile(Config, Prog2, m2, []), + + Plt = filename:join(PrivDir, "remove.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + + [{warn_return_no_exit, _, {no_return,[only_normal,t,0]}}, + {warn_failing_call, _, {call, [m2,a,"('a')",_,_,_,_,_]}}] = + dialyzer:run([{analysis_type, plt_build}, + {files, [Beam1, Beam2]}, + {get_warnings, true}, + {output_plt, Plt}] ++ Opts), + + [] = dialyzer:run([{init_plt, Plt}, + {files, [Beam2]}, + {analysis_type, plt_remove}]), + + [] = dialyzer:run([{analysis_type, succ_typings}, + {files, [Beam1]}, + {init_plt, Plt}] ++ Opts), + ok. compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), -- cgit v1.2.3 From 60f828c89fde5fc9fccfa6305512d9458f5293c4 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Thu, 28 Jan 2016 12:17:59 +0100 Subject: ssh: fixes port_command failure on WIndows in ssh_test_cli.erl --- lib/ssh/test/ssh_basic_SUITE.erl | 8 ++++++-- lib/ssh/test/ssh_test_cli.erl | 15 ++++++++++----- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 6c4c215b3d..4b53f6ec57 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -601,10 +601,14 @@ cli(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - + + TmpDir = filename:join(?config(priv_dir,Config), "tmp"), + ok = ssh_test_lib:del_dirs(TmpDir), + ok = file:make_dir(TmpDir), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {password, "morot"}, - {ssh_cli, {ssh_test_cli, [cli]}}, + {ssh_cli, {ssh_test_cli, [cli,TmpDir]}}, {subsystems, []}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index cd9ad5f2ff..697ddb730d 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -4,20 +4,25 @@ -record(state, { type, + tmpdir, id, ref, port }). -init([Type]) -> - {ok, #state{type = Type}}. + +init([Type]) -> init([Type,"/tmp"]); + +init([Type,TmpDir]) -> + {ok, #state{type = Type, + tmpdir = TmpDir}}. handle_msg({ssh_channel_up, Id, Ref}, S) -> User = get_ssh_user(Ref), ok = ssh_connection:send(Ref, Id, << "\r\nYou are accessing a dummy, type \"q\" to exit\r\n\n" >>), - Port = run_portprog(User, S#state.type), + Port = run_portprog(User, S#state.type, S#state.tmpdir), {ok, S#state{port = Port, id = Id, ref = Ref}}; handle_msg({Port, {data, Data}}, S = #state{port = Port}) -> @@ -68,10 +73,10 @@ handle_ssh_msg({ssh_cm, _, {exit_signal, Id, _, _, _}}, terminate(_Why, _S) -> nop. -run_portprog(User, cli) -> +run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), open_port({spawn_executable, Pty_bin}, - [stream, {cd, "/tmp"}, {env, [{"USER", User}]}, + [stream, {cd, TmpDir}, {env, [{"USER", User}]}, {args, []}, binary, exit_status, use_stdio, stderr_to_stdout]). -- cgit v1.2.3 From 14680fcc3fb9d0357fe33a94525d08896afed1c5 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Thu, 3 Dec 2015 14:33:53 +0100 Subject: erts: Use Sint instead of int for list lengths This avoids potential integer arithmetic overflow for very large lists. --- erts/emulator/beam/beam_bif_load.c | 6 +++--- erts/emulator/beam/beam_load.c | 4 ++-- erts/emulator/beam/bif.c | 18 +++++++++--------- erts/emulator/beam/erl_bif_info.c | 4 ++-- erts/emulator/beam/erl_bif_lists.c | 8 ++++---- erts/emulator/beam/erl_bif_port.c | 8 ++++---- erts/emulator/beam/erl_process_dict.c | 4 ++-- erts/emulator/beam/erl_utils.h | 2 +- erts/emulator/beam/global.h | 4 ++-- erts/emulator/beam/utils.c | 17 +++++++++-------- 10 files changed, 38 insertions(+), 37 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index a000935388..1b4c022370 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -179,8 +179,8 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) BIF_RETTYPE finish_loading_1(BIF_ALIST_1) { - int i; - int n; + Sint i; + Sint n; struct m* p = NULL; Uint exceptions; Eterm res; @@ -201,7 +201,7 @@ finish_loading_1(BIF_ALIST_1) */ n = erts_list_length(BIF_ARG_1); - if (n == -1) { + if (n < 0) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); goto done; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index d367cce212..10f9f7bc2f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -6219,10 +6219,10 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) BeamInstr* code_base; BeamInstr* fp; byte* info; - int n; + Sint n; int code_size; int rval; - int i; + Sint i; byte* temp_alloc = NULL; byte* bytes; Uint size; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index e116b10b95..2654785ffc 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2837,7 +2837,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) { Eterm res; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); - int i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); + Sint i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); if (i < 0) { erts_free(ERTS_ALC_T_TMP, (void *) buf); @@ -2857,7 +2857,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) { - int i; + Sint i; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS)) < 0) { @@ -2964,7 +2964,7 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) and since we have erts_chars_to_integer now it is simpler as well. This could be optmized further if we did not have to copy the list to buf. */ - int i; + Sint i; Eterm res, dummy; int base; @@ -3288,7 +3288,7 @@ static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) { BIF_RETTYPE list_to_float_1(BIF_ALIST_1) { - int i; + Sint i; Eterm res; char *buf = NULL; @@ -3405,7 +3405,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1) Eterm* cons; Eterm res; Eterm* hp; - int len; + Sint len; if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) { BIF_ERROR(BIF_P, BADARG); @@ -3752,7 +3752,7 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1) { Process* p = BIF_P; Eterm string = BIF_ARG_1; - int len = is_string(string); + Sint len = is_string(string); char *str; if (len <= 0) { @@ -3806,7 +3806,7 @@ BIF_RETTYPE halt_1(BIF_ALIST_1) erl_exit(ERTS_ABORT_EXIT, ""); } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { - int i; + Sint i; if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) { goto error; @@ -3875,7 +3875,7 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) erl_exit(ERTS_ABORT_EXIT, ""); } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { - int i; + Sint i; if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) { goto error; @@ -4018,7 +4018,7 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) { Uint a = 0, b = 0, c = 0; char* cp; - int i; + Sint i; DistEntry *dep = NULL; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, 65); /* diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 017339e1f6..bc5c83e542 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1721,7 +1721,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ if (arity == 2) { Eterm res = THE_NON_VALUE; char *buf; - int len = is_string(*tp); + Sint len = is_string(*tp); if (len <= 0) return res; buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); @@ -1740,7 +1740,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ else { Eterm res = THE_NON_VALUE; char *buf; - int len = is_string(tp[1]); + Sint len = is_string(tp[1]); if (len <= 0) return res; buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 5583dcb371..fe64e76575 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -42,7 +42,7 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) Eterm last; size_t need; Eterm* hp; - int i; + Sint i; if ((i = erts_list_length(A)) < 0) { BIF_ERROR(p, BADARG); @@ -99,9 +99,9 @@ static Eterm subtract(Process* p, Eterm A, Eterm B) Eterm small_vec[SMALL_VEC_SIZE]; /* Preallocated memory for small lists */ Eterm* vec_p; Eterm* vp; - int i; - int n; - int m; + Sint i; + Sint n; + Sint m; if ((n = erts_list_length(A)) < 0) { BIF_ERROR(p, BADARG); diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 839abd0424..3acc1d7bbd 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -649,7 +649,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1) static Port * open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) { - int i; + Sint i; Eterm option; Uint arity; Eterm* tp; @@ -977,8 +977,8 @@ static char **convert_args(Eterm l) { char **pp; char *b; - int n; - int i = 0; + Sint n; + Sint i = 0; Eterm str; if (is_not_list(l) && is_not_nil(l)) { return NULL; @@ -1024,7 +1024,7 @@ static byte* convert_environment(Process* p, Eterm env) Eterm* temp_heap; Eterm* hp; Uint heap_size; - int n; + Sint n; Sint size; byte* bytes; int encoding = erts_get_native_filename_encoding(); diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 84cd81aecf..36d16f7f42 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -749,7 +749,7 @@ static void shrink(Process *p, Eterm* ret) if (lo == NIL) { ARRAY_PUT(pd, pd->splitPosition, hi); } else { - int needed = 4; + Sint needed = 4; if (is_list(hi) && is_list(lo)) { needed = 2*erts_list_length(hi); } @@ -814,7 +814,7 @@ static void grow(Process *p) Eterm *hp; unsigned int pos; unsigned int homeSize; - int needed = 0; + Sint needed = 0; ProcDict *pd = p->dictionary; #ifdef DEBUG Eterm *hp_limit; diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 4058d63eaf..b86786a9c0 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -115,7 +115,7 @@ void erts_silence_warn_unused_result(long unused); int erts_fit_in_bits_int64(Sint64); int erts_fit_in_bits_int32(Sint32); int erts_fit_in_bits_uint(Uint); -int erts_list_length(Eterm); +Sint 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/global.h b/erts/emulator/beam/global.h index e8a7573e86..628f36a35e 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1308,7 +1308,7 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen); #define ERTS_UTF8_OK_MAX_CHARS 4 void bin_write(int, void*, byte*, size_t); -int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */ +Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */ struct Sint_buf { #if defined(ARCH_64) @@ -1381,7 +1381,7 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT); ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *); int erts_iolist_size_yielding(ErtsIOListState *state); int erts_iolist_size(Eterm, ErlDrvSizeT *); -int is_string(Eterm); +Sint is_string(Eterm); void erl_at_exit(void (*) (void*), void*); Eterm collect_memory(Process *); void dump_memory_to_fd(int); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index ef851d840d..35dfee49cd 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -317,10 +317,10 @@ erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue) * Calculate length of a list. * Returns -1 if not a proper list (i.e. not terminated with NIL) */ -int +Sint erts_list_length(Eterm list) { - int i = 0; + Sint i = 0; while(is_list(list)) { i++; @@ -3930,11 +3930,11 @@ void bin_write(int to, void *to_arg, byte* buf, size_t sz) /* Fill buf with the contents of bytelist list return number of chars in list or -1 for error */ -int -intlist_to_buf(Eterm list, char *buf, int len) +Sint +intlist_to_buf(Eterm list, char *buf, Sint len) { Eterm* listptr; - int sz = 0; + Sint sz = 0; if (is_nil(list)) return 0; @@ -4481,11 +4481,12 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep) return iolist_size(0, NULL, obj, sizep); } -/* return 0 if item is not a non-empty flat list of bytes */ -int +/* return 0 if item is not a non-empty flat list of bytes + otherwise return the nonzero length of the list */ +Sint is_string(Eterm list) { - int len = 0; + Sint len = 0; while(is_list(list)) { Eterm* consp = list_val(list); -- cgit v1.2.3 From 7a319cd96f7f4869300b32442ebe892ae557f41c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 8 Feb 2016 15:47:49 +0100 Subject: erts: Fix error cases in enif_get_list_length false if improper list false if length > UINT_MAX --- erts/doc/src/erl_nif.xml | 2 +- erts/emulator/beam/erl_nif.c | 9 +++++++-- erts/emulator/test/nif_SUITE.erl | 4 ++-- erts/emulator/test/nif_SUITE_data/nif_SUITE.c | 6 +++++- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 420c9fea38..be0e406b9c 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -753,7 +753,7 @@ typedef enum { intenif_get_list_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len) Get the length of list term

Set *len to the length of list term and return true, - or return false if term is not a list.

 + or return false if term is not a proper list.

 intenif_get_long(ErlNifEnv* env, ERL_NIF_TERM term, long int* ip) Read an long integer term diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index b057ec7770..12aaf4ce53 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -911,8 +911,13 @@ 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 = erts_list_length(term); + Sint i; + Uint u; + + if ((i = erts_list_length(term)) < 0) return 0; + u = (Uint)i; + if ((unsigned)u != u) return 0; + *len = u; return 1; } diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index b02a090103..bfec474966 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1398,7 +1398,7 @@ is_checks(Config) when is_list(Config) -> get_length(doc) -> ["Test all enif_get_length functions"]; get_length(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), - ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list). + ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list, [1,2|3]). ensure_lib_loaded(Config) -> ensure_lib_loaded(Config, 1). @@ -1951,7 +1951,7 @@ last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. -length_test(_,_,_,_,_) -> ?nif_stub. +length_test(_,_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. make_strings() -> ?nif_stub. make_new_resource_binary(_) -> ?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 8ebce4fef4..1acb270d1f 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -914,6 +914,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T * argv[2] empty list * argv[3] not an atom * argv[4] not a list + * argv[5] improper list */ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -934,6 +935,9 @@ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg if (enif_get_list_length(env, argv[4], &len)) return enif_make_badarg(env); + if (enif_get_list_length(env, argv[5], &len)) + return enif_make_badarg(env); + return enif_make_atom(env, "ok"); } @@ -2002,7 +2006,7 @@ static ErlNifFunc nif_funcs[] = {"make_new_resource", 2, make_new_resource}, {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, - {"length_test", 5, length_test}, + {"length_test", 6, length_test}, {"make_atoms", 0, make_atoms}, {"make_strings", 0, make_strings}, {"make_new_resource", 2, make_new_resource}, -- cgit v1.2.3 From 64724376b145aced17c9d518e5c41f25a2d85cc9 Mon Sep 17 00:00:00 2001 From: Matt Campbell Date: Fri, 5 Feb 2016 14:43:18 -0600 Subject: ssl: verify cert signature against original cert binary When searching for a certificate's issuer in the `CertDB`, verify the signature against the original DER certificate from the handshake instead of a re-encoding of the parsed certificate. This avoids false negatives due to differences between DER encoding implementations of OTP and other platforms. --- lib/ssl/src/ssl_certificate.erl | 22 ++++----- lib/ssl/test/ssl_certificate_verify_SUITE.erl | 65 ++++++++++++++++++++++++++- 2 files changed, 75 insertions(+), 12 deletions(-) diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 4658e76ab1..e9dc5764a3 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -56,15 +56,15 @@ %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -> - Path = [Cert | _] = lists:reverse(CertChain), - OtpCert = public_key:pkix_decode_cert(Cert, otp), + Path = [BinCert | _] = lists:reverse(CertChain), + OtpCert = public_key:pkix_decode_cert(BinCert, otp), SignedAndIssuerID = case public_key:pkix_is_self_signed(OtpCert) of true -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), {self, IssuerId}; false -> - other_issuer(OtpCert, CertDbHandle) + other_issuer(OtpCert, BinCert, CertDbHandle) end, case SignedAndIssuerID of @@ -187,7 +187,7 @@ public_key_type(?'id-ecPublicKey') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> +certificate_chain(OtpCert, BinCert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -200,7 +200,7 @@ certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> {_, true = SelfSigned} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, {SerialNr, Issuer}} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); @@ -232,12 +232,12 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned {ok, undefined, lists:reverse(Chain)} end. -find_issuer(OtpCert, CertDbHandle) -> +find_issuer(OtpCert, BinCert, CertDbHandle) -> IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of true -> - case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + case verify_cert_signer(BinCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of true -> throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); false -> @@ -265,9 +265,9 @@ is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). -verify_cert_signer(OtpCert, SignerTBSCert) -> +verify_cert_signer(BinCert, SignerTBSCert) -> PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), - public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + public_key:pkix_verify(BinCert, PublicKey). public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', parameters = Params}, @@ -281,12 +281,12 @@ public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorith subjectPublicKey = Key}) -> {Key, Params}. -other_issuer(OtpCert, CertDbHandle) -> +other_issuer(OtpCert, BinCert, CertDbHandle) -> case public_key:pkix_issuer_id(OtpCert, other) of {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5940a86a7f..968ef30791 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -75,7 +75,8 @@ error_handling_tests()-> unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, unknown_server_ca_accept_backwardscompatibility, - no_authority_key_identifier]. + no_authority_key_identifier, + no_authority_key_identifier_and_nonstandard_encoding]. init_per_suite(Config0) -> catch crypto:stop(), @@ -850,6 +851,68 @@ delete_authority_key_extension([Head | Rest], Acc) -> %%-------------------------------------------------------------------- +no_authority_key_identifier_and_nonstandard_encoding() -> + [{doc, "Test cert with nonstandard encoding that does not have" + " authorityKeyIdentifier extension but are present in trusted certs db."}]. + +no_authority_key_identifier_and_nonstandard_encoding(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + [{'Certificate', DerCert, _}] = ssl_test_lib:pem_to_der(CertFile), + ServerCert = public_key:pkix_decode_cert(DerCert, plain), + ServerTbsCert = ServerCert#'Certificate'.tbsCertificate, + Extensions0 = ServerTbsCert#'TBSCertificate'.extensions, + %% need to remove authorityKeyIdentifier extension to cause DB lookup by signature + Extensions = delete_authority_key_extension(Extensions0, []), + NewExtensions = replace_key_usage_extension(Extensions, []), + NewServerTbsCert = ServerTbsCert#'TBSCertificate'{extensions = NewExtensions}, + + ct:log("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + TbsDer = public_key:pkix_encode('TBSCertificate', NewServerTbsCert, plain), + Sig = public_key:sign(TbsDer, md5, Key), + NewServerCert = ServerCert#'Certificate'{tbsCertificate = NewServerTbsCert, signature = Sig}, + NewDerCert = public_key:pkix_encode('Certificate', NewServerCert, plain), + ssl_test_lib:der_to_pem(NewCertFile, [{'Certificate', NewDerCert, not_encrypted}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{active, true} | NewServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +replace_key_usage_extension([], Acc) -> + lists:reverse(Acc); +replace_key_usage_extension([#'Extension'{extnID = ?'id-ce-keyUsage'} = E | Rest], Acc) -> + %% A nonstandard DER encoding of [digitalSignature, keyEncipherment] + Val = <<3, 2, 0, 16#A0>>, + replace_key_usage_extension(Rest, [E#'Extension'{extnValue = Val} | Acc]); +replace_key_usage_extension([Head | Rest], Acc) -> + replace_key_usage_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + invalid_signature_server() -> [{doc,"Test client with invalid signature"}]. -- cgit v1.2.3 From 22ec76d8bc0e4dc0017791a7bd700b3d3565311a Mon Sep 17 00:00:00 2001 From: Mikael Pettersson Date: Tue, 9 Feb 2016 10:14:36 +0100 Subject: hipe_sigaltstack: correct initialization of ss.ss_flags SS_ONSTACK may be set in oss, but it's not supposed to be set in ss, and some systems correctly reject that; current Linux kernels accept but ignore it in ss --- erts/emulator/hipe/hipe_x86_signal.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 10a40ce901..0ecd13c4bc 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -251,7 +251,7 @@ static void hipe_sigaltstack(void *ss_sp) stack_t ss; ss.ss_sp = ss_sp; - ss.ss_flags = SS_ONSTACK; + ss.ss_flags = 0; ss.ss_size = SIGSTKSZ; if (sigaltstack(&ss, NULL) < 0) { perror("sigaltstack"); -- cgit v1.2.3 From 5f7a22aa3bfb026c285a0ffa51d03048c635fc5d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 9 Feb 2016 11:40:41 +0100 Subject: dialyzer: Correct byte_size() and comparisons The argument of byte_size() is a bitstring(). The code in erl_bif_types that finds cases where comparisons always return true or false is corrected when it comes to maps and bit strings. --- .../test/small_SUITE_data/results/comparisons | 228 +++++++++++++-------- .../test/small_SUITE_data/src/comparisons.erl | 56 +++++ lib/hipe/cerl/erl_bif_types.erl | 6 +- 3 files changed, 197 insertions(+), 93 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons index 642585d25e..5083d2695a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/comparisons +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -1,50 +1,43 @@ comparisons.erl:100: The pattern 'true' can never match the type 'false' -comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'false' can never match the type 'true' comparisons.erl:102: The pattern 'false' can never match the type 'true' -comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'true' can never match the type 'false' comparisons.erl:104: The pattern 'true' can never match the type 'false' -comparisons.erl:105: The pattern 'true' can never match the type 'false' -comparisons.erl:107: The pattern 'true' can never match the type 'false' -comparisons.erl:108: The pattern 'true' can never match the type 'false' -comparisons.erl:109: The pattern 'false' can never match the type 'true' -comparisons.erl:110: The pattern 'false' can never match the type 'true' -comparisons.erl:111: The pattern 'true' can never match the type 'false' -comparisons.erl:112: The pattern 'true' can never match the type 'false' -comparisons.erl:113: The pattern 'false' can never match the type 'true' -comparisons.erl:114: The pattern 'false' can never match the type 'true' -comparisons.erl:115: The pattern 'true' can never match the type 'false' -comparisons.erl:116: The pattern 'true' can never match the type 'false' -comparisons.erl:117: The pattern 'false' can never match the type 'true' comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:119: The pattern 'false' can never match the type 'true' +comparisons.erl:120: The pattern 'true' can never match the type 'false' +comparisons.erl:121: The pattern 'true' can never match the type 'false' +comparisons.erl:122: The pattern 'false' can never match the type 'true' comparisons.erl:123: The pattern 'false' can never match the type 'true' -comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'true' can never match the type 'false' comparisons.erl:125: The pattern 'true' can never match the type 'false' -comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'false' can never match the type 'true' comparisons.erl:127: The pattern 'false' can never match the type 'true' -comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'true' can never match the type 'false' comparisons.erl:129: The pattern 'true' can never match the type 'false' -comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'false' can never match the type 'true' +comparisons.erl:131: The pattern 'false' can never match the type 'true' comparisons.erl:132: The pattern 'true' can never match the type 'false' comparisons.erl:133: The pattern 'true' can never match the type 'false' comparisons.erl:134: The pattern 'false' can never match the type 'true' comparisons.erl:135: The pattern 'false' can never match the type 'true' comparisons.erl:136: The pattern 'true' can never match the type 'false' comparisons.erl:137: The pattern 'true' can never match the type 'false' -comparisons.erl:138: The pattern 'false' can never match the type 'true' -comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'true' can never match the type 'false' comparisons.erl:140: The pattern 'true' can never match the type 'false' -comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'false' can never match the type 'true' comparisons.erl:142: The pattern 'false' can never match the type 'true' -comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'true' can never match the type 'false' comparisons.erl:144: The pattern 'true' can never match the type 'false' -comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'false' can never match the type 'true' comparisons.erl:146: The pattern 'false' can never match the type 'true' -comparisons.erl:147: The pattern 'false' can never match the type 'true' -comparisons.erl:152: The pattern 'false' can never match the type 'true' -comparisons.erl:153: The pattern 'false' can never match the type 'true' -comparisons.erl:154: The pattern 'true' can never match the type 'false' -comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:147: The pattern 'true' can never match the type 'false' +comparisons.erl:148: The pattern 'true' can never match the type 'false' +comparisons.erl:149: The pattern 'false' can never match the type 'true' +comparisons.erl:150: The pattern 'false' can never match the type 'true' +comparisons.erl:155: The pattern 'false' can never match the type 'true' +comparisons.erl:156: The pattern 'false' can never match the type 'true' comparisons.erl:157: The pattern 'true' can never match the type 'false' comparisons.erl:158: The pattern 'true' can never match the type 'false' comparisons.erl:159: The pattern 'false' can never match the type 'true' @@ -59,36 +52,62 @@ comparisons.erl:167: The pattern 'false' can never match the type 'true' comparisons.erl:168: The pattern 'false' can never match the type 'true' comparisons.erl:169: The pattern 'true' can never match the type 'false' comparisons.erl:170: The pattern 'true' can never match the type 'false' -comparisons.erl:171: The pattern 'false' can never match the type 'true' -comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'true' can never match the type 'false' comparisons.erl:173: The pattern 'true' can never match the type 'false' -comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'false' can never match the type 'true' comparisons.erl:175: The pattern 'false' can never match the type 'true' -comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'true' can never match the type 'false' +comparisons.erl:177: The pattern 'true' can never match the type 'false' +comparisons.erl:178: The pattern 'false' can never match the type 'true' +comparisons.erl:179: The pattern 'false' can never match the type 'true' +comparisons.erl:180: The pattern 'true' can never match the type 'false' +comparisons.erl:181: The pattern 'true' can never match the type 'false' +comparisons.erl:182: The pattern 'false' can never match the type 'true' +comparisons.erl:183: The pattern 'false' can never match the type 'true' +comparisons.erl:184: The pattern 'true' can never match the type 'false' +comparisons.erl:185: The pattern 'true' can never match the type 'false' comparisons.erl:186: The pattern 'false' can never match the type 'true' comparisons.erl:187: The pattern 'false' can never match the type 'true' -comparisons.erl:188: The pattern 'true' can never match the type 'false' -comparisons.erl:189: The pattern 'true' can never match the type 'false' -comparisons.erl:190: The pattern 'false' can never match the type 'true' -comparisons.erl:191: The pattern 'false' can never match the type 'true' -comparisons.erl:192: The pattern 'true' can never match the type 'false' -comparisons.erl:193: The pattern 'true' can never match the type 'false' -comparisons.erl:203: The pattern 'false' can never match the type 'true' -comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'false' can never match the type 'true' +comparisons.erl:193: The pattern 'false' can never match the type 'true' +comparisons.erl:194: The pattern 'true' can never match the type 'false' +comparisons.erl:195: The pattern 'true' can never match the type 'false' +comparisons.erl:196: The pattern 'false' can never match the type 'true' +comparisons.erl:197: The pattern 'false' can never match the type 'true' +comparisons.erl:198: The pattern 'true' can never match the type 'false' +comparisons.erl:199: The pattern 'true' can never match the type 'false' +comparisons.erl:200: The pattern 'false' can never match the type 'true' +comparisons.erl:201: The pattern 'false' can never match the type 'true' +comparisons.erl:202: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'true' can never match the type 'false' comparisons.erl:205: The pattern 'true' can never match the type 'false' comparisons.erl:206: The pattern 'true' can never match the type 'false' -comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:207: The pattern 'false' can never match the type 'true' +comparisons.erl:208: The pattern 'false' can never match the type 'true' comparisons.erl:209: The pattern 'true' can never match the type 'false' -comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:210: The pattern 'true' can never match the type 'false' comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:212: The pattern 'false' can never match the type 'true' +comparisons.erl:213: The pattern 'true' can never match the type 'false' +comparisons.erl:214: The pattern 'true' can never match the type 'false' +comparisons.erl:215: The pattern 'false' can never match the type 'true' +comparisons.erl:216: The pattern 'false' can never match the type 'true' +comparisons.erl:217: The pattern 'true' can never match the type 'false' +comparisons.erl:218: The pattern 'true' can never match the type 'false' +comparisons.erl:219: The pattern 'false' can never match the type 'true' +comparisons.erl:220: The pattern 'false' can never match the type 'true' comparisons.erl:221: The pattern 'true' can never match the type 'false' comparisons.erl:222: The pattern 'true' can never match the type 'false' comparisons.erl:223: The pattern 'false' can never match the type 'true' comparisons.erl:224: The pattern 'false' can never match the type 'true' -comparisons.erl:225: The pattern 'true' can never match the type 'false' -comparisons.erl:226: The pattern 'true' can never match the type 'false' -comparisons.erl:227: The pattern 'false' can never match the type 'true' -comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:229: The pattern 'true' can never match the type 'false' +comparisons.erl:230: The pattern 'true' can never match the type 'false' +comparisons.erl:231: The pattern 'false' can never match the type 'true' +comparisons.erl:232: The pattern 'false' can never match the type 'true' +comparisons.erl:233: The pattern 'false' can never match the type 'true' +comparisons.erl:234: The pattern 'false' can never match the type 'true' +comparisons.erl:235: The pattern 'true' can never match the type 'false' +comparisons.erl:236: The pattern 'true' can never match the type 'false' comparisons.erl:242: The pattern 'false' can never match the type 'true' comparisons.erl:243: The pattern 'false' can never match the type 'true' comparisons.erl:244: The pattern 'true' can never match the type 'false' @@ -97,57 +116,86 @@ comparisons.erl:246: The pattern 'false' can never match the type 'true' comparisons.erl:247: The pattern 'false' can never match the type 'true' comparisons.erl:248: The pattern 'true' can never match the type 'false' comparisons.erl:249: The pattern 'true' can never match the type 'false' -comparisons.erl:251: The pattern 'true' can never match the type 'false' -comparisons.erl:252: The pattern 'true' can never match the type 'false' -comparisons.erl:253: The pattern 'false' can never match the type 'true' -comparisons.erl:254: The pattern 'false' can never match the type 'true' -comparisons.erl:263: The pattern 'false' can never match the type 'true' -comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:259: The pattern 'false' can never match the type 'true' +comparisons.erl:260: The pattern 'false' can never match the type 'true' +comparisons.erl:261: The pattern 'true' can never match the type 'false' +comparisons.erl:262: The pattern 'true' can never match the type 'false' +comparisons.erl:264: The pattern 'true' can never match the type 'false' comparisons.erl:265: The pattern 'true' can never match the type 'false' -comparisons.erl:266: The pattern 'true' can never match the type 'false' -comparisons.erl:268: The pattern 'true' can never match the type 'false' -comparisons.erl:269: The pattern 'true' can never match the type 'false' -comparisons.erl:270: The pattern 'false' can never match the type 'true' -comparisons.erl:271: The pattern 'false' can never match the type 'true' -comparisons.erl:272: The pattern 'true' can never match the type 'false' -comparisons.erl:273: The pattern 'true' can never match the type 'false' -comparisons.erl:274: The pattern 'false' can never match the type 'true' -comparisons.erl:275: The pattern 'false' can never match the type 'true' -comparisons.erl:293: The pattern 'false' can never match the type 'true' -comparisons.erl:294: The pattern 'false' can never match the type 'true' -comparisons.erl:295: The pattern 'true' can never match the type 'false' -comparisons.erl:296: The pattern 'true' can never match the type 'false' -comparisons.erl:311: The pattern 'true' can never match the type 'false' -comparisons.erl:312: The pattern 'true' can never match the type 'false' -comparisons.erl:313: The pattern 'false' can never match the type 'true' -comparisons.erl:314: The pattern 'false' can never match the type 'true' -comparisons.erl:44: The pattern 'false' can never match the type 'true' -comparisons.erl:45: The pattern 'false' can never match the type 'true' -comparisons.erl:46: The pattern 'true' can never match the type 'false' -comparisons.erl:47: The pattern 'true' can never match the type 'false' -comparisons.erl:48: The pattern 'false' can never match the type 'true' -comparisons.erl:49: The pattern 'false' can never match the type 'true' -comparisons.erl:50: The pattern 'true' can never match the type 'false' -comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'false' can never match the type 'true' +comparisons.erl:267: The pattern 'false' can never match the type 'true' +comparisons.erl:277: The pattern 'true' can never match the type 'false' +comparisons.erl:278: The pattern 'true' can never match the type 'false' +comparisons.erl:279: The pattern 'false' can never match the type 'true' +comparisons.erl:280: The pattern 'false' can never match the type 'true' +comparisons.erl:281: The pattern 'true' can never match the type 'false' +comparisons.erl:282: The pattern 'true' can never match the type 'false' +comparisons.erl:283: The pattern 'false' can never match the type 'true' +comparisons.erl:284: The pattern 'false' can never match the type 'true' +comparisons.erl:298: The pattern 'false' can never match the type 'true' +comparisons.erl:299: The pattern 'false' can never match the type 'true' +comparisons.erl:300: The pattern 'true' can never match the type 'false' +comparisons.erl:301: The pattern 'true' can never match the type 'false' +comparisons.erl:302: The pattern 'false' can never match the type 'true' +comparisons.erl:303: The pattern 'false' can never match the type 'true' +comparisons.erl:304: The pattern 'true' can never match the type 'false' +comparisons.erl:305: The pattern 'true' can never match the type 'false' +comparisons.erl:307: The pattern 'true' can never match the type 'false' +comparisons.erl:308: The pattern 'true' can never match the type 'false' +comparisons.erl:309: The pattern 'false' can never match the type 'true' +comparisons.erl:310: The pattern 'false' can never match the type 'true' +comparisons.erl:319: The pattern 'false' can never match the type 'true' +comparisons.erl:320: The pattern 'false' can never match the type 'true' +comparisons.erl:321: The pattern 'true' can never match the type 'false' +comparisons.erl:322: The pattern 'true' can never match the type 'false' +comparisons.erl:324: The pattern 'true' can never match the type 'false' +comparisons.erl:325: The pattern 'true' can never match the type 'false' +comparisons.erl:326: The pattern 'false' can never match the type 'true' +comparisons.erl:327: The pattern 'false' can never match the type 'true' +comparisons.erl:328: The pattern 'true' can never match the type 'false' +comparisons.erl:329: The pattern 'true' can never match the type 'false' +comparisons.erl:330: The pattern 'false' can never match the type 'true' +comparisons.erl:331: The pattern 'false' can never match the type 'true' +comparisons.erl:349: The pattern 'false' can never match the type 'true' +comparisons.erl:350: The pattern 'false' can never match the type 'true' +comparisons.erl:351: The pattern 'true' can never match the type 'false' +comparisons.erl:352: The pattern 'true' can never match the type 'false' +comparisons.erl:367: The pattern 'true' can never match the type 'false' +comparisons.erl:368: The pattern 'true' can never match the type 'false' +comparisons.erl:369: The pattern 'false' can never match the type 'true' +comparisons.erl:370: The pattern 'false' can never match the type 'true' comparisons.erl:52: The pattern 'false' can never match the type 'true' comparisons.erl:53: The pattern 'false' can never match the type 'true' comparisons.erl:54: The pattern 'true' can never match the type 'false' comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:56: The pattern 'false' can never match the type 'true' +comparisons.erl:57: The pattern 'false' can never match the type 'true' +comparisons.erl:58: The pattern 'true' can never match the type 'false' +comparisons.erl:59: The pattern 'true' can never match the type 'false' +comparisons.erl:60: The pattern 'false' can never match the type 'true' +comparisons.erl:61: The pattern 'false' can never match the type 'true' +comparisons.erl:62: The pattern 'true' can never match the type 'false' +comparisons.erl:63: The pattern 'true' can never match the type 'false' +comparisons.erl:64: The pattern 'false' can never match the type 'true' +comparisons.erl:65: The pattern 'false' can never match the type 'true' +comparisons.erl:66: The pattern 'true' can never match the type 'false' +comparisons.erl:67: The pattern 'true' can never match the type 'false' +comparisons.erl:68: The pattern 'false' can never match the type 'true' comparisons.erl:69: The pattern 'false' can never match the type 'true' -comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'true' can never match the type 'false' comparisons.erl:71: The pattern 'true' can never match the type 'false' -comparisons.erl:72: The pattern 'true' can never match the type 'false' -comparisons.erl:73: The pattern 'false' can never match the type 'true' -comparisons.erl:74: The pattern 'false' can never match the type 'true' -comparisons.erl:75: The pattern 'true' can never match the type 'false' -comparisons.erl:76: The pattern 'true' can never match the type 'false' -comparisons.erl:77: The pattern 'false' can never match the type 'true' -comparisons.erl:78: The pattern 'false' can never match the type 'true' -comparisons.erl:79: The pattern 'true' can never match the type 'false' -comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:85: The pattern 'false' can never match the type 'true' +comparisons.erl:86: The pattern 'false' can never match the type 'true' +comparisons.erl:87: The pattern 'true' can never match the type 'false' +comparisons.erl:88: The pattern 'true' can never match the type 'false' +comparisons.erl:89: The pattern 'false' can never match the type 'true' +comparisons.erl:90: The pattern 'false' can never match the type 'true' +comparisons.erl:91: The pattern 'true' can never match the type 'false' +comparisons.erl:92: The pattern 'true' can never match the type 'false' +comparisons.erl:93: The pattern 'false' can never match the type 'true' comparisons.erl:94: The pattern 'false' can never match the type 'true' -comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'true' can never match the type 'false' comparisons.erl:96: The pattern 'true' can never match the type 'false' -comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'false' can never match the type 'true' comparisons.erl:98: The pattern 'false' can never match the type 'true' -comparisons.erl:99: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'true' can never match the type 'false' diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl index 70e3cb6af4..64927c6c91 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -19,12 +19,20 @@ tuple(X) when is_tuple(X) -> X. list() -> list(?r). list(X) when is_list(X) -> X. +map() -> map(?r). +map(X) when is_map(X) -> #{}. + +bitstring() -> bitstring(?r). +bitstring(X) when is_bitstring(X) -> <<0:63>>. + i() -> integer(). f() -> mfloat(). n() -> case ?r of 1 -> i(); 2 -> f() end. a() -> atom(). t() -> tuple(). l() -> list(). +m() -> map(). +b() -> bitstring(). na() -> case ?r of 1 -> n(); 2 -> a() end. at() -> case ?r of 1 -> t(); 2 -> a() end. tl() -> case ?r of 1 -> t(); 2 -> l() end. @@ -53,6 +61,14 @@ test_i_ll_l() -> case i() < l() of true -> always; false -> never end. test_i_le_l() -> case i() =< l() of true -> always; false -> never end. test_i_gg_l() -> case i() > l() of true -> never; false -> always end. test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. +test_i_ll_m() -> case i() < m() of true -> always; false -> never end. +test_i_le_m() -> case i() =< m() of true -> always; false -> never end. +test_i_gg_m() -> case i() > m() of true -> never; false -> always end. +test_i_ge_m() -> case i() >= m() of true -> never; false -> always end. +test_i_ll_b() -> case i() < b() of true -> always; false -> never end. +test_i_le_b() -> case i() =< b() of true -> always; false -> never end. +test_i_gg_b() -> case i() > b() of true -> never; false -> always end. +test_i_ge_b() -> case i() >= b() of true -> never; false -> always end. test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. @@ -78,6 +94,14 @@ test_f_ll_l() -> case f() < l() of true -> always; false -> never end. test_f_le_l() -> case f() =< l() of true -> always; false -> never end. test_f_gg_l() -> case f() > l() of true -> never; false -> always end. test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. +test_f_ll_m() -> case f() < m() of true -> always; false -> never end. +test_f_le_m() -> case f() =< m() of true -> always; false -> never end. +test_f_gg_m() -> case f() > m() of true -> never; false -> always end. +test_f_ge_m() -> case f() >= m() of true -> never; false -> always end. +test_f_ll_b() -> case f() < b() of true -> always; false -> never end. +test_f_le_b() -> case f() =< b() of true -> always; false -> never end. +test_f_gg_b() -> case f() > b() of true -> never; false -> always end. +test_f_ge_b() -> case f() >= b() of true -> never; false -> always end. test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. @@ -103,6 +127,14 @@ test_n_ll_l() -> case n() < l() of true -> always; false -> never end. test_n_le_l() -> case n() =< l() of true -> always; false -> never end. test_n_gg_l() -> case n() > l() of true -> never; false -> always end. test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. +test_n_ll_m() -> case n() < m() of true -> always; false -> never end. +test_n_le_m() -> case n() =< m() of true -> always; false -> never end. +test_n_gg_m() -> case n() > m() of true -> never; false -> always end. +test_n_ge_m() -> case n() >= m() of true -> never; false -> always end. +test_n_ll_b() -> case n() < b() of true -> always; false -> never end. +test_n_le_b() -> case n() =< b() of true -> always; false -> never end. +test_n_gg_b() -> case n() > b() of true -> never; false -> always end. +test_n_ge_b() -> case n() >= b() of true -> never; false -> always end. test_a_ll_i() -> case a() < i() of true -> never; false -> always end. test_a_le_i() -> case a() =< i() of true -> never; false -> always end. @@ -128,6 +160,14 @@ test_a_ll_l() -> case a() < l() of true -> always; false -> never end. test_a_le_l() -> case a() =< l() of true -> always; false -> never end. test_a_gg_l() -> case a() > l() of true -> never; false -> always end. test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. +test_a_ll_m() -> case a() < m() of true -> always; false -> never end. +test_a_le_m() -> case a() =< m() of true -> always; false -> never end. +test_a_gg_m() -> case a() > m() of true -> never; false -> always end. +test_a_ge_m() -> case a() >= m() of true -> never; false -> always end. +test_a_ll_b() -> case a() < b() of true -> always; false -> never end. +test_a_le_b() -> case a() =< b() of true -> always; false -> never end. +test_a_gg_b() -> case a() > b() of true -> never; false -> always end. +test_a_ge_b() -> case a() >= b() of true -> never; false -> always end. test_t_ll_i() -> case t() < i() of true -> never; false -> always end. test_t_le_i() -> case t() =< i() of true -> never; false -> always end. @@ -153,6 +193,14 @@ test_t_ll_l() -> case t() < l() of true -> always; false -> never end. test_t_le_l() -> case t() =< l() of true -> always; false -> never end. test_t_gg_l() -> case t() > l() of true -> never; false -> always end. test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. +test_t_ll_m() -> case t() < m() of true -> always; false -> never end. +test_t_le_m() -> case t() =< m() of true -> always; false -> never end. +test_t_gg_m() -> case t() > m() of true -> never; false -> always end. +test_t_ge_m() -> case t() >= m() of true -> never; false -> always end. +test_t_ll_b() -> case t() < b() of true -> always; false -> never end. +test_t_le_b() -> case t() =< b() of true -> always; false -> never end. +test_t_gg_b() -> case t() > b() of true -> never; false -> always end. +test_t_ge_b() -> case t() >= b() of true -> never; false -> always end. test_l_ll_i() -> case l() < i() of true -> never; false -> always end. test_l_le_i() -> case l() =< i() of true -> never; false -> always end. @@ -178,6 +226,14 @@ test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. +test_l_ll_m() -> case l() < m() of true -> never; false -> always end. +test_l_le_m() -> case l() =< m() of true -> never; false -> always end. +test_l_gg_m() -> case l() > m() of true -> always; false -> never end. +test_l_ge_m() -> case l() >= m() of true -> always; false -> never end. +test_l_ll_b() -> case l() < b() of true -> always; false -> never end. +test_l_le_b() -> case l() =< b() of true -> always; false -> never end. +test_l_gg_b() -> case l() > b() of true -> never; false -> always end. +test_l_ge_b() -> case l() >= b() of true -> never; false -> always end. test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index c2fb79c089..9f23b6a9b3 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2200,7 +2200,7 @@ type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), - t_list(), t_binary()]. + t_map(), t_list(), t_bitstr()]. key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of @@ -2300,7 +2300,7 @@ arg_types(erlang, bit_size, 1) -> [t_bitstr()]; %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> - [t_binary()]; + [t_bitstr()]; arg_types(erlang, disconnect_node, 1) -> [t_node()]; arg_types(erlang, halt, 0) -> -- cgit v1.2.3 From c1f4d4a6d5c189f7cd4b3b073fb47f8dfb8d3fff Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 9 Feb 2016 15:11:30 +0100 Subject: mnesia: let loader check if tablelock is needed move_table_copy needs the lock that was set previously in del_table_copy. This doesn't work on old nodes, so bump protocol version and check it. Remove old protocol conversion code, which have been around since OTP-R15. Checking if lock is needed requires rpc communication via mnesia_gvar ets table to be backwards compatible. --- lib/mnesia/src/mnesia_controller.erl | 18 +++--- lib/mnesia/src/mnesia_loader.erl | 36 ++++++++---- lib/mnesia/src/mnesia_locker.erl | 20 ++++++- lib/mnesia/src/mnesia_monitor.erl | 8 +-- lib/mnesia/src/mnesia_schema.erl | 104 ++++++----------------------------- 5 files changed, 75 insertions(+), 111 deletions(-) diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 02c175760e..69ccc1d2c9 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -78,7 +78,7 @@ change_table_majority/1, del_active_replica/2, wait_for_tables/2, - get_network_copy/2, + get_network_copy/3, merge_schema/0, start_remote_sender/4, schedule_late_disc_load/2 @@ -329,14 +329,14 @@ release_schema_commit_lock() -> unlink(whereis(?SERVER_NAME)). %% Special for preparation of add table copy -get_network_copy(Tab, Cs) -> +get_network_copy(Tid, Tab, Cs) -> % We can't let the controller queue this one % because that may cause a deadlock between schema_operations % and initial tableloadings which both takes schema locks. % But we have to get copier_done msgs when the other side % goes down. call({add_other, self()}), - Reason = {dumper,add_table_copy}, + Reason = {dumper,{add_table_copy, Tid}}, Work = #net_load{table = Tab,reason = Reason,cstruct = Cs}, %% I'll need this cause it's linked trough the subscriber %% might be solved by using monitor in subscr instead. @@ -775,7 +775,7 @@ handle_call({net_load, Tab, Cs}, From, State) -> true -> Worker = #net_load{table = Tab, opt_reply_to = From, - reason = {dumper,add_table_copy}, + reason = {dumper,{add_table_copy, unknown}}, cstruct = Cs }, add_worker(Worker, State); @@ -1180,11 +1180,11 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> Done#loader_done.needs_announce == true, Done#loader_done.needs_reply == true -> i_have_tab(Tab), - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy, _}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_reply == true -> - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy,_}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_announce == true, Tab == schema -> @@ -2148,6 +2148,10 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl reply_to = ReplyTo, reply = {loaded, ok} }, + AddTableCopy = case Reason of + {dumper,{add_table_copy,_}} -> true; + _ -> false + end, if ReadNode == node() -> %% Already loaded locally @@ -2157,7 +2161,7 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl Res = mnesia_loader:disc_load_table(Tab, load_local_content), Done#loader_done{reply = Res, needs_announce = true, needs_sync = true} end; - AccessMode == read_only, Reason /= {dumper,add_table_copy} -> + AccessMode == read_only, not AddTableCopy -> fun() -> disc_load_table(Tab, Reason, ReplyTo) end; true -> fun() -> diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index da8549be50..41fcd76fcb 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -180,8 +180,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - -define(MAX_RAM_TRANSFERS, (?MAX_RAM_FILE_SIZE div ?MAX_TRANSFER_SIZE) + 1). -define(MAX_NOPACKETS, 20). -net_load_table(Tab, Reason, Ns, Cs) - when Reason == {dumper,add_table_copy} -> +net_load_table(Tab, {dumper,{add_table_copy, _}}=Reason, Ns, Cs) -> try_net_load_table(Tab, Reason, Ns, Cs); net_load_table(Tab, Reason, Ns, _Cs) -> try_net_load_table(Tab, Reason, Ns, val({Tab, cstruct})). @@ -233,7 +232,8 @@ do_snmpify(Tab, Us, Storage) -> set({Tab, {index, snmp}}, Snmp). %% Start the recieiver -init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> +init_receiver(Node, Tab, Storage, Cs, Reas={dumper,{add_table_copy, Tid}}) -> + rpc:call(Node, mnesia_lib, set, [{?MODULE, active_trans}, Tid]), case start_remote_sender(Node, Tab, Storage) of {SenderPid, TabSize, DetsData} -> start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,Reas); @@ -307,7 +307,7 @@ table_init_fun(SenderPid) -> end. %% Add_table_copy get's it's own locks. -start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> +start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,{add_table_copy,_}}) -> Init = table_init_fun(SenderPid), case do_init_table(Tab,Storage,Cs,SenderPid,TabSize,DetsData,self(), Init) of Err = {error, _} -> @@ -658,9 +658,10 @@ send_table(Pid, Tab, RemoteS) -> {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), SendIt = fun() -> - {atomic, ok} = prepare_copy(Pid, Tab, Storage), + NeedLock = need_lock(Tab), + {atomic, ok} = prepare_copy(Pid, Tab, Storage, NeedLock), send_more(Pid, 1, Chunk, Init(), Tab), - finish_copy(Pid, Tab, Storage, RemoteS) + finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) end, try SendIt() of @@ -678,10 +679,10 @@ send_table(Pid, Tab, RemoteS) -> end end. -prepare_copy(Pid, Tab, Storage) -> +prepare_copy(Pid, Tab, Storage, NeedLock) -> Trans = fun() -> - mnesia:lock_table(Tab, load), + NeedLock andalso mnesia:lock_table(Tab, load), mnesia_subscr:subscribe(Pid, {table, Tab}), update_where_to_write(Tab, node(Pid)), mnesia_lib:db_fixtable(Storage, Tab, true), @@ -689,6 +690,21 @@ prepare_copy(Pid, Tab, Storage) -> end, mnesia:transaction(Trans). + +need_lock(Tab) -> + case ?catch_val({?MODULE, active_trans}) of + #tid{} = Tid -> + %% move_table_copy grabs it's own table-lock + %% do not deadlock with it + mnesia_lib:unset({?MODULE, active_trans}), + case mnesia_locker:get_held_locks(Tab) of + [{write, Tid}|_] -> false; + _Locks -> true + end; + _ -> + true + end. + update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of read_only -> @@ -783,12 +799,12 @@ send_packet(N, Pid, Chunk, {Recs, Cont}) when N < ?MAX_NOPACKETS -> send_packet(_N, _Pid, _Chunk, DataState) -> DataState. -finish_copy(Pid, Tab, Storage, RemoteS) -> +finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) -> RecNode = node(Pid), DatBin = dat2bin(Tab, Storage, RemoteS), Trans = fun() -> - mnesia:read_lock_table(Tab), + NeedLock andalso mnesia:read_lock_table(Tab), A = val({Tab, access_mode}), mnesia_controller:sync_and_block_table_whereabouts(Tab, RecNode, RemoteS, A), cleanup_tab_copier(Pid, Storage, Tab), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 89feeba2c3..5766f22e92 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -22,7 +22,7 @@ -module(mnesia_locker). -export([ - get_held_locks/0, + get_held_locks/0, get_held_locks/1, get_lock_queue/0, global_lock/5, ixrlock/5, @@ -236,6 +236,11 @@ loop(State) -> From ! {Ref, ok}, loop(State); + {From, {is_locked, Oid}} -> + Held = ?ets_lookup(mnesia_held_locks, Oid), + reply(From, Held), + loop(State); + {'EXIT', Pid, _} when Pid == State#state.supervisor -> do_stop(); @@ -1151,6 +1156,19 @@ get_held_locks() -> Locks = receive {mnesia_held_locks, Ls} -> Ls after 5000 -> [] end, rewrite_locks(Locks, []). +%% Mnesia internal usage only +get_held_locks(Tab) when is_atom(Tab) -> + Oid = {Tab, ?ALL}, + ?MODULE ! {self(), {is_locked, Oid}}, + receive + {?MODULE, _Node, Locks} -> + case Locks of + [] -> []; + [{Oid, _Prev, What}] -> What + end + end. + + rewrite_locks([{Oid, _, Ls}|Locks], Acc0) -> Acc = rewrite_locks(Ls, Oid, Acc0), rewrite_locks(Locks, Acc); diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 8313c3bda5..081d746257 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -82,9 +82,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = [], remote_node_status = []}). --define(current_protocol_version, {8,1}). +-define(current_protocol_version, {8,2}). --define(previous_protocol_version, {8,0}). +-define(previous_protocol_version, {8,1}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -193,7 +193,7 @@ protocol_version() -> %% A sorted list of acceptable protocols the %% preferred protocols are first in the list acceptable_protocol_versions() -> - [protocol_version(), ?previous_protocol_version, {7,6}]. + [protocol_version(), ?previous_protocol_version]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -424,8 +424,6 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) case hd(Protocols) of ?previous_protocol_version -> accept_protocol(Mon, MyVersion, ?previous_protocol_version, From, State); - {7,6} -> - accept_protocol(Mon, MyVersion, {7,6}, From, State); _ -> verbose("Connection with ~p rejected. " "version = ~p, protocols = ~p, " diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 2acddccf6e..1bd8703e1d 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -646,54 +646,18 @@ cs2list(Cs) when is_record(Cs, cstruct) -> rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> CreateList; -%% 4.6 + +%% since 4.6 cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> Tags = [name,type,ram_copies,disc_copies,disc_only_copies, load_order,access_mode,majority,index,snmp,local_content, record_name,attributes, user_properties,frag_properties,storage_properties, cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.19 -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.18 and earlier -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], rec2list(Tags, Tags, 2, Cs). cs2list(false, Cs) -> - cs2list(Cs); -cs2list(ver4_4_18, Cs) -> %% Or earlier - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_4_19, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_6, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes, - user_properties,frag_properties,storage_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs). - + cs2list(Cs). rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), @@ -703,19 +667,8 @@ rec2list([], _, _Pos, _Rec) -> rec2list(Tags, [_|Orig], Pos, Rec) -> rec2list(Tags, Orig, Pos+1, Rec). -normalize_cs(Cstructs, Node) -> - %% backward-compatibility hack; normalize before returning - case need_old_cstructs([Node]) of - false -> - Cstructs; - Version -> - %% some other format - [convert_cs(Version, Cs) || Cs <- Cstructs] - end. - -convert_cs(Version, Cs) -> - Fields = [Value || {_, Value} <- cs2list(Version, Cs)], - list_to_tuple([cstruct|Fields]). +normalize_cs(Cstructs, _Node) -> + Cstructs. list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -1357,7 +1310,11 @@ do_move_table(schema, _FromNode, _ToNode) -> mnesia:abort({bad_type, schema}); do_move_table(Tab, FromNode, ToNode) when is_atom(FromNode), is_atom(ToNode) -> TidTs = get_tid_ts_and_lock(schema, write), - %% get_tid_ts_and_lock(Tab, write), write locked by load_table in mnesia_loader + AnyOld = lists:any(fun(Node) -> mnesia_monitor:needs_protocol_conversion(Node) end, + [ToNode|val({Tab, where_to_write})]), + if AnyOld -> ignore; %% Leads to deadlock on old nodes + true -> get_tid_ts_and_lock(Tab, write) + end, insert_schema_ops(TidTs, make_move_table(Tab, FromNode, ToNode)); do_move_table(Tab, FromNode, ToNode) -> mnesia:abort({badarg, Tab, FromNode, ToNode}). @@ -1965,7 +1922,7 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> end, %% Tables are created by mnesia_loader get_network code insert_cstruct(Tid, Cs, true), - case mnesia_controller:get_network_copy(Tab, Cs) of + case mnesia_controller:get_network_copy(Tid, Tab, Cs) of {loaded, ok} -> {true, optional}; {not_loaded, ErrReason} -> @@ -2373,7 +2330,7 @@ undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) -> case mnesia_lib:val({Tab, where_to_read}) of nowhere -> mnesia_lib:set_remote_where_to_read(Tab); - true -> + _ -> ignore end end; @@ -2837,40 +2794,11 @@ do_merge_schema(LockTabs0) -> end. fetch_cstructs(Node) -> - case need_old_cstructs([Node]) of - false -> - rpc:call(Node, mnesia_controller, get_remote_cstructs, []); - _Ver -> - case rpc:call(Node, mnesia_controller, get_cstructs, []) of - {cstructs, Cs0, RR} -> - {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; - Err -> Err - end - end. + rpc:call(Node, mnesia_controller, get_remote_cstructs, []). -need_old_cstructs() -> - need_old_cstructs(val({schema, where_to_write})). - -need_old_cstructs(Nodes) -> - Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, - case lists:dropwhile(Filter, Nodes) of - [] -> false; - [Node|_] -> - case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of - #cstruct{} -> - %% mnesia_lib:warning("Mnesia on ~p do not need to convert cstruct (~p)~n", - %% [node(), Node]), - false; - {badrpc, _} -> - need_old_cstructs(lists:delete(Node,Nodes)); - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - ver4_4_18; % Without majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - ver4_4_19; % With majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> - ver4_6 % With storage_properties - end - end. +need_old_cstructs() -> false. + +need_old_cstructs(_Nodes) -> false. tab_to_nodes(Tab) when is_atom(Tab) -> Cs = val({Tab, cstruct}), -- cgit v1.2.3 From e64741414cc1527797b01ebab1ba64123537991e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Wed, 10 Feb 2016 16:02:33 +0100 Subject: tools: Remove dead code in lcnt --- lib/tools/src/lcnt.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index e8b3d242e4..3a3cebf3ed 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -933,7 +933,6 @@ strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); -strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). -- cgit v1.2.3 From 63179541b74f0a08929c9dbacb8e1a7a690a1a9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 11 Feb 2016 12:50:31 +0100 Subject: erl_prim_loader_SUITE: Refactor helper functions Eliminate duplicated code by factoring out the common code for starting erl_boot_server and a slave node. Also, in the new start_boot_server/0 helper, fix a problem with Linux systems that assign 127.0.1.1 as the IP address for the hostname. Also stop using the -setcookie option when starting a node using -loader inet. The inet loading method doesn't use the distribution anymore. --- lib/kernel/test/erl_prim_loader_SUITE.erl | 111 ++++++++++++++---------------- 1 file changed, 51 insertions(+), 60 deletions(-) diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index e9ff79af19..72b00e22da 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -133,14 +133,8 @@ inet_existing(doc) -> ["Start a node using the 'inet' loading method, ", "from an already started boot server."]; inet_existing(Config) when is_list(Config) -> Name = erl_prim_test_inet_existing, - Host = host(), - Cookie = atom_to_list(erlang:get_cookie()), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, BootPid} = erl_boot_server:start_link([Host]), - {ok, Node} = start_node(Name, Args), + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), stop_node(Node), unlink(BootPid), @@ -151,19 +145,11 @@ inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ", "but start the boot server afterwards."]; inet_coming_up(Config) when is_list(Config) -> Name = erl_prim_test_inet_coming_up, - Cookie = atom_to_list(erlang:get_cookie()), - Host = host(), - IpStr = ip_str(Host), - LFlag = get_loader_flag(os:type()), - Args = LFlag ++ - " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% Wait a while, then start boot server, and wait for node to start. test_server:sleep(test_server:seconds(6)), - io:format("erl_boot_server:start_link([~p]).", [Host]), - {ok, BootPid} = erl_boot_server:start_link([Host]), + BootPid = start_boot_server(), wait_really_started(Node, 25), %% Check loader argument, then cleanup. @@ -191,24 +177,19 @@ inet_disconnects(Config) when is_list(Config) -> true -> {skip,"erl_boot_server is native"}; false -> - ?line Name = erl_prim_test_inet_disconnects, - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, + Name = erl_prim_test_inet_disconnects, - ?line {ok, BootPid} = erl_boot_server:start([Host]), + BootPid = start_boot_server(), + unlink(BootPid), Self = self(), %% This process shuts down the boot server during loading. - ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), - ?line receive - {Stopper,ready} -> ok - end, + Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), + receive + {Stopper,ready} -> ok + end, %% Let the loading begin... - ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), + Node = start_node_using_inet(Name, [{wait,false}]), %% When the stopper is ready, the slave node should be %% looking for a boot server again. @@ -222,12 +203,12 @@ inet_disconnects(Config) when is_list(Config) -> end, %% Start new boot server to see that loading is continued. - ?line {ok, BootPid2} = erl_boot_server:start_link([Host]), - ?line wait_really_started(Node, 25), - ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), - ?line stop_node(Node), - ?line unlink(BootPid2), - ?line exit(BootPid2, kill), + BootPid2 = start_boot_server(), + wait_really_started(Node, 25), + {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + stop_node(Node), + unlink(BootPid2), + exit(BootPid2, kill), ok end. @@ -262,11 +243,8 @@ multiple_slaves(doc) -> multiple_slaves(Config) when is_list(Config) -> ?line Name = erl_prim_test_multiple_slaves, ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, + Args = " -loader inet -hosts " ++ IpStr, NoOfNodes = 10, % no of slave nodes to be started @@ -286,7 +264,7 @@ multiple_slaves(Config) when is_list(Config) -> %% long for this test to work). ?line test_server:sleep(test_server:seconds(5)), %% start the code loading circus! - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + BootPid = start_boot_server(), %% give the nodes a chance to boot up before attempting to stop them ?line test_server:sleep(test_server:seconds(10)), @@ -362,20 +340,6 @@ file_requests(Config) when is_list(Config) -> ?line exit(BootPid, kill), ok. -complete_start_node(Name) -> - ?line Host = host(), - ?line Cookie = atom_to_list(erlang:get_cookie()), - ?line IpStr = ip_str(Host), - ?line LFlag = get_loader_flag(os:type()), - ?line Args = LFlag ++ " -hosts " ++ IpStr ++ - " -setcookie " ++ Cookie, - - ?line {ok,BootPid} = erl_boot_server:start_link([Host]), - - ?line {ok,Node} = start_node(Name, Args), - ?line wait_really_started(Node, 25), - {ok, Node, BootPid}. - local_archive(suite) -> []; local_archive(doc) -> @@ -554,7 +518,37 @@ virtual_dir_in_archive(Config) when is_list(Config) -> ?line ok = file:delete(Archive), ok. -%% Misc. functions +%%% +%%% Helper functions. +%%% + +complete_start_node(Name) -> + BootPid = start_boot_server(), + Node = start_node_using_inet(Name), + wait_really_started(Node, 25), + {ok, Node, BootPid}. + +start_boot_server() -> + %% Many linux systems define: + %% 127.0.0.1 localhost + %% 127.0.1.1 somehostname + %% Therefore, to allow the tests to work on those kind of systems, + %% also include "localhost" in the list of allowed hosts. + + Hosts = [host(),ip_str("localhost")], + {ok,BootPid} = erl_boot_server:start_link(Hosts), + BootPid. + +start_node_using_inet(Name) -> + start_node_using_inet(Name, []). + +start_node_using_inet(Name, Opts) -> + Host = host(), + IpStr = ip_str(Host), + Args = " -loader inet -hosts " ++ IpStr, + {ok,Node} = start_node(Name, Args, Opts), + Node. + ip_str({A, B, C, D}) -> lists:concat([A, ".", B, ".", C, ".", D]); @@ -580,9 +574,6 @@ host() -> stop_node(Node) -> test_server:stop_node(Node). -get_loader_flag(_) -> - " -loader inet ". - compile_app(TopDir, AppName) -> AppDir = filename:join([TopDir, AppName]), SrcDir = filename:join([AppDir, "src"]), -- cgit v1.2.3 From 52fec5fe09e24a99d439e31c1989482f393f4832 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 12 Feb 2016 15:00:05 +0100 Subject: asn1: Suppress warnings for improper lists in generated code --- lib/asn1/src/asn1ct_gen.erl | 1 + lib/asn1/test/asn1_test_lib.erl | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 093bcb5a6c..6d5062a118 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1289,6 +1289,7 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), + emit({"-dialyzer(no_improper_lists).",nl}), case Hrl of 0 -> ok; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 4fee5a64cc..ae2e5641ec 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -58,7 +58,7 @@ dialyze(Files) -> Beams0 = [code:which(module(F)) || F <- Files], Beams = [code:which(asn1rt_nif)|Beams0], case dialyzer:run([{files,Beams}, - {warnings,[no_improper_lists]}, + {warnings,[]}, {get_warnings,true}]) of [] -> ok; -- cgit v1.2.3 From 4ce31a8f72726018b1293986b0f627ca2e6bb7fb Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 12 Feb 2016 16:51:30 +0100 Subject: erts: Fix wobbling test failure in nif_SUITE ResA may have been GC'd after its last use. --- erts/emulator/test/nif_SUITE.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 3d478654b1..e10460ce78 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -617,7 +617,6 @@ resource_new_do2(Type) -> ?line {PtrA,BinA} = get_resource(Type, ResA), ?line {PtrB,BinB} = get_resource(Type, ResB), ?line true = (PtrA =/= PtrB), - ?line [] = last_resource_dtor_call(), %% forget ResA and make it garbage {{PtrA,BinA}, {ResB,PtrB,BinB}}. -- cgit v1.2.3 From a7f48d4972be0c7984d5cb0e08e73260c0fdbe1b Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 27 Jan 2016 14:45:32 +0100 Subject: Ensure that work is done on the correct type of schedulers Only the actual call to the dirty nif is allowed to execute on dirty schedulers. The dirty nif is not allowed to execute on normal schedulers if dirty schedulers are available. Arrival of exit signals and system tasks, while a process was scheduled for execution on a dirty scheduler, could mess up the process internal state. Preparation for dirty system task has been made, but is currently unused. --- erts/emulator/beam/erl_nif.c | 15 +- erts/emulator/beam/erl_process.c | 650 +++++++++++++++++++++------------- erts/emulator/beam/erl_process.h | 48 ++- erts/emulator/beam/erl_process_dump.c | 10 +- 4 files changed, 458 insertions(+), 265 deletions(-) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index d7a2076d85..962cb4858f 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1772,12 +1772,10 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); ep->fp = NULL; + erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); result = (*fp)(env, argc, argv); - 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 (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) close_lib(env->mod_nif); /* @@ -1825,13 +1823,6 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[ 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 (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d583118e7b..1765315ed3 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2969,7 +2969,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, thr_prgr_active); while (1) { - ErtsMonotonicTime current_time; + ErtsMonotonicTime current_time = 0; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { @@ -3635,6 +3635,13 @@ check_requeue_process(ErtsRunQueue *rq, int prio_q) return 0; } +static ERTS_INLINE void +free_proxy_proc(Process *proxy) +{ + ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); + erts_free(ERTS_ALC_T_PROC, proxy); +} + #ifdef ERTS_SMP static ErtsRunQueue * @@ -3949,9 +3956,6 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_aint32_t state; Process *proc; int notify = 0; -#ifdef ERTS_DIRTY_SCHEDULERS - int requeue; -#endif to_rq = NULL; #ifdef ERTS_DIRTY_SCHEDULERS @@ -3966,49 +3970,94 @@ evacuate_run_queue(ErtsRunQueue *rq, proc = dequeue_process(rq, prio_q, &state); while (proc) { -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 1; + Process *real_proc; + int prio; + erts_aint32_t max_qbit, qbit, real_state; + + prio = ERTS_PSFLGS_GET_PRQ_PRIO(state); + qbit = ((erts_aint32_t) 1) << prio; + + if (!(state & ERTS_PSFLG_PROXY)) { + real_proc = proc; + real_state = state; + } + else { + real_proc = erts_proc_lookup_raw(proc->common.id); + if (!real_proc) { + free_proxy_proc(proc); + goto handle_next_proc; + } + real_state = erts_smp_atomic32_read_acqb(&real_proc->state); + } + + max_qbit = (state >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET); + max_qbit &= ERTS_PSFLGS_QMASK; + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit > max_qbit) { + /* Process already queued with higher prio; drop it... */ + if (real_proc != proc) + free_proxy_proc(proc); + else { + erts_aint32_t clr_bits; +#ifdef DEBUG + erts_aint32_t old; #endif - if (ERTS_PSFLG_BOUND & state) { - /* Bound processes get stuck here... */ - proc->next = NULL; - if (sbpp->last) - sbpp->last->next = proc; - else - sbpp->first = proc; - sbpp->last = proc; -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 0; + + clr_bits = ERTS_PSFLG_IN_RUNQ; + clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET; + +#ifdef DEBUG + old = +#else + (void) #endif + erts_smp_atomic32_read_band_mb(&proc->state, + ~clr_bits); + ASSERT((old & clr_bits) == clr_bits); + + } + + goto handle_next_proc; } + #ifdef ERTS_DIRTY_SCHEDULERS - else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { + + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { + erts_aint32_t dqbit = qbit; #ifdef DEBUG - erts_aint32_t old = -#else - (void) + erts_aint32_t old_dqbit; #endif - 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) { + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + #ifdef DEBUG - erts_aint32_t old = + old_dqbit = (int) #else - (void) + (void) #endif - 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))); + erts_smp_atomic32_read_band_mb(&real_proc->dirty_state, + ~dqbit); + ASSERT(old_dqbit & dqbit); } - if (requeue) { -#else - else { #endif + + if (ERTS_PSFLG_BOUND & real_state) { + /* Bound processes get stuck here... */ + proc->next = NULL; + if (sbpp->last) + sbpp->last->next = proc; + else + sbpp->first = proc; + sbpp->last = proc; + } + else { int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); @@ -4031,6 +4080,8 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_smp_runq_lock(rq); } + + handle_next_proc: proc = dequeue_process(rq, prio_q, &state); } if (notify) @@ -5974,19 +6025,96 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio) return proxy; } -static ERTS_INLINE void -free_proxy_proc(Process *proxy) -{ - ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_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 + +#ifdef ERTS_DIRTY_SCHEDULERS + +static int +check_dirty_enqueue_in_prio_queue(Process *c_p, + erts_aint32_t *newp, + erts_aint32_t actual, + erts_aint32_t aprio, + erts_aint32_t qbit) +{ + int queue; + erts_aint32_t dact, max_qbit; + + /* Termination should be done on an ordinary scheduler */ + if (actual & ERTS_PSFLG_EXITING) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NORMAL_QUEUE; + } + + /* + * If we have system tasks, we enqueue on ordinary run-queue + * and take care of those system tasks first. + */ + if (actual & ERTS_PSFLG_ACTIVE_SYS) + return ERTS_ENQUEUE_NORMAL_QUEUE; + + dact = erts_smp_atomic32_read_mb(&c_p->dirty_state); + if (actual & (ERTS_PSFLG_DIRTY_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_CPU_PROC)) { + max_qbit = ((dact >> ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_CPU_QUEUE; + } + else { + ASSERT(actual & ERTS_PSFLG_DIRTY_IO_PROC); + max_qbit = ((dact >> ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_IO_QUEUE; + } + + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit >= max_qbit) + return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */ + 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*queue; + } + + *newp |= ERTS_PSFLG_IN_RUNQ; + return queue; +} + +static ERTS_INLINE int +fin_dirty_enq_s_change(Process *p, + int pstruct_reserved, + erts_aint32_t enq_prio, + int qmask_offset) +{ + erts_aint32_t qbit = 1 << enq_prio; + qbit <<= qmask_offset; + + if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) { + /* Already enqueue by someone else... */ + if (pstruct_reserved) { + /* We reserved process struct for enqueue; clear it... */ +#ifdef DEBUG + erts_aint32_t old = +#else + (void) #endif + erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ); + ASSERT(old & ERTS_PSFLG_IN_RUNQ); + } + return 0; + } + + return !0; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ static ERTS_INLINE int check_enqueue_in_prio_queue(Process *c_p, @@ -6002,61 +6130,14 @@ check_enqueue_in_prio_queue(Process *c_p, *prq_prio_p = aprio; #ifdef ERTS_DIRTY_SCHEDULERS - 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; + if (actual & ERTS_PSFLGS_DIRTY_WORK) { + int res = check_dirty_enqueue_in_prio_queue(c_p, newp, actual, + aprio, qbit); + if (res != ERTS_ENQUEUE_NORMAL_QUEUE) + return res; } - - 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; @@ -6088,6 +6169,65 @@ check_enqueue_in_prio_queue(Process *c_p, return ERTS_ENQUEUE_NORMAL_QUEUE; } +static ERTS_INLINE ErtsRunQueue * +select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t state) +{ + + switch (enqueue) { + + case ERTS_ENQUEUE_NOT: + + return NULL; + +#ifdef ERTS_DIRTY_SCHEDULERS + + case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_CPU_RUNQ; + + return NULL; + + + case ERTS_ENQUEUE_DIRTY_IO_QUEUE: + case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_IO_RUNQ; + + return NULL; + +#endif + + default: { + ErtsRunQueue* runq; + + ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE + || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + + runq = erts_get_runq_proc(p); + +#ifdef ERTS_SMP + if (!(ERTS_PSFLG_BOUND & state)) { + ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); + if (new_runq) { + RUNQ_SET_RQ(&p->run_queue, new_runq); + runq = new_runq; + } + } +#endif + + ASSERT(runq); + + return runq; + } + } +} + + /* * schedule_out_process() return with c_rq locked. */ @@ -6096,11 +6236,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces { erts_aint32_t a, e, n, enq_prio = -1; int enqueue; /* < 0 -> use proxy */ - Process* sched_p; ErtsRunQueue* runq; -#ifdef ERTS_SMP - int check_emigration_need; -#endif a = state; @@ -6112,7 +6248,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces enqueue = ERTS_ENQUEUE_NOT; n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS); - if (a & ERTS_PSFLG_ACTIVE_SYS + if (a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS) || (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) { enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); } @@ -6121,16 +6257,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces break; } - switch (enqueue) { - case ERTS_ENQUEUE_NOT: + runq = select_enqueue_run_queue(enqueue, enq_prio, p, n); + + if (!runq) { + if (erts_system_profile_flags.runnable_procs) { /* Status lock prevents out of order "runnable proc" trace msgs */ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); - if (!(a & ERTS_PSFLG_ACTIVE_SYS) - && (!(a & ERTS_PSFLG_ACTIVE) - || (a & ERTS_PSFLG_SUSPENDED))) { + if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) { /* Process inactive */ profile_runnable_proc(p, am_inactive); } @@ -6143,98 +6280,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces return 0; -#ifdef ERTS_DIRTY_SCHEDULERS -#ifdef ERTS_SMP - 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; + } + else { + Process* sched_p; - 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 + ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); - default: - ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE - || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + if (enqueue < 0) + sched_p = make_proxy_proc(proxy, p, enq_prio); + else { + sched_p = p; + if (proxy) + free_proxy_proc(proxy); + } - runq = erts_get_runq_proc(p); -#ifdef ERTS_SMP - check_emigration_need = !(ERTS_PSFLG_BOUND & n); -#endif - break; - } + ASSERT(runq); - ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS)); + erts_smp_runq_lock(runq); - if (enqueue < 0) - sched_p = make_proxy_proc(proxy, p, enq_prio); - else { - sched_p = p; - if (proxy) - free_proxy_proc(proxy); - } + /* Enqueue the process */ + enqueue_process(runq, (int) enq_prio, sched_p); -#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 + if (runq == c_rq) + return 1; - ASSERT(runq); + erts_smp_runq_unlock(runq); - erts_smp_runq_lock(runq); + smp_notify_inc_runq(runq); - /* Enqueue the process */ - enqueue_process(runq, (int) enq_prio, sched_p); + erts_smp_runq_lock(c_rq); - if (runq == c_rq) return 1; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); - erts_smp_runq_lock(c_rq); - return 1; + } + } static ERTS_INLINE void -add2runq(Process *p, erts_aint32_t state, erts_aint32_t prio) +add2runq(int enqueue, erts_aint32_t prio, + Process *proc, erts_aint32_t state, + Process **proxy) { - ErtsRunQueue *runq = erts_get_runq_proc(p); + ErtsRunQueue *runq; -#ifdef ERTS_SMP - if (!(ERTS_PSFLG_BOUND & state)) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, (int) prio); - if (new_runq) { - RUNQ_SET_RQ(&p->run_queue, new_runq); - runq = new_runq; - } - } -#endif - ASSERT(runq); + runq = select_enqueue_run_queue(enqueue, prio, proc, state); - erts_smp_runq_lock(runq); + if (runq) { + Process *sched_p; - /* Enqueue the process */ - enqueue_process(runq, (int) prio, p); + if (enqueue > 0) + sched_p = proc; + else { + Process *pxy; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); + if (!proxy) + pxy = NULL; + else { + pxy = *proxy; + *proxy = NULL; + } + sched_p = make_proxy_proc(pxy, proc, prio); + } + + erts_smp_runq_lock(runq); + + /* Enqueue the process */ + enqueue_process(runq, (int) prio, sched_p); + erts_smp_runq_unlock(runq); + smp_notify_inc_runq(runq); + } } static ERTS_INLINE int @@ -6340,10 +6455,7 @@ schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue != ERTS_ENQUEUE_NOT) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } void @@ -6403,16 +6515,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) prof_runnable_procs = 0; } - if (enqueue != ERTS_ENQUEUE_NOT) { - Process *sched_p; - if (enqueue > 0) - sched_p = p; - else { - sched_p = make_proxy_proc(proxy, p, enq_prio); - proxy = NULL; - } - add2runq(sched_p, n, enq_prio); - } + add2runq(enqueue, enq_prio, p, n, &proxy); cleanup: @@ -6508,10 +6611,7 @@ resume_process(Process *p, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } int @@ -9361,15 +9461,16 @@ Process *schedule(Process *p, int calls) #ifdef ERTS_SMP ErtsMigrationPaths *mps; ErtsMigrationPath *mp; - ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; - if (erts_proclist_fetch(&pnd_xtrs, NULL)) { + + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; + if (erts_proclist_fetch(&pnd_xtrs, NULL)) { rq->procs.pending_exiters = NULL; erts_smp_runq_unlock(rq); handle_pending_exiters(pnd_xtrs); erts_smp_runq_lock(rq); } - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { if (rq->check_balance_reds <= 0) check_balance(rq); @@ -9564,11 +9665,12 @@ Process *schedule(Process *p, int calls) pick_next_process: { erts_aint32_t psflg_band_mask; int prio_q; - int qmask; + int qmask, qbit; flags = ERTS_RUNQ_FLGS_GET_NOB(rq); qmask = (int) (flags & ERTS_RUNQ_FLGS_PROCS_QMASK); - switch (qmask & -qmask) { + qbit = qmask & -qmask; + switch (qbit) { case MAX_BIT: prio_q = PRIORITY_MAX; break; @@ -9596,20 +9698,11 @@ Process *schedule(Process *p, int calls) ASSERT(p); /* Wrong qmask in rq->flags? */ - psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) - + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); - -#ifdef ERTS_DIRTY_SCHEDULERS - 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 (ERTS_SCHEDULER_IS_DIRTY(esdp)) + psflg_band_mask = ~((erts_aint32_t) 0); + else + psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) + + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; @@ -9632,9 +9725,11 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_RUNNING_SYS))) { tmp = state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS); + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS); if (tmp != ERTS_PSFLG_SUSPENDED) { - if (state & ERTS_PSFLG_ACTIVE_SYS) + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) new |= ERTS_PSFLG_RUNNING_SYS; else new |= ERTS_PSFLG_RUNNING; @@ -9647,7 +9742,8 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_FREE)) || ((state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS)) + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) == ERTS_PSFLG_SUSPENDED)) { if (state & ERTS_PSFLG_FREE) erts_proc_dec_refc(p); @@ -9666,10 +9762,42 @@ Process *schedule(Process *p, int calls) esdp->current_process = p; + + reds = context_reds; + +#ifdef ERTS_SMP + + erts_smp_runq_unlock(rq); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { +#ifdef DEBUG + int old_dqbit; +#endif + int dqbit = qbit; + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + +#ifdef DEBUG + old_dqbit = (int) +#else + (void) +#endif + erts_smp_atomic32_read_band_mb(&p->dirty_state, ~dqbit); + ASSERT(old_dqbit & dqbit); + } +#endif /* ERTS_DIRTY_SCHEDULERS */ + +#endif /* ERTS_SMP */ + } #ifdef ERTS_SMP - erts_smp_runq_unlock(rq); if (flags & ERTS_RUNQ_FLG_PROTECTED) (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); @@ -9702,15 +9830,56 @@ Process *schedule(Process *p, int calls) erts_smp_spin_unlock(&erts_sched_stat.lock); } - if (ERTS_PROC_PENDING_EXIT(p)) { + ASSERT(!p->scheduler_data); + p->scheduler_data = esdp; + + state = erts_smp_atomic32_read_nob(&p->state); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!!(state & ERTS_PSFLGS_DIRTY_WORK) + & !(state & ERTS_PSFLG_ACTIVE_SYS)) { + /* Migrate to dirty scheduler... */ + sunlock_sched_out_proc: + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + p->fcalls = reds; + goto sched_out_proc; + + } + } + else { + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLG_EXITING)) { + /* Migrate to normal scheduler... */ + goto sunlock_sched_out_proc; + } + if ((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + && rq == ERTS_DIRTY_IO_RUNQ) { + /* Migrate to dirty cpu scheduler... */ + goto sunlock_sched_out_proc; + } + + ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + || *p->i == (BeamInstr) em_call_nif); + + ASSERT(rq == ERTS_DIRTY_CPU_RUNQ + ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + : (rq == ERTS_DIRTY_IO_RUNQ + && (state & ERTS_PSFLG_DIRTY_IO_PROC))); + } +#endif + + if (state & ERTS_PSFLG_PENDING_EXIT) { erts_handle_pending_exit(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); state = erts_smp_atomic32_read_nob(&p->state); } - ASSERT(!p->scheduler_data); - p->scheduler_data = esdp; -#endif - reds = context_reds; + +#endif /* ERTS_SMP */ + + p->fcalls = reds; if (IS_TRACED(p)) { if (state & ERTS_PSFLG_EXITING) { @@ -9739,7 +9908,8 @@ Process *schedule(Process *p, int calls) reds -= execute_sys_tasks(p, &state, reds); if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS - || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) + || ERTS_SCHEDULER_IS_DIRTY(esdp) + || (state & ERTS_PSFLGS_DIRTY_WORK) #endif ) { p->fcalls = reds; @@ -9787,7 +9957,6 @@ Process *schedule(Process *p, int calls) proxy_p = NULL; } - p->fcalls = reds; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* Never run a suspended process */ @@ -10732,6 +10901,9 @@ static void early_init_process_struct(void *varg, Eterm data) Process *proc = arg->proc; proc->common.id = make_internal_pid(data); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&proc->dirty_state, 0); +#endif erts_smp_atomic32_init_relb(&proc->state, arg->state); #ifdef ERTS_SMP @@ -11194,6 +11366,9 @@ void erts_init_empty_process(Process *p) p->last_old_htop = NULL; #endif +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&p->dirty_state, 0); +#endif erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); #ifdef ERTS_SMP @@ -11395,7 +11570,9 @@ set_proc_exiting(Process *p, ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL); enqueue = change_proc_schedule_state(p, - ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, + (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLGS_DIRTY_WORK), ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, &enq_prio, @@ -11429,10 +11606,7 @@ set_proc_exiting(Process *p, } #endif - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } static ERTS_INLINE erts_aint32_t @@ -11535,6 +11709,11 @@ save_pending_exiter(Process *p) else rq = esdp->run_queue; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) + rq = ERTS_RUNQ_IX(0); /* Handle on ordinary scheduler */ +#endif + plp = proclist_create(p); erts_smp_runq_lock(rq); @@ -11544,13 +11723,8 @@ save_pending_exiter(Process *p) non_empty_runq(rq); erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - wake_dirty_schedulers(rq, 0); - else -#endif - wake_scheduler(rq); + wake_scheduler(rq); } #endif diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 10c6fa4a67..32e458aa1d 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1033,6 +1033,9 @@ struct process { ErtsProcSysTaskQs *sys_task_qs; erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */ +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */ +#endif #ifdef ERTS_SMP ErlMessageInQueue msg_inq; @@ -1150,15 +1153,14 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15) #define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16) #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) -#ifdef ERTS_DIRTY_SCHEDULERS #define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18) #define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21) -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22) -#else -#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18) -#endif +#define ERTS_PSFLG_DIRTY_ACTIVE_SYS ERTS_PSFLG_BIT(20) +#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 20) + +#define ERTS_PSFLGS_DIRTY_WORK (ERTS_PSFLG_DIRTY_CPU_PROC \ + | ERTS_PSFLG_DIRTY_IO_PROC \ + | ERTS_PSFLG_DIRTY_ACTIVE_SYS) #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ | ERTS_PSFLG_IN_PRQ_HIGH \ @@ -1170,7 +1172,37 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLGS_GET_USR_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) #define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \ - (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) + (((PSFLGS) >> ERTS_PSFLGS_PRQ_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) + +#ifdef ERTS_DIRTY_SCHEDULERS + +/* + * Flags in the dirty_state field. + */ + +#define ERTS_PDSFLG_IN_CPU_PRQ_MAX (((erts_aint32_t) 1) << 0) +#define ERTS_PDSFLG_IN_CPU_PRQ_HIGH (((erts_aint32_t) 1) << 1) +#define ERTS_PDSFLG_IN_CPU_PRQ_NORMAL (((erts_aint32_t) 1) << 2) +#define ERTS_PDSFLG_IN_CPU_PRQ_LOW (((erts_aint32_t) 1) << 3) +#define ERTS_PDSFLG_IN_IO_PRQ_MAX (((erts_aint32_t) 1) << 4) +#define ERTS_PDSFLG_IN_IO_PRQ_HIGH (((erts_aint32_t) 1) << 5) +#define ERTS_PDSFLG_IN_IO_PRQ_NORMAL (((erts_aint32_t) 1) << 6) +#define ERTS_PDSFLG_IN_IO_PRQ_LOW (((erts_aint32_t) 1) << 7) + +#define ERTS_PDSFLGS_QMASK ERTS_PSFLGS_QMASK +#define ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET 0 +#define ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET ERTS_PSFLGS_QMASK_BITS + +#define ERTS_PDSFLG_IN_CPU_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#define ERTS_PDSFLG_IN_IO_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#endif + /* * Static flags that do not change after process creation. diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 25f0b1ed38..598c1d66ba 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -617,7 +617,7 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { if (psflg) erts_print(to, to_arg, " | "); - for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) { + for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) { erts_aint32_t chk = (1 << i); if (psflg & chk) { switch (chk) { @@ -657,16 +657,12 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { erts_print(to, to_arg, "PROXY"); break; case ERTS_PSFLG_DELAYED_SYS: erts_print(to, to_arg, "DELAYED_SYS"); break; -#ifdef ERTS_DIRTY_SCHEDULERS case ERTS_PSFLG_DIRTY_CPU_PROC: erts_print(to, to_arg, "DIRTY_CPU_PROC"); break; case ERTS_PSFLG_DIRTY_IO_PROC: erts_print(to, to_arg, "DIRTY_IO_PROC"); break; - case ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q: - erts_print(to, to_arg, "DIRTY_CPU_PROC_IN_Q"); break; - case ERTS_PSFLG_DIRTY_IO_PROC_IN_Q: - erts_print(to, to_arg, "DIRTY_IO_PROC_IN_Q"); break; -#endif + case ERTS_PSFLG_DIRTY_ACTIVE_SYS: + erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", chk); break; } -- cgit v1.2.3 From 57cff1f4286a9511926ee37c015b3f6f081d64d0 Mon Sep 17 00:00:00 2001 From: Steve Vinoski Date: Thu, 28 Jan 2016 16:37:33 -0500 Subject: Add dirty scheduler process termination test In scheduler_SUITE add a new test that runs a single dirty I/O scheduler and launches a number of dirty I/O NIF calls that each sleep for 3 seconds. Given the single scheduler, the first of these will run while the rest queue up. Then start killing these processes, and verify they call exit correctly. --- erts/emulator/test/scheduler_SUITE.erl | 50 +++++++++++++++++++++- .../test/scheduler_SUITE_data/Makefile.src | 8 ++++ .../test/scheduler_SUITE_data/scheduler_SUITE.c | 31 ++++++++++++++ 3 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 erts/emulator/test/scheduler_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 986a73ebb1..684e8a3b4e 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -56,6 +56,7 @@ scheduler_threads/1, scheduler_suspend/1, dirty_scheduler_threads/1, + dirty_scheduler_exit/1, reader_groups/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(15)). @@ -70,7 +71,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, + dirty_scheduler_threads, dirty_scheduler_exit, reader_groups]. groups() -> @@ -1166,6 +1167,53 @@ get_dsstate(Config, Cmd) -> stop_node(Node), {DSCPU, DSCPUOnln, DSIO}. +dirty_scheduler_exit(Config) when is_list(Config) -> + try + erlang:system_info(dirty_cpu_schedulers), + dirty_scheduler_exit_test(Config) + catch + error:badarg -> + {skipped, "No dirty scheduler support"} + end. + +dirty_scheduler_exit_test(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Path = ?config(data_dir, Config), + Lib = atom_to_list(?MODULE), + ok = erlang:load_nif(filename:join(Path,Lib), []), + ok = test_dirty_scheduler_exit() + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun dirty_sleeper/0), + test_dse(N-1,[Pid|Pids]). +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,killed} -> + ok + end, + wait_dse(Pids). + +dirty_sleeper() -> + erlang:nif_error({error,?MODULE}). + 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, diff --git a/erts/emulator/test/scheduler_SUITE_data/Makefile.src b/erts/emulator/test/scheduler_SUITE_data/Makefile.src new file mode 100644 index 0000000000..859112cf19 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +SCHEDULER_LIBS = scheduler_SUITE@dll@ + +all: $(SCHEDULER_LIBS) + +@SHLIB_RULES@ + +$(SCHEDULER_LIBS): scheduler_SUITE.c diff --git a/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c new file mode 100644 index 0000000000..022858c114 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c @@ -0,0 +1,31 @@ +#include +#include "erl_nif.h" + +static int +load(ErlNifEnv* env, void** priv, ERL_NIF_TERM info) +{ + ErlNifSysInfo sys_info; + enif_system_info(&sys_info, sizeof(ErlNifSysInfo)); + if (!sys_info.smp_support || !sys_info.dirty_scheduler_support) + return 1; + return 0; +} + +static ERL_NIF_TERM +dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + sleep(3); +#endif + return enif_make_atom(env, "ok"); +} + +static ErlNifFunc funcs[] = { +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND} +#else + {"dirty_sleeper", 0, dirty_sleeper, 0} +#endif +}; + +ERL_NIF_INIT(scheduler_SUITE, funcs, &load, NULL, NULL, NULL); -- cgit v1.2.3 From 5d8a987285cf13e8d87731a6284c7df7ed3dac70 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Fri, 12 Feb 2016 16:20:23 +0100 Subject: Fix unique_SUITE for dirty schedulers --- erts/emulator/test/unique_SUITE.erl | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl index 6fa634b886..a6884d63a6 100644 --- a/erts/emulator/test/unique_SUITE.erl +++ b/erts/emulator/test/unique_SUITE.erl @@ -267,10 +267,21 @@ calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift -> calc_sched_bits(NoScheds, Shift) -> calc_sched_bits(NoScheds, Shift+1). +schedulers() -> + S = erlang:system_info(schedulers), + try + DCPUS = erlang:system_info(dirty_cpu_schedulers), + DIOS = erlang:system_info(dirty_io_schedulers), + S+DCPUS+DIOS + catch + _ : _ -> + S + end. + init_uniqint_info() -> SmallBits = erlang:system_info({wordsize, internal})*8-4, io:format("SmallBits=~p~n", [SmallBits]), - Schedulers = erlang:system_info(schedulers), + Schedulers = schedulers(), io:format("Schedulers=~p~n", [Schedulers]), MinSmall = -1*(1 bsl (SmallBits-1)), io:format("MinSmall=~p~n", [MinSmall]), @@ -337,7 +348,7 @@ check_uniqint(Int, UinqintInfo) -> true -> io:format("OK~n~n", []); false -> - io:format("result UniqInt=~p FAILED~n", [UniqInt]), + io:format("result Int=~p FAILED~n", [Int]), exit(badres) end. -- cgit v1.2.3 From bc1e16e334afc8255b221e3ffbb6f7c54fb91a2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Mon, 1 Feb 2016 10:50:32 +0100 Subject: Avoid erts_cmp jump in atom, int and float comparisons Given the function definition below: check(X) when X >= 0, X <= 20 -> true. @nox has originally noticed that perfoming lt and ge guard tests were performing slower than they should be. Further investigation revealed that most of the cost was in jumping to the erts_cmp function. This patch brings the operations already inlined in erts_cmp into the emulator, removing the jump cost. After applying these changes, invoking the check/1 function defined above 30000 times with different values from 0 to 20 has fallen from 367us to 213us (measured as average of 3 runs). This is a considerably improvement over Erlang 18 which takes 556us on average. Floats have also dropped their time from 1126us (on Erlang 18) to 613us. --- erts/emulator/beam/atom.c | 2 +- erts/emulator/beam/beam_emu.c | 8 ++++---- erts/emulator/beam/erl_utils.h | 34 ++++++++++++++++++++++++---------- erts/emulator/beam/utils.c | 18 +++++++++--------- 4 files changed, 38 insertions(+), 24 deletions(-) diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index fd2adac676..099c00bcf6 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -176,7 +176,7 @@ atom_alloc(Atom* tmpl) /* * Precompute ordinal value of first 3 bytes + 7 bits. - * This is used by utils.c:cmp_atoms(). + * This is used by utils.c:erts_cmp_atoms(). * We cannot use the full 32 bits of the first 4 bytes, * since we use the sign of the difference between two * ordinal values to represent their relative order. diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4d7b00b032..659ff3ad2f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -718,10 +718,10 @@ void** beam_ops; #define NotEqualImmed(X, Y, Action) if (X == Y) { Action; } #define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; } #define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; } -#define Equal(X, Y, Action) if (!CMP_EQ(X,Y)) { Action; } -#define NotEqual(X, Y, Action) if (!CMP_NE(X,Y)) { Action; } -#define IsLessThan(X, Y, Action) if (CMP_GE(X, Y)) { Action; } -#define IsGreaterEqual(X, Y, Action) if (CMP_LT(X, Y)) { Action; } +#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action) +#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action) +#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action) +#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action) #define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 4058d63eaf..b8746f7edb 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -161,7 +161,9 @@ int eq(Eterm, Eterm); #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) +int erts_cmp_atoms(Eterm a, Eterm b); Sint erts_cmp(Eterm, Eterm, int, int); +Sint erts_cmp_compound(Eterm, Eterm, int, int); Sint cmp(Eterm a, Eterm b); #define CMP(A,B) erts_cmp(A,B,0,0) #define CMP_TERM(A,B) erts_cmp(A,B,1,0) @@ -174,17 +176,29 @@ Sint cmp(Eterm a, Eterm b); #define cmp_ge(a,b) (CMP((a),(b)) >= 0) #define cmp_gt(a,b) (CMP((a),(b)) > 0) -#define cmp_lt_term(a,b) (CMP_TERM((a),(b)) < 0) -#define cmp_le_term(a,b) (CMP_TERM((a),(b)) <= 0) -#define cmp_ge_term(a,b) (CMP_TERM((a),(b)) >= 0) -#define cmp_gt_term(a,b) (CMP_TERM((a),(b)) > 0) - -#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) -#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) #define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) -#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b))) -#define CMP_LT_TERM(a,b) ((a) != (b) && cmp_lt_term((a),(b))) -#define CMP_GE_TERM(a,b) ((a) == (b) || cmp_ge_term((a),(b))) +#define CMP_EQ_ACTION(X,Y,Action) \ + if ((X) != (Y)) { CMP_SPEC((X),(Y),!=,Action,1); } +#define CMP_NE_ACTION(X,Y,Action) \ + if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),==,Action,1); } +#define CMP_GE_ACTION(X,Y,Action) \ + if ((X) != (Y)) { CMP_SPEC((X),(Y),<,Action,0); } +#define CMP_LT_ACTION(X,Y,Action) \ + if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),>=,Action,0); } + +#define CMP_SPEC(X,Y,Op,Action,EqOnly) \ + if (is_atom(X) && is_atom(Y)) { \ + if (erts_cmp_atoms(X, Y) Op 0) { Action; }; \ + } else if (is_both_small(X, Y)) { \ + if (signed_val(X) Op signed_val(Y)) { Action; }; \ + } else if (is_float(X) && is_float(Y)) { \ + FloatDef af, bf; \ + GET_DOUBLE(X, af); \ + GET_DOUBLE(Y, bf); \ + if (af.fd Op bf.fd) { Action; }; \ + } else { \ + if (erts_cmp_compound(X,Y,0,EqOnly) Op 0) { Action; }; \ + } #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index ef851d840d..6aad1ff778 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2991,7 +2991,7 @@ static int cmpbytes(byte *s1, int l1, byte *s2, int l2) #define float_comp(x,y) (((x)<(y)) ? -1 : (((x)==(y)) ? 0 : 1)) -static int cmp_atoms(Eterm a, Eterm b) +int erts_cmp_atoms(Eterm a, Eterm b) { Atom *aa = atom_tab(atom_val(a)); Atom *bb = atom_tab(atom_val(b)); @@ -3010,12 +3010,12 @@ Sint cmp(Eterm a, Eterm b) return erts_cmp(a, b, 0, 0); } -static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only); +Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only); Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) { if (is_atom(a) && is_atom(b)) { - return cmp_atoms(a, b); + return erts_cmp_atoms(a, b); } else if (is_both_small(a, b)) { return (signed_val(a) - signed_val(b)); } else if (is_float(a) && is_float(b)) { @@ -3032,7 +3032,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) * exact = 1 -> term-based compare * exact = 0 -> arith-based compare */ -static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) +Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) { #define PSTACK_TYPE struct erts_cmp_hashmap_state struct erts_cmp_hashmap_state { @@ -3089,7 +3089,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) do { \ if((AN) != (BN)) { \ if((AN)->sysname != (BN)->sysname) \ - RETURN_NEQ(cmp_atoms((AN)->sysname, (BN)->sysname)); \ + RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \ ASSERT((AN)->creation != (BN)->creation); \ RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \ } \ @@ -3107,7 +3107,7 @@ tailrecur_ne: /* deal with majority (?) cases by brute-force */ if (is_atom(a)) { if (is_atom(b)) { - ON_CMP_GOTO(cmp_atoms(a, b)); + ON_CMP_GOTO(erts_cmp_atoms(a, b)); } } else if (is_both_small(a, b)) { ON_CMP_GOTO(signed_val(a) - signed_val(b)); @@ -3341,10 +3341,10 @@ tailrecur_ne: Export* a_exp = *((Export **) (export_val(a) + 1)); Export* b_exp = *((Export **) (export_val(b) + 1)); - if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { + if ((j = erts_cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { RETURN_NEQ(j); } - if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) { + if ((j = erts_cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) { RETURN_NEQ(j); } ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]); @@ -3659,7 +3659,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ b = *bb++; if (!is_same(a, b)) { if (is_atom(a) && is_atom(b)) { - if ((j = cmp_atoms(a, b)) != 0) { + if ((j = erts_cmp_atoms(a, b)) != 0) { goto not_equal; } } else if (is_both_small(a, b)) { -- cgit v1.2.3 From 345651148351c57b26347ee9a9b50e6e2732e79a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Mon, 15 Feb 2016 11:00:26 +0100 Subject: Unify comparison macros in erl_utils.h This removes the duplication in having both `cmp_eq` and `CMP_EQ` and normalizes their name to uppercase. --- erts/emulator/beam/erl_bif_op.c | 12 ++++++------ erts/emulator/beam/erl_utils.h | 14 ++++++-------- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index d53a9e11ca..0f20ded1d6 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -89,22 +89,22 @@ BIF_RETTYPE not_1(BIF_ALIST_1) BIF_RETTYPE sgt_2(BIF_ALIST_2) { - BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_GT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sge_2(BIF_ALIST_2) { - BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_GE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE slt_2(BIF_ALIST_2) { - BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_LT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sle_2(BIF_ALIST_2) { - BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_LE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE seq_2(BIF_ALIST_2) @@ -114,7 +114,7 @@ BIF_RETTYPE seq_2(BIF_ALIST_2) BIF_RETTYPE seqeq_2(BIF_ALIST_2) { - BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_EQ(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sneq_2(BIF_ALIST_2) @@ -124,7 +124,7 @@ BIF_RETTYPE sneq_2(BIF_ALIST_2) BIF_RETTYPE sneqeq_2(BIF_ALIST_2) { - BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_NE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE is_atom_1(BIF_ALIST_1) diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index b8746f7edb..dd7b925bd3 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -169,14 +169,12 @@ Sint cmp(Eterm a, Eterm b); #define CMP_TERM(A,B) erts_cmp(A,B,1,0) #define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1) -#define cmp_lt(a,b) (CMP((a),(b)) < 0) -#define cmp_le(a,b) (CMP((a),(b)) <= 0) -#define cmp_eq(a,b) (CMP_EQ_ONLY((a),(b)) == 0) -#define cmp_ne(a,b) (CMP_EQ_ONLY((a),(b)) != 0) -#define cmp_ge(a,b) (CMP((a),(b)) >= 0) -#define cmp_gt(a,b) (CMP((a),(b)) > 0) - -#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) +#define CMP_LT(a,b) ((a) != (b) && CMP((a),(b)) < 0) +#define CMP_LE(a,b) ((a) == (b) || CMP((a),(b)) <= 0) +#define CMP_EQ(a,b) ((a) == (b) || CMP_EQ_ONLY((a),(b)) == 0) +#define CMP_NE(a,b) ((a) != (b) && CMP_EQ_ONLY((a),(b)) != 0) +#define CMP_GE(a,b) ((a) == (b) || CMP((a),(b)) >= 0) +#define CMP_GT(a,b) ((a) != (b) && CMP((a),(b)) > 0) #define CMP_EQ_ACTION(X,Y,Action) \ if ((X) != (Y)) { CMP_SPEC((X),(Y),!=,Action,1); } -- cgit v1.2.3 From e5fe2f89638dedb08da2114558d229fe18dcd14e Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Wed, 14 Jan 2015 19:14:38 +0000 Subject: Prettify default error_logger output somewhat The default error logger, the one in use before a more sophisticated error logger can be installed, has rather terse output, in part because it cannot rely on io:format. This patch attempts to improve the error logger within that constraint: - Print timestamps as YYYY-MM-DD HH:MM:SS - For error reports with format strings, just print the format string and the format arguments on separate lines - For error reports with tuple lists, print each pair on a separate line --- lib/kernel/src/error_logger.erl | 81 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 79 insertions(+), 2 deletions(-) diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index b8fbf02feb..5cf750c40b 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -434,5 +434,82 @@ add_node(X, Pid) -> %% Can't do io_lib:format -display2(Tag,F,A) -> - erlang:display({error_logger,Tag,F,A}). +display2({{_Y,_Mo,_D},{_H,_Mi,_S}} = Date, F, A) -> + display_date(Date), + display3(string_p(F), F, A). + +display_date({{Y,Mo,D},{H,Mi,S}}) -> + erlang:display_string( + integer_to_list(Y) ++ "-" ++ + two_digits(Mo) ++ "-" ++ + two_digits(D) ++ " " ++ + two_digits(H) ++ ":" ++ + two_digits(Mi) ++ ":" ++ + two_digits(S) ++ " "). + +two_digits(N) when 0 =< N, N =< 9 -> + [$0, $0 + N]; +two_digits(N) -> + integer_to_list(N). + +display3(true, F, A) -> + %% Format string with arguments + erlang:display_string(F ++ "\n"), + [begin + erlang:display_string("\t"), + erlang:display(Arg) + end || Arg <- A], + ok; +display3(false, Atom, A) when is_atom(Atom) -> + %% The widest atom seems to be 'supervisor_report' at 17. + ColumnWidth = 20, + AtomString = atom_to_list(Atom), + AtomLength = length(AtomString), + Padding = lists:duplicate(ColumnWidth - AtomLength, $\s), + erlang:display_string(AtomString ++ Padding), + display4(A); +display3(_, F, A) -> + erlang:display({F, A}). + +display4([A, []]) -> + %% Not sure why crash reports look like this. + display4(A); +display4(A = [_|_]) -> + case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of + true -> + erlang:display_string("\n"), + lists:foreach( + fun({Key, Value}) -> + erlang:display_string( + " " ++ + atom_to_list(Key) ++ + ": "), + erlang:display(Value) + end, A); + false -> + erlang:display(A) + end; +display4(A) -> + erlang:display(A). + +string_p([]) -> + false; +string_p(Term) -> + string_p1(Term). + +string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> + string_p1(T); +string_p1([$\n|T]) -> string_p1(T); +string_p1([$\r|T]) -> string_p1(T); +string_p1([$\t|T]) -> string_p1(T); +string_p1([$\v|T]) -> string_p1(T); +string_p1([$\b|T]) -> string_p1(T); +string_p1([$\f|T]) -> string_p1(T); +string_p1([$\e|T]) -> string_p1(T); +string_p1([H|T]) when is_list(H) -> + case string_p1(H) of + true -> string_p1(T); + _ -> false + end; +string_p1([]) -> true; +string_p1(_) -> false. -- cgit v1.2.3 From 5e266f38ea828fdfd6e550c2b4a2584d6d1a1d4e Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 3 Feb 2016 15:49:15 +0100 Subject: tools: Add suppression of Dialyzer warnings --- lib/tools/src/cprof.erl | 3 ++- lib/tools/src/fprof.erl | 8 +++++++- lib/tools/src/xref_utils.erl | 23 +++++++++++++---------- 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl index 0240f876bc..f6d68f0bf8 100644 --- a/lib/tools/src/cprof.erl +++ b/lib/tools/src/cprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -114,6 +114,7 @@ analyse(Limit) when is_integer(Limit) -> analyse(M) when is_atom(M) -> analyse(M, 1). +-dialyzer({no_improper_lists, analyse/2}). analyse(M, Limit) when is_atom(M), is_integer(Limit) -> L0 = [begin MFA = {M,F,A}, diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index 7c6fab0b75..c5c24c8eb3 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2251,6 +2251,8 @@ do_analyse(Table, Analyse) -> ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), Result. +-dialyzer({no_improper_lists, do_analyse_1/2}). + do_analyse_1(Table, #analyse{group_leader = GroupLeader, dest = Io, @@ -2624,6 +2626,8 @@ funcstat_pd(Pid, Func1, Func0, Clocks) -> funcstat_sort_r(FuncstatList, Element) -> funcstat_sort_r_1(FuncstatList, Element, []). +-dialyzer({no_improper_lists, funcstat_sort_r_1/3}). + funcstat_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, @@ -2646,6 +2650,8 @@ funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, clocks_sort_r(L, E) -> clocks_sort_r_1(L, E, []). +-dialyzer({no_improper_lists, clocks_sort_r_1/3}). + clocks_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); clocks_sort_r_1([#clocks{} = C | L], E, R) -> diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index 438ec93962..f69aa70244 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -245,6 +245,8 @@ select_last_application_version(AppVs) -> TL = to_external(partition(1, relation(AppVs))), [last(keysort(2, L)) || L <- TL]. +-record(scan, {collected = [], errors = [], seen = [], unreadable = []}). + %% scan_directory(Directory, Recurse, Collect, Watch) -> %% {Collected, Errors, Seen, Unreadable} %% @@ -261,8 +263,9 @@ select_last_application_version(AppVs) -> %% Unreadable. %% scan_directory(File, Recurse, Collect, Watch) -> - Init = [[] | {[],[],[]}], - [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init), + Init = #scan{}, + S = find_files_dir(File, Recurse, Collect, Watch, Init), + #scan{collected = L, errors = E, seen = J, unreadable = U} = S, {reverse(L), reverse(E), reverse(J), reverse(U)}. %% {Dir, Basename} | false @@ -576,8 +579,7 @@ find_files_dir(Dir, Recurse, Collect, Watch, L) -> {ok, Files} -> find_files(sort(Files), Dir, Recurse, Collect, Watch, L); {error, Error} -> - [B | {E,J,U}] = L, - [B | {[file_error(Dir, Error)|E],J,U}] + L#scan{errors = [file_error(Dir, Error)|L#scan.errors]} end. find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> @@ -588,22 +590,23 @@ find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> {ok, {_, directory, _, _}} -> L; Info -> - [B | EJU = {E,J,U}] = L, + #scan{collected = B, errors = E, + seen = J, unreadable = U} = L, Ext = filename:extension(File), C = member(Ext, Collect), case C of true -> case Info of {ok, {_, file, readable, _}} -> - [[{Dir,F} | B] | EJU]; + L#scan{collected = [{Dir,F} | B]}; {ok, {_, file, unreadable, _}} -> - [B | {E,J,[File|U]}]; + L#scan{unreadable = [File|U]}; Error -> - [B | {[Error|E],J,U}] + L#scan{errors = [Error|E]} end; false -> case member(Ext, Watch) of - true -> [B | {E,[File|J],U}]; + true -> L#scan{seen = [File|J]}; false -> L end end -- cgit v1.2.3 From 811d6f7c9d9f86a388b8ba555b42934b9ed1c180 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 11:46:00 +0100 Subject: test_server: Add suppression of Dialyzer warnings --- lib/test_server/src/test_server_node.erl | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 4e6839fc6b..e870a55398 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -121,7 +121,7 @@ start_tracer_node(TraceFile,TI) -> %%% trace_nodes(Sock,Nodes) -> Bin = term_to_binary({add_nodes,Nodes}), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive_ack(Sock). @@ -142,7 +142,7 @@ receive_ack(Sock) -> %%% stop_tracer_node(Sock) -> Bin = term_to_binary(id(stop)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, ok. @@ -171,7 +171,7 @@ trc([TraceFile, PortAtom, Type]) -> {packet,2}]) of {ok,Sock} -> BinResult = term_to_binary(Result), - ok = gen_tcp:send(Sock,[1|BinResult]), + ok = gen_tcp:send(Sock,tag_trace_message(BinResult)), trc_loop(Sock,Patterns,Type); _else -> ok @@ -187,7 +187,7 @@ trc_loop(Sock,Patterns,Type) -> {ok,{add_nodes,Nodes}} -> add_nodes(Nodes,Patterns,Type), Bin = term_to_binary(id(ok)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), trc_loop(Sock,Patterns,Type); {ok,stop} -> ttb:stop(), @@ -482,7 +482,7 @@ node_started(Host,PortAtom) -> {ok,Sock} -> Started = term_to_binary({started, node(), Version, VsnStr}), - ok = gen_tcp:send(Sock, [1|Started]), + ok = gen_tcp:send(Sock, tag_trace_message(Started)), receive _Anyting -> gen_tcp:close(Sock), erlang:halt() @@ -492,8 +492,10 @@ node_started(Host,PortAtom) -> end. - - +-compile({inline, [tag_trace_message/1]}). +-dialyzer({no_improper_lists, tag_trace_message/1}). +tag_trace_message(M) -> + [1|M]. % start_which_node(Optlist) -> hostname start_which_node(Optlist) -> -- cgit v1.2.3 From 03e5309b312bd1c714a3874eba1384bf5b4feff5 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 3 Feb 2016 14:44:16 +0100 Subject: stdlib: Add suppression of Dialyzer warnings --- lib/stdlib/src/dets_utils.erl | 4 +++- lib/stdlib/src/dets_v8.erl | 4 +++- lib/stdlib/src/dets_v9.erl | 4 +++- lib/stdlib/src/dict.erl | 4 +++- lib/stdlib/src/digraph.erl | 6 +++++- lib/stdlib/src/erl_lint.erl | 4 ++++ lib/stdlib/src/file_sorter.erl | 4 +++- lib/stdlib/src/lists.erl | 4 +++- lib/stdlib/src/otp_internal.erl | 14 +++++++++----- lib/stdlib/src/qlc.erl | 4 +++- lib/stdlib/src/rand.erl | 6 +++++- lib/stdlib/src/unicode.erl | 4 +++- lib/stdlib/src/zip.erl | 4 +++- 13 files changed, 50 insertions(+), 16 deletions(-) diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 196158cd48..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 49126193b8..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 361780c776..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6ce3710f87..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -333,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e51e560542..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -338,6 +338,8 @@ edge(G, E) -> %% -spec new_edge_id(graph()) -> edge(). +-dialyzer({no_improper_lists, new_edge_id/1}). + new_edge_id(G) -> NT = G#digraph.ntab, [{'$eid', K}] = ets:lookup(NT, '$eid'), @@ -350,6 +352,8 @@ new_edge_id(G) -> %% -spec new_vertex_id(graph()) -> vertex(). +-dialyzer({no_improper_lists, new_vertex_id/1}). + new_vertex_id(G) -> NT = G#digraph.ntab, [{'$vid', K}] = ets:lookup(NT, '$vid'), diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index e940ad6956..62b3169a6c 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3532,6 +3532,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3560,6 +3562,8 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). + deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..0d50392b96 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 62b6ca8a21..2b4472cdf7 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2267,6 +2267,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index c254ab1e46..9d394e19d7 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,6 +23,8 @@ %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). @@ -698,17 +700,19 @@ is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. +-dialyzer({no_match, obsolete_type/3}). + -spec obsolete_type(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. obsolete_type(Module, Name, NumberOfVariables) -> case obsolete_type_1(Module, Name, NumberOfVariables) of -%% {deprecated=Tag,{_,_,_}=Replacement} -> -%% {Tag,Replacement,"in a future release"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; -%% {_,_,_}=Ret -> -%% Ret; + {_,_,_}=Ret -> + Ret; no -> no end. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..1ae7c6cc25 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index dc060e82d9..d455abf7b0 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -256,6 +256,8 @@ exs64_uniform(Max, {Alg, R}) -> %% ===================================================================== -type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-dialyzer({no_improper_lists, exsplus_seed/1}). + exsplus_seed({A1, A2, A3}) -> {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| (((A2 * 4294967231) + 1) band ?UINT58MASK)]), @@ -263,6 +265,8 @@ exsplus_seed({A1, A2, A3}) -> tl(R1)]), R2. +-dialyzer({no_improper_lists, exsplus_next/1}). + %% Advance xorshift116+ state for one step and generate 58bit unsigned integer -spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. exsplus_next([S1|S0]) -> diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 3e8e6f5101..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -561,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index bec0bd3f6d..f8ba6f18e9 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1566,6 +1566,8 @@ append_bins([_|_]=List, B) -> append_bins([], B) -> B. +-dialyzer({no_improper_lists, pwrite_iolist/3}). + pwrite_iolist(B, Pos, Bin) -> {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), -- cgit v1.2.3 From d7ec9c47050ca07d60bf2cdf1c1ab4d7ee2ef75c Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 12:55:15 +0100 Subject: runtime_tools: Add suppression of Dialyzer warnings --- lib/runtime_tools/src/dbg.erl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 22b531e6ee..6eea1a0917 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1276,6 +1276,8 @@ gen_reader_file(ReadFun, Filename) -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader/2}). + %% Creates and returns a reader (lazy list). mk_reader(ReadFun, Source) -> fun() -> @@ -1301,6 +1303,8 @@ mk_reader_wrap([Hd | _] = WrapFiles) -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader_wrap/2}). + mk_reader_wrap([_Hd | Tail] = WrapFiles, File) -> fun() -> case read_term(fun file_read/2, File) of -- cgit v1.2.3 From e7ec19163e2f7f626fc9193fae6e3c3baa6e3f70 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 11:51:33 +0100 Subject: observer: Add suppression of Dialyzer warnings --- lib/observer/src/observer_tv_table.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 88f606b3e4..75e6919642 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -669,6 +669,7 @@ merge([], New, _Key) -> merge(Old, New, Key) -> merge2(keysort(Key, Old), keysort(Key, New), Key). +-dialyzer({no_improper_lists, merge2/3}). merge2([[Obj|_]|Old], [Obj|New], Key) -> [[Obj]|merge2(Old, New, Key)]; merge2([[A|Op]|Old], [B|New], Key) -- cgit v1.2.3 From d1972f66df96ec76bc6a3861d1ff8f4f4c302b5f Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 11:49:26 +0100 Subject: mnesia: Add suppression of Dialyzer warnings --- lib/mnesia/src/mnesia_schema.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 1bd8703e1d..782493fb4f 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1095,6 +1095,7 @@ do_delete_table(Tab) -> ensure_writable(schema), insert_schema_ops(TidTs, make_delete_table(Tab, whole_table)). +-dialyzer({no_improper_lists, make_delete_table/2}). make_delete_table(Tab, Mode) -> case existed_before(Tab) of false -> -- cgit v1.2.3 From d114f1166cd25b6fb7aedaddc9087ecca38fb3b2 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Feb 2016 09:34:28 +0100 Subject: kernel: Add suppression of Dialyzer warnings --- lib/kernel/src/disk_log_1.erl | 6 +++++- lib/kernel/src/heart.erl | 3 ++- lib/kernel/src/user_drv.erl | 3 ++- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 9b9fd086f1..2e61363aa6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -79,6 +79,7 @@ log(FdC, FileName, X) -> logl(X) -> logl(X, [], 0). +-dialyzer({no_improper_lists, logl/3}). logl([X | T], Bs, Size) -> Sz = byte_size(X), BSz = <>, @@ -1142,6 +1143,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> file_error(FileName, E) end. +-dialyzer({no_improper_lists, to_8_bytes/4}). to_8_bytes(<>, NT, FileName, Fd) -> to_8_bytes(T, [NT | <>], FileName, Fd); to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 -> @@ -1276,6 +1278,7 @@ ext_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, ext_split_bins/6}). ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> NBs = Bs + byte_size(X), if @@ -1296,6 +1299,7 @@ int_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, int_split_bins/6}). int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> Sz = byte_size(X), NBs = Bs + Sz + ?HEADERSZ, diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 464b6919f1..137fad706f 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -265,6 +265,7 @@ do_cycle_port_program(Caller, Parent, Port, Cmd) -> send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}. %% Set a new HEART_COMMAND. +-dialyzer({no_improper_lists, send_heart_cmd/2}). send_heart_cmd(Port, []) -> Port ! {self(), {command, [?CLEAR_CMD]}}; send_heart_cmd(Port, Cmd) -> diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index ca3c53ff93..b794d4f45e 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -559,6 +559,7 @@ put_int16(N, Tail) -> %% is sent back to the process sending the request. This command was added in %% OTP 18 to make sure that data sent from io:format is actually printed %% to the console before the vm stops when calling erlang:halt(integer()). +-dialyzer({no_improper_lists, io_command/1}). io_command({put_chars_sync, unicode,Cs,Reply}) -> {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> -- cgit v1.2.3 From 98f74d1f6f1109cbd0cbc495ed3d8630271ce8c6 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 3 Feb 2016 16:42:17 +0100 Subject: debugger: Add suppression of Dialyzer warnings --- lib/debugger/src/dbg_icmd.erl | 6 +++--- lib/debugger/src/dbg_ieval.erl | 6 +++--- lib/debugger/src/dbg_ieval.hrl | 4 +++- lib/debugger/src/dbg_wx_trace.erl | 4 ++-- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index 4c34f253c6..1b274e20ae 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -267,7 +267,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, #ieval{level=Le,module=M}=Ieval) -> if Status =:= idle, Le =:= 1 -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []); true -> case dbg_istk:in_use_p(Mod, M) of @@ -277,7 +277,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, exit(get(self), kill), dbg_ieval:exception(exit, old_code, Bs, Ieval); false -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []) end end; diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 7ed371a653..f5e079ef7e 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -560,7 +560,7 @@ get_function(Mod, Name, Args, extern) -> end. db_ref(Mod) -> - case get([Mod|db]) of + case get(?DB_REF_KEY(Mod)) of undefined -> case dbg_iserver:call(get(int), {get_module_db, Mod, get(self)}) of @@ -572,7 +572,7 @@ db_ref(Mod) -> Node =/= node() -> {Node,ModDb}; true -> ModDb end, - put([Mod|db], DbRef), + put(?DB_REF_KEY(Mod), DbRef), DbRef end; DbRef -> diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index 95d0842b19..ad422a9e4a 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,3 +27,5 @@ %% (i.e. the next call will leave interpreted code). top = false }). + +-define(DB_REF_KEY(Mod), {Mod,db}). diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 5fd1519ba0..f9c60f9b72 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -811,7 +811,7 @@ gui_show_module(Win, Mod, Line, Mod, _Pid, How) -> dbg_wx_trace_win:mark_line(Win, Line, How); gui_show_module(Win, Mod, Line, _Cm, Pid, How) -> Win2 = case dbg_wx_trace_win:is_shown(Win, Mod) of - {true, Win3} -> Win3; + %% {true, Win3} -> Win3; false -> gui_load_module(Win, Mod, Pid) end, dbg_wx_trace_win:mark_line(Win2, Line, How). -- cgit v1.2.3 From 7113a52be93505b2db99cfa7a37160e80722a203 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 3 Feb 2016 15:33:11 +0100 Subject: eunit: Add suppression of Dialyzer warnings --- lib/eunit/src/eunit_data.erl | 1 + lib/eunit/src/eunit_lib.erl | 6 ++++++ lib/eunit/src/eunit_listener.erl | 37 +++++++++++++++++++------------------ lib/eunit/src/eunit_proc.erl | 2 ++ lib/eunit/src/eunit_serial.erl | 18 ++++++++++-------- lib/eunit/src/eunit_test.erl | 3 +++ lib/eunit/src/eunit_tests.erl | 2 ++ 7 files changed, 43 insertions(+), 26 deletions(-) diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 8b53a3681d..cc002cb449 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -761,6 +761,7 @@ lazy_test_() -> lazy_gen(7), ?_assertMatch(7, get(count))]}. +-dialyzer({no_improper_lists, lazy_gen/1}). lazy_gen(N) -> {generator, fun () -> diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index d8f98cffa5..4dbe023257 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -192,6 +192,7 @@ error_msg(Title, Fmt, Args) -> io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). +-dialyzer({no_match, format_exception_test_/0}). format_exception_test_() -> [?_assertMatch( "\nymmud:rorre"++_, @@ -273,6 +274,7 @@ dlist_next([], Xs) -> -ifdef(TEST). +-dialyzer({no_match, dlist_test_/0}). dlist_test_() -> {"deep list traversal", [{"non-list term -> singleton list", @@ -338,6 +340,7 @@ is_nonempty_string([]) -> false; is_nonempty_string(Cs) -> is_string(Cs). -ifdef(TEST). +-dialyzer({no_match, is_string_test_/0}). is_string_test_() -> {"is_string", [{"no non-lists", ?_assert(not is_string($A))}, @@ -399,6 +402,7 @@ uniq([X | Xs]) -> [X | uniq(Xs)]; uniq([]) -> []. -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_improper_lists], uniq_test_/0}). uniq_test_() -> {"uniq", [?_assertError(function_clause, uniq(ok)), @@ -459,6 +463,7 @@ normalize([]) -> -ifdef(TEST). +-dialyzer({no_match, cmd_test_/0}). cmd_test_() -> ([?_test({0, "hello\n"} = ?_cmd_("echo hello"))] ++ case os:type() of @@ -576,6 +581,7 @@ trie_match([], _T) -> -ifdef(TEST). +-dialyzer({no_match, trie_test_/0}). trie_test_() -> [{"basic representation", [?_assert(trie_new() =:= gb_trees:empty()), diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index ecaac424a2..d9b836863b 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -27,14 +27,11 @@ -export([start/1, start/2]). --export([behaviour_info/1]). - - -behaviour_info(callbacks) -> - [{init,1},{handle_begin,3},{handle_end,3},{handle_cancel,3}, - {terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(_) -> _. +-callback handle_begin(_, _, _) -> _. +-callback handle_end(_, _, _) -> _. +-callback handle_cancel(_, _, _) -> _. +-callback terminate(_, _) -> _. -record(state, {callback, % callback module @@ -50,18 +47,22 @@ start(Callback) -> start(Callback, Options) -> St = #state{callback = Callback}, - spawn_opt(fun () -> init(St, Options) end, + spawn_opt(init_fun(St, Options), proplists:get_all_values(spawn, Options)). -init(St0, Options) -> - St1 = call(init, [Options], St0), - St2 = expect([], undefined, St1), - Data = [{pass, St2#state.pass}, - {fail, St2#state.fail}, - {skip, St2#state.skip}, - {cancel, St2#state.cancel}], - call(terminate, [{ok, Data}, St2#state.state], St2), - exit(normal). +-spec init_fun(_, _) -> no_return(). + +init_fun(St0, Options) -> + fun () -> + St1 = call(init, [Options], St0), + St2 = expect([], undefined, St1), + Data = [{pass, St2#state.pass}, + {fail, St2#state.fail}, + {skip, St2#state.skip}, + {cancel, St2#state.cancel}], + call(terminate, [{ok, Data}, St2#state.state], St2), + exit(normal) + end. expect(Id, ParentId, St) -> case wait_for(Id, 'begin', ParentId) of diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 98ae31d54b..8bdf94c877 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -268,6 +268,8 @@ insulator_wait(Child, Parent, Buf, St) -> kill_task(Child, St) end. +-spec kill_task(_, _) -> no_return(). + kill_task(Child, St) -> exit(Child, kill), terminate_insulator(St). diff --git a/lib/eunit/src/eunit_serial.erl b/lib/eunit/src/eunit_serial.erl index 1a0179a5df..da76064a53 100644 --- a/lib/eunit/src/eunit_serial.erl +++ b/lib/eunit/src/eunit_serial.erl @@ -61,14 +61,16 @@ messages = dict:new() :: dict:dict()}). start(Pids) -> - spawn(fun () -> serializer(Pids) end). - -serializer(Pids) -> - St = #state{listeners = sets:from_list(Pids), - cancelled = eunit_lib:trie_new(), - messages = dict:new()}, - expect([], undefined, 0, St), - exit(normal). + spawn(serializer_fun(Pids)). + +serializer_fun(Pids) -> + fun () -> + St = #state{listeners = sets:from_list(Pids), + cancelled = eunit_lib:trie_new(), + messages = dict:new()}, + expect([], undefined, 0, St), + exit(normal) + end. %% collect beginning and end of an expected item; return {Done, NewSt} %% where Done is true if there are no more items of this group diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index 9cf40a738d..62d30b1930 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -40,6 +40,7 @@ get_stacktrace() -> get_stacktrace(Ts) -> eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). +-dialyzer({no_match, prune_trace/2}). prune_trace([{eunit_data, _, _} | Rest], Tail) -> prune_trace(Rest, Tail); prune_trace([{eunit_data, _, _, _} | Rest], Tail) -> @@ -75,6 +76,7 @@ run_testfun(F) -> -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_return], macro_test_/0}). macro_test_() -> {"macro definitions", [{?LINE, fun () -> @@ -301,6 +303,7 @@ wrapper_test_() -> ]}. %% this must be exported (done automatically by the autoexport transform) +-dialyzer({no_missing_calls, wrapper_test_exported_/0}). wrapper_test_exported_() -> {ok, ?MODULE:nonexisting_function()}. -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 47ea0aaf46..5dee1cb49e 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -23,6 +23,8 @@ -include("eunit.hrl"). +-dialyzer(no_match). + -ifdef(TEST). id(X) -> X. % for suppressing compiler warnings -endif. -- cgit v1.2.3 From 3f2a84b2f1671b10be7c9a34d107a7f21dc73192 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 16 Feb 2016 15:16:08 +0100 Subject: xmerl: Add suppression of Dialyzer warnings --- lib/xmerl/src/xmerl_sax_parser_base.erlsrc | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 2bbe0eea1a..2c5caab07b 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -152,6 +152,7 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '' %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> @@ -1205,6 +1206,7 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- +-dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1716,6 +1718,7 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> -- cgit v1.2.3 From 3270b7f32c71bf8f7637a61a09dd0e9a2dbfc8d1 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 16 Feb 2016 15:51:12 +0100 Subject: xmerl: Remove 'no_return' Dialyzer warnings --- lib/xmerl/src/xmerl_scan.erl | 113 +++++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 53 deletions(-) diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 2bf3172d87..829716dcdb 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -1010,7 +1010,7 @@ scan_optional_version(T,S) -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0) when H >= $"; H =< $' -> ?bump_col(1), @@ -1020,7 +1020,7 @@ scan_enc_name([H|T], S0) when H >= $"; H =< $' -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0, Delim, Acc) when H >= $a, H =< $z -> ?bump_col(1), @@ -1034,7 +1034,7 @@ scan_enc_name([H|_T],S,_Delim,_Acc) -> scan_enc_name2([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name2(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name2([H|T], S0, H, Acc) -> ?bump_col(1), @@ -1058,7 +1058,7 @@ scan_enc_name2([H|T], S0, Delim, Acc) when H == $.; H == $_; H == $- -> scan_xml_vsn([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_xml_vsn(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []). @@ -1066,7 +1066,7 @@ scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> xml_vsn(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); xml_vsn([H|T], S=#xmerl_scanner{col = C}, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = C+1}}; @@ -1089,7 +1089,7 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> @@ -1125,7 +1125,7 @@ scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1152,7 +1152,7 @@ scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1180,7 +1180,7 @@ scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> scan_doctype([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype(T, S) -> {_,T1,S1} = mandatory_strip(T,S), @@ -1194,7 +1194,7 @@ scan_doctype(T, S) -> scan_doctype1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype1("PUBLIC" ++ T, S0) -> ?bump_col(6), @@ -1217,7 +1217,7 @@ scan_doctype1(T, S) -> scan_doctype2([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype2(MoreBytes, S1, DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype2("[" ++ T, S0, DTD) -> ?bump_col(1), @@ -1237,7 +1237,7 @@ scan_doctype2(_T,S,_DTD) -> scan_doctype3([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype3(MoreBytes, S1,DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype3("%" ++ T, S0, DTD) -> ?bump_col(1), @@ -1549,7 +1549,7 @@ scan_decl_sep(T,S) -> scan_conditional_sect([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_conditional_sect(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_conditional_sect("IGNORE" ++ T, S0) -> ?bump_col(6), @@ -1582,7 +1582,7 @@ scan_ignore(Str,S) -> scan_ignore([], S=#xmerl_scanner{continuation_fun = F},Level) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ignore(MoreBytes, S1,Level) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ignore(" %% nested conditional section. Topmost condition is ignore, though @@ -1603,7 +1603,7 @@ scan_ignore([_H|T],S0,Level) -> scan_include([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_include(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_include("]]>" ++ T, S0) -> ?bump_col(3), @@ -1745,7 +1745,7 @@ update_attributes1([],Acc) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(T, S) -> scan_attdef(T, S, _AttrAcc = []). @@ -1754,7 +1754,7 @@ scan_attdef(T, S) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}, Attrs) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1, Attrs) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(">" ++ T, S0, Attrs) -> ?bump_col(1), @@ -1798,7 +1798,7 @@ scan_attdef2(T, S, Attrs) -> scan_att_type([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_type(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_type("CDATA" ++ T, S0) -> ?bump_col(5), @@ -1856,7 +1856,7 @@ scan_att_type("%" ++ T, S0) -> scan_notation_type([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_type(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_type(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1889,7 +1889,7 @@ notation_exists(Name, #xmerl_scanner{rules_read_fun = Read, scan_enumeration([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enumeration(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_enumeration(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1907,7 +1907,7 @@ scan_enumeration("|" ++ T, S0, Acc) -> scan_default_decl([], S=#xmerl_scanner{continuation_fun = F}, Type) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_default_decl(MoreBytes, S1, Type) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_default_decl("#REQUIRED" ++ T, S0, _Type) -> ?bump_col(9), @@ -1936,7 +1936,7 @@ default_value(T, S, Type) -> scan_entity([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity("%" ++ T, #xmerl_scanner{rules_write_fun = Write} = S0) -> %% parameter entity @@ -1974,7 +1974,7 @@ scan_entity_completion(T,S) -> scan_entity_def([], S=#xmerl_scanner{continuation_fun = F}, EName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_def(MoreBytes, S1, EName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_def("'" ++ T, S0, EName) -> ?bump_col(1), @@ -2015,7 +2015,7 @@ scan_entity_def(Str, S, EName) -> scan_ndata_decl([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ndata_decl(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ndata_decl(Str = ">"++_T, S) -> {[], Str, S}; @@ -2062,7 +2062,7 @@ scan_element("/", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element("/" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element([], S=#xmerl_scanner{continuation_fun = F}, Pos, Name, StartL, StartC, Attrs, Lang, Parents, @@ -2071,7 +2071,7 @@ scan_element([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event, @@ -2099,7 +2099,7 @@ scan_element(">", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(">" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element(">" ++ T, S0 = #xmerl_scanner{event_fun = Event, hook_fun = Hook, @@ -2344,7 +2344,7 @@ keyreplaceadd(_K, _Pos, [], Obj) -> scan_att_value([], S=#xmerl_scanner{continuation_fun = F},AT) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_value(MoreBytes, S1, AT) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_value("%"++_T,S=#xmerl_scanner{environment=prolog},_AttType) -> ?fatal({error,{wfc_PEs_In_Internal_Subset}},S); @@ -2385,7 +2385,7 @@ scan_att_chars([],S=#xmerl_scanner{continuation_fun=F},H,Acc,TmpAcc,AT,IsNorm)-> F(fun(MoreBytes, S1) -> scan_att_chars(MoreBytes, S1, H, Acc,TmpAcc,AT,IsNorm) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_chars([H|T], S0, H, Acc, TmpAcc,AttType,IsNorm) -> % End quote ?bump_col(1), @@ -2518,7 +2518,7 @@ scan_content("<", S= #xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content("<" ++ MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content([], S=#xmerl_scanner{environment={external,{entity,_}}}, _Pos, _Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,_) -> @@ -2532,7 +2532,7 @@ scan_content([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content(MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content(" @@ -2636,7 +2636,7 @@ scan_content_markup([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content_markup( MoreBytes,S1,Pos,Name, Attrs,Space,Lang,Parents,NS) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> @@ -2664,7 +2664,7 @@ scan_char_data([], S=#xmerl_scanner{environment=internal_parsed_entity}, scan_char_data([], S=#xmerl_scanner{continuation_fun = F}, Space, _MUD,Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_data(MoreBytes,S1,Space,_MUD,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_data([$&|T], S,Space,"&",Acc) -> scan_char_data(T, S, Space,[], [$&|Acc]); @@ -2716,7 +2716,7 @@ scan_cdata(Str, S, Pos, Parents) -> scan_cdata([], S=#xmerl_scanner{continuation_fun = F}, Pos, Parents, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_cdata(MoreBytes, S1, Pos, Parents, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_cdata("]]>" ++ T, S0, Pos, Parents, Acc) -> ?bump_col(3), @@ -2741,7 +2741,7 @@ scan_cdata(Str, S0, Pos, Parents, Acc) -> scan_reference([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_reference(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_reference("#x" ++ T, S0) -> %% [66] CharRef @@ -2783,7 +2783,7 @@ scan_reference(T, S) -> scan_entity_ref([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_ref(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_ref("amp;" ++ T, S0) -> ?bump_col(4), @@ -2868,7 +2868,7 @@ expand_reference(Name, #xmerl_scanner{rules_read_fun = Read} = S) -> scan_char_ref_dec([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_dec(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_dec([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2883,7 +2883,7 @@ scan_char_ref_dec(";" ++ T, S0, Acc) -> scan_char_ref_hex([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_hex(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_hex([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2957,7 +2957,7 @@ scan_name_no_colons(Str, S) -> scan_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_name(Str = [$:|T], S0 = #xmerl_scanner{namespace_conformant = NSC}) -> if NSC == false -> @@ -3007,7 +3007,7 @@ scan_nmtoken(Str, S, Acc, NSC) -> scan_nmtoken([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_nmtoken(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_nmtoken("%"++T, S0=#xmerl_scanner{environment={external,_}}) -> ?bump_col(1), @@ -3084,7 +3084,7 @@ isLatin1(_,_) -> scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal("\"" ++ T, S) -> scan_system_literal(T, S, $", []); @@ -3096,7 +3096,7 @@ scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3114,7 +3114,7 @@ scan_system_literal(Str, S, Delimiter, Acc) -> scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S) when H == $"; H == $' -> scan_pubid_literal(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []); @@ -3126,7 +3126,7 @@ scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3161,7 +3161,7 @@ is_pubid_char(X) -> scan_contentspec([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_contentspec(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_contentspec("EMPTY" ++ T, S0) -> ?bump_col(5), @@ -3195,7 +3195,7 @@ scan_elem_content([], S=#xmerl_scanner{continuation_fun = F}, Context, Mode, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes,S1) -> scan_elem_content(MoreBytes,S1,Context,Mode,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_elem_content(")" ++ T, S0, Context, Mode0, Acc0) -> ?bump_col(1), @@ -3282,7 +3282,7 @@ format_elem_content(Other) -> Other. scan_occurrence([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_occurrence(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_occurrence([$?|T], S0) -> ?bump_col(1), @@ -3433,7 +3433,7 @@ wfc_whitespace_betw_attrs([$> |_]=L,S) -> wfc_whitespace_betw_attrs([],S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> wfc_whitespace_betw_attrs(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); wfc_whitespace_betw_attrs(_,S) -> ?fatal({whitespace_required_between_attributes},S). @@ -3477,7 +3477,7 @@ vc_Element_valid(_,_) -> scan_pe_def([], S=#xmerl_scanner{continuation_fun = F}, PEName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pe_def(MoreBytes, S1, PEName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pe_def("'" ++ T, S0, PEName) -> ?bump_col(1), @@ -3510,7 +3510,7 @@ scan_notation_decl(T, #xmerl_scanner{rules_write_fun = Write, scan_notation_decl1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_decl1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_decl1("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3536,7 +3536,7 @@ scan_notation_decl1("PUBLIC" ++ T, S0) -> scan_external_id([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_external_id(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_external_id("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3582,7 +3582,7 @@ scan_entity_value([], S=#xmerl_scanner{continuation_fun = F}, scan_entity_value(MoreBytes,S1, Delim,Acc,PEName,Namespace,PENesting) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_value([Delim|T], S=#xmerl_scanner{validation=dtd}, Delim,_Acc,PEName,_NS,PENesting) when length(PENesting) /= 0 -> @@ -3850,7 +3850,7 @@ scan_comment1([], S=#xmerl_scanner{continuation_fun = F}, Pos, Comment, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_comment1(MoreBytes, S1, Pos, Comment, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_comment1("-->" ++ T, S0 = #xmerl_scanner{col = C, event_fun = Event, @@ -4100,6 +4100,13 @@ handle_schema_result({error,Reason},S5) -> %%% Helper functions +-compile({inline, [fatal_fun/1]}). + +-spec fatal_fun(_) -> fun((_) -> no_return()). + +fatal_fun(Reason) -> + fun(S) -> ?fatal(Reason, S) end. + fatal(Reason, S) -> exit({fatal, {Reason, {file,S#xmerl_scanner.filename}, -- cgit v1.2.3 From 03fcb7dabf8861e60ffab4121a909b347bccfec9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 15 Feb 2016 15:33:12 +0100 Subject: Eliminate use of test_server.hrl and test_server_line.hrl As a first step to removing the test_server application as as its own separate application, change the inclusion of test_server.hrl to an inclusion of ct.hrl and remove the inclusion of test_server_line.hrl. --- erts/emulator/test/a_SUITE.erl | 2 +- erts/emulator/test/after_SUITE.erl | 2 +- erts/emulator/test/alloc_SUITE.erl | 2 +- erts/emulator/test/beam_SUITE.erl | 2 +- erts/emulator/test/beam_literals_SUITE.erl | 2 +- erts/emulator/test/bif_SUITE.erl | 2 +- erts/emulator/test/big_SUITE.erl | 2 +- erts/emulator/test/binary_SUITE.erl | 2 +- erts/emulator/test/bs_bit_binaries_SUITE.erl | 2 +- erts/emulator/test/bs_construct_SUITE.erl | 2 +- erts/emulator/test/bs_match_bin_SUITE.erl | 2 +- erts/emulator/test/bs_match_int_SUITE.erl | 2 +- erts/emulator/test/bs_match_misc_SUITE.erl | 2 +- erts/emulator/test/bs_match_tail_SUITE.erl | 2 +- erts/emulator/test/bs_utf_SUITE.erl | 2 +- erts/emulator/test/busy_port_SUITE.erl | 2 +- erts/emulator/test/call_trace_SUITE.erl | 2 +- erts/emulator/test/code_SUITE.erl | 2 +- erts/emulator/test/code_parallel_load_SUITE.erl | 2 +- erts/emulator/test/crypto_SUITE.erl | 2 +- erts/emulator/test/ddll_SUITE.erl | 2 +- erts/emulator/test/decode_packet_SUITE.erl | 2 +- erts/emulator/test/distribution_SUITE.erl | 2 +- erts/emulator/test/driver_SUITE.erl | 2 +- erts/emulator/test/efile_SUITE.erl | 2 +- erts/emulator/test/erl_drv_thread_SUITE.erl | 2 +- erts/emulator/test/erl_link_SUITE.erl | 2 +- erts/emulator/test/erts_debug_SUITE.erl | 2 +- erts/emulator/test/estone_SUITE.erl | 2 +- erts/emulator/test/evil_SUITE.erl | 2 +- erts/emulator/test/exception_SUITE.erl | 2 +- erts/emulator/test/float_SUITE.erl | 2 +- erts/emulator/test/fun_SUITE.erl | 2 +- erts/emulator/test/fun_r13_SUITE.erl | 2 +- erts/emulator/test/gc_SUITE.erl | 2 +- erts/emulator/test/guard_SUITE.erl | 2 +- erts/emulator/test/hash_SUITE.erl | 2 +- erts/emulator/test/hibernate_SUITE.erl | 2 +- erts/emulator/test/ignore_cores.erl | 2 +- erts/emulator/test/list_bif_SUITE.erl | 2 +- erts/emulator/test/match_spec_SUITE.erl | 2 +- erts/emulator/test/message_queue_data_SUITE.erl | 2 +- erts/emulator/test/module_info_SUITE.erl | 2 +- erts/emulator/test/monitor_SUITE.erl | 2 +- erts/emulator/test/nested_SUITE.erl | 2 +- erts/emulator/test/nif_SUITE.erl | 2 +- erts/emulator/test/nif_SUITE_data/nif_mod.erl | 2 +- erts/emulator/test/nif_SUITE_data/tester.erl | 2 +- erts/emulator/test/node_container_SUITE.erl | 2 +- erts/emulator/test/nofrag_SUITE.erl | 2 +- erts/emulator/test/num_bif_SUITE.erl | 2 +- erts/emulator/test/old_mod.erl | 2 +- erts/emulator/test/old_scheduler_SUITE.erl | 2 +- erts/emulator/test/op_SUITE.erl | 2 +- erts/emulator/test/port_SUITE.erl | 2 +- erts/emulator/test/port_bif_SUITE.erl | 2 +- erts/emulator/test/process_SUITE.erl | 2 +- erts/emulator/test/receive_SUITE.erl | 2 +- erts/emulator/test/ref_SUITE.erl | 2 +- erts/emulator/test/register_SUITE.erl | 2 +- erts/emulator/test/save_calls_SUITE.erl | 2 +- erts/emulator/test/scheduler_SUITE.erl | 2 +- erts/emulator/test/send_term_SUITE.erl | 2 +- erts/emulator/test/sensitive_SUITE.erl | 2 +- erts/emulator/test/signal_SUITE.erl | 2 +- erts/emulator/test/smoke_test_SUITE.erl | 2 +- erts/emulator/test/statistics_SUITE.erl | 2 +- erts/emulator/test/system_info_SUITE.erl | 2 +- erts/emulator/test/system_profile_SUITE.erl | 2 +- erts/emulator/test/time_SUITE.erl | 2 +- erts/emulator/test/timer_bif_SUITE.erl | 2 +- erts/emulator/test/trace_SUITE.erl | 2 +- erts/emulator/test/trace_bif_SUITE.erl | 2 +- erts/emulator/test/trace_call_count_SUITE.erl | 2 +- erts/emulator/test/trace_call_time_SUITE.erl | 2 +- erts/emulator/test/trace_local_SUITE.erl | 2 +- erts/emulator/test/trace_meta_SUITE.erl | 2 +- erts/emulator/test/trace_nif_SUITE.erl | 2 +- erts/emulator/test/trace_port_SUITE.erl | 2 +- erts/emulator/test/tuple_SUITE.erl | 2 +- erts/emulator/test/unique_SUITE.erl | 2 +- erts/emulator/test/z_SUITE.erl | 2 +- erts/epmd/test/epmd_SUITE.erl | 2 +- erts/test/erl_print_SUITE.erl | 2 +- erts/test/erlc_SUITE.erl | 2 +- erts/test/erlexec_SUITE.erl | 2 +- erts/test/ethread_SUITE.erl | 2 +- erts/test/ignore_cores.erl | 2 +- erts/test/install_SUITE.erl | 2 +- erts/test/nt_SUITE.erl | 2 +- erts/test/otp_SUITE.erl | 2 +- erts/test/run_erl_SUITE.erl | 2 +- lib/asn1/test/asn1_SUITE.erl | 2 +- lib/asn1/test/asn1_test_lib.erl | 2 +- lib/asn1/test/error_SUITE.erl | 2 +- lib/asn1/test/h323test.erl | 2 +- lib/asn1/test/syntax_SUITE.erl | 2 +- lib/asn1/test/testChoExtension.erl | 2 +- lib/asn1/test/testChoExternal.erl | 2 +- lib/asn1/test/testChoPrim.erl | 2 +- lib/asn1/test/testChoRecursive.erl | 2 +- lib/asn1/test/testChoTypeRefCho.erl | 2 +- lib/asn1/test/testChoTypeRefPrim.erl | 2 +- lib/asn1/test/testChoTypeRefSeq.erl | 2 +- lib/asn1/test/testChoTypeRefSet.erl | 2 +- lib/asn1/test/testChoiceIndefinite.erl | 2 +- lib/asn1/test/testConstraints.erl | 2 +- lib/asn1/test/testContextSwitchingTypes.erl | 2 +- lib/asn1/test/testDER.erl | 2 +- lib/asn1/test/testDeepTConstr.erl | 2 +- lib/asn1/test/testDef.erl | 2 +- lib/asn1/test/testDoubleEllipses.erl | 2 +- lib/asn1/test/testEnumExt.erl | 2 +- lib/asn1/test/testINSTANCE_OF.erl | 2 +- lib/asn1/test/testInfObjectClass.erl | 2 +- lib/asn1/test/testMegaco.erl | 2 +- lib/asn1/test/testMergeCompile.erl | 2 +- lib/asn1/test/testNBAPsystem.erl | 2 +- lib/asn1/test/testOpenTypeImplicitTag.erl | 2 +- lib/asn1/test/testOpt.erl | 2 +- lib/asn1/test/testParamBasic.erl | 2 +- lib/asn1/test/testParameterizedInfObj.erl | 2 +- lib/asn1/test/testPrim.erl | 2 +- lib/asn1/test/testPrimExternal.erl | 2 +- lib/asn1/test/testPrimStrings.erl | 2 +- lib/asn1/test/testRfcs.erl | 2 +- lib/asn1/test/testSSLspecs.erl | 2 +- lib/asn1/test/testSelectionTypes.erl | 2 +- lib/asn1/test/testSeq2738.erl | 2 +- lib/asn1/test/testSeqDefault.erl | 2 +- lib/asn1/test/testSeqExtension.erl | 2 +- lib/asn1/test/testSeqExternal.erl | 2 +- lib/asn1/test/testSeqOf.erl | 2 +- lib/asn1/test/testSeqOfCho.erl | 2 +- lib/asn1/test/testSeqOfExternal.erl | 2 +- lib/asn1/test/testSeqOfIndefinite.erl | 2 +- lib/asn1/test/testSeqOfTag.erl | 2 +- lib/asn1/test/testSeqOptional.erl | 2 +- lib/asn1/test/testSeqPrim.erl | 2 +- lib/asn1/test/testSeqSetDefaultVal.erl | 2 +- lib/asn1/test/testSeqSetIndefinite.erl | 2 +- lib/asn1/test/testSeqTag.erl | 2 +- lib/asn1/test/testSeqTypeRefCho.erl | 2 +- lib/asn1/test/testSeqTypeRefPrim.erl | 2 +- lib/asn1/test/testSeqTypeRefSeq.erl | 2 +- lib/asn1/test/testSeqTypeRefSet.erl | 2 +- lib/asn1/test/testSetDefault.erl | 2 +- lib/asn1/test/testSetExtension.erl | 2 +- lib/asn1/test/testSetExternal.erl | 2 +- lib/asn1/test/testSetOf.erl | 2 +- lib/asn1/test/testSetOfCho.erl | 2 +- lib/asn1/test/testSetOfExternal.erl | 2 +- lib/asn1/test/testSetOfTag.erl | 2 +- lib/asn1/test/testSetPrim.erl | 2 +- lib/asn1/test/testSetTag.erl | 2 +- lib/asn1/test/testSetTypeRefCho.erl | 2 +- lib/asn1/test/testSetTypeRefPrim.erl | 2 +- lib/asn1/test/testSetTypeRefSeq.erl | 2 +- lib/asn1/test/testSetTypeRefSet.erl | 2 +- lib/asn1/test/testTCAP.erl | 2 +- lib/asn1/test/testTimer.erl | 2 +- lib/asn1/test/test_compile_options.erl | 2 +- lib/asn1/test/test_modified_x420.erl | 2 +- lib/asn1/test/test_partial_incomplete_decode.erl | 2 +- lib/asn1/test/test_selective_decode.erl | 2 +- lib/asn1/test/test_special_decode_performance.erl | 2 +- lib/asn1/test/test_undecoded_rest.erl | 2 +- lib/asn1/test/test_x691.erl | 2 +- lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl | 2 +- lib/common_test/test/ct_hooks_SUITE.erl | 2 +- lib/common_test/test/ct_misc_1_SUITE.erl | 1 - lib/common_test/test/ct_test_support_eh.erl | 2 +- lib/compiler/test/andor_SUITE.erl | 2 +- lib/compiler/test/apply_SUITE.erl | 2 +- lib/compiler/test/beam_disasm_SUITE.erl | 2 +- lib/compiler/test/beam_validator_SUITE.erl | 2 +- lib/compiler/test/bs_bincomp_SUITE.erl | 2 +- lib/compiler/test/bs_bit_binaries_SUITE.erl | 2 +- lib/compiler/test/bs_construct_SUITE.erl | 2 +- lib/compiler/test/bs_match_SUITE.erl | 2 +- lib/compiler/test/bs_utf_SUITE.erl | 2 +- lib/compiler/test/compilation_SUITE.erl | 2 +- lib/compiler/test/compile_SUITE.erl | 2 +- lib/compiler/test/core_SUITE.erl | 2 +- lib/compiler/test/core_fold_SUITE.erl | 2 +- lib/compiler/test/error_SUITE.erl | 2 +- lib/compiler/test/float_SUITE.erl | 2 +- lib/compiler/test/fun_SUITE.erl | 2 +- lib/compiler/test/guard_SUITE.erl | 2 +- lib/compiler/test/inline_SUITE.erl | 2 +- lib/compiler/test/lc_SUITE.erl | 2 +- lib/compiler/test/match_SUITE.erl | 2 +- lib/compiler/test/misc_SUITE.erl | 2 +- lib/compiler/test/num_bif_SUITE.erl | 2 +- lib/compiler/test/receive_SUITE.erl | 2 +- lib/compiler/test/record_SUITE.erl | 2 +- lib/compiler/test/regressions_SUITE.erl | 2 +- lib/compiler/test/test_lib.erl | 2 +- lib/compiler/test/trycatch_SUITE.erl | 2 +- lib/compiler/test/warnings_SUITE.erl | 2 +- lib/cosEvent/test/event_channel_SUITE.erl | 2 +- lib/cosEvent/test/generated_SUITE.erl | 2 +- lib/cosEventDomain/test/event_domain_SUITE.erl | 2 +- lib/cosEventDomain/test/generated_SUITE.erl | 2 +- lib/cosFileTransfer/test/fileTransfer_SUITE.erl | 2 +- lib/cosNotification/test/eventDB_SUITE.erl | 2 +- lib/cosNotification/test/generated_SUITE.erl | 2 +- lib/cosNotification/test/grammar_SUITE.erl | 2 +- lib/cosNotification/test/notification_SUITE.erl | 2 +- lib/cosProperty/test/generated_SUITE.erl | 2 +- lib/cosProperty/test/property_SUITE.erl | 2 +- lib/cosTime/test/generated_SUITE.erl | 2 +- lib/cosTime/test/time_SUITE.erl | 2 +- lib/cosTransactions/test/generated_SUITE.erl | 2 +- lib/cosTransactions/test/transactions_SUITE.erl | 2 +- lib/crypto/test/blowfish_SUITE.erl | 3 +-- lib/crypto/test/old_crypto_SUITE.erl | 2 +- lib/debugger/test/andor_SUITE.erl | 2 +- lib/debugger/test/bs_bincomp_SUITE.erl | 2 +- lib/debugger/test/bs_construct_SUITE.erl | 2 +- lib/debugger/test/bs_match_bin_SUITE.erl | 2 +- lib/debugger/test/bs_match_int_SUITE.erl | 2 +- lib/debugger/test/bs_match_misc_SUITE.erl | 2 +- lib/debugger/test/bs_match_tail_SUITE.erl | 2 +- lib/debugger/test/bs_utf_SUITE.erl | 2 +- lib/debugger/test/bug_SUITE.erl | 2 +- lib/debugger/test/cleanup.erl | 2 +- lib/debugger/test/dbg_ui_SUITE.erl | 2 +- lib/debugger/test/debugger_SUITE.erl | 2 +- lib/debugger/test/erl_eval_SUITE.erl | 2 +- lib/debugger/test/exception_SUITE.erl | 2 +- lib/debugger/test/fun_SUITE.erl | 2 +- lib/debugger/test/guard_SUITE.erl | 2 +- lib/debugger/test/int_SUITE.erl | 2 +- lib/debugger/test/int_break_SUITE.erl | 2 +- lib/debugger/test/int_eval_SUITE.erl | 2 +- lib/debugger/test/lc_SUITE.erl | 2 +- lib/debugger/test/line_number_SUITE.erl | 2 +- lib/debugger/test/record_SUITE.erl | 2 +- lib/debugger/test/trycatch_SUITE.erl | 2 +- lib/dialyzer/test/dialyzer_SUITE.erl | 2 +- lib/edoc/test/edoc_SUITE.erl | 2 +- lib/eldap/test/eldap_basic_SUITE.erl | 2 +- lib/erl_interface/test/ei_accept_SUITE.erl | 2 +- lib/erl_interface/test/ei_connect_SUITE.erl | 2 +- lib/erl_interface/test/ei_decode_SUITE.erl | 2 +- lib/erl_interface/test/ei_decode_encode_SUITE.erl | 2 +- lib/erl_interface/test/ei_encode_SUITE.erl | 2 +- lib/erl_interface/test/ei_format_SUITE.erl | 2 +- lib/erl_interface/test/ei_print_SUITE.erl | 2 +- lib/erl_interface/test/ei_tmo_SUITE.erl | 2 +- lib/erl_interface/test/erl_connect_SUITE.erl | 2 +- lib/erl_interface/test/erl_eterm_SUITE.erl | 2 +- lib/erl_interface/test/erl_ext_SUITE.erl | 2 +- lib/erl_interface/test/erl_format_SUITE.erl | 2 +- lib/erl_interface/test/erl_global_SUITE.erl | 2 +- lib/erl_interface/test/erl_match_SUITE.erl | 2 +- lib/erl_interface/test/port_call_SUITE.erl | 2 +- lib/hipe/test/bs_SUITE_data/bs_utf.erl | 2 +- lib/ic/test/ic_SUITE.erl | 2 +- lib/ic/test/ic_be_SUITE.erl | 2 +- lib/ic/test/ic_pp_SUITE.erl | 2 +- lib/ic/test/ic_pragma_SUITE.erl | 2 +- lib/ic/test/ic_register_SUITE.erl | 2 +- lib/ic/test/java_client_erl_server_SUITE.erl | 2 +- lib/inets/test/ftp_format_SUITE.erl | 1 - lib/inets/test/ftp_suite_lib.erl | 4 ++-- lib/inets/test/httpc_cookie_SUITE.erl | 2 +- lib/inets/test/httpd_load.erl | 3 +-- lib/inets/test/httpd_mod.erl | 3 +-- lib/inets/test/old_httpd_SUITE.erl | 3 +-- lib/jinterface/test/jinterface_SUITE.erl | 1 - lib/jinterface/test/nc_SUITE.erl | 1 - lib/kernel/test/application_SUITE.erl | 2 +- lib/kernel/test/bif_SUITE.erl | 2 +- lib/kernel/test/cleanup.erl | 2 +- lib/kernel/test/code_SUITE.erl | 2 +- lib/kernel/test/disk_log_SUITE.erl | 2 +- lib/kernel/test/erl_boot_server_SUITE.erl | 2 +- lib/kernel/test/erl_distribution_SUITE.erl | 2 +- lib/kernel/test/erl_distribution_wb_SUITE.erl | 2 +- lib/kernel/test/erl_prim_loader_SUITE.erl | 2 +- lib/kernel/test/error_logger_SUITE.erl | 2 +- lib/kernel/test/error_logger_warn_SUITE.erl | 2 +- lib/kernel/test/file_SUITE.erl | 2 +- lib/kernel/test/file_name_SUITE.erl | 2 +- lib/kernel/test/gen_sctp_SUITE.erl | 2 +- lib/kernel/test/gen_tcp_echo_SUITE.erl | 2 +- lib/kernel/test/gen_tcp_misc_SUITE.erl | 2 +- lib/kernel/test/gen_udp_SUITE.erl | 2 +- lib/kernel/test/global_SUITE.erl | 2 +- lib/kernel/test/global_group_SUITE.erl | 2 +- lib/kernel/test/heart_SUITE.erl | 2 +- lib/kernel/test/ignore_cores.erl | 2 +- lib/kernel/test/inet_SUITE.erl | 2 +- lib/kernel/test/inet_res_SUITE.erl | 1 - lib/kernel/test/inet_sockopt_SUITE.erl | 2 +- lib/kernel/test/init_SUITE.erl | 2 +- lib/kernel/test/interactive_shell_SUITE.erl | 2 +- lib/kernel/test/kernel_SUITE.erl | 2 +- lib/kernel/test/kernel_config_SUITE.erl | 2 +- lib/kernel/test/os_SUITE.erl | 2 +- lib/kernel/test/pdict_SUITE.erl | 2 +- lib/kernel/test/pg2_SUITE.erl | 2 +- lib/kernel/test/prim_file_SUITE.erl | 2 +- lib/kernel/test/ram_file_SUITE.erl | 2 +- lib/kernel/test/rpc_SUITE.erl | 2 +- lib/kernel/test/seq_trace_SUITE.erl | 2 +- lib/kernel/test/wrap_log_reader_SUITE.erl | 2 +- lib/kernel/test/zlib_SUITE.erl | 2 +- lib/observer/test/crashdump_helper.erl | 2 +- lib/observer/test/crashdump_viewer_SUITE.erl | 1 - lib/observer/test/etop_SUITE.erl | 2 +- lib/observer/test/observer_SUITE.erl | 2 +- lib/observer/test/ttb_SUITE.erl | 2 +- lib/odbc/test/odbc_connect_SUITE.erl | 1 - lib/odbc/test/odbc_data_type_SUITE.erl | 1 - lib/odbc/test/odbc_query_SUITE.erl | 1 - lib/odbc/test/odbc_start_SUITE.erl | 1 - lib/odbc/test/odbc_test_lib.erl | 2 +- lib/orber/test/cdrcoding_10_SUITE.erl | 2 +- lib/orber/test/cdrcoding_11_SUITE.erl | 2 +- lib/orber/test/cdrcoding_12_SUITE.erl | 2 +- lib/orber/test/cdrlib_SUITE.erl | 2 +- lib/orber/test/corba_SUITE.erl | 2 +- lib/orber/test/csiv2_SUITE.erl | 2 +- lib/orber/test/data_types_SUITE.erl | 2 +- lib/orber/test/generated_SUITE.erl | 2 +- lib/orber/test/interceptors_SUITE.erl | 2 +- lib/orber/test/iop_ior_10_SUITE.erl | 2 +- lib/orber/test/iop_ior_11_SUITE.erl | 2 +- lib/orber/test/iop_ior_12_SUITE.erl | 2 +- lib/orber/test/ip_v4v6_interop_SUITE.erl | 2 +- lib/orber/test/lname_SUITE.erl | 2 +- lib/orber/test/multi_ORB_SUITE.erl | 2 +- lib/orber/test/naming_context_SUITE.erl | 2 +- lib/orber/test/orber_SUITE.erl | 2 +- lib/orber/test/orber_acl_SUITE.erl | 2 +- lib/orber/test/orber_firewall_ipv4_in_SUITE.erl | 2 +- lib/orber/test/orber_firewall_ipv4_out_SUITE.erl | 2 +- lib/orber/test/orber_firewall_ipv6_in_SUITE.erl | 2 +- lib/orber/test/orber_firewall_ipv6_out_SUITE.erl | 2 +- lib/orber/test/orber_nat_SUITE.erl | 2 +- lib/orber/test/orber_test_lib.erl | 2 +- lib/orber/test/orber_web_SUITE.erl | 2 +- lib/orber/test/tc_SUITE.erl | 2 +- lib/os_mon/test/cpu_sup_SUITE.erl | 2 +- lib/os_mon/test/disksup_SUITE.erl | 2 +- lib/os_mon/test/memsup_SUITE.erl | 2 +- lib/os_mon/test/os_mon_SUITE.erl | 2 +- lib/os_mon/test/os_mon_mib_SUITE.erl | 2 +- lib/os_mon/test/os_sup_SUITE.erl | 2 +- lib/otp_mibs/test/otp_mibs_SUITE.erl | 2 +- lib/parsetools/test/leex_SUITE.erl | 2 +- lib/parsetools/test/yecc_SUITE.erl | 2 +- lib/percept/test/egd_SUITE.erl | 2 +- lib/percept/test/percept_SUITE.erl | 2 +- lib/percept/test/percept_db_SUITE.erl | 2 +- lib/runtime_tools/test/dbg_SUITE.erl | 2 +- lib/runtime_tools/test/dyntrace_SUITE.erl | 2 +- lib/runtime_tools/test/erts_alloc_config_SUITE.erl | 2 +- lib/runtime_tools/test/runtime_tools_SUITE.erl | 2 +- lib/sasl/test/sasl_report_SUITE.erl | 2 +- lib/snmp/test/exp/snmp_agent_ms_test.erl | 2 +- lib/snmp/test/exp/snmp_agent_mt_test.erl | 2 +- lib/snmp/test/exp/snmp_agent_v1_test.erl | 2 +- lib/snmp/test/exp/snmp_agent_v2_test.erl | 2 +- lib/snmp/test/exp/snmp_agent_v3_test.erl | 2 +- lib/snmp/test/snmp_agent_mibs_test.erl | 2 +- lib/snmp/test/snmp_agent_nfilter_test.erl | 2 +- lib/snmp/test/snmp_agent_test.erl | 2 +- lib/snmp/test/snmp_agent_test_lib.erl | 2 +- lib/snmp/test/snmp_app_test.erl | 2 +- lib/snmp/test/snmp_compiler_test.erl | 2 +- lib/snmp/test/snmp_conf_test.erl | 2 +- lib/snmp/test/snmp_log_test.erl | 2 +- lib/snmp/test/snmp_manager_config_test.erl | 2 +- lib/snmp/test/snmp_manager_test.erl | 2 +- lib/snmp/test/snmp_manager_user.erl | 2 +- lib/snmp/test/snmp_manager_user_old.erl | 2 +- lib/snmp/test/snmp_manager_user_test.erl | 2 +- lib/snmp/test/snmp_manager_user_test_lib.erl | 2 +- lib/stdlib/test/array_SUITE.erl | 2 +- lib/stdlib/test/beam_lib_SUITE.erl | 2 +- lib/stdlib/test/binary_module_SUITE.erl | 2 +- lib/stdlib/test/c_SUITE.erl | 2 +- lib/stdlib/test/calendar_SUITE.erl | 2 +- lib/stdlib/test/dets_SUITE.erl | 2 +- lib/stdlib/test/dict_SUITE.erl | 2 +- lib/stdlib/test/digraph_SUITE.erl | 2 +- lib/stdlib/test/digraph_utils_SUITE.erl | 2 +- lib/stdlib/test/edlin_expand_SUITE.erl | 2 +- lib/stdlib/test/epp_SUITE.erl | 2 +- lib/stdlib/test/erl_anno_SUITE.erl | 4 ++-- lib/stdlib/test/erl_eval_SUITE.erl | 2 +- lib/stdlib/test/erl_expand_records_SUITE.erl | 2 +- lib/stdlib/test/erl_internal_SUITE.erl | 2 +- lib/stdlib/test/erl_lint_SUITE.erl | 2 +- lib/stdlib/test/erl_pp_SUITE.erl | 2 +- lib/stdlib/test/erl_scan_SUITE.erl | 2 +- lib/stdlib/test/error_logger_h_SUITE.erl | 2 +- lib/stdlib/test/escript_SUITE.erl | 2 +- lib/stdlib/test/ets_SUITE.erl | 2 +- lib/stdlib/test/ets_tough_SUITE.erl | 2 +- lib/stdlib/test/file_sorter_SUITE.erl | 2 +- lib/stdlib/test/filelib_SUITE.erl | 2 +- lib/stdlib/test/filename_SUITE.erl | 2 +- lib/stdlib/test/fixtable_SUITE.erl | 2 +- lib/stdlib/test/format_SUITE.erl | 2 +- lib/stdlib/test/gen_event_SUITE.erl | 2 +- lib/stdlib/test/gen_fsm_SUITE.erl | 2 +- lib/stdlib/test/gen_server_SUITE.erl | 2 +- lib/stdlib/test/id_transform_SUITE.erl | 2 +- lib/stdlib/test/io_SUITE.erl | 2 +- lib/stdlib/test/io_proto_SUITE.erl | 2 +- lib/stdlib/test/lists_SUITE.erl | 2 +- lib/stdlib/test/log_mf_h_SUITE.erl | 2 +- lib/stdlib/test/maps_SUITE.erl | 2 +- lib/stdlib/test/ms_transform_SUITE.erl | 2 +- lib/stdlib/test/proc_lib_SUITE.erl | 2 +- lib/stdlib/test/qlc_SUITE.erl | 2 +- lib/stdlib/test/queue_SUITE.erl | 2 +- lib/stdlib/test/rand_SUITE.erl | 2 +- lib/stdlib/test/random_SUITE.erl | 2 +- lib/stdlib/test/re_SUITE.erl | 2 +- lib/stdlib/test/select_SUITE.erl | 2 +- lib/stdlib/test/sets_SUITE.erl | 2 +- lib/stdlib/test/shell_SUITE.erl | 2 +- lib/stdlib/test/slave_SUITE.erl | 2 +- lib/stdlib/test/sofs_SUITE.erl | 2 +- lib/stdlib/test/stdlib_SUITE.erl | 2 +- lib/stdlib/test/string_SUITE.erl | 2 +- lib/stdlib/test/supervisor_bridge_SUITE.erl | 2 +- lib/stdlib/test/sys_SUITE.erl | 2 +- lib/stdlib/test/tar_SUITE.erl | 2 +- lib/stdlib/test/timer_SUITE.erl | 2 +- lib/stdlib/test/timer_simple_SUITE.erl | 2 +- lib/stdlib/test/unicode_SUITE.erl | 2 +- lib/stdlib/test/win32reg_SUITE.erl | 2 +- lib/stdlib/test/y2k_SUITE.erl | 2 +- lib/stdlib/test/zip_SUITE.erl | 3 +-- lib/syntax_tools/test/merl_SUITE.erl | 2 +- lib/syntax_tools/test/syntax_tools_SUITE.erl | 2 +- lib/test_server/doc/src/example_chapter.xml | 2 +- lib/test_server/src/things/distr_startup_SUITE.erl | 2 +- lib/test_server/src/things/mnesia_power_SUITE.erl | 2 +- lib/test_server/src/things/random_kill_SUITE.erl | 2 +- lib/test_server/src/ts_make.erl | 2 +- lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl | 3 +-- .../test/test_server_SUITE_data/test_server_break_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_conf01_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_conf02_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_cover_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_parallel01_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl | 2 +- .../test/test_server_SUITE_data/test_server_skip_SUITE.erl | 3 +-- .../test/test_server_SUITE_data/test_server_unicode_SUITE.erl | 2 +- lib/tools/test/cover_SUITE.erl | 2 +- lib/tools/test/cprof_SUITE.erl | 2 +- lib/tools/test/emem_SUITE.erl | 2 +- lib/tools/test/eprof_SUITE.erl | 2 +- lib/tools/test/fprof_SUITE.erl | 2 +- lib/tools/test/ignore_cores.erl | 2 +- lib/tools/test/instrument_SUITE.erl | 2 +- lib/tools/test/lcnt_SUITE.erl | 2 +- lib/tools/test/make_SUITE.erl | 2 +- lib/tools/test/tools_SUITE.erl | 2 +- lib/tools/test/xref_SUITE.erl | 2 +- lib/xmerl/test/xmerl_SUITE.erl | 2 +- lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl | 2 +- lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl | 2 +- lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl | 2 +- lib/xmerl/test/xmerl_sax_SUITE.erl | 2 +- lib/xmerl/test/xmerl_sax_std_SUITE.erl | 2 +- lib/xmerl/test/xmerl_std_SUITE.erl | 2 +- lib/xmerl/test/xmerl_test_lib.erl | 2 +- lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl | 2 +- lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl | 2 +- lib/xmerl/test/xmerl_xsd_SUITE.erl | 2 +- lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl | 2 +- lib/xmerl/test/xmerl_xsd_lib.erl | 2 +- 481 files changed, 473 insertions(+), 490 deletions(-) diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 16f060fe34..a9bba9548b 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -27,7 +27,7 @@ %%%------------------------------------------------------------------- -module(a_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]). diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index 5017a83185..879fb03927 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -22,7 +22,7 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 516bc873a5..332e2ad67d 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -36,7 +36,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 706a4a1c16..499b05d658 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -28,7 +28,7 @@ -export([applied/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 9f14ca26e5..29c6a5c7ac 100644 --- a/erts/emulator/test/beam_literals_SUITE.erl +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -28,7 +28,7 @@ put_list/1, fconv/1, literal_case_expression/1, increment/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index ebc4db53c4..9bba5387fa 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -20,7 +20,7 @@ -module(bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index e8f881f2a4..bb77235253 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -34,7 +34,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index f8f71efecc..c5e3226a13 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -40,7 +40,7 @@ %% phash2(Binary, N) %% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl index a07fd7609c..0896fad8ed 100644 --- a/erts/emulator/test/bs_bit_binaries_SUITE.erl +++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl @@ -30,7 +30,7 @@ big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1,append/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 7ed99f5b4e..1fa7353252 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -31,7 +31,7 @@ copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl index ba79643e69..2185e43498 100644 --- a/erts/emulator/test/bs_match_bin_SUITE.erl +++ b/erts/emulator/test/bs_match_bin_SUITE.erl @@ -24,7 +24,7 @@ init_per_group/2,end_per_group/2, byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index 368f71978d..48c2b4644e 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -24,7 +24,7 @@ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [seq/2]). diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index e875dc859c..b161d9544e 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -27,7 +27,7 @@ writable_binary_matched/1,otp_7198/1,unordered_bindings/1, float_middle_endian/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl index 58b0d3fef6..baa86e6d4a 100644 --- a/erts/emulator/test/bs_match_tail_SUITE.erl +++ b/erts/emulator/test/bs_match_tail_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 0625c22163..91e4e30dd2 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -28,7 +28,7 @@ utf32_illegal_sequences/1, bad_construction/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 6a2588aadd..0e81141907 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -29,7 +29,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Internal exports. -export([init/2]). diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 064404a038..b9f8fe52f3 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -39,7 +39,7 @@ -export([abbr/1,abbr/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(P, 20). diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 1acc4538fb..3d2cc000a8 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -30,7 +30,7 @@ t_copy_literals/1]). -define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl index b7ac0420cd..3998d27d04 100644 --- a/erts/emulator/test/code_parallel_load_SUITE.erl +++ b/erts/emulator/test/code_parallel_load_SUITE.erl @@ -39,7 +39,7 @@ -define(passes, 4). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl index 3622592586..41fe6a226c 100644 --- a/erts/emulator/test/crypto_SUITE.erl +++ b/erts/emulator/test/crypto_SUITE.erl @@ -20,7 +20,7 @@ -module(crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl index cabd6472d4..7ff727bcf5 100644 --- a/erts/emulator/test/ddll_SUITE.erl +++ b/erts/emulator/test/ddll_SUITE.erl @@ -52,7 +52,7 @@ -import(ordsets, [subtract/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 65ae94d0dc..58a8d390f0 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -22,7 +22,7 @@ -module(decode_packet_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index d71cedbdc5..7a33dbbb36 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -33,7 +33,7 @@ %% Tests distribution and the tcp driver. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index ce55fe3c52..8eb555a5b7 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -86,7 +86,7 @@ -export([bin_prefix/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % First byte in communication with the timer driver diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index 4d8d89db9b..cb26e8e736 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -24,7 +24,7 @@ -export([do_iter_max_files/2, do_async_dist/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl index 2cd569ce4f..26d00db7c0 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE.erl +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -25,7 +25,7 @@ -export([basic/1, rwlock/1, tsd/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index a7a45046ca..56b2c9c6ee 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -29,7 +29,7 @@ -author('rickard.green@uab.ericsson.se'). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index bbba829501..440a7950a6 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -19,7 +19,7 @@ %% -module(erts_debug_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index dc8f0aaee9..7be55eca8d 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -46,7 +46,7 @@ run_micro/3,p1/1,ppp/3,macro/2,micros/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). %% Test suite defines diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index d28e4d9596..77ee2128b6 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -33,7 +33,7 @@ decode_pos_neg_zero/1 ]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 11caea3698..57ce8fb879 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -29,7 +29,7 @@ -export([bad_guy/2]). -export([crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foreach/2]). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 8826026f88..bf557f2bca 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -20,7 +20,7 @@ -module(float_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index b18f9f5c6b..6697a86fc5 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -35,7 +35,7 @@ -export([nothing/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl index 7ab5e65cb3..39e8b3c324 100644 --- a/erts/emulator/test/fun_r13_SUITE.erl +++ b/erts/emulator/test/fun_r13_SUITE.erl @@ -26,7 +26,7 @@ init_per_testcase/2,end_per_testcase/2,dist_old_release/1]). -define(default_timeout, ?t:minutes(1)). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 1e155e7b09..cb000fd45f 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -22,7 +22,7 @@ -module(gc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index b3a85c6423..2e03983c4f 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -25,7 +25,7 @@ test_heap_guards/1, guard_bifs/1, type_tests/1,guard_bif_binary_part/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/3]). -import(lists, [member/2]). diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 1b2acf48e1..31b10158fb 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -50,7 +50,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 4ac8c272db..5138a6ee05 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -20,7 +20,7 @@ -module(hibernate_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl index 13f34cd10f..e40b91392c 100644 --- a/erts/emulator/test/ignore_cores.erl +++ b/erts/emulator/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 9e930822cf..544f9c9c1f 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -19,7 +19,7 @@ %% -module(list_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 3f986ca2ed..9e724bdd8c 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -39,7 +39,7 @@ % This test suite assumes that tracing in general works. What we test is % the match spec functionality. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl index 11481409aa..96c41a57b5 100644 --- a/erts/emulator/test/message_queue_data_SUITE.erl +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -27,7 +27,7 @@ -export([basic_test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(2)), diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index 7c2101ca05..c622a2d8d7 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -20,7 +20,7 @@ -module(module_info_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index 4db17969c0..8101908df1 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -20,7 +20,7 @@ -module(monitor_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl index 7cfa837ee5..ee6bbf6a55 100644 --- a/erts/emulator/test/nested_SUITE.erl +++ b/erts/emulator/test/nested_SUITE.erl @@ -24,7 +24,7 @@ init_per_group/2,end_per_group/2, case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index b02a090103..eecce3a6a8 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -24,7 +24,7 @@ -define(CHECK(Exp,Got), check(Exp,Got,?LINE)). %%-define(CHECK(Exp,Got), ?line Exp = Got). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl index e65d4577c7..aa3c90fe9d 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -20,7 +20,7 @@ -module(nif_mod). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0, get_priv_data_ptr/0, make_new_resource/2, get_resource/2]). diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl index b393e29b82..32b9ef1826 100644 --- a/erts/emulator/test/nif_SUITE_data/tester.erl +++ b/erts/emulator/test/nif_SUITE_data/tester.erl @@ -1,6 +1,6 @@ -module(tester). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([load_nif_lib/2, run/0]). diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index fecaad5232..dcd0428e65 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -30,7 +30,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index 3660a58c56..caa2d30a6c 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -20,7 +20,7 @@ -module(nofrag_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index d0840fe731..04a6f9d18d 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -20,7 +20,7 @@ -module(num_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests the BIFs: %% abs/1 diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl index 1586a024d8..e714a75954 100644 --- a/erts/emulator/test/old_mod.erl +++ b/erts/emulator/test/old_mod.erl @@ -23,7 +23,7 @@ -export([sort_on_old_node/1, sorter/3]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). sorter(Receiver, Ref, List) -> Receiver ! {Ref, lists:sort(List)}. diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index 97c99fe07b..272131cb46 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -20,7 +20,7 @@ -module(old_scheduler_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index 65a5a4c505..4e15b27231 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -20,7 +20,7 @@ -module(op_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index ff75ee86d6..5274da301a 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -102,7 +102,7 @@ -export([otp_3906_forker/5, otp_3906_start_forker_starter/4]). -export([env_slave_main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index 981899b167..9215d7f720 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -32,7 +32,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index bfd1e78bf0..862fe78b85 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -26,7 +26,7 @@ %% process_info/1,2 %% register/2 (partially) --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(heap_binary_size, 64). diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index ccae0df72e..635c3d27c5 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -22,7 +22,7 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index 1042c23d65..6d4a998094 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -27,7 +27,7 @@ -export([loop_ref/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(2)), diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl index 5ecca0f547..53bf02e085 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -23,7 +23,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index 810bc07eed..b40a5f0a56 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -20,7 +20,7 @@ -module(save_calls_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0, init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 986a73ebb1..b56b6f6dbf 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -31,7 +31,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 670865cd3f..63c11519b8 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -26,7 +26,7 @@ -export([generate_external_terms_files/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index 2e51712737..29517cdcb8 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -20,7 +20,7 @@ -module(sensitive_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 4aa690fb0f..e176fe52d6 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -31,7 +31,7 @@ -define(DEFAULT_TIMEOUT_SECONDS, 120). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 5bb98e5ad9..2df19cd20b 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -20,7 +20,7 @@ -module(smoke_test_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index aab3d3e3d2..df96b018a1 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -38,7 +38,7 @@ -export([hog/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_, Config) -> ?line Dog = test_server:timetrap(test_server:seconds(300)), diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 51122e5d55..ae18b280cf 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -31,7 +31,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index 6e85f8c54e..c63a119f9d 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -37,7 +37,7 @@ -export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 9bf3b90d91..f6f99a0c81 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -48,7 +48,7 @@ -export([local_to_univ_utc/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([linear_time/1]). diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index 51d59f09f3..f4615d6810 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -33,7 +33,7 @@ % same_time_yielding_with_cancel_other_accessor/1, auto_cancel_yielding/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated -define(TIMEOUT_YIELD_LIMIT, 100). diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 00b90e3c3d..02c2c7a93a 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -38,7 +38,7 @@ system_monitor_long_schedule/1, bad_flag/1, trace_delivered/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%% Internal exports -export([process/1]). diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 96b7dd159f..ae98cc7189 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -20,7 +20,7 @@ -module(trace_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl index c7881bbd70..e358791f1f 100644 --- a/erts/emulator/test/trace_call_count_SUITE.erl +++ b/erts/emulator/test/trace_call_count_SUITE.erl @@ -43,7 +43,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index f359e1bd80..a802aa12b8 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -58,7 +58,7 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% When run in test server. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 7431099340..503a773545 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -46,7 +46,7 @@ -export([config/2]). -define(DEFAULT_RECEIVE_TIMEOUT, 1000). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_RECEIVE_TIMEOUT, infinity). -endif. diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 3b105ec6fe..8f732f0a5f 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -46,7 +46,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl index 1cd50350e3..3ac891b1dd 100644 --- a/erts/emulator/test/trace_nif_SUITE.erl +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -20,7 +20,7 @@ -module(trace_nif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index a77710205e..b169a264be 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -38,7 +38,7 @@ default_tracer/1, tracer_port_crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test_cases() -> [call_trace, return_trace, send, receive_trace, diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index f1f077be6b..2c2f93e7ee 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -26,7 +26,7 @@ t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1, t_append_element/1, t_append_element_upper_boundry/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests tuples and the BIFs: %% diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl index 6fa634b886..7b8d1492b9 100644 --- a/erts/emulator/test/unique_SUITE.erl +++ b/erts/emulator/test/unique_SUITE.erl @@ -26,7 +26,7 @@ -export([unique_monotonic_integer_white_box/1, unique_integer_white_box/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-define(P(V), V). -define(P(V), print_ret_val(?FILE, ?LINE, V)). diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index abc353fb01..0037a9a477 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -30,7 +30,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index 4de65500e9..0c8f01ef6b 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(epmd_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index 3b0c083702..f0fee49024 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -40,7 +40,7 @@ -export([erlang_display/1, integer/1, float/1, string/1, character/1, snprintf/1, quote/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index c21064fd3f..7e44be1fe0 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -27,7 +27,7 @@ compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1, make_dep_options/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 9279872d25..6440cbf0d7 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -38,7 +38,7 @@ -export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) -> diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 388af66b23..8ad2a32278 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -51,7 +51,7 @@ atomic/1, dw_atomic_massage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). tests() -> [create_join_thread, diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl index 13f34cd10f..e40b91392c 100644 --- a/erts/test/ignore_cores.erl +++ b/erts/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index b380b064bd..d6df1aab6b 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -52,7 +52,7 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(1)). -define(JOIN(A,B,C), filename:join(A, B, C)). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record(inst, {mkdirs = true, symlinks = true, diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index dbae8df7fe..1ddaaaaeb5 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -20,7 +20,7 @@ %%% Purpose: Test NT specific utilities -module(nt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 87d620b180..6777c205b0 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -27,7 +27,7 @@ call_to_size_1/1,call_to_now_0/1,strong_components/1, erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [filter/2,foldl/3,foreach/2]). diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index 6759d41a2b..e3c563d3d9 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -26,7 +26,7 @@ basic/1,heavy/1,heavier/1,defunct/1]). -export([ping_me_back/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?t:minutes(2)), diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index ce87fd3180..d392055458 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -28,7 +28,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%------------------------------------------------------------------------------ %% Suite definition diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index ae2e5641ec..dbb2600b41 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -26,7 +26,7 @@ parallel/0, roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). run_dialyzer() -> false. diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index a3413d1b3d..caae845592 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -27,7 +27,7 @@ object_sets/1,parameterization/1, syntax/1,table_constraints/1,tags/1,values/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks, [ts_install_cth]}]. diff --git a/lib/asn1/test/h323test.erl b/lib/asn1/test/h323test.erl index 39097a9330..566abd9714 100644 --- a/lib/asn1/test/h323test.erl +++ b/lib/asn1/test/h323test.erl @@ -21,7 +21,7 @@ -module(h323test). -export([run/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). run(per) -> run(); run(_Rules) -> ok. diff --git a/lib/asn1/test/syntax_SUITE.erl b/lib/asn1/test/syntax_SUITE.erl index 2c23416433..a354b75062 100644 --- a/lib/asn1/test/syntax_SUITE.erl +++ b/lib/asn1/test/syntax_SUITE.erl @@ -33,7 +33,7 @@ types/1, values/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks, [ts_install_cth]}]. diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl index 33515403d1..f4dc00b33c 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -22,7 +22,7 @@ -export([extension/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). extension(_Rules) -> diff --git a/lib/asn1/test/testChoExternal.erl b/lib/asn1/test/testChoExternal.erl index 980b837475..fd9bcf4406 100644 --- a/lib/asn1/test/testChoExternal.erl +++ b/lib/asn1/test/testChoExternal.erl @@ -21,7 +21,7 @@ -module(testChoExternal). -export([external/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). external(_Rules) -> diff --git a/lib/asn1/test/testChoPrim.erl b/lib/asn1/test/testChoPrim.erl index abf3fcdb81..14518285aa 100644 --- a/lib/asn1/test/testChoPrim.erl +++ b/lib/asn1/test/testChoPrim.erl @@ -23,7 +23,7 @@ -export([bool/1]). -export([int/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). bool(Rules) -> roundtrip('ChoCon', {bool0,true}), diff --git a/lib/asn1/test/testChoRecursive.erl b/lib/asn1/test/testChoRecursive.erl index a307d448ed..040aeabe48 100644 --- a/lib/asn1/test/testChoRecursive.erl +++ b/lib/asn1/test/testChoRecursive.erl @@ -23,7 +23,7 @@ -export([recursive/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoRec_something',{a, b, c}). -record('ChoRec2_something',{a, b, c}). diff --git a/lib/asn1/test/testChoTypeRefCho.erl b/lib/asn1/test/testChoTypeRefCho.erl index 378a43fa59..b0a9fd68bd 100644 --- a/lib/asn1/test/testChoTypeRefCho.erl +++ b/lib/asn1/test/testChoTypeRefCho.erl @@ -22,7 +22,7 @@ -export([choice/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). choice(_Rules) -> roundtrip('ChoTRcho', {choCho,{choInt,88}}), diff --git a/lib/asn1/test/testChoTypeRefPrim.erl b/lib/asn1/test/testChoTypeRefPrim.erl index 3541277674..59d23a8683 100644 --- a/lib/asn1/test/testChoTypeRefPrim.erl +++ b/lib/asn1/test/testChoTypeRefPrim.erl @@ -22,7 +22,7 @@ -export([prim/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). prim(_Rules) -> roundtrip('ChoTR', {bool,true}), diff --git a/lib/asn1/test/testChoTypeRefSeq.erl b/lib/asn1/test/testChoTypeRefSeq.erl index c582d6f0fc..87c94fc888 100644 --- a/lib/asn1/test/testChoTypeRefSeq.erl +++ b/lib/asn1/test/testChoTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([seq/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoSeq', {seqInt, seqOs}). -record('ChoSeqImp', {seqInt, seqOs}). diff --git a/lib/asn1/test/testChoTypeRefSet.erl b/lib/asn1/test/testChoTypeRefSet.erl index 2d4f6cce4b..d2ff48af91 100644 --- a/lib/asn1/test/testChoTypeRefSet.erl +++ b/lib/asn1/test/testChoTypeRefSet.erl @@ -22,7 +22,7 @@ -export([set/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('ChoSet', {setInt, setOs}). -record('ChoSetImp', {setInt, setOs}). diff --git a/lib/asn1/test/testChoiceIndefinite.erl b/lib/asn1/test/testChoiceIndefinite.erl index d796871620..f5ae3ff882 100644 --- a/lib/asn1/test/testChoiceIndefinite.erl +++ b/lib/asn1/test/testChoiceIndefinite.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(per) -> ok; main(ber) -> diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 60b7994929..7da3ea3d38 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -23,7 +23,7 @@ -export([int_constraints/1,refed_NNL_name/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). int_constraints(Rules) -> diff --git a/lib/asn1/test/testContextSwitchingTypes.erl b/lib/asn1/test/testContextSwitchingTypes.erl index f1af6cf0e5..3779f61f2f 100644 --- a/lib/asn1/test/testContextSwitchingTypes.erl +++ b/lib/asn1/test/testContextSwitchingTypes.erl @@ -22,7 +22,7 @@ -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> ValT_1 = 'ContextSwitchingTypes':'val1-T'(), diff --git a/lib/asn1/test/testDER.erl b/lib/asn1/test/testDER.erl index 195d8fe5a4..edaaa12eba 100644 --- a/lib/asn1/test/testDER.erl +++ b/lib/asn1/test/testDER.erl @@ -22,7 +22,7 @@ -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> Val = {'Set',12,{version,214},true}, diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl index 50291bf645..ed37df7204 100644 --- a/lib/asn1/test/testDeepTConstr.erl +++ b/lib/asn1/test/testDeepTConstr.erl @@ -24,7 +24,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Erule) -> Val1 = {substrings, diff --git a/lib/asn1/test/testDef.erl b/lib/asn1/test/testDef.erl index c07665d097..5fa5711473 100644 --- a/lib/asn1/test/testDef.erl +++ b/lib/asn1/test/testDef.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Def1',{bool0, bool1 = asn1_DEFAULT, diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl index 8dcd979d6a..4a054a14ed 100644 --- a/lib/asn1/test/testDoubleEllipses.erl +++ b/lib/asn1/test/testDoubleEllipses.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq',{a, c}). -record('SeqV1',{a, b}). diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index 122d198205..057fcb694b 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(Rule) when Rule =:= per; Rule =:= uper -> io:format("main(~p)~n",[Rule]), diff --git a/lib/asn1/test/testINSTANCE_OF.erl b/lib/asn1/test/testINSTANCE_OF.erl index afff05a4c5..b9079d8e95 100644 --- a/lib/asn1/test/testINSTANCE_OF.erl +++ b/lib/asn1/test/testINSTANCE_OF.erl @@ -21,7 +21,7 @@ -module(testINSTANCE_OF). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Erule) -> Int = roundtrip('Int', 3), diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl index 271be63fc8..a7d0f2b6bd 100644 --- a/lib/asn1/test/testInfObjectClass.erl +++ b/lib/asn1/test/testInfObjectClass.erl @@ -24,7 +24,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(Rule) -> %% this test is added for OTP-4591, to test that elements in decoded diff --git a/lib/asn1/test/testMegaco.erl b/lib/asn1/test/testMegaco.erl index b1b1c866be..61794ec02d 100644 --- a/lib/asn1/test/testMegaco.erl +++ b/lib/asn1/test/testMegaco.erl @@ -23,7 +23,7 @@ -export([compile/3,main/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Erule, Options) -> asn1_test_lib:compile("MEDIA-GATEWAY-CONTROL.asn", Config, [Erule|Options]), diff --git a/lib/asn1/test/testMergeCompile.erl b/lib/asn1/test/testMergeCompile.erl index 6bf7aaa1d6..5011c7d576 100644 --- a/lib/asn1/test/testMergeCompile.erl +++ b/lib/asn1/test/testMergeCompile.erl @@ -23,7 +23,7 @@ -export([main/1,mvrasn/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('InitiatingMessage',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{protocolIEs,protocolExtensions}). diff --git a/lib/asn1/test/testNBAPsystem.erl b/lib/asn1/test/testNBAPsystem.erl index e0eeb9fe0c..2a7e39597a 100644 --- a/lib/asn1/test/testNBAPsystem.erl +++ b/lib/asn1/test/testNBAPsystem.erl @@ -22,7 +22,7 @@ -export([compile/2,test/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('InitiatingMessage',{ procedureID, criticality, messageDiscriminator, transactionID, value}). diff --git a/lib/asn1/test/testOpenTypeImplicitTag.erl b/lib/asn1/test/testOpenTypeImplicitTag.erl index 01e0a5e07f..fc2f2a81e6 100644 --- a/lib/asn1/test/testOpenTypeImplicitTag.erl +++ b/lib/asn1/test/testOpenTypeImplicitTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main(_Rules) -> roundtrip('Seq', {'Seq',<<1,1,255>>,<<1,1,255>>,12,<<1,1,255>>}), diff --git a/lib/asn1/test/testOpt.erl b/lib/asn1/test/testOpt.erl index 1f96331966..a15aa28f02 100644 --- a/lib/asn1/test/testOpt.erl +++ b/lib/asn1/test/testOpt.erl @@ -21,7 +21,7 @@ -module(testOpt). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Opt1',{bool0, bool1 = asn1_NOVALUE, diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index f4a696ff38..768c5ad2fa 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('T11',{number, string=asn1_DEFAULT}). -record('T12',{number, string=asn1_DEFAULT}). diff --git a/lib/asn1/test/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index 592dc693f0..8b0353522d 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -23,7 +23,7 @@ -export([main/2,param/1,ranap/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('AllocationOrRetentionPriority',{priorityLevel,iE_Extensions}). -record('ProtocolExtensionField',{id,criticality,extensionValue}). diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index dc2e0fa2e7..82da953ca1 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -28,7 +28,7 @@ -export([null/1]). -export([real/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). bool(Rules) -> Types = ['Bool','BoolCon','BoolPri','BoolApp', diff --git a/lib/asn1/test/testPrimExternal.erl b/lib/asn1/test/testPrimExternal.erl index 56252241d4..79c8a3a045 100644 --- a/lib/asn1/test/testPrimExternal.erl +++ b/lib/asn1/test/testPrimExternal.erl @@ -22,7 +22,7 @@ -export([external/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). external(_Rules) -> Types = ['NT', diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index c9217d60fa..042b1757ba 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -33,7 +33,7 @@ -export([utf8_string/1]). -export([fragmented/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). fragmented(Rules) -> Lens = fragmented_lengths(), diff --git a/lib/asn1/test/testRfcs.erl b/lib/asn1/test/testRfcs.erl index 20eaee9982..fa4389b904 100644 --- a/lib/asn1/test/testRfcs.erl +++ b/lib/asn1/test/testRfcs.erl @@ -23,7 +23,7 @@ -export([compile/3,test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Erules, Options0) -> Options = [no_ok_wrapper|Options0], diff --git a/lib/asn1/test/testSSLspecs.erl b/lib/asn1/test/testSSLspecs.erl index 9e51021ad2..7dc7eedd50 100644 --- a/lib/asn1/test/testSSLspecs.erl +++ b/lib/asn1/test/testSSLspecs.erl @@ -23,7 +23,7 @@ -export([compile/2,run/1,compile_combined/2,run_combined/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Options) -> DataDir = ?config(data_dir, Config), diff --git a/lib/asn1/test/testSelectionTypes.erl b/lib/asn1/test/testSelectionTypes.erl index d33cfcc694..7039f6da4e 100644 --- a/lib/asn1/test/testSelectionTypes.erl +++ b/lib/asn1/test/testSelectionTypes.erl @@ -21,7 +21,7 @@ -module(testSelectionTypes). -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> ["Es"] = Val2 = ['SelectionType':einsteinium()], diff --git a/lib/asn1/test/testSeq2738.erl b/lib/asn1/test/testSeq2738.erl index 3c9e4a744e..a75d058259 100644 --- a/lib/asn1/test/testSeq2738.erl +++ b/lib/asn1/test/testSeq2738.erl @@ -21,7 +21,7 @@ -module(testSeq2738). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqOptFake',{int, opt = asn1_NOVALUE}). -record('OptSeqFake',{bool = false}). diff --git a/lib/asn1/test/testSeqDefault.erl b/lib/asn1/test/testSeqDefault.erl index db0914bf0a..ac3cf202b7 100644 --- a/lib/asn1/test/testSeqDefault.erl +++ b/lib/asn1/test/testSeqDefault.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqDef1',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}). -record('SeqDef1Imp',{bool1 = asn1_DEFAULT, int1, seq1 = asn1_DEFAULT}). diff --git a/lib/asn1/test/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index 6b49b29047..a84b6fb27c 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/3]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqExt1',{}). -record('SeqExt2',{bool, int}). diff --git a/lib/asn1/test/testSeqExternal.erl b/lib/asn1/test/testSeqExternal.erl index a48794924f..9ad2c03208 100644 --- a/lib/asn1/test/testSeqExternal.erl +++ b/lib/asn1/test/testSeqExternal.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqXSet1',{set, bool, int}). -record('SeqXSet2',{bool, set, int}). diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 898b8c1e15..f4a4181f51 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq1',{bool1, int1, seq1 = asn1_DEFAULT}). -record('Seq2',{seq2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSeqOfCho.erl b/lib/asn1/test/testSeqOfCho.erl index 82ac56ac50..7bd1ce7aa6 100644 --- a/lib/asn1/test/testSeqOfCho.erl +++ b/lib/asn1/test/testSeqOfCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqChoDef',{bool1, int1, seq1 = asn1_DEFAULT}). -record('SeqChoOpt',{bool1, int1, seq1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSeqOfExternal.erl b/lib/asn1/test/testSeqOfExternal.erl index 560fdecb64..de95e081d5 100644 --- a/lib/asn1/test/testSeqOfExternal.erl +++ b/lib/asn1/test/testSeqOfExternal.erl @@ -21,7 +21,7 @@ -module(testSeqOfExternal). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('NT',{os, bool}). diff --git a/lib/asn1/test/testSeqOfIndefinite.erl b/lib/asn1/test/testSeqOfIndefinite.erl index 4a0101834a..bebd516c5c 100644 --- a/lib/asn1/test/testSeqOfIndefinite.erl +++ b/lib/asn1/test/testSeqOfIndefinite.erl @@ -22,7 +22,7 @@ -export([main/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main() -> ?line ok = test(isd), diff --git a/lib/asn1/test/testSeqOfTag.erl b/lib/asn1/test/testSeqOfTag.erl index 55f807199f..cacbc85093 100644 --- a/lib/asn1/test/testSeqOfTag.erl +++ b/lib/asn1/test/testSeqOfTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). diff --git a/lib/asn1/test/testSeqOptional.erl b/lib/asn1/test/testSeqOptional.erl index db615d6e4d..92b49e9c0d 100644 --- a/lib/asn1/test/testSeqOptional.erl +++ b/lib/asn1/test/testSeqOptional.erl @@ -23,7 +23,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqOpt1',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}). -record('SeqOpt1Imp',{bool1 = asn1_NOVALUE, int1, seq1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl index 6af0ce9287..5872902ce7 100644 --- a/lib/asn1/test/testSeqPrim.erl +++ b/lib/asn1/test/testSeqPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}). -record('Empty',{}). diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index 86ab07a4a8..1c41f64078 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -22,7 +22,7 @@ -export([main/2]). -include("External.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqInts',{a = asn1_DEFAULT, b = asn1_DEFAULT, diff --git a/lib/asn1/test/testSeqSetIndefinite.erl b/lib/asn1/test/testSeqSetIndefinite.erl index 8948e10ece..41e09f7796 100644 --- a/lib/asn1/test/testSeqSetIndefinite.erl +++ b/lib/asn1/test/testSeqSetIndefinite.erl @@ -21,7 +21,7 @@ -module(testSeqSetIndefinite). -export([main/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). main() -> seq_indefinite(), diff --git a/lib/asn1/test/testSeqTag.erl b/lib/asn1/test/testSeqTag.erl index baa79ed428..6959e2f7e2 100644 --- a/lib/asn1/test/testSeqTag.erl +++ b/lib/asn1/test/testSeqTag.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SeqTag',{nt, imp, exp}). diff --git a/lib/asn1/test/testSeqTypeRefCho.erl b/lib/asn1/test/testSeqTypeRefCho.erl index 372be0c637..4a9ba53291 100644 --- a/lib/asn1/test/testSeqTypeRefCho.erl +++ b/lib/asn1/test/testSeqTypeRefCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SeqTRcho',{seqCho, seqChoE, 'seqCho-E', 'seqChoE-E'}). diff --git a/lib/asn1/test/testSeqTypeRefPrim.erl b/lib/asn1/test/testSeqTypeRefPrim.erl index 42554e758e..e0c3277156 100644 --- a/lib/asn1/test/testSeqTypeRefPrim.erl +++ b/lib/asn1/test/testSeqTypeRefPrim.erl @@ -21,7 +21,7 @@ -module(testSeqTypeRefPrim). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}). diff --git a/lib/asn1/test/testSeqTypeRefSeq.erl b/lib/asn1/test/testSeqTypeRefSeq.erl index ee30937af5..befbe5f457 100644 --- a/lib/asn1/test/testSeqTypeRefSeq.erl +++ b/lib/asn1/test/testSeqTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Seq1',{bool1, int1, seq1}). -record('Seq2',{seq2, bool2, int2}). diff --git a/lib/asn1/test/testSeqTypeRefSet.erl b/lib/asn1/test/testSeqTypeRefSet.erl index ba690b4503..48c94a8b06 100644 --- a/lib/asn1/test/testSeqTypeRefSet.erl +++ b/lib/asn1/test/testSeqTypeRefSet.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SeqTRset',{seqSet, seqSetI, seqSetE, 'seqSet-I', 'seqSetI-I', 'seqSetE-I', 'seqSet-E', 'seqSetI-E', 'seqSetE-E'}). -record('SeqSet',{setInt, setOs}). diff --git a/lib/asn1/test/testSetDefault.erl b/lib/asn1/test/testSetDefault.erl index 4e34c01a52..e91a526add 100644 --- a/lib/asn1/test/testSetDefault.erl +++ b/lib/asn1/test/testSetDefault.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetDef1',{bool1 = asn1_DEFAULT, int1, set1 = asn1_DEFAULT}). -record('SetDef2',{set2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSetExtension.erl b/lib/asn1/test/testSetExtension.erl index 67977a2a31..89f27a7fef 100644 --- a/lib/asn1/test/testSetExtension.erl +++ b/lib/asn1/test/testSetExtension.erl @@ -22,7 +22,7 @@ -include("External.hrl"). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetExt1',{}). -record('SetExt2',{bool, int}). diff --git a/lib/asn1/test/testSetExternal.erl b/lib/asn1/test/testSetExternal.erl index e265cf1f3e..f5d01e23a8 100644 --- a/lib/asn1/test/testSetExternal.erl +++ b/lib/asn1/test/testSetExternal.erl @@ -22,7 +22,7 @@ -export([main/1]). -include("External.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetXSeq1',{seq, bool, int}). -record('SetXSeq2',{bool, seq, int}). diff --git a/lib/asn1/test/testSetOf.erl b/lib/asn1/test/testSetOf.erl index 4ff90676aa..02009dc8d5 100644 --- a/lib/asn1/test/testSetOf.erl +++ b/lib/asn1/test/testSetOf.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set1',{bool1, int1, set1 = asn1_DEFAULT}). -record('Set2',{set2 = asn1_DEFAULT, bool2, int2}). diff --git a/lib/asn1/test/testSetOfCho.erl b/lib/asn1/test/testSetOfCho.erl index 002fa9be0a..be199b4688 100644 --- a/lib/asn1/test/testSetOfCho.erl +++ b/lib/asn1/test/testSetOfCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetChoDef',{bool1, int1, set1 = asn1_DEFAULT}). -record('SetChoOpt',{bool1, int1, set1 = asn1_NOVALUE}). diff --git a/lib/asn1/test/testSetOfExternal.erl b/lib/asn1/test/testSetOfExternal.erl index 60bde33962..7abed66167 100644 --- a/lib/asn1/test/testSetOfExternal.erl +++ b/lib/asn1/test/testSetOfExternal.erl @@ -21,7 +21,7 @@ -module(testSetOfExternal). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('NT',{os, bool}). diff --git a/lib/asn1/test/testSetOfTag.erl b/lib/asn1/test/testSetOfTag.erl index 96dc9942d7..ce77e2848f 100644 --- a/lib/asn1/test/testSetOfTag.erl +++ b/lib/asn1/test/testSetOfTag.erl @@ -21,7 +21,7 @@ -module(testSetOfTag). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTagNt',{nt}). diff --git a/lib/asn1/test/testSetPrim.erl b/lib/asn1/test/testSetPrim.erl index a4b8bb2f09..47913178f3 100644 --- a/lib/asn1/test/testSetPrim.erl +++ b/lib/asn1/test/testSetPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}). -record('Empty',{}). diff --git a/lib/asn1/test/testSetTag.erl b/lib/asn1/test/testSetTag.erl index b963ecb4b3..2e95fb6793 100644 --- a/lib/asn1/test/testSetTag.erl +++ b/lib/asn1/test/testSetTag.erl @@ -21,7 +21,7 @@ -module(testSetTag). -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTag',{nt, imp, exp}). diff --git a/lib/asn1/test/testSetTypeRefCho.erl b/lib/asn1/test/testSetTypeRefCho.erl index adffb646fb..ac5bf5ab02 100644 --- a/lib/asn1/test/testSetTypeRefCho.erl +++ b/lib/asn1/test/testSetTypeRefCho.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("External.hrl"). -record('SetTRcho',{setCho, setChoE, 'setCho-E', 'setChoE-E'}). diff --git a/lib/asn1/test/testSetTypeRefPrim.erl b/lib/asn1/test/testSetTypeRefPrim.erl index e20b6c57ab..51190e2ba4 100644 --- a/lib/asn1/test/testSetTypeRefPrim.erl +++ b/lib/asn1/test/testSetTypeRefPrim.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetTR',{octStr, octStrI, octStrE, 'octStr-I', 'octStrI-I', 'octStrE-I', 'octStr-E', 'octStrI-E', 'octStrE-E'}). diff --git a/lib/asn1/test/testSetTypeRefSeq.erl b/lib/asn1/test/testSetTypeRefSeq.erl index 0d2bd6b32d..44a7910526 100644 --- a/lib/asn1/test/testSetTypeRefSeq.erl +++ b/lib/asn1/test/testSetTypeRefSeq.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('SetTRseq',{setSeq, setSeqI, setSeqE, 'setSeq-I', 'setSeqI-I', 'setSeqE-I', 'setSeq-E', 'setSeqI-E', 'setSeqE-E'}). -record('SetSeq',{seqInt, seqOs}). diff --git a/lib/asn1/test/testSetTypeRefSet.erl b/lib/asn1/test/testSetTypeRefSet.erl index 85d9bf52cd..7a67e6434c 100644 --- a/lib/asn1/test/testSetTypeRefSet.erl +++ b/lib/asn1/test/testSetTypeRefSet.erl @@ -22,7 +22,7 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record('Set1',{bool1, int1, set1}). -record('Set2',{set2, bool2, int2}). diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index 6c66d73feb..6e777875f6 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -22,7 +22,7 @@ -export([compile/2,test/2,compile_asn1config/2,test_asn1config/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). compile(Config, Options) -> Files = ["Remote-Operations-Information-Objects", diff --git a/lib/asn1/test/testTimer.erl b/lib/asn1/test/testTimer.erl index 30e31796e2..6fecee3d78 100644 --- a/lib/asn1/test/testTimer.erl +++ b/lib/asn1/test/testTimer.erl @@ -21,7 +21,7 @@ -module(testTimer). -export([go/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(times, 5000). diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 8be3a29763..1af614f49a 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -21,7 +21,7 @@ -module(test_compile_options). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl index f9a29d1436..c0a32e2a37 100644 --- a/lib/asn1/test/test_modified_x420.erl +++ b/lib/asn1/test/test_modified_x420.erl @@ -21,7 +21,7 @@ -module(test_modified_x420). -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> DataDir = ?config(data_dir,Config), diff --git a/lib/asn1/test/test_partial_incomplete_decode.erl b/lib/asn1/test/test_partial_incomplete_decode.erl index d5eacc5a4d..64f2ce22ae 100644 --- a/lib/asn1/test/test_partial_incomplete_decode.erl +++ b/lib/asn1/test/test_partial_incomplete_decode.erl @@ -22,7 +22,7 @@ -export([test/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test(Config) -> FMsg = msg('F'), diff --git a/lib/asn1/test/test_selective_decode.erl b/lib/asn1/test/test_selective_decode.erl index 079351db19..d7870057a8 100644 --- a/lib/asn1/test/test_selective_decode.erl +++ b/lib/asn1/test/test_selective_decode.erl @@ -21,7 +21,7 @@ -module(test_selective_decode). -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> FMsg = msg('F'), diff --git a/lib/asn1/test/test_special_decode_performance.erl b/lib/asn1/test/test_special_decode_performance.erl index 7bb324c902..6cf7ee2805 100644 --- a/lib/asn1/test/test_special_decode_performance.erl +++ b/lib/asn1/test/test_special_decode_performance.erl @@ -22,7 +22,7 @@ -export([go/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). go(all) -> {Time_S_s,Time_S_e,Time_S_c}=go(10000,'PartialDecSeq'), diff --git a/lib/asn1/test/test_undecoded_rest.erl b/lib/asn1/test/test_undecoded_rest.erl index 6264530fff..77147d59cc 100644 --- a/lib/asn1/test/test_undecoded_rest.erl +++ b/lib/asn1/test/test_undecoded_rest.erl @@ -22,7 +22,7 @@ -export([test/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% testing OTP-5104 diff --git a/lib/asn1/test/test_x691.erl b/lib/asn1/test/test_x691.erl index 56c1b9bf71..8ef62960ff 100644 --- a/lib/asn1/test/test_x691.erl +++ b/lib/asn1/test/test_x691.erl @@ -21,7 +21,7 @@ -module(test_x691). -export([cases/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). cases(Erule) -> _ = [begin diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl index 28c85ee2db..29c25bf151 100644 --- a/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl +++ b/lib/common_test/test/ct_event_handler_SUITE_data/eh_A.erl @@ -27,7 +27,7 @@ -behaviour(gen_event). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). %% gen_event callbacks diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index f00b2bbb43..06bc0c07f4 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -30,7 +30,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). -define(eh, ct_test_support_eh). diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl index 1db8bcc794..a562719296 100644 --- a/lib/common_test/test/ct_misc_1_SUITE.erl +++ b/lib/common_test/test/ct_misc_1_SUITE.erl @@ -31,7 +31,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server_line.hrl"). -include_lib("common_test/include/ct_event.hrl"). -define(eh, ct_test_support_eh). diff --git a/lib/common_test/test/ct_test_support_eh.erl b/lib/common_test/test/ct_test_support_eh.erl index 7c3d137901..f3d933da04 100644 --- a/lib/common_test/test/ct_test_support_eh.erl +++ b/lib/common_test/test/ct_test_support_eh.erl @@ -27,7 +27,7 @@ -behaviour(gen_event). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). %% gen_event callbacks diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index fae9597c8a..264dc38907 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -25,7 +25,7 @@ combined/1,in_case/1,before_and_inside_if/1, slow_compilation/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index 3425553fed..868bc674f9 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -24,7 +24,7 @@ -export([foo/0,bar/1,baz/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl index 4dd92e7ed9..4268729e75 100644 --- a/lib/compiler/test/beam_disasm_SUITE.erl +++ b/lib/compiler/test/beam_disasm_SUITE.erl @@ -19,7 +19,7 @@ %% -module(beam_disasm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index d6deb4a730..cb217e4655 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -34,7 +34,7 @@ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(10)), diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 1bf4e9d4a7..d9865c3746 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -28,7 +28,7 @@ extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, nomatch/1,sizes/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index afee52c9b9..5bda20e6d6 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -29,7 +29,7 @@ big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index 87cfaaf73c..caf204032c 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -31,7 +31,7 @@ nasty_literals/1,coerce_to_float/1,side_effect/1, opt/1,otp_7556/1,float_arith/1,otp_8054/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 8725e133fa..99539f3779 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -41,7 +41,7 @@ -export([coverage_id/1,coverage_external_ignore/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index e6d292d9e6..ffe8de00d4 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -26,7 +26,7 @@ utf32_roundtrip/1,guard/1,extreme_tripping/1, literals/1,coverage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 2715a3aec5..6bff5e55f2 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -20,7 +20,7 @@ -module(compilation_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index ab9910f555..c69e0ac408 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -21,7 +21,7 @@ %% Tests compile:file/1 and compile:file/2 with various options. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 25f8564ce4..ddc4c7af5e 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -29,7 +29,7 @@ bs_shadowed_size_var/1 ]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(comp(N), N(Config) when is_list(Config) -> try_it(N, Config)). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 016ea9d0d9..36faea1363 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -29,7 +29,7 @@ -export([foo/0,foo/1,foo/2,foo/3]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 2962e3ff77..f4662ec7b2 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(error_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 1b313ad021..60efe4f228 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 36a4d6fce2..c6cc5b17b3 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -27,7 +27,7 @@ %% Internal exports. -export([call_me/1,dup1/0,dup2/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 47eb1ba78b..5391771dad 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -19,7 +19,7 @@ %% -module(guard_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 0b92a784de..f28e1e5a25 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -21,7 +21,7 @@ -module(inline_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). -compile({inline,[badarg/2]}). diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index d10839ccf2..43e23f3b46 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -26,7 +26,7 @@ empty_generator/1,no_export/1,shadow/1, effect/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 9166726aa2..8e88d26b62 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -26,7 +26,7 @@ selectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index a8b4ed0a24..9c65151685 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -25,7 +25,7 @@ tobias/1,empty_string/1,md5/1,silly_coverage/1, confused_literals/1,integer_encoding/1,override_bif/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% For the override_bif testcase. %% NB, no other testcases in this testsuite can use these without erlang:prefix! diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index d54fa203f0..a94ca40b38 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -19,7 +19,7 @@ %% -module(num_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests optimization of the BIFs: %% abs/1 diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 4016fac0b5..fef29ab06d 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -27,7 +27,7 @@ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, wait/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 2ef379e43f..48a2a9f5df 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -21,7 +21,7 @@ -module(record_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl index 716a9693ed..a8caa34c60 100644 --- a/lib/compiler/test/regressions_SUITE.erl +++ b/lib/compiler/test/regressions_SUITE.erl @@ -19,7 +19,7 @@ %% Test specific code snippets that has crashed the compiler in the past. -module(regressions_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, groups/0, init_per_testcase/2,end_per_testcase/2]). diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 09ec8f3c81..e4b6a2fa9c 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -19,7 +19,7 @@ %% -module(test_lib). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile({no_auto_import,[binary_part/2]}). -export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1, smoke_disasm/1,p_run/2,binary_part/2]). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index adcab8ef67..b316776f50 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -28,7 +28,7 @@ plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, hockey/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index a964afe5a1..2a425c2ae5 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -27,7 +27,7 @@ -define(privdir, "warnings_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). -endif. diff --git a/lib/cosEvent/test/event_channel_SUITE.erl b/lib/cosEvent/test/event_channel_SUITE.erl index 0d67a94520..3a01a0eab6 100644 --- a/lib/cosEvent/test/event_channel_SUITE.erl +++ b/lib/cosEvent/test/event_channel_SUITE.erl @@ -23,7 +23,7 @@ -module(event_channel_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/cosEvent/test/generated_SUITE.erl b/lib/cosEvent/test/generated_SUITE.erl index 40fe94386a..1533c0be9c 100644 --- a/lib/cosEvent/test/generated_SUITE.erl +++ b/lib/cosEvent/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosEventDomain/test/event_domain_SUITE.erl b/lib/cosEventDomain/test/event_domain_SUITE.erl index 75835b03a0..37a04a34aa 100644 --- a/lib/cosEventDomain/test/event_domain_SUITE.erl +++ b/lib/cosEventDomain/test/event_domain_SUITE.erl @@ -23,7 +23,7 @@ -module(event_domain_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl"). -include_lib("cosNotification/include/CosNotification.hrl"). diff --git a/lib/cosEventDomain/test/generated_SUITE.erl b/lib/cosEventDomain/test/generated_SUITE.erl index 553516bed1..afaa70db0a 100644 --- a/lib/cosEventDomain/test/generated_SUITE.erl +++ b/lib/cosEventDomain/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl index 3fb08dbcdd..173cf71e61 100644 --- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl +++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl @@ -29,7 +29,7 @@ %%--------------- INCLUDES ----------------------------------- -include_lib("cosFileTransfer/src/cosFileTransferApp.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/test/eventDB_SUITE.erl b/lib/cosNotification/test/eventDB_SUITE.erl index 0f0faed065..2d095adfae 100644 --- a/lib/cosNotification/test/eventDB_SUITE.erl +++ b/lib/cosNotification/test/eventDB_SUITE.erl @@ -42,7 +42,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/test/generated_SUITE.erl b/lib/cosNotification/test/generated_SUITE.erl index fe186f24e8..8e29989e30 100644 --- a/lib/cosNotification/test/generated_SUITE.erl +++ b/lib/cosNotification/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosNotification/test/grammar_SUITE.erl b/lib/cosNotification/test/grammar_SUITE.erl index eb0741ce04..b17ddba1c4 100644 --- a/lib/cosNotification/test/grammar_SUITE.erl +++ b/lib/cosNotification/test/grammar_SUITE.erl @@ -43,7 +43,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosNotification/test/notification_SUITE.erl b/lib/cosNotification/test/notification_SUITE.erl index b3884e7968..6824a2805f 100644 --- a/lib/cosNotification/test/notification_SUITE.erl +++ b/lib/cosNotification/test/notification_SUITE.erl @@ -41,7 +41,7 @@ -include("idl_output/notify_test.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosProperty/test/generated_SUITE.erl b/lib/cosProperty/test/generated_SUITE.erl index 0422e0d018..1789650cbd 100644 --- a/lib/cosProperty/test/generated_SUITE.erl +++ b/lib/cosProperty/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosProperty/test/property_SUITE.erl b/lib/cosProperty/test/property_SUITE.erl index 94765e7479..ae508fa7b6 100644 --- a/lib/cosProperty/test/property_SUITE.erl +++ b/lib/cosProperty/test/property_SUITE.erl @@ -33,7 +33,7 @@ -include_lib("cosProperty/src/cosProperty.hrl"). -include_lib("cosProperty/include/CosPropertyService.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosTime/test/generated_SUITE.erl b/lib/cosTime/test/generated_SUITE.erl index 2e63b6f50e..03dffedc05 100644 --- a/lib/cosTime/test/generated_SUITE.erl +++ b/lib/cosTime/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosTime/test/time_SUITE.erl b/lib/cosTime/test/time_SUITE.erl index 0e805aed05..7213680b99 100644 --- a/lib/cosTime/test/time_SUITE.erl +++ b/lib/cosTime/test/time_SUITE.erl @@ -30,7 +30,7 @@ %%--------------- INCLUDES ----------------------------------- -include_lib("cosTime/src/cosTimeApp.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%--------------- DEFINES ------------------------------------ -define(default_timeout, ?t:minutes(20)). diff --git a/lib/cosTransactions/test/generated_SUITE.erl b/lib/cosTransactions/test/generated_SUITE.erl index 9d5cfb154a..c4bd86a892 100644 --- a/lib/cosTransactions/test/generated_SUITE.erl +++ b/lib/cosTransactions/test/generated_SUITE.erl @@ -27,7 +27,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/cosTransactions/test/transactions_SUITE.erl b/lib/cosTransactions/test/transactions_SUITE.erl index 0f06c3d262..63ec04f74f 100644 --- a/lib/cosTransactions/test/transactions_SUITE.erl +++ b/lib/cosTransactions/test/transactions_SUITE.erl @@ -29,7 +29,7 @@ -include_lib("cosTransactions/include/CosTransactions.hrl"). -include("etrap_test_lib.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(20)). diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl index b0d6954820..19f60450e9 100644 --- a/lib/crypto/test/blowfish_SUITE.erl +++ b/lib/crypto/test/blowfish_SUITE.erl @@ -24,8 +24,7 @@ %% Note: This directive should only be used in test suites. -compile(export_all). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMEOUT, 120000). % 2 min diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl index 1e7f3a1438..37cce2ebd2 100644 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -19,7 +19,7 @@ %% -module(old_crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -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, diff --git a/lib/debugger/test/andor_SUITE.erl b/lib/debugger/test/andor_SUITE.erl index 384b6c7c77..9750fa018d 100644 --- a/lib/debugger/test/andor_SUITE.erl +++ b/lib/debugger/test/andor_SUITE.erl @@ -27,7 +27,7 @@ t_andalso/1,t_orelse/1,inside/1,overlap/1, combined/1,in_case/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_bincomp_SUITE.erl b/lib/debugger/test/bs_bincomp_SUITE.erl index 0750c6793d..18b4198354 100644 --- a/lib/debugger/test/bs_bincomp_SUITE.erl +++ b/lib/debugger/test/bs_bincomp_SUITE.erl @@ -30,7 +30,7 @@ byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index f62512568f..966c096c3a 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -36,7 +36,7 @@ copy_writable_binary/1, dynamic/1, otp_7422/1, zero_width/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl index a61b56501c..98c1013210 100644 --- a/lib/debugger/test/bs_match_bin_SUITE.erl +++ b/lib/debugger/test/bs_match_bin_SUITE.erl @@ -27,7 +27,7 @@ init_per_suite/1,end_per_suite/1, byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl index fd77530dd5..11b5e30efd 100644 --- a/lib/debugger/test/bs_match_int_SUITE.erl +++ b/lib/debugger/test/bs_match_int_SUITE.erl @@ -26,7 +26,7 @@ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [seq/2]). diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index 2221cfe08b..7196026dc7 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -29,7 +29,7 @@ writable_binary_matched/1,otp_7198/1, unordered_bindings/1,float_middle_endian/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl index 9ec93978ed..f4201ee7db 100644 --- a/lib/debugger/test/bs_match_tail_SUITE.erl +++ b/lib/debugger/test/bs_match_tail_SUITE.erl @@ -26,7 +26,7 @@ init_per_suite/1,end_per_suite/1, aligned/1,unaligned/1,zero_tail/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bs_utf_SUITE.erl b/lib/debugger/test/bs_utf_SUITE.erl index 90c4d6c7b9..5bf776226a 100644 --- a/lib/debugger/test/bs_utf_SUITE.erl +++ b/lib/debugger/test/bs_utf_SUITE.erl @@ -28,7 +28,7 @@ utf8_roundtrip/1,unused_utf_char/1,utf16_roundtrip/1, utf32_roundtrip/1,guard/1,extreme_tripping/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile([no_jopt,time]). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl index 542db3f41e..516d9f4b8d 100644 --- a/lib/debugger/test/bug_SUITE.erl +++ b/lib/debugger/test/bug_SUITE.erl @@ -21,7 +21,7 @@ %% -module(bug_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/debugger/test/cleanup.erl b/lib/debugger/test/cleanup.erl index b40ae5f82c..58f3c9380f 100644 --- a/lib/debugger/test/cleanup.erl +++ b/lib/debugger/test/cleanup.erl @@ -23,7 +23,7 @@ -export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all() -> [cleanup]. diff --git a/lib/debugger/test/dbg_ui_SUITE.erl b/lib/debugger/test/dbg_ui_SUITE.erl index f0f4e09aa8..39ecb51b57 100644 --- a/lib/debugger/test/dbg_ui_SUITE.erl +++ b/lib/debugger/test/dbg_ui_SUITE.erl @@ -22,7 +22,7 @@ -module(dbg_ui_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Test server specific exports diff --git a/lib/debugger/test/debugger_SUITE.erl b/lib/debugger/test/debugger_SUITE.erl index 9207df38e4..678ca0e5c3 100644 --- a/lib/debugger/test/debugger_SUITE.erl +++ b/lib/debugger/test/debugger_SUITE.erl @@ -23,7 +23,7 @@ %% Test break points. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index af9b0a6e6e..c75e4012f3 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -60,7 +60,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index f42dbc7776..e35326a798 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -28,7 +28,7 @@ -export([bad_guy/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index fabee16cee..b8092ab16c 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -30,7 +30,7 @@ %% Internal exports. -export([nothing/0,call_me/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index 880c89532b..2b87ef23ba 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -39,7 +39,7 @@ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/4]). -import(lists, [member/2]). diff --git a/lib/debugger/test/int_SUITE.erl b/lib/debugger/test/int_SUITE.erl index 5f2e4dd84d..8b16b7631b 100644 --- a/lib/debugger/test/int_SUITE.erl +++ b/lib/debugger/test/int_SUITE.erl @@ -20,7 +20,7 @@ %% -module(int_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/debugger/test/int_break_SUITE.erl b/lib/debugger/test/int_break_SUITE.erl index 21b53a8d30..75bdd69a7d 100644 --- a/lib/debugger/test/int_break_SUITE.erl +++ b/lib/debugger/test/int_break_SUITE.erl @@ -22,7 +22,7 @@ %% Test break points. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index f30d386de9..3f3c03492e 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -36,7 +36,7 @@ -define(IM, my_int_eval_module). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index aca4c4de7c..851d0fbc20 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -28,7 +28,7 @@ basic/1,deeply_nested/1,no_generator/1, empty_generator/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl index 6ec5ef5d5a..592f0a1f32 100644 --- a/lib/debugger/test/line_number_SUITE.erl +++ b/lib/debugger/test/line_number_SUITE.erl @@ -26,7 +26,7 @@ line_numbers/1]). -export([crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/debugger/test/record_SUITE.erl b/lib/debugger/test/record_SUITE.erl index 2f663e2dfc..115e65c685 100644 --- a/lib/debugger/test/record_SUITE.erl +++ b/lib/debugger/test/record_SUITE.erl @@ -23,7 +23,7 @@ -module(record_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl index 7fdd98fc71..0303d1bd82 100644 --- a/lib/debugger/test/trycatch_SUITE.erl +++ b/lib/debugger/test/trycatch_SUITE.erl @@ -28,7 +28,7 @@ catch_oops/1,after_oops/1,eclectic/1,rethrow/1, nested_of/1,nested_catch/1,nested_after/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl index 80f4508ec6..8a2324a7c2 100644 --- a/lib/dialyzer/test/dialyzer_SUITE.erl +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -19,7 +19,7 @@ %% -module(dialyzer_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 2e2d5584f0..00d7550bed 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -16,7 +16,7 @@ %% -module(edoc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index 638a609346..8efed3cc18 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -23,7 +23,7 @@ -compile(export_all). %%-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("eldap/include/eldap.hrl"). -include_lib("eldap/ebin/ELDAPv3.hrl"). diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 144ec99e0a..db3587339e 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_accept_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_accept_SUITE_data/ei_accept_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 3385d1eb6c..c94ac37af4 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_connect_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_connect_SUITE_data/ei_connect_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index 0abcf50fb5..91357c99f2 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_decode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_decode_SUITE_data/ei_decode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 3c7e4bf70d..6a25b98209 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_decode_encode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_decode_encode_SUITE_data/ei_decode_encode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 6213916314..d94f3adf42 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_encode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_encode_SUITE_data/ei_encode_test_cases.hrl"). -export( diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl index 11cbae31db..ed6a755f9b 100644 --- a/lib/erl_interface/test/ei_format_SUITE.erl +++ b/lib/erl_interface/test/ei_format_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_format_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_format_SUITE_data/ei_format_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl index 4309b883bb..36ee90c7ee 100644 --- a/lib/erl_interface/test/ei_print_SUITE.erl +++ b/lib/erl_interface/test/ei_print_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_print_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("ei_print_SUITE_data/ei_print_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl index 689499f42f..f506b3dbb0 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE.erl +++ b/lib/erl_interface/test/ei_tmo_SUITE.erl @@ -21,7 +21,7 @@ %% -module(ei_tmo_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -include("ei_tmo_SUITE_data/ei_tmo_test_cases.hrl"). diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index f621310a1c..d3fe020bce 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_connect_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_connect_SUITE_data/erl_connect_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 8fbef35309..230310f63b 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_eterm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_eterm_SUITE_data/eterm_test_cases.hrl"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/erl_interface/test/erl_ext_SUITE.erl b/lib/erl_interface/test/erl_ext_SUITE.erl index f73c15e15f..cbc93b4cfb 100644 --- a/lib/erl_interface/test/erl_ext_SUITE.erl +++ b/lib/erl_interface/test/erl_ext_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_ext_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_ext_SUITE_data/ext_test_cases.hrl"). -export([ diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl index 8c01a9914f..afbbe6a241 100644 --- a/lib/erl_interface/test/erl_format_SUITE.erl +++ b/lib/erl_interface/test/erl_format_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_format_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_format_SUITE_data/format_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/erl_global_SUITE.erl index b719ad5c6a..493ad576c9 100644 --- a/lib/erl_interface/test/erl_global_SUITE.erl +++ b/lib/erl_interface/test/erl_global_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_global_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_global_SUITE_data/erl_global_test_cases.hrl"). -export([all/0,suite/0,init_per_suite/1,end_per_suite/1, diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl index d8f7bd89b4..ecdebad212 100644 --- a/lib/erl_interface/test/erl_match_SUITE.erl +++ b/lib/erl_interface/test/erl_match_SUITE.erl @@ -21,7 +21,7 @@ %% -module(erl_match_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("erl_match_SUITE_data/match_test_cases.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl index b0f5ed4fe9..3bc1a03eab 100644 --- a/lib/erl_interface/test/port_call_SUITE.erl +++ b/lib/erl_interface/test/port_call_SUITE.erl @@ -34,7 +34,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, basic/1]). % Private exports --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index 24526f574d..368ad0cd20 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -9,7 +9,7 @@ -export([test/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). test() -> ok = utf8_cm65(), diff --git a/lib/ic/test/ic_SUITE.erl b/lib/ic/test/ic_SUITE.erl index bca75b8349..c9fbf49a55 100644 --- a/lib/ic/test/ic_SUITE.erl +++ b/lib/ic/test/ic_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(ic_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/ic/test/ic_be_SUITE.erl b/lib/ic/test/ic_be_SUITE.erl index 42c30fc86e..49dd9953cb 100644 --- a/lib/ic/test/ic_be_SUITE.erl +++ b/lib/ic/test/ic_be_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(ic_be_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/ic/test/ic_pp_SUITE.erl b/lib/ic/test/ic_pp_SUITE.erl index ab22d532a1..e85ce788e3 100644 --- a/lib/ic/test/ic_pp_SUITE.erl +++ b/lib/ic/test/ic_pp_SUITE.erl @@ -23,7 +23,7 @@ %%---------------------------------------------------------------------- -module(ic_pp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). diff --git a/lib/ic/test/ic_pragma_SUITE.erl b/lib/ic/test/ic_pragma_SUITE.erl index e0ab43e178..c6e23a1f8c 100644 --- a/lib/ic/test/ic_pragma_SUITE.erl +++ b/lib/ic/test/ic_pragma_SUITE.erl @@ -28,7 +28,7 @@ %%----------------------------------------------------------------- -module(ic_pragma_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). %%----------------------------------------------------------------- %% External exports diff --git a/lib/ic/test/ic_register_SUITE.erl b/lib/ic/test/ic_register_SUITE.erl index e402692940..86d89e72d5 100644 --- a/lib/ic/test/ic_register_SUITE.erl +++ b/lib/ic/test/ic_register_SUITE.erl @@ -27,7 +27,7 @@ %%----------------------------------------------------------------- -module(ic_register_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). %%----------------------------------------------------------------- %% External exports diff --git a/lib/ic/test/java_client_erl_server_SUITE.erl b/lib/ic/test/java_client_erl_server_SUITE.erl index e95b3d5026..a670c5546e 100644 --- a/lib/ic/test/java_client_erl_server_SUITE.erl +++ b/lib/ic/test/java_client_erl_server_SUITE.erl @@ -23,7 +23,7 @@ %%%---------------------------------------------------------------------- -module(java_client_erl_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, diff --git a/lib/inets/test/ftp_format_SUITE.erl b/lib/inets/test/ftp_format_SUITE.erl index 7ed94b9c61..9b71d2944b 100644 --- a/lib/inets/test/ftp_format_SUITE.erl +++ b/lib/inets/test/ftp_format_SUITE.erl @@ -22,7 +22,6 @@ -author('ingela@erix.ericsson.se'). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("ftp_internal.hrl"). %% Test server specific exports diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index 6d30f3aa62..2f9170fa0c 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -22,8 +22,8 @@ -module(ftp_suite_lib). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). %% Test server specific exports diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index 9a62bdb43f..2efca9a5c8 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -20,7 +20,7 @@ %% -module(httpc_cookie_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). %% Test server specific exports diff --git a/lib/inets/test/httpd_load.erl b/lib/inets/test/httpd_load.erl index 39c2280f23..fef693d818 100644 --- a/lib/inets/test/httpd_load.erl +++ b/lib/inets/test/httpd_load.erl @@ -21,8 +21,7 @@ -module(httpd_load). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). %% General testcases bodies called from httpd_SUITE -export([load_test/5]). diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index 847586a903..016989a22e 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -21,8 +21,7 @@ -module(httpd_mod). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). %% General testcases bodies called from httpd_SUITE -export([alias/4, actions/4, security/5, auth/4, auth_api/6, diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index aaaf69fbec..f972f0f435 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -21,8 +21,7 @@ -module(old_httpd_SUITE). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index 6d34a21209..5c4618dcde 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -46,7 +46,6 @@ ]). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -define(debug,true). -ifdef(debug). diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index c5f3198c21..9910334749 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -21,7 +21,6 @@ -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -define(VERSION_MAGIC, 131). diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 0c198b90ae..0ff512bb6e 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -19,7 +19,7 @@ %% -module(application_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2 diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl index dd3010567a..284ca8f377 100644 --- a/lib/kernel/test/bif_SUITE.erl +++ b/lib/kernel/test/bif_SUITE.erl @@ -38,7 +38,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/kernel/test/cleanup.erl b/lib/kernel/test/cleanup.erl index 7eb0a9e140..7f623b9fc3 100644 --- a/lib/kernel/test/cleanup.erl +++ b/lib/kernel/test/cleanup.erl @@ -21,7 +21,7 @@ -export([all/0,groups/0,init_per_group/2,end_per_group/2, cleanup/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all() -> [cleanup]. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 2a8468942c..23acd7b4d9 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -19,7 +19,7 @@ %% -module(code_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). -export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 9988347581..21da958c11 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -29,7 +29,7 @@ -define(config(X,Y), foo). -define(t,test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -define(datadir(Conf), ?config(data_dir, Conf)). diff --git a/lib/kernel/test/erl_boot_server_SUITE.erl b/lib/kernel/test/erl_boot_server_SUITE.erl index 954880e252..2450761ac9 100644 --- a/lib/kernel/test/erl_boot_server_SUITE.erl +++ b/lib/kernel/test/erl_boot_server_SUITE.erl @@ -19,7 +19,7 @@ %% -module(erl_boot_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 2f73ab170a..3ac87384b4 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -20,7 +20,7 @@ -module(erl_distribution_SUITE). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index c107e92fae..e453cb2cdd 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -19,7 +19,7 @@ %% -module(erl_distribution_wb_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index 72b00e22da..bc14a2764d 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -20,7 +20,7 @@ -module(erl_prim_loader_SUITE). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl index f1988b68d9..fa0fc5b75c 100644 --- a/lib/kernel/test/error_logger_SUITE.erl +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -19,7 +19,7 @@ %% -module(error_logger_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%----------------------------------------------------------------- %% We don't have to test the normal behaviour here, i.e. the tty diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl index a3a3b2f8c6..40b3f6bd53 100644 --- a/lib/kernel/test/error_logger_warn_SUITE.erl +++ b/lib/kernel/test/error_logger_warn_SUITE.erl @@ -29,7 +29,7 @@ %% Internal exports. -export([init/1,handle_event/2,handle_info/2,handle_call/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(EXPECT(Pattern), (fun() -> diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 8f5027c91b..e9401e26ef 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -106,7 +106,7 @@ %% System probe functions that might be handy to check from the shell -export([disc_free/1, memsize/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(THROW_ERROR(RES), throw({fail, ?LINE, RES})). diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 4c422c9e0a..e6f8761f95 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -19,7 +19,7 @@ %% %CopyrightEnd% %% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %% diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index 91a57d3290..99f8625ba9 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_sctp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet_sctp.hrl"). %%-compile(export_all). diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl index b5ed16ec34..fe81cbac18 100644 --- a/lib/kernel/test/gen_tcp_echo_SUITE.erl +++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_tcp_echo_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-compile(export_all). diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 3adca83ec9..323796665b 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_tcp_misc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 8d8c953303..2efbf26e1c 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -22,7 +22,7 @@ % because udp is not deterministic. % -module(gen_udp_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index c0e24e17fe..0b96e7a68b 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -51,7 +51,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(NODES, [node()|nodes()]). diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl index 0a994c3bf0..e7d321418c 100644 --- a/lib/kernel/test/global_group_SUITE.erl +++ b/lib/kernel/test/global_group_SUITE.erl @@ -30,7 +30,7 @@ %-compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(NODES, [node()|nodes()]). diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 83efbb4c35..4447475833 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -19,7 +19,7 @@ %% -module(heart_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, diff --git a/lib/kernel/test/ignore_cores.erl b/lib/kernel/test/ignore_cores.erl index db61c4003b..6a37b48189 100644 --- a/lib/kernel/test/ignore_cores.erl +++ b/lib/kernel/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index d64a52fc2c..0a36bc9673 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -19,7 +19,7 @@ %% -module(inet_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -include_lib("kernel/src/inet_dns.hrl"). diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 6e575c2f95..ea06061c74 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -20,7 +20,6 @@ -module(inet_res_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/inet.hrl"). -include_lib("kernel/src/inet_dns.hrl"). diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index cb522c8abe..a6981854c8 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -19,7 +19,7 @@ %% -module(inet_sockopt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(C_GET_IPPROTO_TCP,1). diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index f90eb69ef1..cb531f7b57 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -19,7 +19,7 @@ %% -module(init_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 8adae1f606..d7fa52b721 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(interactive_shell_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, get_columns_and_rows/1, exit_initial/1, job_control_local/1, diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 8ae2e4b23b..64c7ce6136 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -21,7 +21,7 @@ %%% Kernel application test suite. %%%----------------------------------------------------------------- -module(kernel_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Test server specific exports diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl index 4be44015c9..1486619b1c 100644 --- a/lib/kernel/test/kernel_config_SUITE.erl +++ b/lib/kernel/test/kernel_config_SUITE.erl @@ -19,7 +19,7 @@ %% -module(kernel_config_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, sync/1]). diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index e6e8568394..29fc3a2ea5 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -26,7 +26,7 @@ find_executable/1, unix_comment_in_command/1, deep_list_command/1, large_output_command/1, perf_counter_api/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl index b096296fa1..80025d2fd9 100644 --- a/lib/kernel/test/pdict_SUITE.erl +++ b/lib/kernel/test/pdict_SUITE.erl @@ -21,7 +21,7 @@ %% NB: The ?line macro cannot be used when testing the dictionary. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(M(A,B),m(A,B,?MODULE,?LINE)). -ifdef(DEBUG). diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl index 832d2d1c27..6e4f5ee682 100644 --- a/lib/kernel/test/pg2_SUITE.erl +++ b/lib/kernel/test/pg2_SUITE.erl @@ -21,7 +21,7 @@ %%----------------------------------------------------------------- -module(pg2_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 366231d2cc..1265180354 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -62,7 +62,7 @@ -export([allocate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(PRIM_FILE, prim_file). diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl index 933dc88d21..fdb61a3619 100644 --- a/lib/kernel/test/ram_file_SUITE.erl +++ b/lib/kernel/test/ram_file_SUITE.erl @@ -28,7 +28,7 @@ truncate/1, sync/1, get_set_file/1, compress/1, uuencode/1, large_file_errors/1, large_file_light/1, large_file_heavy/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -define(FILE_MODULE, file). % Name of module to test diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index ed30c2dffa..42c522b1bd 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -28,7 +28,7 @@ -export([suicide/2, suicide/3, f/0, f2/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 6a63f7bc9c..fb6f62d2e5 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -33,7 +33,7 @@ do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMESTAMP_MODES, [no_timestamp, timestamp, diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl index 9a93b9037f..27ff98dc17 100644 --- a/lib/kernel/test/wrap_log_reader_SUITE.erl +++ b/lib/kernel/test/wrap_log_reader_SUITE.erl @@ -29,7 +29,7 @@ -define(config(X,Y), foo). -define(t,test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 77fdabe73c..d9d4c138d5 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -20,7 +20,7 @@ -module(zlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index eea82d8c3c..e9a3ba0369 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -21,7 +21,7 @@ -module(crashdump_helper). -export([n1_proc/2,remote_proc/2]). -compile(r13). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). n1_proc(N2,Creator) -> spawn(fun() -> n1_proc(Creator,N2,x,y,[]) end). diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 84af440245..2d47054600 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -30,7 +30,6 @@ -export([init_per_testcase/2, end_per_testcase/2]). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/file.hrl"). -define(failed_file,"failed-cases.txt"). diff --git a/lib/observer/test/etop_SUITE.erl b/lib/observer/test/etop_SUITE.erl index d4857c5e2f..4b05e4c2a0 100644 --- a/lib/observer/test/etop_SUITE.erl +++ b/lib/observer/test/etop_SUITE.erl @@ -26,7 +26,7 @@ -export([text/1,text/2,text_tracing_off/1,text_tracing_off/2]). -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 7f96d72e59..a33df61b98 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -19,7 +19,7 @@ %% -module(observer_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("wx/include/wx.hrl"). -include_lib("observer/src/observer_tv.hrl"). diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index bdf10f507d..f1649e6cb9 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -32,7 +32,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). -export([foo/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). -define(OUTPUT, "handler_output"). diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 2d4173a008..41601a2750 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). -define(MAX_SEQ_TIMEOUTS, 10). diff --git a/lib/odbc/test/odbc_data_type_SUITE.erl b/lib/odbc/test/odbc_data_type_SUITE.erl index a56af650c2..25988bef2a 100644 --- a/lib/odbc/test/odbc_data_type_SUITE.erl +++ b/lib/odbc/test/odbc_data_type_SUITE.erl @@ -27,7 +27,6 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/ms_transform.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %%-------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_query_SUITE.erl b/lib/odbc/test/odbc_query_SUITE.erl index e8c2df7c31..79c756e956 100644 --- a/lib/odbc/test/odbc_query_SUITE.erl +++ b/lib/odbc/test/odbc_query_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %%-------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_start_SUITE.erl b/lib/odbc/test/odbc_start_SUITE.erl index 8fb564d1f9..e16b4cfb7f 100644 --- a/lib/odbc/test/odbc_start_SUITE.erl +++ b/lib/odbc/test/odbc_start_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include("odbc_test.hrl"). %% Test server callback functions diff --git a/lib/odbc/test/odbc_test_lib.erl b/lib/odbc/test/odbc_test_lib.erl index 6f49c019e3..88d772467c 100644 --- a/lib/odbc/test/odbc_test_lib.erl +++ b/lib/odbc/test/odbc_test_lib.erl @@ -26,7 +26,7 @@ -compile(export_all). -include("odbc_test.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). unique_table_name() -> lists:reverse(lists:foldl(fun($@, Acc) -> [$t, $A |Acc] ; diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl index 1fec91dca3..dac6e78ddd 100644 --- a/lib/orber/test/cdrcoding_10_SUITE.erl +++ b/lib/orber/test/cdrcoding_10_SUITE.erl @@ -28,7 +28,7 @@ -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl index 324b9b2b17..f4fe3d06e3 100644 --- a/lib/orber/test/cdrcoding_11_SUITE.erl +++ b/lib/orber/test/cdrcoding_11_SUITE.erl @@ -28,7 +28,7 @@ -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl index f0a8fe4d7f..8843233d35 100644 --- a/lib/orber/test/cdrcoding_12_SUITE.erl +++ b/lib/orber/test/cdrcoding_12_SUITE.erl @@ -29,7 +29,7 @@ -module(cdrcoding_12_SUITE). -include("idl_output/Module.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/cdrlib_SUITE.erl b/lib/orber/test/cdrlib_SUITE.erl index dd1f975d9e..8fc9c655ce 100644 --- a/lib/orber/test/cdrlib_SUITE.erl +++ b/lib/orber/test/cdrlib_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(cdrlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/corba_SUITE.erl b/lib/orber/test/corba_SUITE.erl index 914856f370..018d8b5f12 100644 --- a/lib/orber/test/corba_SUITE.erl +++ b/lib/orber/test/corba_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(corba_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/csiv2_SUITE.erl b/lib/orber/test/csiv2_SUITE.erl index 7f45f16ef7..cf4dbec073 100644 --- a/lib/orber/test/csiv2_SUITE.erl +++ b/lib/orber/test/csiv2_SUITE.erl @@ -21,7 +21,7 @@ -module(csiv2_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/data_types_SUITE.erl b/lib/orber/test/data_types_SUITE.erl index d0e0eacad1..f910eecae7 100644 --- a/lib/orber/test/data_types_SUITE.erl +++ b/lib/orber/test/data_types_SUITE.erl @@ -26,7 +26,7 @@ -module(data_types_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/generated_SUITE.erl b/lib/orber/test/generated_SUITE.erl index cc14b4ebc0..7af355620e 100644 --- a/lib/orber/test/generated_SUITE.erl +++ b/lib/orber/test/generated_SUITE.erl @@ -26,7 +26,7 @@ -module(generated_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/interceptors_SUITE.erl b/lib/orber/test/interceptors_SUITE.erl index 57d5a5f831..ec30187aca 100644 --- a/lib/orber/test/interceptors_SUITE.erl +++ b/lib/orber/test/interceptors_SUITE.erl @@ -26,7 +26,7 @@ -module(interceptors_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl index 5705a95710..edfe566dcd 100644 --- a/lib/orber/test/iop_ior_10_SUITE.erl +++ b/lib/orber/test/iop_ior_10_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(iop_ior_10_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl index b32da44c68..d24e3fb882 100644 --- a/lib/orber/test/iop_ior_11_SUITE.erl +++ b/lib/orber/test/iop_ior_11_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(iop_ior_11_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl index a12f341f04..725118b609 100644 --- a/lib/orber/test/iop_ior_12_SUITE.erl +++ b/lib/orber/test/iop_ior_12_SUITE.erl @@ -27,7 +27,7 @@ -module(iop_ior_12_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/orber/test/ip_v4v6_interop_SUITE.erl b/lib/orber/test/ip_v4v6_interop_SUITE.erl index 995a11ae1e..4840501418 100644 --- a/lib/orber/test/ip_v4v6_interop_SUITE.erl +++ b/lib/orber/test/ip_v4v6_interop_SUITE.erl @@ -47,7 +47,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/lname_SUITE.erl b/lib/orber/test/lname_SUITE.erl index 2200ff6ed1..1fb4d7bbb9 100644 --- a/lib/orber/test/lname_SUITE.erl +++ b/lib/orber/test/lname_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(lname_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/COSS/CosNaming/lname.hrl"). diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 6b523229cc..abedcec407 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -21,7 +21,7 @@ -module(multi_ORB_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/naming_context_SUITE.erl b/lib/orber/test/naming_context_SUITE.erl index f99820fa24..626b9237b5 100644 --- a/lib/orber/test/naming_context_SUITE.erl +++ b/lib/orber/test/naming_context_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(naming_context_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -include_lib("orber/include/corba.hrl"). diff --git a/lib/orber/test/orber_SUITE.erl b/lib/orber/test/orber_SUITE.erl index 914705adb9..1ca22cd60b 100644 --- a/lib/orber/test/orber_SUITE.erl +++ b/lib/orber/test/orber_SUITE.erl @@ -19,7 +19,7 @@ %% %% -module(orber_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(15)). -define(application, orber). diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl index 8d1f9ebb6d..0d8f79de5c 100644 --- a/lib/orber/test/orber_acl_SUITE.erl +++ b/lib/orber/test/orber_acl_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(orber_acl_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(5)). diff --git a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl index 220029ec72..efa4f120c7 100644 --- a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv4_in_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl index 270b166fe9..cfe1ab2d95 100644 --- a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv4_out_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl index b0e28118f7..514504716f 100644 --- a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv6_in_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl index 96884f3339..9ff57a0294 100644 --- a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_firewall_ipv6_out_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index 1294f96681..0751cdf89c 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -21,7 +21,7 @@ -module(orber_nat_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 51025927ee..796ed21489 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -20,7 +20,7 @@ %% -module(orber_test_lib). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/include/ifr_types.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/orber_web_SUITE.erl b/lib/orber/test/orber_web_SUITE.erl index a88e0373bd..31c67be9d8 100644 --- a/lib/orber/test/orber_web_SUITE.erl +++ b/lib/orber/test/orber_web_SUITE.erl @@ -26,7 +26,7 @@ -module(orber_web_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). diff --git a/lib/orber/test/tc_SUITE.erl b/lib/orber/test/tc_SUITE.erl index a1a5c74ae3..c670ebdea2 100644 --- a/lib/orber/test/tc_SUITE.erl +++ b/lib/orber/test/tc_SUITE.erl @@ -26,7 +26,7 @@ %%----------------------------------------------------------------- -module(tc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index e96b54d3fe..13d47c6a89 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(cpu_sup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index e41fc73ab2..8e2825ec26 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(disksup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/memsup_SUITE.erl b/lib/os_mon/test/memsup_SUITE.erl index 8ab61e9581..904c9b95b0 100644 --- a/lib/os_mon/test/memsup_SUITE.erl +++ b/lib/os_mon/test/memsup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(memsup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/os_mon/test/os_mon_SUITE.erl b/lib/os_mon/test/os_mon_SUITE.erl index 5c484ef2a6..0f7ae3a508 100644 --- a/lib/os_mon/test/os_mon_SUITE.erl +++ b/lib/os_mon/test/os_mon_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(os_mon_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl index e68a139a74..f8fb9e20fc 100644 --- a/lib/os_mon/test/os_mon_mib_SUITE.erl +++ b/lib/os_mon/test/os_mon_mib_SUITE.erl @@ -30,7 +30,7 @@ %% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg %%----------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("os_mon/include/OTP-OS-MON-MIB.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/os_mon/test/os_sup_SUITE.erl b/lib/os_mon/test/os_sup_SUITE.erl index 768d95aebc..5857faa0a6 100644 --- a/lib/os_mon/test/os_sup_SUITE.erl +++ b/lib/os_mon/test/os_sup_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(os_sup_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/otp_mibs/test/otp_mibs_SUITE.erl b/lib/otp_mibs/test/otp_mibs_SUITE.erl index abb5aa8194..4d1eb155cd 100644 --- a/lib/otp_mibs/test/otp_mibs_SUITE.erl +++ b/lib/otp_mibs/test/otp_mibs_SUITE.erl @@ -30,7 +30,7 @@ %% > ct_run -suite otp_mibs_SUITE -config otp_mibs_SUITE.cfg %%----------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("otp_mibs/include/OTP-MIB.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 1e3738de85..f5ff32c358 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -31,7 +31,7 @@ -define(privdir, "leex_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index 6603a5a07d..a1bb5eb16c 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -30,7 +30,7 @@ -define(privdir, "yecc_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl index 5a0a9af14d..0b1149e1f1 100644 --- a/lib/percept/test/egd_SUITE.erl +++ b/lib/percept/test/egd_SUITE.erl @@ -19,7 +19,7 @@ %% -module(egd_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/percept/test/percept_SUITE.erl b/lib/percept/test/percept_SUITE.erl index fd96c2b97a..06d62630ba 100644 --- a/lib/percept/test/percept_SUITE.erl +++ b/lib/percept/test/percept_SUITE.erl @@ -19,7 +19,7 @@ %% -module(percept_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/percept/test/percept_db_SUITE.erl b/lib/percept/test/percept_db_SUITE.erl index e2775aabc0..5b878e8462 100644 --- a/lib/percept/test/percept_db_SUITE.erl +++ b/lib/percept/test/percept_db_SUITE.erl @@ -19,7 +19,7 @@ %% -module(percept_db_SUITE). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/1]). diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 11dd753eed..fd9b8f23bd 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -31,7 +31,7 @@ -export([tracee1/1, tracee2/1]). -export([dummy/0, exported/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl index 03242784dd..6d39bc54f4 100644 --- a/lib/runtime_tools/test/dyntrace_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(dyntrace_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl index 9c0a643e91..a5c4801af9 100644 --- a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl +++ b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl @@ -22,7 +22,7 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/runtime_tools/test/runtime_tools_SUITE.erl b/lib/runtime_tools/test/runtime_tools_SUITE.erl index 7599026e7e..2a79f0a8f9 100644 --- a/lib/runtime_tools/test/runtime_tools_SUITE.erl +++ b/lib/runtime_tools/test/runtime_tools_SUITE.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(runtime_tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl index 940234f152..7469ec4d46 100644 --- a/lib/sasl/test/sasl_report_SUITE.erl +++ b/lib/sasl/test/sasl_report_SUITE.erl @@ -24,7 +24,7 @@ -export([crash_me/0,start_link/0,init/1,handle_cast/2,terminate/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/snmp/test/exp/snmp_agent_ms_test.erl b/lib/snmp/test/exp/snmp_agent_ms_test.erl index 3415fcc8e6..3010de0619 100644 --- a/lib/snmp/test/exp/snmp_agent_ms_test.erl +++ b/lib/snmp/test/exp/snmp_agent_ms_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_mt_test.erl b/lib/snmp/test/exp/snmp_agent_mt_test.erl index 89815e1044..71ae58baca 100644 --- a/lib/snmp/test/exp/snmp_agent_mt_test.erl +++ b/lib/snmp/test/exp/snmp_agent_mt_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v1_test.erl b/lib/snmp/test/exp/snmp_agent_v1_test.erl index ec243747df..55045d536e 100644 --- a/lib/snmp/test/exp/snmp_agent_v1_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v1_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v2_test.erl b/lib/snmp/test/exp/snmp_agent_v2_test.erl index ce95d0b5cd..6238a6c4bd 100644 --- a/lib/snmp/test/exp/snmp_agent_v2_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v2_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/exp/snmp_agent_v3_test.erl b/lib/snmp/test/exp/snmp_agent_v3_test.erl index 1ba06209b2..af7cee9b96 100644 --- a/lib/snmp/test/exp/snmp_agent_v3_test.erl +++ b/lib/snmp/test/exp/snmp_agent_v3_test.erl @@ -29,7 +29,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl index a03c2b8534..2cbba14c74 100644 --- a/lib/snmp/test/snmp_agent_mibs_test.erl +++ b/lib/snmp/test/snmp_agent_mibs_test.erl @@ -31,7 +31,7 @@ %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/include/SNMP-COMMUNITY-MIB.hrl"). diff --git a/lib/snmp/test/snmp_agent_nfilter_test.erl b/lib/snmp/test/snmp_agent_nfilter_test.erl index 16a9903198..8aeef81333 100644 --- a/lib/snmp/test/snmp_agent_nfilter_test.erl +++ b/lib/snmp/test/snmp_agent_nfilter_test.erl @@ -26,7 +26,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 412d62c6a1..93968ede2e 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -421,7 +421,7 @@ -define(application, snmp). -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 8ea7b2e081..6f20254fcb 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -69,7 +69,7 @@ -export([wait/5, run/4]). -include_lib("kernel/include/file.hrl"). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_app_test.erl b/lib/snmp/test/snmp_app_test.erl index 3b5b196ad6..6892d4aa93 100644 --- a/lib/snmp/test/snmp_app_test.erl +++ b/lib/snmp/test/snmp_app_test.erl @@ -45,7 +45,7 @@ -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index c83c4e0fed..b08181191f 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -29,7 +29,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl index 1d514cd1d2..73b471b107 100644 --- a/lib/snmp/test/snmp_conf_test.erl +++ b/lib/snmp/test/snmp_conf_test.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/STANDARD-MIB.hrl"). diff --git a/lib/snmp/test/snmp_log_test.erl b/lib/snmp/test/snmp_log_test.erl index b204522ee0..ae2581fb69 100644 --- a/lib/snmp/test/snmp_log_test.erl +++ b/lib/snmp/test/snmp_log_test.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index 47e150e8e8..8428b61e8a 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -32,7 +32,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/src/manager/snmpm_usm.hrl"). diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 3d05e5791f..a343dfdca7 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -32,7 +32,7 @@ %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). -include("snmp_test_data/Test2.hrl"). diff --git a/lib/snmp/test/snmp_manager_user.erl b/lib/snmp/test/snmp_manager_user.erl index 256ea6a834..55b1e23b2e 100644 --- a/lib/snmp/test/snmp_manager_user.erl +++ b/lib/snmp/test/snmp_manager_user.erl @@ -31,7 +31,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_old.erl b/lib/snmp/test/snmp_manager_user_old.erl index 0f0f026eca..f317fa831c 100644 --- a/lib/snmp/test/snmp_manager_user_old.erl +++ b/lib/snmp/test/snmp_manager_user_old.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_test.erl b/lib/snmp/test/snmp_manager_user_test.erl index a0cdcdef4d..64edfef4d5 100644 --- a/lib/snmp/test/snmp_manager_user_test.erl +++ b/lib/snmp/test/snmp_manager_user_test.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/snmp/test/snmp_manager_user_test_lib.erl b/lib/snmp/test/snmp_manager_user_test_lib.erl index a547f78efb..ea2c83a0da 100644 --- a/lib/snmp/test/snmp_manager_user_test_lib.erl +++ b/lib/snmp/test/snmp_manager_user_test_lib.erl @@ -30,7 +30,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("snmp_test_lib.hrl"). diff --git a/lib/stdlib/test/array_SUITE.erl b/lib/stdlib/test/array_SUITE.erl index ab4ca91f76..6fec03a2f7 100644 --- a/lib/stdlib/test/array_SUITE.erl +++ b/lib/stdlib/test/array_SUITE.erl @@ -20,7 +20,7 @@ -module(array_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). %% This should be set relatively high (10-15 times the expected diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index c102f6e929..5de7b661e5 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -28,7 +28,7 @@ -define(t,test_server). -define(privdir, "beam_lib_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir, ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 8a2df2bf85..8bb29b6a26 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -37,7 +37,7 @@ -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). % Some of these testcases are really heavy... diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl index f3a713abfd..47dd95f86b 100644 --- a/lib/stdlib/test/c_SUITE.erl +++ b/lib/stdlib/test/c_SUITE.erl @@ -23,7 +23,7 @@ -export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1, ls/1, memory/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(c, [c/2, nc/2]). diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl index 498b1f459c..bddc3a4821 100644 --- a/lib/stdlib/test/calendar_SUITE.erl +++ b/lib/stdlib/test/calendar_SUITE.erl @@ -19,7 +19,7 @@ %% -module(calendar_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index ad8829c471..ee3a812e24 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -28,7 +28,7 @@ -define(privdir(_), "./dets_SUITE_priv"). -define(datadir(_), "./dets_SUITE_data"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -define(datadir(Conf), ?config(data_dir, Conf)). diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index aff73b176d..92d31bb748 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -28,7 +28,7 @@ init_per_testcase/2,end_per_testcase/2, create/1,store/1,iterate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foldl/3]). diff --git a/lib/stdlib/test/digraph_SUITE.erl b/lib/stdlib/test/digraph_SUITE.erl index 9e007fe17d..97561196d8 100644 --- a/lib/stdlib/test/digraph_SUITE.erl +++ b/lib/stdlib/test/digraph_SUITE.erl @@ -24,7 +24,7 @@ -ifdef(STANDALONE). -define(line, put(line, ?LINE), ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/digraph_utils_SUITE.erl b/lib/stdlib/test/digraph_utils_SUITE.erl index 747ccf322c..e155857bd4 100644 --- a/lib/stdlib/test/digraph_utils_SUITE.erl +++ b/lib/stdlib/test/digraph_utils_SUITE.erl @@ -23,7 +23,7 @@ -ifdef(debug). -define(line, put(line, ?LINE), ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 6fdc4c35df..b0a07a95a3 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 4c007e76ad..0266a7fa6c 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -47,7 +47,7 @@ config(priv_dir, _) -> config(data_dir, _) -> filename:absname("./epp_SUITE_data"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl index 0369455846..79b27c6217 100644 --- a/lib/stdlib/test/erl_anno_SUITE.erl +++ b/lib/stdlib/test/erl_anno_SUITE.erl @@ -22,10 +22,10 @@ %-define(debug, true). -ifdef(debug). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), io:format(S, A)). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -endif. diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c21c4e61ee..1874ee1a1d 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -64,7 +64,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index 8cec445cb4..2cc4757c04 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -28,7 +28,7 @@ -define(privdir, "erl_expand_records_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index 0d2f535040..ad0b37aae3 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -26,7 +26,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 32247ba492..6d97ae2718 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -28,7 +28,7 @@ -define(privdir, "erl_lint_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 8a128b3815..f7418b1f5f 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -31,7 +31,7 @@ -define(privdir, "erl_pp_SUITE_priv"). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -endif. diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index db669aae99..941703b5dd 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -42,7 +42,7 @@ %% config(data_dir, _) -> %% ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Case, Config) when is_list(Config) -> diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl index c82b1b62ef..b2f1618ff5 100644 --- a/lib/stdlib/test/error_logger_h_SUITE.erl +++ b/lib/stdlib/test/error_logger_h_SUITE.erl @@ -25,7 +25,7 @@ %% Event handler exports. -export([init/1,handle_event/2,terminate/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 87ff6a68ff..a8d646c044 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -40,7 +40,7 @@ unicode/1 ]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 39d9ddaaa7..6f9be9b179 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -107,7 +107,7 @@ -export([t_select_reverse/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(m(A,B), ?line assert_eq(A,B)). diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl index 8a7f2b1ec2..5c2ab4747c 100644 --- a/lib/stdlib/test/ets_tough_SUITE.erl +++ b/lib/stdlib/test/ets_tough_SUITE.erl @@ -23,7 +23,7 @@ -export([init/1,terminate/2,handle_call/3,handle_info/2]). -export([init_per_testcase/2, end_per_testcase/2]). -compile([export_all]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/file_sorter_SUITE.erl b/lib/stdlib/test/file_sorter_SUITE.erl index e0d9ec1fd7..947dc2ad8d 100644 --- a/lib/stdlib/test/file_sorter_SUITE.erl +++ b/lib/stdlib/test/file_sorter_SUITE.erl @@ -28,7 +28,7 @@ -define(t,test_server). -define(privdir(_), "./file_sorter_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index c39ff842ee..5d5434c7b2 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -29,7 +29,7 @@ -import(lists, [foreach/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). init_per_testcase(_Case, Config) -> diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index 4372e77df9..8ecbc7eadf 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -29,7 +29,7 @@ dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]). -export([pathtype_bin/1,rootname_bin/1,split_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/fixtable_SUITE.erl b/lib/stdlib/test/fixtable_SUITE.erl index cf716032a1..66150e60c1 100644 --- a/lib/stdlib/test/fixtable_SUITE.erl +++ b/lib/stdlib/test/fixtable_SUITE.erl @@ -56,7 +56,7 @@ end_per_group(_GroupName, Config) -> Config. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%% I wrote this thinking I would use more than one temporary at a time, but %%% I wasn't... Well, maybe in the future... diff --git a/lib/stdlib/test/format_SUITE.erl b/lib/stdlib/test/format_SUITE.erl index 77636687cd..da28e085bb 100644 --- a/lib/stdlib/test/format_SUITE.erl +++ b/lib/stdlib/test/format_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index b019f98b69..e14f057720 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_event_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index e3da1a2271..c238232ef0 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_fsm_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test cases -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 0ae763a48d..634d868ad4 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -19,7 +19,7 @@ %% -module(gen_server_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl index 1cff990697..a0c3c9317a 100644 --- a/lib/stdlib/test/id_transform_SUITE.erl +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -31,7 +31,7 @@ % Serves as test... -hej(hopp). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 0e897631ff..821673559b 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -46,7 +46,7 @@ -define(t, test_server). -define(privdir(_), "./io_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 811c7ed7bb..97e6a90b76 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -47,7 +47,7 @@ -define(t, test_server). -define(privdir(_), "./io_SUITE_priv"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(privdir(Conf), ?config(priv_dir, Conf)). -endif. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index bd68c93779..257607f734 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -22,7 +22,7 @@ %%%----------------------------------------------------------------- -module(lists_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). diff --git a/lib/stdlib/test/log_mf_h_SUITE.erl b/lib/stdlib/test/log_mf_h_SUITE.erl index 86af3d4614..70d03dd46f 100644 --- a/lib/stdlib/test/log_mf_h_SUITE.erl +++ b/lib/stdlib/test/log_mf_h_SUITE.erl @@ -19,7 +19,7 @@ %% -module(log_mf_h_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 40a8b6ac81..f1f476433b 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -23,7 +23,7 @@ -module(maps_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index f02e82b39c..6bb518f46f 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -20,7 +20,7 @@ -module(ms_transform_SUITE). -author('pan@erix.ericsson.se'). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index f7a6a38138..a39a82b0df 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -44,7 +44,7 @@ -ifdef(STANDALONE). -define(line, noop, ). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 52fdb69b73..6f94e740eb 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -43,7 +43,7 @@ -define(testcase, current_testcase). % don't know -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). -define(testcase, ?config(?TESTCASE, Config)). diff --git a/lib/stdlib/test/queue_SUITE.erl b/lib/stdlib/test/queue_SUITE.erl index 5165ac3a3a..77fe6adb7c 100644 --- a/lib/stdlib/test/queue_SUITE.erl +++ b/lib/stdlib/test/queue_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 03b5ce1a25..ab260da950 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -33,7 +33,7 @@ -export([test/0, gen/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(3)). diff --git a/lib/stdlib/test/random_SUITE.erl b/lib/stdlib/test/random_SUITE.erl index 738f73ae15..701a3e3f33 100644 --- a/lib/stdlib/test/random_SUITE.erl +++ b/lib/stdlib/test/random_SUITE.erl @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index d78d6153da..bd495ce587 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -30,7 +30,7 @@ opt_no_start_optimize/1,opt_never_utf/1,opt_ucp/1, match_limit/1,sub_binaries/1,copt/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index 6796676179..f92971583a 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -38,7 +38,7 @@ -export([config/2]). -define(fmt(A,B),io:format(A,B)). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(fmt(A,B),test_server:format(A,B)). -endif. diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl index e7fc5595a9..06da696700 100644 --- a/lib/stdlib/test/sets_SUITE.erl +++ b/lib/stdlib/test/sets_SUITE.erl @@ -31,7 +31,7 @@ is_set/1,fold/1,filter/1, take_smallest/1,take_largest/1, iterate/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foldl/3,reverse/1]). diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index a9dd6b5817..5aa81594cb 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -52,7 +52,7 @@ config(priv_dir,_) -> ".". -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init_per_testcase/2, end_per_testcase/2]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(10)). diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl index 65627b3741..f01bf77550 100644 --- a/lib/stdlib/test/slave_SUITE.erl +++ b/lib/stdlib/test/slave_SUITE.erl @@ -19,7 +19,7 @@ %% -module(slave_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_start/1, t_start_link/1, diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index d23eb3abb9..9eed2893d4 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -27,7 +27,7 @@ -define(config(X,Y), foo). -define(t, test_server). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -endif. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index a586729b30..687e2fb6e8 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -21,7 +21,7 @@ %%% Purpose:Stdlib application test suite. %%%----------------------------------------------------------------- -module(stdlib_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 53eea6f180..6ac3950f44 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -21,7 +21,7 @@ %%% Purpose: string test suite. %%%----------------------------------------------------------------- -module(string_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % Default timetrap timeout (set in init_per_testcase). diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl index b55fbfaf0d..94e719bea1 100644 --- a/lib/stdlib/test/supervisor_bridge_SUITE.erl +++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl @@ -24,7 +24,7 @@ simple_global_supervisor/1]). -export([client/1,init/1,internal_loop_init/1,terminate/2,server9212/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(bridge_name,supervisor_bridge_SUITE_server). -define(work_bridge_name,work_supervisor_bridge_SUITE_server). diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index 573fa6f358..102a147fcd 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2,log/1,log_to_file/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"). +-include_lib("common_test/include/ct.hrl"). -define(server,sys_SUITE_server). diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 6da017f818..a22eaa1d3a 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -26,7 +26,7 @@ extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1, memory/1,unicode/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl index 10dcfad76f..e4d656c9bf 100644 --- a/lib/stdlib/test/timer_SUITE.erl +++ b/lib/stdlib/test/timer_SUITE.erl @@ -24,7 +24,7 @@ -export([big_test/1, collect/3, i_t/3, a_t/2]). -export([do_nrev/1, internal_watchdog/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Random test of the timer module. This is a really nasty test, as it %% runs a lot of timeouts and then checks in the end if any of them diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl index 93fbc3a032..42b96c4b1c 100644 --- a/lib/stdlib/test/timer_simple_SUITE.erl +++ b/lib/stdlib/test/timer_simple_SUITE.erl @@ -51,7 +51,7 @@ timer/4, timer/5]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(MAXREF, (1 bsl 18)). -define(REFMARG, 30). diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 8bb2555213..f45e00928e 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -19,7 +19,7 @@ %% -module(unicode_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/win32reg_SUITE.erl b/lib/stdlib/test/win32reg_SUITE.erl index 82baa43318..982cc86979 100644 --- a/lib/stdlib/test/win32reg_SUITE.erl +++ b/lib/stdlib/test/win32reg_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2,long/1,evil_write/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/stdlib/test/y2k_SUITE.erl b/lib/stdlib/test/y2k_SUITE.erl index 9e766e80ab..d80dd10631 100644 --- a/lib/stdlib/test/y2k_SUITE.erl +++ b/lib/stdlib/test/y2k_SUITE.erl @@ -22,7 +22,7 @@ -module(y2k_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index c275053691..135bfd5867 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -28,8 +28,7 @@ compress_control/1, foldl/1]). --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -include_lib("stdlib/include/zip.hrl"). diff --git a/lib/syntax_tools/test/merl_SUITE.erl b/lib/syntax_tools/test/merl_SUITE.erl index 125250395a..945972d405 100644 --- a/lib/syntax_tools/test/merl_SUITE.erl +++ b/lib/syntax_tools/test/merl_SUITE.erl @@ -16,7 +16,7 @@ %% -module(merl_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% include the Merl header file -include_lib("syntax_tools/include/merl.hrl"). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 40e00e0554..eb52cce6af 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -18,7 +18,7 @@ %% -module(syntax_tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/test_server/doc/src/example_chapter.xml b/lib/test_server/doc/src/example_chapter.xml index ec152fdd6c..43fd4d9d53 100644 --- a/lib/test_server/doc/src/example_chapter.xml +++ b/lib/test_server/doc/src/example_chapter.xml @@ -43,7 +43,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/test_server/src/things/distr_startup_SUITE.erl b/lib/test_server/src/things/distr_startup_SUITE.erl index aa84ab007f..2423566fc0 100644 --- a/lib/test_server/src/things/distr_startup_SUITE.erl +++ b/lib/test_server/src/things/distr_startup_SUITE.erl @@ -20,7 +20,7 @@ -module(distr_startup_SUITE). -compile([export_all]). %%-define(line_trace,1). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/things/mnesia_power_SUITE.erl b/lib/test_server/src/things/mnesia_power_SUITE.erl index e9bc75e583..84a41d6594 100644 --- a/lib/test_server/src/things/mnesia_power_SUITE.erl +++ b/lib/test_server/src/things/mnesia_power_SUITE.erl @@ -20,7 +20,7 @@ -module(mnesia_power_SUITE). -compile([export_all]). %%-define(line_trace,1). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/things/random_kill_SUITE.erl b/lib/test_server/src/things/random_kill_SUITE.erl index 917bc2b3d5..4dc44b108a 100644 --- a/lib/test_server/src/things/random_kill_SUITE.erl +++ b/lib/test_server/src/things/random_kill_SUITE.erl @@ -20,7 +20,7 @@ -module(random_kill_SUITE). -compile([export_all]). %%-define(line_trace,1). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl index 0178f4d836..921edb264a 100644 --- a/lib/test_server/src/ts_make.erl +++ b/lib/test_server/src/ts_make.erl @@ -21,7 +21,7 @@ -export([make/1,make/3,unmake/1]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Functions to be called from make test cases. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl index 79d8defb22..c3d4315cb8 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -22,8 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_SUITE). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -export([all/1]). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl index ae9f018bc8..171f83df0f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl @@ -28,7 +28,7 @@ break_in_end_tc_after_abort/1, check_all_breaks/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [break_in_init_tc, diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl index f634bc3a46..e4f40f6c03 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_conf01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl index f9cca8653b..1c6fe6dd0b 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_conf02_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl index ab5ccec7a2..3371418980 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl @@ -23,7 +23,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). -export([tc1/1, tc2/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [tc1,tc2]. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl index 0385435710..ad639b585d 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_parallel01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 80ac9f6b3d..0f7118a810 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl @@ -22,7 +22,7 @@ %%% Test Server self test. %%%------------------------------------------------------------------ -module(test_server_shuffle01_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl index 871bd21ee7..ae2321c6ad 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl @@ -22,8 +22,7 @@ -export([all/1, init_per_suite/1, end_per_suite/1]). -export([dummy/1]). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> [dummy]. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl index 3a3366218b..0cabce995f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl @@ -25,7 +25,7 @@ print_and_log_unicode/1, print_and_log_latin1/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). all(suite) -> ['#=@: difficult_case_name_äöå', diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 71570a55fa..b9a9cd5be4 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -21,7 +21,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl index 7b22dea7ed..8beaf4f399 100644 --- a/lib/tools/test/cprof_SUITE.erl +++ b/lib/tools/test/cprof_SUITE.erl @@ -42,7 +42,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). diff --git a/lib/tools/test/emem_SUITE.erl b/lib/tools/test/emem_SUITE.erl index 95cda98558..93d21623ce 100644 --- a/lib/tools/test/emem_SUITE.erl +++ b/lib/tools/test/emem_SUITE.erl @@ -43,7 +43,7 @@ -include_lib("kernel/include/file.hrl"). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMEOUT, ?t:minutes(5)). diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 5428643667..6274eabc37 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -19,7 +19,7 @@ %% -module(eprof_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index e8f179c630..d1a673d6b7 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -19,7 +19,7 @@ %% -module(fprof_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server framework exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, diff --git a/lib/tools/test/ignore_cores.erl b/lib/tools/test/ignore_cores.erl index 13f34cd10f..e40b91392c 100644 --- a/lib/tools/test/ignore_cores.erl +++ b/lib/tools/test/ignore_cores.erl @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index 3b981a9303..773d805cd0 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -25,7 +25,7 @@ -export(['+Mim true'/1, '+Mis true'/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> ?line Dog=?t:timetrap(10000), diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index f3789a4137..47b8031bee 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lcnt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl index 70bc8502bf..fdcc310df1 100644 --- a/lib/tools/test/make_SUITE.erl +++ b/lib/tools/test/make_SUITE.erl @@ -25,7 +25,7 @@ otp_6057_a/1, otp_6057_b/1, otp_6057_c/1, otp_6057_end/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/tools/test/tools_SUITE.erl b/lib/tools/test/tools_SUITE.erl index 9403124c96..ae2a69305b 100644 --- a/lib/tools/test/tools_SUITE.erl +++ b/lib/tools/test/tools_SUITE.erl @@ -19,7 +19,7 @@ %% -module(tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 71c8b1a277..53aa80d2a3 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -30,7 +30,7 @@ -define(privdir, "xref_SUITE_priv"). -define(copydir, "xref_SUITE_priv/datacopy"). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(datadir, ?config(data_dir, Conf)). -define(privdir, ?config(priv_dir, Conf)). diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index 7ddf1066de..672f8a43d1 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index afd39b6598..2e026d7476 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -10,7 +10,7 @@ -export([test/0, check_node_set/2, ticket_6873/0, ticket_7496/0, functions/0]). -export([namespaces/0]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). test() -> diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl index 4cde46826e..f5c65b0c63 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_lib.erl @@ -9,7 +9,7 @@ -export([test/0,check_node_set/2,ticket_6873/0]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). test() -> diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl index e39ad6bcb0..c3a1fb9c4d 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_text.erl @@ -9,7 +9,7 @@ -compile(export_all). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -import(xmerl_xs, diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl index a15d9bd57c..f0e80f81d3 100644 --- a/lib/xmerl/test/xmerl_sax_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %%====================================================================== diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl index 70e768ff04..b820bd5bc2 100644 --- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl @@ -27,7 +27,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). %%====================================================================== diff --git a/lib/xmerl/test/xmerl_std_SUITE.erl b/lib/xmerl/test/xmerl_std_SUITE.erl index 0ef44bb04e..d3e28353e2 100644 --- a/lib/xmerl/test/xmerl_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_std_SUITE.erl @@ -25,7 +25,7 @@ %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). diff --git a/lib/xmerl/test/xmerl_test_lib.erl b/lib/xmerl/test/xmerl_test_lib.erl index 62689353f2..aa8a86138a 100644 --- a/lib/xmerl/test/xmerl_test_lib.erl +++ b/lib/xmerl/test/xmerl_test_lib.erl @@ -28,7 +28,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). %% cmp_element/2 diff --git a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl index ee648dc455..7393a878e2 100644 --- a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl index 634e47ba7b..6a645b255e 100644 --- a/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_NIST2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_SUITE.erl b/lib/xmerl/test/xmerl_xsd_SUITE.erl index 92c8287782..e1ce8525c7 100644 --- a/lib/xmerl/test/xmerl_xsd_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_SUITE.erl @@ -25,7 +25,7 @@ -compile(export_all). %%-export([Function/Arity, ...]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%-include("xmerl.hrl"). -include_lib("xmerl/include/xmerl.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl index 5ad6bb94fb..5057e70956 100644 --- a/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_Sun2002-01-16_SUITE.erl @@ -27,7 +27,7 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("xmerl/include/xmerl.hrl"). -include_lib("xmerl/include/xmerl_xsd.hrl"). diff --git a/lib/xmerl/test/xmerl_xsd_lib.erl b/lib/xmerl/test/xmerl_xsd_lib.erl index 892706609f..58fb6a27cc 100644 --- a/lib/xmerl/test/xmerl_xsd_lib.erl +++ b/lib/xmerl/test/xmerl_xsd_lib.erl @@ -32,7 +32,7 @@ -compile(export_all). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("xmerl.hrl"). -include("xmerl_xsd.hrl"). -include_lib("kernel/include/file.hrl"). -- cgit v1.2.3 From 4e1162bbdf88465a03da165c088ad1256b816956 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 15 Feb 2016 16:04:32 +0100 Subject: Makefiles: Remove test_server from include path and code path Since no test suites includede test_server.hrl, there is no need to have test_server in the include path or code path. --- erts/emulator/test/Makefile | 2 +- erts/test/Makefile | 2 +- lib/common_test/src/Makefile | 3 +-- lib/common_test/test/Makefile | 4 ++-- lib/compiler/test/Makefile | 2 +- lib/cosEvent/test/Makefile | 4 +--- lib/cosEventDomain/test/Makefile | 4 +--- lib/cosFileTransfer/test/Makefile | 4 +--- lib/cosNotification/test/Makefile | 4 +--- lib/cosProperty/test/Makefile | 4 +--- lib/cosTime/test/Makefile | 4 +--- lib/cosTransactions/test/Makefile | 4 +--- lib/crypto/test/Makefile | 2 +- lib/debugger/test/Makefile | 2 +- lib/edoc/test/Makefile | 2 +- lib/erl_docgen/test/Makefile | 2 +- lib/eunit/test/Makefile | 4 ++-- lib/gs/test/Makefile | 2 +- lib/hipe/test/Makefile | 2 +- lib/ic/test/Makefile | 4 +--- lib/inets/test/Makefile | 2 -- lib/kernel/test/Makefile | 2 +- lib/megaco/test/Makefile | 5 +---- lib/observer/test/Makefile | 6 ++---- lib/odbc/test/Makefile | 2 +- lib/orber/test/Makefile | 4 +--- lib/os_mon/test/Makefile | 3 +-- lib/otp_mibs/test/Makefile | 1 - lib/parsetools/test/Makefile | 2 +- lib/percept/test/Makefile | 3 +-- lib/runtime_tools/test/Makefile | 2 +- lib/sasl/test/Makefile | 3 +-- lib/snmp/test/Makefile | 1 - lib/ssh/test/Makefile | 6 ++---- lib/ssl/test/Makefile | 5 ++--- lib/stdlib/test/Makefile | 3 +-- lib/syntax_tools/test/Makefile | 2 +- lib/tools/test/Makefile | 3 +-- lib/typer/test/Makefile | 2 +- lib/xmerl/test/Makefile | 2 +- 40 files changed, 42 insertions(+), 78 deletions(-) diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 8cc47937b7..987a655c3d 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -158,7 +158,7 @@ RELSYSDIR = $(RELEASE_PATH)/emulator_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += # ---------------------------------------------------- # Targets diff --git a/erts/test/Makefile b/erts/test/Makefile index 5263d8cd4f..a01d67e34f 100644 --- a/erts/test/Makefile +++ b/erts/test/Makefile @@ -54,7 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/system_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += # ---------------------------------------------------- # Targets diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 987345c679..34c94d5032 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -101,8 +101,7 @@ DTD_FILES = \ # FLAGS # ---------------------------------------------------- ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \ - -I../../test_server/include -I../../xmerl/inc/ \ - -I $(ERL_TOP)/lib/kernel/include -Werror + -I../../xmerl/inc/ -I $(ERL_TOP)/lib/kernel/include -Werror # ---------------------------------------------------- # Targets diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index ff4495b104..c17fb07446 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -84,8 +84,8 @@ RELSYSDIR = $(RELEASE_PATH)/common_test_test # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 400565100f..c2d757da4d 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -109,7 +109,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0 +ERL_COMPILE_FLAGS += +clint +clint0 EBIN = . diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile index 2d29afd20d..028b0221b6 100644 --- a/lib/cosEvent/test/Makefile +++ b/lib/cosEvent/test/Makefile @@ -96,12 +96,10 @@ TARGET_FILES = \ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEvent/ebin \ -pa $(ERL_TOP)/lib/cosEvent/test/idl_output \ -I$(ERL_TOP)/lib/cosEvent \ - -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosEventDomain/test/Makefile b/lib/cosEventDomain/test/Makefile index 1bbd1f1693..d8f6a863d6 100644 --- a/lib/cosEventDomain/test/Makefile +++ b/lib/cosEventDomain/test/Makefile @@ -61,15 +61,13 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEventDomain/ebin \ -pa $(ERL_TOP)/lib/cosEventDomain/include \ -pa $(ERL_TOP)/lib/cosNotification/ebin \ -pa $(ERL_TOP)/lib/cosNotification/include \ -I$(ERL_TOP)/lib/cosEventDomain/include \ -I$(ERL_TOP)/lib/cosNotification/include \ - -I$(ERL_TOP)/lib/cosNotification/ebin \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosNotification/ebin # ---------------------------------------------------- # Targets diff --git a/lib/cosFileTransfer/test/Makefile b/lib/cosFileTransfer/test/Makefile index 39512d83bd..332f90cb39 100644 --- a/lib/cosFileTransfer/test/Makefile +++ b/lib/cosFileTransfer/test/Makefile @@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ -pa $(ERL_TOP)/lib/cosProperty/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosFileTransfer/ebin \ -pa $(ERL_TOP)/lib/cosFileTransfer/include \ -pa $(ERL_TOP)/lib/cosFileTransfer/test/idl_output \ @@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosFileTransfer/src \ -I$(ERL_TOP)/lib/cosFileTransfer/include \ -I$(ERL_TOP)/lib/cosFileTransfer \ - -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile index 1db6d2bc14..5a4c5e18aa 100644 --- a/lib/cosNotification/test/Makefile +++ b/lib/cosNotification/test/Makefile @@ -128,7 +128,6 @@ ERL_IDL_FLAGS += \ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosEvent/ebin \ -pa $(ERL_TOP)/lib/cosNotification/ebin \ -pa $(ERL_TOP)/lib/cosNotification/test/idl_output \ @@ -142,8 +141,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosNotification/src \ -I$(ERL_TOP)/lib/cosNotification/include \ -I$(ERL_TOP)/lib/cosNotification \ - -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosProperty/test/Makefile b/lib/cosProperty/test/Makefile index ec928a9789..b5e063129d 100644 --- a/lib/cosProperty/test/Makefile +++ b/lib/cosProperty/test/Makefile @@ -82,14 +82,12 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosProperty/ebin \ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosProperty/ebin \ -pa $(ERL_TOP)/lib/cosProperty/test/idl_output \ -I$(ERL_TOP)/lib/orber/include \ -I$(ERL_TOP)/lib/cosProperty/src \ -I$(ERL_TOP)/lib/cosProperty \ - -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosProperty/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosTime/test/Makefile b/lib/cosTime/test/Makefile index aabf855af5..003ea886a3 100644 --- a/lib/cosTime/test/Makefile +++ b/lib/cosTime/test/Makefile @@ -85,7 +85,6 @@ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ -pa $(ERL_TOP)/lib/cosNotification/include \ - -pa $(ERL_TOP)/internal_tools/test_server/ebin \ -pa $(ERL_TOP)/lib/cosTime/ebin \ -pa $(ERL_TOP)/lib/cosTime/include \ -pa $(ERL_TOP)/lib/cosTime/test/idl_output \ @@ -94,8 +93,7 @@ ERL_COMPILE_FLAGS += \ -I$(ERL_TOP)/lib/cosTime/src \ -I$(ERL_TOP)/lib/cosTime/include \ -I$(ERL_TOP)/lib/cosTime \ - -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile index 3cdb05e7ef..9bcd461f04 100644 --- a/lib/cosTransactions/test/Makefile +++ b/lib/cosTransactions/test/Makefile @@ -93,13 +93,11 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTransactions/ebin\ ERL_COMPILE_FLAGS += \ $(ERL_IDL_FLAGS) \ -pa $(ERL_TOP)/lib/orber/include \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/cosTransactions/ebin \ -pa $(ERL_TOP)/lib/cosTransactions/test/idl_output \ -I$(ERL_TOP)/lib/orber/include \ -I$(ERL_TOP)/lib/cosTransactions \ - -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/cosTransactions/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index 07e5c1b754..928a1b1d73 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -28,7 +28,7 @@ RELSYSDIR = $(RELEASE_PATH)/crypto_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 82f49c155f..1594c891b4 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -68,7 +68,7 @@ RELSYSDIR = $(RELEASE_PATH)/debugger_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/edoc/test/Makefile b/lib/edoc/test/Makefile index 2033e003b3..7a03ddeba9 100644 --- a/lib/edoc/test/Makefile +++ b/lib/edoc/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/edoc_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/erl_docgen/test/Makefile b/lib/erl_docgen/test/Makefile index 9f4cc04105..9e58157023 100644 --- a/lib/erl_docgen/test/Makefile +++ b/lib/erl_docgen/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/erl_docgen_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/eunit/test/Makefile b/lib/eunit/test/Makefile index 8721bacf89..6f166f99aa 100644 --- a/lib/eunit/test/Makefile +++ b/lib/eunit/test/Makefile @@ -41,8 +41,8 @@ RELSYSDIR = $(RELEASE_PATH)/eunit_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/gs/test/Makefile b/lib/gs/test/Makefile index 493770745f..067e1adbb6 100644 --- a/lib/gs/test/Makefile +++ b/lib/gs/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/gs_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index d781e4f9be..09f4fd2129 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -36,7 +36,7 @@ RELSYSDIR = $(RELEASE_PATH)/hipe_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/ic/test/Makefile b/lib/ic/test/Makefile index 576ffc4eff..93cbaf4dfe 100644 --- a/lib/ic/test/Makefile +++ b/lib/ic/test/Makefile @@ -209,10 +209,8 @@ ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += \ $(ERL_LOCAL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/orber/ebin \ - -I$(ERL_TOP)/lib/orber \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/orber # ---------------------------------------------------- # Targets diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 607ec7c182..67c979bd59 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -42,7 +42,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- INCLUDES = -I. \ - -I$(ERL_TOP)/lib/test_server/include/ \ -I$(ERL_TOP)/lib/inets/src/inets_app \ -I$(ERL_TOP)/lib/inets/src/http_lib \ -I$(ERL_TOP)/lib/inets/src/http_client \ @@ -238,7 +237,6 @@ RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin # running the target "targets". # ---------------------------------------------------- ERL_COMPILE_FLAGS += \ - -pa ../../../internal_tools/test_server/ebin \ $(INCLUDES) \ $(FTP_FLAGS) \ $(INETS_FLAGS) diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index 9e972b4f95..ba40dd3168 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -112,7 +112,7 @@ RELSYSDIR = $(RELEASE_PATH)/kernel_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/megaco/test/Makefile b/lib/megaco/test/Makefile index 06ecc06d20..d621b0f16d 100644 --- a/lib/megaco/test/Makefile +++ b/lib/megaco/test/Makefile @@ -100,10 +100,7 @@ ifeq ($(USE_MEGACO_HIPE),true) ERL_COMPILE_FLAGS += +native -Dmegaco_hipe_special=true endif -ERL_COMPILE_FLAGS += \ - $(MEGACO_ERL_COMPILE_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ - -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += $(MEGACO_ERL_COMPILE_FLAGS) ERL_PATH = -pa ../../megaco/examples/simple \ -pa ../../megaco/ebin \ diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index e8bb7d0a52..6100af5e17 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -45,8 +45,8 @@ RELSYSDIR = $(RELEASE_PATH)/observer_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += EBIN = . @@ -60,8 +60,6 @@ make_emakefile: $(MODULES) > $(EMAKEFILE) tests debug opt: make_emakefile - cd $(ERL_TOP)/lib/test_server/src && \ - $(MAKE) ../ebin/test_server_line.beam erl $(ERL_MAKE_FLAGS) -make clean: diff --git a/lib/odbc/test/Makefile b/lib/odbc/test/Makefile index 114eb5373d..4fecea3aae 100644 --- a/lib/odbc/test/Makefile +++ b/lib/odbc/test/Makefile @@ -21,7 +21,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -INCLUDES= -I. -I$(ERL_TOP)/lib/test_server/include/ -I$(ERL_TOP)/lib/odbc/src +INCLUDES= -I. -I$(ERL_TOP)/lib/odbc/src # ---------------------------------------------------- # Target Specs diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index b9be48c790..1d4e3c70f0 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -162,12 +162,10 @@ TARGET_FILES = \ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ -pa $(ERL_TOP)/lib/ic/ebin \ -pa $(ERL_TOP)/lib/orber/ebin \ -I$(ERL_TOP)/lib/orber \ - -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR) \ - -I$(ERL_TOP)/lib/test_server/include + -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR) # ---------------------------------------------------- # Targets diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile index cdfc13a4c1..aace77a3f0 100644 --- a/lib/os_mon/test/Makefile +++ b/lib/os_mon/test/Makefile @@ -55,8 +55,7 @@ RELSYSDIR = $(RELEASE_PATH)/os_mon_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/snmp/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/snmp/include # ---------------------------------------------------- # Targets diff --git a/lib/otp_mibs/test/Makefile b/lib/otp_mibs/test/Makefile index e1cfbb347d..18d7e915db 100644 --- a/lib/otp_mibs/test/Makefile +++ b/lib/otp_mibs/test/Makefile @@ -49,7 +49,6 @@ RELSYSDIR = $(RELEASE_PATH)/otp_mibs_test # ---------------------------------------------------- ERL_MAKE_FLAGS += ERL_COMPILE_FLAGS += \ - -I$(ERL_TOP)/lib/test_server/include \ -I$(ERL_TOP)/lib/snmp/include # ---------------------------------------------------- diff --git a/lib/parsetools/test/Makefile b/lib/parsetools/test/Makefile index f84bb0e75e..75f9624fd5 100644 --- a/lib/parsetools/test/Makefile +++ b/lib/parsetools/test/Makefile @@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/parsetools_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile index 4ba0b80fc8..6891de832d 100644 --- a/lib/percept/test/Makefile +++ b/lib/percept/test/Makefile @@ -52,8 +52,7 @@ RELSYSDIR = $(RELEASE_PATH)/percept_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/percept/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include # ---------------------------------------------------- # Targets diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index 71ac8b1157..432a361468 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -27,7 +27,7 @@ RELSYSDIR = $(RELEASE_PATH)/runtime_tools_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/sasl/test/Makefile b/lib/sasl/test/Makefile index 86976def6a..6f67498714 100644 --- a/lib/sasl/test/Makefile +++ b/lib/sasl/test/Makefile @@ -55,8 +55,7 @@ RELSYSDIR = $(RELEASE_PATH)/sasl_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/sasl/src +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/sasl/src EBIN = . diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 3261982a32..8e895bc5b1 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -150,7 +150,6 @@ ERL_COMPILE_FLAGS += -I../../snmp/src/app \ -I../../snmp/src/misc \ -I../../snmp/src/agent \ -I../../snmp/src/manager \ - -I$(ERL_TOP)/lib/test_server/include \ -I../../snmp/include \ -Dsnmp_test_data=snmp_test_data \ -Dversion=\"$(VSN)$(PRE_VSN)\" \ diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 9cd98f069f..fb539f98fa 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -64,8 +64,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) DATA_DIRS = $(MODULES:%=%_data) -INCLUDES = -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/ssh/src \ +INCLUDES = -I$(ERL_TOP)/lib/ssh/src EMAKEFILE=Emakefile MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) @@ -88,8 +87,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssh_test # The path to the test_server ebin dir is needed when # running the target "targets". # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \ - $(INCLUDES) +ERL_COMPILE_FLAGS += $(INCLUDES) EBIN = . diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 999df320a3..89a62c3a4b 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -81,7 +81,7 @@ HRL_FILES_NEEDED_IN_TEST = \ TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INCLUDES = -I. -I$(ERL_TOP)/lib/test_server/include/ +INCLUDES = -I. DATADIRS = ssl_basic_SUITE_data @@ -100,8 +100,7 @@ RELSYSDIR = $(RELEASE_PATH)/ssl_test # The path to the test_server ebin dir is needed when # running the target "targets". # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \ - $(INCLUDES) +ERL_COMPILE_FLAGS += $(INCLUDES) # ---------------------------------------------------- # Targets diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index e366c2b755..287f63b2be 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -107,8 +107,7 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include \ +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/include \ -I$(ERL_TOP)/lib/stdlib/include EBIN = . diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile index 569c044b1a..4ace860223 100644 --- a/lib/syntax_tools/test/Makefile +++ b/lib/syntax_tools/test/Makefile @@ -26,7 +26,7 @@ RELSYSDIR = $(RELEASE_PATH)/syntax_tools_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 49b86628b7..8768413dc1 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -53,8 +53,7 @@ RELSYSDIR = $(RELEASE_PATH)/tools_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/percept/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include EBIN = . diff --git a/lib/typer/test/Makefile b/lib/typer/test/Makefile index d6dd22b6cf..fb5570d9f0 100644 --- a/lib/typer/test/Makefile +++ b/lib/typer/test/Makefile @@ -25,7 +25,7 @@ RELSYSDIR = $(RELEASE_PATH)/typer_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile index f9c03336c8..14e11d5fc4 100644 --- a/lib/xmerl/test/Makefile +++ b/lib/xmerl/test/Makefile @@ -84,7 +84,7 @@ RELSYSDIR = $(RELEASE_PATH)/xmerl_test # FLAGS # ---------------------------------------------------- -#ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include -I$(ERL_TOP)/lib/xmerl/include/ $(XMERL_PRESERV_TEST_DIRS) +ERL_COMPILE_FLAGS += # ---------------------------------------------------- -- cgit v1.2.3 From 851f29e7eb906ffbd1a2871eaae6f5038728d763 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Feb 2016 12:24:54 +0100 Subject: Remove out-commented references to the test_server applications Cleanliness. --- lib/asn1/test/asn1_SUITE_data/test_records.erl | 3 --- lib/kernel/test/global_SUITE.erl | 2 +- lib/sasl/test/systools_rc_SUITE.erl | 4 ---- 3 files changed, 1 insertion(+), 8 deletions(-) diff --git a/lib/asn1/test/asn1_SUITE_data/test_records.erl b/lib/asn1/test/asn1_SUITE_data/test_records.erl index adfc98600c..65716bb0dc 100644 --- a/lib/asn1/test/asn1_SUITE_data/test_records.erl +++ b/lib/asn1/test/asn1_SUITE_data/test_records.erl @@ -23,9 +23,6 @@ -export(['check_record_names_OTP-5812'/1]). -%-include("test_server.hrl"). -%-include_lib("test_server/include/test_server.hrl"). - -define(line,put(test_server_loc,{?MODULE,?LINE}),). -include("NBAP-PDU-Discriptions.hrl"). diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 0b96e7a68b..0046fdafa4 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -1349,7 +1349,7 @@ stress_partition(Config) when is_list(Config) -> %% Use this one to test alot of connection tests -%% erl -sname ts -rsh ctrsh -pa /clearcase/otp/internal_tools/test_server/ebin/ -ring_line 10000 -s test_server run_test global_SUITE +%% erl -sname ts -ring_line 10000 -s test_server run_test global_SUITE ring_line(suite) -> []; ring_line(doc) -> [""]; diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl index 3754ed99f2..2ecb6f107a 100644 --- a/lib/sasl/test/systools_rc_SUITE.erl +++ b/lib/sasl/test/systools_rc_SUITE.erl @@ -26,10 +26,6 @@ translate_emulator_restarts/1, translate_add_delete_module/1]). -%%----------------------------------------------------------------- -%% erl -compile systools_rc_SUITE @i ../src/ @i ../../test_server/include/ -%% c(systools_rc_SUITE, [{i, "../src"}, {i, "../../test_server/include"}]). -%%----------------------------------------------------------------- all() -> [syntax_check, translate, translate_app, translate_emulator_restarts, translate_add_delete_module]. -- cgit v1.2.3 From 40aaa8bfa8ec0776a4d70079cf34a5bd337d42fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Feb 2016 14:29:58 +0100 Subject: Erlang mode for Emacs: Include ct.hrl instead test_server.hrl --- lib/tools/emacs/erlang-skels-old.el | 2 +- lib/tools/emacs/erlang-skels.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/tools/emacs/erlang-skels-old.el b/lib/tools/emacs/erlang-skels-old.el index c271cce3cb..d0b2bfd97f 100644 --- a/lib/tools/emacs/erlang-skels-old.el +++ b/lib/tools/emacs/erlang-skels-old.el @@ -816,7 +816,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator 2) "%% TEST SERVER CALLBACK FUNCTIONS" n diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 6880ec733c..ac37ff2ee5 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1070,7 +1070,7 @@ Please see the function `tempo-define-template'.") "%% Note: This directive should only be used in test suites." n "-compile(export_all)." n n - "-include_lib(\"test_server/include/test_server.hrl\")." n n + "-include_lib(\"common_test/include/ct.hrl\")." n n (erlang-skel-separator-start 2) "%% TEST SERVER CALLBACK FUNCTIONS" n -- cgit v1.2.3 From dcda9b507bf14391c8bed91bfa9c56355342b681 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Feb 2016 06:45:27 +0100 Subject: Remove test_server as a standalone application The test_server application has previously been deprecated. In OTP 19, we will move relevant parts of test_server into the common_test application. Test suites that include test_server.hrl must be updated to include ct.hrl instead. Test suites that include test_server_line.hrl must removed that inclusion. Test suites that call the test_server module directly will continue to work in OTP 19. The test suites for Erlang/OTP are built and executed in exactly the same way as previously. Here are some more details. The modules test_server*.erl and erl2html2.erl in lib/test_server/src have been moved to common_test/src. The test_server.hrl and test_server_line.hrl include files have been deleted. The macros in test_server.hrl have been copied into lib/common_test/include/ct.hrl. The ts*.erl modules and their associated data files in lib/test_server/src has been been moved to the new directory lib/common_test/test_server. The ts* modules are no longer built to lib/common_test/ebin. They will only built when 'make release_tests' is executed. The test suite for test_server has been moved to lib/common_test/test. The rest of the files have been deleted. --- .gitignore | 9 +- Makefile.in | 15 +- lib/Makefile | 3 +- lib/common_test/include/ct.hrl | 8 +- lib/common_test/src/Makefile | 10 +- lib/common_test/src/ct_run.erl | 4 +- lib/common_test/src/erl2html2.erl | 311 ++ lib/common_test/src/test_server.app.src | 39 + lib/common_test/src/test_server.appup.src | 22 + lib/common_test/src/test_server.erl | 2655 +++++++++ lib/common_test/src/test_server_ctrl.erl | 5652 ++++++++++++++++++++ lib/common_test/src/test_server_gl.erl | 301 ++ lib/common_test/src/test_server_internal.hrl | 61 + lib/common_test/src/test_server_io.erl | 452 ++ lib/common_test/src/test_server_node.erl | 758 +++ lib/common_test/src/test_server_sup.erl | 939 ++++ lib/common_test/test/Makefile | 8 +- lib/common_test/test/common_test.cover | 7 - lib/common_test/test/erl2html2_SUITE.erl | 277 + .../test/erl2html2_SUITE_data/Makefile.src | 2 + .../test/erl2html2_SUITE_data/header1.hrl | 4 + .../test/erl2html2_SUITE_data/include/header2.hrl | 0 .../test/erl2html2_SUITE_data/include/header3.hrl | 1 + lib/common_test/test/erl2html2_SUITE_data/m1.erl | 52 + lib/common_test/test/test_server_SUITE.erl | 449 ++ .../test/test_server_SUITE_data/Makefile.src | 11 + .../test_server_SUITE_data/test_server_SUITE.erl | 514 ++ .../test_server_SUITE_data/dummy_file | 1 + .../test_server_break_SUITE.erl | 149 + .../test_server_conf01_SUITE.erl | 188 + .../test_server_conf02_SUITE.erl | 295 + .../test_server_cover_SUITE.erl | 59 + .../test_server_cover_SUITE_data/cover_helper.erl | 4 + .../test_server_parallel01_SUITE.erl | 519 ++ .../test_server_shuffle01_SUITE.erl | 477 ++ .../test_server_skip_SUITE.erl | 43 + .../test_server_unicode_SUITE.erl | 82 + lib/common_test/test/test_server_test_lib.erl | 217 + lib/common_test/test/test_server_test_lib.hrl | 23 + lib/common_test/test_server/Makefile | 96 + lib/common_test/test_server/conf_vars.in | 25 + lib/common_test/test_server/configure.in | 509 ++ lib/common_test/test_server/cross.cover | 20 + lib/common_test/test_server/ts.config | 46 + lib/common_test/test_server/ts.erl | 1019 ++++ lib/common_test/test_server/ts.hrl | 38 + lib/common_test/test_server/ts.unix.config | 6 + lib/common_test/test_server/ts.win32.config | 8 + lib/common_test/test_server/ts_autoconf_win32.erl | 256 + lib/common_test/test_server/ts_benchmark.erl | 87 + lib/common_test/test_server/ts_erl_config.erl | 403 ++ lib/common_test/test_server/ts_install.erl | 465 ++ lib/common_test/test_server/ts_install_cth.erl | 253 + lib/common_test/test_server/ts_lib.erl | 372 ++ lib/common_test/test_server/ts_make.erl | 114 + lib/common_test/test_server/ts_run.erl | 455 ++ lib/kernel/test/code_SUITE.erl | 8 - lib/test_server/AUTHORS | 12 - lib/test_server/Makefile | 39 - lib/test_server/README | 113 - lib/test_server/doc/html/.gitignore | 0 lib/test_server/doc/man3/.gitignore | 0 lib/test_server/doc/man6/.gitignore | 0 lib/test_server/doc/pdf/.gitignore | 0 lib/test_server/doc/src/Makefile | 140 - lib/test_server/doc/src/basics_chapter.xml | 215 - lib/test_server/doc/src/book.xml | 50 - lib/test_server/doc/src/example_chapter.xml | 151 - lib/test_server/doc/src/fascicules.xml | 18 - lib/test_server/doc/src/notes.xml | 1694 ------ lib/test_server/doc/src/notes_history.xml | 113 - lib/test_server/doc/src/part.xml | 46 - lib/test_server/doc/src/part_notes.xml | 41 - lib/test_server/doc/src/part_notes_history.xml | 39 - lib/test_server/doc/src/ref_man.xml | 44 - lib/test_server/doc/src/run_test_chapter.xml | 50 - lib/test_server/doc/src/test_server.xml | 853 --- lib/test_server/doc/src/test_server_app.xml | 75 - lib/test_server/doc/src/test_server_ctrl.xml | 844 --- lib/test_server/doc/src/test_spec_chapter.xml | 375 -- lib/test_server/doc/src/ts.xml | 568 -- lib/test_server/doc/src/why_test_chapter.xml | 141 - .../doc/src/write_framework_chapter.xml | 160 - lib/test_server/doc/src/write_test_chapter.xml | 228 - lib/test_server/ebin/.gitignore | 0 lib/test_server/include/test_server.hrl | 32 - lib/test_server/include/test_server_line.hrl | 20 - lib/test_server/info | 2 - lib/test_server/prebuild.skip | 1 - lib/test_server/src/Makefile | 144 - lib/test_server/src/conf_vars.in | 25 - lib/test_server/src/configure.in | 509 -- lib/test_server/src/cross.cover | 20 - lib/test_server/src/erl2html2.erl | 311 -- lib/test_server/src/test_server.app.src | 39 - lib/test_server/src/test_server.appup.src | 22 - lib/test_server/src/test_server.erl | 2655 --------- lib/test_server/src/test_server_ctrl.erl | 5652 -------------------- lib/test_server/src/test_server_gl.erl | 301 -- lib/test_server/src/test_server_internal.hrl | 61 - lib/test_server/src/test_server_io.erl | 452 -- lib/test_server/src/test_server_node.erl | 758 --- lib/test_server/src/test_server_sup.erl | 939 ---- lib/test_server/src/things/distr_startup_SUITE.erl | 239 - lib/test_server/src/things/mnesia_power_SUITE.erl | 126 - lib/test_server/src/things/random_kill_SUITE.erl | 82 - lib/test_server/src/things/soft.gs.txt | 16 - lib/test_server/src/things/verify.erl | 200 - lib/test_server/src/ts.config | 46 - lib/test_server/src/ts.erl | 1019 ---- lib/test_server/src/ts.hrl | 38 - lib/test_server/src/ts.unix.config | 6 - lib/test_server/src/ts.win32.config | 8 - lib/test_server/src/ts_autoconf_win32.erl | 256 - lib/test_server/src/ts_benchmark.erl | 87 - lib/test_server/src/ts_erl_config.erl | 403 -- lib/test_server/src/ts_install.erl | 465 -- lib/test_server/src/ts_install_cth.erl | 253 - lib/test_server/src/ts_lib.erl | 372 -- lib/test_server/src/ts_make.erl | 114 - lib/test_server/src/ts_run.erl | 455 -- lib/test_server/test/Makefile | 92 - lib/test_server/test/erl2html2_SUITE.erl | 277 - .../test/erl2html2_SUITE_data/Makefile.src | 2 - .../test/erl2html2_SUITE_data/header1.hrl | 4 - .../test/erl2html2_SUITE_data/include/header2.hrl | 0 .../test/erl2html2_SUITE_data/include/header3.hrl | 1 - lib/test_server/test/erl2html2_SUITE_data/m1.erl | 52 - lib/test_server/test/test_server.cover | 1 - lib/test_server/test/test_server.spec | 1 - lib/test_server/test/test_server_SUITE.erl | 449 -- .../test/test_server_SUITE_data/Makefile.src | 11 - .../test_server_SUITE_data/test_server_SUITE.erl | 514 -- .../test_server_SUITE_data/dummy_file | 1 - .../test_server_break_SUITE.erl | 149 - .../test_server_conf01_SUITE.erl | 188 - .../test_server_conf02_SUITE.erl | 295 - .../test_server_cover_SUITE.erl | 59 - .../test_server_cover_SUITE_data/cover_helper.erl | 4 - .../test_server_parallel01_SUITE.erl | 519 -- .../test_server_shuffle01_SUITE.erl | 477 -- .../test_server_skip_SUITE.erl | 43 - .../test_server_unicode_SUITE.erl | 82 - lib/test_server/test/test_server_test_lib.erl | 217 - lib/test_server/test/test_server_test_lib.hrl | 23 - lib/test_server/vsn.mk | 1 - otp_build | 4 +- 147 files changed, 18760 insertions(+), 25644 deletions(-) create mode 100644 lib/common_test/src/erl2html2.erl create mode 100644 lib/common_test/src/test_server.app.src create mode 100644 lib/common_test/src/test_server.appup.src create mode 100644 lib/common_test/src/test_server.erl create mode 100644 lib/common_test/src/test_server_ctrl.erl create mode 100644 lib/common_test/src/test_server_gl.erl create mode 100644 lib/common_test/src/test_server_internal.hrl create mode 100644 lib/common_test/src/test_server_io.erl create mode 100644 lib/common_test/src/test_server_node.erl create mode 100644 lib/common_test/src/test_server_sup.erl create mode 100644 lib/common_test/test/erl2html2_SUITE.erl create mode 100644 lib/common_test/test/erl2html2_SUITE_data/Makefile.src create mode 100644 lib/common_test/test/erl2html2_SUITE_data/header1.hrl create mode 100644 lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl create mode 100644 lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl create mode 100644 lib/common_test/test/erl2html2_SUITE_data/m1.erl create mode 100644 lib/common_test/test/test_server_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/Makefile.src create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl create mode 100644 lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl create mode 100644 lib/common_test/test/test_server_test_lib.erl create mode 100644 lib/common_test/test/test_server_test_lib.hrl create mode 100644 lib/common_test/test_server/Makefile create mode 100644 lib/common_test/test_server/conf_vars.in create mode 100644 lib/common_test/test_server/configure.in create mode 100644 lib/common_test/test_server/cross.cover create mode 100644 lib/common_test/test_server/ts.config create mode 100644 lib/common_test/test_server/ts.erl create mode 100644 lib/common_test/test_server/ts.hrl create mode 100644 lib/common_test/test_server/ts.unix.config create mode 100644 lib/common_test/test_server/ts.win32.config create mode 100644 lib/common_test/test_server/ts_autoconf_win32.erl create mode 100644 lib/common_test/test_server/ts_benchmark.erl create mode 100644 lib/common_test/test_server/ts_erl_config.erl create mode 100644 lib/common_test/test_server/ts_install.erl create mode 100644 lib/common_test/test_server/ts_install_cth.erl create mode 100644 lib/common_test/test_server/ts_lib.erl create mode 100644 lib/common_test/test_server/ts_make.erl create mode 100644 lib/common_test/test_server/ts_run.erl delete mode 100644 lib/test_server/AUTHORS delete mode 100644 lib/test_server/Makefile delete mode 100644 lib/test_server/README delete mode 100644 lib/test_server/doc/html/.gitignore delete mode 100644 lib/test_server/doc/man3/.gitignore delete mode 100644 lib/test_server/doc/man6/.gitignore delete mode 100644 lib/test_server/doc/pdf/.gitignore delete mode 100644 lib/test_server/doc/src/Makefile delete mode 100644 lib/test_server/doc/src/basics_chapter.xml delete mode 100644 lib/test_server/doc/src/book.xml delete mode 100644 lib/test_server/doc/src/example_chapter.xml delete mode 100644 lib/test_server/doc/src/fascicules.xml delete mode 100644 lib/test_server/doc/src/notes.xml delete mode 100644 lib/test_server/doc/src/notes_history.xml delete mode 100644 lib/test_server/doc/src/part.xml delete mode 100644 lib/test_server/doc/src/part_notes.xml delete mode 100644 lib/test_server/doc/src/part_notes_history.xml delete mode 100644 lib/test_server/doc/src/ref_man.xml delete mode 100644 lib/test_server/doc/src/run_test_chapter.xml delete mode 100644 lib/test_server/doc/src/test_server.xml delete mode 100644 lib/test_server/doc/src/test_server_app.xml delete mode 100644 lib/test_server/doc/src/test_server_ctrl.xml delete mode 100644 lib/test_server/doc/src/test_spec_chapter.xml delete mode 100644 lib/test_server/doc/src/ts.xml delete mode 100644 lib/test_server/doc/src/why_test_chapter.xml delete mode 100644 lib/test_server/doc/src/write_framework_chapter.xml delete mode 100644 lib/test_server/doc/src/write_test_chapter.xml delete mode 100644 lib/test_server/ebin/.gitignore delete mode 100644 lib/test_server/include/test_server.hrl delete mode 100644 lib/test_server/include/test_server_line.hrl delete mode 100644 lib/test_server/info delete mode 100644 lib/test_server/prebuild.skip delete mode 100644 lib/test_server/src/Makefile delete mode 100644 lib/test_server/src/conf_vars.in delete mode 100644 lib/test_server/src/configure.in delete mode 100644 lib/test_server/src/cross.cover delete mode 100644 lib/test_server/src/erl2html2.erl delete mode 100644 lib/test_server/src/test_server.app.src delete mode 100644 lib/test_server/src/test_server.appup.src delete mode 100644 lib/test_server/src/test_server.erl delete mode 100644 lib/test_server/src/test_server_ctrl.erl delete mode 100644 lib/test_server/src/test_server_gl.erl delete mode 100644 lib/test_server/src/test_server_internal.hrl delete mode 100644 lib/test_server/src/test_server_io.erl delete mode 100644 lib/test_server/src/test_server_node.erl delete mode 100644 lib/test_server/src/test_server_sup.erl delete mode 100644 lib/test_server/src/things/distr_startup_SUITE.erl delete mode 100644 lib/test_server/src/things/mnesia_power_SUITE.erl delete mode 100644 lib/test_server/src/things/random_kill_SUITE.erl delete mode 100644 lib/test_server/src/things/soft.gs.txt delete mode 100644 lib/test_server/src/things/verify.erl delete mode 100644 lib/test_server/src/ts.config delete mode 100644 lib/test_server/src/ts.erl delete mode 100644 lib/test_server/src/ts.hrl delete mode 100644 lib/test_server/src/ts.unix.config delete mode 100644 lib/test_server/src/ts.win32.config delete mode 100644 lib/test_server/src/ts_autoconf_win32.erl delete mode 100644 lib/test_server/src/ts_benchmark.erl delete mode 100644 lib/test_server/src/ts_erl_config.erl delete mode 100644 lib/test_server/src/ts_install.erl delete mode 100644 lib/test_server/src/ts_install_cth.erl delete mode 100644 lib/test_server/src/ts_lib.erl delete mode 100644 lib/test_server/src/ts_make.erl delete mode 100644 lib/test_server/src/ts_run.erl delete mode 100644 lib/test_server/test/Makefile delete mode 100644 lib/test_server/test/erl2html2_SUITE.erl delete mode 100644 lib/test_server/test/erl2html2_SUITE_data/Makefile.src delete mode 100644 lib/test_server/test/erl2html2_SUITE_data/header1.hrl delete mode 100644 lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl delete mode 100644 lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl delete mode 100644 lib/test_server/test/erl2html2_SUITE_data/m1.erl delete mode 100644 lib/test_server/test/test_server.cover delete mode 100644 lib/test_server/test/test_server.spec delete mode 100644 lib/test_server/test/test_server_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/Makefile.src delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl delete mode 100644 lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl delete mode 100644 lib/test_server/test/test_server_test_lib.erl delete mode 100644 lib/test_server/test/test_server_test_lib.hrl delete mode 100644 lib/test_server/vsn.mk diff --git a/.gitignore b/.gitignore index e27b5b12ff..3dcfa79f4d 100644 --- a/.gitignore +++ b/.gitignore @@ -182,7 +182,6 @@ JAVADOC-GENERATED # Files generated by configure. # -/lib/*/configure /lib/*/config.log /lib/*/config.status @@ -190,6 +189,8 @@ JAVADOC-GENERATED # Files generated by "./otp_build autoconf" # +/lib/*/configure +/lib/common_test/test_server/configure /lib/configure.in /aclocal.m4 /lib/common_test/priv/auxdir/config.guess @@ -201,9 +202,9 @@ JAVADOC-GENERATED /lib/erl_interface/src/auxdir/install-sh /lib/megaco/aclocal.m4 /lib/odbc/aclocal.m4 -/lib/test_server/src/config.guess -/lib/test_server/src/config.sub -/lib/test_server/src/install-sh +/lib/common_test/test_server/config.guess +/lib/common_test/test_server/config.sub +/lib/common_test/test_server/install-sh /lib/wx/aclocal.m4 /lib/wx/autoconf/config.guess /lib/wx/autoconf/config.sub diff --git a/Makefile.in b/Makefile.in index 0360a61e0a..377eebbbc2 100644 --- a/Makefile.in +++ b/Makefile.in @@ -670,8 +670,6 @@ tertiary_bootstrap_copy: $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/ebin ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/ebin ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; fi - $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server ; fi - $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi $(V_at)for x in lib/ic/ebin/*.beam; do \ @@ -752,17 +750,6 @@ tertiary_bootstrap_copy: done # copy test includes to be able to compile tests with bootstrap compiler - $(V_at)for x in lib/test_server/include/*.hrl; do \ - BN=`basename $$x`; \ - TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/test_server/include/$$BN; \ - test -f $$TF && \ - test '!' -z "`find $$x -newer $$TF -print`" && \ - cp $$x $$TF; \ - test '!' -f $$TF && \ - cp $$x $$TF; \ - true; \ - done - $(V_at)for x in lib/common_test/include/*.hrl; do \ BN=`basename $$x`; \ TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include/$$BN; \ @@ -987,7 +974,7 @@ local_setup: # --------------------------------------------------------------------- TEST_DIRS := \ - lib/test_server \ + lib/common_test/test_server \ $(wildcard lib/*/test) \ erts/test \ erts/epmd/test \ diff --git a/lib/Makefile b/lib/Makefile index 863b9abac6..82c7cb6e18 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -25,8 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_APPLICATIONS = stdlib sasl kernel compiler # Then these have to be build -ERLANG_APPLICATIONS = tools test_server common_test runtime_tools \ - inets parsetools +ERLANG_APPLICATIONS = tools common_test runtime_tools inets parsetools # These are only build if -a is given to otp_build or make is used directly ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index 53bc43fc24..5806f75806 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -18,8 +18,6 @@ %% %CopyrightEnd% %% --include_lib("test_server/include/test_server.hrl"). - %% the log level is used as argument to any CT logging function -define(MIN_IMPORTANCE, 0 ). -define(LOW_IMPORTANCE, 25). @@ -37,3 +35,9 @@ %% name of process executing the CT Hook init and terminate function -define(CT_HOOK_INIT_PROCESS, ct_util_server). -define(CT_HOOK_TERMINATE_PROCESS, ct_util_server). + +%% Backward compatibility for test_server test suites. +%% DO NOT USE IN NEW TEST SUITES. +-define(line,). +-define(t,test_server). +-define(config,test_server:lookup_config). diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 34c94d5032..91c1e8ede8 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -79,7 +79,15 @@ MODULES= \ cth_conn_log \ ct_groups \ ct_property_test \ - ct_release_test + ct_release_test \ + erl2html2 \ + test_server_ctrl \ + test_server_gl \ + test_server_io \ + test_server_node \ + test_server \ + test_server_sup + TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 0b646ffd07..a0d0c8b6c2 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2617,11 +2617,9 @@ run_make(Targets, TestDir0, Mod, UserInclude) -> data=TestDir}), {ok,Cwd} = file:get_cwd(), ok = file:set_cwd(TestDir), - TestServerInclude = get_dir(test_server, "include"), CtInclude = get_dir(common_test, "include"), XmerlInclude = get_dir(xmerl, "include"), - ErlFlags = UserInclude ++ [{i,TestServerInclude}, - {i,CtInclude}, + ErlFlags = UserInclude ++ [{i,CtInclude}, {i,XmerlInclude}, debug_info], Result = diff --git a/lib/common_test/src/erl2html2.erl b/lib/common_test/src/erl2html2.erl new file mode 100644 index 0000000000..e281c9de1b --- /dev/null +++ b/lib/common_test/src/erl2html2.erl @@ -0,0 +1,311 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Purpose:Convert Erlang files to html. +%%%------------------------------------------------------------------ + +-module(erl2html2). +-export([convert/3, convert/4]). + +convert([], _Dest, _InclPath) -> % Fake clause. + ok; +convert(File, Dest, InclPath) -> + %% The generated code uses the BGCOLOR attribute in the + %% BODY tag, which wasn't valid until HTML 3.2. Also, + %% good HTML should either override all colour attributes + %% or none of them -- *never* just a few. + %% + %% FIXME: The colours should *really* be set with + %% stylesheets... + %% + %% The html file is written with the same encoding as the input file. + Encoding = encoding(File), + Header = ["\n" + "\n" + "\n" + "\n" + "\n" + "", to_raw_list(File,Encoding), "\n" + "\n\n" + "\n"], + convert(File, Dest, InclPath, Header). + + +convert(File, Dest, InclPath, Header) -> + %% statistics(runtime), + case parse_file(File, InclPath) of + {ok,Functions} -> + %% {_, Time1} = statistics(runtime), + %% io:format("Parsed file in ~.2f Seconds.~n",[Time1/1000]), + case file:open(File,[raw,{read_ahead,10000}]) of + {ok,SFd} -> + case file:open(Dest,[write,raw]) of + {ok,DFd} -> + file:write(DFd,[Header,"
\n"]),
+			    _Lines = build_html(SFd,DFd,encoding(File),Functions),
+			    file:write(DFd,["
\n",footer(), + "\n\n"]), + %% {_, Time2} = statistics(runtime), + %% io:format("Converted ~p lines in ~.2f Seconds.~n", + %% [_Lines, Time2/1000]), + file:close(SFd), + file:close(DFd), + ok; + Error -> + Error + end; + Error -> + Error + end; + Error -> + Error + end. + +%%%----------------------------------------------------------------- +%%% Parse the input file to get the line numbers for all function +%%% definitions. This will be used when creating link targets for each +%%% function in build_html/5. +%%% +%%% All function clauses are also marked in order to allow +%%% possibly_enhance/2 to write these in bold. +%%% +%%% Use expanded preprocessor directives if possible (epp). Only if +%%% this fails, fall back on using non-expanded code (epp_dodger). + +parse_file(File, InclPath) -> + case epp:open(File, InclPath, []) of + {ok,Epp} -> + try parse_preprocessed_file(Epp,File,false) of + Forms -> + epp:close(Epp), + {ok,Forms} + catch + _:{error,_Reason,true} -> + parse_non_preprocessed_file(File); + _:{error,_Reason,false} -> + {ok,[]} + end; + Error = {error,_} -> + Error + end. + +parse_preprocessed_file(Epp, File, InCorrectFile) -> + case epp:parse_erl_form(Epp) of + {ok,Form} -> + case Form of + {attribute,_,file,{File,_}} -> + parse_preprocessed_file(Epp, File, true); + {attribute,_,file,{_OtherFile,_}} -> + parse_preprocessed_file(Epp, File, false); + {function,L,F,A,Cs} when InCorrectFile -> + {CLs,LastCL} = find_clause_lines(Cs, []), + %% tl(CLs) cause we know the start line already + [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ + parse_preprocessed_file(Epp, File, true); + _ -> + parse_preprocessed_file(Epp, File, InCorrectFile) + end; + {error,Reason={_L,epp,{undefined,_Macro,none}}} -> + throw({error,Reason,InCorrectFile}); + {error,_Reason} -> + parse_preprocessed_file(Epp, File, InCorrectFile); + {eof,_Location} -> + [] + end. + +parse_non_preprocessed_file(File) -> + case file:open(File, []) of + {ok,Epp} -> + Forms = parse_non_preprocessed_file(Epp, File, 1), + file:close(Epp), + {ok,Forms}; + Error = {error,_E} -> + Error + end. + +parse_non_preprocessed_file(Epp, File, Location) -> + case epp_dodger:parse_form(Epp, Location) of + {ok,Tree,Location1} -> + try erl_syntax:revert(Tree) of + {function,L,F,A,Cs} -> + {CLs,LastCL} = find_clause_lines(Cs, []), + %% tl(CLs) cause we know the start line already + [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ + parse_non_preprocessed_file(Epp, File, Location1); + _ -> + parse_non_preprocessed_file(Epp, File, Location1) + catch + _:_ -> parse_non_preprocessed_file(Epp, File, Location1) + end; + {error,_E,Location1} -> + parse_non_preprocessed_file(Epp, File, Location1); + {eof,_Location} -> + [] + end. + +get_line(Anno) -> + erl_anno:line(Anno). + +%%%----------------------------------------------------------------- +%%% Find the line number of the last expression in the function +find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause + case classify_exprs(Exprs) of + {anno, Anno} -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(Anno)}; + {tree, Exprs1} -> + find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs); + unknown -> + {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} + end; +find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> + find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]). + +classify_exprs(Exprs) -> + case tuple_to_list(lists:last(Exprs)) of + [macro,{_var,Anno,_MACRO} | _] -> + {anno, Anno}; + [T,ExprAnno | Exprs1] -> + case erl_anno:is_anno(ExprAnno) of + true -> + {anno, ExprAnno}; + false when T =:= tree -> + {tree, Exprs1}; + false -> + unknown + end + end. + +%%%----------------------------------------------------------------- +%%% Add a link target for each line and one for each function definition. +build_html(SFd,DFd,Encoding,FuncsAndCs) -> + build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs, + false,undefined). + +%% line of last expression in function found +build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) -> + LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8), + file:write(DFd,[""]), + build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined); +%% function start line found +build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs], + _IsFuncDef,_FAndLastL) -> + FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8), + file:write(DFd,[""]), + build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL}); +build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs], + _IsFuncDef,FAndLastL) -> + build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL); +build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) -> + LStr = line_number(L), + Str1 = line(Str,IsFuncDef), + file:write(DFd,[LStr,Str1]), + build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL); +build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) -> + L. + +line_number(L) -> + LStr = integer_to_list(L), + Pred = + case length(LStr) of + Length when Length < 5 -> + lists:duplicate(5-Length,$\s); + _ -> + [] + end, + ["",Pred,LStr,": "]. + +line(Str,IsFuncDef) -> + Str1 = htmlize(Str), + possibly_enhance(Str1,IsFuncDef). + +%%%----------------------------------------------------------------- +%%% Substitute special characters that should not appear in HTML +htmlize([$<|Str]) -> + [$&,$l,$t,$;|htmlize(Str)]; +htmlize([$>|Str]) -> + [$&,$g,$t,$;|htmlize(Str)]; +htmlize([$&|Str]) -> + [$&,$a,$m,$p,$;|htmlize(Str)]; +htmlize([$"|Str]) -> + [$&,$q,$u,$o,$t,$;|htmlize(Str)]; +htmlize([Ch|Str]) -> + [Ch|htmlize(Str)]; +htmlize([]) -> + []. + +%%%----------------------------------------------------------------- +%%% Write comments in italic and function definitions in bold. +possibly_enhance(Str,true) -> + case lists:splitwith(fun($() -> false; (_) -> true end, Str) of + {_,[]} -> Str; + {F,A} -> ["",F,"",A] + end; +possibly_enhance([$%|_]=Str,_) -> + ["",Str--"\n","","\n"]; +possibly_enhance([$-|_]=Str,_) -> + possibly_enhance(Str,true); +possibly_enhance(Str,false) -> + Str. + +%%%----------------------------------------------------------------- +%%% End of the file +footer() -> + "". + +%%%----------------------------------------------------------------- +%%% Read encoding from source file +encoding(File) -> + case epp:read_encoding(File) of + none -> + epp:default_encoding(); + E -> + E + end. + +%%%----------------------------------------------------------------- +%%% Covert encoding atom to string for use in HTML header +html_encoding(latin1) -> + "iso-8859-1"; +html_encoding(utf8) -> + "utf-8". + +%%%----------------------------------------------------------------- +%%% Convert a string to a list of raw printable characters in the +%%% given encoding. This is necessary since the files (source and +%%% destination) are both opened in raw mode (default encoding). Byte +%%% by byte is read from source and written to the destination. This +%%% conversion is needed when printing data that is not first read +%%% from the source. +%%% +%%% Example: if the encoding of the file is utf8, and we have a string +%%% containing "å" = [229], then we need to convert this to [195,165] +%%% before writing. Note that this conversion is only necessary +%%% because the destination file is not (necessarily) opened with utf8 +%%% encoding - it is opened with default encoding in order to allow +%%% raw file mode and byte by byte copying from source. +to_raw_list(X,latin1) when is_list(X) -> + X; +to_raw_list(X,utf8) when is_list(X) -> + binary_to_list(unicode:characters_to_binary(X)). diff --git a/lib/common_test/src/test_server.app.src b/lib/common_test/src/test_server.app.src new file mode 100644 index 0000000000..334be8109d --- /dev/null +++ b/lib/common_test/src/test_server.app.src @@ -0,0 +1,39 @@ +% This is an -*- erlang -*- file. +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% + +{application, test_server, + [{description, "The OTP Test Server application"}, + {vsn, "%VSN%"}, + {modules, [ + erl2html2, + test_server_ctrl, + test_server, + test_server_io, + test_server_node, + test_server_sup + ]}, + {registered, [test_server_ctrl, + test_server, + test_server_break_process]}, + {applications, [kernel,stdlib]}, + {env, []}, + {runtime_dependencies, ["tools-2.8","stdlib-2.5","runtime_tools-1.8.16", + "observer-2.1","kernel-4.0","inets-6.0", + "syntax_tools-1.7","erts-7.0"]}]}. + diff --git a/lib/common_test/src/test_server.appup.src b/lib/common_test/src/test_server.appup.src new file mode 100644 index 0000000000..7c4aa630ae --- /dev/null +++ b/lib/common_test/src/test_server.appup.src @@ -0,0 +1,22 @@ +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + [{<<".*">>,[{restart_application, test_server}]}], + [{<<".*">>,[{restart_application, test_server}]}] +}. diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl new file mode 100644 index 0000000000..da6bf491ac --- /dev/null +++ b/lib/common_test/src/test_server.erl @@ -0,0 +1,2655 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +-module(test_server). + +-define(DEFAULT_TIMETRAP_SECS, 60). + +%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([run_test_case_apply/1,init_target_info/0,init_purify/0]). +-export([cover_compile/1,cover_analyse/2]). + +%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([get_loc/1,set_tc_state/1]). + +%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([lookup_config/2]). +-export([fail/0,fail/1,format/1,format/2,format/3]). +-export([capture_start/0,capture_stop/0,capture_get/0]). +-export([messages_get/0]). +-export([permit_io/2]). +-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). +-export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0, + timetrap_cancel/1,timetrap_cancel/0]). +-export([m_out_of_n/3,do_times/4,do_times/2]). +-export([call_crash/3,call_crash/4,call_crash/5]). +-export([temp_name/1]). +-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). +-export([app_test/1, app_test/2, appup_test/1]). +-export([is_native/1]). +-export([comment/1, make_priv_dir/0]). +-export([os_type/0]). +-export([run_on_shielded_node/2]). +-export([is_cover/0,is_debug/0,is_commercial/0]). + +-export([break/1,break/2,break/3,continue/0,continue/1]). + +%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0, + purify_is_running/0]). + +%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-include("test_server_internal.hrl"). +-include_lib("kernel/include/file.hrl"). + +init_target_info() -> + [$.|Emu] = code:objfile_extension(), + {_, OTPRel} = init:script_id(), + TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))), + #target_info{os_family=test_server_sup:get_os_family(), + os_type=os:type(), + version=erlang:system_info(version), + system_version=erlang:system_info(system_version), + root_dir=code:root_dir(), + test_server_dir=TestServerDir, + emulator=Emu, + otp_release=OTPRel, + username=test_server_sup:get_username(), + cookie=atom_to_list(erlang:get_cookie())}. + +init_purify() -> + purify_new_leaks(). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) -> +%% {ok,#cover{mods=AnalyseModules}} | {error,Reason} +%% +%% App = atom() , name of application to be compiled +%% Exclude = [atom()], list of modules to exclude +%% Include = [atom()], list of modules outside of App that should be included +%% in the cover compilation +%% Cross = [atoms()], list of modules outside of App shat should be included +%% in the cover compilation, but that shall not be part of +%% the cover analysis for this application. +%% AnalyseModules = [atom()], list of successfully compiled modules +%% +%% Cover compile the given application. Return {ok,CoverInfo} if +%% compilation succeeds, else (if application is not found and there +%% are no modules to compile) {error,application_not_found}. + +cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) -> + CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), + CompileMods = Include++CrossMods, + case length(CompileMods) of + 0 -> + io:fwrite("WARNING: No modules to cover compile!\n\n",[]), + cover:start(), % start cover server anyway + {ok,CoverInfo#cover{mods=[]}}; + N -> + io:fwrite("Cover compiling ~w modules - " + "this may take some time... ",[N]), + do_cover_compile(CompileMods), + io:fwrite("done\n\n",[]), + {ok,CoverInfo#cover{mods=Include}} + end; +cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) -> + CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), + CompileMods = Include++CrossMods, + case length(CompileMods) of + 0 -> + io:fwrite("WARNING: No modules to cover compile!\n\n",[]), + cover:start(), % start cover server anyway + {ok,CoverInfo#cover{mods=[]}}; + N -> + io:fwrite("Cover compiling '~w' (~w files) - " + "this may take some time... ",[App,N]), + io:format("\nWARNING: All modules in \'~w\' are excluded\n" + "Only cover compiling modules in include list " + "and the modules\nin the cross cover file:\n" + "~tp\n", [App,CompileMods]), + do_cover_compile(CompileMods), + io:fwrite("done\n\n",[]), + {ok,CoverInfo#cover{mods=Include}} + end; +cover_compile(CoverInfo=#cover{app=App,excl=Exclude, + incl=Include,cross=Cross}) -> + CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), + case code:lib_dir(App) of + {error,bad_name} -> + case Include++CrossMods of + [] -> + io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" + "Not cover compiling!\n\n",[App]), + {error,application_not_found}; + CompileMods -> + io:fwrite("Cover compiling '~w' (~w files) - " + "this may take some time... ", + [App,length(CompileMods)]), + io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" + "Only cover compiling modules in include list: " + "~tp\n", [App,Include]), + do_cover_compile(CompileMods), + io:fwrite("done\n\n",[]), + {ok,CoverInfo#cover{mods=Include}} + end; + LibDir -> + EbinDir = filename:join([LibDir,"ebin"]), + WC = filename:join(EbinDir,"*.beam"), + AllMods = module_names(filelib:wildcard(WC)), + AnalyseMods = (AllMods ++ Include) -- Exclude, + CompileMods = AnalyseMods ++ CrossMods, + case length(CompileMods) of + 0 -> + io:fwrite("WARNING: No modules to cover compile!\n\n",[]), + cover:start(), % start cover server anyway + {ok,CoverInfo#cover{mods=[]}}; + N -> + io:fwrite("Cover compiling '~w' (~w files) - " + "this may take some time... ",[App,N]), + do_cover_compile(CompileMods), + io:fwrite("done\n\n",[]), + {ok,CoverInfo#cover{mods=AnalyseMods}} + end + end. + + +module_names(Beams) -> + [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams]. + + +do_cover_compile(Modules) -> + cover:start(), + Sticky = prepare_cover_compile(Modules,[]), + R = cover:compile_beam(Modules), + [warn_compile(Error) || Error <- R,element(1,Error)=/=ok], + [code:stick_mod(M) || M <- Sticky], + ok. + +warn_compile({error,{Reason,Module}}) -> + io:fwrite("\nWARNING: Could not cover compile ~ts: ~p\n", + [Module,{error,Reason}]). + +%% Make sure all modules are loaded and unstick if sticky +prepare_cover_compile([M|Ms],Sticky) -> + case {code:is_sticky(M),code:is_loaded(M)} of + {true,_} -> + code:unstick_mod(M), + prepare_cover_compile(Ms,[M|Sticky]); + {false,false} -> + case code:load_file(M) of + {module,_} -> + prepare_cover_compile([M|Ms],Sticky); + Error -> + io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]), + prepare_cover_compile(Ms,Sticky) + end; + {false,_} -> + prepare_cover_compile(Ms,Sticky) + end; +prepare_cover_compile([],Sticky) -> + Sticky. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) -> +%% [{M,{Cov,NotCov,Details}}] +%% +%% Dir = string() +%% Analyse = details | overview +%% Modules = [atom()], the modules to analyse +%% +%% Cover analysis. If Analyse==details analyse_to_file is used. +%% +%% If Analyse==overview analyse_to_file is not used, only an overview +%% containing the number of covered/not covered lines in each module. +%% +%% Also, cover data will be exported to a file called all.coverdata in +%% the given directory. +%% +%% Finally, if Stop==true, then cover will be stopped after the +%% analysis is completed. Stopping cover causes the original (non +%% cover compiled) modules to be loaded back in. If a process at this +%% point is still running old code of any of the cover compiled +%% modules, meaning that is has not done any fully qualified function +%% call after the cover compilation, the process will now be +%% killed. To avoid this scenario, it is possible to set Stop=false, +%% which means that the modules will stay cover compiled. Note that +%% this is only recommended if the erlang node is being terminated +%% after the test is completed. +cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) -> + io:fwrite(user, "Cover analysing... ", []), + {ATFOk,ATFFail} = + case Analyse of + details -> + case cover:export(filename:join(Dir,"all.coverdata")) of + ok -> + {result,Ok1,Fail1} = + cover:analyse_to_file(Modules,[{outdir,Dir},html]), + {lists:map(fun(OutFile) -> + M = list_to_atom( + filename:basename( + filename:rootname(OutFile, + ".COVER.html") + ) + ), + {M,{file,OutFile}} + end, Ok1), + lists:map(fun({Reason,M}) -> + {M,{error,Reason}} + end, Fail1)}; + Error -> + {[],lists:map(fun(M) -> {M,Error} end, Modules)} + end; + overview -> + case cover:export(filename:join(Dir,"all.coverdata")) of + ok -> + {[],lists:map(fun(M) -> {M,undefined} end, Modules)}; + Error -> + {[],lists:map(fun(M) -> {M,Error} end, Modules)} + end + end, + {result,AOk,AFail} = cover:analyse(Modules,module), + R0 = merge_analysis_results(AOk,ATFOk++ATFFail,[]) ++ + [{M,{error,Reason}} || {Reason,M} <- AFail], + R = lists:sort(R0), + io:fwrite(user, "done\n\n", []), + + case Stop of + true -> + Sticky = unstick_all_sticky(node()), + cover:stop(), + stick_all_sticky(node(),Sticky); + false -> + ok + end, + R. + +merge_analysis_results([{M,{Cov,NotCov}}|T],ATF,Acc) -> + case lists:keytake(M,1,ATF) of + {value,{_,R},ATF1} -> + merge_analysis_results(T,ATF1,[{M,{Cov,NotCov,R}}|Acc]); + false -> + merge_analysis_results(T,ATF,Acc) + end; +merge_analysis_results([],_,Acc) -> + Acc. + +do_cover_for_node(Node,CoverFunc) -> + do_cover_for_node(Node,CoverFunc,true). +do_cover_for_node(Node,CoverFunc,StickUnstick) -> + %% In case a slave node is starting another slave node! I.e. this + %% function is executed on a slave node - then the cover function + %% must be executed on the master node. This is for instance the + %% case in test_server's own tests. + MainCoverNode = cover:get_main_node(), + Sticky = + if StickUnstick -> unstick_all_sticky(MainCoverNode,Node); + true -> ok + end, + rpc:call(MainCoverNode,cover,CoverFunc,[Node]), + if StickUnstick -> stick_all_sticky(Node,Sticky); + true -> ok + end. + +unstick_all_sticky(Node) -> + unstick_all_sticky(node(),Node). +unstick_all_sticky(MainCoverNode,Node) -> + lists:filter( + fun(M) -> + case code:is_sticky(M) of + true -> + rpc:call(Node,code,unstick_mod,[M]), + true; + false -> + false + end + end, + rpc:call(MainCoverNode,cover,modules,[])). + +stick_all_sticky(Node,Sticky) -> + lists:foreach( + fun(M) -> + rpc:call(Node,code,stick_mod,[M]) + end, + Sticky). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> +%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} +%% +%% Time = float() (seconds) +%% Value = term() +%% Loc = term() +%% Comment = string() +%% Reason = term() +%% +%% Spawns off a process (case process) that actually runs the test suite. +%% The case process will have the job process as group leader, which makes +%% it possible to capture all it's output from io:format/2, etc. +%% +%% The job process then sits down and waits for news from the case process. +%% +%% Returns a tuple with the time spent (in seconds) in the test case, +%% the return value from the test case or an {'EXIT',Reason} if the case +%% failed, Loc points out where the test case crashed (if it did). Loc +%% is either the name of the function, or {,} of the last +%% line executed that had a ?line macro. If the test case did execute +%% erase/0 or similar, it may be empty. Comment is the last comment added +%% by test_server:comment/1, the reason if test_server:fail has been +%% called or the comment given by the return value {comment,Comment} from +%% a test case. +%% +%% {died,Reason,unknown,Comment} is returned if the test case was killed +%% by some other process. Reason is the kill reason provided. +%% +%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a +%% possible extension of all timetraps. Timetraps will be multiplied by +%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all. +%% ScaleTimetrap indicates if test_server should attemp to automatically +%% compensate timetraps for runtime delays introduced by e.g. tools like +%% cover. + +run_test_case_apply({CaseNum,Mod,Func,Args,Name, + RunInit,TimetrapData}) -> + purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), + case os:getenv("TS_RUN_VALGRIND") of + false -> + ok; + _ -> + os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ + atom_to_list(Func)++"-") + end, + ProcBef = erlang:system_info(process_count), + Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, + TimetrapData), + ProcAft = erlang:system_info(process_count), + purify_new_leaks(), + DetFail = get(test_server_detected_fail), + {Result,DetFail,ProcBef,ProcAft}. + +-type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | + 'end_per_testcase' | {'framework',atom(),atom()} | + 'tc'. +-record(st, + { + ref :: reference(), + pid :: pid(), + mf :: {atom(),atom()}, + last_known_loc :: term(), + status :: tc_status() | 'undefined', + ret_val :: term(), + comment :: list(char()), + timeout :: non_neg_integer() | 'infinity', + config :: list() | 'undefined', + end_conf_pid :: pid() | 'undefined' + }). + +run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> + print_timestamp(minor,"Started at "), + print(minor, "", [], internal_raw), + TCCallback = get(test_server_testcase_callback), + LogOpts = get(test_server_logopts), + Ref = make_ref(), + Pid = + spawn_link( + fun() -> + run_test_case_eval(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, + LogOpts, TCCallback) + end), + put(test_server_detected_fail, []), + St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, + status=starting,ret_val=[],comment="",timeout=infinity, + config=hd(Args)}, + run_test_case_msgloop(St). + +%% Ugly bug (pre R5A): +%% If this process (group leader of the test case) terminates before +%% all messages have been replied back to the io server, the io server +%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in +%% io.erl. +%% +%% A test case is known to have failed if it returns {'EXIT', _} tuple, +%% or sends a message {failed, File, Line} to it's group_leader +%% +run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> + receive + {set_tc_state=Tag,From,{Status,Config0}} -> + Config = case Config0 of + unknown -> St0#st.config; + _ -> Config0 + end, + St = St0#st{status=Status,config=Config}, + From ! {self(),Tag,ok}, + run_test_case_msgloop(St); + {abort_current_testcase,_,_}=Abort when St0#st.status =:= starting -> + %% we're in init phase, must must postpone this operation + %% until test case execution is in progress (or FW:init_tc + %% gets killed) + self() ! Abort, + erlang:yield(), + run_test_case_msgloop(St0); + {abort_current_testcase,Reason,From} -> + Line = case is_process_alive(Pid) of + true -> get_loc(Pid); + false -> unknown + end, + Mon = erlang:monitor(process, Pid), + exit(Pid,{testcase_aborted,Reason,Line}), + erlang:yield(), + From ! {self(),abort_current_testcase,ok}, + St = receive + {'DOWN', Mon, process, Pid, _} -> + St0 + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + exit(Pid, kill), + %% here's the only place we know Reason, so we save + %% it as a comment, potentially replacing user data + Error = lists:flatten(io_lib:format("Aborted: ~p", + [Reason])), + Error1 = lists:flatten([string:strip(S,left) || + S <- string:tokens(Error, + [$\n])]), + Comment = if length(Error1) > 63 -> + string:substr(Error1,1,60) ++ "..."; + true -> + Error1 + end, + St0#st{comment=Comment} + end, + run_test_case_msgloop(St); + {sync_apply,From,MFA} -> + do_sync_apply(false,From,MFA), + run_test_case_msgloop(St0); + {sync_apply_proxy,Proxy,From,MFA} -> + do_sync_apply(Proxy,From,MFA), + run_test_case_msgloop(St0); + {comment,NewComment0} -> + NewComment1 = test_server_ctrl:to_string(NewComment0), + NewComment = test_server_sup:framework_call(format_comment, + [NewComment1], + NewComment1), + run_test_case_msgloop(St0#st{comment=NewComment}); + {read_comment,From} -> + From ! {self(),read_comment,St0#st.comment}, + run_test_case_msgloop(St0); + {make_priv_dir,From} -> + Config = case St0#st.config of + undefined -> []; + Config0 -> Config0 + end, + Result = + case proplists:get_value(priv_dir, Config) of + undefined -> + {error,no_priv_dir_in_config}; + PrivDir -> + case file:make_dir(PrivDir) of + ok -> + ok; + {error, eexist} -> + ok; + MkDirError -> + {error,{MkDirError,PrivDir}} + end + end, + From ! {self(),make_priv_dir,Result}, + run_test_case_msgloop(St0); + {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> + RetVal = {Time/1000000,Value,Loc,Opts}, + St = setup_termination(RetVal, St0#st{config=undefined}), + run_test_case_msgloop(St); + {'EXIT',Pid,Reason} -> + %% This exit typically happens when an unknown external process + %% has caused a test case process to terminate (e.g. if a linked + %% process has crashed). + St = + case Reason of + {What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when + is_integer(A) -> + Loc = rewrite_loc_item(Loc0), + handle_tc_exit(What, St0#st{last_known_loc=[Loc]}); + {What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when + is_integer(A) -> + Loc = rewrite_loc_item(Loc0), + handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]}); + _ -> + handle_tc_exit(Reason, St0) + end, + run_test_case_msgloop(St); + {EndConfPid0,{call_end_conf,Data,_Result}} -> + #st{mf={Mod,Func},config=CurrConf} = St0, + case CurrConf of + _ when is_list(CurrConf) -> + {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, + spawn_fw_call(Mod,Func,CurrConf,TCPid, + TCExitReason,Loc,self()), + St = St0#st{config=undefined,end_conf_pid=undefined}, + run_test_case_msgloop(St); + _ -> + run_test_case_msgloop(St0) + end; + {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> + %% the framework has been notified, we're finished + RetVal = {T,Value,Loc,Opts}, + Comment0 = St0#st.comment, + Comment = case AddToComment of + undefined -> + Comment0; + _ -> + if Comment0 =:= "" -> + AddToComment; + true -> + Comment0 ++ + test_server_ctrl:xhtml("
", + "
") ++ + AddToComment + end + end, + St = setup_termination(RetVal, St0#st{comment=Comment, + config=undefined}), + run_test_case_msgloop(St); + {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> + %% a framework function failed + CB = os:getenv("TEST_SERVER_FRAMEWORK"), + Loc = case CB of + FW when FW =:= false; FW =:= "undefined" -> + [{test_server,Func}]; + _ -> + [{list_to_atom(CB),Func}] + end, + RetVal = {died,{framework_error,Loc,Error},Loc}, + St = setup_termination(RetVal, St0#st{comment="Framework error", + config=undefined}), + run_test_case_msgloop(St); + {failed,File,Line} -> + put(test_server_detected_fail, + [{File, Line}| get(test_server_detected_fail)]), + run_test_case_msgloop(St0); + + {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> + case update_user_timetraps(Pid, StartTime) of + proceed -> + self() ! {abort_current_testcase,E,Pid}; + ignore -> + ok + end, + run_test_case_msgloop(St0); + {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> + %% a user timetrap is triggered, ignore it if new + %% timetrap has been started since + case update_user_timetraps(Pid, StartTime) of + proceed -> + TotalTime = if is_integer(TrapTime) -> + TrapTime + ElapsedTime; + true -> + TrapTime + end, + timetrap(TrapTime, TotalTime, Pid, Scale); + ignore -> + ok + end, + run_test_case_msgloop(St0); + {timetrap_cancel_one,Handle,_From} -> + timetrap_cancel_one(Handle, false), + run_test_case_msgloop(St0); + {timetrap_cancel_all,TCPid,_From} -> + timetrap_cancel_all(TCPid, false), + run_test_case_msgloop(St0); + {get_timetrap_info,From,TCPid} -> + Info = get_timetrap_info(TCPid, false), + From ! {self(),get_timetrap_info,Info}, + run_test_case_msgloop(St0); + _Other when not is_tuple(_Other) -> + %% ignore anything not generated by test server + run_test_case_msgloop(St0); + _Other when element(1, _Other) /= 'EXIT', + element(1, _Other) /= started, + element(1, _Other) /= finished, + element(1, _Other) /= print -> + %% ignore anything not generated by test server + run_test_case_msgloop(St0) + after St0#st.timeout -> + #st{ret_val=RetVal,comment=Comment} = St0, + erlang:append_element(RetVal, Comment) + end. + +setup_termination(RetVal, #st{pid=Pid}=St) -> + timetrap_cancel_all(Pid, false), + St#st{ret_val=RetVal,timeout=20}. + +set_tc_state(State) -> + set_tc_state(State,unknown). +set_tc_state(State, Config) -> + tc_supervisor_req(set_tc_state, {State,Config}). + +handle_tc_exit(killed, St) -> + %% probably the result of an exit(TestCase,kill) call, which is the + %% only way to abort a testcase process that traps exits + %% (see abort_current_testcase). + #st{config=Config,mf={Mod,Func},pid=Pid} = St, + Msg = testcase_aborted_or_killed, + spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), + St; +handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> + #st{config=Config,mf={Mod,Func},pid=Pid} = St, + spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), + St; +handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, + config=Config,pid=Pid}=St) -> + R = case Reason of + {timetrap_timeout,TVal,_} -> + {timetrap,TVal}; + {testcase_aborted=E,AbortReason,_} -> + {E,AbortReason}; + {fw_error,{FwMod,FwFunc,FwError}} -> + FwError; + Other -> + Other + end, + Error = {framework_error,R}, + spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()), + St; +handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) + when is_list(Config0) -> + {R,Loc1,F} = case Reason of + {timetrap_timeout=E,TVal,Loc0} -> + {{E,TVal},Loc0,E}; + {testcase_aborted=E,AbortReason,Loc0} -> + Msg = {E,AbortReason}, + {Msg,Loc0,Msg}; + Other -> + {{'EXIT',Other},unknown,Other} + end, + Timeout = end_conf_timeout(Reason, St), + Config = [{tc_status,{failed,F}}|Config0], + EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout), + St#st{end_conf_pid=EndConfPid}; +handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, + status=Status}=St) -> + {R,Loc1} = case Reason of + {timetrap_timeout=E,TVal,Loc0} -> + {{E,TVal},Loc0}; + {testcase_aborted=E,AbortReason,Loc0} -> + {{E,AbortReason},Loc0}; + Other -> + {{'EXIT',Other},St#st.last_known_loc} + end, + Func = case Status of + init_per_testcase=F -> {F,Func0}; + end_per_testcase=F -> {F,Func0}; + _ -> Func0 + end, + spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()), + St. + +end_conf_timeout({timetrap_timeout,Timeout,_}, _) -> + Timeout; +end_conf_timeout(_, #st{config=Config}) when is_list(Config) -> + proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000); +end_conf_timeout(_, _) -> + ?DEFAULT_TIMETRAP_SECS*1000. + +call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> + Starter = self(), + Data = {Mod,Func,TCPid,TCExitReason,Loc}, + case erlang:function_exported(Mod,end_per_testcase,2) of + false -> + spawn_link(fun() -> + Starter ! {self(),{call_end_conf,Data,ok}} + end); + true -> + do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) + end. + +do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) -> + EndConfProc = + fun() -> + process_flag(trap_exit,true), % to catch timetraps + Supervisor = self(), + EndConfApply = + fun() -> + timetrap(TVal), + try apply(Mod,end_per_testcase,[Func,Conf]) of + _ -> ok + catch + _:Why -> + timer:sleep(1), + group_leader() ! {printout,12, + "WARNING! " + "~w:end_per_testcase(~w, ~p)" + " crashed!\n\tReason: ~p\n", + [Mod,Func,Conf,Why]} + end, + Supervisor ! {self(),end_conf} + end, + Pid = spawn_link(EndConfApply), + receive + {Pid,end_conf} -> + Starter ! {self(),{call_end_conf,Data,ok}}; + {'EXIT',Pid,Reason} -> + group_leader() ! {printout,12, + "WARNING! ~w:end_per_testcase(~w, ~p)" + " failed!\n\tReason: ~p\n", + [Mod,Func,Conf,Reason]}, + Starter ! {self(),{call_end_conf,Data,{error,Reason}}}; + {'EXIT',_OtherPid,Reason} -> + %% Probably the parent - not much to do about that + exit(Reason) + end + end, + spawn_link(EndConfProc). + +spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid, + {timetrap_timeout,TVal}=Why, + Loc,SendTo) -> + FwCall = + fun() -> + Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, + %% if init_per_testcase fails, the test case + %% should be skipped + try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + %% finished, report back + SendTo ! {self(),fw_notify_done, + {TVal/1000,Skip,Loc,[],undefined}} + end, + spawn_link(FwCall); + +spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, + {timetrap_timeout,TVal}=Why,_Loc,SendTo) -> + FwCall = + fun() -> + {RetVal,Report} = + case proplists:get_value(tc_status, EndConf) of + undefined -> + E = {failed,{Mod,end_per_testcase,Why}}, + {E,E}; + E = {failed,Reason} -> + {E,{error,Reason}}; + Result -> + E = {failed,{Mod,end_per_testcase,Why}}, + {Result,E} + end, + group_leader() ! {printout,12, + "WARNING! ~w:end_per_testcase(~w, ~p)" + " failed!\n\tReason: timetrap timeout" + " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, + FailLoc = proplists:get_value(tc_fail_loc, EndConf), + try do_end_tc_call(Mod,Func, + {Pid,Report,[EndConf]}, Why) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + Warn = "" + "WARNING: end_per_testcase timed out!", + %% finished, report back (if end_per_testcase fails, a warning + %% should be printed as part of the comment) + SendTo ! {self(),fw_notify_done, + {TVal/1000,RetVal,FailLoc,[],Warn}} + end, + spawn_link(FwCall); + +spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> + FwCall = + fun() -> + test_server_sup:framework_call(report, [framework_error, + {{FwMod,FwFunc}, + FwError}]), + Comment = + lists:flatten( + io_lib:format("" + "WARNING! ~w:~w failed!", + [FwMod,FwFunc])), + %% finished, report back + SendTo ! {self(),fw_notify_done, + {died,{error,{FwMod,FwFunc,FwError}}, + {FwMod,FwFunc},[],Comment}} + end, + spawn_link(FwCall); + +spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> + Func1 = case Func of + {_InitOrEndPerTC,F} -> F; + F -> F + end, + FwCall = + fun() -> + try fw_error_notify(Mod,Func1,[], + Error,Loc) of + _ -> ok + catch + _:FwErrorNotifyErr -> + exit({fw_notify_done,error_notification, + FwErrorNotifyErr}) + end, + Conf = [{tc_status,{failed,Error}}|CurrConf], + try do_end_tc_call(Mod,Func1, + {Pid,Error,[Conf]},Error) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + %% finished, report back + SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}} + end, + spawn_link(FwCall). + +%% The job proxy process forwards messages between the test case +%% process on a shielded node (and its descendants) and the job process. +%% +%% The job proxy process have to be started by the test-case process +%% on the shielded node! +start_job_proxy() -> + group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok. + +%% The io_reply_proxy is not the most satisfying solution but it works... +io_reply_proxy(ReplyTo) -> + receive + IoReply when is_tuple(IoReply), + element(1, IoReply) == io_reply -> + ReplyTo ! IoReply; + _ -> + io_reply_proxy(ReplyTo) + end. + +job_proxy_msgloop() -> + receive + + %% + %% Messages that need intervention by proxy... + %% + + %% io stuff ... + IoReq when tuple_size(IoReq) >= 2, + element(1, IoReq) == io_request -> + + ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end), + group_leader() ! setelement(2, IoReq, ReplyProxy); + + %% test_server stuff... + {sync_apply, From, MFA} -> + group_leader() ! {sync_apply_proxy, self(), From, MFA}; + {sync_result_proxy, To, Result} -> + To ! {sync_result, Result}; + + %% + %% Messages that need no intervention by proxy... + %% + Msg -> + group_leader() ! Msg + end, + job_proxy_msgloop(). + +%% A test case is known to have failed if it returns {'EXIT', _} tuple, +%% or sends a message {failed, File, Line} to it's group_leader + +run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, + TimetrapData, LogOpts, TCCallback) -> + put(test_server_multiply_timetraps, TimetrapData), + put(test_server_logopts, LogOpts), + Where = [{Mod,Func}], + put(test_server_loc, Where), + + FWInitResult = test_server_sup:framework_call(init_tc,[Mod,Func,Args0], + {ok,Args0}), + set_tc_state(running), + {{Time,Value},Loc,Opts} = + case FWInitResult of + {ok,Args} -> + run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); + Error = {error,_Reason} -> + NewResult = do_end_tc_call(Mod,Func, {Error,Args0}, + {auto_skip,{failed,Error}}), + {{0,NewResult},Where,[]}; + {fail,Reason} -> + Conf = [{tc_status,{failed,Reason}} | hd(Args0)], + fw_error_notify(Mod, Func, Conf, Reason), + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]}, + {fail,Reason}), + {{0,NewResult},Where,[]}; + Skip = {SkipType,_Reason} when SkipType == skip; + SkipType == skipped -> + NewResult = do_end_tc_call(Mod,Func, + {Skip,Args0}, Skip), + {{0,NewResult},Where,[]}; + AutoSkip = {auto_skip,_Reason} -> + %% special case where a conf case "pretends" to be skipped + NewResult = + do_end_tc_call(Mod,Func, {AutoSkip,Args0}, AutoSkip), + {{0,NewResult},Where,[]} + end, + exit({Ref,Time,Value,Loc,Opts}). + +run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> + case RunInit of + run_init -> + set_tc_state(init_per_testcase, hd(Args)), + ensure_timetrap(Args), + case init_per_testcase(Mod, Func, Args) of + Skip = {SkipType,Reason} when SkipType == skip; + SkipType == skipped -> + Line = get_loc(), + Conf = [{tc_status,{skipped,Reason}}|hd(Args)], + NewRes = do_end_tc_call(Mod,Func, + {Skip,[Conf]}, Skip), + {{0,NewRes},Line,[]}; + {skip_and_save,Reason,SaveCfg} -> + Line = get_loc(), + Conf = [{tc_status,{skipped,Reason}}, + {save_config,SaveCfg}|hd(Args)], + NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]}, + {skip,Reason}), + {{0,NewRes},Line,[]}; + FailTC = {fail,Reason} -> % user fails the testcase + EndConf = [{tc_status,{failed,Reason}} | hd(Args)], + fw_error_notify(Mod, Func, EndConf, Reason), + NewRes = do_end_tc_call(Mod,Func, + {{error,Reason},[EndConf]}, + FailTC), + {{0,NewRes},[{Mod,Func}],[]}; + {ok,NewConf} -> + %% call user callback function if defined + NewConf1 = + user_callback(TCCallback, Mod, Func, init, NewConf), + %% save current state in controller loop + set_tc_state(tc, NewConf1), + %% execute the test case + {{T,Return},Loc} = {ts_tc(Mod,Func,[NewConf1]), get_loc()}, + {EndConf,TSReturn,FWReturn} = + case Return of + {E,TCError} when E=='EXIT' ; E==failed -> + fw_error_notify(Mod, Func, NewConf1, + TCError, Loc), + {[{tc_status,{failed,TCError}}, + {tc_fail_loc,Loc}|NewConf1], + Return,{error,TCError}}; + SaveCfg={save_config,_} -> + {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; + {skip_and_save,Why,SaveCfg} -> + Skip = {skip,Why}, + {[{tc_status,{skipped,Why}}, + {save_config,SaveCfg}|NewConf1], + Skip,Skip}; + {SkipType,Why} when SkipType == skip; + SkipType == skipped -> + {[{tc_status,{skipped,Why}}|NewConf1],Return, + Return}; + _ -> + {[{tc_status,ok}|NewConf1],Return,ok} + end, + %% call user callback function if defined + EndConf1 = + user_callback(TCCallback, Mod, Func, 'end', EndConf), + %% update current state in controller loop + {FWReturn1,TSReturn1,EndConf2} = + case end_per_testcase(Mod, Func, EndConf1) of + SaveCfg1={save_config,_} -> + {FWReturn,TSReturn, + [SaveCfg1|lists:keydelete(save_config,1, + EndConf1)]}; + {fail,ReasonToFail} -> + %% user has failed the testcase + fw_error_notify(Mod, Func, EndConf1, + ReasonToFail), + {{error,ReasonToFail}, + {failed,ReasonToFail}, + EndConf1}; + {failed,{_,end_per_testcase,_}} = Failure when + FWReturn == ok -> + %% unexpected termination in end_per_testcase + %% report this as the result to the framework + {Failure,TSReturn,EndConf1}; + _ -> + %% test case result should be reported to + %% framework no matter the status of + %% end_per_testcase + {FWReturn,TSReturn,EndConf1} + end, + %% clear current state in controller loop + case do_end_tc_call(Mod,Func, + {FWReturn1,[EndConf2]}, TSReturn1) of + {failed,Reason} = NewReturn -> + fw_error_notify(Mod,Func,EndConf2, Reason), + {{T,NewReturn},[{Mod,Func}],[]}; + NewReturn -> + {{T,NewReturn},Loc,[]} + end + end; + skip_init -> + set_tc_state(running, hd(Args)), + %% call user callback function if defined + Args1 = user_callback(TCCallback, Mod, Func, init, Args), + ensure_timetrap(Args1), + %% ts_tc does a catch + %% if this is a named conf group, the test case (init or end conf) + %% should be called with the name as the first argument + Args2 = if Name == undefined -> Args1; + true -> [Name | Args1] + end, + %% execute the conf test case + {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, + %% call user callback function if defined + Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), + {Return2,Opts} = process_return_val([Return1], Mod, Func, + Args1, [{Mod,Func}], Return1), + {{T,Return2},Loc,Opts} + end. + +do_end_tc_call(Mod, Func, Res, Return) -> + FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), + Ref = make_ref(), + if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false -> + case test_server_sup:framework_call( + end_tc, [Mod,Func,Res, Return], ok) of + {fail,FWReason} -> + {failed,FWReason}; + ok -> + case Return of + {fail,Reason} -> + {failed,Reason}; + Return -> + Return + end; + NewReturn -> + NewReturn + end; + true -> + case test_server_sup:framework_call(FwMod, end_tc, + [Mod,Func,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + _Else -> + Return + end + end. + +%% the return value is a list and we have to check if it contains +%% the result of an end conf case or if it's a Config list +process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> + ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result], + %% check if all elements in the list are valid end conf return value tuples + case lists:all(fun(Val) when is_tuple(Val) -> + lists:any(fun(T) -> T == element(1, Val) end, + ReturnTags); + (ok) -> + true; + (_) -> + false + end, Return) of + true -> % must be return value from end conf case + process_return_val1(Return, M,F,A, Loc, Final, []); + false -> % must be Config value from init conf case + case do_end_tc_call(M, F, {ok,A}, Return) of + {failed, FWReason} = Failed -> + fw_error_notify(M,F,A, FWReason), + {Failed, []}; + NewReturn -> + {NewReturn, []} + end + end; +%% the return value is not a list, so it's the return value from an +%% end conf case or it's a dummy value that can be ignored +process_return_val(Return, M,F,A, Loc, Final) -> + process_return_val1(Return, M,F,A, Loc, Final, []). + +process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) + when E=='EXIT'; + E==failed -> + fw_error_notify(M,F,A, TCError, Loc), + case do_end_tc_call(M,F, {{error,TCError}, + [[{tc_status,{failed,TCError}}|Args]]}, + Failed) of + {failed,FWReason} -> + {{failed,FWReason},SaveOpts}; + NewReturn -> + {NewReturn,SaveOpts} + end; +process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], + Loc, Final, SaveOpts) -> + process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); +process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], + Loc, _, SaveOpts) -> + process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]], + Loc, {skip,Why}, SaveOpts); +process_return_val1([GR={return_group_result,_}|Opts], M,F,A, + Loc, Final, SaveOpts) -> + process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]); +process_return_val1([RetVal={Tag,_}|Opts], M,F,A, + Loc, _, SaveOpts) when Tag==skip; + Tag==comment -> + process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts); +process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) -> + process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts); +process_return_val1([], M,F,A, _Loc, Final, SaveOpts) -> + case do_end_tc_call(M,F, {Final,A}, Final) of + {failed,FWReason} -> + {{failed,FWReason},SaveOpts}; + NewReturn -> + {NewReturn,lists:reverse(SaveOpts)} + end. + +user_callback(undefined, _, _, _, Args) -> + Args; +user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, + [Args]) when is_list(Args) -> + case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of + Args1 when is_list(Args1) -> + [Args1]; + _ -> + [Args] + end; +user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) -> + case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of + Args1 when is_list(Args1) -> + Args1; + _ -> + Args + end. + +init_per_testcase(Mod, Func, Args) -> + case code:is_loaded(Mod) of + false -> code:load_file(Mod); + _ -> ok + end, + case erlang:function_exported(Mod, init_per_testcase, 2) of + true -> + do_init_per_testcase(Mod, [Func|Args]); + false -> + %% Optional init_per_testcase is not defined -- keep quiet. + [Config] = Args, + {ok, Config} + end. + +do_init_per_testcase(Mod, Args) -> + try apply(Mod, init_per_testcase, Args) of + {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; + {skip_and_save,_,_}=Res -> + Res; + NewConf when is_list(NewConf) -> + case lists:filter(fun(T) when is_tuple(T) -> false; + (_) -> true end, NewConf) of + [] -> + {ok,NewConf}; + Bad -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase has returned " + "bad elements in Config: ~p\n",[Bad]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + end; + {fail,_Reason}=Res -> + Res; + _Other -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase did not return " + "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(), + FormattedLoc = test_server_sup:format_loc(Line), + group_leader() ! {printout,12, + "ERROR! init_per_testcase thrown!\n" + "\tLocation: ~ts\n\tReason: ~p\n", + [FormattedLoc, Other]}, + {skip,{failed,{Mod,init_per_testcase,Other}}}; + _:Reason0 -> + Stk = erlang:get_stacktrace(), + Reason = {Reason0,Stk}, + set_loc(Stk), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(Line), + group_leader() ! {printout,12, + "ERROR! init_per_testcase crashed!\n" + "\tLocation: ~ts\n\tReason: ~p\n", + [FormattedLoc,Reason]}, + {skip,{failed,{Mod,init_per_testcase,Reason}}} + end. + +end_per_testcase(Mod, Func, Conf) -> + case erlang:function_exported(Mod,end_per_testcase,2) of + true -> + do_end_per_testcase(Mod,end_per_testcase,Func,Conf); + false -> + %% Backwards compatibility! + case erlang:function_exported(Mod,fin_per_testcase,2) of + true -> + do_end_per_testcase(Mod,fin_per_testcase,Func,Conf); + false -> + ok + end + end. + +do_end_per_testcase(Mod,EndFunc,Func,Conf) -> + set_tc_state(end_per_testcase, Conf), + try Mod:EndFunc(Func, Conf) of + {save_config,_}=SaveCfg -> + SaveCfg; + {fail,_}=Fail -> + Fail; + _ -> + ok + catch + throw:Other -> + Comment0 = case read_comment() of + "" -> ""; + Cmt -> Cmt ++ test_server_ctrl:xhtml("
", + "
") + end, + set_loc(erlang:get_stacktrace()), + comment(io_lib:format("~ts" + "WARNING: ~w thrown!" + "\n",[Comment0,EndFunc])), + group_leader() ! {printout,12, + "WARNING: ~w thrown!\n" + "Reason: ~p\n" + "Line: ~ts\n", + [EndFunc, Other, + test_server_sup:format_loc(get_loc())]}, + {failed,{Mod,end_per_testcase,Other}}; + Class:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + Why = case Class of + exit -> {'EXIT',Reason}; + error -> {'EXIT',{Reason,Stk}} + end, + Comment0 = case read_comment() of + "" -> ""; + Cmt -> Cmt ++ test_server_ctrl:xhtml("
", + "
") + end, + comment(io_lib:format("~ts" + "WARNING: ~w crashed!" + "\n",[Comment0,EndFunc])), + group_leader() ! {printout,12, + "WARNING: ~w crashed!\n" + "Reason: ~p\n" + "Line: ~ts\n", + [EndFunc, Reason, + test_server_sup:format_loc(get_loc())]}, + {failed,{Mod,end_per_testcase,Why}} + end. + +get_loc() -> + get(test_server_loc). + +get_loc(Pid) -> + [{current_stacktrace,Stk0},{dictionary,Dict}] = + process_info(Pid, [current_stacktrace,dictionary]), + lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), + Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], + case get(test_server_loc) of + [{Suite,Case}] -> + %% Location info unknown, check if {Suite,Case,Line} + %% is available in stacktrace and if so, use stacktrace + %% instead of current test_server_loc. + %% If location is the last expression in a test case + %% function, the info is not available due to tail call + %% elimination. We need to check if the test case has been + %% called by ts_tc/3 and, if so, insert the test case info + %% at that position. + case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of + [match|_] -> + put(test_server_loc, Stk); + _ -> + {PreTC,PostTC} = + lists:splitwith(fun({test_server,ts_tc,_}) -> + false; + (_) -> + true + end, Stk), + if PostTC == [] -> + ok; + true -> + put(test_server_loc, + PreTC++[{Suite,Case,last_expr} | PostTC]) + end + end; + _ -> + put(test_server_loc, Stk) + end, + get_loc(). + +fw_error_notify(Mod, Func, Args, Error) -> + test_server_sup:framework_call(error_notification, + [Mod,Func,[Args], + {Error,unknown}]). +fw_error_notify(Mod, Func, Args, Error, Loc) -> + test_server_sup:framework_call(error_notification, + [Mod,Func,[Args], + {Error,Loc}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% print(Detail,Format,Args,Printer) -> ok +%% Detail = integer() +%% Format = string() +%% Args = [term()] +%% +%% Just like io:format, except that depending on the Detail value, the output +%% is directed to console, major and/or minor log files. + +%% print(Detail,Format,Args) -> +%% test_server_ctrl:print(Detail, Format, Args). + +print(Detail,Format,Args,Printer) -> + test_server_ctrl:print(Detail, Format, Args, Printer). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% print_timsteamp(Detail,Leader) -> ok +%% +%% Prints Leader followed by a time stamp (date and time). Depending on +%% the Detail value, the output is directed to console, major and/or minor +%% log files. + +print_timestamp(Detail,Leader) -> + test_server_ctrl:print_timestamp(Detail, Leader). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined +%% Key = term() +%% Value = term() +%% Config = [{Key,Value},...] +%% +%% Looks up a specific key in the config list, and returns the value +%% of the associated key, or undefined if the key doesn't exist. + +lookup_config(Key,Config) -> + case lists:keysearch(Key,1,Config) of + {value,{Key,Val}} -> + Val; + _ -> + io:format("Could not find element ~p in Config.~n",[Key]), + undefined + end. + +%% +%% IMPORTANT: get_loc/1 uses the name of this function when analysing +%% stack traces. If the name changes, get_loc/1 must be updated! +%% +ts_tc(M, F, A) -> + Before = erlang:monotonic_time(), + 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), + case Type of + throw -> + {failed,{thrown,Reason}}; + error -> + {'EXIT',{Reason,Stk}}; + exit -> + {'EXIT',Reason} + end + end, + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds), + {Elapsed, Result}. + +set_loc(Stk) -> + Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of + [{M,F,0}|Stack] -> + [{M,F}|Stack]; + Other -> + Other + end, + put(test_server_loc, Loc). + +rewrite_loc_item({M,F,_,Loc}) -> + {M,F,proplists:get_value(line, Loc, 0)}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% TEST SUITE SUPPORT FUNCTIONS %% +%% %% +%% Note: Some of these functions have been moved to test_server_sup %% +%% in an attempt to keep this modules small (yeah, right!) %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% format(Format) -> IoLibReturn +%% format(Detail,Format) -> IoLibReturn +%% format(Format,Args) -> IoLibReturn +%% format(Detail,Format,Args) -> IoLibReturn +%% Detail = integer() +%% Format = string() +%% Args = [term(),...] +%% IoLibReturn = term() +%% +%% Logs the Format string and Args, similar to io:format/1/2 etc. If +%% Detail is not specified, the default detail level (which is 50) is used. +%% Which log files the string will be logged in depends on the thresholds +%% set with set_levels/3. Typically with default detail level, only the +%% minor log file is used. +format(Format) -> + format(minor, Format, []). + +format(major, Format) -> + format(major, Format, []); +format(minor, Format) -> + format(minor, Format, []); +format(Detail, Format) when is_integer(Detail) -> + format(Detail, Format, []); +format(Format, Args) -> + format(minor, Format, Args). + +format(Detail, Format, Args) -> + Str = + case catch io_lib:format(Format,Args) of + {'EXIT',_} -> + io_lib:format("illegal format; ~p with args ~p.\n", + [Format,Args]); + Valid -> Valid + end, + log({Detail, Str}). + +log(Msg) -> + group_leader() ! {structured_io, self(), Msg}, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% capture_start() -> ok +%% capture_stop() -> ok +%% +%% Starts/stops capturing all output from io:format, and similar. Capturing +%% output doesn't stop output from happening. It just makes it possible +%% to retrieve the output using capture_get/0. +%% Starting and stopping capture doesn't affect already captured output. +%% All output is stored as messages in the message queue until retrieved + +capture_start() -> + group_leader() ! {capture,self()}, + ok. + +capture_stop() -> + group_leader() ! {capture,false}, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% capture_get() -> Output +%% Output = [string(),...] +%% +%% Retrieves all the captured output since last call to capture_get/0. +%% Note that since output arrive as messages to the process, it takes +%% a short while from the call to io:format until all output is available +%% by capture_get/0. It is not necessary to call capture_stop/0 before +%% retreiving the output. +capture_get() -> + test_server_sup:capture_get([]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% messages_get() -> Messages +%% Messages = [term(),...] +%% +%% Returns all messages in the message queue. +messages_get() -> + test_server_sup:messages_get([]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% permit_io(GroupLeader, FromPid) -> ok +%% +%% Make sure proceeding IO from FromPid won't get rejected +permit_io(GroupLeader, FromPid) -> + GroupLeader ! {permit_io,FromPid}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sleep(Time) -> ok +%% Time = integer() | float() | infinity +%% +%% Sleeps the specified number of milliseconds. This sleep also accepts +%% floating point numbers (which are truncated) and the atom 'infinity'. +sleep(infinity) -> + receive + after infinity -> + ok + end; +sleep(MSecs) -> + receive + after trunc(MSecs) -> + ok + end, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% adjusted_sleep(Time) -> ok +%% Time = integer() | float() | infinity +%% +%% Sleeps the specified number of milliseconds, multiplied by the +%% 'multiply_timetraps' value (if set) and possibly also automatically scaled +%% up if 'scale_timetraps' is set to true (which is default). +%% This function also accepts floating point numbers (which are truncated) and +%% the atom 'infinity'. +adjusted_sleep(infinity) -> + receive + after infinity -> + ok + end; +adjusted_sleep(MSecs) -> + {Multiplier,ScaleFactor} = + case test_server_ctrl:get_timetrap_parameters() of + {undefined,undefined} -> + {1,1}; + {undefined,false} -> + {1,1}; + {undefined,true} -> + {1,timetrap_scale_factor()}; + {infinity,_} -> + {infinity,1}; + {Mult,undefined} -> + {Mult,1}; + {Mult,false} -> + {Mult,1}; + {Mult,true} -> + {Mult,timetrap_scale_factor()} + end, + receive + after trunc(MSecs*Multiplier*ScaleFactor) -> + ok + end, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% fail(Reason) -> exit({suite_failed,Reason}) +%% +%% Immediately calls exit. Included because test suites are easier +%% to read when using this function, rather than exit directly. +fail(Reason) -> + comment(cast_to_list(Reason)), + try + exit({suite_failed,Reason}) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,1,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. + +cast_to_list(X) when is_list(X) -> X; +cast_to_list(X) when is_atom(X) -> atom_to_list(X); +cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% fail() -> exit(suite_failed) +%% +%% Immediately calls exit. Included because test suites are easier +%% to read when using this function, rather than exit directly. +fail() -> + try + exit(suite_failed) + catch + Class:R -> + case erlang:get_stacktrace() of + [{?MODULE,fail,0,_}|Stk] -> ok; + Stk -> ok + end, + erlang:raise(Class, R, Stk) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% break(Comment) -> ok +%% +%% Break a test case so part of the test can be done manually. +%% Use continue/0 to continue. +break(Comment) -> + break(?MODULE, Comment). + +break(CBM, Comment) -> + break(CBM, '', Comment). + +break(CBM, TestCase, Comment) -> + timetrap_cancel(), + {TCName,CntArg,PName} = + if TestCase == '' -> + {"", "", test_server_break_process}; + true -> + Str = atom_to_list(TestCase), + {[32 | Str], Str, + list_to_atom("test_server_break_process_" ++ Str)} + end, + io:format(user, + "\n\n\n--- SEMIAUTOMATIC TESTING ---" + "\nThe test case~ts executes on process ~w" + "\n\n\n~ts" + "\n\n\n-----------------------------\n\n" + "Continue with --> ~w:continue(~ts).\n", + [TCName,self(),Comment,CBM,CntArg]), + case whereis(PName) of + undefined -> + spawn_break_process(self(), PName); + OldBreakProcess -> + OldBreakProcess ! cancel, + spawn_break_process(self(), PName) + end, + receive continue -> ok end. + +spawn_break_process(Pid, PName) -> + spawn(fun() -> + register(PName, self()), + receive + continue -> continue(Pid); + cancel -> ok + end + end). + +continue() -> + case whereis(test_server_break_process) of + undefined -> ok; + BreakProcess -> BreakProcess ! continue + end. + +continue(TestCase) when is_atom(TestCase) -> + PName = list_to_atom("test_server_break_process_" ++ + atom_to_list(TestCase)), + case whereis(PName) of + undefined -> ok; + BreakProcess -> BreakProcess ! continue + end; + +continue(Pid) when is_pid(Pid) -> + Pid ! continue. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_scale_factor() -> Factor +%% +%% Returns the amount to scale timetraps with. + +%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true +timetrap_scale_factor() -> + timetrap_scale_factor([ + { 2, fun() -> has_lock_checking() end}, + { 3, fun() -> has_superfluous_schedulers() end}, + { 5, fun() -> purify_is_running() end}, + { 6, fun() -> is_debug() end}, + {10, fun() -> is_cover() end} + ]). + +timetrap_scale_factor(Scales) -> + %% The fun in {S, Fun} a filter input to the list comprehension + lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap(Timeout) -> Handle +%% Handle = term() +%% +%% Creates a time trap, that will kill the calling process if the +%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. +timetrap(Timeout) -> + MultAndScale = + case get(test_server_multiply_timetraps) of + undefined -> {fun(T) -> T end, true}; + {undefined,false} -> {fun(T) -> T end, false}; + {undefined,_} -> {fun(T) -> T end, true}; + {infinity,_} -> {fun(_) -> infinity end, false}; + {Int,Scale} -> {fun(infinity) -> infinity; + (T) -> T*Int end, Scale} + end, + timetrap(Timeout, Timeout, self(), MultAndScale). + +%% when the function is called from different process than +%% the test case, the test_server_multiply_timetraps data +%% is unknown and must be passed as argument +timetrap(Timeout, TCPid, MultAndScale) -> + timetrap(Timeout, Timeout, TCPid, MultAndScale). + +timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) -> + %% the time_ms call will either convert Timeout to ms or spawn a + %% user timetrap which sends the result to the IO server process + Timeout = time_ms(Timeout0, TCPid, MultAndScale), + Timeout1 = Multiplier(Timeout), + TimeToReport = if Timeout0 == TimeToReport0 -> + Timeout1; + true -> + %% only convert to ms, don't start a + %% user timetrap + time_ms_check(TimeToReport0) + end, + cancel_default_timetrap(self() == TCPid), + Handle = case Timeout1 of + infinity -> + infinity; + _ -> + spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport, + Scale,TCPid]) + end, + + %% ERROR! This sets dict on IO process instead of testcase process + %% if Timeout is return value from previous user timetrap!! + + case get(test_server_timetraps) of + undefined -> + put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); + List -> + List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), + put(test_server_timetraps,[{Handle,TCPid, + {TimeToReport,Scale}}|List1]) + end, + Handle. + +ensure_timetrap(Config) -> + case get(test_server_timetraps) of + [_|_] -> + ok; + _ -> + case get(test_server_default_timetrap) of + undefined -> ok; + Garbage -> + erase(test_server_default_timetrap), + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", + [Garbage]) + end, + DTmo = case lists:keysearch(default_timeout,1,Config) of + {value,{default_timeout,Tmo}} -> Tmo; + _ -> ?DEFAULT_TIMETRAP_SECS + end, + format("=== test_server setting default " + "timetrap of ~p seconds~n", + [DTmo]), + put(test_server_default_timetrap, timetrap(seconds(DTmo))) + end. + +%% executing on IO process, no default timetrap ever set here +cancel_default_timetrap(false) -> + ok; +cancel_default_timetrap(true) -> + case get(test_server_default_timetrap) of + undefined -> + ok; + TimeTrap when is_pid(TimeTrap) -> + timetrap_cancel(TimeTrap), + erase(test_server_default_timetrap), + format("=== test_server canceled default timetrap " + "since another timetrap was set~n"), + ok; + Garbage -> + erase(test_server_default_timetrap), + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", + [Garbage]), + error + end. + +time_ms({hours,N}, _, _) -> hours(N); +time_ms({minutes,N}, _, _) -> minutes(N); +time_ms({seconds,N}, _, _) -> seconds(N); +time_ms({Other,_N}, _, _) -> + format("=== ERROR: Invalid time specification: ~p. " + "Should be seconds, minutes, or hours.~n", [Other]), + exit({invalid_time_format,Other}); +time_ms(Ms, _, _) when is_integer(Ms) -> Ms; +time_ms(infinity, _, _) -> infinity; +time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) -> + time_ms_apply(Fun, TCPid, MultAndScale); +time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), + is_atom(F), + is_list(A) -> + time_ms_apply(MFA, TCPid, MultAndScale); +time_ms(Other, _, _) -> exit({invalid_time_format,Other}). + +time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> + MFA; +time_ms_check(Fun) when is_function(Fun) -> + Fun; +time_ms_check(Other) -> + time_ms(Other, undefined, undefined). + +time_ms_apply(Func, TCPid, MultAndScale) -> + {_,GL} = process_info(TCPid, group_leader), + WhoAmI = self(), % either TC or IO server + T0 = erlang:monotonic_time(), + UserTTSup = + spawn(fun() -> + user_timetrap_supervisor(Func, WhoAmI, TCPid, + GL, T0, MultAndScale) + end), + receive + {UserTTSup,infinity} -> + %% remember the user timetrap so that it can be cancelled + save_user_timetrap(TCPid, UserTTSup, T0), + %% we need to make sure the user timetrap function + %% gets time to execute and return + timetrap(infinity, TCPid, MultAndScale) + after 5000 -> + exit(UserTTSup, kill), + if WhoAmI /= GL -> + exit({user_timetrap_error,time_ms_apply}); + true -> + format("=== ERROR: User timetrap execution failed!", []), + ignore + end + end. + +user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> + process_flag(trap_exit, true), + Spawner ! {self(),infinity}, + MonRef = monitor(process, TCPid), + UserTTSup = self(), + group_leader(GL, UserTTSup), + UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), + receive + {UserTT,Result} -> + demonitor(MonRef, [flush]), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), + try time_ms_check(Result) of + TimeVal -> + %% this is the new timetrap value to set (return value + %% from a fun or an MFA) + GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale} + catch _:_ -> + %% when other than a legal timetrap value is returned + %% which will be the normal case for user timetraps + GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale} + end; + {'EXIT',UserTT,Error} when Error /= normal -> + demonitor(MonRef, [flush]), + GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, + MultAndScale}; + {'DOWN',MonRef,_,_,_} -> + demonitor(MonRef, [flush]), + exit(UserTT, kill) + end. + +call_user_timetrap(Func, Sup) when is_function(Func) -> + try Func() of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end; +call_user_timetrap({M,F,A}, Sup) -> + try apply(M,F,A) of + Result -> + Sup ! {self(),Result} + catch _:Error -> + exit({Error,erlang:get_stacktrace()}) + end. + +save_user_timetrap(TCPid, UserTTSup, StartTime) -> + %% save pid of user timetrap supervisor process so that + %% it may be stopped even before the timetrap func has returned + NewUserTT = {TCPid,{UserTTSup,StartTime}}, + case get(test_server_user_timetrap) of + undefined -> + put(test_server_user_timetrap, [NewUserTT]); + UserTTSups -> + case proplists:get_value(TCPid, UserTTSups) of + undefined -> + put(test_server_user_timetrap, + [NewUserTT | UserTTSups]); + PrevTTSup -> + %% remove prev user timetrap + remove_user_timetrap(PrevTTSup), + put(test_server_user_timetrap, + [NewUserTT | proplists:delete(TCPid, + UserTTSups)]) + end + end. + +update_user_timetraps(TCPid, StartTime) -> + %% called when a user timetrap is triggered + case get(test_server_user_timetrap) of + undefined -> + proceed; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {_UserTTSup,StartTime} -> % same timetrap + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed; + {OtherUserTTSup,OtherStartTime} -> + case OtherStartTime - StartTime of + Diff when Diff >= 0 -> + ignore; + _ -> + exit(OtherUserTTSup, kill), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)), + proceed + end; + undefined -> + proceed + end + end. + +remove_user_timetrap(TTSup) -> + exit(TTSup, kill). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_cancel(Handle) -> ok +%% Handle = term() +%% +%% Cancels a time trap. +timetrap_cancel(Handle) -> + timetrap_cancel_one(Handle, true). + +timetrap_cancel_one(infinity, _SendToServer) -> + ok; +timetrap_cancel_one(Handle, SendToServer) -> + case get(test_server_timetraps) of + undefined -> + ok; + [{Handle,_,_}] -> + erase(test_server_timetraps); + Timers -> + case lists:keysearch(Handle, 1, Timers) of + {value,_} -> + put(test_server_timetraps, + lists:keydelete(Handle, 1, Timers)); + false when SendToServer == true -> + group_leader() ! {timetrap_cancel_one,Handle,self()}; + false -> + ok + end + end, + test_server_sup:timetrap_cancel(Handle). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_cancel() -> ok +%% +%% Cancels timetrap for current test case. +timetrap_cancel() -> + timetrap_cancel_all(self(), true). + +timetrap_cancel_all(TCPid, SendToServer) -> + case get(test_server_timetraps) of + undefined -> + ok; + Timers -> + [timetrap_cancel_one(Handle, false) || + {Handle,Pid,_} <- Timers, Pid == TCPid] + end, + case get(test_server_user_timetrap) of + undefined -> + ok; + UserTTs -> + case proplists:get_value(TCPid, UserTTs) of + {UserTTSup,_StartTime} -> + remove_user_timetrap(UserTTSup), + put(test_server_user_timetrap, + proplists:delete(TCPid, UserTTs)); + undefined -> + ok + end + end, + if SendToServer == true -> + group_leader() ! {timetrap_cancel_all,TCPid,self()}; + true -> + ok + end, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% get_timetrap_info() -> {Timeout,Scale} | undefined +%% +%% Read timetrap info for current test case +get_timetrap_info() -> + get_timetrap_info(self(), true). + +get_timetrap_info(TCPid, SendToServer) -> + case get(test_server_timetraps) of + undefined -> + undefined; + Timers -> + case [Info || {Handle,Pid,Info} <- Timers, + Pid == TCPid, Handle /= infinity] of + [I|_] -> + I; + [] when SendToServer == true -> + tc_supervisor_req({get_timetrap_info,TCPid}); + [] -> + undefined + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% hours(N) -> Milliseconds +%% minutes(N) -> Milliseconds +%% seconds(N) -> Milliseconds +%% N = integer() | float() +%% Milliseconds = integer() +%% +%% Transforms the named units to milliseconds. Fractions in the input +%% are accepted. The output is an integer. +hours(N) -> trunc(N * 1000 * 60 * 60). +minutes(N) -> trunc(N * 1000 * 60). +seconds(N) -> trunc(N * 1000). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% tc_supervisor_req(Tag) -> Result +%% tc_supervisor_req(Tag, Msg) -> Result +%% + +tc_supervisor_req(Tag) -> + Pid = test_server_gl:get_tc_supervisor(group_leader()), + Pid ! {Tag,self()}, + receive + {Pid,Tag,Result} -> + Result + after 5000 -> + error(no_answer_from_tc_supervisor) + end. + +tc_supervisor_req(Tag, Msg) -> + Pid = test_server_gl:get_tc_supervisor(group_leader()), + Pid ! {Tag,self(),Msg}, + receive + {Pid,Tag,Result} -> + Result + after 5000 -> + error(no_answer_from_tc_supervisor) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timecall(M,F,A) -> {Time,Val} +%% Time = float() +%% +%% Measures the time spent evaluating MFA. The measurement is done with +%% erlang:now/0, and should have pretty good accuracy on most platforms. +%% The function is not evaluated in a catch context. +timecall(M, F, A) -> + test_server_sup:timecall(M,F,A). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_times(N,M,F,A) -> ok +%% do_times(N,Fun) -> +%% N = integer() +%% Fun = fun() -> void() +%% +%% Evaluates MFA or Fun N times, and returns ok. +do_times(N,M,F,A) when N>0 -> + apply(M,F,A), + do_times(N-1,M,F,A); +do_times(0,_,_,_) -> + ok. + +do_times(N,Fun) when N>0 -> + Fun(), + do_times(N-1,Fun); +do_times(0,_) -> + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}}) +%% M = integer() +%% N = integer() +%% Fun = fun() -> void() +%% R = integer() +%% +%% Repeats evaluating the given function until it succeeded (didn't crash) +%% M times. If, after N times, M successful attempts have not been +%% accomplished, the process crashes with reason {m_out_of_n_failed +%% {R,left_to_do}}, where R indicates how many cases that remained to be +%% successfully completed. +%% +%% For example: +%% m_out_of_n(1,4,fun() -> tricky_test_case() end) +%% Tries to run tricky_test_case() up to 4 times, +%% and is happy if it succeeds once. +%% +%% m_out_of_n(7,8,fun() -> clock_sanity_check() end) +%% Tries running clock_sanity_check() up to 8 +%% times and allows the function to fail once. +%% This might be useful if clock_sanity_check/0 +%% is known to fail if the clock crosses an hour +%% boundary during the test (and the up to 8 +%% test runs could never cross 2 boundaries) +m_out_of_n(0,_,_) -> + ok; +m_out_of_n(M,0,_) -> + exit({m_out_of_n_failed,{M,left_to_do}}); +m_out_of_n(M,N,Fun) -> + case catch Fun() of + {'EXIT',_} -> + m_out_of_n(M,N-1,Fun); + _Other -> + m_out_of_n(M-1,N-1,Fun) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%call_crash(M,F,A) +%%call_crash(Time,M,F,A) +%%call_crash(Time,Crash,M,F,A) +%% M - atom() +%% F - atom() +%% A - [term()] +%% Time - integer() in milliseconds. +%% Crash - term() +%% +%% Spaws a new process that calls MFA. The call is considered +%% successful if the call crashes with the given reason (Crash), +%% or any other reason if Crash is not specified. +%% ** The call must terminate withing the given Time (defaults +%% to infinity), or it is considered a failure (exit with reason +%% 'call_crash_timeout' is generated). + +call_crash(M,F,A) -> + call_crash(infinity,M,F,A). +call_crash(Time,M,F,A) -> + call_crash(Time,any,M,F,A). +call_crash(Time,Crash,M,F,A) -> + test_server_sup:call_crash(Time,Crash,M,F,A). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% start_node(SlaveName, Type, Options) -> +%% {ok, Slave} | {error, Reason} +%% +%% SlaveName = string(), atom(). +%% Type = slave | peer +%% Options = [{tuple(), term()}] +%% +%% OptionList is a tuplelist wich may contain one +%% or more of these members: +%% +%% Slave and Peer: +%% {remote, true} - Start the node on a remote host. If not specified, +%% the node will be started on the local host (with +%% some exceptions, for instance VxWorks, +%% where all nodes are started on a remote host). +%% {args, Arguments} - Arguments passed directly to the node. +%% {cleanup, false} - Nodes started with this option will not be killed +%% by the test server after completion of the test case +%% Therefore it is IMPORTANT that the USER terminates +%% the node!! +%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList +%% when starting nodes, instead of the same emulator +%% as the test server is running. ReleaseList is a list +%% of specifiers, where a specifier is either +%% {release, Rel}, {prog, Prog}, or 'this'. Rel is +%% either the name of a release, e.g., "r7a" or +%% 'latest'. 'this' means using the same emulator as +%% the test server. Prog is the name of an emulator +%% executable. If the list has more than one element, +%% one of them is picked randomly. (Only +%% works on Solaris and Linux, and the test +%% server gives warnings when it notices that +%% nodes are not of the same version as +%% itself.) +%% +%% Peer only: +%% {wait, false} - Don't wait for the node to be started. +%% {fail_on_error, false} - Returns {error, Reason} rather than failing +%% the test case. This option can only be used with +%% peer nodes. +%% Note that slave nodes always act as if they had +%% fail_on_error==false. +%% + +start_node(Name, Type, Options) -> + lists:foreach( + fun(N) -> + case firstname(N) of + Name -> + format("=== WARNING: Trying to start node \'~w\' when node" + " with same first name exists: ~w", [Name, N]); + _other -> ok + end + end, + nodes()), + + group_leader() ! {sync_apply, + self(), + {test_server_ctrl,start_node,[Name,Type,Options]}}, + Result = receive {sync_result,R} -> R end, + + case Result of + {ok,Node} -> + + %% Cannot run cover on shielded node or on a node started + %% by a shielded node. + Cover = case is_cover(Node) of + true -> + proplists:get_value(start_cover,Options,true); + false -> + false + end, + + net_adm:ping(Node), + case Cover of + true -> + do_cover_for_node(Node,start); + _ -> + ok + end, + {ok,Node}; + {fail,Reason} -> fail(Reason); + Error -> Error + end. + +firstname(N) -> + list_to_atom(upto($@,atom_to_list(N))). + +%% This should!!! crash if H is not member in list. +upto(H, [H | _T]) -> []; +upto(H, [X | T]) -> [X | upto(H,T)]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% wait_for_node(Name) -> ok | {error,timeout} +%% +%% If a node is started with the options {wait,false}, this function +%% can be used to wait for the node to come up from the +%% test server point of view (i.e. wait until it has contacted +%% the test server controller after startup) +wait_for_node(Slave) -> + group_leader() ! {sync_apply, + self(), + {test_server_ctrl,wait_for_node,[Slave]}}, + Result = receive {sync_result,R} -> R end, + case Result of + ok -> + net_adm:ping(Slave), + case is_cover(Slave) of + true -> + do_cover_for_node(Slave,start); + _ -> + ok + end; + _ -> + ok + end, + Result. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% stop_node(Name) -> true|false +%% +%% Kills a (remote) node. +%% Also inform test_server_ctrl so it can clean up! +stop_node(Slave) -> + Cover = is_cover(Slave), + if Cover -> do_cover_for_node(Slave,flush,false); + true -> ok + end, + group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}}, + Result = receive {sync_result,R} -> R end, + case Result of + ok -> + erlang:monitor_node(Slave, true), + slave:stop(Slave), + receive + {nodedown, Slave} -> + format(minor, "Stopped slave node: ~w", [Slave]), + format(major, "=node_stop ~w", [Slave]), + if Cover -> do_cover_for_node(Slave,stop,false); + true -> ok + end, + true + after 30000 -> + format("=== WARNING: Node ~w does not seem to terminate.", + [Slave]), + erlang:monitor_node(Slave, false), + receive {nodedown, Slave} -> ok after 0 -> ok end, + false + end; + {error, _Reason} -> + %% Either, the node is already dead or it was started + %% with the {cleanup,false} option, or it was started + %% in some other way than test_server:start_node/3 + format("=== WARNING: Attempt to stop a nonexisting slavenode (~w)~n" + "=== Trying to kill it anyway!!!", + [Slave]), + case net_adm:ping(Slave)of + pong -> + erlang:monitor_node(Slave, true), + slave:stop(Slave), + receive + {nodedown, Slave} -> + format(minor, "Stopped slave node: ~w", [Slave]), + format(major, "=node_stop ~w", [Slave]), + if Cover -> do_cover_for_node(Slave,stop,false); + true -> ok + end, + true + after 30000 -> + format("=== WARNING: Node ~w does not seem to terminate.", + [Slave]), + erlang:monitor_node(Slave, false), + receive {nodedown, Slave} -> ok after 0 -> ok end, + false + end; + pang -> + if Cover -> do_cover_for_node(Slave,stop,false); + true -> ok + end, + false + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_release_available(Release) -> true | false +%% Release -> string() +%% +%% Test if a release (such as "r10b") is available to be +%% started using start_node/3. + +is_release_available(Release) -> + group_leader() ! {sync_apply, + self(), + {test_server_ctrl,is_release_available,[Release]}}, + receive {sync_result,R} -> R end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_on_shielded_node(Fun, CArgs) -> term() +%% Fun -> function() +%% CArg -> list() +%% +%% +%% Fun is executed in a process on a temporarily created +%% hidden node. Communication with the job process goes +%% via a job proxy process on the hidden node, i.e. the +%% group leader of the test case process is the job proxy +%% process. This makes it possible to start nodes from the +%% hidden node that are unaware of the test server node. +%% Without the job proxy process all processes would have +%% a process residing on the test_server node as group_leader. +%% +%% Fun - Function to execute +%% CArg - Extra command line arguments to use when starting +%% the shielded node. +%% +%% If Fun is successfully executed, the result is returned. +%% + +run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> + Nr = erlang:unique_integer([positive]), + Name = "shielded_node-" ++ integer_to_list(Nr), + Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of + {ok, N} -> N; + Err -> fail({failed_to_start_shielded_node, Err}) + end, + Master = self(), + Ref = make_ref(), + Slave = spawn(Node, + fun () -> + start_job_proxy(), + receive + Ref -> + Master ! {Ref, Fun()} + end, + receive after infinity -> infinity end + end), + MRef = erlang:monitor(process, Slave), + Slave ! Ref, + receive + {'DOWN', MRef, _, _, Info} -> + stop_node(Node), + fail(Info); + {Ref, Res} -> + stop_node(Node), + receive + {'DOWN', MRef, _, _, _} -> + Res + end + end. + +%% Return true if Name or node() is a shielded node +is_shielded(Name) -> + case {cast_to_list(Name),atom_to_list(node())} of + {"shielded_node"++_,_} -> true; + {_,"shielded_node"++_} -> true; + _ -> false + end. + +same_version(Name) -> + ThisVersion = erlang:system_info(version), + OtherVersion = rpc:call(Name, erlang, system_info, [version]), + ThisVersion =:= OtherVersion. + +is_cover(Name) -> + case is_cover() of + true -> + not is_shielded(Name) andalso same_version(Name); + false -> + false + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% temp_name(Stem) -> string() +%% Stem = string() +%% +%% Create a unique file name, based on (starting with) Stem. +%% A filename of the form is generated, and the +%% function checks that that file doesn't already exist. +temp_name(Stem) -> + Num = erlang:unique_integer([positive]), + RandomName = Stem ++ integer_to_list(Num), + {ok,Files} = file:list_dir(filename:dirname(Stem)), + case lists:member(RandomName,Files) of + true -> + %% oh, already exists - bad luck. Try again. + temp_name(Stem); %% recursively try again + false -> + RandomName + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% app_test/1 +%% +app_test(App) -> + app_test(App, pedantic). +app_test(App, Mode) -> + test_server_sup:app_test(App, Mode). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% appup_test/1 +%% +appup_test(App) -> + test_server_sup:appup_test(App). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_native(Mod) -> true | false +%% +%% Checks wether the module is natively compiled or not. + +is_native(Mod) -> + (catch Mod:module_info(native)) =:= true. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% comment(String) -> ok +%% +%% The given String will occur in the comment field +%% of the table on the test suite result page. If +%% called several times, only the last comment is +%% printed. +%% comment/1 is also overwritten by the return value +%% {comment,Comment} or fail/1 (which prints Reason +%% as a comment). +comment(String) -> + group_leader() ! {comment,String}, + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% read_comment() -> string() +%% +%% Read the current comment string stored in +%% state during test case execution. +read_comment() -> + tc_supervisor_req(read_comment). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% make_priv_dir() -> ok +%% +%% Order test server to create the private directory +%% for the current test case. +make_priv_dir() -> + tc_supervisor_req(make_priv_dir). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% os_type() -> OsType +%% +%% Returns the OsType of the target node. OsType is +%% the same as returned from os:type() +os_type() -> + os:type(). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_cover() -> boolean() +%% +%% Returns true if cover is running, else false +is_cover() -> + case whereis(cover_server) of + undefined -> false; + _ -> true + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_debug() -> boolean() +%% +%% Returns true if the emulator is debug-compiled, false otherwise. +is_debug() -> + case catch erlang:system_info(debug_compiled) of + {'EXIT', _} -> + case string:str(erlang:system_info(system_version), "debug") of + Int when is_integer(Int), Int > 0 -> true; + _ -> false + end; + Res -> + Res + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% has_lock_checking() -> boolean() +%% +%% Returns true if the emulator has lock checking enabled, false otherwise. +has_lock_checking() -> + case catch erlang:system_info(lock_checking) of + {'EXIT', _} -> false; + Res -> Res + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% has_superfluous_schedulers() -> boolean() +%% +%% Returns true if the emulator has more scheduler threads than logical +%% processors, false otherwise. +has_superfluous_schedulers() -> + case catch {erlang:system_info(schedulers), + erlang:system_info(logical_processors)} of + {S, P} when is_integer(S), is_integer(P), S > P -> true; + _ -> false + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_commercial_build() -> boolean() +%% +%% Returns true if the current emulator is commercially supported. +%% (The emulator will not have "[source]" in its start-up message.) +%% We might want to do more tests on a commercial platform, for instance +%% ensuring that all applications have documentation). +is_commercial() -> + case string:str(erlang:system_info(system_version), "source") of + Int when is_integer(Int), Int > 0 -> false; + _ -> true + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DEBUGGER INTERFACE %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% purify_is_running() -> false|true +%% +%% Tests if Purify is currently running. + +purify_is_running() -> + case catch erlang:system_info({error_checker, running}) of + {'EXIT', _} -> false; + Res -> Res + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% purify_new_leaks() -> false|BytesLeaked +%% BytesLeaked = integer() +%% +%% Checks for new memory leaks if Purify is active. +%% Returns the number of bytes leaked, or false if Purify +%% is not running. +purify_new_leaks() -> + case catch erlang:system_info({error_checker, memory}) of + {'EXIT', _} -> false; + Leaked when is_integer(Leaked) -> Leaked + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% purify_new_fds_inuse() -> false|FdsInuse +%% FdsInuse = integer() +%% +%% Checks for new file descriptors in use. +%% Returns the number of new file descriptors in use, or false +%% if Purify is not running. +purify_new_fds_inuse() -> + case catch erlang:system_info({error_checker, fd}) of + {'EXIT', _} -> false; + Inuse when is_integer(Inuse) -> Inuse + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% purify_format(Format, Args) -> ok +%% Format = string() +%% Args = lists() +%% +%% Outputs the formatted string to Purify's logfile,if Purify is active. +purify_format(Format, Args) -> + (catch erlang:system_info({error_checker, io_lib:format(Format, Args)})), + ok. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Apply given function and reply to caller or proxy. +%% +do_sync_apply(Proxy, From, {M,F,A}) -> + Result = apply(M, F, A), + if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result}; + true -> From ! {sync_result,Result} + end. diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl new file mode 100644 index 0000000000..cd08a25bd8 --- /dev/null +++ b/lib/common_test/src/test_server_ctrl.erl @@ -0,0 +1,5652 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_ctrl). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The Erlang Test Server %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% MODULE DEPENDENCIES: +%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string, +%% code, ets, rpc, gen_tcp, inet, erl_tar, sets, +%% test_server, test_server_sup, test_server_node +%% EASIER TO REMOVE: filename, filelib, lib, re +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([start/0, start/1, start_link/1, stop/0]). + +%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([add_spec/1, add_dir/2, add_dir/3]). +-export([add_module/1, add_module/2, + add_conf/3, + add_case/2, add_case/3, add_cases/2, add_cases/3]). +-export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]). +-export([add_module_with_skip/2, add_module_with_skip/3, + add_conf_with_skip/4, + add_case_with_skip/3, add_case_with_skip/4, + add_cases_with_skip/3, add_cases_with_skip/4]). +-export([jobs/0, run_test/1, wait_finish/0, idle_notify/1, + abort_current_testcase/1, abort/0]). +-export([start_get_totals/1, stop_get_totals/0]). +-export([reject_io_reqs/1, get_levels/0, set_levels/3]). +-export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]). +-export([create_priv_dir/1]). +-export([cover/1, cover/2, cover/3, + cover_compile/7, cover_analyse/2, cross_cover_analyse/2, + trc/1, stop_trace/0]). +-export([testcase_callback/1]). +-export([set_random_seed/1]). +-export([kill_slavenodes/0]). + +%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([print/2, print/3, print/4, print_timestamp/2]). +-export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). +-export([format/1, format/2, format/3, to_string/1]). +-export([get_target_info/0]). +-export([get_hosts/0]). +-export([node_started/1]). +-export([uri_encode/1,uri_encode/2]). + +%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([i/0, p/1, p/3, pi/2, pi/4, t/0, t/1]). + +%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-export([init/1, terminate/2]). +-export([handle_call/3, handle_cast/2, handle_info/2]). +-export([do_test_cases/4]). +-export([do_spec/2, do_spec_list/2]). +-export([xhtml/2]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-include("test_server_internal.hrl"). +-include_lib("kernel/include/file.hrl"). +-define(suite_ext, "_SUITE"). +-define(log_ext, ".log.html"). +-define(src_listing_ext, ".src.html"). +-define(logdir_ext, ".logs"). +-define(data_dir_suffix, "_data/"). +-define(suitelog_name, "suite.log"). +-define(coverlog_name, "cover.html"). +-define(raw_coverlog_name, "cover.log"). +-define(cross_coverlog_name, "cross_cover.html"). +-define(raw_cross_coverlog_name, "cross_cover.log"). +-define(cross_cover_info, "cross_cover.info"). +-define(cover_total, "total_cover.log"). +-define(unexpected_io_log, "unexpected_io.log.html"). +-define(last_file, "last_name"). +-define(last_link, "last_link"). +-define(last_test, "last_test"). +-define(html_ext, ".html"). +-define(now, os:timestamp()). + +-define(void_fun, fun() -> ok end). +-define(mod_result(X), if X == skip -> skipped; + X == auto_skip -> skipped; + true -> X end). + +-define(auto_skip_color, "#FFA64D"). +-define(user_skip_color, "#FF8000"). +-define(sortable_table_name, "SortableTable"). + +-record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false, + multiply_timetraps=1, scale_timetraps=true, + create_priv_dir=auto_per_run, finish=false, + target_info, trc=false, cover=false, wait_for_node=[], + testcase_callback=undefined, idle_notify=[], + get_totals=false, random_seed=undefined}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% OPERATOR INTERFACE + +add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) -> + add_job(cast_to_list(Name), + lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job)); +add_dir(Name, Dir) -> + add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}). + +add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) -> + add_job(cast_to_list(Name), + lists:map(fun(D)-> {dir,cast_to_list(D), + cast_to_list(Pattern)} end, Job)); +add_dir(Name, Dir, Pattern) -> + add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}). + +add_module(Mod) when is_atom(Mod) -> + add_job(atom_to_list(Mod), {Mod,all}). + +add_module(Name, Mods) when is_list(Mods) -> + add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)). + +add_conf(Name, Mod, Conf) when is_tuple(Conf) -> + add_job(cast_to_list(Name), {Mod,[Conf]}); + +add_conf(Name, Mod, Confs) when is_list(Confs) -> + add_job(cast_to_list(Name), {Mod,Confs}). + +add_case(Mod, Case) when is_atom(Mod), is_atom(Case) -> + add_job(atom_to_list(Mod), {Mod,Case}). + +add_case(Name, Mod, Case) when is_atom(Mod), is_atom(Case) -> + add_job(Name, {Mod,Case}). + +add_cases(Mod, Cases) when is_atom(Mod), is_list(Cases) -> + add_job(atom_to_list(Mod), {Mod,Cases}). + +add_cases(Name, Mod, Cases) when is_atom(Mod), is_list(Cases) -> + add_job(Name, {Mod,Cases}). + +add_spec(Spec) -> + Name = filename:rootname(Spec, ".spec"), + case filelib:is_file(Spec) of + true -> add_job(Name, {spec,Spec}); + false -> {error,nofile} + end. + +%% This version of the interface is to be used if there are +%% suites or cases that should be skipped. + +add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) -> + add_job(cast_to_list(Name), + lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job), + Skip); +add_dir_with_skip(Name, Dir, Skip) -> + add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip). + +add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) -> + add_job(cast_to_list(Name), + lists:map(fun(D)-> {dir,cast_to_list(D), + cast_to_list(Pattern)} end, Job), + Skip); +add_dir_with_skip(Name, Dir, Pattern, Skip) -> + add_job(cast_to_list(Name), + {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip). + +add_module_with_skip(Mod, Skip) when is_atom(Mod) -> + add_job(atom_to_list(Mod), {Mod,all}, Skip). + +add_module_with_skip(Name, Mods, Skip) when is_list(Mods) -> + add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip). + +add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) -> + add_job(cast_to_list(Name), {Mod,[Conf]}, Skip); + +add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) -> + add_job(cast_to_list(Name), {Mod,Confs}, Skip). + +add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) -> + add_job(atom_to_list(Mod), {Mod,Case}, Skip). + +add_case_with_skip(Name, Mod, Case, Skip) when is_atom(Mod), is_atom(Case) -> + add_job(Name, {Mod,Case}, Skip). + +add_cases_with_skip(Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) -> + add_job(atom_to_list(Mod), {Mod,Cases}, Skip). + +add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) -> + add_job(Name, {Mod,Cases}, Skip). + +add_tests_with_skip(LogDir, Tests, Skip) -> + add_job(LogDir, + lists:map(fun({Dir,all,all}) -> + {Dir,{dir,Dir}}; + ({Dir,Mods,all}) -> + {Dir,lists:map(fun(M) -> {M,all} end, Mods)}; + ({Dir,Mod,Cases}) -> + {Dir,{Mod,Cases}} + end, Tests), + Skip). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% COMMAND LINE INTERFACE + +parse_cmd_line(Cmds) -> + parse_cmd_line(Cmds, [], [], local, false, false, undefined). + +parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + case file:consult(Spec) of + {ok, TermList} -> + Name = filename:rootname(Spec), + parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param, + Trc, Cov, TCCB); + {error,Reason} -> + io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]), + parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB) + end; +parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds, SpecList, [{name,atom_to_list(Name)}|Names], + Param, Trc, Cov, TCCB); +parse_cmd_line(['SKIPMOD',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds, [{skip,{Mod,"by command line"}}|SpecList], Names, + Param, Trc, Cov, TCCB); +parse_cmd_line(['SKIPCASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds, [{skip,{Mod,Case,"by command line"}}|SpecList], Names, + Param, Trc, Cov, TCCB); +parse_cmd_line(['DIR',Dir|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + Name = filename:basename(Dir), + parse_cmd_line(Cmds, [{topcase,{dir,Name}}|SpecList], [Name|Names], + Param, Trc, Cov, TCCB); +parse_cmd_line(['MODULE',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds,[{topcase,{Mod,all}}|SpecList],[atom_to_list(Mod)|Names], + Param, Trc, Cov, TCCB); +parse_cmd_line(['CASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> + parse_cmd_line(Cmds,[{topcase,{Mod,Case}}|SpecList],[atom_to_list(Mod)|Names], + Param, Trc, Cov, TCCB); +parse_cmd_line(['TRACE',Trc|Cmds], SpecList, Names, Param, _Trc, Cov, TCCB) -> + parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB); +parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov, TCCB) -> + parse_cmd_line(Cmds, SpecList, Names, Param, Trc, {{App,CF}, Analyse}, TCCB); +parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) -> + parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func}); +parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) -> + io:format("~w: Bad argument: ~w\n", [?MODULE,Obj]), + io:format(" Use the `ts' module to start tests.\n", []), + io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []), + halt(1); +parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) -> + NameList = lists:reverse(Names, ["suite"]), + Name = case lists:keysearch(name, 1, NameList) of + {value,{name,N}} -> N; + false -> hd(NameList) + end, + {lists:reverse(SpecList), Name, Param, Trc, Cov, TCCB}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% cast_to_list(X) -> string() +%% X = list() | atom() | void() +%% Returns a string representation of whatever was input + +cast_to_list(X) when is_list(X) -> X; +cast_to_list(X) when is_atom(X) -> atom_to_list(X); +cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% START INTERFACE + +%% Kept for backwards compatibility +start(_) -> + start(). +start_link(_) -> + start_link(). + + +start() -> + case gen_server:start({local,?MODULE}, ?MODULE, [], []) of + {ok, Pid} -> + {ok, Pid}; + Other -> + Other + end. + +start_link() -> + case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of + {ok, Pid} -> + {ok, Pid}; + Other -> + Other + end. + +run_test(CommandLine) -> + process_flag(trap_exit,true), + {SpecList,Name,Param,Trc,Cov,TCCB} = parse_cmd_line(CommandLine), + {ok,_TSPid} = start_link(Param), + case Trc of + false -> ok; + File -> trc(File) + end, + case Cov of + false -> ok; + {{App,CoverFile},Analyse} -> cover(App, maybe_file(CoverFile), Analyse) + end, + testcase_callback(TCCB), + add_job(Name, {command_line,SpecList}), + + wait_finish(). + +%% Converted CoverFile to a string unless it is 'none' +maybe_file(none) -> + none; +maybe_file(CoverFile) -> + atom_to_list(CoverFile). + +idle_notify(Fun) -> + {ok, Pid} = controller_call({idle_notify,Fun}), + Pid. + +start_get_totals(Fun) -> + {ok, Pid} = controller_call({start_get_totals,Fun}), + Pid. + +stop_get_totals() -> + ok = controller_call(stop_get_totals), + ok. + +wait_finish() -> + OldTrap = process_flag(trap_exit, true), + {ok, Pid} = finish(true), + link(Pid), + receive + {'EXIT',Pid,_} -> + ok + end, + process_flag(trap_exit, OldTrap), + ok. + +abort_current_testcase(Reason) -> + controller_call({abort_current_testcase,Reason}). + +abort() -> + OldTrap = process_flag(trap_exit, true), + {ok, Pid} = finish(abort), + link(Pid), + receive + {'EXIT',Pid,_} -> + ok + end, + process_flag(trap_exit, OldTrap), + ok. + +finish(Abort) -> + controller_call({finish,Abort}). + +stop() -> + controller_call(stop). + +jobs() -> + controller_call(jobs). + +get_levels() -> + controller_call(get_levels). + +set_levels(Show, Major, Minor) -> + controller_call({set_levels,Show,Major,Minor}). + +reject_io_reqs(Bool) -> + controller_call({reject_io_reqs,Bool}). + +multiply_timetraps(N) -> + controller_call({multiply_timetraps,N}). + +scale_timetraps(Bool) -> + controller_call({scale_timetraps,Bool}). + +get_timetrap_parameters() -> + controller_call(get_timetrap_parameters). + +create_priv_dir(Value) -> + controller_call({create_priv_dir,Value}). + +trc(TraceFile) -> + controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT). + +stop_trace() -> + controller_call(stop_trace). + +node_started(Node) -> + gen_server:cast(?MODULE, {node_started,Node}). + +cover(App, Analyse) when is_atom(App) -> + cover(App, none, Analyse); +cover(CoverFile, Analyse) -> + cover(none, CoverFile, Analyse). +cover(App, CoverFile, Analyse) -> + {Excl,Incl,Cross} = read_cover_file(CoverFile), + CoverInfo = #cover{app=App, + file=CoverFile, + excl=Excl, + incl=Incl, + cross=Cross, + level=Analyse}, + controller_call({cover,CoverInfo}). + +cover(CoverInfo) -> + controller_call({cover,CoverInfo}). + +cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) -> + cover_compile(#cover{app=App, + file=File, + excl=Excl, + incl=Incl, + cross=Cross, + level=Analyse, + stop=Stop}). + +testcase_callback(ModFunc) -> + controller_call({testcase_callback,ModFunc}). + +set_random_seed(Seed) -> + controller_call({set_random_seed,Seed}). + +kill_slavenodes() -> + controller_call(kill_slavenodes). + +get_hosts() -> + get(test_server_hosts). + +%%-------------------------------------------------------------------- + +add_job(Name, TopCase) -> + add_job(Name, TopCase, []). + +add_job(Name, TopCase, Skip) -> + SuiteName = + case Name of + "." -> "current_dir"; + ".." -> "parent_dir"; + Other -> Other + end, + Dir = filename:absname(SuiteName), + controller_call({add_job,Dir,SuiteName,TopCase,Skip}). + +controller_call(Arg) -> + case catch gen_server:call(?MODULE, Arg, infinity) of + {'EXIT',{{badarg,_},{gen_server,call,_}}} -> + exit(test_server_ctrl_not_running); + {'EXIT',Reason} -> + exit(Reason); + Other -> + Other + end. +controller_call(Arg, Timeout) -> + case catch gen_server:call(?MODULE, Arg, Timeout) of + {'EXIT',{{badarg,_},{gen_server,call,_}}} -> + exit(test_server_ctrl_not_running); + {'EXIT',Reason} -> + exit(Reason); + Other -> + Other + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% init([]) +%% +%% init() is the init function of the test_server's gen_server. +%% +init([]) -> + case os:getenv("TEST_SERVER_CALL_TRACE") of + false -> + ok; + "" -> + ok; + TraceSpec -> + test_server_sup:call_trace(TraceSpec) + end, + process_flag(trap_exit, true), + %% copy format_exception setting from init arg to application environment + case init:get_argument(test_server_format_exception) of + {ok,[[TSFE]]} -> + application:set_env(test_server, format_exception, list_to_atom(TSFE)); + _ -> + ok + end, + test_server_sup:cleanup_crash_dumps(), + test_server_sup:util_start(), + State = #state{jobs=[],finish=false}, + TI0 = test_server:init_target_info(), + TargetHost = test_server_sup:hoststr(), + TI = TI0#target_info{host=TargetHost, + naming=naming(), + master=TargetHost}, + ets:new(slave_tab, [named_table,set,public,{keypos,2}]), + set_hosts([TI#target_info.host]), + {ok,State#state{target_info=TI}}. + +naming() -> + case lists:member($., test_server_sup:hoststr()) of + true -> "-name"; + false -> "-sname" + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(kill_slavenodes, From, State) -> ok +%% +%% Kill all slave nodes that remain after a test case +%% is completed. +%% +handle_call(kill_slavenodes, _From, State) -> + Nodes = test_server_node:kill_nodes(), + {reply, Nodes, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({set_hosts, HostList}, From, State) -> ok +%% +%% Set the global hostlist. +%% +handle_call({set_hosts, Hosts}, _From, State) -> + set_hosts(Hosts), + {reply, ok, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(get_hosts, From, State) -> [Hosts] +%% +%% Returns the lists of hosts that the test server +%% can use for slave nodes. This is primarily used +%% for nodename generation. +%% +handle_call(get_hosts, _From, State) -> + Hosts = get_hosts(), + {reply, Hosts, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) -> +%% ok | {error,Reason} +%% +%% Dir = string() +%% Name = string() +%% TopCase = term() +%% Skip = [SkipItem] +%% SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment} +%% Mod = Case = atom() +%% Comment = string() +%% Cases = [Case] +%% +%% Adds a job to the job queue. The name of the job is Name. A log directory +%% will be created in Dir/Name.logs. TopCase may be anything that +%% collect_cases/3 accepts, plus the following: +%% +%% {spec,SpecName} executes the named test suite specification file. Commands +%% in the file should be in the format accepted by do_spec_list/1. +%% +%% {command_line,SpecList} executes the list of specification instructions +%% supplied, which should be in the format accepted by do_spec_list/1. + +handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> + LogDir = Dir ++ ?logdir_ext, + ExtraTools = + case State#state.cover of + false -> []; + CoverInfo -> [{cover,CoverInfo}] + end, + ExtraTools1 = + case State#state.random_seed of + undefined -> ExtraTools; + Seed -> [{random_seed,Seed}|ExtraTools] + end, + case lists:keysearch(Name, 1, State#state.jobs) of + false -> + case TopCase of + {spec,SpecName} -> + Pid = spawn_tester( + ?MODULE, do_spec, + [SpecName,{State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, + State#state.testcase_callback, ExtraTools1), + NewJobs = [{Name,Pid}|State#state.jobs], + {reply, ok, State#state{jobs=NewJobs}}; + {command_line,SpecList} -> + Pid = spawn_tester( + ?MODULE, do_spec_list, + [SpecList,{State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, + State#state.testcase_callback, ExtraTools1), + NewJobs = [{Name,Pid}|State#state.jobs], + {reply, ok, State#state{jobs=NewJobs}}; + TopCase -> + case State#state.get_totals of + {CliPid,Fun} -> + Result = count_test_cases(TopCase, Skip), + Fun(CliPid, Result), + {reply, ok, State}; + _ -> + Cfg = make_config([]), + Pid = spawn_tester( + ?MODULE, do_test_cases, + [TopCase,Skip,Cfg, + {State#state.multiply_timetraps, + State#state.scale_timetraps}], + LogDir, Name, State#state.levels, + State#state.reject_io_reqs, + State#state.create_priv_dir, + State#state.testcase_callback, ExtraTools1), + NewJobs = [{Name,Pid}|State#state.jobs], + {reply, ok, State#state{jobs=NewJobs}} + end + end; + _ -> + {reply,{error,name_already_in_use},State} + end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(jobs, _, State) -> JobList +%% JobList = [{Name,Pid}, ...] +%% Name = string() +%% Pid = pid() +%% +%% Return the list of current jobs. + +handle_call(jobs, _From, State) -> + {reply,State#state.jobs,State}; + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({abort_current_testcase,Reason}, _, State) -> Result +%% Reason = term() +%% Result = ok | {error,no_testcase_running} +%% +%% Attempts to abort the test case that's currently running. + +handle_call({abort_current_testcase,Reason}, _From, State) -> + case State#state.jobs of + [{_,Pid}|_] -> + Pid ! {abort_current_testcase,Reason,self()}, + receive + {Pid,abort_current_testcase,Result} -> + {reply, Result, State} + after 10000 -> + {reply, {error,no_testcase_running}, State} + end; + _ -> + {reply, {error,no_testcase_running}, State} + end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({finish,Fini}, _, State) -> {ok,Pid} +%% Fini = true | abort +%% +%% Tells the test_server to stop as soon as there are no test suites +%% running. Immediately if none are running. Abort is handled as soon +%% as current test finishes. + +handle_call({finish,Fini}, _From, State) -> + case State#state.jobs of + [] -> + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end, + State#state.idle_notify), + State2 = State#state{finish=false}, + {stop,shutdown,{ok,self()}, State2}; + _SomeJobs -> + State2 = State#state{finish=Fini}, + {reply, {ok,self()}, State2} + end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({idle_notify,Fun}, From, State) -> {ok,Pid} +%% +%% Lets a test client subscribe to receive a notification when the +%% test server becomes idle (can be used to syncronize jobs). +%% test_server calls Fun(From) when idle. + +handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> + case State#state.jobs of + [] -> self() ! report_idle; + _ -> ok + end, + Subscribed = State#state.idle_notify, + {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(start_get_totals, From, State) -> {ok,Pid} +%% +%% Switch on the mode where the test server will only +%% report back the number of tests it would execute +%% given some subsequent jobs. + +handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) -> + {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(stop_get_totals, From, State) -> ok +%% +%% Lets a test client subscribe to receive a notification when the +%% test server becomes idle (can be used to syncronize jobs). +%% test_server calls Fun(From) when idle. + +handle_call(stop_get_totals, {_Cli,_Ref}, State) -> + {reply, ok, State#state{get_totals=false}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(get_levels, _, State) -> {Show,Major,Minor} +%% Show = integer() +%% Major = integer() +%% Minor = integer() +%% +%% Returns a 3-tuple with the logging thresholds. +%% All output and information from a test suite is tagged with a detail +%% level. Lower values are more "important". Text that is output using +%% io:format or similar is automatically tagged with detail level 50. +%% +%% All output with detail level: +%% less or equal to Show is displayed on the screen (default 1) +%% less or equal to Major is logged in the major log file (default 19) +%% greater or equal to Minor is logged in the minor log files (default 10) + +handle_call(get_levels, _From, State) -> + {reply,State#state.levels,State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({set_levels,Show,Major,Minor}, _, State) -> ok +%% Show = integer() +%% Major = integer() +%% Minor = integer() +%% +%% Sets the logging thresholds, see handle_call(get_levels,...) above. + +handle_call({set_levels,Show,Major,Minor}, _From, State) -> + {reply,ok,State#state{levels={Show,Major,Minor}}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({reject_io_reqs,Bool}, _, State) -> ok +%% Bool = bool() +%% +%% May be used to switch off stdout printouts to the minor log file + +handle_call({reject_io_reqs,Bool}, _From, State) -> + {reply,ok,State#state{reject_io_reqs=Bool}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({multiply_timetraps,N}, _, State) -> ok +%% N = integer() | infinity +%% +%% Multiplies all timetraps set by test cases with N + +handle_call({multiply_timetraps,N}, _From, State) -> + {reply,ok,State#state{multiply_timetraps=N}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({scale_timetraps,Bool}, _, State) -> ok +%% Bool = true | false +%% +%% Specifies if test_server should scale the timetrap value +%% automatically if e.g. cover is running. + +handle_call({scale_timetraps,Bool}, _From, State) -> + {reply,ok,State#state{scale_timetraps=Bool}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale} +%% Multiplier = integer() | infinity +%% Scale = true | false +%% +%% Returns the parameter values that affect timetraps. + +handle_call(get_timetrap_parameters, _From, State) -> + {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason} +%% +%% Starts a separate node (trace control node) which +%% starts tracing on target and all slave nodes +%% +%% TraceFile is a text file with elements of type +%% {Trace,Mod,TracePattern}. +%% {Trace,Mod,Func,TracePattern}. +%% {Trace,Mod,Func,Arity,TracePattern}. +%% +%% Trace = tp | tpl; local or global call trace +%% Mod,Func = atom(), Arity=integer(); defines what to trace +%% TracePattern = [] | match_spec() +%% +%% The 'call' trace flag is set on all processes, and then +%% the given trace patterns are set. + +handle_call({trace,TraceFile}, _From, State=#state{trc=false}) -> + TI = State#state.target_info, + case test_server_node:start_tracer_node(TraceFile, TI) of + {ok,Tracer} -> {reply,ok,State#state{trc=Tracer}}; + Error -> {reply,Error,State} + end; +handle_call({trace,_TraceFile}, _From, State) -> + {reply,{error,already_tracing},State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(stop_trace, _, State) -> ok | {error,Reason} +%% +%% Stops tracing on target and all slave nodes and +%% terminates trace control node + +handle_call(stop_trace, _From, State=#state{trc=false}) -> + {reply,{error,not_tracing},State}; +handle_call(stop_trace, _From, State) -> + R = test_server_node:stop_tracer_node(State#state.trc), + {reply,R,State#state{trc=false}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason} +%% +%% Set specification of cover analysis to be used when running tests +%% (see start_extra_tools/1 and stop_extra_tools/1) + +handle_call({cover,CoverInfo}, _From, State) -> + {reply,ok,State#state{cover=CoverInfo}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason} +%% +%% Set create_priv_dir to either auto_per_run (create common priv dir once +%% per test run), manual_per_tc (the priv dir name will be unique for each +%% test case, but the user has to call test_server:make_priv_dir/0 to create +%% it), or auto_per_tc (unique priv dir created automatically for each test +%% case). + +handle_call({create_priv_dir,Value}, _From, State) -> + {reply,ok,State#state{create_priv_dir=Value}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason} +%% +%% Add a callback function that will be called before and after every +%% test case (on the test case process): +%% +%% Mod:Func(Suite,TestCase,InitOrEnd,Config) +%% +%% InitOrEnd = init | 'end'. + +handle_call({testcase_callback,ModFunc}, _From, State) -> + case ModFunc of + {Mod,Func} -> + case code:is_loaded(Mod) of + {file,_} -> + ok; + false -> + code:load_file(Mod) + end, + case erlang:function_exported(Mod,Func,4) of + true -> + ok; + false -> + io:format(user, + "WARNING! Callback function ~w:~w/4 undefined.~n~n", + [Mod,Func]) + end; + _ -> + ok + end, + {reply,ok,State#state{testcase_callback=ModFunc}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({set_random_seed,Seed}, _, State) -> ok | {error,Reason} +%% +%% Let operator set a random seed value to be used e.g. for shuffling +%% test cases. + +handle_call({set_random_seed,Seed}, _From, State) -> + {reply,ok,State#state{random_seed=Seed}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(stop, _, State) -> ok +%% +%% Stops the test server immediately. +%% Some cleanup is done by terminate/2 + +handle_call(stop, _From, State) -> + {stop, shutdown, ok, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call(get_target_info, _, State) -> TI +%% +%% TI = #target_info{} +%% +%% Returns information about target + +handle_call(get_target_info, _From, State) -> + {reply, State#state.target_info, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({start_node,Name,Type,Options}, _, State) -> +%% ok | {error,Reason} +%% +%% Starts a new node (slave or peer) + +handle_call({start_node, Name, Type, Options}, From, State) -> + %% test_server_ctrl does gen_server:reply/2 explicitly + test_server_node:start_node(Name, Type, Options, From, + State#state.target_info), + {noreply,State}; + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({wait_for_node,Node}, _, State) -> ok +%% +%% Waits for a new node to take contact. Used if +%% node is started with option {wait,false} + +handle_call({wait_for_node, Node}, From, State) -> + NewWaitList = + case ets:lookup(slave_tab,Node) of + [] -> + [{Node,From}|State#state.wait_for_node]; + _ -> + gen_server:reply(From,ok), + State#state.wait_for_node + end, + {noreply,State#state{wait_for_node=NewWaitList}}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({stop_node,Name}, _, State) -> ok | {error,Reason} +%% +%% Stops a slave or peer node. This is actually only some cleanup +%% - the node is really stopped by test_server when this returns. + +handle_call({stop_node, Name}, _From, State) -> + R = test_server_node:stop_node(Name), + {reply, R, State}; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_call({is_release_available,Name}, _, State) -> ok | {error,Reason} +%% +%% Tests if the release is available. + +handle_call({is_release_available, Release}, _From, State) -> + R = test_server_node:is_release_available(Release), + {reply, R, State}. + +%%-------------------------------------------------------------------- +set_hosts(Hosts) -> + put(test_server_hosts, Hosts). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_cast({node_started,Name}, _, State) +%% +%% Called by test_server_node when a slave/peer node is fully started. + +handle_cast({node_started,Node}, State) -> + case State#state.trc of + false -> ok; + Trc -> test_server_node:trace_nodes(Trc, [Node]) + end, + NewWaitList = + case lists:keysearch(Node,1,State#state.wait_for_node) of + {value,{Node,From}} -> + gen_server:reply(From, ok), + lists:keydelete(Node, 1, State#state.wait_for_node); + false -> + State#state.wait_for_node + end, + {noreply, State#state{wait_for_node=NewWaitList}}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_info({'EXIT',Pid,Reason}, State) +%% Pid = pid() +%% Reason = term() +%% +%% Handles exit messages from linked processes. Only test suites are +%% expected to be linked. When a test suite terminates, it is removed +%% from the job queue. + +handle_info(report_idle, State) -> + Finish = State#state.finish, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State#state.idle_notify), + {noreply,State#state{idle_notify=[]}}; + + +handle_info({'EXIT',Pid,Reason}, State) -> + case lists:keysearch(Pid,2,State#state.jobs) of + false -> + %% not our problem + {noreply,State}; + {value,{Name,_}} -> + NewJobs = lists:keydelete(Pid, 2, State#state.jobs), + case Reason of + normal -> + fine; + killed -> + io:format("Suite ~ts was killed\n", [Name]); + _Other -> + io:format("Suite ~ts was killed with reason ~p\n", + [Name,Reason]) + end, + State2 = State#state{jobs=NewJobs}, + Finish = State2#state.finish, + case NewJobs of + [] -> + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State2#state.idle_notify), + case Finish of + false -> + {noreply,State2#state{idle_notify=[]}}; + _ -> % true | abort + %% test_server:finish() has been called and + %% there are no jobs in the job queue => + %% stop the test_server_ctrl + {stop,shutdown,State2#state{finish=false}} + end; + _ -> % pending jobs + case Finish of + abort -> % abort test now! + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State2#state.idle_notify), + {stop,shutdown,State2#state{finish=false}}; + _ -> % true | false + {noreply, State2} + end + end + end; + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_info({tcp_closed,Sock}, State) +%% +%% A Socket was closed. This indicates that a node died. +%% This can be +%% *Slave or peer node started by a test suite +%% *Trace controll node + +handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) -> + %% Tracer node died - can't really do anything + %%! Maybe print something??? + {noreply,State#state{trc=false}}; +handle_info({tcp_closed,Sock}, State) -> + test_server_node:nodedown(Sock), + {noreply,State}; +handle_info(_, State) -> + %% dummy; accept all, do nothing. + {noreply, State}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% terminate(Reason, State) -> ok +%% Reason = term() +%% +%% Cleans up when the test_server is terminating. Kills the running +%% test suites (if any) and any possible remainting slave node + +terminate(_Reason, State) -> + test_server_sup:util_stop(), + case State#state.trc of + false -> ok; + Sock -> test_server_node:stop_tracer_node(Sock) + end, + kill_all_jobs(State#state.jobs), + test_server_node:kill_nodes(), + ok. + +kill_all_jobs([{_Name,JobPid}|Jobs]) -> + exit(JobPid, kill), + kill_all_jobs(Jobs); +kill_all_jobs([]) -> + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%----------------------- INTERNAL FUNCTIONS -----------------------%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, +%% CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid +%% Mod = atom() +%% Func = atom() +%% Args = [term(),...] +%% Dir = string() +%% Name = string() +%% Levels = {integer(),integer(),integer()} +%% RejectIoReqs = bool() +%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc +%% TestCaseCallback = {CBMod,CBFunc} | undefined +%% ExtraTools = [ExtraTool,...] +%% ExtraTool = CoverInfo | TraceInfo | RandomSeed +%% +%% Spawns a test suite execute-process, just an ordinary spawn, except +%% that it will set a lot of dictionary information before starting the +%% named function. Also, the execution is timed and protected by a catch. +%% When the named function is done executing, a summary of the results +%% is printed to the log files. + +spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, + CreatePrivDir, TCCallback, ExtraTools) -> + spawn_link(fun() -> + init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, + CreatePrivDir, TCCallback, ExtraTools) + end). + +init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, + RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) -> + process_flag(trap_exit, true), + test_server_io:start_link(), + put(test_server_name, Name), + put(test_server_dir, Dir), + put(test_server_total_time, 0), + put(test_server_ok, 0), + put(test_server_failed, 0), + put(test_server_skipped, {0,0}), + put(test_server_minor_level, MinLev), + put(test_server_create_priv_dir, CreatePrivDir), + put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)), + put(test_server_testcase_callback, TCCallback), + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW =:= false; FW =:= "undefined" -> + put(test_server_framework, '$none'); + FW -> + put(test_server_framework_name, list_to_atom(FW)), + case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of + FWName when FWName =:= false; FWName =:= "undefined" -> + put(test_server_framework_name, '$none'); + FWName -> + put(test_server_framework_name, list_to_atom(FWName)) + end + end, + + %% before first print, read and set logging options + LogOpts = test_server_sup:framework_call(get_logopts, [], []), + put(test_server_logopts, LogOpts), + + StartedExtraTools = start_extra_tools(ExtraTools), + + test_server_io:set_job_name(Name), + test_server_io:set_gl_props([{levels,Levels}, + {auto_nl,not lists:member(no_nl, LogOpts)}, + {reject_io_reqs,RejectIoReqs}]), + group_leader(test_server_io:get_gl(true), self()), + {TimeMy,Result} = ts_tc(Mod, Func, Args), + set_io_buffering(undefined), + test_server_io:set_job_name(undefined), + catch stop_extra_tools(StartedExtraTools), + case Result of + {'EXIT',test_suites_done} -> + ok; + {'EXIT',_Pid,Reason} -> + print(1, "EXIT, reason ~p", [Reason]); + {'EXIT',Reason} -> + report_severe_error(Reason), + print(1, "EXIT, reason ~p", [Reason]) + end, + Time = TimeMy/1000000, + SuccessStr = + case get(test_server_failed) of + 0 -> "Ok"; + _ -> "FAILED" + end, + {SkippedN,SkipStr} = + case get(test_server_skipped) of + {0,0} -> + {0,""}; + {USkipped,ASkipped} -> + Skipped = USkipped+ASkipped, + {Skipped,io_lib:format(", ~w Skipped", [Skipped])} + end, + OkN = get(test_server_ok), + FailedN = get(test_server_failed), + print(html,"\n\n\n" + "TOTAL" + "~.3fs~ts~w Ok, ~w Failed~ts of ~w\n" + "\n", + [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]), + + test_server_io:stop([major,html,unexpected_io]), + {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer), + {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]), + io:put_chars(UnexpectedIoFd, "\n\n"++UnexpectedIoFooter), + file:close(UnexpectedIoFd), + ok. + +report_severe_error(Reason) -> + test_server_sup:framework_call(report, [severe_error,Reason]). + +ts_tc(M,F,A) -> + Before = erlang:monotonic_time(), + Result = (catch apply(M, F, A)), + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, + native, + micro_seconds), + {Elapsed, Result}. + +start_extra_tools(ExtraTools) -> + start_extra_tools(ExtraTools, []). +start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) -> + case start_cover(CoverInfo) of + {ok,NewCoverInfo} -> + start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]); + {error,_} -> + start_extra_tools(ExtraTools, Started) + end; +start_extra_tools([_ | ExtraTools], Started) -> + start_extra_tools(ExtraTools, Started); +start_extra_tools([], Started) -> + Started. + +stop_extra_tools(ExtraTools) -> + TestDir = get(test_server_log_dir_base), + case lists:keymember(cover, 1, ExtraTools) of + false -> + write_default_coverlog(TestDir); + true -> + ok + end, + stop_extra_tools(ExtraTools, TestDir). + +stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) -> + stop_cover(CoverInfo,TestDir), + stop_extra_tools(ExtraTools, TestDir); +%%stop_extra_tools([_ | ExtraTools], TestDir) -> +%% stop_extra_tools(ExtraTools, TestDir); +stop_extra_tools([], _) -> + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result) +%% SpecName = string() +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} +%% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() +%% +%% Reads the named test suite specification file, and executes it. +%% +%% This function is meant to be called by a process created by +%% spawn_tester/10, which sets up some necessary dictionary values. + +do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> + case file:consult(SpecName) of + {ok,TermList} -> + do_spec_list(TermList,TimetrapSpec); + {error,Reason} -> + io:format("Can't open ~ts: ~p\n", [SpecName,Reason]), + {error,{cant_open_spec,Reason}} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_spec_list(TermList, TimetrapSpec) -> exit(Result) +%% TermList = [term()|...] +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} +%% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() +%% +%% Executes a list of test suite specification commands. The following +%% commands are available, and may occur zero or more times (if several, +%% the contents is appended): +%% +%% {topcase,TopCase} Specifies top level test goals. TopCase has the syntax +%% specified by collect_cases/3. +%% +%% {skip,Skip} Specifies test cases to skip, and lists requirements that +%% cannot be granted during the test run. Skip has the syntax specified +%% by collect_cases/3. +%% +%% {nodes,Nodes} Lists node names avaliable to the test suites. Nodes have +%% the syntax specified by collect_cases/3. +%% +%% {require_nodenames, Num} Specifies how many nodenames the test suite will +%% need. Theese are automaticly generated and inserted into the Config by the +%% test_server. The caller may specify other hosts to run theese nodes by +%% using the {hosts, Hosts} option. If there are no hosts specified, all +%% nodenames will be generated from the local host. +%% +%% {hosts, Hosts} Specifies a list of available hosts on which to start +%% slave nodes. It is used when the {remote, true} option is given to the +%% test_server:start_node/3 function. Also, if {require_nodenames, Num} is +%% contained in the TermList, the generated nodenames will be spread over +%% all hosts given in this Hosts list. The hostnames are given as atoms or +%% strings. +%% +%% {diskless, true} is kept for backwards compatiblilty and +%% should not be used. Use a configuration test case instead. +%% +%% This function is meant to be called by a process created by +%% spawn_tester/10, which sets up some necessary dictionary values. + +do_spec_list(TermList0, TimetrapSpec) -> + Nodes = [], + TermList = + case lists:keysearch(hosts, 1, TermList0) of + {value, {hosts, Hosts0}} -> + Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0), + controller_call({set_hosts, Hosts}), + lists:keydelete(hosts, 1, TermList0); + _ -> + TermList0 + end, + DefaultConfig = make_config([{nodes,Nodes}]), + {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig), + do_test_cases(TopCases, SkipList, Config, TimetrapSpec). + +do_spec_terms([], TopCases, SkipList, Config) -> + {TopCases,SkipList,Config}; +do_spec_terms([{topcase,TopCase}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms,[TopCase|TopCases], SkipList, Config); +do_spec_terms([{skip,Skip}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms, TopCases, [Skip|SkipList], Config); +do_spec_terms([{nodes,Nodes}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms, TopCases, SkipList, + update_config(Config, {nodes,Nodes})); +do_spec_terms([{diskless,How}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms, TopCases, SkipList, + update_config(Config, {diskless,How})); +do_spec_terms([{config,MoreConfig}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms, TopCases, SkipList, Config++MoreConfig); +do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) -> + do_spec_terms(Terms, TopCases, SkipList, + update_config(Config, {default_timeout,Tmo})); + +do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) -> + NodeNames0=generate_nodenames(NumNames), + NodeNames=lists:delete([], NodeNames0), + do_spec_terms(Terms, TopCases, SkipList, + update_config(Config, {nodenames,NodeNames})); +do_spec_terms([Other|Terms], TopCases, SkipList, Config) -> + io:format("** WARNING: Spec file contains unknown directive ~p\n", + [Other]), + do_spec_terms(Terms, TopCases, SkipList, Config). + + + +generate_nodenames(Num) -> + Hosts = case controller_call(get_hosts) of + [] -> + TI = controller_call(get_target_info), + [TI#target_info.host]; + List -> + List + end, + generate_nodenames2(Num, Hosts, []). + +generate_nodenames2(0, _Hosts, Acc) -> + Acc; +generate_nodenames2(N, Hosts, Acc) -> + Host=lists:nth((N rem (length(Hosts)))+1, Hosts), + Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), + generate_nodenames2(N-1, Hosts, [Name|Acc]). + +temp_nodename([], Acc) -> + lists:flatten(Acc); +temp_nodename([Chr|Base], Acc) -> + {A,B,C} = ?now, + New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], + temp_nodename(Base, [New|Acc]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% count_test_cases(TopCases, SkipCases) -> {Suites,NoOfCases} | error +%% TopCases = term() (See collect_cases/3) +%% SkipCases = term() (See collect_cases/3) +%% Suites = list() +%% NoOfCases = integer() | unknown +%% +%% Counts the test cases that are about to run and returns that number. +%% If there's a conf group in TestSpec with a repeat property, the total number +%% of cases can not be calculated and NoOfCases = unknown. +count_test_cases(TopCases, SkipCases) when is_list(TopCases) -> + case collect_all_cases(TopCases, SkipCases) of + {error,_Why} = Error -> + Error; + TestSpec -> + {get_suites(TestSpec, []), + case remove_conf(TestSpec) of + {repeats,_} -> + unknown; + TestSpec1 -> + length(TestSpec1) + end} + end; + +count_test_cases(TopCase, SkipCases) -> + count_test_cases([TopCase], SkipCases). + + +remove_conf(Cases) -> + remove_conf(Cases, [], false). + +remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) -> + case get_repeat(Props) of + undefined -> + remove_conf(Cases, NoConf, Repeats); + {_RepType,1} -> + remove_conf(Cases, NoConf, Repeats); + _ -> + remove_conf(Cases, NoConf, true) + end; +remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) -> + remove_conf(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; + Type==make -> + remove_conf(Cases, NoConf, Repeats); +remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt},_Mode}|Cases], + NoConf, Repeats) when Type==conf; + Type==make -> + remove_conf(Cases, NoConf, Repeats); +remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) -> + FwMod = get_fw_mod(?MODULE), + if Mod == FwMod -> + remove_conf(Cases, NoConf, Repeats); + true -> + remove_conf(Cases, [C|NoConf], Repeats) + end; +remove_conf([C|Cases], NoConf, Repeats) -> + remove_conf(Cases, [C|NoConf], Repeats); +remove_conf([], NoConf, true) -> + {repeats,lists:reverse(NoConf)}; +remove_conf([], NoConf, false) -> + lists:reverse(NoConf). + +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) + end; +get_suites([{Mod,_Case}|Tests], Mods) when is_atom(Mod) -> + case add_mod(Mod, Mods) of + true -> get_suites(Tests, [Mod|Mods]); + false -> get_suites(Tests, Mods) + end; +get_suites([{Mod,_Func,_Args}|Tests], Mods) when is_atom(Mod) -> + case add_mod(Mod, Mods) of + true -> get_suites(Tests, [Mod|Mods]); + false -> get_suites(Tests, Mods) + end; +get_suites([_|Tests], Mods) -> + get_suites(Tests, Mods); + +get_suites([], Mods) -> + lists:reverse(Mods). + +add_mod(Mod, Mods) -> + case string:rstr(atom_to_list(Mod), "_SUITE") of + 0 -> false; + _ -> % test suite + case lists:member(Mod, Mods) of + true -> false; + false -> true + end + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) -> +%% exit(Result) +%% +%% TopCases = term() (See collect_cases/3) +%% SkipCases = term() (See collect_cases/3) +%% Config = term() (See collect_cases/3) +%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} +%% MultiplyTimetrap = integer() | infinity +%% ScaleTimetrap = bool() +%% +%% Initializes and starts the test run, for "ordinary" test suites. +%% Creates log directories and log files, inserts initial timestamps and +%% configuration information into the log files. +%% +%% This function is meant to be called by a process created by +%% spawn_tester/10, which sets up some necessary dictionary values. +do_test_cases(TopCases, SkipCases, + Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap); + MultiplyTimetrap == infinity -> + do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true}); + +do_test_cases(TopCases, SkipCases, + Config, TimetrapData) when is_list(TopCases), + is_tuple(TimetrapData) -> + {ok,TestDir} = start_log_file(), + FwMod = get_fw_mod(?MODULE), + case collect_all_cases(TopCases, SkipCases) of + {error,Why} -> + print(1, "Error starting: ~p", [Why]), + exit(test_suites_done); + TestSpec0 -> + N = case remove_conf(TestSpec0) of + {repeats,_} -> unknown; + TS -> length(TS) + end, + put(test_server_cases, N), + put(test_server_case_num, 0), + + TestSpec = + add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod), + + TI = get_target_info(), + print(1, "Starting test~ts", + [print_if_known(N, {", ~w test cases",[N]}, + {" (with repeated test cases)",[]})]), + Test = get(test_server_name), + TestName = if is_list(Test) -> + lists:flatten(io_lib:format("~ts", [Test])); + true -> + lists:flatten(io_lib:format("~tp", [Test])) + end, + TestDescr = "Test " ++ TestName ++ " results", + + test_server_sup:framework_call(report, [tests_start,{Test,N}]), + + {Header,Footer} = + case test_server_sup:framework_call(get_html_wrapper, + [TestDescr,true,TestDir, + {[],[2,3,4,7,8],[1,6]}], "") of + Empty when (Empty == "") ; (element(2,Empty) == "") -> + put(basic_html, true), + {[html_header(TestDescr), + "

Results for test ", TestName, "

\n"], + "\n\n\n"}; + {basic_html,Html0,Html1} -> + put(basic_html, true), + {Html0++["

Results for ",TestName,"

\n"], + Html1}; + {xhtml,Html0,Html1} -> + put(basic_html, false), + {Html0++["

Results for ",TestName,"

\n"], + Html1} + end, + + print(html, Header), + + print(html, xhtml("

", "

")), + print_timestamp(html, "Test started at "), + print(html, xhtml("

", "

")), + + print(html, xhtml("\n

Host info:
\n", + "\n

Host info:
\n")), + print_who(test_server_sup:hoststr(), test_server_sup:get_username()), + print(html, xhtml("
Used Erlang v~ts in ~ts

\n", + "
Used Erlang v~ts in \"~ts\"

\n"), + [erlang:system_info(version), code:root_dir()]), + + if FwMod == ?MODULE -> + print(html, xhtml("\n

Target Info:
\n", + "\n

Target Info:
\n")), + print_who(TI#target_info.host, TI#target_info.username), + print(html,xhtml("
Used Erlang v~ts in ~ts

\n", + "
Used Erlang v~ts in \"~ts\"

\n"), + [TI#target_info.version, TI#target_info.root_dir]); + true -> + case test_server_sup:framework_call(target_info, []) of + TargetInfo when is_list(TargetInfo), + length(TargetInfo) > 0 -> + print(html, xhtml("\n

Target info:
\n", + "\n

Target info:
\n")), + print(html, "~ts

\n", [TargetInfo]); + _ -> + ok + end + end, + CoverLog = + case get(test_server_cover_log_dir) of + undefined -> + ?coverlog_name; + AbsLogDir -> + AbsLog = filename:join(AbsLogDir,?coverlog_name), + make_relative(AbsLog, TestDir) + end, + print(html, + "

\n", + [?suitelog_name,CoverLog,?unexpected_io_log]), + print(html, + "

~ts

\n" ++ + xhtml(["\n", + "\n"], + ["
\n", + "\n"]) ++ + "" ++ + "" ++ + "\n\n\n", + [print_if_known(N, {"Executing ~w test cases..." + ++ xhtml("\n
\n", "\n
\n"),[N]}, + {"",[]})]), + + print(major, "=cases ~w", [get(test_server_cases)]), + print(major, "=user ~ts", [TI#target_info.username]), + print(major, "=host ~ts", [TI#target_info.host]), + + %% If there are no hosts specified,use only the local host + case controller_call(get_hosts) of + [] -> + print(major, "=hosts ~ts", [TI#target_info.host]), + controller_call({set_hosts, [TI#target_info.host]}); + Hosts -> + Str = lists:flatten(lists:map(fun(X) -> [X," "] end, Hosts)), + print(major, "=hosts ~ts", [Str]) + end, + print(major, "=emulator_vsn ~ts", [TI#target_info.version]), + print(major, "=emulator ~ts", [TI#target_info.emulator]), + print(major, "=otp_release ~ts", [TI#target_info.otp_release]), + print(major, "=started ~s", + [lists:flatten(timestamp_get(""))]), + + test_server_io:set_footer(Footer), + + run_test_cases(TestSpec, Config, TimetrapData) + end; + +do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) -> + %% when not list(TopCase) + do_test_cases([TopCase], SkipCases, Config, TimetrapSpec). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% start_log_file() -> {ok,TestDirName} | exit({Error,Reason}) +%% Stem = string() +%% +%% Creates the log directories, the major log file and the html log file. +%% The log files are initialized with some header information. +%% +%% The name of the log directory will be .logs/run./ where +%% Name is the test suite name and Date is the current date and time. + +start_log_file() -> + Dir = get(test_server_dir), + case file:make_dir(Dir) of + ok -> + ok; + {error, eexist} -> + ok; + MkDirError -> + log_file_error(MkDirError, Dir) + end, + TestDir = timestamp_filename_get(filename:join(Dir, "run.")), + TestDir1 = + case file:make_dir(TestDir) of + ok -> + TestDir; + {error,eexist} -> + timer:sleep(1000), + %% we need min 1 second between timestamps unfortunately + TestDirX = timestamp_filename_get(filename:join(Dir, "run.")), + case file:make_dir(TestDirX) of + ok -> + TestDirX; + MkDirError2 -> + log_file_error(MkDirError2, TestDirX) + end; + MkDirError2 -> + log_file_error(MkDirError2, TestDir) + end, + FilenameMode = file:native_name_encoding(), + ok = write_file(filename:join(Dir, ?last_file), + TestDir1 ++ "\n", + FilenameMode), + ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode), + put(test_server_log_dir_base,TestDir1), + + MajorName = filename:join(TestDir1, ?suitelog_name), + HtmlName = MajorName ++ ?html_ext, + UnexpectedName = filename:join(TestDir1, ?unexpected_io_log), + + {ok,Major} = open_utf8_file(MajorName), + {ok,Html} = open_html_file(HtmlName), + + {UnexpHeader,UnexpFooter} = + case test_server_sup:framework_call(get_html_wrapper, + ["Unexpected I/O log",false, + TestDir, undefined],"") of + UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "") -> + {html_header("Unexpected I/O log"),"\n\n\n"}; + {basic_html,UH,UF} -> + {UH,UF}; + {xhtml,UH,UF} -> + {UH,UF} + end, + + {ok,Unexpected} = open_html_file(UnexpectedName), + io:put_chars(Unexpected, [UnexpHeader, + xhtml("
\n

Unexpected I/O

", + "
\n

Unexpected I/O

"), + "\n
\n"]),
+    put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}),
+
+    test_server_io:set_fd(major, Major),
+    test_server_io:set_fd(html, Html),
+    test_server_io:set_fd(unexpected_io, Unexpected),
+
+    make_html_link(filename:absname(?last_test ++ ?html_ext),
+		   HtmlName, filename:basename(Dir)),
+    LinkName = filename:join(Dir, ?last_link),
+    make_html_link(LinkName ++ ?html_ext, HtmlName,
+		   filename:basename(Dir)),
+
+    PrivDir = filename:join(TestDir1, ?priv_dir),
+    ok = file:make_dir(PrivDir),
+    put(test_server_priv_dir,PrivDir++"/"),
+    print_timestamp(major, "Suite started at "),
+
+    LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
+    test_server_sup:framework_call(report, [loginfo,LogInfo]),
+    {ok,TestDir1}.
+
+log_file_error(Error, Dir) ->
+    exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}).
+
+make_html_link(LinkName, Target, Explanation) ->
+    %% if possible use a relative reference to Target.
+    TargetL = filename:split(Target),
+    PwdL = filename:split(filename:dirname(LinkName)),
+    Href = case lists:prefix(PwdL, TargetL) of
+	       true ->
+		   uri_encode(filename:join(lists:nthtail(length(PwdL),TargetL)));
+	       false ->
+		   "file:" ++ uri_encode(Target)
+	   end,
+    H = [html_header(Explanation),
+	 "
Last test
\n"
+	 "",Explanation,"\n"
+	 "\n\n"],
+    ok = write_html_file(LinkName, H).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
+%% Mod = atom()
+%% Func = atom()
+%% ParallelTC = bool()
+%% AbsName = string()
+%%
+%% Create a minor log file for the test case Mod,Func,Args. The log file
+%% will be stored in the log directory under the name ..html.
+%% Some header info will also be inserted into the log file. If the test
+%% case runs in a parallel group, then to avoid clashing file names if the
+%% case is executed more than once, the name ...html
+%% is used.
+
+start_minor_log_file(Mod, Func, ParallelTC) ->
+    MFA = {Mod,Func,1},
+    LogDir = get(test_server_log_dir_base),
+    Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
+    Name = downcase(Name0),
+    AbsName = filename:join(LogDir, Name),
+    case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
+	false ->                           %% normal case, unique name
+	    start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
+	true ->                            %% special case, duplicate names
+	    Tag = test_server_sup:unique_name(),
+	    Name1_0 =
+		lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
+							      ?html_ext])),
+	    Name1 = downcase(Name1_0),
+	    AbsName1 = filename:join(LogDir, Name1),
+	    start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
+    end.
+
+start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
+    {ok,Fd} = open_html_file(AbsName),
+    Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
+    put(test_server_minor_fd, Fd),
+    test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
+
+    TestDescr = io_lib:format("Test ~w:~w result", [Mod,Func]),
+    {Header,Footer} =
+	case test_server_sup:framework_call(get_html_wrapper,
+					    [TestDescr,false,
+					     filename:dirname(AbsName),
+					     undefined], "") of
+	    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
+		put(basic_html, true),
+		{html_header(TestDescr), "\n\n\n"};
+	    {basic_html,Html0,Html1} ->
+		put(basic_html, true),
+		{Html0,Html1};
+	    {xhtml,Html0,Html1} ->
+		put(basic_html, false),
+		{Html0,Html1}
+	end,
+    put(test_server_minor_footer, Footer),
+    io:put_chars(Fd, Header),
+
+    io:put_chars(Fd, ""),
+    io:put_chars(Fd, "
\n"),
+
+    SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
+
+    case get_fw_mod(?MODULE) of
+	Mod when Func == error_in_suite ->
+	    ok;
+	_ ->
+	    {Info,Arity} =
+		if Func == init_per_suite; Func == end_per_suite ->
+			{"Config function: ", 1};
+		   Func == init_per_group; Func == end_per_group ->
+			{"Config function: ", 2};
+		   true ->
+			{"Test case: ", 1}
+		end,
+	    
+	    case {filelib:is_file(filename:join(LogDir, SrcListing)),
+		  lists:member(no_src, get(test_server_logopts))} of
+		{true,false} ->
+		    print(Lev, Info ++ "~w:~w/~w "
+			  "(click for source code)\n",
+			  [uri_encode(SrcListing),
+			   uri_encode(atom_to_list(Func)++"-1",utf8),
+			   Mod,Func,Arity]);
+		_ ->
+		    print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity])
+	    end
+    end,
+
+    AbsName.
+
+stop_minor_log_file() ->
+    test_server_gl:unset_minor_fd(group_leader()),
+    Fd = get(test_server_minor_fd),
+    Footer = get(test_server_minor_footer),
+    io:put_chars(Fd, "
\n" ++ Footer),
+    ok = file:close(Fd),
+    put(test_server_minor_fd, undefined).
+
+downcase(S) -> downcase(S, []).
+downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
+    downcase(Rest, [Uc-$A+$a|Result]);
+downcase([C|Rest], Result) ->
+    downcase(Rest, [C|Result]);
+downcase([], Result) ->
+    lists:reverse(Result).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% html_convert_modules(TestSpec, Config) -> ok
+%%  Isolate the modules affected by TestSpec and
+%%  make sure they are converted to html.
+%%
+%%  Errors are silently ignored.
+
+html_convert_modules(TestSpec, _Config, FwMod) ->
+    Mods = html_isolate_modules(TestSpec, FwMod),
+    html_convert_modules(Mods),
+    copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).
+
+%% Retrieve a list of modules out of the test spec.
+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,{_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
+	       undefined -> Set;
+	       Mod -> sets:add_element(Mod, Set)
+	   end,
+    html_isolate_modules(Cases, Set1, FwMod);
+html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set, FwMod) ->
+    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
+html_isolate_modules([{skip_case,{conf,_Ref,{FwMod,_Func},_Cmt},Mode}|Cases],
+		     Set, FwMod) ->
+    Set1 = case proplists:get_value(suite, get_props(Mode)) of
+	       undefined -> Set;
+	       Mod -> sets:add_element(Mod, Set)
+	   end,
+    html_isolate_modules(Cases, Set1, FwMod);
+html_isolate_modules([{skip_case,{conf,_Ref,{Mod,_Func},_Cmt},_Props}|Cases],
+		     Set, FwMod) ->
+    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
+html_isolate_modules([{Mod,_Case}|Cases], Set, FwMod) ->
+    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
+html_isolate_modules([{Mod,_Case,_Args}|Cases], Set, FwMod) ->
+    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod).
+
+%% Given a list of modules, convert each module's source code to HTML.
+html_convert_modules([Mod|Mods]) ->
+    case code:which(Mod) of
+	Path when is_list(Path) ->
+	    SrcFile = filename:rootname(Path) ++ ".erl",
+	    FoundSrcFile =
+		case file:read_file_info(SrcFile) of
+		    {ok,SInfo} ->
+			{SrcFile,SInfo};
+		    {error,_} ->
+			ModInfo = Mod:module_info(compile),
+			case proplists:get_value(source, ModInfo) of
+			    undefined ->
+				undefined;
+			    OtherSrcFile ->
+				case file:read_file_info(OtherSrcFile) of
+				    {ok,SInfo} ->
+					{OtherSrcFile,SInfo};
+				    {error,_} ->
+					undefined
+				end
+			end
+		end,
+	    case FoundSrcFile of
+		undefined ->
+		    html_convert_modules(Mods);
+		{SrcFile1,SrcFileInfo} ->
+		    DestDir = get(test_server_dir),
+		    Name = atom_to_list(Mod),
+		    DestFile = filename:join(DestDir,
+					     downcase(Name)++?src_listing_ext),
+		    html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
+		    html_convert_modules(Mods)
+	    end;
+	_Other ->
+	    html_convert_modules(Mods)
+    end;
+html_convert_modules([]) -> ok.
+
+%% Convert source code to HTML if possible and needed.
+html_possibly_convert(Src, SrcInfo, Dest) ->
+    case file:read_file_info(Dest) of
+	{ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime ->
+	    ok;					% dest file up to date
+	_ ->
+	    InclPath = case application:get_env(test_server, include) of
+			   {ok,Incls} -> Incls;
+			   _ -> []
+		       end,
+
+	    OutDir = get(test_server_log_dir_base),
+	    case test_server_sup:framework_call(get_html_wrapper,
+						["Module "++Src,false,
+						 OutDir,undefined,
+						 encoding(Src)], "") of
+		Empty when (Empty == "") ; (element(2,Empty) == "")  ->
+		    erl2html2:convert(Src, Dest, InclPath);
+		{_,Header,_} ->
+		    erl2html2:convert(Src, Dest, InclPath, Header)
+	    end
+    end.
+
+%% Copy all HTML files in InDir to OutDir.
+copy_html_files(InDir, OutDir) ->
+    Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
+    lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).
+
+copy_html_file(Src, DestDir) ->
+    Dest = filename:join(DestDir, filename:basename(Src)),
+    case file:read_file(Src) of
+	{ok,Bin} ->
+	    ok = write_binary_file(Dest, Bin);
+	{error,_Reason} ->
+	    io:format("File ~ts: read failed\n", [Src])
+    end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
+%%
+%% Expands TestSpec with an initial init_per_suite, and a final
+%% end_per_suite element, per each discovered suite in the list.
+
+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,
+			   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,_},_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, 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, 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([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
+			   LastRef, FwMod) ->
+    %% if Mod == FwMod, this conf test is (probably) a test case group where
+    %% the init- and end-functions are missing in the suite, and if so,
+    %% the suite name should be stored as {suite,Suite} in Props
+    case proplists:get_value(suite, Props) of
+	Suite when Suite =/= undefined, Suite =/= LastMod ->
+	    {PreCases, NextMod, NextRef} =
+		do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
+	    Case1 = {conf,Ref,[{suite,NextMod}|proplists:delete(suite,Props)],
+		     {FwMod,Func}},
+	    PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
+							  NextRef, FwMod)];
+	_ ->
+	    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
+    end;
+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)];
+add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod)
+  when element(1,SkipCase) == skip_case;  element(1,SkipCase) == auto_skip_case->
+    [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
+add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
+    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, 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)];
+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)];
+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) ->
+    [];
+add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
+    [];
+add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
+    %% we'll add end_per_suite here even if it's not exported
+    %% (and simply let the call fail if it's missing)
+    case erlang:function_exported(LastMod, end_per_suite, 1) of
+	true ->
+	    [{conf,LastRef,[],{LastMod,end_per_suite}}];
+	false ->
+	    %% let's call a "fake" end_per_suite if it exists			
+	    case erlang:function_exported(FwMod, end_per_suite, 1) of
+		true ->					
+		    [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
+		false ->		
+		    [{conf,LastRef,[],{LastMod,end_per_suite}}]
+	    end
+    end.    
+
+do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
+    case code:is_loaded(Mod) of
+	false -> code:load_file(Mod);
+	_ -> ok
+    end,
+    {Init,NextMod,NextRef} =
+	case erlang:function_exported(Mod, init_per_suite, 1) of
+	    true ->
+		Ref = make_ref(),
+		{[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
+	    false ->
+		%% let's call a "fake" init_per_suite if it exists
+		case erlang:function_exported(FwMod, init_per_suite, 1) of
+		    true ->
+			Ref = make_ref(),
+			{[{conf,Ref,[{suite,Mod}],
+			   {FwMod,init_per_suite}}],Mod,Ref};
+		    false ->
+			{[],Mod,undefined}
+		end
+
+	end,
+    Cases =
+	if LastRef==undefined ->
+		Init;
+	   LastRef==skipped_suite ->
+		Init;
+	   true ->
+		%% we'll add end_per_suite here even if it's not exported
+		%% (and simply let the call fail if it's missing)
+		case erlang:function_exported(LastMod, end_per_suite, 1) of
+		    true ->
+			[{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
+		    false ->
+			%% let's call a "fake" end_per_suite if it exists
+			case erlang:function_exported(FwMod, end_per_suite, 1) of
+			    true ->				
+				[{conf,LastRef,[{suite,Mod}],
+				  {FwMod,end_per_suite}}|Init];
+			    false ->
+				[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
+			end
+		end
+	end,
+    {Cases,NextMod,NextRef}.
+
+do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
+    case LastRef of
+	No when No==undefined ; No==skipped_suite ->
+	    {[],Mod,skipped_suite};
+	_Ref ->
+	    case erlang:function_exported(LastMod, end_per_suite, 1) of
+		true ->
+		    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+		     Mod,skipped_suite};
+		false ->
+		    case erlang:function_exported(FwMod, end_per_suite, 1) of
+			true ->				
+			    %% let's call "fake" end_per_suite if it exists
+			    {[{conf,LastRef,[],{FwMod,end_per_suite}}],
+			     Mod,skipped_suite};
+			false ->
+			    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
+			     Mod,skipped_suite}
+		    end
+	    end    	    
+    end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result)
+%%
+%% Runs the specified tests, then displays/logs the summary.
+
+run_test_cases(TestSpec, Config, TimetrapData) ->
+    test_server:init_purify(),
+    case lists:member(no_src, get(test_server_logopts)) of
+	true ->
+	    ok;
+	false ->
+	    FwMod = get_fw_mod(?MODULE),
+	    html_convert_modules(TestSpec, Config, FwMod)
+    end,
+
+    run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
+
+    {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
+	case get(test_server_skipped) of
+	    {0,0} -> {0,0,0,""};
+	    {US,AS} -> {US+AS,US,AS,io_lib:format(", ~w skipped", [US+AS])}
+	end,
+    OkN = get(test_server_ok),
+    FailedN = get(test_server_failed),
+    print(1, "TEST COMPLETE, ~w ok, ~w failed~ts of ~w test cases\n",
+	  [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]),
+    test_server_sup:framework_call(report, [tests_done,
+					    {OkN,FailedN,{UserSkipN,AutoSkipN}}]),
+    print(major, "=finished      ~s", [lists:flatten(timestamp_get(""))]),
+    print(major, "=failed        ~w", [FailedN]),
+    print(major, "=successful    ~w", [OkN]),
+    print(major, "=user_skipped  ~w", [UserSkipN]),
+    print(major, "=auto_skipped  ~w", [AutoSkipN]),
+    exit(test_suites_done).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
+%% TestCases = [Test,...]
+%% Config = [[{Key,Val},...],...]
+%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}
+%% MultiplyTimetrap = integer() | infinity
+%% ScaleTimetrap = bool()
+%% Mode = [{Ref,[Prop,..],StartTime}]
+%% Ref = reference()
+%% Prop = {name,Name} | sequence | parallel |
+%%        shuffle | {shuffle,Seed} |
+%%        repeat | {repeat,N} |
+%%        repeat_until_all_ok | {repeat_until_all_ok,N} |
+%%        repeat_until_any_ok | {repeat_until_any_ok,N} |
+%%        repeat_until_any_fail | {repeat_until_any_fail,N} |
+%%        repeat_until_all_fail | {repeat_until_all_fail,N}
+%% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}]
+%% Ok = Skipped = Failed = [Case,...]
+%%
+%% Execute the TestCases under configuration Config. Config is a list
+%% of lists, where hd(Config) holds the config tuples for the current
+%% conf case and tl(Config) is the data for the higher level conf cases.
+%% Config data is "inherited" from top to nested conf cases, but
+%% never the other way around. if length(Config) == 1, Config contains
+%% only the initial config data for the suite.
+%%
+%% Test may be one of the following:
+%%
+%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification
+%% function, call it with the current configuration as argument. It will
+%% return a new configuration.
+%%
+%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called
+%% with the given arguments.
+%%
+%% {Mod,Case} This is a normal test case. Determine the correct
+%% configuration, and insert {Mod,Case,Config} as head of the list,
+%% then reiterate.
+%%
+%% {Mod,Case,Args} A test case with predefined argument (usually a normal
+%% test case which just got a fresh configuration (see above)).
+%%
+%% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped
+%% by the user. This will also cause the end conf case to be skipped.
+%% Note that it is not possible to skip an end conf case directly (it
+%% can only be skipped indirectly by a skipped init conf case). The
+%% comment (which gets printed in the log files) describes why the case
+%% was skipped.
+%%
+%% {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.
+%%
+%% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of
+%% an end conf case being automatically skipped due to a failing init
+%% conf case. It could also be a nested conf case that gets skipped
+%% because of a failed or skipped top level conf.
+%%
+%% {auto_skip_case,{Case,Comment},Mode} This is a normal test case which
+%% gets automatically skipped because of a failing init conf case or
+%% because of a failing previous test case in a sequence.
+%%
+%% -------------------------------------------------------------------
+%% Description of IO handling during execution of parallel test cases:
+%% -------------------------------------------------------------------
+%%
+%% A conf group can have an associated list of properties. If the
+%% parallel property is specified for a group, it means the test cases
+%% should be spawned and run in parallel rather than called sequentially
+%% (which is always the default mode). Test cases that execute in parallel
+%% also write to their respective minor log files in parallel. Printouts
+%% to common log files, such as the summary html file and the major log
+%% file on text format, still have to be processed sequentially. For this
+%% reason, the Mode argument specifies if a parallel group is currently
+%% being executed.
+%%
+%% The low-level mechanism for buffering IO for the common log files
+%% is handled by the test_server_io module. Buffering is turned on by
+%% test_server_io:start_transaction/0 and off by calling
+%% test_server_io:end_transaction/0. The buffered data for the transaction
+%% can printed by calling test_server_io:print_buffered/1.
+%%
+%% This module is responsible for turning on IO buffering and to later
+%% test_server_io:print_buffered/1 to print the data. To help with this,
+%% two variables in the process dictionary are used:
+%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
+%% are set to as follwing:
+%%
+%%   Value	Meaning
+%%   -----     -------
+%%   undefined	No parallel test cases running
+%%   {tc,Pid}	Running test cases in a top-level parallel group
+%%   {Ref,Pid}	Running sequential test case inside a parallel group
+%%
+%% FIXME: The Pid is no longer used.
+%%
+%% If a conf group nested under a parallel group in the test
+%% specification should be started, the 'test_server_common_io_handler'
+%% value gets set also on the main process.
+%%
+%% During execution of a parallel group (or of a group nested under a
+%% parallel group), *any* new test case being started gets registered
+%% in a list saved in the dictionary with 'test_server_queued_io' as key.
+%% When the top level parallel group is finished (only then can we be
+%% sure all parallel test cases have finished and "reported in"), the
+%% list of test cases is traversed in order and test_server_io:print_buffered/1
+%% can be called for each test case. See handle_test_case_io_and_status/0
+%% for details.
+%%
+%% To be able to handle nested conf groups with different properties,
+%% the Mode argument specifies a list of {Ref,Properties} tuples.
+%% The head of the Mode list at any given time identifies the group
+%% currently being processed. The tail of the list identifies groups
+%% on higher level.
+%%
+%% -------------------------------------------------------------------
+%% Notes on parallel execution of test cases
+%% -------------------------------------------------------------------
+%%
+%% A group nested under a parallel group will start executing in
+%% parallel with previous (parallel) test cases (no matter what
+%% properties the nested group has). Test cases are however never
+%% executed in parallel with the start or end conf case of the same
+%% group! Because of this, the test_server_ctrl loop waits at
+%% the end conf of a group for all parallel cases to finish
+%% before the end conf case actually executes. This has the effect
+%% that it's only after a nested group has finished that any
+%% remaining parallel cases in the previous group get spawned (*).
+%% Example (all parallel cases):
+%%
+%% group1_init   |---->
+%% group1_case1        | --------->
+%% group1_case2        | --------------------------------->
+%% group2_init         | ---->
+%% group2_case1               | ------>
+%% group2_case2               | ---------->
+%% group2_end                              | --->
+%% group1_case3                               (*)| ---->
+%% group1_case4                               (*)| -->
+%% group1_end                                              | --->
+%%
+
+run_test_cases_loop([{SkipTag,CaseData={Type,_Ref,_Case,_Comment}}|Cases],
+		    Config, TimetrapData, Mode, Status) when
+      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
+      ((Type==conf) or (Type==make)) ->
+    run_test_cases_loop([{SkipTag,CaseData,Mode}|Cases],
+			Config, TimetrapData, Mode, Status);
+
+run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases],
+		    Config, TimetrapData, Mode, Status) when
+      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
+      ((Type==conf) or (Type==make)) ->
+    file:set_cwd(filename:dirname(get(test_server_dir))),
+    CurrIOHandler = get(test_server_common_io_handler),
+    ParentMode = tl(Mode),
+
+    {AutoOrUser,ReportTag} = 
+	if SkipTag == auto_skip_case -> {auto,tc_auto_skip};
+	   SkipTag == skip_case      -> {user,tc_user_skip}
+	end,
+
+    %% check and update the mode for test case execution and io msg handling
+    case {curr_ref(Mode),check_props(parallel, Mode)} of
+	{Ref,Ref} ->
+	    case check_props(parallel, ParentMode) of
+		false ->
+		    %% this is a skipped end conf for a top level parallel
+		    %% group, buffered io can be flushed
+		    handle_test_case_io_and_status(),
+		    set_io_buffering(undefined),
+		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+					   false, SkipMode),
+		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+		    test_server_sup:framework_call(report,
+						   [ReportTag,ConfData]),
+		    run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
+					delete_status(Ref, Status));
+		_ ->
+		    %% this is a skipped end conf for a parallel group nested
+		    %% under a parallel group (io buffering is active)
+		    wait_for_cases(Ref),
+		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+					   true, SkipMode),
+		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+		    test_server_sup:framework_call(report, [ReportTag,ConfData]),
+		    case CurrIOHandler of
+			{Ref,_} ->
+			    %% current_io_handler was set by start conf of this
+			    %% group, so we can unset it now (no more io from main
+			    %% process needs to be buffered)
+			    set_io_buffering(undefined);
+			_ ->
+			    ok
+		    end,
+		    run_test_cases_loop(Cases, Config,
+					TimetrapData, ParentMode,
+					delete_status(Ref, Status))
+	    end;
+	{Ref,false} ->
+	    %% this is a skipped end conf for a non-parallel group that's not
+	    %% nested under a parallel group
+	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+				   false, SkipMode),
+	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
+
+	    %% Check if this group is auto skipped because of error in the
+	    %% init conf. If so, check if the parent group is a sequence,
+	    %% and if it is, skip all proceeding tests in that group.
+	    GrName = get_name(Mode),
+	    Cases1 =
+		case get_tc_results(Status) of
+		    {_,_,Fails} when length(Fails) > 0 ->
+			case lists:member({group_result,GrName}, Fails) of
+			    true ->
+				case check_prop(sequence, ParentMode) of
+				    false ->
+					Cases;
+				    ParentRef ->
+					Reason = {group_result,GrName,failed},
+					skip_cases_upto(ParentRef, Cases,
+							Reason, tc, ParentMode,
+							SkipTag)
+				end;
+			    false ->
+				Cases
+			end;
+		    _ ->
+			Cases
+		end,
+	    run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode,
+				delete_status(Ref, Status));
+	{Ref,_} ->
+	    %% this is a skipped end conf for a non-parallel group nested under
+	    %% a parallel group (io buffering is active)
+	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+				   true, SkipMode),
+	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
+	    case CurrIOHandler of
+		{Ref,_} ->
+		    %% current_io_handler was set by start conf of this
+		    %% group, so we can unset it now (no more io from main
+		    %% process needs to be buffered)
+		    set_io_buffering(undefined);
+		_ ->
+		    ok
+	    end,
+	    run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode),
+				delete_status(Ref, Status));
+	{_,false} ->
+	    %% this is a skipped start conf for a group which is not nested
+	    %% under a parallel group
+	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+				   false, SkipMode),
+	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
+	    run_test_cases_loop(Cases, Config, TimetrapData,
+				[conf(Ref,[])|Mode], Status);
+	{_,Ref0} when is_reference(Ref0) ->
+	    %% this is a skipped start conf for a group nested under a parallel
+	    %% group and if this is the first nested group, io buffering must
+	    %% be activated
+	    if CurrIOHandler == undefined ->
+		    set_io_buffering({Ref,self()});
+	       true ->
+		    ok
+	    end,
+	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
+				   true, SkipMode),
+	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
+	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
+	    run_test_cases_loop(Cases, Config, TimetrapData,
+				[conf(Ref,[])|Mode], Status)
+    end;
+
+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,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},SkipMode}|Cases],
+		    Config, TimetrapData, Mode, Status) ->
+    skip_case(user, undefined, 0, Case, Comment, false, SkipMode),
+    test_server_sup:framework_call(report, [tc_user_skip,
+					    {Mod,{all,get_name(SkipMode)},
+					     Comment}]),
+    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
+
+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(), 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));
+
+%% a start *or* end conf case, wrapping test cases or other conf cases
+run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
+		    Config, TimetrapData, Mode0, Status) ->
+    CurrIOHandler = get(test_server_common_io_handler),
+    %% check and update the mode for test case execution and io msg handling
+    {StartConf,Mode,IOHandler,ConfTime,Status1} =
+	case {curr_ref(Mode0),check_props(parallel, Mode0)} of
+	    {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
+			OkSkipFail = handle_test_case_io_and_status(),
+			file:set_cwd(filename:dirname(get(test_server_dir))),
+			After = ?now,
+			Before = get(test_server_parallel_start_time),
+			Elapsed = timer:now_diff(After, Before)/1000000,
+			put(test_server_total_time, Elapsed),
+			{false,tl(Mode0),undefined,Elapsed,
+			 update_status(Ref, OkSkipFail, Status)};
+		    _ ->
+			%% this is an end conf for a parallel group nested under a
+			%% parallel group (io buffering is active)
+			OkSkipFail = wait_for_cases(Ref),
+			queue_test_case_io(Ref, self(), 0, Mod, Func),
+			Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
+			case CurrIOHandler of
+			    {Ref,_} ->
+				%% current_io_handler was set by start conf of this
+				%% group, so we can unset it after this case (no
+				%% more io from main process needs to be buffered)
+				{false,tl(Mode0),undefined,Elapsed,
+				 update_status(Ref, OkSkipFail, Status)};
+			    _ ->
+				{false,tl(Mode0),CurrIOHandler,Elapsed,
+				 update_status(Ref, OkSkipFail, Status)}
+			end
+		end;
+	    {Ref,false} ->
+		%% this is an end conf for a non-parallel group that's not
+		%% nested under a parallel group, so no need to buffer io
+		{false,tl(Mode0),undefined,
+		 timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status};
+	    {Ref,_} ->
+		%% this is an end conf for a non-parallel group nested under
+		%% a parallel group (io buffering is active)
+		queue_test_case_io(Ref, self(), 0, Mod, Func),
+		Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
+		case CurrIOHandler of
+		    {Ref,_} ->
+			%% current_io_handler was set by start conf of this
+			%% group, so we can unset it after this case (no
+			%% more io from main process needs to be buffered)
+			{false,tl(Mode0),undefined,Elapsed,Status};
+		    _ ->
+			{false,tl(Mode0),CurrIOHandler,Elapsed,Status}
+		end;
+	    {_,false} ->
+		%% this is a start conf for a group which is not nested under a
+		%% parallel group, check if this case starts a new parallel group
+		case lists:member(parallel, Props) of
+		    true ->
+			%% prepare for execution of parallel group
+			put(test_server_parallel_start_time, ?now),
+			put(test_server_queued_io, []);
+		    false ->
+			ok
+		end,
+		{true,[conf(Ref,Props)|Mode0],undefined,0,Status};
+	    {_,_Ref0} ->
+		%% this is a start conf for a group nested under a parallel group, the
+		%% parallel_start_time and parallel_test_cases values have already been set
+		queue_test_case_io(Ref, self(), 0, Mod, Func),
+		%% if this is the first nested group under a parallel group, io
+		%% buffering must be activated
+		IOHandler1 = if CurrIOHandler == undefined ->
+				     IOH = {Ref,self()},
+				     set_io_buffering(IOH),
+				     IOH;
+				true ->
+				     CurrIOHandler
+			     end,
+		{true,[conf(Ref,Props)|Mode0],IOHandler1,0,Status}
+	end,
+
+    %% if this is a start conf we check if cases should be shuffled
+    {[_Conf|Cases1]=Cs1,Shuffle} =
+	if StartConf ->
+		case get_shuffle(Props) of
+		    undefined ->
+			{Cs0,undefined};
+		    {_,repeated} ->
+			%% if group is repeated, a new seed should not be set every
+			%% turn - last one is saved in dictionary
+			CurrSeed = get(test_server_curr_random_seed),
+			{shuffle_cases(Ref, Cs0, CurrSeed),{shuffle,CurrSeed}};
+		    {_,Seed} ->
+			UseSeed=
+			    %% Determine which seed to use by:
+			    %% 1. check the TS_RANDOM_SEED env variable
+			    %% 2. check random_seed in process state
+			    %% 3. use value provided with shuffle option
+			    %% 4. use timestamp() values for seed
+			    case os:getenv("TS_RANDOM_SEED") of
+				Undef when Undef == false ; Undef == "undefined" ->
+				    case get(test_server_random_seed) of
+					undefined -> Seed;
+					TSRS -> TSRS
+				    end;
+				NumStr ->
+				    %% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
+				    list_to_tuple([list_to_integer(NS) ||
+						   NS <- string:tokens(NumStr, [$ ,$:,$,])])
+			    end,
+			{shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
+		end;
+	   not StartConf ->
+		{Cs0,undefined}
+	end,
+
+    %% if this is a start conf we check if Props specifies repeat and if so
+    %% we copy the group and carry the copy until the end conf where we
+    %% decide to perform the repetition or not
+    {Repeating,Status2,Cases,ReportRepeatStop} =
+	if StartConf ->
+		case get_repeat(Props) of
+		    undefined ->
+			%% we *must* have a status entry for every conf since we
+			%% will continously update status with test case results
+			%% without knowing the Ref (but update hd(Status))
+			{false,new_status(Ref, Status1),Cases1,?void_fun};
+		    {_RepType,N} when N =< 1 ->
+			{false,new_status(Ref, Status1),Cases1,?void_fun};
+		    _ ->
+			{Copied,_} = copy_cases(Ref, make_ref(), Cs1),
+			{true,new_status(Ref, Copied, Status1),Cases1,?void_fun}
+		end;
+	   not StartConf ->
+		RepVal = get_repeat(get_props(Mode0)),
+		ReportStop =
+		    fun() ->
+			    print(minor, "~n*** Stopping repeat operation ~w", [RepVal]),
+			    print(1, "Stopping repeat operation ~w", [RepVal])
+		    end,
+		CopiedCases = get_copied_cases(Status1),
+		EndStatus = delete_status(Ref, Status1),
+		%% check in Mode0 if this is a repeat conf
+		case RepVal of
+		    undefined ->
+			{false,EndStatus,Cases1,?void_fun};
+		    {_RepType,N} when N =< 1 ->
+			{false,EndStatus,Cases1,?void_fun};
+		    {repeat,_} ->
+			{true,EndStatus,CopiedCases++Cases1,?void_fun};
+		    {repeat_until_all_ok,_} ->
+			{RestCs,Fun} = case get_tc_results(Status1) of
+					   {_,_,[]} ->
+					       {Cases1,ReportStop};
+					   _ ->
+					       {CopiedCases++Cases1,?void_fun}
+				       end,
+			{true,EndStatus,RestCs,Fun};
+		    {repeat_until_any_ok,_} ->
+			{RestCs,Fun} = case get_tc_results(Status1) of
+					   {Ok,_,_Fails} when length(Ok) > 0 ->
+					       {Cases1,ReportStop};
+					   _ ->
+					       {CopiedCases++Cases1,?void_fun}
+				       end,
+			{true,EndStatus,RestCs,Fun};
+		    {repeat_until_any_fail,_} ->
+			{RestCs,Fun} = case get_tc_results(Status1) of
+					   {_,_,Fails} when length(Fails) > 0 ->
+					       {Cases1,ReportStop};
+					   _ ->
+					       {CopiedCases++Cases1,?void_fun}
+				 end,
+			{true,EndStatus,RestCs,Fun};
+		    {repeat_until_all_fail,_} ->
+			{RestCs,Fun} = case get_tc_results(Status1) of
+					   {[],_,_} ->
+					       {Cases1,ReportStop};
+					   _ ->
+					       {CopiedCases++Cases1,?void_fun}
+				       end,
+			{true,EndStatus,RestCs,Fun}
+		end
+	end,
+
+    ReportAbortRepeat = fun(What) when Repeating ->
+				print(minor, "~n*** Aborting repeat operation "
+				      "(configuration case ~w)", [What]),
+				print(1, "Aborting repeat operation "
+				      "(configuration case ~w)", [What]);
+			   (_) -> ok
+			end,
+    CfgProps = if StartConf ->
+		       if Shuffle == undefined ->
+			       [{tc_group_properties,Props}];
+			  true ->
+			       [{tc_group_properties,
+				 [Shuffle|delete_shuffle(Props)]}]
+		       end;
+		  not StartConf ->
+		       {TcOk,TcSkip,TcFail} = get_tc_results(Status1),
+		       [{tc_group_properties,get_props(Mode0)},
+			{tc_group_result,[{ok,TcOk},
+					  {skipped,TcSkip},
+					  {failed,TcFail}]}]
+	       end,
+
+    SuiteName = proplists:get_value(suite, Props),
+    case get(test_server_create_priv_dir) of
+	auto_per_run ->				% use common priv_dir
+	    TSDirs = [{priv_dir,get(test_server_priv_dir)},
+		      {data_dir,get_data_dir(Mod, SuiteName)}];    
+	_ ->
+	    TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
+    end,
+
+    ActualCfg = 
+	if not StartConf ->
+		update_config(hd(Config), TSDirs ++ CfgProps);
+	   true ->
+		GroupPath = lists:flatmap(fun({_Ref,[],_T}) -> [];
+					     ({_Ref,GrProps,_T}) -> [GrProps]
+					  end, Mode0),
+		update_config(hd(Config), 
+			      TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
+	end,
+
+    CurrMode = curr_mode(Ref, Mode0, Mode),
+    ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
+				   TimetrapData, CurrMode),
+
+    case ConfCaseResult of
+	{_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) ->
+	    %% check that init_per_suite returned data on correct format
+	    case lists:filter(fun({_,_}) -> false;
+				 (_) -> true end, NewCfg) of
+		[] ->
+		    set_io_buffering(IOHandler),
+		    stop_minor_log_file(),
+		    run_test_cases_loop(Cases, [NewCfg|Config],
+					TimetrapData, Mode, Status2);
+		Bad ->
+		    print(minor,
+			  "~n*** ~w returned bad elements in Config: ~p.~n",
+			  [Func,Bad]),
+		    Reason = {failed,{Mod,init_per_suite,bad_return}},
+		    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
+					     auto_skip_case),
+		    set_io_buffering(IOHandler),
+		    stop_minor_log_file(),
+		    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
+					delete_status(Ref, Status2))
+	    end;
+	{_,NewCfg,_} when StartConf, is_list(NewCfg) ->
+	    print_conf_time(ConfTime),
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
+	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
+	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
+		  [FwMod,FwFunc,Reason]),
+	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
+	    exit(framework_error);
+	{_,Fail,_} when element(1,Fail) == 'EXIT';
+			element(1,Fail) == timetrap_timeout;
+			element(1,Fail) == user_timetrap_error;
+			element(1,Fail) == failed ->
+	    {Cases2,Config1,Status3} =
+		if StartConf ->
+			ReportAbortRepeat(failed),
+			print(minor, "~n*** ~w failed.~n"
+			      "    Skipping all cases.", [Func]),
+			Reason = {failed,{Mod,Func,Fail}},
+			{skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
+					 auto_skip_case),
+			 Config,
+			 update_status(failed, group_result, get_name(Mode),
+				       delete_status(Ref, Status2))};
+		   not StartConf ->
+			ReportRepeatStop(),
+			print_conf_time(ConfTime),
+			{Cases,tl(Config),delete_status(Ref, Status2)}
+		end,
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
+
+	{_,{auto_skip,SkipReason},_} ->
+	    %% this case can only happen if the framework (not the user)
+	    %% decides to skip execution of a conf function
+	    {Cases2,Config1,Status3} =
+		if StartConf ->
+			ReportAbortRepeat(auto_skipped),
+			print(minor, "~n*** ~w auto skipped.~n"
+			      "    Skipping all cases.", [Func]),
+			{skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
+					 auto_skip_case),
+			 Config,
+			 delete_status(Ref, Status2)};
+		   not StartConf ->
+			ReportRepeatStop(),
+			print_conf_time(ConfTime),
+			{Cases,tl(Config),delete_status(Ref, Status2)}
+		end,
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
+
+	{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
+	    ReportAbortRepeat(skipped),
+	    print(minor, "~n*** ~w skipped.~n"
+		  "    Skipping all cases.", [Func]),
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
+						CurrMode, skip_case),
+				[hd(Config)|Config], TimetrapData, Mode,
+				delete_status(Ref, Status2));
+	{_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
+	    ReportAbortRepeat(skipped),
+	    print(minor, "~n*** ~w skipped.~n"
+		  "    Skipping all cases.", [Func]),
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
+						CurrMode, skip_case),
+				[hd(Config)|Config], TimetrapData, Mode,
+				delete_status(Ref, Status2));
+	{_,_Other,_} when Func == init_per_suite ->
+	    print(minor, "~n*** init_per_suite failed to return a Config list.~n", []),
+	    Reason = {failed,{Mod,init_per_suite,bad_return}},
+	    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
+				     auto_skip_case),
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
+				delete_status(Ref, Status2));
+	{_,_Other,_} when StartConf ->
+	    print_conf_time(ConfTime),
+	    set_io_buffering(IOHandler),
+	    ReportRepeatStop(),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData,
+				Mode, Status2);
+	{_,_EndConfRetVal,Opts} ->
+	    %% Check if return_group_result is set (ok, skipped or failed) and
+	    %% if so:
+	    %% 1) *If* the parent group is a sequence, skip all proceeding tests
+	    %%    in that group.
+	    %% 2) Return the value to the group "above" so that result may be
+	    %%    used for evaluating a 'repeat_until_*' property.
+	    GrName = get_name(Mode0, Func),
+	    {Cases2,Status3} =
+		case lists:keysearch(return_group_result, 1, Opts) of
+		    {value,{_,failed}} ->
+			case {curr_ref(Mode),check_prop(sequence, Mode)} of
+			    {ParentRef,ParentRef} ->
+				Reason = {group_result,GrName,failed},
+				{skip_cases_upto(ParentRef, Cases, Reason, tc,
+						 Mode, auto_skip_case),
+				 update_status(failed, group_result, GrName,
+					       delete_status(Ref, Status2))};
+			    _ ->
+				{Cases,update_status(failed, group_result, GrName,
+						     delete_status(Ref, Status2))}
+			end;
+		    {value,{_,GroupResult}} ->
+			{Cases,update_status(GroupResult, group_result, GrName,
+					     delete_status(Ref, Status2))};
+		    false ->
+			{Cases,update_status(ok, group_result, GrName,
+					     delete_status(Ref, Status2))}
+		end,
+	    print_conf_time(ConfTime),
+	    ReportRepeatStop(),
+	    set_io_buffering(IOHandler),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases2, tl(Config), TimetrapData,
+				Mode, Status3)
+    end;
+
+run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
+		    Mode, Status) ->
+    case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
+	{_,Why={'EXIT',_},_} ->
+	    print(minor, "~n*** ~w failed.~n"
+ 		  "    Skipping all cases.", [Func]),
+	    Reason = {failed,{Mod,Func,Why}},
+	    Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
+				    auto_skip_case),
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
+	{_,_Whatever,_} ->
+	    stop_minor_log_file(),
+	    run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status)
+    end;
+
+run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
+		    Config, _TimetrapData, _Mode, _Status) ->
+    erlang:error(badarg, [Conf,Config]);
+
+run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
+    ActualCfg =
+	case get(test_server_create_priv_dir) of
+	    auto_per_run ->
+		update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
+					   {data_dir,get_data_dir(Mod)}]);
+	    _ ->
+		update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
+	end,
+    run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
+			TimetrapData, Mode, Status);
+
+run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) ->
+    {Num,RunInit} =
+	case FwMod = get_fw_mod(?MODULE) of
+	    Mod when Func == error_in_suite ->
+		{-1,skip_init};
+	    _ ->
+		{put(test_server_case_num, get(test_server_case_num)+1),
+		 run_init}
+	end,
+
+    %% check the current execution mode and save info about the case if
+    %% detected that printouts to common log files is handled later
+
+    case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
+	true ->
+	    %% sequential test case nested in a parallel group;
+	    %% io is buffered, so we must queue this test case
+	    queue_test_case_io(undefined, self(), Num+1, Mod, Func);
+	false ->
+	    ok
+    end,
+
+    case run_test_case(undefined, Num+1, Mod, Func, Args,
+		       RunInit, TimetrapData, Mode) of
+	%% callback to framework module failed, exit immediately
+	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
+	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
+		  [FwMod,FwFunc,Reason]),
+	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
+	    stop_minor_log_file(),
+	    exit(framework_error);
+	%% sequential execution of test case finished
+	{Time,RetVal,_} ->
+	    {Failed,Status1} =
+		case Time of
+		    died ->
+			{true,update_status(failed, Mod, Func, Status)};
+		    _ when is_tuple(RetVal) ->
+			case element(1, RetVal) of
+			    R when R=='EXIT'; R==failed ->
+				{true,update_status(failed, Mod, Func, Status)};
+			    R when R==skip; R==skipped ->
+				{false,update_status(skipped, Mod, Func, Status)};
+			    _ ->
+				{false,update_status(ok, Mod, Func, Status)}
+			end;
+		    _ ->
+			{false,update_status(ok, Mod, Func, Status)}
+		end,
+	    case check_prop(sequence, Mode) of
+		false ->
+		    stop_minor_log_file(),
+		    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
+		Ref ->
+		    %% the case is in a sequence; we must check the result and
+		    %% determine if the following cases should run or be skipped
+		    if not Failed ->	      % proceed with next case
+			    stop_minor_log_file(),
+			    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
+		       true ->	              % skip rest of cases in sequence
+			    print(minor, "~n*** ~w failed.~n"
+				  "    Skipping all other cases in sequence.",
+				  [Func]),
+			    Reason = {failed,{Mod,Func}},
+			    Cases2 = skip_cases_upto(Ref, Cases, Reason, tc,
+						     Mode, auto_skip_case),
+			    stop_minor_log_file(),
+			    run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1)
+		    end
+	    end;
+	%% the test case is being executed in parallel with the main process (and
+	%% other test cases) and Pid is the dedicated process executing the case
+	Pid ->
+	    %% io from Pid will be buffered by the test_server_io process and
+	    %% handled later, so we have to save info about the case
+	    queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
+	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status)
+    end;
+
+%% TestSpec processing finished
+run_test_cases_loop([], _Config, _TimetrapData, _, _) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% various help functions
+
+new_status(Ref, Status) ->
+    [{Ref,{{[],[],[]},[]}} | Status].
+
+new_status(Ref, CopiedCases, Status) ->
+    [{Ref,{{[],[],[]},CopiedCases}} | Status].
+
+delete_status(Ref, Status) ->
+    lists:keydelete(Ref, 1, Status).
+
+update_status(ok, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
+    [{Ref,{{Ok++[{Mod,Func}],Skip,Fail},Cs}} | Status];
+
+update_status(skipped, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
+    [{Ref,{{Ok,Skip++[{Mod,Func}],Fail},Cs}} | Status];
+
+update_status(failed, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
+    [{Ref,{{Ok,Skip,Fail++[{Mod,Func}]},Cs}} | Status];
+
+update_status(_, _, _, []) ->
+    [].
+
+update_status(Ref, {Ok,Skip,Fail}, [{Ref,{{Ok0,Skip0,Fail0},Cs}} | Status]) ->
+    [{Ref,{{Ok0++Ok,Skip0++Skip,Fail0++Fail},Cs}} | Status].
+
+get_copied_cases([{_,{_,Cases}} | _Status]) ->
+    Cases.
+
+get_tc_results([{_,{OkSkipFail,_}} | _Status]) ->
+    OkSkipFail;
+get_tc_results([]) ->		      % in case init_per_suite crashed
+    {[],[],[]}.
+
+conf(Ref, Props) ->
+    {Ref,Props,?now}.
+
+curr_ref([{Ref,_Props,_}|_]) ->
+    Ref;
+curr_ref([]) ->
+    undefined.
+
+curr_mode(Ref, Mode0, Mode1) ->
+    case curr_ref(Mode1) of
+	Ref -> Mode1;
+	_   -> Mode0
+    end.
+
+get_props([{_,Props,_} | _]) ->
+    Props;
+get_props([]) ->
+    [].
+
+check_prop(_Attrib, []) ->
+    false;
+check_prop(Attrib, [{Ref,Props,_}|_]) ->
+    case lists:member(Attrib, Props) of
+	true -> Ref;
+	false -> false
+    end.
+
+check_props(Attrib, Mode) ->
+    case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of
+	[] -> false;
+	[Ref|_] -> Ref
+    end.
+
+get_name(Mode, Def) ->
+    case get_name(Mode) of
+	undefined -> Def;
+	Name      -> Name
+    end.
+
+get_name([{_Ref,Props,_}|_]) ->
+    proplists:get_value(name, Props);
+get_name([]) ->
+    undefined.
+
+conf_start(Ref, Mode) ->
+    case lists:keysearch(Ref, 1, Mode) of
+	{value,{_,_,T}} -> T;
+	false -> 0
+    end.
+
+
+get_data_dir(Mod) ->
+    get_data_dir(Mod, undefined).
+
+get_data_dir(Mod, Suite) ->
+    UseMod = if Suite == undefined -> Mod;
+		true               -> Suite
+	     end,
+    case code:which(UseMod) of
+	non_existing ->
+	    print(12, "The module ~w is not loaded", [Mod]),
+	    [];
+	cover_compiled ->
+	    MainCoverNode = cover:get_main_node(),
+	    {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
+	    do_get_data_dir(UseMod,File);
+	FullPath ->
+	    do_get_data_dir(UseMod,FullPath)
+    end.
+
+do_get_data_dir(Mod,File) ->
+    filename:dirname(File) ++ "/" ++ atom_to_list(Mod) ++ ?data_dir_suffix.
+
+print_conf_time(0) ->
+    ok;
+print_conf_time(ConfTime) ->
+    print(major, "=group_time    ~.3fs", [ConfTime]),
+    print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).
+
+print_props([]) ->
+    ok;
+print_props(Props) ->
+    print(major, "=group_props   ~p", [Props]),
+    print(minor, "Group properties: ~p~n", [Props]).
+
+%% repeat N times:                                  {repeat,N}
+%% repeat N times or until all successful:          {repeat_until_all_ok,N}
+%% repeat N times or until at least one successful: {repeat_until_any_ok,N}
+%% repeat N times or until at least one case fails: {repeat_until_any_fail,N}
+%% repeat N times or until all fails:               {repeat_until_all_fail,N}
+%% N      = integer() | forever
+get_repeat(Props) ->
+    get_prop([repeat,repeat_until_all_ok,repeat_until_any_ok,
+	      repeat_until_any_fail,repeat_until_all_fail], forever, Props).
+
+update_repeat(Props) ->
+    case get_repeat(Props) of
+	undefined ->
+	    Props;
+	{RepType,N} ->
+	    Props1 =
+		if N == forever ->
+			[{RepType,N}|lists:keydelete(RepType, 1, Props)];
+		   N < 3 ->
+			lists:keydelete(RepType, 1, Props);
+		   N >= 3 ->
+			[{RepType,N-1}|lists:keydelete(RepType, 1, Props)]
+		end,
+	    %% if shuffle is used in combination with repeat, a new
+	    %% seed shouldn't be set every new turn
+	    case get_shuffle(Props1) of
+		undefined ->
+		    Props1;
+		_ ->
+		    [{shuffle,repeated}|delete_shuffle(Props1)]
+	    end
+    end.
+
+get_shuffle(Props) ->
+    get_prop([shuffle], ?now, Props).
+
+delete_shuffle(Props) ->
+    delete_prop([shuffle], Props).
+
+%% Return {Item,Value} if found, else if Item alone
+%% is found, return {Item,Default}
+get_prop([Item|Items], Default, Props) ->
+    case lists:keysearch(Item, 1, Props) of
+	{value,R} ->
+	    R;
+	false ->
+	    case lists:member(Item, Props) of
+		true ->
+		    {Item,Default};
+		false ->
+		    get_prop(Items, Default, Props)
+	    end
+    end;
+get_prop([], _Def, _Props) ->
+    undefined.
+
+delete_prop([Item|Items], Props) ->
+    Props1 = lists:delete(Item, lists:keydelete(Item, 1, Props)),
+    delete_prop(Items, Props1);
+delete_prop([], Props) ->
+    Props.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% shuffle_cases(Ref, Cases, Seed) -> Cases1
+%%
+%% Shuffles the order of Cases.
+
+shuffle_cases(Ref, Cases, undefined) ->
+    shuffle_cases(Ref, Cases, rand:seed_s(exsplus));
+
+shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) ->
+    {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
+    Seed = case Seed0 of
+	       {X,Y,Z} when is_integer(X+Y+Z) ->
+		   rand:seed(exsplus, Seed0);
+	       _ ->
+		   Seed0
+	   end,
+    ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []),
+    [Start|ShuffledCases] ++ Rest.
+
+cases_to_shuffle(Ref, Cases) ->
+    cases_to_shuffle(Ref, Cases, 1, []).
+
+cases_to_shuffle(Ref, [{conf,Ref,_,_} | _]=Cs, N, Ix) ->          % end
+    {N-1,Ix,Cs};
+cases_to_shuffle(Ref, [{skip_case,{_,Ref,_,_},_} | _]=Cs, N, Ix) -> % end
+    {N-1,Ix,Cs};
+
+cases_to_shuffle(Ref, [{conf,Ref1,_,_}=C | Cs], N, Ix) ->          % nested group
+    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
+    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
+cases_to_shuffle(Ref, [{skip_case,{_,Ref1,_,_},_}=C | Cs], N, Ix) -> % nested group
+    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
+    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
+
+cases_to_shuffle(Ref, [C | Cs], N, Ix) ->
+    cases_to_shuffle(Ref, Cs, N+1, [{N,[C]} | Ix]).
+
+get_subcases(SubRef, [{conf,SubRef,_,_}=C | Cs], SubCs) ->
+    {lists:reverse([C|SubCs]),Cs};
+get_subcases(SubRef, [{skip_case,{_,SubRef,_,_},_}=C | Cs], SubCs) ->
+    {lists:reverse([C|SubCs]),Cs};
+get_subcases(SubRef, [C|Cs], SubCs) ->
+    get_subcases(SubRef, Cs, [C|SubCs]).
+
+random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
+    %% save current seed to be used if test cases are repeated
+    put(test_server_curr_random_seed, Seed),
+    Shuffled++CaseOrGroup;
+random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
+    {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
+    random_order(N-1, rand:uniform_s(N-1, NewSeed),
+		 First++Rest, Shuffled++CaseOrGroup).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func}
+%%
+%% Prints info about a skipped case in the major and html log files.
+%% 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, Mode) ->
+    MF = {Mod,Func} = case Case of
+			  {M,F,_A} -> {M,F};
+			  {M,F} -> {M,F}
+		      end,
+    if SendSync ->
+	    queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
+	    self() ! {started,Ref,self(),CaseNum,Mod,Func},
+	    test_server_io:start_transaction(),
+	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
+	    test_server_io:end_transaction(),
+	    self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
+       not SendSync ->
+	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
+    end,
+    MF.
+
+skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
+    {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode),
+    ResultCol = if Type == auto -> ?auto_skip_color;
+		   Type == user -> ?user_skip_color
+		end,
+    print(major, "~n=case          ~w:~w", [Mod,Func]),
+    GroupName =	case get_name(Mode) of
+		    undefined ->
+			"";
+		    GrName ->
+			GrName1 = cast_to_list(GrName),
+			print(major, "=group_props   ~p", [[{name,GrName1}]]),
+			GrName1
+		end,
+    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
+    Comment1 = reason_to_string(Comment),
+    if Type == auto ->
+	    print(major, "=result        auto_skipped: ~ts", [Comment1]);
+       Type == user ->
+	    print(major, "=result        skipped: ~ts", [Comment1])
+    end,
+    if CaseNum == 0 ->
+	    print(2,"*** Skipping ~w ***", [{Mod,Func}]);
+       true ->
+	    print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}])
+    end,
+    TR = xhtml("
", [""]), + GroupName = case get_name(Mode) of + undefined -> ""; + Name -> cast_to_list(Name) + end, + print(html, + TR ++ "" + "" + "" + "" + "" + "" + "" + "\n", + [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]), + + if CaseNum > 0 -> + {US,AS} = get(test_server_skipped), + case Type of + user -> put(test_server_skipped, {US+1,AS}); + auto -> put(test_server_skipped, {US,AS+1}) + end, + put(test_server_case_num, CaseNum); + true -> % conf + ok + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> Cases1 +%% +%% SkipType = skip_case | auto_skip_case +%% Mark all cases tagged with Ref as skipped. + +skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> + {_,Modified,Rest} = + modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases), + Modified++Rest. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% copy_cases(OrigRef, NewRef, Cases) -> Cases1 +%% +%% Copy the test cases marked with OrigRef and tag the copies with NewRef. +%% The start conf case copy will also get its repeat property updated. + +copy_cases(OrigRef, NewRef, Cases) -> + {Original,Altered,Rest} = modify_cases_upto(OrigRef, {copy,NewRef}, Cases), + {Altered,Original++Altered++Rest}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% modify_cases_upto(Ref, ModOp, Cases) -> {Original,Altered,Remaining} +%% +%% ModOp = {skip,Reason,Origin,Mode} | {copy,NewRef} +%% Origin = conf | tc +%% +%% Modifies Cases according to ModOp and returns the original elements, +%% the modified versions of these elements and the remaining (untouched) +%% cases. + +modify_cases_upto(Ref, ModOp, Cases) -> + {Original,Altered,Rest} = modify_cases_upto(Ref, ModOp, Cases, [], []), + {lists:reverse(Original),lists:reverse(Altered),Rest}. + +%% first case of a copy operation is the start conf +modify_cases_upto(Ref, {copy,NewRef}=Op, [{conf,Ref,Props,MF}=C|T], Orig, Alt) -> + modify_cases_upto(Ref, Op, T, [C|Orig], [{conf,NewRef,update_repeat(Props),MF}|Alt]); + +modify_cases_upto(Ref, ModOp, Cases, Orig, Alt) -> + %% we need to check if there's an end conf case with the + %% same ref in the list, if not, this *is* an end conf case + case lists:any(fun({_,R,_,_}) when R == Ref -> true; + ({_,R,_}) when R == Ref -> true; + ({skip_case,{_,R,_,_},_}) when R == Ref -> true; + ({skip_case,{_,R,_,_}}) when R == Ref -> true; + (_) -> false + end, Cases) of + true -> + modify_cases_upto1(Ref, ModOp, Cases, Orig, Alt); + false -> + {[],[],Cases} + end. + +%% next case is a conf with same ref, must be end conf = we're done +modify_cases_upto1(Ref, {skip,Reason,conf,Mode,skip_case}, + [{conf,Ref,_Props,MF}|T], Orig, Alt) -> + {Orig,[{skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T}; +modify_cases_upto1(Ref, {skip,Reason,conf,Mode,auto_skip_case}, + [{conf,Ref,_Props,MF}|T], Orig, Alt) -> + {Orig,[{auto_skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T}; +modify_cases_upto1(Ref, {copy,NewRef}, [{conf,Ref,Props,MF}=C|T], Orig, Alt) -> + {[C|Orig],[{conf,NewRef,update_repeat(Props),MF}|Alt],T}; + +%% we've skipped all remaining cases in a sequence +modify_cases_upto1(Ref, {skip,_,tc,_,_}, + [{conf,Ref,_Props,_MF}|_]=Cs, Orig, Alt) -> + {Orig,Alt,Cs}; + +%% next is a make case +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, + [{make,Ref,MF}|T], Orig, Alt) -> + {Orig,[{SkipType,{make,Ref,MF,Reason},Mode}|Alt],T}; +modify_cases_upto1(Ref, {copy,NewRef}, [{make,Ref,MF}=M|T], Orig, Alt) -> + {[M|Orig],[{make,NewRef,MF}|Alt],T}; + +%% next case is a user skipped end conf with the same ref = we're done +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, + [{skip_case,{Type,Ref,MF,_Cmt},_}|T], Orig, Alt) -> + {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T}; +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, + [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) -> + {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T}; +modify_cases_upto1(Ref, {copy,NewRef}, + [{skip_case,{Type,Ref,MF,Cmt},Mode}=C|T], Orig, Alt) -> + {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt},Mode}|Alt],T}; +modify_cases_upto1(Ref, {copy,NewRef}, + [{skip_case,{Type,Ref,MF,Cmt}}=C|T], Orig, Alt) -> + {[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},_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,_,Mode,skip_case}=Op, + [{_M,_F}=MF|T], Orig, 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, [_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]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set_io_buffering(IOHandler) -> PrevIOHandler +%% +%% Save info about current process (always the main process) buffering +%% io printout messages from parallel test case processes (*and* possibly +%% also the main process). + +set_io_buffering(IOHandler) -> + put(test_server_common_io_handler, IOHandler). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_io_buffered() -> true|false +%% +%% Test whether is being buffered. + +is_io_buffered() -> + get(test_server_common_io_handler) =/= undefined. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% queue_test_case_io(Pid, Num, Mod, Func) -> ok +%% +%% Save info about test case that gets its io buffered. This can +%% be a parallel test case or it can be a test case (conf or normal) +%% that belongs to a group nested under a parallel group. The queue +%% is processed after io buffering is disabled. See run_test_cases_loop/4 +%% and handle_test_case_io_and_status/0 for more info. + +queue_test_case_io(Ref, Pid, Num, Mod, Func) -> + Entry = {Ref,Pid,Num,Mod,Func}, + %% the order of the test cases is very important! + put(test_server_queued_io, + get(test_server_queued_io)++[Entry]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% wait_for_cases(Ref) -> {Ok,Skipped,Failed} +%% +%% At the end of a nested parallel group, we have to wait for the test +%% cases to terminate before we can go on (since test cases never execute +%% in parallel with the end conf case of the group). When a top level +%% parallel group is finished, buffered io messages must be handled and +%% this is taken care of by handle_test_case_io_and_status/0. + +wait_for_cases(Ref) -> + case get(test_server_queued_io) of + [] -> + {[],[],[]}; + Cases -> + [_Start|TCs] = + lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false; + (_) -> true + end, Cases), + wait_and_resend(Ref, TCs, [],[],[]) + end. + +wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps], + Ok,Skip,Fail) when is_reference(OtherRef), + OtherRef /= Ref -> + %% ignore cases that belong to nested group + Ps1 = rm_cases_upto(OtherRef, Ps), + wait_and_resend(Ref, Ps1, Ok,Skip,Fail); + +wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> + receive + {finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg -> + %% resend message to main process so that it can be used + %% to test_server_io:print_buffered/1 later + self() ! Msg, + MF = {Mod,Func}, + {Ok1,Skip1,Fail1} = + case Result of + ok -> {[MF|Ok],Skip,Fail}; + skipped -> {Ok,[MF|Skip],Fail}; + failed -> {Ok,Skip,[MF|Fail]} + end, + wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1); + {'EXIT',CurrPid,Reason} when Reason /= normal -> + %% unexpected termination of test case process + {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases), + print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", + [CaseNum, Mod, Func, Reason]), + exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}}) + end; + +wait_and_resend(_, [], Ok,Skip,Fail) -> + {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}. + +rm_cases_upto(Ref, [{Ref,_,0,_,_}|Ps]) -> + Ps; +rm_cases_upto(Ref, [_|Ps]) -> + rm_cases_upto(Ref, Ps). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% handle_test_case_io_and_status() -> [Ok,Skipped,Failed} +%% +%% Each parallel test case process prints to its own minor log file during +%% execution. The common log files (major, html etc) must however be +%% written to sequentially. This is handled by calling +%% test_server_io:start_transaction/0 to tell the test_server_io process +%% to buffer all print requests. +%% +%% An io session is always started with a +%% {started,Ref,Pid,Num,Mod,Func} message (and +%% test_server_io:start_transaction/0 will be called) and terminated +%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and +%% test_server_io:end_transaction/0 will be called). The result +%% shipped with the finished message from a parallel process is used +%% to update status data of the current test run. An 'EXIT' message +%% from each parallel test case process (after finishing and +%% terminating) is also received and handled here. +%% +%% During execution of a parallel group, any cases (conf or normal) +%% belonging to a nested group will also get its io printouts buffered. +%% This is necessary to get the major and html log files written in +%% correct sequence. This function handles also the print messages +%% generated by nested group cases that have been executed sequentially +%% by the main process (note that these cases do not generate 'EXIT' +%% messages, only 'start' and 'finished' messages). +%% +%% See the header comment for run_test_cases_loop/4 for more +%% info about IO handling. +%% +%% Note: It is important that the type of messages handled here +%% do not get consumed by test_server:run_test_case_msgloop/5 +%% during the test case execution (e.g. in the catch clause of +%% the receive)! + +handle_test_case_io_and_status() -> + case get(test_server_queued_io) of + [] -> + {[],[],[]}; + Cases -> + %% Cases = [{Ref,Pid,CaseNum,Mod,Func} | ...] + Result = handle_io_and_exit_loop([], Cases, [],[],[]), + Main = self(), + %% flush normal exit messages + lists:foreach(fun({_,Pid,_,_,_}) when Pid /= Main -> + receive + {'EXIT',Pid,normal} -> ok + after + 1000 -> ok + end; + (_) -> + ok + end, Cases), + Result + end. + +%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = []) +handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> + %% retrieve the start message for the current io session (= testcase) + receive + {started,_,CurrPid,CaseNum,Mod,Func} -> + {Ok1,Skip1,Fail1} = + case handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases) of + {ok,MF} -> {[MF|Ok],Skip,Fail}; + {skipped,MF} -> {Ok,[MF|Skip],Fail}; + {failed,MF} -> {Ok,Skip,[MF|Fail]} + end, + handle_io_and_exit_loop([], Ps, Ok1,Skip1,Fail1) + after + 1000 -> + exit({testcase_failed_to_start,Mod,Func}) + end; + +%% Handle cases that belong to groups nested under top parallel group +handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> + receive + {started,_,CurrPid,CaseNum,Mod,Func} -> + handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases), + Refs1 = + case Refs of + [Ref|Rs] -> % must be end conf case for subgroup + Rs; + _ when is_reference(Ref) -> % must be start of new subgroup + [Ref|Refs]; + _ -> % must be normal subgroup testcase + Refs + end, + handle_io_and_exit_loop(Refs1, Ps, Ok,Skip,Fail) + after + 1000 -> + exit({testcase_failed_to_start,Mod,Func}) + end; + +handle_io_and_exit_loop(_, [], Ok,Skip,Fail) -> + {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}. + +handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> + receive + {abort_current_testcase=Tag,_Reason,From} -> + %% If a parallel group is executing, there is no unique + %% current test case, so we must generate an error. + From ! {self(),Tag,{error,parallel_group}}, + handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); + %% end of io session from test case executed by main process + {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} -> + test_server_io:print_buffered(CurrPid), + {Result,{Mod,Func}}; + %% end of io session from test case executed by parallel process + {finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} -> + test_server_io:print_buffered(CurrPid), + case Result of + ok -> + put(test_server_ok, get(test_server_ok)+1); + failed -> + put(test_server_failed, get(test_server_failed)+1); + skipped -> + SkipCounters = + update_skip_counters(RetVal, get(test_server_skipped)), + put(test_server_skipped, SkipCounters) + end, + {Result,{Mod,Func}}; + + %% unexpected termination of test case process + {'EXIT',TCPid,Reason} when Reason /= normal -> + test_server_io:print_buffered(CurrPid), + {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases), + print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", + [Num, M, F, Reason]), + exit({unexpected_termination,{Num,M,F},{TCPid,Reason}}) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_case(Ref, Num, Mod, Func, Args, RunInit, +%% TimetrapData, Mode) -> RetVal +%% +%% Creates the minor log file and inserts some test case specific headers +%% and footers into the log files. Then the test case is executed and the +%% result is printed to the log files (also info about lingering processes +%% & slave nodes in the system is presented). +%% +%% RunInit decides if the per test case init is to be run (true for all +%% but conf cases). +%% +%% Mode specifies if the test case should be executed by a dedicated, +%% parallel, process rather than sequentially by the main process. If +%% the former, the new process is spawned and the dictionary of the main +%% process is copied to the test case process. +%% +%% RetVal is the result of executing the test case. It contains info +%% about the execution time and the return value of the test case function. + +run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) -> + file:set_cwd(filename:dirname(get(test_server_dir))), + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, + TimetrapData, [], self()). + +run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) -> + %% a conf case is always executed by the main process + run_test_case1(Ref, Num, Mod, Func, Args, skip_init, + TimetrapData, Mode, self()); + +run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) -> + file:set_cwd(filename:dirname(get(test_server_dir))), + Main = self(), + case check_prop(parallel, Mode) of + false -> + %% this is a sequential test case + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, + TimetrapData, Mode, Main); + _Ref -> + %% this a parallel test case, spawn the new process + Dictionary = get(), + {dictionary,Dictionary} = process_info(self(), dictionary), + spawn_link( + fun() -> + process_flag(trap_exit, true), + [put(Key, Val) || {Key,Val} <- Dictionary], + set_io_buffering({tc,Main}), + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, + TimetrapData, Mode, Main) + end) + end. + +run_test_case1(Ref, Num, Mod, Func, Args, RunInit, + TimetrapData, Mode, Main) -> + group_leader(test_server_io:get_gl(Main == self()), self()), + + %% if io is being buffered, send start io session message + %% (no matter if case runs on parallel or main process) + case is_io_buffered() of + false -> ok; + true -> + test_server_io:start_transaction(), + Main ! {started,Ref,self(),Num,Mod,Func} + end, + TSDir = get(test_server_dir), + + print(major, "=case ~w:~w", [Mod, Func]), + MinorName = start_minor_log_file(Mod, Func, self() /= Main), + MinorBase = filename:basename(MinorName), + print(major, "=logfile ~ts", [filename:basename(MinorName)]), + + UpdatedArgs = + %% maybe create unique private directory for test case or config func + case get(test_server_create_priv_dir) of + auto_per_run -> + update_config(hd(Args), [{tc_logfile,MinorName}]); + PrivDirMode -> + %% create unique private directory for test case + RunDir = filename:dirname(MinorName), + Ext = + if Num == 0 -> + Int = erlang:unique_integer([positive,monotonic]), + lists:flatten(io_lib:format(".cfg.~w", [Int])); + true -> + lists:flatten(io_lib:format(".~w", [Num])) + end, + PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext, + if PrivDirMode == auto_per_tc -> + ok = file:make_dir(PrivDir); + PrivDirMode == manual_per_tc -> + ok + end, + 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,GrName}}, + MinorName}]), + + {ok,Cwd} = file:get_cwd(), + Args2Print = if is_list(UpdatedArgs) -> + lists:keydelete(tc_group_result, 1, UpdatedArgs); + true -> + UpdatedArgs + end, + if RunInit == skip_init -> + print_props(get_props(Mode)); + true -> + ok + end, + print(minor, "Config value:\n\n ~tp\n", [Args2Print]), + print(minor, "Current directory is ~tp\n", [Cwd]), + + GrNameStr = case GrName of + undefined -> ""; + Name -> cast_to_list(Name) + end, + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), + {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), + TR = xhtml("", [""]), + EncMinorBase = uri_encode(MinorBase), + print(html, TR ++ "" + "" + "" + "" + "", + [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], GrName, + RunInit, TimetrapData), + {Time,RetVal,Loc,Opts,Comment} = + case Result of + Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; + {died,DReason,DLoc,DCmt} -> {died,DReason,DLoc,[],DCmt} + end, + + print(minor, "", [], internal_raw), + print(minor, "\n", [], internal_raw), + print_timestamp(minor, "Ended at "), + print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), + + do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end), + + %% call the appropriate progress function clause to print the results to log + Status = + case {Time,RetVal} of + {died,{timetrap_timeout,TimetrapTimeout}} -> + progress(failed, Num, Mod, Func, GrName, Loc, + timetrap_timeout, TimetrapTimeout, Comment, Style); + {died,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, GrName, Loc, Reason, + Time, Comment, Style); + {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped -> + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {_,{'EXIT',_Pid,Reason}} -> + progress(failed, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {_,{'EXIT',Reason}} -> + progress(failed, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed -> + progress(failed, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {_,Reason={auto_skip,_Why}} -> + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {_,{Skip,Reason}} when Skip==skip; Skip==skipped -> + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {Time,RetVal} -> + case DetectedFail of + [] -> + progress(ok, Num, Mod, Func, GrName, Loc, RetVal, + Time, Comment, Style); + + Reason -> + progress(failed, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style) + end + end, + %% if the test case was executed sequentially, this updates the + %% status count on the main process (status of parallel test cases + %% is updated later by the handle_test_case_io_and_status/0 function) + case {RunInit,Status} of + {skip_init,_} -> % conf doesn't count + ok; + {_,ok} -> + put(test_server_ok, get(test_server_ok)+1); + {_,failed} -> + put(test_server_failed, get(test_server_failed)+1); + {_,skip} -> + {US,AS} = get(test_server_skipped), + put(test_server_skipped, {US+1,AS}); + {_,auto_skip} -> + {US,AS} = get(test_server_skipped), + put(test_server_skipped, {US,AS+1}) + end, + %% only if test case execution is sequential do we care about the + %% remaining processes and slave nodes count + case self() of + Main -> + case test_server_sup:framework_call(warn, [processes], true) of + true -> + if ProcsBefore < ProcsAfter -> + print(minor, + "WARNING: ~w more processes in system after test case", + [ProcsAfter-ProcsBefore]); + ProcsBefore > ProcsAfter -> + print(minor, + "WARNING: ~w less processes in system after test case", + [ProcsBefore-ProcsAfter]); + true -> ok + end; + false -> + ok + end, + case test_server_sup:framework_call(warn, [nodes], true) of + true -> + case catch controller_call(kill_slavenodes) of + {'EXIT',_} = Exit -> + print(minor, + "WARNING: There might be slavenodes left in the" + " system. I tried to kill them, but I failed: ~p\n", + [Exit]); + [] -> ok; + List -> + print(minor, "WARNING: ~w slave nodes in system after test"++ + "case. Tried to killed them.~n"++ + " Names:~p", + [length(List),List]) + end; + false -> + ok + end; + _ -> + ok + end, + %% if the test case was executed sequentially, this updates the execution + %% time count on the main process (adding execution time of parallel test + %% case groups is done in run_test_cases_loop/4) + if is_number(Time) -> + put(test_server_total_time, get(test_server_total_time)+Time); + true -> + ok + end, + test_server_sup:check_new_crash_dumps(), + + %% if io is being buffered, send finished message + %% (no matter if case runs on parallel or main process) + case is_io_buffered() of + false -> + ok; + true -> + test_server_io:end_transaction(), + Main ! {finished,Ref,self(),Num,Mod,Func, + ?mod_result(Status),{Time,RetVal,Opts}} + end, + {Time,RetVal,Opts}. + + +%%-------------------------------------------------------------------- +%% various help functions + +%% Call Action if we are running on the main process (not parallel). +do_unless_parallel(Main, Action) when is_function(Action, 0) -> + case self() of + Main -> Action(); + _ -> ok + end. + +num2str(0) -> ""; +num2str(N) -> integer_to_list(N). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time, +%% Comment, TimeFormat) -> Result +%% +%% Prints the result of the test case to log file. +%% 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, GrName, Loc, Reason, Time, + Comment, {St0,St1}) -> + {Reason1,{Color,Ret,ReportTag}} = + if_auto_skip(Reason, + fun() -> {?auto_skip_color,auto_skip,auto_skipped} end, + fun() -> {?user_skip_color,skip,skipped} end), + 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,GrName}, + {ReportTag,Reason1}}]), + ReasonStr = reason_to_string(Reason1), + ReasonStr1 = lists:flatten([string:strip(S,left) || + S <- string:tokens(ReasonStr,[$\n])]), + ReasonStr2 = + if length(ReasonStr1) > 80 -> + string:substr(ReasonStr1, 1, 77) ++ "..."; + true -> + ReasonStr1 + end, + Comment1 = case Comment of + "" -> ""; + _ -> xhtml("
(","
(") ++ to_string(Comment) ++ ")" + end, + print(html, + "" + "" + "\n", + [Time,Color,ReasonStr2,Comment1]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: ~ts", [ReasonStr1]), + Ret; + +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,GrName}, + {failed,timetrap_timeout}}]), + FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]), + Comment = + case Comment0 of + "" -> "" ++ ErrorReason ++ ""; + _ -> "" ++ ErrorReason ++ + xhtml("
","
") ++ to_string(Comment0) + end, + print(html, + "" + "" + "\n", + [T/1000,Comment]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: timetrap timeout", []), + failed; + +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,GrName}, + {failed,testcase_aborted}}]), + FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]), + Comment = + case Comment0 of + "" -> "" ++ ErrorReason ++ ""; + _ -> "" ++ ErrorReason ++ + xhtml("
","
") ++ to_string(Comment0) + end, + print(html, + "" + "" + "\n", + [Comment]), + FormatLoc = test_server_sup:format_loc(Loc), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]), + failed; + +progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, + Comment0, {St0,St1}) -> + print(major, "=result failed: ~p, ~w", [Reason,unknown_location]), + print(1, "*** FAILED ~ts ***", + [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, + {failed,Reason}}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), + ErrorReason = lists:flatten(io_lib:format("~p", [Reason])), + ErrorReason1 = lists:flatten([string:strip(S,left) || + S <- string:tokens(ErrorReason,[$\n])]), + ErrorReason2 = + if length(ErrorReason1) > 63 -> + string:substr(ErrorReason1, 1, 60) ++ "..."; + true -> + ErrorReason1 + end, + Comment = + case Comment0 of + "" -> "" ++ ErrorReason2 ++ ""; + _ -> "" ++ ErrorReason2 ++ + xhtml("
","
") ++ + to_string(Comment0) + end, + print(html, + "" + "" + "\n", + [TimeStr,Comment]), + print(minor, "=== Location: ~w", [unknown]), + {FStr,FormattedReason} = format_exception(Reason), + print(minor, "=== Reason: " ++ FStr, [FormattedReason]), + failed; + +progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, + Comment0, {St0,St1}) -> + {LocMaj,LocMin} = if Func == error_in_suite -> + case get_fw_mod(undefined) of + Mod -> {unknown_location,unknown}; + _ -> {Loc,Loc} + end; + true -> {Loc,Loc} + end, + print(major, "=result failed: ~p, ~p", [Reason,LocMaj]), + print(1, "*** FAILED ~ts ***", + [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), + test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, + {failed,Reason}}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), + Comment = + case Comment0 of + "" -> ""; + _ -> xhtml("
","
") ++ to_string(Comment0) + end, + FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)), + print(html, + "" + "" + "\n", + [TimeStr,FormatLastLoc,Comment]), + FormatLoc = test_server_sup:format_loc(LocMin), + print(minor, "=== Location: ~ts", [FormatLoc]), + {FStr,FormattedReason} = format_exception(Reason), + print(minor, "=== Reason: " ++ FStr, [FormattedReason]), + failed; + +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,GrName},ok}]), + Comment = + case RetVal of + {comment,RetComment} -> + String = to_string(RetComment), + HtmlCmt = test_server_sup:framework_call(format_comment, + [String], + String), + print(major, "=result ok: ~ts", [String]), + ""; + _ -> + print(major, "=result ok", []), + case Comment0 of + "" -> ""; + _ -> "" + end + end, + print(major, "=elapsed ~p", [Time]), + print(html, + "" + "" + "~ts\n", + [Time,Comment]), + print(minor, "=== Returned value: ~p", [RetVal]), + ok. + +%%-------------------------------------------------------------------- +%% various help functions + +get_fw_mod(Mod) -> + case get(test_server_framework) of + undefined -> + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW =:= false; FW =:= "undefined" -> + Mod; + FW -> + list_to_atom(FW) + end; + '$none' -> Mod; + FW -> FW + end. + +fw_name(?MODULE) -> + test_server; +fw_name(Mod) -> + case get(test_server_framework_name) of + undefined -> + case get_fw_mod(undefined) of + undefined -> + Mod; + Mod -> + case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of + FWName when FWName =:= false; FWName =:= "undefined" -> + Mod; + FWName -> + list_to_atom(FWName) + end; + _ -> + Mod + end; + '$none' -> + Mod; + FWName -> + case get_fw_mod(Mod) of + Mod -> FWName; + _ -> Mod + end + end. + +if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) -> + {Reason,True()}; +if_auto_skip({skip,Reason={failed,{_,init_per_testcase,_}}}, True, _False) -> + {Reason,True()}; +if_auto_skip({auto_skip,Reason}, True, _False) -> + {Reason,True()}; +if_auto_skip(Reason, _True, False) -> + {Reason,False()}. + +update_skip_counters({_T,Pat,_Opts}, {US,AS}) -> + {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end), + Result; +update_skip_counters(Pat, {US,AS}) -> + {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end), + Result. + +get_info_str(Mod,Func, 0, _Cases) -> + io_lib:format("~w", [{Mod,Func}]); +get_info_str(_Mod,_Func, CaseNum, unknown) -> + "test case " ++ integer_to_list(CaseNum); +get_info_str(_Mod,_Func, CaseNum, Cases) -> + "test case " ++ integer_to_list(CaseNum) ++ + " of " ++ integer_to_list(Cases). + +print_if_known(Known, {SK,AK}, {SU,AU}) -> + {S,A} = if Known == unknown -> {SU,AU}; + true -> {SK,AK} + end, + io_lib:format(S, A). + +to_string(Term) when is_list(Term) -> + case (catch io_lib:format("~ts", [Term])) of + {'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term])); + String -> lists:flatten(String) + end; +to_string(Term) -> + lists:flatten(io_lib:format("~p", [Term])). + +get_last_loc(Loc) when is_tuple(Loc) -> + Loc; +get_last_loc([Loc|_]) when is_tuple(Loc) -> + [Loc]; +get_last_loc(Loc) -> + Loc. + +reason_to_string({failed,{_,FailFunc,bad_return}}) -> + atom_to_list(FailFunc) ++ " bad return value"; +reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) -> + atom_to_list(FailFunc) ++ " timed out"; +reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) -> + to_string(FWInitFail); +reason_to_string({failed,{_,FailFunc,_}}) -> + atom_to_list(FailFunc) ++ " failed"; +reason_to_string(Other) -> + to_string(Other). + +%get_font_style(Prop) -> +% {Col,St0,St1} = get_font_style1(Prop), +% {{"",""}, +% {""++St0,St1++""}}. + +get_font_style(NormalCase, Mode) -> + Prop = if not NormalCase -> + default; + true -> + case check_prop(parallel, Mode) of + false -> + case check_prop(sequence, Mode) of + false -> + default; + _ -> + sequence + end; + _ -> + parallel + end + end, + {Col,St0,St1} = get_font_style1(Prop), + {{"",""}, + {""++St0,St1++""}}. + +get_font_style1(parallel) -> + {"\"darkslategray\"","",""}; +get_font_style1(sequence) -> +% {"\"darkolivegreen\"","",""}; + {"\"saddlebrown\"","",""}; +get_font_style1(default) -> + {"\"black\"","",""}. +%%get_font_style1(skipped) -> +%% {"\"lightgray\"","",""}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% format_exception({Error,Stack}) -> {CtrlSeq,Term} +%% +%% The default behaviour is that error information gets formatted +%% (like in the erlang shell) before printed to the minor log file. +%% The framework application can switch this feature off by setting +%% *its* application environment variable 'format_exception' to false. +%% It is also possible to switch formatting off by starting the +%% test_server node with init argument 'test_server_format_exception' +%% set to false. + +format_exception(Reason={_Error,Stack}) when is_list(Stack) -> + case get_fw_mod(undefined) of + undefined -> + case application:get_env(test_server, format_exception) of + {ok,false} -> + {"~p",Reason}; + _ -> + do_format_exception(Reason) + end; + FW -> + case application:get_env(FW, format_exception) of + {ok,false} -> + {"~p",Reason}; + _ -> + do_format_exception(Reason) + end + end; +format_exception(Error) -> + format_exception({Error,[]}). + +do_format_exception(Reason={Error,Stack}) -> + StackFun = fun(_, _, _) -> false end, + PF = fun(Term, I) -> + io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term]) + end, + case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of + {'EXIT',_} -> + {"~p",Reason}; + Formatted -> + Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]), + {"~ts",lists:flatten(Formatted1)} + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, +%% TimetrapData) -> +%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | +%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} +%% Name = atom() +%% Time = float() (seconds) +%% RetVal = term() +%% Loc = term() +%% Comment = string() +%% Reason = term() +%% DetectedFail = [{File,Line}] +%% ProcessesBefore = ProcessesAfter = integer() +%% + +run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, + TimetrapData) -> + test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, + TimetrapData}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% print(Detail, Format, Args) -> ok +%% Detail = integer() +%% Format = string() +%% Args = [term()] +%% +%% Just like io:format, except that depending on the Detail value, the output +%% is directed to console, major and/or minor log files. + +print(Detail, Format) -> + print(Detail, Format, []). + +print(Detail, Format, Args) -> + print(Detail, Format, Args, internal). + +print(Detail, Format, Args, Printer) -> + Msg = io_lib:format(Format, Args), + print_or_buffer(Detail, Msg, Printer). + +print_or_buffer(Detail, Msg, Printer) -> + test_server_gl:print(group_leader(), Detail, Msg, Printer). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% print_timestamp(Detail, Leader) -> ok +%% +%% Prints Leader followed by a time stamp (date and time). Depending on +%% the Detail value, the output is directed to console, major and/or minor +%% log files. + +print_timestamp(Detail, Leader) -> + print(Detail, timestamp_get(Leader), []). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% print_who(Host, User) -> ok +%% +%% Logs who runs the suite. + +print_who(Host, User) -> + UserStr = case User of + "" -> ""; + _ -> " by " ++ User + end, + print(html, "Run~ts on ~ts", [UserStr,Host]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% format(Format) -> IoLibReturn +%% format(Detail, Format) -> IoLibReturn +%% format(Format, Args) -> IoLibReturn +%% format(Detail, Format, Args) -> IoLibReturn +%% +%% Detail = integer() +%% Format = string() +%% Args = [term(),...] +%% IoLibReturn = term() +%% +%% Logs the Format string and Args, similar to io:format/1/2 etc. If +%% Detail is not specified, the default detail level (which is 50) is used. +%% Which log files the string will be logged in depends on the thresholds +%% set with set_levels/3. Typically with default detail level, only the +%% minor log file is used. + +format(Format) -> + format(minor, Format, []). + +format(major, Format) -> + format(major, Format, []); +format(minor, Format) -> + format(minor, Format, []); +format(Detail, Format) when is_integer(Detail) -> + format(Detail, Format, []); +format(Format, Args) -> + format(minor, Format, Args). + +format(Detail, Format, Args) -> + Str = + case catch io_lib:format(Format, Args) of + {'EXIT',_} -> + io_lib:format("illegal format; ~p with args ~p.\n", + [Format,Args]); + Valid -> Valid + end, + print_or_buffer(Detail, Str, self()). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml +%% +xhtml(HTML, XHTML) -> + case get(basic_html) of + true -> HTML; + _ -> XHTML + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% odd_or_even() -> "odd" | "even" +%% +odd_or_even() -> + case get(odd_or_even) of + even -> + put(odd_or_even, odd), + "even"; + _ -> + put(odd_or_even, even), + "odd" + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timestamp_filename_get(Leader) -> string() +%% Leader = string() +%% +%% Returns a string consisting of Leader concatenated with the current +%% date and time. The resulting string is suitable as a filename. +timestamp_filename_get(Leader) -> + timestamp_get_internal(Leader, + "~ts~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w"). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timestamp_get(Leader) -> string() +%% Leader = string() +%% +%% Returns a string consisting of Leader concatenated with the current +%% date and time. The resulting string is suitable for display. +timestamp_get(Leader) -> + timestamp_get_internal(Leader, + "~ts~w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w"). + +timestamp_get_internal(Leader, Format) -> + {YY,MM,DD,H,M,S} = time_get(), + io_lib:format(Format, [Leader,YY,MM,DD,H,M,S]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% time_get() -> {YY,MM,DD,H,M,S} +%% YY = integer() +%% MM = integer() +%% DD = integer() +%% H = integer() +%% M = integer() +%% S = integer() +%% +%% Returns the current Year,Month,Day,Hours,Minutes,Seconds. +%% The function checks that the date doesn't wrap while calling +%% getting the time. +time_get() -> + {YY,MM,DD} = date(), + {H,M,S} = time(), + case date() of + {YY,MM,DD} -> + {YY,MM,DD,H,M,S}; + _NewDay -> + %% date changed between call to date() and time(), try again + time_get() + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% make_config(Config) -> NewConfig +%% Config = [{Key,Value},...] +%% NewConfig = [{Key,Value},...] +%% +%% Creates a configuration list (currently returns it's input) + +make_config(Initial) -> + Initial. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% update_config(Config, Update) -> NewConfig +%% Config = [{Key,Value},...] +%% Update = [{Key,Value},...] | {Key,Value} +%% NewConfig = [{Key,Value},...] +%% +%% Adds or replaces the key-value pairs in config with those in update. +%% Returns the updated list. + +update_config(Config, {Key,Val}) -> + case lists:keymember(Key, 1, Config) of + true -> + lists:keyreplace(Key, 1, Config, {Key,Val}); + false -> + [{Key,Val}|Config] + end; +update_config(Config, [Assoc|Assocs]) -> + NewConfig = update_config(Config, Assoc), + update_config(NewConfig, Assocs); +update_config(Config, []) -> + Config. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% collect_cases(CurMod, TopCase, SkipList) -> +%% BasicCaseList | {error,Reason} +%% +%% CurMod = atom() +%% TopCase = term() +%% SkipList = [term(),...] +%% BasicCaseList = [term(),...] +%% +%% Parses the given test goal(s) in TopCase, and transforms them to a +%% simple list of test cases to call, when executing the test suite. +%% +%% CurMod is the "current" module, that is, the module the last instruction +%% was read from. May be be set to 'none' initially. +%% +%% SkipList is the list of test cases to skip and requirements to deny. +%% +%% The BasicCaseList is built out of TopCase, which may be any of the +%% following terms: +%% +%% [] Nothing is added +%% List list() The list is decomposed, and each element is +%% treated according to this table +%% Case atom() CurMod:Case(suite) is called +%% {module,Case} CurMod:Case(suite) is called +%% {Module,Case} Module:Case(suite) is called +%% {module,Module,Case} Module:Case(suite) is called +%% {module,Module,Case,Args} Module:Case is called with Args as arguments +%% {dir,Dir} All modules *_SUITE in the named directory +%% are listed, and each Module:all(suite) is called +%% {dir,Dir,Pattern} All modules _SUITE in the named dir +%% are listed, and each Module:all(suite) is called +%% {conf,InitMF,Cases,FinMF} +%% {conf,Props,InitMF,Cases,FinMF} +%% InitMF is placed in the BasicCaseList, then +%% Cases is treated according to this table, then +%% FinMF is placed in the BasicCaseList. InitMF +%% and FinMF are configuration manipulation +%% functions. See below. +%% {make,InitMFA,Cases,FinMFA} +%% InitMFA is placed in the BasicCaseList, then +%% Cases is treated according to this table, then +%% FinMFA is placed in the BasicCaseList. InitMFA +%% and FinMFA are make/unmake functions. If InitMFA +%% fails, Cases are not run. +%% +%% When a function is called, above, it means that the function is invoked +%% and the return is expected to be: +%% +%% [] Leaf case +%% {req,ReqList} Kept for backwards compatibility - same as [] +%% {req,ReqList,Cases} Kept for backwards compatibility - +%% Cases parsed recursively with collect_cases/3 +%% Cases (list) Recursively parsed with collect_cases/3 +%% +%% Leaf cases are added to the BasicCaseList as Module:Case(Config). Each +%% case is checked against the SkipList. If present, a skip instruction +%% is inserted instead, which only prints the case name and the reason +%% why the case was skipped in the log files. +%% +%% Configuration manipulation functions are called with the current +%% configuration list as only argument, and are expected to return a new +%% configuration list. Such a pair of function may, for example, start a +%% server and stop it after a serie of test cases. +%% +%% SkipCases is expected to be in the format: +%% +%% Other Recursively parsed with collect_cases/3 +%% {Mod,Comment} Skip Mod, with Comment +%% {Mod,Funcs,Comment} Skip listed functions in Mod with Comment +%% {Mod,Func,Comment} Skip named function in Mod with Comment +%% +-record(cc, {mod, % current module + skip}). % skip list + +collect_all_cases(Top, Skip) when is_list(Skip) -> + Result = + 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, Mode) -> + case collect_cases(Case, St0, Mode) of + {ok,FlatCases1,St1} -> + case collect_cases(Cs0, St1, Mode) of + {ok,FlatCases2,St} -> + {ok,FlatCases1 ++ FlatCases2,St}; + {error,_Reason} = Error -> Error + end; + {error,_Reason} = Error -> Error + end; + + +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, Mode) + end; +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, Mode) + end; +collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) -> + case init_props(Props) of + {error,_} -> + {ok,[],St}; + Props1 -> + Ref = make_ref(), + Skips = St#cc.skip, + Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)], + 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},Mode1} | + [] ++ [{conf,Ref,[],FinMF}]],St}; + {true,Name,Comment} when is_atom(Name) -> % all cases skipped + case collect_cases(CaseList, St, Mode1) of + {ok,[],_St} = Empty -> + Empty; + {ok,FlatCases,St1} -> + Cases2Skip = FlatCases ++ [{conf,Ref, + keep_name(Props1), + FinMF}], + Skipped = skip_cases_upto(Ref, Cases2Skip, Comment, + 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}, Mode1) of + {ok,[],_St} = Empty -> + Empty; + {ok,FlatCases,St1} -> + {ok,[{conf,Ref,Props1,InitMF} | + FlatCases ++ [{conf,Ref, + keep_name(Props1), + FinMF}]],St1#cc{skip=Skips}}; + {error,_Reason} = Error -> + Error + end; + false -> + case collect_cases(CaseList, St, Mode1) of + {ok,[],_St} = Empty -> + Empty; + {ok,FlatCases,St1} -> + {ok,[{conf,Ref,Props1,InitMF} | + FlatCases ++ [{conf,Ref, + keep_name(Props1), + FinMF}]],St1}; + {error,_Reason} = Error -> + Error + end + end + end; + +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(), + {ok,[{make,Ref,InitMFA}|FlatCases ++ + [{make,Ref,FinMFA}]],St}; + {error,_Reason} = Error -> Error + end; + +collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> + case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of + Result = {ok,_,_} -> + Result; + Other -> + {error,Other} + end; + +collect_cases({_Mod,_Case}=Spec, St, Mode) -> + collect_case(Spec, St, Mode); + +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, Mode) -> + collect_case_invoke(Mod, Conf, [], St, Mode); + +collect_case(MFA, St, Mode) -> + case in_skip_list(MFA, St#cc.skip) of + {true,Comment} when Comment /= make_failed -> + {ok,[{skip_case,{MFA,Comment},Mode}],St}; + _ -> + case MFA of + {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode); + {_Mod,_Case,_Args} -> {ok,[MFA],St} + end + end. + +collect_case([], St, Acc, _Mode) -> + {ok, Acc, St}; + +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, 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, Mode) + end; + _ -> + Suite = test_server_sup:framework_call(get_suite, + [Mod,Case], + []), + collect_subcases(Mod, Case, MFA, St, Suite, Mode) + end. + +collect_subcases(Mod, Case, MFA, St, Suite, Mode) -> + case Suite of + [] when Case == all -> {ok,[],St}; + [] when element(1, Case) == conf -> {ok,[],St}; + [] -> {ok,[MFA],St}; +%%%! --- START Kept for backwards compatibility --- +%%%! Requirements are not used + {req,ReqList} -> + collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode); + {req,ReqList,SubCases} -> + 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},Mode}],St}; + {error,Reason} -> + throw(Reason); + SubCases -> + collect_case_subcases(Mod, Case, SubCases, St, Mode) + end. + +collect_case_subcases(Mod, Case, SubCases, St0, Mode) -> + OldMod = St0#cc.mod, + 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, Mode) -> + {ok,Cwd} = file:get_cwd(), + Dir1 = filename:join(Cwd, Dir), + Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]), + case catch filelib:wildcard(Wc) of + {'EXIT', Reason} -> + io:format("Could not collect files: ~p~n", [Reason]), + {error,{collect_fail,Dir,Pattern}}; + Files -> + %% convert to module names and remove duplicates + Mods = lists:foldl(fun(File, Acc) -> + Mod = fullname_to_mod(File), + case lists:member(Mod, Acc) of + true -> Acc; + false -> [Mod | Acc] + end + end, [], Files), + Tests = [{Mod,all} || Mod <- lists:sort(Mods)], + collect_cases(Tests, St, Mode) + end. + +fullname_to_mod(Path) when is_list(Path) -> + %% If this is called with a binary, then we are probably in +fnu + %% mode and have found a beam file with name encoded as latin1. We + %% will let this crash since it can not work to load such a module + %% anyway. It should be removed or renamed! + list_to_atom(filename:rootname(filename:basename(Path))). + +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},Mode}],St}; + {granted,[]} -> + {ok,[MFA],St}; + {granted,SubCases} -> + collect_case_subcases(Mod, Case, SubCases, St, Mode) + end. + +check_deny([Req|Reqs], DenyList) -> + case check_deny_req(Req, DenyList) of + {denied,_Comment}=Denied -> Denied; + granted -> check_deny(Reqs, DenyList) + end; +check_deny([], _DenyList) -> granted; +check_deny(Req, DenyList) -> check_deny([Req], DenyList). + +check_deny_req({Req,Val}, DenyList) -> + %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]), + case lists:keysearch(Req, 1, DenyList) of + {value,{_Req,DenyVal}} when Val >= DenyVal -> + {denied,io_lib:format("Requirement ~p=~p", [Req,Val])}; + _ -> + check_deny_req(Req, DenyList) + end; +check_deny_req(Req, DenyList) -> + case lists:member(Req, DenyList) of + true -> {denied,io_lib:format("Requirement ~p", [Req])}; + false -> granted + end. + +in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) -> + case in_skip_list(InitMF, SkipList) of + {true,_} = Yes -> + Yes; + _ -> + case proplists:get_value(name, Props) of + undefined -> + false; + Name -> + ToSkip = + lists:flatmap( + fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when + M == Mod -> + case proplists:get_value(name, SProps) of + all -> + [{M,all,Cmt}]; + Name -> + case SCaseList of + all -> + [{M,all,Cmt}]; + _ -> + [{M,F,Cmt} || F <- SCaseList] + end; + _ -> + [] + end; + (_) -> + [] + end, SkipList), + case ToSkip of + [] -> + false; + _ -> + case lists:keysearch(all, 2, ToSkip) of + {value,{_,_,Cmt}} -> {true,Name,Cmt}; + _ -> {true,ToSkip,""} + end + end + end + end; + +in_skip_list({Mod,Func,_Args}, SkipList) -> + in_skip_list({Mod,Func}, SkipList); +in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) -> + case lists:member(Func, Funcs) of + true -> + {true,Comment}; + _ -> + in_skip_list({Mod,Func}, SkipList) + end; +in_skip_list({Mod,Func}, [{Mod,Func,Comment}|_SkipList]) -> + {true,Comment}; +in_skip_list({Mod,_Func}, [{Mod,Comment}|_SkipList]) -> + {true,Comment}; +in_skip_list({Mod,Func}, [_|SkipList]) -> + in_skip_list({Mod,Func}, SkipList); +in_skip_list(_, []) -> + false. + +%% remove unnecessary properties +init_props(Props) -> + case get_repeat(Props) of + Repeat = {_RepType,N} when N < 2 -> + if N == 0 -> + {error,{invalid_property,Repeat}}; + true -> + lists:delete(Repeat, Props) + end; + _ -> + Props + end. + +keep_name(Props) -> + lists:filter(fun({name,_}) -> true; + ({suite,_}) -> true; + (_) -> false end, Props). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Node handling functions %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% get_target_info() -> #target_info +%% +%% Returns a record containing system information for target + +get_target_info() -> + controller_call(get_target_info). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% start_node(SlaveName, Type, Options) -> +%% {ok, Slave} | {error, Reason} +%% +%% Called by test_server. See test_server:start_node/3 for details + +start_node(Name, Type, Options) -> + T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(), + format(minor, "Attempt to start ~w node ~p with options ~p", + [Type, Name, Options]), + case controller_call({start_node,Name,Type,Options}, T) of + {{ok,Nodename}, Host, Cmd, Info, Warning} -> + format(minor, + "Successfully started node ~w on ~tp with command: ~ts", + [Nodename, Host, Cmd]), + format(major, "=node_start ~w", [Nodename]), + case Info of + [] -> ok; + _ -> format(minor, Info) + end, + case Warning of + [] -> ok; + _ -> + format(1, Warning), + format(minor, Warning) + end, + {ok, Nodename}; + {fail,{Ret, Host, Cmd}} -> + format(minor, + "Failed to start node ~tp on ~tp with command: ~ts~n" + "Reason: ~p", + [Name, Host, Cmd, Ret]), + {fail,Ret}; + {Ret, undefined, undefined} -> + format(minor, "Failed to start node ~tp: ~p", [Name,Ret]), + Ret; + {Ret, Host, Cmd} -> + format(minor, + "Failed to start node ~tp on ~tp with command: ~ts~n" + "Reason: ~p", + [Name, Host, Cmd, Ret]), + Ret + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% wait_for_node(Node) -> ok | {error,timeout} +%% +%% Wait for a slave/peer node which has been started with +%% the option {wait,false}. This function returns when +%% when the new node has contacted test_server_ctrl again + +wait_for_node(Slave) -> + T = 10000 * test_server:timetrap_scale_factor(), + case catch controller_call({wait_for_node,Slave},T) of + {'EXIT',{timeout,_}} -> {error,timeout}; + ok -> ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_release_available(Release) -> true | false +%% Release -> string() +%% +%% Test if a release (such as "r10b") is available to be +%% started using start_node/3. + +is_release_available(Release) -> + controller_call({is_release_available,Release}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% stop_node(Name) -> ok | {error,Reason} +%% +%% Clean up - test_server will stop this node + +stop_node(Slave) -> + controller_call({stop_node,Slave}). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DEBUGGER INTERFACE %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +i() -> + hformat("Pid", "Initial Call", "Current Function", "Reducts", "Msgs"), + Line=lists:duplicate(27, "-"), + hformat(Line, Line, Line, Line, Line), + display_info(processes(), 0, 0). + +p(A,B,C) -> + pinfo(ts_pid(A,B,C)). +p(X) when is_atom(X) -> + pinfo(whereis(X)); +p({A,B,C}) -> + pinfo(ts_pid(A,B,C)); +p(X) -> + pinfo(X). + +t() -> + t(wall_clock). +t(X) -> + element(1, statistics(X)). + +pi(Item,X) -> + lists:keysearch(Item,1,p(X)). +pi(Item,A,B,C) -> + lists:keysearch(Item,1,p(A,B,C)). + +%% c:pid/3 +ts_pid(X,Y,Z) when is_integer(X), is_integer(Y), is_integer(Z) -> + list_to_pid("<" ++ integer_to_list(X) ++ "." ++ + integer_to_list(Y) ++ "." ++ + integer_to_list(Z) ++ ">"). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% display_info(Pids, Reductions, Messages) -> void +%% Pids = [pid(),...] +%% Reductions = integer() +%% Messaged = integer() +%% +%% Displays info, similar to c:i() about the processes in the list Pids. +%% Also counts the total number of reductions and msgs for the listed +%% processes, if called with Reductions = Messages = 0. + +display_info([Pid|T], R, M) -> + case pinfo(Pid) of + undefined -> + display_info(T, R, M); + Info -> + Call = fetch(initial_call, Info), + Curr = case fetch(current_function, Info) of + {Mod,F,Args} when is_list(Args) -> + {Mod,F,length(Args)}; + Other -> + Other + end, + Reds = fetch(reductions, Info), + LM = length(fetch(messages, Info)), + pformat(io_lib:format("~w", [Pid]), + io_lib:format("~w", [Call]), + io_lib:format("~w", [Curr]), Reds, LM), + display_info(T, R+Reds, M + LM) + end; +display_info([], R, M) -> + Line=lists:duplicate(27, "-"), + hformat(Line, Line, Line, Line, Line), + pformat("Total", "", "", R, M). + +hformat(A1, A2, A3, A4, A5) -> + io:format("~-10s ~-27s ~-27s ~8s ~4s~n", [A1,A2,A3,A4,A5]). + +pformat(A1, A2, A3, A4, A5) -> + io:format("~-10s ~-27s ~-27s ~8w ~4w~n", [A1,A2,A3,A4,A5]). + +fetch(Key, Info) -> + case lists:keysearch(Key, 1, Info) of + {value, {_, Val}} -> + Val; + _ -> + 0 + end. + +pinfo(P) -> + Node = node(), + case node(P) of + Node -> + process_info(P); + _ -> + rpc:call(node(P),erlang,process_info,[P]) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Support functions for COVER %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% A module is included in the cover analysis if +%% - it belongs to the tested application and is not listed in the +%% {exclude,List} part of the App.cover file +%% - it does not belong to the application, but is listed in the +%% {include,List} part of the App.cover file +%% - it does not belong to the application, but is listed in the +%% {cross,[{Tag,List}]} part of the App.cover file +%% +%% The modules listed in the 'cross' part of the cover file are +%% modules that are heavily used by other tests than the one where +%% they are explicitly tested. They should then be listed as 'cross' +%% in the cover file for the test where they are used but do not +%% belong. +%% +%% After all tests are completed, the these modules can be analysed +%% with coverage data from all tests where they are compiled - see +%% cross_cover_analyse/2. The result is stored in a file called +%% cross_cover.html in the run. directory of the +%% test the modules belong to. +%% +%% Example: +%% If the module m1 belongs to system s1 but is heavily used also in +%% the tests for another system s2, then the cover files for the two +%% systems could be like this: +%% +%% s1.cover: +%% {include,[m1]}. +%% +%% s2.cover: +%% {include,[....]}. % modules belonging to system s2 +%% {cross,[{s1,[m1]}]}. +%% +%% When the tests for both s1 and s2 are completed, run +%% cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]), and +%% the accumulated cover data for m1 will be written to +%% S1LogDir/[run./]cross_cover.html +%% +%% S1LogDir and S2LogDir are either the run. directories +%% for the two tests, or the parent directory of these, in which case +%% the latest run. directory will be chosen. +%% +%% Note that the m1 module will also be presented in the normal +%% coverage log for s1 (due to the include statement in s1.cover), but +%% that only includes the coverage achieved by the s1 test itself. +%% +%% The Tag in the 'cross' statement in the cover file has no other +%% purpose than mapping the list of modules ([m1] in the example +%% above) to the correct log directory where it should be included in +%% the cross_cover.html file (S1LogDir in the example above). +%% I.e. the value of the Tag has no meaning, it could be foo as well +%% as s1 above, as long as the same Tag is used in the cover file and +%% in the call to cross_cover_analyse/2. + + +%% Cover compilation +%% The compilation is executed on the target node +start_cover(#cover{}=CoverInfo) -> + cover_compile(CoverInfo); +start_cover({log,CoverLogDir}=CoverInfo) -> + %% Cover is controlled by the framework - here's the log + put(test_server_cover_log_dir,CoverLogDir), + {ok,CoverInfo}. + +cover_compile(CoverInfo) -> + test_server:cover_compile(CoverInfo). + +%% Read the coverfile for an application and return a list of modules +%% that are members of the application but shall not be compiled +%% (Exclude), and a list of modules that are not members of the +%% application but shall be compiled (Include). +read_cover_file(none) -> + {[],[],[]}; +read_cover_file(CoverFile) -> + case file:consult(CoverFile) of + {ok,List} -> + case check_cover_file(List, [], [], []) of + {ok,Exclude,Include,Cross} -> {Exclude,Include,Cross}; + error -> + io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]), + {[],[],[]} + end; + {error,Reason} -> + io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n", + [CoverFile,Reason]), + {[],[],[]} + end. + +check_cover_file([{exclude,all}|Rest], _, Include, Cross) -> + check_cover_file(Rest, all, Include, Cross); +check_cover_file([{exclude,Exclude}|Rest], _, Include, Cross) -> + case lists:all(fun(M) -> is_atom(M) end, Exclude) of + true -> + check_cover_file(Rest, Exclude, Include, Cross); + false -> + error + end; +check_cover_file([{include,Include}|Rest], Exclude, _, Cross) -> + case lists:all(fun(M) -> is_atom(M) end, Include) of + true -> + check_cover_file(Rest, Exclude, Include, Cross); + false -> + error + end; +check_cover_file([{cross,Cross}|Rest], Exclude, Include, _) -> + case check_cross(Cross) of + true -> + check_cover_file(Rest, Exclude, Include, Cross); + false -> + error + end; +check_cover_file([], Exclude, Include, Cross) -> + {ok,Exclude,Include,Cross}. + +check_cross([{Tag,Modules}|Rest]) -> + case lists:all(fun(M) -> is_atom(M) end, [Tag|Modules]) of + true -> + check_cross(Rest); + false -> + false + end; +check_cross([]) -> + true. + + +%% Cover analysis, per application +%% This analysis is executed on the target node once the test is +%% completed for an application. This is not the same as the cross +%% cover analysis, which can be executed on any node after the tests +%% are finshed. +%% +%% This per application analysis writes the file cover.html in the +%% application's run. directory. +stop_cover(#cover{}=CoverInfo, TestDir) -> + cover_analyse(CoverInfo, TestDir); +stop_cover(_CoverInfo, _TestDir) -> + %% Cover is probably controlled by the framework + ok. + +make_relative(AbsDir, VsDir) -> + DirTokens = filename:split(AbsDir), + VsTokens = filename:split(VsDir), + filename:join(make_relative1(DirTokens, VsTokens)). + +make_relative1([T | DirTs], [T | VsTs]) -> + make_relative1(DirTs, VsTs); +make_relative1(Last = [_File], []) -> + Last; +make_relative1(Last = [_File], VsTs) -> + Ups = ["../" || _ <- VsTs], + Ups ++ Last; +make_relative1(DirTs, []) -> + DirTs; +make_relative1(DirTs, VsTs) -> + Ups = ["../" || _ <- VsTs], + Ups ++ DirTs. + + +cover_analyse(CoverInfo, TestDir) -> + write_default_cross_coverlog(TestDir), + + {ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)), + write_coverlog_header(CoverLog), + #cover{app=App, + file=CoverFile, + excl=Excluded, + cross=Cross} = CoverInfo, + io:fwrite(CoverLog, "

Coverage for application '~w'

\n", [App]), + io:fwrite(CoverLog, + "

Coverdata collected over all tests

", + [?cross_coverlog_name]), + + io:fwrite(CoverLog, "

CoverFile: ~tp\n", [CoverFile]), + write_cross_cover_info(TestDir,Cross), + + case length(cover:imported_modules()) of + Imps when Imps > 0 -> + io:fwrite(CoverLog, + "

Analysis includes data from ~w imported module(s).\n", + [Imps]); + _ -> + ok + end, + + io:fwrite(CoverLog, "

Excluded module(s): ~tp\n", [Excluded]), + + Coverage = test_server:cover_analyse(TestDir, CoverInfo), + write_binary_file(filename:join(TestDir,?raw_coverlog_name), + term_to_binary(Coverage)), + + case lists:filter(fun({_M,{_,_,_}}) -> false; + (_) -> true + end, Coverage) of + [] -> + ok; + Bad -> + io:fwrite(CoverLog, "

Analysis failed for ~w module(s): " + "~w\n", + [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]]) + end, + + TotPercent = write_cover_result_table(CoverLog, Coverage), + write_binary_file(filename:join(TestDir, ?cover_total), + term_to_binary(TotPercent)). + +%% Cover analysis - accumulated over multiple tests +%% This can be executed on any node after all tests are finished. +%% Analyse = overview | details +%% TagDirs = [{Tag,Dir}] +%% Tag = atom(), identifier +%% Dir = string(), the log directory for Tag, it can be a +%% run. directory or the parent directory of +%% such (in which case the latest run. directory +%% is used) +cross_cover_analyse(Analyse, TagDirs0) -> + TagDirs = get_latest_run_dirs(TagDirs0), + TagMods = get_all_cross_info(TagDirs,[]), + TagDirMods = add_cross_modules(TagMods,TagDirs), + CoverdataFiles = get_coverdata_files(TagDirMods), + lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles), + io:fwrite("Cover analysing...\n", []), + DetailsFun = + case Analyse of + details -> + fun(Dir,M) -> + OutFile = filename:join(Dir, + atom_to_list(M) ++ + ".CROSS_COVER.html"), + case cover:analyse_to_file(M, OutFile, [html]) of + {ok,_} -> + {file,OutFile}; + Error -> + Error + end + end; + _ -> + fun(_,_) -> undefined end + end, + Coverage = analyse_tests(TagDirMods, DetailsFun, []), + cover:stop(), + write_cross_cover_logs(Coverage,TagDirMods). + +write_cross_cover_info(_Dir,[]) -> + ok; +write_cross_cover_info(Dir,Cross) -> + write_binary_file(filename:join(Dir,?cross_cover_info), + term_to_binary(Cross)). + +%% For each test from which there are cross cover analysed +%% modules, write a cross cover log (cross_cover.html). +write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) -> + case lists:keyfind(Tag,1,TagDirMods) of + {_,Dir,Mods} when Mods=/=[] -> + write_binary_file(filename:join(Dir,?raw_cross_coverlog_name), + term_to_binary(Coverage)), + CoverLogName = filename:join(Dir,?cross_coverlog_name), + {ok,CoverLog} = open_html_file(CoverLogName), + write_coverlog_header(CoverLog), + io:fwrite(CoverLog, + "

Coverage results for \'~w\' from all tests

\n", + [Tag]), + write_cover_result_table(CoverLog, Coverage), + io:fwrite("Written file ~tp\n", [CoverLogName]); + _ -> + ok + end, + write_cross_cover_logs(T,TagDirMods); +write_cross_cover_logs([],_) -> + io:fwrite("done\n", []). + +%% Get the latest run. directories +get_latest_run_dirs([{Tag,Dir}|Rest]) -> + [{Tag,get_latest_run_dir(Dir)} | get_latest_run_dirs(Rest)]; +get_latest_run_dirs([]) -> + []. + +get_latest_run_dir(Dir) -> + case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of + [] -> + Dir; + [H|T] -> + get_latest_dir(T,H) + end. + +get_latest_dir([H|T],Latest) when H>Latest -> + get_latest_dir(T,H); +get_latest_dir([_|T],Latest) -> + get_latest_dir(T,Latest); +get_latest_dir([],Latest) -> + Latest. + +get_all_cross_info([{_Tag,Dir}|Rest],Acc) -> + case file:read_file(filename:join(Dir,?cross_cover_info)) of + {ok,Bin} -> + TagMods = binary_to_term(Bin), + get_all_cross_info(Rest,TagMods++Acc); + _ -> + get_all_cross_info(Rest,Acc) + end; +get_all_cross_info([],Acc) -> + Acc. + +%% Associate the cross cover modules with their log directories +add_cross_modules(TagMods,TagDirs)-> + do_add_cross_modules(TagMods,[{Tag,Dir,[]} || {Tag,Dir} <- TagDirs]). +do_add_cross_modules([{Tag,Mods1}|TagMods],TagDirMods)-> + NewTagDirMods = + case lists:keytake(Tag,1,TagDirMods) of + {value,{Tag,Dir,Mods},Rest} -> + [{Tag,Dir,lists:umerge(lists:sort(Mods1),Mods)}|Rest]; + false -> + TagDirMods + end, + do_add_cross_modules(TagMods,NewTagDirMods); +do_add_cross_modules([],TagDirMods) -> + %% Just to get the modules in the same order as in the normal cover log + [{Tag,Dir,lists:reverse(Mods)} || {Tag,Dir,Mods} <- TagDirMods]. + +%% Find all exported coverdata files. +get_coverdata_files(TagDirMods) -> + lists:flatmap( + fun({_,LatestDir,_}) -> + filelib:wildcard(filename:join(LatestDir,"all.coverdata")) + end, + TagDirMods). + + +%% For each test, analyse all modules +%% Used for cross cover analysis. +analyse_tests([{Tag,LastTest,Modules}|T], DetailsFun, Acc) -> + Cov = analyse_modules(LastTest, Modules, DetailsFun, []), + analyse_tests(T, DetailsFun, [{Tag,Cov}|Acc]); +analyse_tests([], _DetailsFun, Acc) -> + Acc. + +%% Analyse each module +%% Used for cross cover analysis. +analyse_modules(Dir, [M|Modules], DetailsFun, Acc) -> + {ok,{M,{Cov,NotCov}}} = cover:analyse(M, module), + Acc1 = [{M,{Cov,NotCov,DetailsFun(Dir,M)}}|Acc], + analyse_modules(Dir, Modules, DetailsFun, Acc1); +analyse_modules(_Dir, [], _DetailsFun, Acc) -> + Acc. + + +%% Support functions for writing the cover logs (both cross and normal) +write_coverlog_header(CoverLog) -> + case catch io:put_chars(CoverLog,html_header("Coverage results")) of + {'EXIT',Reason} -> + io:format("\n\nERROR: Could not write normal heading in coverlog.\n" + "CoverLog: ~w\n" + "Reason: ~p\n", + [CoverLog,Reason]), + io:format(CoverLog,"\n", []); + _ -> + ok + end. + + +format_analyse(M,Cov,NotCov,undefined) -> + io_lib:fwrite("" + "" + "" + "\n", + [M,pc(Cov,NotCov),Cov,NotCov]); +format_analyse(M,Cov,NotCov,{file,File}) -> + io_lib:fwrite("" + "" + "" + "\n", + [uri_encode(filename:basename(File)), + M,pc(Cov,NotCov),Cov,NotCov]); +format_analyse(M,Cov,NotCov,{lines,Lines}) -> + CoverOutName = atom_to_list(M)++".COVER.html", + {ok,CoverOut} = open_html_file(CoverOutName), + write_not_covered(CoverOut,M,Lines), + ok = file:close(CoverOut), + io_lib:fwrite("" + "" + "" + "\n", + [uri_encode(CoverOutName),M,pc(Cov,NotCov),Cov,NotCov]); +format_analyse(M,Cov,NotCov,{error,_}) -> + io_lib:fwrite("" + "" + "" + "\n", + [M,pc(Cov,NotCov),Cov,NotCov]). + + +pc(0,0) -> + 0; +pc(Cov,NotCov) -> + round(Cov/(Cov+NotCov)*100). + + +write_not_covered(CoverOut,M,Lines) -> + io:put_chars(CoverOut,html_header("Coverage results for "++atom_to_list(M))), + io:fwrite(CoverOut, + "The following lines in module ~w are not covered:\n" + "
NumModuleGroupCaseLogTimeResultComment
" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "< >" ++ Col1 ++ "" ++ Col0 ++ "0.000s" ++ Col1 ++ "SKIPPED~ts
" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "~ts" ++ Col1 ++ "~w< >" ++ St0 ++ "~.3fs" ++ St1 ++ "SKIPPED~ts~ts
" ++ St0 ++ "~.3fs" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "died" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "~ts" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "~ts" ++ St1 ++ "FAILED~ts~ts
" ++ HtmlCmt ++ "" ++ to_string(Comment0) ++ "" ++ St0 ++ "~.3fs" ++ St1 ++ "Ok
~w~w %~w~w
~w~w %~w~w
~w~w %~w~w
~w~w %~w~w
\n" + "\n", + [M]), + lists:foreach(fun({{_M,Line},{0,1}}) -> + io:fwrite(CoverOut,"\n", [Line]); + (_) -> + ok + end, + Lines), + io:put_chars(CoverOut,"
Line Number
~w
\n\n\n"). + + +write_default_coverlog(TestDir) -> + {ok,CoverLog} = open_html_file(filename:join(TestDir,?coverlog_name)), + write_coverlog_header(CoverLog), + io:put_chars(CoverLog,"Cover tool is not used\n\n"), + ok = file:close(CoverLog). + +write_default_cross_coverlog(TestDir) -> + {ok,CrossCoverLog} = + open_html_file(filename:join(TestDir,?cross_coverlog_name)), + write_coverlog_header(CrossCoverLog), + io:put_chars(CrossCoverLog, + ["No cross cover modules exist for this application,", + xhtml("
","
"), + "or cross cover analysis is not completed.\n" + "\n"]), + ok = file:close(CrossCoverLog). + +write_cover_result_table(CoverLog,Coverage) -> + io:fwrite(CoverLog, + "

\n" + "" + "\n", + []), + {TotCov,TotNotCov} = + lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) -> + Str = format_analyse(M,Cov,NotCov,Details), + io:fwrite(CoverLog,"~ts", [Str]), + {AccCov+Cov,AccNotCov+NotCov}; + ({_M,{error,_Reason}},{AccCov,AccNotCov}) -> + {AccCov,AccNotCov} + end, + {0,0}, + Coverage), + TotPercent = pc(TotCov,TotNotCov), + io:fwrite(CoverLog, + "" + "\n" + "
ModuleCovered (%)Covered (Lines)Not covered (Lines)
Total~w %~w~w
\n" + "\n" + "\n", + [TotPercent,TotCov,TotNotCov]), + ok = file:close(CoverLog), + TotPercent. + + +%%%----------------------------------------------------------------- +%%% Support functions for writing files + +%% HTML files are always written with utf8 encoding +html_header(Title) -> + ["\n" + "\n" + "\n" + "\n" + "", Title, "\n" + "\n" + "\n" + "\n" + "\n"]. + +open_html_file(File) -> + open_utf8_file(File). + +open_html_file(File,Opts) -> + open_utf8_file(File,Opts). + +write_html_file(File,Content) -> + write_file(File,Content,utf8). + +%% The 'major' log file, which is a pure text file is also written +%% with utf8 encoding +open_utf8_file(File) -> + case file:open(File,AllOpts=[write,{encoding,utf8}]) of + {error,Reason} -> {error,{Reason,{File,AllOpts}}}; + Result -> Result + end. + +open_utf8_file(File,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) -> + file:write_file(File,Content); +write_file(File,Content,utf8) -> + write_binary_file(File,unicode:characters_to_binary(Content)). + +%% Write a file with only binary data +write_binary_file(File,Content) -> + file:write_file(File,Content). + +%% Encoding of hyperlinks in HTML files +uri_encode(File) -> + Encoding = file:native_name_encoding(), + uri_encode(File,Encoding). + +uri_encode(File,Encoding) -> + Components = filename:split(File), + filename:join([uri_encode_comp(C,Encoding) || C <- Components]). + +%% Encode the reference to a "filename of the given encoding" so it +%% can be inserted in a utf8 encoded HTML file. +%% This does almost the same as http_uri:encode/1, except +%% 1. it does not convert @, : and / (in order to preserve nodename and c:/) +%% 2. if the file name is in latin1, it also encodes all +%% characters >127 - i.e. latin1 but not ASCII. +uri_encode_comp([Char|Chars],Encoding) -> + Reserved = sets:is_element(Char, reserved()), + case (Char>127 andalso Encoding==latin1) orelse Reserved of + true -> + [ $% | http_util:integer_to_hexlist(Char)] ++ + uri_encode_comp(Chars,Encoding); + false -> + [Char | uri_encode_comp(Chars,Encoding)] + end; +uri_encode_comp([],_) -> + []. + +%% Copied from http_uri.erl, but slightly modified +%% (not converting @, : and /) +reserved() -> + sets:from_list([$;, $&, $=, $+, $,, $?, + $#, $[, $], $<, $>, $\", ${, $}, $|, + $\\, $', $^, $%, $ ]). + +encoding(File) -> + case epp:read_encoding(File) of + none -> + epp:default_encoding(); + E -> + E + end. diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl new file mode 100644 index 0000000000..31098d9726 --- /dev/null +++ b/lib/common_test/src/test_server_gl.erl @@ -0,0 +1,301 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% This module implements group leader processes for test cases. +%% Each group leader process handles output to the minor log file for +%% a test case, and calls test_server_io to handle output to the common +%% log files. The group leader processes are created and destroyed +%% through the test_server_io module/process. + +-module(test_server_gl). +-export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1, + get_tc_supervisor/1,print/4,set_props/2]). + +-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). + +-record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor + tc :: mfa() | 'undefined', %Current test case MFA + minor :: 'none'|pid(), %Minor fd + minor_monitor, %Monitor ref for minor fd + capture :: 'none'|pid(), %Capture output + reject_io :: boolean(), %Reject I/O requests... + permit_io, %... and exceptions + auto_nl=true :: boolean(), %Automatically add NL + levels %{Stdout,Major,Minor} + }). + +%% start_link() +%% Start a new group leader process. Only to be called by +%% the test_server_io process. + +start_link() -> + case gen_server:start_link(?MODULE, [], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end. + + +%% stop(Pid) +%% Stop a group leader process. Only to be called by +%% the test_server_io process. + +stop(GL) -> + gen_server:cast(GL, stop). + + +%% set_minor_fd(GL, Fd, MFA) +%% GL = Pid for the group leader process +%% Fd = file descriptor for the minor log file +%% MFA = {M,F,A} for the test case owning the minor log file +%% +%% Register the file descriptor for the minor log file. Subsequent +%% IO directed to the minor log file will be written to this file. +%% Also register the currently executing process at the testcase +%% supervisor corresponding to this group leader process. + +set_minor_fd(GL, Fd, MFA) -> + req(GL, {set_minor_fd,Fd,MFA,self()}). + + +%% unset_minor_fd(GL, Fd, MFA) +%% GL = Pid for the group leader process +%% +%% Unregister the file descriptor for minor log file (typically +%% because the test case has ended the minor log file is about +%% to be closed). Subsequent IO (for example, by a process spawned +%% by the testcase process) will go to the unexpected_io log file. + +unset_minor_fd(GL) -> + req(GL, unset_minor_fd). + + +%% get_tc_supervisor(GL) +%% GL = Pid for the group leader process +%% +%% Return the Pid for the process that supervises the test case +%% that has this group leader. + +get_tc_supervisor(GL) -> + req(GL, get_tc_supervisor). + + +%% print(GL, Detail, Format, Args) -> ok +%% GL = Pid for the group leader process +%% Detail = integer() | minor | major | html | stdout +%% Msg = iodata() +%% Printer = internal | pid() +%% +%% Print a message to one of the log files. If Detail is an integer, +%% it will be compared to the levels (set by set_props/2) to +%% determine which log file(s) that are to receive the output. If +%% Detail is an atom, the value of the atom will directly determine +%% which log file to use. IO to the minor log file will be handled +%% directly by this group leader process (printing to the file set by +%% set_minor_fd/3), and all other IO will be handled by calling +%% test_server_io:print/3. + +print(GL, Detail, Msg, Printer) -> + req(GL, {print,Detail,Msg,Printer}). + + +%% set_props(GL, [PropertyTuple]) +%% GL = Pid for the group leader process +%% PropertyTuple = {levels,{Show,Major,Minor}} | +%% {auto_nl,boolean()} | +%% {reject_io_reqs,boolean()} +%% +%% Set properties for this group leader process. + +set_props(GL, PropList) -> + req(GL, {set_props,PropList}). + +%%% Internal functions. + +init([]) -> + {ok,#st{tc_supervisor=none, + minor=none, + minor_monitor=none, + capture=none, + reject_io=false, + permit_io=gb_sets:empty(), + auto_nl=true, + levels={1,19,10} + }}. + +req(GL, Req) -> + gen_server:call(GL, Req, infinity). + +handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) -> + {reply,Pid,St}; +handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) -> + Ref = erlang:monitor(process, Fd), + {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref, + tc_supervisor=Supervisor}}; +handle_call(unset_minor_fd, _From, St) -> + {reply,ok,St#st{minor=none,tc_supervisor=none}}; +handle_call({set_props,PropList}, _From, St) -> + {reply,ok,do_set_props(PropList, St)}; +handle_call({print,Detail,Msg,Printer}, {From,_}, St) -> + output(Detail, Msg, Printer, From, St), + {reply,ok,St}. + +handle_cast(stop, St) -> + {stop,normal,St}. + +handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) -> + case Reason of + normal -> ok; + _ -> + Data = io_lib:format("=== WARNING === TC: ~w\n" + "Got down from minor Fd ~w: ~w\n\n", + [St#st.tc,St#st.minor,D]), + test_server_io:print_unexpected(Data) + end, + {noreply,St#st{minor=none,minor_monitor=none}}; +handle_info({permit_io,Pid}, #st{permit_io=P}=St) -> + {noreply,St#st{permit_io=gb_sets:add(Pid, P)}}; +handle_info({capture,Cap0}, St) -> + Cap = case Cap0 of + false -> none; + Pid when is_pid(Cap0) -> Pid + end, + {noreply,St#st{capture=Cap}}; +handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> + try io_req(Req, From, St) of + passthrough -> + group_leader() ! IoReq; + Data -> + case is_io_permitted(From, St) of + false -> + ok; + true -> + case St of + #st{capture=none} -> + ok; + #st{capture=CapturePid} -> + CapturePid ! {captured,Data} + end, + output(minor, Data, From, From, St) + end, + From ! {io_reply,ReplyAs,ok} + catch + _:_ -> + From ! {io_reply,ReplyAs,{error,arguments}} + end, + {noreply,St}; +handle_info({structured_io,ClientPid,{Detail,Str}}, St) -> + output(Detail, Str, ClientPid, ClientPid, St), + {noreply,St}; +handle_info({printout,Detail,Format,Args}, St) -> + Str = io_lib:format(Format, Args), + output(Detail, Str, internal, none, St), + {noreply,St}; +handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) -> + %% The process overseeing the testcase process also used to be + %% the group leader; thus, it is widely expected that it can be + %% reached by sending a message to the group leader. Therefore + %% we'll need to forward any non-recognized messaged to the test + %% case supervisor. + Pid ! Msg, + {noreply,St}; +handle_info(_Msg, #st{}=St) -> + %% There is no known supervisor process. Ignore this message. + {noreply,St}. + +terminate(_, _) -> + ok. + +do_set_props([{levels,Levels}|Ps], St) -> + do_set_props(Ps, St#st{levels=Levels}); +do_set_props([{auto_nl,AutoNL}|Ps], St) -> + do_set_props(Ps, St#st{auto_nl=AutoNL}); +do_set_props([{reject_io_reqs,Bool}|Ps], St) -> + do_set_props(Ps, St#st{reject_io=Bool}); +do_set_props([], St) -> St. + +io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode -> + unicode:characters_to_list(Bytes, Enc); +io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) -> + Str = Mod:Func(Format, Args), + unicode:characters_to_list(Str, Encoding); +io_req(_, _, _) -> passthrough. + +output(Level, Str, Sender, From, St) when is_integer(Level) -> + case selected_by_level(Level, stdout, St) of + true -> output(stdout, Str, Sender, From, St); + false -> ok + end, + case selected_by_level(Level, major, St) of + true -> output(major, Str, Sender, From, St); + false -> ok + end, + case selected_by_level(Level, minor, St) of + true -> output(minor, Str, Sender, From, St); + false -> ok + end; +output(stdout, Str, _Sender, From, St) -> + output_to_file(stdout, Str, From, St); +output(html, Str, _Sender, From, St) -> + output_to_file(html, Str, From, St); +output(Level, Str, Sender, From, St) when is_atom(Level) -> + output_to_file(Level, dress_output(Str, Sender, St), From, St). + +output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) -> + Data = [io_lib:format("=== ~w:~w/~w\n", [M,F,A]),Data0], + test_server_io:print(From, unexpected_io, Data), + ok; +output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) -> + try + io:put_chars(Fd, Data) + catch + Type:Reason -> + Data1 = + [io_lib:format("=== ERROR === TC: ~w\n" + "Failed to write to minor Fd: ~w\n" + "Type: ~w\n" + "Reason: ~w\n", + [TC,Fd,Type,Reason]), + Data,"\n"], + test_server_io:print(From, unexpected_io, Data1) + end; +output_to_file(Detail, Data, From, _) -> + test_server_io:print(From, Detail, Data). + +is_io_permitted(From, #st{reject_io=true,permit_io=P}) -> + gb_sets:is_member(From, P); +is_io_permitted(_, #st{reject_io=false}) -> true. + +selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) -> + Level =< Stdout; +selected_by_level(Level, major, #st{levels={_,Major,_}}) -> + Level =< Major; +selected_by_level(Level, minor, #st{levels={_,_,Minor}}) -> + Level >= Minor. + +dress_output([$=|_]=Str, internal, _) -> + [Str,$\n]; +dress_output(Str, internal, _) -> + ["=== ",Str,$\n]; +dress_output(Str, _, #st{auto_nl=AutoNL}) -> + case AutoNL of + true -> [Str,$\n]; + false -> Str + end. diff --git a/lib/common_test/src/test_server_internal.hrl b/lib/common_test/src/test_server_internal.hrl new file mode 100644 index 0000000000..578f359010 --- /dev/null +++ b/lib/common_test/src/test_server_internal.hrl @@ -0,0 +1,61 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-define(priv_dir,"log_private"). +-define(MAIN_PORT,3289). +-define(ACCEPT_TIMEOUT,20000). + +%% Target information generated by test_server:init_target_info/0 +%% Once initiated, this information will never change!! +-record(target_info, {os_family, % atom(); win32 | unix + os_type, % result of os:type() + host, % string(); the name of the target machine + version, % string() + system_version, % string() + root_dir, % string() + test_server_dir, % string() + emulator, % string() + otp_release, % string() + username, % string() + cookie, % string(); Cookie for target node + naming, % string(); "-name" | "-sname" + master}). % string(); Was used for OSE's master + % node for main target and slave nodes. + % For other platforms the target node + % itself is master for slave nodes + +%% Temporary information generated by test_server_ctrl:read_parameters/X +%% This information is used when starting the main target, and for +%% initiating the #target_info record. +-record(par, {type, + target, + naming, + master, + cookie}). + + +-record(cover, {app, % application; Name | none + file, % cover spec file + incl, % explicitly include modules + excl, % explicitly exclude modules + level, % analyse level; details | overview + mods, % actually cover compiled modules + stop=true, % stop cover after analyse; boolean() + cross}).% cross cover analyse info diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl new file mode 100644 index 0000000000..0d881d0ada --- /dev/null +++ b/lib/common_test/src/test_server_io.erl @@ -0,0 +1,452 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% This module implements a process with the registered name 'test_server_io', +%% which has two main responsibilities: +%% +%% * Manage group leader processes (see the test_server_gl module) +%% for test cases. A group_leader process is obtained by calling +%% get_gl/1. Group leader processes will be kept alive as along as +%% the 'test_server_io' process is alive. +%% +%% * Handle output to the common log files (stdout, major, html, +%% unexpected_io). +%% + +-module(test_server_io). +-export([start_link/0,stop/1,get_gl/1,set_fd/2, + start_transaction/0,end_transaction/0, + print_buffered/1,print/3,print_unexpected/1, + set_footer/1,set_job_name/1,set_gl_props/1, + reset_state/0,finish/0]). + +-export([init/1,handle_call/3,handle_info/2,terminate/2]). + +-record(st, {fds, % Singleton fds (gb_tree) + tags=[], % Known tag types + shared_gl :: pid(), % Shared group leader + gls, % Group leaders (gb_set) + io_buffering=false, % I/O buffering + buffered, % Buffered I/O requests + html_footer, % HTML footer + job_name, % Name of current job. + gl_props, % Properties for GL + phase, % Indicates current mode + offline_buffer, % Buffer I/O during startup + stopping, % Reply to when process stopped + pending_ops % Perform when process idle + }). + +start_link() -> + case whereis(?MODULE) of + undefined -> + case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end; + Pid -> + %% already running, reset the state + reset_state(), + {ok,Pid} + end. + +stop(FilesToClose) -> + OldGL = group_leader(), + group_leader(self(), self()), + req({stop,FilesToClose}), + group_leader(OldGL, self()), + ok. + +finish() -> + req(finish). + +%% get_gl(Shared) -> Pid +%% Shared = boolean() +%% Pid = pid() +%% +%% Return a group leader (a process using the test_server_gl module). +%% If Shared is true, the shared group leader is returned (suitable for +%% running sequential test cases), otherwise a new group leader process +%% is spawned. Group leader processes will live until the +%% 'test_server_io' process is stopped. + +get_gl(Shared) when is_boolean(Shared) -> + req({get_gl,Shared}). + +%% set_fd(Tag, Fd) -> ok. +%% Tag = major | html | unexpected_io +%% Fd = a file descriptor (as returned by file:open/2) +%% +%% Associate a file descriptor with the given Tag. This +%% Tag can later be used in when calling to print/3. + +set_fd(Tag, Fd) -> + req({set_fd,Tag,Fd}). + +%% start_transaction() +%% +%% Subsequent calls to print/3 from the process executing start_transaction/0 +%% will cause the messages to be buffered instead of printed directly. + +start_transaction() -> + req({start_transaction,self()}). + +%% end_transaction() +%% +%% End the transaction started by start_transaction/0. Subsequent calls to +%% print/3 will cause the message to be printed directly. + +end_transaction() -> + req({end_transaction,self()}). + +%% print(From, Tag, Msg) +%% From = pid() +%% Tag = stdout, or any tag that has been registered using set_fd/2 +%% Msg = string or iolist +%% +%% Either print Msg to the file identified by Tag, or buffer the message +%% start_transaction/0 has been called from the process From. +%% +%% NOTE: The tags have various special meanings. For example, 'html' +%% is assumed to be a HTML file. + +print(From, Tag, Msg) -> + req({print,From,Tag,Msg}). + +%% print_buffered(Pid) +%% Pid = pid() +%% +%% Print all messages buffered in the *first* transaction buffered for Pid. +%% (If start_transaction/0 and end_transaction/0 has been called N times, +%% print_buffered/1 must be called N times to print all transactions.) + +print_buffered(Pid) -> + req({print_buffered,Pid}). + +%% print_unexpected(Msg) +%% Msg = string or iolist +%% +%% Print the given string in the unexpected_io log. + +print_unexpected(Msg) -> + print(xxxFrom,unexpected_io,Msg). + +%% set_footer(IoData) +%% +%% Set a footer for the file associated with the 'html' tag. +%% It will be used by print/3 to print a footer for the HTML file. + +set_footer(Footer) -> + req({set_footer,Footer}). + +%% set_job_name(Name) +%% +%% Set a name for the currently running job. The name will be used +%% when printing to 'stdout'. +%% + +set_job_name(Name) -> + req({set_job_name,Name}). + +%% set_gl_props(PropList) +%% +%% Set properties for group leader processes. When a group_leader process +%% is created, test_server_gl:set_props(PropList) will be called. + +set_gl_props(PropList) -> + req({set_gl_props,PropList}). + +%% reset_state +%% +%% Reset the initial state +reset_state() -> + req(reset_state). + +%%% Internal functions. + +init([]) -> + process_flag(trap_exit, true), + Empty = gb_trees:empty(), + {ok,Shared} = test_server_gl:start_link(), + {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), + io_buffering=gb_sets:empty(), + buffered=Empty, + html_footer="\n\n", + job_name="", + gl_props=[], + phase=starting, + offline_buffer=[], + pending_ops=[]}}. + +req(Req) -> + gen_server:call(?MODULE, Req, infinity). + +handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) -> + {ok,Pid} = test_server_gl:start_link(), + test_server_gl:set_props(Pid, Props), + {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}}; +handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) -> + {reply,Shared,St}; +handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0,tags=Tags0, + offline_buffer=OfflineBuff}=St) -> + Fds = gb_trees:enter(Tag, Fd, Fds0), + St1 = St#st{fds=Fds,tags=[Tag|lists:delete(Tag, Tags0)]}, + OfflineBuff1 = + if OfflineBuff == [] -> + []; + true -> + %% Fd ready, print anything buffered for associated Tag + lists:filtermap(fun({T,From,Str}) when T == Tag -> + output(From, Tag, Str, St1), + false; + (_) -> + true + end, lists:reverse(OfflineBuff)) + end, + {reply,ok,St1#st{phase=started, + offline_buffer=lists:reverse(OfflineBuff1)}}; +handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0, + buffered=Buf0}=St) -> + Buf = case gb_trees:is_defined(Pid, Buf0) of + false -> gb_trees:insert(Pid, queue:new(), Buf0); + true -> Buf0 + end, + Buffer = gb_sets:add(Pid, Buffer0), + {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}}; +handle_call({print,From,Tag,Str}, _From, St0) -> + St = output(From, Tag, Str, St0), + {reply,ok,St}; +handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0, + buffered=Buffered0}=St0) -> + Q0 = gb_trees:get(Pid, Buffered0), + Q = queue:in(eot, Q0), + Buffered = gb_trees:update(Pid, Q, Buffered0), + Buffer = gb_sets:delete_any(Pid, Buffer0), + St = St0#st{io_buffering=Buffer,buffered=Buffered}, + {reply,ok,St}; +handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) -> + Q0 = gb_trees:get(Pid, Buffered0), + Q = do_print_buffered(Q0, St0), + Buffered = gb_trees:update(Pid, Q, Buffered0), + St = St0#st{buffered=Buffered}, + {reply,ok,St}; +handle_call({set_footer,Footer}, _From, St) -> + {reply,ok,St#st{html_footer=Footer}}; +handle_call({set_job_name,Name}, _From, St) -> + {reply,ok,St#st{job_name=Name}}; +handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) -> + test_server_gl:set_props(Shared, Props), + {reply,ok,St#st{gl_props=Props}}; +handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) -> + %% can't reset during stopping phase, save op for later + Op = fun(NewSt) -> + {_,Result,NewSt1} = handle_call(reset_state, From, NewSt), + {Result,NewSt1} + end, + {noreply,St#st{pending_ops=[{From,Op}|Ops]}}; +handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, + offline_buffer=OfflineBuff}) -> + %% close open log files + lists:foreach(fun(Tag) -> + case gb_trees:lookup(Tag, Fds) of + none -> + ok; + {value,Fd} -> + file:close(Fd) + end + end, Tags), + GlList = gb_sets:to_list(Gls), + [test_server_gl:stop(GL) || GL <- GlList], + timer:sleep(100), + case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlList) of + [] -> + ok; + _ -> + timer:sleep(2000), + [exit(GL, kill) || GL <- GlList] + end, + Empty = gb_trees:empty(), + {ok,Shared} = test_server_gl:start_link(), + {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), + io_buffering=gb_sets:empty(), + buffered=Empty, + html_footer="\n\n", + job_name="", + gl_props=[], + phase=starting, + offline_buffer=OfflineBuff, + pending_ops=[]}}; +handle_call({stop,FdTags}, From, #st{fds=Fds0,tags=Tags0, + shared_gl=SGL,gls=Gls0}=St0) -> + St = St0#st{gls=gb_sets:insert(SGL, Gls0),phase=stopping,stopping=From}, + gc(St), + %% close open log files + {Fds1,Tags1} = lists:foldl(fun(Tag, {Fds,Tags}) -> + case gb_trees:lookup(Tag, Fds) of + none -> + {Fds,Tags}; + {value,Fd} -> + file:close(Fd), + {gb_trees:delete(Tag, Fds), + lists:delete(Tag, Tags)} + end + end, {Fds0,Tags0}, FdTags), + %% Give the users of the surviving group leaders some + %% time to finish. + erlang:send_after(1000, self(), stop_group_leaders), + {noreply,St#st{fds=Fds1,tags=Tags1}}; +handle_call(finish, From, St) -> + gen_server:reply(From, ok), + {stop,normal,St}. + +handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> + Gls = gb_sets:delete_any(Pid, Gls0), + case gb_sets:is_empty(Gls) andalso stopping =/= undefined of + true -> + %% No more group leaders left. + gen_server:reply(From, ok), + {noreply,St#st{gls=Gls,phase=stopping,stopping=undefined}}; + false -> + %% Wait for more group leaders to finish. + {noreply,St#st{gls=Gls,phase=stopping}} + end; +handle_info({'EXIT',_Pid,Reason}, _St) -> + exit(Reason); +handle_info(stop_group_leaders, #st{gls=Gls}=St) -> + %% Stop the remaining group leaders. + GlPids = gb_sets:to_list(Gls), + [test_server_gl:stop(GL) || GL <- GlPids], + timer:sleep(100), + Wait = + case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlPids) of + [] -> 0; + _ -> 2000 + end, + erlang:send_after(Wait, self(), kill_group_leaders), + {noreply,St}; +handle_info(kill_group_leaders, #st{gls=Gls,stopping=From, + pending_ops=Ops}=St) -> + [exit(GL, kill) || GL <- gb_sets:to_list(Gls)], + if From /= undefined -> + gen_server:reply(From, ok); + true -> % reply has been sent already + ok + end, + %% we're idle, check if any ops are pending + St1 = lists:foldr(fun({ReplyTo,Op},NewSt) -> + {Result,NewSt1} = Op(NewSt), + gen_server:reply(ReplyTo, Result), + NewSt1 + end, St#st{phase=idle,pending_ops=[]}, Ops), + {noreply,St1}; +handle_info(Other, St) -> + io:format("Ignoring: ~p\n", [Other]), + {noreply,St}. + +terminate(_, _) -> + ok. + +output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0, + phase=Phase,offline_buffer=OfflineBuff}=St) -> + case gb_sets:is_member(From, Buffered) of + false -> + case do_output(Tag, Str, Phase, St) of + buffer when length(OfflineBuff)>500 -> + %% something's wrong, clear buffer + St#st{offline_buffer=[]}; + buffer -> + St#st{offline_buffer=[{Tag,From,Str}|OfflineBuff]}; + _ -> + St + end; + true -> + Q0 = gb_trees:get(From, Buf0), + Q = queue:in({Tag,Str}, Q0), + Buf = gb_trees:update(From, Q, Buf0), + St#st{buffered=Buf} + end. + +do_output(stdout, Str, _, #st{job_name=undefined}) -> + io:put_chars(Str); +do_output(stdout, Str0, _, #st{job_name=Name}) -> + Str = io_lib:format("Testing ~ts: ~ts\n", [Name,Str0]), + io:put_chars(Str); +do_output(Tag, Str, Phase, #st{fds=Fds}=St) -> + case gb_trees:lookup(Tag, Fds) of + none when Phase /= started -> + buffer; + none -> + S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n", + [?MODULE,?LINE,Tag]), + do_output(stdout, [S,Str], Phase, St); + {value,Fd} -> + try + io:put_chars(Fd, Str), + case Tag of + html -> finalise_table(Fd, St); + _ -> ok + end + catch _:Error -> + S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to " + "log file '~p': ~p\n", + [?MODULE,?LINE,Tag,Error]), + do_output(stdout, [S,Str], Phase, St) + end + end. + +finalise_table(Fd, #st{html_footer=Footer}) -> + case file:position(Fd, {cur,0}) of + {ok,Pos} -> + %% We are writing to a seekable file. Finalise so + %% we get complete valid (and viewable) HTML code. + %% Then rewind to overwrite the finalising code. + io:put_chars(Fd, ["\n\n",Footer]), + file:position(Fd, Pos); + {error,epipe} -> + %% The file is not seekable. We cannot erase what + %% we've already written --- so the reader will + %% have to wait until we're done. + ok + end. + +do_print_buffered(Q0, St) -> + Item = queue:get(Q0), + Q = queue:drop(Q0), + case Item of + eot -> + Q; + {Tag,Str} -> + do_output(Tag, Str, undefined, St), + do_print_buffered(Q, St) + end. + +gc(#st{gls=Gls0}) -> + InUse0 = [begin + case process_info(P, group_leader) of + {group_leader,GL} -> GL; + undefined -> undefined + end + end || P <- processes()], + InUse = ordsets:from_list(InUse0), + Gls = gb_sets:to_list(Gls0), + NotUsed = ordsets:subtract(Gls, InUse), + [test_server_gl:stop(Pid) || Pid <- NotUsed], + ok. diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl new file mode 100644 index 0000000000..3419f3f5d0 --- /dev/null +++ b/lib/common_test/src/test_server_node.erl @@ -0,0 +1,758 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_node). +-compile(r12). + +%%% +%%% The same compiled code for this module must be possible to load +%%% in R12B and later. +%%% + +%% Test Controller interface +-export([is_release_available/1]). +-export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]). +-export([start_node/5, stop_node/1]). +-export([kill_nodes/0, nodedown/1]). +%% Internal export +-export([node_started/1,trc/1,handle_debug/4]). + +-include("test_server_internal.hrl"). +-record(slave_info, {name,socket,client}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% All code in this module executes on the test_server_ctrl process %%% +%%% except for node_started/1 and trc/1 which execute on a new node. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +is_release_available(Rel) when is_atom(Rel) -> + is_release_available(atom_to_list(Rel)); +is_release_available(Rel) -> + case os:type() of + {unix,_} -> + Erl = find_release(Rel), + case Erl of + none -> false; + _ -> filelib:is_regular(Erl) + end; + _ -> + false + end. + +nodedown(Sock) -> + Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'}, + case ets:match(slave_tab,Match) of + [[Node,_Client]] -> % Slave node died + gen_tcp:close(Sock), + ets:delete(slave_tab,Node), + slave_died; + [] -> + ok + end. + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Start trace node +%%% +start_tracer_node(TraceFile,TI) -> + Match = #slave_info{name='$1',_='_'}, + SlaveNodes = lists:map(fun([N]) -> [" ",N] end, + ets:match(slave_tab,Match)), + TargetNode = node(), + Cookie = TI#target_info.cookie, + {ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]), + {ok,TracePort} = inet:port(LSock), + Prog = quote_progname(pick_erl_program(default)), + Cmd = lists:concat([Prog, " -sname tracer -hidden -setcookie ", Cookie, + " -s ", ?MODULE, " trc ", TraceFile, " ", + TracePort, " ", TI#target_info.os_family]), + spawn(fun() -> print_data(open_port({spawn,Cmd},[stream])) end), +%! open_port({spawn,Cmd},[stream]), + case gen_tcp:accept(LSock,?ACCEPT_TIMEOUT) of + {ok,Sock} -> + gen_tcp:close(LSock), + receive + {tcp,Sock,Result} when is_binary(Result) -> + case unpack(Result) of + error -> + gen_tcp:close(Sock), + {error,timeout}; + {ok,started} -> + trace_nodes(Sock,[TargetNode | SlaveNodes]), + {ok,Sock}; + {ok,Error} -> Error + end; + {tcp_closed,Sock} -> + gen_tcp:close(Sock), + {error,could_not_start_tracernode} + after ?ACCEPT_TIMEOUT -> + gen_tcp:close(Sock), + {error,timeout} + end; + Error -> + gen_tcp:close(LSock), + {error,{could_not_start_tracernode,Error}} + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Start a tracer on each of these nodes and set flags and patterns +%%% +trace_nodes(Sock,Nodes) -> + Bin = term_to_binary({add_nodes,Nodes}), + ok = gen_tcp:send(Sock, [1|Bin]), + receive_ack(Sock). + + +receive_ack(Sock) -> + receive + {tcp,Sock,Bin} when is_binary(Bin) -> + case unpack(Bin) of + error -> receive_ack(Sock); + {ok,_} -> ok + end; + _ -> + receive_ack(Sock) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Stop trace node +%%% +stop_tracer_node(Sock) -> + Bin = term_to_binary(id(stop)), + ok = gen_tcp:send(Sock, [1|Bin]), + receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, + ok. + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% trc([TraceFile,Nodes]) -> ok +%% +%% Start tracing on the given nodes +%% +%% This function executes on the new node +%% +trc([TraceFile, PortAtom, Type]) -> + {Result,Patterns} = + case file:consult(TraceFile) of + {ok,TI} -> + Pat = parse_trace_info(lists:flatten(TI)), + {started,Pat}; + Error -> + {Error,[]} + end, + Port = list_to_integer(atom_to_list(PortAtom)), + case catch gen_tcp:connect("localhost", Port, [binary, + {reuseaddr,true}, + {packet,2}]) of + {ok,Sock} -> + BinResult = term_to_binary(Result), + ok = gen_tcp:send(Sock,[1|BinResult]), + trc_loop(Sock,Patterns,Type); + _else -> + ok + end, + erlang:halt(). +trc_loop(Sock,Patterns,Type) -> + receive + {tcp,Sock,Bin} -> + case unpack(Bin) of + error -> + ttb:stop(), + gen_tcp:close(Sock); + {ok,{add_nodes,Nodes}} -> + add_nodes(Nodes,Patterns,Type), + Bin = term_to_binary(id(ok)), + ok = gen_tcp:send(Sock, [1|Bin]), + trc_loop(Sock,Patterns,Type); + {ok,stop} -> + ttb:stop(), + gen_tcp:close(Sock) + end; + {tcp_closed,Sock} -> + ttb:stop(), + gen_tcp:close(Sock) + end. +add_nodes(Nodes,Patterns,_Type) -> + ttb:tracer(Nodes,[{file,{local, test_server}}, + {handler, {{?MODULE,handle_debug},initial}}]), + ttb:p(all,[call,timestamp]), + lists:foreach(fun({TP,M,F,A,Pat}) -> ttb:TP(M,F,A,Pat); + ({CTP,M,F,A}) -> ttb:CTP(M,F,A) + end, + Patterns). + +parse_trace_info([{TP,M,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> + [{TP,M,'_','_',Pat}|parse_trace_info(Pats)]; +parse_trace_info([{TP,M,F,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> + [{TP,M,F,'_',Pat}|parse_trace_info(Pats)]; +parse_trace_info([{TP,M,F,A,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> + [{TP,M,F,A,Pat}|parse_trace_info(Pats)]; +parse_trace_info([CTP|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> + [{CTP,'_','_','_'}|parse_trace_info(Pats)]; +parse_trace_info([{CTP,M}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> + [{CTP,M,'_','_'}|parse_trace_info(Pats)]; +parse_trace_info([{CTP,M,F}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> + [{CTP,M,F,'_'}|parse_trace_info(Pats)]; +parse_trace_info([{CTP,M,F,A}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> + [{CTP,M,F,A}|parse_trace_info(Pats)]; +parse_trace_info([]) -> + []; +parse_trace_info([_other|Pats]) -> % ignore + parse_trace_info(Pats). + +handle_debug(Out,Trace,TI,initial) -> + handle_debug(Out,Trace,TI,0); +handle_debug(_Out,end_of_trace,_TI,N) -> + N; +handle_debug(Out,Trace,_TI,N) -> + print_trc(Out,Trace,N), + N+1. + +print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) -> + io:format(Out, + "~w: ~s~n" + "Process : ~w~n" + "Call : ~w:~w/~w~n" + "Arguments : ~p~n" + "Caller : ~w~n~n", + [N,ts(Ts),P,M,F,length(A),A,C]); +print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) -> + io:format(Out, + "~w: ~s~n" + "Process : ~w~n" + "Call : ~w:~w/~w~n" + "Arguments : ~p~n~n", + [N,ts(Ts),P,M,F,length(A),A]); +print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> + io:format(Out, + "~w: ~s~n" + "Process : ~w~n" + "Return from : ~w:~w/~w~n" + "Return value : ~p~n~n", + [N,ts(Ts),P,M,F,A,R]); +print_trc(Out,{drop,X},N) -> + io:format(Out, + "~w: Tracer dropped ~w messages - too busy~n~n", + [N,X]); +print_trc(Out,Trace,N) -> + Ts = element(size(Trace),Trace), + io:format(Out, + "~w: ~s~n" + "Trace : ~p~n~n", + [N,ts(Ts),Trace]). +ts({_, _, Micro} = Now) -> + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now), + io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w,~6.6.0w", + [Y,M,D,H,Min,S,Micro]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Start slave/peer nodes (initiated by test_server:start_node/5) +%%% +start_node(SlaveName, slave, Options, From, TI) when is_list(SlaveName) -> + start_node_slave(list_to_atom(SlaveName), Options, From, TI); +start_node(SlaveName, slave, Options, From, TI) -> + start_node_slave(SlaveName, Options, From, TI); +start_node(SlaveName, peer, Options, From, TI) when is_atom(SlaveName) -> + start_node_peer(atom_to_list(SlaveName), Options, From, TI); +start_node(SlaveName, peer, Options, From, TI) -> + start_node_peer(SlaveName, Options, From, TI); +start_node(_SlaveName, _Type, _Options, _From, _TI) -> + not_implemented_yet. + +%% +%% Peer nodes are always started on the same host as test_server_ctrl +%% +%% (Socket communication is used since in early days the test target +%% and the test server controller node could be on different hosts and +%% the target could not know the controller node via erlang +%% distribution) +%% +start_node_peer(SlaveName, OptList, From, TI) -> + SuppliedArgs = start_node_get_option_value(args, OptList, []), + Cleanup = start_node_get_option_value(cleanup, OptList, true), + HostStr = test_server_sup:hoststr(), + {ok,LSock} = gen_tcp:listen(0,[binary, + {reuseaddr,true}, + {packet,2}]), + {ok,WaitPort} = inet:port(LSock), + NodeStarted = lists:concat([" -s ", ?MODULE, " node_started ", + HostStr, " ", WaitPort]), + + % Support for erl_crash_dump files.. + CrashFile = filename:join([TI#target_info.test_server_dir, + "erl_crash_dump."++cast_to_list(SlaveName)]), + CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), + FailOnError = start_node_get_option_value(fail_on_error, OptList, true), + Pa = TI#target_info.test_server_dir, + Prog0 = start_node_get_option_value(erl, OptList, default), + Prog = quote_progname(pick_erl_program(Prog0)), + Args = + case string:str(SuppliedArgs,"-setcookie") of + 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs; + _ -> SuppliedArgs + end, + Cmd = lists:concat([Prog, + " -detached ", + TI#target_info.naming, " ", SlaveName, + " -pa \"", Pa,"\"", + NodeStarted, + CrashArgs, + " ", Args]), + Opts = case start_node_get_option_value(env, OptList, []) of + [] -> []; + Env -> [{env, Env}] + end, + %% peer is always started on localhost + %% + %% Bad environment can cause open port to fail. If this happens, + %% we ignore it and let the testcase handle the situation... + catch open_port({spawn, Cmd}, [stream|Opts]), + + Tmo = 60000 * test_server:timetrap_scale_factor(), + + case start_node_get_option_value(wait, OptList, true) of + true -> + Ret = wait_for_node_started(LSock,Tmo,undefined,Cleanup,TI,self()), + case {Ret,FailOnError} of + {{{ok, Node}, Warning},_} -> + gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning}); + {_,false} -> + gen_server:reply(From,{Ret, HostStr, Cmd}); + {_,true} -> + gen_server:reply(From,{fail,{Ret, HostStr, Cmd}}) + end; + false -> + Nodename = list_to_atom(SlaveName ++ "@" ++ HostStr), + I = "=== Not waiting for node", + gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}), + Self = self(), + spawn_link( + fun() -> + wait_for_node_started(LSock,Tmo,undefined, + Cleanup,TI,Self), + receive after infinity -> ok end + end), + ok + end. + +%% +%% Slave nodes are started on a remote host if +%% - the option remote is given when calling test_server:start_node/3 +%% +start_node_slave(SlaveName, OptList, From, TI) -> + SuppliedArgs = start_node_get_option_value(args, OptList, []), + Cleanup = start_node_get_option_value(cleanup, OptList, true), + + CrashFile = filename:join([TI#target_info.test_server_dir, + "erl_crash_dump."++cast_to_list(SlaveName)]), + CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), + Pa = TI#target_info.test_server_dir, + Args = lists:concat([" -pa \"", Pa, "\" ", SuppliedArgs, CrashArgs]), + + Prog0 = start_node_get_option_value(erl, OptList, default), + Prog = pick_erl_program(Prog0), + Ret = + case start_which_node(OptList) of + {error,Reason} -> {{error,Reason},undefined,undefined}; + Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup) + end, + gen_server:reply(From,Ret). + + +do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) -> + Host = + case Host0 of + local -> test_server_sup:hoststr(); + _ -> cast_to_list(Host0) + end, + Cmd = Prog ++ " " ++ Args, + case slave:start(Host, SlaveName, Args, no_link, Prog) of + {ok,Nodename} -> + case Cleanup of + true -> ets:insert(slave_tab,#slave_info{name=Nodename}); + false -> ok + end, + {{ok,Nodename}, Host, Cmd, [], []}; + Ret -> + {Ret, Host, Cmd} + end. + + +wait_for_node_started(LSock,Timeout,Client,Cleanup,TI,CtrlPid) -> + case gen_tcp:accept(LSock,Timeout) of + {ok,Sock} -> + gen_tcp:close(LSock), + receive + {tcp,Sock,Started0} when is_binary(Started0) -> + case unpack(Started0) of + error -> + gen_tcp:close(Sock), + {error, connection_closed}; + {ok,Started} -> + Version = TI#target_info.otp_release, + VsnStr = TI#target_info.system_version, + {ok,Nodename, W} = + handle_start_node_return(Version, + VsnStr, + Started), + case Cleanup of + true -> + ets:insert(slave_tab,#slave_info{name=Nodename, + socket=Sock, + client=Client}); + false -> ok + end, + gen_tcp:controlling_process(Sock,CtrlPid), + test_server_ctrl:node_started(Nodename), + {{ok,Nodename},W} + end; + {tcp_closed,Sock} -> + gen_tcp:close(Sock), + {error, connection_closed} + after Timeout -> + gen_tcp:close(Sock), + {error, timeout} + end; + {error,Reason} -> + gen_tcp:close(LSock), + {error, {no_connection,Reason}} + end. + + + +handle_start_node_return(Version,VsnStr,{started, Node, Version, VsnStr}) -> + {ok, Node, []}; +handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) -> + Str = io_lib:format("WARNING: Started node " + "reports different system " + "version than current node! " + "Current node version: ~p, ~p " + "Started node version: ~p, ~p", + [Version, VsnStr, + OVersion, OVsnStr]), + Str1 = lists:flatten(Str), + {ok, Node, Str1}. + + +%% +%% This function executes on the new node +%% +node_started([Host,PortAtom]) -> + %% Must spawn a new process because the boot process should not + %% hang forever!! + spawn(fun() -> node_started(Host,PortAtom) end). + +%% This process hangs forever, just waiting for the socket to be +%% closed and terminating the node +node_started(Host,PortAtom) -> + {_, Version} = init:script_id(), + VsnStr = erlang:system_info(system_version), + Port = list_to_integer(atom_to_list(PortAtom)), + case catch gen_tcp:connect(Host,Port, [binary, + {reuseaddr,true}, + {packet,2}]) of + + {ok,Sock} -> + Started = term_to_binary({started, node(), Version, VsnStr}), + ok = gen_tcp:send(Sock, [1|Started]), + receive _Anyting -> + gen_tcp:close(Sock), + erlang:halt() + end; + _else -> + erlang:halt() + end. + + + + + +% start_which_node(Optlist) -> hostname +start_which_node(Optlist) -> + case start_node_get_option_value(remote, Optlist) of + undefined -> + local; + true -> + case find_remote_host() of + {error, Other} -> + {error, Other}; + RHost -> + RHost + end + end. + +find_remote_host() -> + HostList=test_server_ctrl:get_hosts(), + case lists:delete(test_server_sup:hoststr(), HostList) of + [] -> + {error, no_remote_hosts}; + [RHost|_Rest] -> + RHost + end. + +start_node_get_option_value(Key, List) -> + start_node_get_option_value(Key, List, undefined). + +start_node_get_option_value(Key, List, Default) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Value}} -> + Value; + false -> + Default + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% stop_node(Name) -> ok | {error,Reason} +%% +%% Clean up - test_server will stop this node +stop_node(Name) -> + case ets:lookup(slave_tab,Name) of + [#slave_info{}] -> + ets:delete(slave_tab,Name), + ok; + [] -> + {error, not_a_slavenode} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% kill_nodes() -> ok +%% +%% Brutally kill all slavenodes that were not stopped by test_server +kill_nodes() -> + case ets:match_object(slave_tab,'_') of + [] -> []; + List -> + lists:map(fun(SI) -> kill_node(SI) end, List) + end. + +kill_node(SI) -> + Name = SI#slave_info.name, + ets:delete(slave_tab,Name), + case SI#slave_info.socket of + undefined -> + catch rpc:call(Name,erlang,halt,[]); + Sock -> + gen_tcp:close(Sock) + end, + Name. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% cast_to_list(X) -> string() +%%% X = list() | atom() | void() +%%% Returns a string representation of whatever was input + +cast_to_list(X) when is_list(X) -> X; +cast_to_list(X) when is_atom(X) -> atom_to_list(X); +cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])). + + +%%% L contains elements of the forms +%%% {prog, String} +%%% {release, Rel} where Rel = String | latest | previous +%%% this +%%% +pick_erl_program(default) -> + cast_to_list(lib:progname()); +pick_erl_program(L) -> + P = random_element(L), + case P of + {prog, S} -> + S; + {release, S} -> + find_release(S); + this -> + cast_to_list(lib:progname()) + end. + +%% 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. +%% +%% Arguments could exist either if the executable is excplicitly given +%% ({prog,String}) or if the -program switch to beam is used and +%% includes arguments (typically done by cerl in OTP test environment +%% in order to ensure that slave/peer nodes are started with the same +%% emulator and flags as the test node. The return from lib:progname() +%% could then typically be '//cerl -gcov'). +quote_progname(Progname) -> + do_quote_progname(string:tokens(Progname," ")). + +do_quote_progname([Prog]) -> + "\""++Prog++"\""; +do_quote_progname([Prog,Arg|Args]) -> + case os:find_executable(Prog) of + false -> + do_quote_progname([Prog++" "++Arg | Args]); + _ -> + %% this one has an executable - we assume the rest are arguments + "\""++Prog++"\""++ + lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args])) + end. + +random_element(L) -> + lists:nth(rand:uniform(length(L)), L). + +find_release(latest) -> + "/usr/local/otp/releases/latest/bin/erl"; +find_release(previous) -> + "kaka"; +find_release(Rel) -> + find_release(os:type(), Rel). + +find_release({unix,sunos}, Rel) -> + case os:cmd("uname -p") of + "sparc" ++ _ -> + "/usr/local/otp/releases/otp_beam_solaris8_" ++ Rel ++ "/bin/erl"; + _ -> + none + end; +find_release({unix,linux}, Rel) -> + Candidates = find_rel_linux(Rel), + case lists:dropwhile(fun(N) -> + not filelib:is_regular(N) + end, Candidates) of + [] -> none; + [Erl|_] -> Erl + end; +find_release(_, _) -> none. + +find_rel_linux(Rel) -> + case suse_release() of + none -> []; + SuseRel -> find_rel_suse(Rel, SuseRel) + end. + +find_rel_suse(Rel, SuseRel) -> + Root = "/usr/local/otp/releases/sles", + case SuseRel of + "11" -> + %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order. + find_rel_suse_1(Rel, Root++"11") ++ + find_rel_suse_1(Rel, Root++"10") ++ + find_rel_suse_1(Rel, Root++"9"); + "10" -> + %% Try both SuSE 10 and SuSe 9 in that order. + find_rel_suse_1(Rel, Root++"10") ++ + find_rel_suse_1(Rel, Root++"9"); + "9" -> + find_rel_suse_1(Rel, Root++"9"); + _ -> + [] + end. + +find_rel_suse_1(Rel, RootWc) -> + case erlang:system_info(wordsize) of + 4 -> + find_rel_suse_2(Rel, RootWc++"_32"); + 8 -> + find_rel_suse_2(Rel, RootWc++"_64") ++ + find_rel_suse_2(Rel, RootWc++"_32") + end. + +find_rel_suse_2(Rel, RootWc) -> + RelDir = filename:dirname(RootWc), + Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*", + case file:list_dir(RelDir) of + {ok,Dirs} -> + case lists:filter(fun(Dir) -> + case re:run(Dir, Pat) of + nomatch -> false; + _ -> true + end + end, Dirs) of + [] -> + []; + [R|_] -> + [filename:join([RelDir,R,"bin","erl"])] + end; + _ -> + [] + end. + +%% suse_release() -> VersionString | none. +%% Return the major SuSE version number for this platform or +%% 'none' if this is not a SuSE platform. +suse_release() -> + case file:open("/etc/SuSE-release", [read]) of + {ok,Fd} -> + try + suse_release(Fd) + after + file:close(Fd) + end; + {error,_} -> none + end. + +suse_release(Fd) -> + case io:get_line(Fd, '') of + eof -> none; + Line when is_list(Line) -> + case re:run(Line, "^VERSION\\s*=\\s*(\\d+)\s*", + [{capture,all_but_first,list}]) of + nomatch -> + suse_release(Fd); + {match,[Version]} -> + Version + end + end. + +unpack(Bin) -> + {One,Term} = split_binary(Bin, 1), + case binary_to_list(One) of + [1] -> + case catch {ok,binary_to_term(Term)} of + {'EXIT',_} -> error; + {ok,_}=Res -> Res + end; + _ -> error + end. + +id(I) -> I. + +print_data(Port) -> + receive + {Port, {data, Bytes}} -> + io:put_chars(Bytes), + print_data(Port); + {Port, eof} -> + Port ! {self(), close}, + receive + {Port, closed} -> + true + end, + receive + {'EXIT', Port, _} -> + ok + after 1 -> % force context switch + ok + end + end. diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl new file mode 100644 index 0000000000..fc2cfd57bd --- /dev/null +++ b/lib/common_test/src/test_server_sup.erl @@ -0,0 +1,939 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% Purpose: Test server support functions. +%%%------------------------------------------------------------------- +-module(test_server_sup). +-export([timetrap/2, timetrap/3, timetrap/4, + timetrap_cancel/1, capture_get/1, messages_get/1, + timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, + cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, + get_username/0, get_os_family/0, + hostatom/0, hostatom/1, hoststr/0, hoststr/1, + framework_call/2,framework_call/3,framework_call/4, + format_loc/1, + util_start/0, util_stop/0, unique_name/0, + call_trace/1, + appup_test/1]). +-include("test_server_internal.hrl"). +-define(crash_dump_tar,"crash_dumps.tar.gz"). +-define(src_listing_ext, ".src.html"). +-record(util_state, {starter, latest_name}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap(Timeout,Scale,Pid) -> Handle +%% Handle = term() +%% +%% Creates a time trap, that will kill the given process if the +%% trap is not cancelled with timetrap_cancel/1, within Timeout +%% milliseconds. +%% Scale says if the time should be scaled up to compensate for +%% delays during the test (e.g. if cover is running). + +timetrap(Timeout0, Pid) -> + timetrap(Timeout0, Timeout0, true, Pid). + +timetrap(Timeout0, Scale, Pid) -> + timetrap(Timeout0, Timeout0, Scale, Pid). + +timetrap(Timeout0, ReportTVal, Scale, Pid) -> + process_flag(priority, max), + Timeout = if not Scale -> Timeout0; + true -> test_server:timetrap_scale_factor() * Timeout0 + end, + TruncTO = trunc(Timeout), + receive + after TruncTO -> + kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) + end. + +kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) -> + case is_process_alive(Pid) of + true -> + TimeToReport = if Timeout0 == ReportTVal -> TruncTO; + true -> ReportTVal end, + MFLs = test_server:get_loc(Pid), + Mon = erlang:monitor(process, Pid), + Trap = {timetrap_timeout,TimeToReport,MFLs}, + exit(Pid, Trap), + receive + {'DOWN', Mon, process, Pid, _} -> + ok + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + catch error_logger:warning_msg( + "Testcase process ~w not " + "responding to timetrap " + "timeout:~n" + " ~p.~n" + "Killing testcase...~n", + [Pid, Trap]), + exit(Pid, kill) + end; + false -> + ok + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_cancel(Handle) -> ok +%% Handle = term() +%% +%% Cancels a time trap. +timetrap_cancel(Handle) -> + unlink(Handle), + MonRef = erlang:monitor(process, Handle), + exit(Handle, kill), + receive {'DOWN',MonRef,_,_,_} -> ok + after + 2000 -> + erlang:demonitor(MonRef, [flush]), + ok + end. + +capture_get(Msgs) -> + receive + {captured,Msg} -> + capture_get([Msg|Msgs]) + after 0 -> + lists:reverse(Msgs) + end. + +messages_get(Msgs) -> + receive + Msg -> + messages_get([Msg|Msgs]) + after 0 -> + lists:reverse(Msgs) + end. + +timecall(M, F, A) -> + {Elapsed, Val} = timer:tc(M, F, A), + {Elapsed / 1000000, Val}. + + +call_crash(Time,Crash,M,F,A) -> + OldTrapExit = process_flag(trap_exit,true), + Pid = spawn_link(M,F,A), + Answer = + receive + {'EXIT',Crash} -> + ok; + {'EXIT',Pid,Crash} -> + ok; + {'EXIT',_Reason} when Crash==any -> + ok; + {'EXIT',Pid,_Reason} when Crash==any -> + ok; + {'EXIT',Reason} -> + test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", + [Crash, Reason]), + exit({wrong_crash_reason,Reason}); + {'EXIT',Pid,Reason} -> + test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", + [Crash, Reason]), + exit({wrong_crash_reason,Reason}); + {'EXIT',OtherPid,Reason} when OldTrapExit == false -> + exit({'EXIT',OtherPid,Reason}) + after do_trunc(Time) -> + exit(call_crash_timeout) + end, + process_flag(trap_exit,OldTrapExit), + Answer. + +do_trunc(infinity) -> infinity; +do_trunc(T) -> trunc(T). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% app_test/2 +%% +%% Checks one applications .app file for obvious errors. +%% Checks.. +%% * .. required fields +%% * .. that all modules specified actually exists +%% * .. that all requires applications exists +%% * .. that no module included in the application has export_all +%% * .. that all modules in the ebin/ dir is included +%% (This only produce a warning, as all modules does not +%% have to be included (If the `pedantic' option isn't used)) +app_test(Application, Mode) -> + case is_app(Application) of + {ok, AppFile} -> + do_app_tests(AppFile, Application, Mode); + Error -> + test_server:fail(Error) + end. + +is_app(Application) -> + case file:consult(filename:join([code:lib_dir(Application),"ebin", + atom_to_list(Application)++".app"])) of + {ok, [{application, Application, AppFile}] } -> + {ok, AppFile}; + _ -> + test_server:format(minor, + "Application (.app) file not found, " + "or it has very bad syntax.~n"), + {error, not_an_application} + end. + + +do_app_tests(AppFile, AppName, Mode) -> + DictList= + [ + {missing_fields, []}, + {missing_mods, []}, + {superfluous_mods_in_ebin, []}, + {export_all_mods, []}, + {missing_apps, []} + ], + fill_dictionary(DictList), + + %% An appfile must (?) have some fields.. + check_fields([description, modules, registered, applications], AppFile), + + %% Check for missing and extra modules. + {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile), + EBinList=lists:sort(get_ebin_modnames(AppName)), + {Missing, Extra} = common(lists:sort(Mods), EBinList), + put(superfluous_mods_in_ebin, Extra), + put(missing_mods, Missing), + + %% Check that no modules in the application has export_all. + app_check_export_all(Mods), + + %% Check that all specified applications exists. + {value, {applications, Apps}}= + lists:keysearch(applications, 1, AppFile), + check_apps(Apps), + + A=check_dict(missing_fields, "Inconsistent app file, " + "missing fields"), + B=check_dict(missing_mods, "Inconsistent app file, " + "missing modules"), + C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, " + "Modules not included in app file.", Mode), + D=check_dict(export_all_mods, "Inconsistent app file, " + "Modules have `export_all'."), + E=check_dict(missing_apps, "Inconsistent app file, " + "missing applications."), + + erase_dictionary(DictList), + case A+B+C+D+E of + 5 -> + ok; + _ -> + test_server:fail() + end. + +app_check_export_all([]) -> + ok; +app_check_export_all([Mod|Mods]) -> + case catch apply(Mod, module_info, [compile]) of + {'EXIT', {undef,_}} -> + app_check_export_all(Mods); + COpts -> + case lists:keysearch(options, 1, COpts) of + false -> + app_check_export_all(Mods); + {value, {options, List}} -> + case lists:member(export_all, List) of + true -> + put(export_all_mods, [Mod|get(export_all_mods)]), + app_check_export_all(Mods); + false -> + app_check_export_all(Mods) + end + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% appup_test/1 +%% +%% Checks one applications .appup file for obvious errors. +%% Checks.. +%% * .. syntax +%% * .. that version in app file matches appup file version +%% * .. validity of appup instructions +%% +%% For library application this function checks that the proper +%% 'restart_application' upgrade and downgrade clauses exist. +appup_test(Application) -> + case is_app(Application) of + {ok, AppFile} -> + case is_appup(Application, proplists:get_value(vsn, AppFile)) of + {ok, Up, Down} -> + StartMod = proplists:get_value(mod, AppFile), + Modules = proplists:get_value(modules, AppFile), + do_appup_tests(StartMod, Application, Up, Down, Modules); + Error -> + test_server:fail(Error) + end; + Error -> + test_server:fail(Error) + end. + +is_appup(Application, Version) -> + AppupFile = atom_to_list(Application) ++ ".appup", + AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]), + case file:consult(AppupPath) of + {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) -> + {ok, Up, Down}; + _ -> + test_server:format( + minor, + "Application upgrade (.appup) file not found, " + "or it has very bad syntax.~n"), + {error, appup_not_readable} + end. + +do_appup_tests(undefined, Application, Up, Down, _Modules) -> + %% library application + case Up of + [{<<".*">>, [{restart_application, Application}]}] -> + case Down of + [{<<".*">>, [{restart_application, Application}]}] -> + ok; + _ -> + test_server:format( + minor, + "Library application needs restart_application " + "downgrade instruction.~n"), + {error, library_downgrade_instruction_malformed} + end; + _ -> + test_server:format( + minor, + "Library application needs restart_application " + "upgrade instruction.~n"), + {error, library_upgrade_instruction_malformed} + end; +do_appup_tests(_, _Application, Up, Down, Modules) -> + %% normal application + case check_appup_clauses_plausible(Up, up, Modules) of + ok -> + case check_appup_clauses_plausible(Down, down, Modules) of + ok -> + test_server:format(minor, "OK~n"); + Error -> + test_server:format(minor, "ERROR ~p~n", [Error]), + test_server:fail(Error) + end; + Error -> + test_server:format(minor, "ERROR ~p~n", [Error]), + test_server:fail(Error) + end. + +check_appup_clauses_plausible([], _Direction, _Modules) -> + ok; +check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules) + when is_binary(Re) -> + case re:compile(Re) of + {ok, _} -> + case check_appup_instructions(Instrs, Direction, Modules) of + ok -> + check_appup_clauses_plausible(Rest, Direction, Modules); + Error -> + Error + end; + {error, Error} -> + {error, {version_regex_malformed, Re, Error}} + end; +check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules) + when is_list(V) -> + case check_appup_instructions(Instrs, Direction, Modules) of + ok -> + check_appup_clauses_plausible(Rest, Direction, Modules); + Error -> + Error + end; +check_appup_clauses_plausible(Clause, _Direction, _Modules) -> + {error, {clause_malformed, Clause}}. + +check_appup_instructions(Instrs, Direction, Modules) -> + case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of + {_Good, []} -> + ok; + {_, Bad} -> + {error, {bad_instructions, Bad}} + end. + +check_instructions(_, [], _, Good, Bad, _) -> + {lists:reverse(Good), lists:reverse(Bad)}; +check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) -> + case catch check_instruction(UpDown, Instr, All, Modules) of + ok -> + check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules); + {error, Reason} -> + NewBad = [{Instr, Reason} | Bad], + check_instructions(UpDown, Rest, All, Good, NewBad, Modules) + end. + +check_instruction(up, {add_module, Module}, _, Modules) -> + %% A new module is added + check_module(Module, Modules); +check_instruction(down, {add_module, Module}, _, Modules) -> + %% An old module is re-added + case (catch check_module(Module, Modules)) of + {error, {unknown_module, Module, Modules}} -> ok; + ok -> throw({error, {existing_readded_module, Module}}) + end; +check_instruction(_, {load_module, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {load_module, Module, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_depend(DepMods); +check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_depend(DepMods), + check_purge(Pre), + check_purge(Post); +check_instruction(up, {delete_module, Module}, _, Modules) -> + case (catch check_module(Module, Modules)) of + {error, {unknown_module, Module, Modules}} -> + ok; + ok -> + throw({error,{existing_module_deleted, Module}}) + end; +check_instruction(down, {delete_module, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, supervisor}, _, Modules) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, DepMods}, _, Modules) + when is_list(DepMods) -> + check_module(Module, Modules); +check_instruction(_, {update, Module, Change}, _, Modules) -> + check_module(Module, Modules), + check_change(Change); +check_instruction(_, {update, Module, Change, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_change(Change), + check_depend(DepMods); +check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) -> + check_module(Module, Modules), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, + {update, Module, Timeout, Change, Pre, Post, DepMods}, + _, + Modules) -> + check_module(Module, Modules), + check_timeout(Timeout), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, + {update, Module, ModType, Timeout, Change, Pre, Post, DepMods}, + _, + Modules) -> + check_module(Module, Modules), + check_mod_type(ModType), + check_timeout(Timeout), + check_change(Change), + check_purge(Pre), + check_purge(Post), + check_depend(DepMods); +check_instruction(_, {restart_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {remove_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {add_application, Application}, _, _) -> + check_application(Application); +check_instruction(_, {add_application, Application, Type}, _, _) -> + check_application(Application), + check_restart_type(Type); +check_instruction(_, Instr, _, _) -> + throw({error, {low_level_or_invalid_instruction, Instr}}). + +check_module(Module, Modules) -> + case {is_atom(Module), lists:member(Module, Modules)} of + {true, true} -> ok; + {true, false} -> throw({error, {unknown_module, Module}}); + {false, _} -> throw({error, {bad_module, Module}}) + end. + +check_application(App) -> + case is_atom(App) of + true -> ok; + false -> throw({error, {bad_application, App}}) + end. + +check_depend(Dep) when is_list(Dep) -> ok; +check_depend(Dep) -> throw({error, {bad_depend, Dep}}). + +check_restart_type(permanent) -> ok; +check_restart_type(transient) -> ok; +check_restart_type(temporary) -> ok; +check_restart_type(load) -> ok; +check_restart_type(none) -> ok; +check_restart_type(Type) -> throw({error, {bad_restart_type, Type}}). + +check_timeout(T) when is_integer(T), T > 0 -> ok; +check_timeout(default) -> ok; +check_timeout(infinity) -> ok; +check_timeout(T) -> throw({error, {bad_timeout, T}}). + +check_mod_type(static) -> ok; +check_mod_type(dynamic) -> ok; +check_mod_type(Type) -> throw({error, {bad_mod_type, Type}}). + +check_purge(soft_purge) -> ok; +check_purge(brutal_purge) -> ok; +check_purge(Purge) -> throw({error, {bad_purge, Purge}}). + +check_change(soft) -> ok; +check_change({advanced, _}) -> ok; +check_change(Change) -> throw({error, {bad_change, Change}}). + +%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1}, +%% NotInL2 is the elements of L1 which don't occurr in L2, +%% NotInL1 is the elements of L2 which don't ocurr in L1. + +common(L1, L2) -> + common(L1, L2, [], []). + +common([X|Rest1], [X|Rest2], A1, A2) -> + common(Rest1, Rest2, A1, A2); +common([X|Rest1], [Y|Rest2], A1, A2) when X < Y -> + common(Rest1, [Y|Rest2], [X|A1], A2); +common([X|Rest1], [Y|Rest2], A1, A2) -> + common([X|Rest1], Rest2, A1, [Y|A2]); +common([], L, A1, A2) -> + {A1, L++A2}; +common(L, [], A1, A2) -> + {L++A1, A2}. + +check_apps([]) -> + ok; +check_apps([App|Apps]) -> + case is_app(App) of + {ok, _AppFile} -> + ok; + {error, _} -> + put(missing_apps, [App|get(missing_apps)]) + end, + check_apps(Apps). + +check_fields([], _AppFile) -> + ok; +check_fields([L|Ls], AppFile) -> + check_field(L, AppFile), + check_fields(Ls, AppFile). + +check_field(FieldName, AppFile) -> + case lists:keymember(FieldName, 1, AppFile) of + true -> + ok; + false -> + put(missing_fields, [FieldName|get(missing_fields)]), + ok + end. + +check_dict(Dict, Reason) -> + case get(Dict) of + [] -> + 1; % All ok. + List -> + io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), + 0 + end. + +check_dict_tolerant(Dict, Reason, Mode) -> + case get(Dict) of + [] -> + 1; % All ok. + List -> + io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), + case Mode of + pedantic -> + 0; + _ -> + 1 + end + end. + +get_ebin_modnames(AppName) -> + Wc=filename:join([code:lib_dir(AppName),"ebin", + "*"++code:objfile_extension()]), + TheFun=fun(X, Acc) -> + [list_to_atom(filename:rootname( + filename:basename(X)))|Acc] end, + _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)). + +%% +%% This function removes any erl_crash_dump* files found in the +%% test server directory. Done only once when the test server +%% is started. +%% +cleanup_crash_dumps() -> + Dir = crash_dump_dir(), + Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), + delete_files(Dumps). + +crash_dump_dir() -> + filename:dirname(code:which(?MODULE)). + +tar_crash_dumps() -> + Dir = crash_dump_dir(), + case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of + [] -> {error,no_crash_dumps}; + Dumps -> + TarFileName = filename:join(Dir,?crash_dump_tar), + {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]), + lists:foreach( + fun(File) -> + ok = erl_tar:add(Tar,File,filename:basename(File),[]) + end, + Dumps), + ok = erl_tar:close(Tar), + delete_files(Dumps), + {ok,TarFileName} + end. + + +check_new_crash_dumps() -> + Dir = crash_dump_dir(), + Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), + case length(Dumps) of + 0 -> + ok; + Num -> + test_server_ctrl:format(minor, + "Found ~w crash dumps:~n", [Num]), + append_files_to_logfile(Dumps), + delete_files(Dumps) + end. + +append_files_to_logfile([]) -> ok; +append_files_to_logfile([File|Files]) -> + NodeName=from($., File), + test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]), + Fd=get(test_server_minor_fd), + case file:read_file(File) of + {ok, Bin} -> + case file:write(Fd, Bin) of + ok -> + ok; + {error,Error} -> + %% Write failed. The following io:format/3 will probably also + %% fail, but in that case it will throw an exception so that + %% we will be aware of the problem. + io:format(Fd, "Unable to write the crash dump " + "to this file: ~p~n", [file:format_error(Error)]) + end; + _Error -> + io:format(Fd, "Failed to read: ~ts\n", [File]) + end, + append_files_to_logfile(Files). + +delete_files([]) -> ok; +delete_files([File|Files]) -> + io:format("Deleting file: ~ts~n", [File]), + case file:delete(File) of + {error, _} -> + case file:rename(File, File++".old") of + {error, Error} -> + io:format("Could neither delete nor rename file " + "~ts: ~ts.~n", [File, Error]); + _ -> + ok + end; + _ -> + ok + end, + delete_files(Files). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% erase_dictionary(Vars) -> ok +%% Vars = [atom(),...] +%% +%% Takes a list of dictionary keys, KeyVals, erases +%% each key and returns ok. +erase_dictionary([{Var, _Val}|Vars]) -> + erase(Var), + erase_dictionary(Vars); +erase_dictionary([]) -> + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% fill_dictionary(KeyVals) -> void() +%% KeyVals = [{atom(),term()},...] +%% +%% Takes each Key-Value pair, and inserts it in the process dictionary. +fill_dictionary([{Var,Val}|Vars]) -> + put(Var,Val), + fill_dictionary(Vars); +fill_dictionary([]) -> + []. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% get_username() -> UserName +%% +%% Returns the current user +get_username() -> + getenv_any(["USER","USERNAME"]). + +getenv_any([Key|Rest]) -> + case catch os:getenv(Key) of + String when is_list(String) -> String; + false -> getenv_any(Rest) + end; +getenv_any([]) -> "". + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% get_os_family() -> OsFamily +%% +%% Returns the OS family +get_os_family() -> + {OsFamily,_OsName} = os:type(), + OsFamily. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% hostatom()/hostatom(Node) -> Host; atom() +%% hoststr() | hoststr(Node) -> Host; string() +%% +%% Returns the OS family +hostatom() -> + hostatom(node()). +hostatom(Node) -> + list_to_atom(hoststr(Node)). +hoststr() -> + hoststr(node()). +hoststr(Node) when is_atom(Node) -> + hoststr(atom_to_list(Node)); +hoststr(Node) when is_list(Node) -> + from($@, Node). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_H, []) -> []. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn +%% +%% Calls the given Func in Callback +framework_call(Func,Args) -> + framework_call(Func,Args,ok). +framework_call(Func,Args,DefaultReturn) -> + CB = os:getenv("TEST_SERVER_FRAMEWORK"), + framework_call(CB,Func,Args,DefaultReturn). +framework_call(FW,_Func,_Args,DefaultReturn) + when FW =:= false; FW =:= "undefined" -> + DefaultReturn; +framework_call(Callback,Func,Args,DefaultReturn) -> + Mod = list_to_atom(Callback), + case code:is_loaded(Mod) of + false -> code:load_file(Mod); + _ -> ok + end, + case erlang:function_exported(Mod,Func,length(Args)) of + true -> + EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end, + SetTcState = case Func of + end_tc -> true; + init_tc -> true; + _ -> false + end, + case SetTcState of + true -> + test_server:set_tc_state({framework,Mod,Func}); + false -> + ok + end, + try apply(Mod,Func,Args) of + Result -> + Result + catch + exit:Why -> + EH(Why); + error:Why -> + EH({Why,erlang:get_stacktrace()}); + throw:Why -> + EH(Why) + end; + false -> + DefaultReturn + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% format_loc(Loc) -> string() +%% +%% Formats the printout of the line of code read from +%% process dictionary (test_server_loc). Adds link to +%% correct line in source code. +format_loc([{Mod,Func,Line}]) -> + [format_loc1({Mod,Func,Line})]; +format_loc([{Mod,Func,Line}|Rest]) -> + ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; +format_loc([{Mod,LineOrFunc}]) -> + format_loc({Mod,LineOrFunc}); +format_loc({Mod,Func}) when is_atom(Func) -> + io_lib:format("{~w,~w}",[Mod,Func]); +format_loc(Loc) -> + io_lib:format("~p",[Loc]). + +format_loc1([{Mod,Func,Line}]) -> + [" ",format_loc1({Mod,Func,Line}),"]"]; +format_loc1([{Mod,Func,Line}|Rest]) -> + [" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; +format_loc1({Mod,Func,Line}) -> + ModStr = atom_to_list(Mod), + case {lists:member(no_src, get(test_server_logopts)), + lists:reverse(ModStr)} of + {false,[$E,$T,$I,$U,$S,$_|_]} -> + Link = if is_integer(Line) -> + integer_to_list(Line); + Line == last_expr -> + list_to_atom(atom_to_list(Func)++"-last_expr"); + is_atom(Line) -> + atom_to_list(Line); + true -> + Line + end, + io_lib:format("{~w,~w,~w}", + [Mod,Func, + test_server_ctrl:uri_encode(downcase(ModStr)), + ?src_listing_ext,Link,Line]); + _ -> + io_lib:format("{~w,~w,~w}",[Mod,Func,Line]) + end. + +downcase(S) -> downcase(S, []). +downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z -> + downcase(Rest, [Uc-$A+$a|Result]); +downcase([C|Rest], Result) -> + downcase(Rest, [C|Result]); +downcase([], Result) -> + lists:reverse(Result). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_start() -> ok +%% +%% Start local utility process +util_start() -> + Starter = self(), + case whereis(?MODULE) of + undefined -> + spawn_link(fun() -> + register(?MODULE, self()), + util_loop(#util_state{starter=Starter}) + end); + _Pid -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_stop() -> ok +%% +%% Stop local utility process +util_stop() -> + try (?MODULE ! {self(),stop}) of + _ -> + receive {?MODULE,stopped} -> ok + after 5000 -> exit(whereis(?MODULE), kill) + end + catch + _:_ -> + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% unique_name() -> string() +%% +unique_name() -> + ?MODULE ! {self(),unique_name}, + receive {?MODULE,Name} -> Name + after 5000 -> exit({?MODULE,no_util_process}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% util_loop(State) -> ok +%% +util_loop(State) -> + receive + {From,unique_name} -> + Nr = erlang:unique_integer([positive]), + Name = integer_to_list(Nr), + if Name == State#util_state.latest_name -> + timer:sleep(1), + self() ! {From,unique_name}, + util_loop(State); + true -> + From ! {?MODULE,Name}, + util_loop(State#util_state{latest_name = Name}) + end; + {From,stop} -> + catch unlink(State#util_state.starter), + From ! {?MODULE,stopped}, + ok + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% call_trace(TraceSpecFile) -> ok +%% +%% Read terms on format {m,Mod} | {f,Mod,Func} +%% from TraceSpecFile and enable call trace for +%% specified functions. +call_trace(TraceSpec) -> + case catch try_call_trace(TraceSpec) of + {'EXIT',Reason} -> + erlang:display(Reason), + exit(Reason); + Ok -> + Ok + end. + +try_call_trace(TraceSpec) -> + case file:consult(TraceSpec) of + {ok,Terms} -> + dbg:tracer(), + %% dbg:p(self(), [p, m, sos, call]), + dbg:p(self(), [sos, call]), + lists:foreach(fun({m,M}) -> + case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of + {error,What} -> exit({error,{tracing_failed,What}}); + _ -> ok + end; + ({f,M,F}) -> + case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of + {error,What} -> exit({error,{tracing_failed,What}}); + _ -> ok + end; + (Huh) -> + exit({error,{unrecognized_trace_term,Huh}}) + end, Terms), + ok; + {_,Error} -> + exit({error,{tracing_failed,TraceSpec,Error}}) + end. + diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index c17fb07446..aa99fe1af1 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -65,9 +65,13 @@ MODULES= \ ct_cover_nomerge_SUITE \ ct_groups_search_SUITE \ ct_surefire_SUITE \ - ct_telnet_SUITE + ct_telnet_SUITE \ + erl2html2_SUITE \ + test_server_SUITE \ + test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) +HRL_FILES= test_server_test_lib.hrl TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) INSTALL_PROGS= $(TARGET_FILES) @@ -118,7 +122,7 @@ release_spec: opt release_tests_spec: $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(COVERFILE) "$(RELSYSDIR)" $(INSTALL_DATA) common_test.spec common_test.cover "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover index 87d00c420f..e8e01a9312 100644 --- a/lib/common_test/test/common_test.cover +++ b/lib/common_test/test/common_test.cover @@ -1,9 +1,2 @@ %% -*- erlang -*- {incl_app,common_test,details}. -{cross,common_test,[{test_server,[erl2html2, - test_server, - test_server_ctrl, - test_server_gl, - test_server_io, - test_server_node, - test_server_sup]}]}. diff --git a/lib/common_test/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl new file mode 100644 index 0000000000..9e6389109b --- /dev/null +++ b/lib/common_test/test/erl2html2_SUITE.erl @@ -0,0 +1,277 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(erl2html2_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + + +-define(HEADER, + ["\n", + "\n", + "\n", + "Module ", Src, "\n", + "\n", + "\n", + "\n"]). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,30}}, + {ct_hooks,[ts_install_cth,test_server_test_lib]}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_group(_GroupName, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + []. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [macros_defined, macros_undefined]. + +%%-------------------------------------------------------------------- +%% @spec TestCase(Config0) -> +%% ok | exit() | {skip,Reason} | {comment,Comment} | +%% {save_config,Config1} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% Comment = term() +%% @end +%%-------------------------------------------------------------------- +macros_defined(Config) -> + %% let erl2html2 use epp as parser + DataDir = ?config(data_dir,Config), + InclDir = filename:join(DataDir, "include"), + {Src,Dst} = convert_module("m1",[InclDir],Config), + {true,L} = check_line_numbers(Src,Dst), + ok = check_link_targets(Src,Dst,L,[{baz,0}],[]), + ok. + +macros_undefined(Config) -> + %% let erl2html2 use epp_dodger as parser + {Src,Dst} = convert_module("m1",[],Config), + {true,L} = check_line_numbers(Src,Dst), + ok = check_link_targets(Src,Dst,L,[{baz,0}],[{quux,0}]), + ok. + +convert_module(Mod,InclDirs,Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + Src = filename:join(DataDir,Mod++".erl"), + Dst = filename:join(PrivDir,Mod++".erl.html"), + io:format("~s\n",[Src,filename:basename(Src)]), + ok = erl2html2:convert(Src, Dst, InclDirs, ""), + io:format("~s\n",[Dst,filename:basename(Dst)]), + {Src,Dst}. + +%% Check that there are the same number of lines in each file, and +%% that all line numbers are displayed in the dst file. +check_line_numbers(Src,Dst) -> + {ok,SFd} = file:open(Src,[read]), + {ok,DFd} = file:open(Dst,[read]), + {ok,SN} = count_src_lines(SFd,0), + ok = file:close(SFd), + {ok,DN} = read_dst_line_numbers(DFd), + ok = file:close(DFd), + {SN == DN,SN}. + +count_src_lines(Fd,N) -> + case io:get_line(Fd,"") of + eof -> + {ok,N}; + {error,Reason} -> + {error,Reason,N}; + _Line -> + count_src_lines(Fd,N+1) + end. + +read_dst_line_numbers(Fd) -> + "

\n" = io:get_line(Fd,""),
+    read_dst_line_numbers(Fd,0).
+read_dst_line_numbers(Fd,Last) when is_integer(Last) ->
+    case io:get_line(Fd,"") of
+	eof ->
+	    {ok,Last};
+	{error,Reason} ->
+	    {error,Reason,Last};
+	"
"++_ -> + {ok,Last}; + ""++_ -> + {ok,Last}; + Line -> + %% erlang:display(Line), + Num = check_line_number(Last,Line,Line), + read_dst_line_numbers(Fd,Num) + end. + +check_line_number(Last,Line,OrigLine) -> + case Line of + " ct:fail({no_line_number_after,Last,OrigLine}) + end, + if Num == Last+1 -> + Num; + true -> + ct:fail({unexpected_integer,Num,Last}) + end + end. + + +%% Check that there is one link target for each line and one for each +%% function. +%% The test module has -compile(export_all), so all functions are +%% found by listing the exported ones. +check_link_targets(Src,Dst,L,RmFncs,ShouldRemain) -> + Mod = list_to_atom(filename:basename(filename:rootname(Src))), + Exports = Mod:module_info(exports)--[{module_info,0},{module_info,1}|RmFncs], + LastExprFuncs = [Func || {Func,_A} <- Exports], + {ok,{FAs,Fs,L},_} = + xmerl_sax_parser:file(Dst, + [{event_fun,fun sax_event/3}, + {event_state,{Exports,LastExprFuncs,0}}]), + true = (length(FAs) == length(ShouldRemain)), + [] = [FA || FA <- FAs, not lists:member(FA,ShouldRemain)], + [] = [F || F <- Fs, not lists:keymember(F,1,ShouldRemain)], + ok. + +sax_event(Event,_Loc,State) -> + sax_event(Event,State). + +sax_event({startElement,_Uri,"a",_QN,Attrs},{Exports,LastExprFuncs,PrevLine}) -> + {_,_,"name",Name} = lists:keyfind("name",3,Attrs), + case catch list_to_integer(Name) of + Line when is_integer(Line) -> + case PrevLine + 1 of + Line -> + {Exports,LastExprFuncs,Line}; + Other -> + ct:fail({unexpected_line_number_target,Other}) + end; + {'EXIT',_} -> + {match,[FStr,EndStr]} = + re:run(Name,"^(.*)-(last_expr|[0-9]+)$", + [{capture,all_but_first,list}]), + F = list_to_atom(http_uri:decode(FStr)), + case EndStr of + "last_expr" -> + true = lists:member(F,LastExprFuncs), + {Exports,lists:delete(F,LastExprFuncs),PrevLine}; + _ -> + A = list_to_integer(EndStr), + A = proplists:get_value(F,Exports), + {lists:delete({F,A},Exports),LastExprFuncs,PrevLine} + end + end; +sax_event(_,State) -> + State. diff --git a/lib/common_test/test/erl2html2_SUITE_data/Makefile.src b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src new file mode 100644 index 0000000000..942ac0584b --- /dev/null +++ b/lib/common_test/test/erl2html2_SUITE_data/Makefile.src @@ -0,0 +1,2 @@ +all: + erlc -Iinclude m1.erl \ No newline at end of file diff --git a/lib/common_test/test/erl2html2_SUITE_data/header1.hrl b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl new file mode 100644 index 0000000000..53d1b79ac5 --- /dev/null +++ b/lib/common_test/test/erl2html2_SUITE_data/header1.hrl @@ -0,0 +1,4 @@ +baz() -> + ok. + +-define(MACRO_DEFINING_A_FUNCTION,quux() -> ok). diff --git a/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header2.hrl new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl new file mode 100644 index 0000000000..2a20850a3a --- /dev/null +++ b/lib/common_test/test/erl2html2_SUITE_data/include/header3.hrl @@ -0,0 +1 @@ +-define(EPP_SWITCH, on). diff --git a/lib/common_test/test/erl2html2_SUITE_data/m1.erl b/lib/common_test/test/erl2html2_SUITE_data/m1.erl new file mode 100644 index 0000000000..1d405963a5 --- /dev/null +++ b/lib/common_test/test/erl2html2_SUITE_data/m1.erl @@ -0,0 +1,52 @@ +%% Comment with code & +%% and also some "quotes" and 'single quotes' + +-module(m1). + +-compile(export_all). + +-include("header1.hrl"). +-include("header2.hrl"). +-include("header3.hrl"). + +-define(MACRO1,value). + +%% This macro is used to select parser in erl2html2. +%% If EPP_SWITCH is defined epp is used, else epp_dodger. +epp_switch() -> + ?EPP_SWITCH. + +%%% Comment +foo(x) -> + %% Comment + ok_x; +foo(y) -> + %% Second clause + ok_y. + +'quoted_foo'() -> + ok. + +'quoted_foo_with_"_and_/'() -> + ok. + +'quoted_foo_with_(_and_)'() -> + ok. + +'quoted_foo_with_<_and_>'() -> + ok. + +bar() -> + do_something(), +ok. % indentation error, OTP-9710 + +%% Function inside macro definition +?MACRO_DEFINING_A_FUNCTION. + +%% Two function one one line +quuux() -> ok. quuuux() -> ok. + +%% do_something/0 does something +do_something() -> + ?MACRO1. +%% comments after last line diff --git a/lib/common_test/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl new file mode 100644 index 0000000000..d1c789f34c --- /dev/null +++ b/lib/common_test/test/test_server_SUITE.erl @@ -0,0 +1,449 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%%%------------------------------------------------------------------- +%%% @author Lukas Larsson +%%% @copyright (C) 2011, Erlang Solutions Ltd. +%%% @doc +%%% +%%% @end +%%% Created : 15 Feb 2011 by Lukas Larsson +%%%------------------------------------------------------------------- +-module(test_server_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_test_lib.hrl"). +-include_lib("kernel/include/file.hrl"). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%% @spec suite() -> Info +suite() -> + [{ct_hooks,[ts_install_cth,test_server_test_lib]}]. + + +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_suite(Config) -> + [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config]. + +%% @spec end_per_suite(Config) -> _ +end_per_suite(_Config) -> + io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]), + ok. + +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_group(_GroupName, Config) -> + Config. + +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +end_per_group(_GroupName, _Config) -> + ok. + +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_testcase(_TestCase, Config) -> + Config. + +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +end_per_testcase(test_server_unicode, _Config) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + N1 = list_to_atom("test_server_tester_latin1" ++ "@" ++ Host), + N2 = list_to_atom("test_server_tester_utf8" ++ "@" ++ Host), + test_server:stop_node(N1), + test_server:stop_node(N2), + ok; +end_per_testcase(_TestCase, _Config) -> + ok. + +%% @spec: groups() -> [Group] +groups() -> + []. + +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +all() -> + [test_server_SUITE, test_server_parallel01_SUITE, + test_server_conf02_SUITE, test_server_conf01_SUITE, + test_server_skip_SUITE, test_server_shuffle01_SUITE, + test_server_break_SUITE, test_server_cover_SUITE, + test_server_unicode]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- +%% @spec TestCase(Config0) -> +%% ok | exit() | {skip,Reason} | {comment,Comment} | +%% {save_config,Config1} | {skip_and_save,Reason,Config1} +test_server_SUITE(Config) -> +% rpc:call(Node,dbg, tracer,[]), +% rpc:call(Node,dbg, p,[all,c]), +% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), + run_test_server_tests("test_server_SUITE", + [{test_server_SUITE,skip_case7,"SKIPPED!"}], + 40, 1, 32, 21, 9, 1, 11, 2, 27, Config). + +test_server_parallel01_SUITE(Config) -> + run_test_server_tests("test_server_parallel01_SUITE", [], + 37, 0, 19, 19, 0, 0, 0, 0, 37, Config). + +test_server_shuffle01_SUITE(Config) -> + run_test_server_tests("test_server_shuffle01_SUITE", [], + 130, 0, 0, 76, 0, 0, 0, 0, 130, Config). + +test_server_skip_SUITE(Config) -> + run_test_server_tests("test_server_skip_SUITE", [], + 3, 0, 1, 0, 1, 0, 3, 0, 0, Config). + +test_server_conf01_SUITE(Config) -> + run_test_server_tests("test_server_conf01_SUITE", [], + 24, 0, 12, 12, 0, 0, 0, 0, 24, Config). + +test_server_conf02_SUITE(Config) -> + run_test_server_tests("test_server_conf02_SUITE", [], + 26, 0, 12, 12, 0, 0, 0, 0, 26, Config). + +test_server_break_SUITE(Config) -> + run_test_server_tests("test_server_break_SUITE", [], + 8, 2, 6, 4, 0, 0, 0, 2, 6, Config). + +test_server_cover_SUITE(Config) -> + case test_server:is_cover() of + true -> + {skip, "Cover already running"}; + false -> + PrivDir = ?config(priv_dir,Config), + + %% Test suite has two test cases + %% tc1 calls cover_helper:foo/0 + %% tc2 calls cover_helper:bar/0 + %% Each function in cover_helper is one line. + %% + %% First test run skips tc2, so only cover_helper:foo/0 is executed. + %% Cover file specifies to include cover_helper in this test run. + CoverFile1 = filename:join(PrivDir,"t1.cover"), + CoverSpec1 = {include,[cover_helper]}, + file:write_file(CoverFile1,io_lib:format("~p.~n",[CoverSpec1])), + run_test_server_tests("test_server_cover_SUITE", + [{test_server_cover_SUITE,tc2,"SKIPPED!"}], + 4, 0, 2, 1, 1, 0, 1, 0, 3, + CoverFile1, Config), + + %% Next test run skips tc1, so only cover_helper:bar/0 is executed. + %% Cover file specifies cross compilation of cover_helper + CoverFile2 = filename:join(PrivDir,"t2.cover"), + CoverSpec2 = {cross,[{t1,[cover_helper]}]}, + file:write_file(CoverFile2,io_lib:format("~p.~n",[CoverSpec2])), + run_test_server_tests("test_server_cover_SUITE", + [{test_server_cover_SUITE,tc1,"SKIPPED!"}], + 4, 0, 2, 1, 1, 0, 1, 0, 3, CoverFile2, Config), + + %% Cross cover analyse + WorkDir = ?config(work_dir,Config), + WC = filename:join([WorkDir,"test_server_cover_SUITE.logs","run.*"]), + [D2,D1|_] = lists:reverse(lists:sort(filelib:wildcard(WC))), + TagDirs = [{t1,D1},{t2,D2}], + test_server_ctrl:cross_cover_analyse(details,TagDirs), + + %% Check that cover log shows only what is really included + %% in the test and cross cover log show the accumulated + %% result. + {ok,Cover1} = file:read_file(filename:join(D1,"cover.log")), + [{cover_helper,{1,1,_}}] = binary_to_term(Cover1), + {ok,Cover2} = file:read_file(filename:join(D2,"cover.log")), + [] = binary_to_term(Cover2), + {ok,Cross} = file:read_file(filename:join(D1,"cross_cover.log")), + [{cover_helper,{2,0,_}}] = binary_to_term(Cross), + ok + end. + +test_server_unicode(Config) -> + run_test_server_tests("test_server_unicode_SUITE", [], + 5, 0, 3, 3, 0, 0, 0, 0, 5, Config), + + %% Create and run two test suites - one with filename and content + %% in latin1 (if the default filename mode is latin1) and one with + %% filename and content in utf8. Both have name and content + %% including letters äöå. Check that all logs are generated with + %% utf8 encoded filenames. + case file:native_name_encoding() of + utf8 -> + ok; + latin1 -> + generate_and_run_unicode_test(Config,latin1) + end, + generate_and_run_unicode_test(Config,utf8). + +%%%----------------------------------------------------------------- +run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, Config) -> + run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, false, Config). + +run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, Cover, Config) -> + Node = proplists:get_value(node, Config), + Encoding = rpc:call(Node,file,native_name_encoding,[]), + WorkDir = proplists:get_value(work_dir, Config), + LogDir = filename:join(WorkDir, SuiteName++".logs"), + LogDirUri = test_server_ctrl:uri_encode(LogDir, Encoding), + ct:log("Test case log files\n", [LogDirUri]), + + {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), + case Cover of + false -> + ok; + _ -> + rpc:call(Node,test_server_ctrl,cover,[Cover,details]) + end, + rpc:call(Node, + test_server_ctrl,add_dir_with_skip, + [SuiteName, + [proplists:get_value(data_dir,Config)],SuiteName, + Skip]), + + until(fun() -> + rpc:call(Node,test_server_ctrl,jobs,[]) =:= [] + end), + + rpc:call(Node,test_server_ctrl, stop, []), + + LogDir1 = translate_filename(LogDir,Encoding), + LastRunDir = get_latest_run_dir(LogDir1), + LastSuiteLog = filename:join(LastRunDir,"suite.log"), + {ok,Data} = test_server_test_lib:parse_suite(LastSuiteLog), + check([{"Number of cases",NCases,Data#suite.n_cases}, + {"Number failed",NFail,Data#suite.n_cases_failed}, + {"Number expected",NExpected,Data#suite.n_cases_expected}, + {"Number successful",NSucc,Data#suite.n_cases_succ}, + {"Number user skipped",NUsrSkip,Data#suite.n_cases_user_skip}, + {"Number auto skipped",NAutoSkip,Data#suite.n_cases_auto_skip}], ok), + {NActualSkip,NActualFail,NActualSucc} = + lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> + {S+1,F,Su}; + (#tc{ result = auto_skip },{S,F,Su}) -> + {S+1,F,Su}; + (#tc{ result = ok },{S,F,Su}) -> + {S,F,Su+1}; + (#tc{ result = failed },{S,F,Su}) -> + {S,F+1,Su} + end,{0,0,0},Data#suite.cases), + Data. + +translate_filename(Filename,EncodingOnTestNode) -> + case {file:native_name_encoding(),EncodingOnTestNode} of + {X,X} -> Filename; + {utf8,latin1} -> list_to_binary(Filename); + {latin1,utf8} -> unicode:characters_to_binary(Filename) + end. + +get_latest_run_dir(Dir) -> + %% For the time being, filelib:wildcard can not take a binary + %% argument, so we avoid using this here. + case file:list_dir(Dir) of + {ok,Files} -> + {ok,RE} = re:compile(<<"^run.[1-2][-_\.0-9]*$">>), + RunDirs = lists:filter( + fun(F) -> + L = l(F), + case re:run(F,RE) of + {match,[{0,L}]} -> true; + _ -> false + end + end, Files), + case RunDirs of + [] -> + Dir; + [H|T] -> + filename:join(Dir,get_latest_dir(T,H)) + end; + _ -> + Dir + end. + +l(X) when is_binary(X) -> size(X); +l(X) when is_list(X) -> length(X). + +get_latest_dir([H|T],Latest) when H>Latest -> + get_latest_dir(T,H); +get_latest_dir([_|T],Latest) -> + get_latest_dir(T,Latest); +get_latest_dir([],Latest) -> + Latest. + +check([{Str,Same,Same}|T], Status) -> + io:format("~s: ~p\n", [Str,Same]), + check(T, Status); +check([{Str,Expected,Actual}|T], _) -> + io:format("~s: expected ~p, actual ~p\n", [Str,Expected,Actual]), + check(T, error); +check([], ok) -> ok; +check([], error) -> ?t:fail(). + +until(Fun) -> + case Fun() of + true -> + ok; + false -> + timer:sleep(100), + until(Fun) + end. + +generate_and_run_unicode_test(Config0,Encoding) -> + DataDir = ?config(data_dir,Config0), + Suite = create_unicode_test_suite(DataDir,Encoding), + + %% We can not run this test on default node since it must be + %% started with correct file name mode (+fnu/+fnl). + %% OBS: the node are stopped by end_per_testcase/2 + Config1 = lists:keydelete(node,1,Config0), + Config2 = lists:keydelete(work_dir,1,Config1), + NodeName = list_to_atom("test_server_tester_" ++ atom_to_list(Encoding)), + Config = start_node(Config2,NodeName,erts_switch(Encoding)), + + %% Compile the suite + Node = proplists:get_value(node,Config), + {ok,Mod} = rpc:call(Node,compile,file,[Suite,[report,{outdir,DataDir}]]), + ModStr = atom_to_list(Mod), + + %% Clean logdir + LogDir0 = filename:join(DataDir,ModStr++".logs"), + LogDir = translate_filename(LogDir0,Encoding), + rm_dir(LogDir), + + %% Run the test + run_test_server_tests(ModStr, [], 3, 0, 1, 1, 0, 0, 0, 0, 3, Config), + + %% Check that all logs are created with utf8 encoded filenames + true = filelib:is_dir(LogDir), + + RunDir = get_latest_run_dir(LogDir), + true = filelib:is_dir(RunDir), + + LowerModStr = string:to_lower(ModStr), + SuiteHtml = translate_filename(LowerModStr++".src.html",Encoding), + true = filelib:is_regular(filename:join(RunDir,SuiteHtml)), + + TCLog = translate_filename(LowerModStr++".tc_äöå.html",Encoding), + true = filelib:is_regular(filename:join(RunDir,TCLog)), + ok. + +%% Same as test_server_test_lib:start_slave, but starts a peer with +%% additional arguments. +%% The reason for this is that we need to start nodes with +fnu/+fnl, +%% and that will not work well with a slave node since slave nodes run +%% remote file system on master - i.e. they will use same file name +%% mode as the master. +start_node(Config,Name,Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n",[Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + test_server_test_lib:prepare_tester_node(Node,Config) + end. + +create_unicode_test_suite(Dir,Encoding) -> + ModStr = "test_server_"++atom_to_list(Encoding)++"_äöå_SUITE", + File = filename:join(Dir,ModStr++".erl"), + Suite = + ["%% -*- ",epp:encoding_to_string(Encoding)," -*-\n", + "-module(",ModStr,").\n" + "\n" + "-export([all/1, init_per_suite/1, end_per_suite/1]).\n" + "-export([init_per_testcase/2, end_per_testcase/2]).\n" + "-export([tc_äöå/1]).\n" + "\n" + "-include_lib(\"common_test/include/ct.hrl\").\n" + "\n" + "all(suite) ->\n" + " [tc_äöå].\n" + "\n" + "init_per_suite(Config) ->\n" + " Config.\n" + "\n" + "end_per_suite(_Config) ->\n" + " ok.\n" + "\n" + "init_per_testcase(_Case,Config) ->\n" + " init_timetrap(500,Config).\n" + "\n" + "init_timetrap(T,Config) ->\n" + " Dog = ?t:timetrap(T),\n" + " [{watchdog, Dog}|Config].\n" + "\n" + "end_per_testcase(_Case,Config) ->\n" + " cancel_timetrap(Config).\n" + "\n" + "cancel_timetrap(Config) ->\n" + " Dog=?config(watchdog, Config),\n" + " ?t:timetrap_cancel(Dog),\n" + " ok.\n" + "\n" + "tc_äöå(Config) when is_list(Config) ->\n" + " true = filelib:is_dir(?config(priv_dir,Config)),\n" + " ok.\n"], + {ok,Fd} = file:open(raw_filename(File,Encoding),[write,{encoding,Encoding}]), + io:put_chars(Fd,Suite), + ok = file:close(Fd), + File. + +raw_filename(Name,latin1) -> list_to_binary(Name); +raw_filename(Name,utf8) -> unicode:characters_to_binary(Name). + +rm_dir(Dir) -> + case file:list_dir(Dir) of + {error,enoent} -> + ok; + {ok,Files} -> + rm_files([filename:join(Dir, F) || F <- Files]), + file:del_dir(Dir) + end. + +rm_files([F | Fs]) -> + case file:read_file_info(F) of + {ok,#file_info{type=directory}} -> + rm_dir(F), + rm_files(Fs); + {ok,_Regular} -> + case file:delete(F) of + ok -> + rm_files(Fs); + {error,Errno} -> + exit({del_failed,F,Errno}) + end + end; +rm_files([]) -> + ok. + +erts_switch(latin1) -> "+fnl"; +erts_switch(utf8) -> "+fnu". diff --git a/lib/common_test/test/test_server_SUITE_data/Makefile.src b/lib/common_test/test/test_server_SUITE_data/Makefile.src new file mode 100644 index 0000000000..5aeb035572 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/Makefile.src @@ -0,0 +1,11 @@ +all: + erlc test_server_SUITE.erl + erlc test_server_parallel01_SUITE.erl + erlc test_server_conf01_SUITE.erl + erlc test_server_shuffle01_SUITE.erl + erlc test_server_conf02_SUITE.erl + erlc test_server_skip_SUITE.erl + erlc test_server_break_SUITE.erl + erlc test_server_cover_SUITE.erl + erlc +debug_info test_server_cover_SUITE_data/cover_helper.erl + erlc test_server_unicode_SUITE.erl diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl new file mode 100644 index 0000000000..c3d4315cb8 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE.erl @@ -0,0 +1,514 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). +-export([all/1]). + +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). +-export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, + init_per_s/1, init_per_tc/1, end_per_tc/1, + timeconv/1, msgs/1, capture/1, timecall/1, + do_times/1, do_times_mfa/1, do_times_fun/1, + skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, + skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, + skip_case8/1, skip_case9/1, + conf_init/1, check_new_conf/1, conf_cleanup/1, + check_old_conf/1, conf_init_fail/1, start_stop_node/1, + cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, + commercial/1, + io_invalid_data/1, print_unexpected/1]). + +-export([dummy_function/0,dummy_function/1,doer/1]). + +all(doc) -> ["Test Server self test"]; +all(suite) -> + [config, comment, timetrap, timetrap_cancel, multiply_timetrap, + init_per_s, init_per_tc, end_per_tc, + timeconv, msgs, capture, timecall, do_times, skip_cases, + commercial, io_invalid_data, print_unexpected, + {conf, conf_init, [check_new_conf], conf_cleanup}, + check_old_conf, + {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, + start_stop_node, + {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, + config + ]. + + +init_per_suite(Config) -> + [{init_per_suite_var,ok}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + Config1 = [{watchdog, Dog}|Config], + case Func of + init_per_tc -> + [{strange_var, 1}|Config1]; + skip_case8 -> + {skipped, "This case should be noted as `Skipped'"}; + skip_case9 -> + {skip, "This case should be noted as `Skipped'"}; + _ -> + Config1 + end; +init_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to init_per_testcase not correct"). + +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + case Func of + end_per_tc -> io:format("CLEANUP => this test case is ok\n"); + _Other -> ok + end; +end_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to end_per_testcase not correct"). + +fin_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + + +config(suite) -> []; +config(doc) -> ["Test that the Config variable is decent, ", + "and that the std config variables are correct ", + "(check that data/priv dir exists)." + "Also check that ?config macro works."]; +config(Config) when is_list(Config) -> + is_tuplelist(Config), + {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), + true=is_dir(Dd), + {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), + true=is_dir(Dp), + + Dd = ?config(data_dir,Config), + Dp = ?config(priv_dir,Config), + ok; +config(_Config) -> + ?t:fail("Config variable is not a list."). + +is_tuplelist([]) -> + true; +is_tuplelist([{_A,_B}|Rest]) -> + is_tuplelist(Rest); +is_tuplelist(_) -> + false. + +is_dir(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type=directory}} -> + true; + _ -> + false + end. + +comment(suite) -> []; +comment(doc) -> ["Print a comment in the HTML log"]; +comment(Config) when is_list(Config) -> + ?t:comment("This comment should not occur in the HTML log because a later" + " comment shall overwrite it"), + ?t:comment("This comment is printed with the comment/1 function." + " It should occur in the HTML log"). + + + +timetrap(suite) -> []; +timetrap(doc) -> ["Test that timetrap works."]; +timetrap(Config) when is_list(Config) -> + TrapAfter = 3000, + Dog=?t:timetrap(TrapAfter), + process_flag(trap_exit, true), + TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, + receive + {'EXIT', Dog, {timetrap_timeout, _, _}} -> + ok; + {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> + ?t:fail("EXIT signal from wrong process") + after + TimeOut -> + ?t:fail("Timetrap is not working.") + end, + ?t:timetrap_cancel(Dog), + ok. + + +timetrap_cancel(suite) -> []; +timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; +timetrap_cancel(Config) when is_list(Config) -> + Dog=?t:timetrap(1000), + receive + after + 500 -> + ok + end, + ?t:timetrap_cancel(Dog), + receive + after 1000 -> + ok + end, + ok. + +multiply_timetrap(suite) -> []; +multiply_timetrap(doc) -> ["Test multiply timetrap"]; +multiply_timetrap(Config) when is_list(Config) -> + %% This simulates the call to test_server_ctrl:multiply_timetraps/1: + put(test_server_multiply_timetraps,{2,true}), + + Dog = ?t:timetrap(500), + timer:sleep(800), + ?t:timetrap_cancel(Dog), + + %% Reset + put(test_server_multiply_timetraps,1), + ok. + + +init_per_s(suite) -> []; +init_per_s(doc) -> ["Test that a Config that is altered in ", + "init_per_suite gets through to the testcases."]; +init_per_s(Config) -> + %% Check that the config var sent from init_per_suite + %% really exists. + {value, {init_per_suite_var, ok}} = + lists:keysearch(init_per_suite_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +init_per_tc(suite) -> []; +init_per_tc(doc) -> ["Test that a Config that is altered in ", + "init_per_testcase gets through to the ", + "actual testcase."]; +init_per_tc(Config) -> + %% Check that the config var sent from init_per_testcase + %% really exists. + {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +end_per_tc(suite) -> []; +end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" + " test case fails"]; +end_per_tc(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that \"CLEANUP\" is" + " printed in the minor log file."). + + +timeconv(suite) -> []; +timeconv(doc) -> ["Test that the time unit conversion functions ", + "works."]; +timeconv(Config) when is_list(Config) -> + Val=2, + Secs=Val*1000, + Mins=Secs*60, + Hrs=Mins*60, + Secs=?t:seconds(2), + Mins=?t:minutes(2), + Hrs=?t:hours(2), + ok. + + +msgs(suite) -> []; +msgs(doc) -> ["Tests the messages_get function."]; +msgs(Config) when is_list(Config) -> + self() ! {hej, du}, + self() ! {lite, "data"}, + self() ! en_atom, + [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), + ok. + +capture(suite) -> []; +capture(doc) -> ["Test that the capture functions work properly."]; +capture(Config) when is_list(Config) -> + String1="abcedfghjiklmnopqrstuvwxyz", + String2="0123456789", + ?t:capture_start(), + io:format(String1), + [String1]=?t:capture_get(), + io:format(String2), + [String2]=?t:capture_get(), + ?t:capture_stop(), + []=?t:capture_get(), + io:format(String2), + []=?t:capture_get(), + ok. + +timecall(suite) -> []; +timecall(doc) -> ["Tests that timed calls work."]; +timecall(Config) when is_list(Config) -> + {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), + {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), + DTime=round(Time2), + if + DTime<1 -> + ?t:fail("Timecall reported a too low time."); + DTime==1 -> + ok; + DTime>1 -> + ?t:fail("Timecall reported a too high time.") + end, + ok. + +dummy_function() -> + liten_apa_e_oxo_farlig. +dummy_function(gorilla) -> + receive after 1000 -> ok end, + jag_ar_en_gorilla. + + +do_times(suite) -> [do_times_mfa, do_times_fun]; +do_times(doc) -> ["Test the do_times function."]. + +do_times_mfa(suite) -> []; +do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; +do_times_mfa(Config) when is_list(Config) -> + ?t:do_times(100, ?MODULE, doer, [self()]), + 100=length(?t:messages_get()), + ok. + +do_times_fun(suite) -> []; +do_times_fun(doc) -> ["Test the do_times function with fun given."]; +do_times_fun(Config) when is_list(Config) -> + Self = self(), + ?t:do_times(100, fun() -> doer(Self) end), + 100=length(?t:messages_get()), + ok. + +doer(From) -> + From ! a, + ok. + +skip_cases(doc) -> ["Test all possible ways to skip a test case."]; +skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, + skip_case5, skip_case6, skip_case7, skip_case8, + skip_case9]. + +skip_case1(suite) -> []; +skip_case1(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case1(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + {skipped, "This case should be noted as `Skipped'"}. + +skip_case2(suite) -> []; +skip_case2(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case2(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + exit({skipped, "This case should be noted as `Skipped'"}). + +skip_case3(suite) -> []; +skip_case3(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case3(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + {skip, "This case should be noted as `Skipped'"}. + +skip_case4(suite) -> []; +skip_case4(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case4(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + exit({skip, "This case should be noted as `Skipped'"}). + +skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; +skip_case5(doc) -> ["Test that you can return {skipped, Reason}" + " from the specification clause"]. + +skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; +skip_case6(doc) -> ["Test that you can return {skip, Reason}" + " from the specification clause"]. + +skip_case7(suite) -> []; +skip_case7(doc) -> ["Test that skip works from a test specification file"]; +skip_case7(Config) when is_list(Config) -> + %% This case shall be skipped by adding + %% {skip, {test_server_SUITE, skip_case7, Reason}}. + %% to the test specification file. + ?t:fail("This case should have been Skipped by the .spec file"). + +skip_case8(suite) -> []; +skip_case8(doc) -> ["Test that {skipped, Reason} works from" + " init_per_testcase/2"]; +skip_case8(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skipped, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +skip_case9(suite) -> []; +skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; +skip_case9(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skip, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; +conf_init(Config) when is_list(Config) -> + [{conf_init_var,1389}|Config]. + +check_new_conf(suite) -> []; +check_new_conf(doc) -> ["Check that Config parameter changed by" + " conf_init is used"]; +check_new_conf(Config) when is_list(Config) -> + 1389 = ?config(conf_init_var,Config), + ok. + +conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; +conf_cleanup(Config) when is_list(Config) -> + lists:keydelete(conf_init_var,1,Config). + +check_old_conf(suite) -> []; +check_old_conf(doc) -> ["Test that the restored Config is used after a" + " conf cleanup"]; +check_old_conf(Config) when is_list(Config) -> + undefined = ?config(conf_init_var,Config), + ok. + +conf_init_fail(doc) -> ["Test that config members are skipped if" + " conf init function fails."]; +conf_init_fail(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that conf_member_skip and" + " conf_cleanup_skip are skipped."). + + + +start_stop_node(suite) -> []; +start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; +start_stop_node(Config) when is_list(Config) -> + {ok,Node2} = ?t:start_node(node2,peer,[]), + {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), + true = lists:member(Node2,nodes()), + + {ok,Node3} = ?t:start_node(node3,slave,[]), + {error, _} = ?t:start_node(node3,slave,[]), + true = lists:member(Node3,nodes()), + + {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), + case lists:member(Node4,nodes()) of + true -> + ?t:comment("WARNING: Node started with {wait,false}" + " is up faster than expected..."); + false -> + test_server:wait_for_node(Node4), + true = lists:member(Node4,nodes()) + end, + + true = ?t:stop_node(Node2), + false = lists:member(Node2,nodes()), + + true = ?t:stop_node(Node3), + false = lists:member(Node3,nodes()), + + true = ?t:stop_node(Node4), + false = lists:member(Node4,nodes()), + timer:sleep(2000), + false = ?t:stop_node(Node4), + + ok. + +cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" + " is finished unless {cleanup,false} is given."]; +cleanup_nodes_init(Config) when is_list(Config) -> + {ok,DieSlave} = ?t:start_node(die_slave, slave, []), + {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), + {ok,DiePeer} = ?t:start_node(die_peer, peer, []), + {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), + [{die_slave,DieSlave}, + {survive_slave,SurviveSlave}, + {die_peer,DiePeer}, + {survive_peer,SurvivePeer} | Config]. + + + +check_survive_nodes(suite) -> []; +check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; +check_survive_nodes(Config) when is_list(Config) -> + timer:sleep(1000), + false = lists:member(?config(die_slave,Config),nodes()), + true = lists:member(?config(survive_slave,Config),nodes()), + false = lists:member(?config(die_peer,Config),nodes()), + true = lists:member(?config(survive_peer,Config),nodes()), + ok. + + +cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" + " can be stopped"]; +cleanup_nodes_fin(Config) when is_list(Config) -> + Slave = ?config(survive_slave,Config), + Peer = ?config(survive_peer,Config), + + true = ?t:stop_node(Slave), + false = lists:member(Slave,nodes()), + true = ?t:stop_node(Peer), + false = lists:member(Peer,nodes()), + + C1 = lists:keydelete(die_slave,1,Config), + C2 = lists:keydelete(survive_slave,1,C1), + C3 = lists:keydelete(die_peer,1,C2), + lists:keydelete(survive_peer,1,C3). + +commercial(Config) when is_list(Config) -> + case ?t:is_commercial() of + false -> {comment,"Open-source build"}; + true -> {comment,"Commercial build"} + end. + +io_invalid_data(Config) when is_list(Config) -> + ok = io:put_chars("valid: " ++ [42]), + %% OTP-10991 caused this to hang and produce a timetrap timeout: + {'EXIT',{badarg,_}} = (catch io:put_chars("invalid: " ++ [42.0])), + ok. + +print_unexpected(Config) when is_list(Config) -> + Str = "-x-x-x- test_server_SUITE:print_unexpected -> Unexpected data -x-x-x-", + test_server_io:print_unexpected(Str), + UnexpectedLog = filename:join(filename:dirname(?config(tc_logfile,Config)), + "unexpected_io.log.html"), + {ok,Bin} = file:read_file(UnexpectedLog), + match = re:run(Bin, Str, [global,{capture,none}]), + ok. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file new file mode 100644 index 0000000000..65c88fbd75 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file @@ -0,0 +1 @@ +Dummy file. \ No newline at end of file diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl new file mode 100644 index 0000000000..171f83df0f --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_break_SUITE.erl @@ -0,0 +1,149 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_break_SUITE). + +-export([all/1, init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). +-export([break_in_init_tc/1, + break_in_tc/1, + break_in_end_tc/1, + break_in_end_tc_after_fail/1, + break_in_end_tc_after_abort/1, + check_all_breaks/1]). + +-include_lib("common_test/include/ct.hrl"). + +all(suite) -> + [break_in_init_tc, + break_in_tc, + break_in_end_tc, + break_in_end_tc_after_fail, + break_in_end_tc_after_abort, + check_all_breaks]. %must be the last test - checks result of previous tests + +init_per_suite(Config) -> + spawn(fun break_and_continue_sup/0), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Case,Config) when Case==break_in_init_tc -> + Config1 = init_timetrap(500,Config), + break_and_check(Case), + Config1; +init_per_testcase(Case,Config) when Case==check_all_breaks -> + init_timetrap({seconds,20},Config); +init_per_testcase(_Case,Config) -> + init_timetrap(500,Config). + +init_timetrap(T,Config) -> + Dog = ?t:timetrap(T), + [{watchdog, Dog}|Config]. + +end_per_testcase(Case,Config) when Case==break_in_end_tc; + Case==break_in_end_tc_after_fail; + Case==break_in_end_tc_after_abort -> + break_and_check(Case), + cancel_timetrap(Config); +end_per_testcase(_Case,Config) -> + cancel_timetrap(Config). + +cancel_timetrap(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + + +%%%----------------------------------------------------------------- +%%% Test cases + +break_in_init_tc(Config) when is_list(Config) -> + ok. + +break_in_tc(Config) when is_list(Config) -> + break_and_check(break_in_tc), + ok. + +break_in_end_tc(Config) when is_list(Config) -> + ok. + +break_in_end_tc_after_fail(Config) when is_list(Config) -> + ?t:fail(test_case_should_fail). + +break_in_end_tc_after_abort(Config) when is_list(Config) -> + ?t:adjusted_sleep(2000). % will cause a timetrap timeout + +%% This test case checks that all breaks in previous test cases was +%% also continued, and that the break lasted as long as expected. +%% The reason for this is that some of the breaks above are in +%% end_per_testcase, and failures there will only produce a warning, +%% not an error - so this is to catch the error for real. +check_all_breaks(Config) when is_list(Config) -> + break_and_continue_sup ! {done,self()}, + receive {Breaks,Continued} -> + check_all_breaks(Breaks,Continued) + end. +%%%----------------------------------------------------------------- +%%% Internal functions + + +check_all_breaks([{From,Case,T,Start}|Breaks],[{From,End}|Continued]) -> + Diff = timer:now_diff(End,Start), + DiffSec = round(Diff/1000000), + TSec = round(T/1000000), + if DiffSec==TSec -> + ?t:format("Break in ~p successfully continued after ~p second(s)~n", + [Case,DiffSec]), + check_all_breaks(Breaks,Continued); + true -> + ?t:format("Faulty duration of break in ~p: continued after ~p second(s)~n", + [Case,DiffSec]), + ?t:fail({faulty_diff,Case,DiffSec,TSec}) + end; +check_all_breaks([],[]) -> + ok; +check_all_breaks(Breaks,Continued) -> + %% This is probably a case of a missing continue - i.e. a break + %% has been started, but it was never continued. + ?t:fail({no_match_in_breaks_and_continued,Breaks,Continued}). + +break_and_check(Case) -> + break_and_continue_sup ! {break,Case,1000,self()}, + ?t:break(atom_to_list(Case)), + break_and_continue_sup ! {continued,self()}, + ok. + +break_and_continue_sup() -> + register(break_and_continue_sup,self()), + break_and_continue_loop([],[]). + +break_and_continue_loop(Breaks,Continued) -> + receive + {break,Case,T,From} -> + Start = now(), + {RealT,_} = timer:tc(?t,adjusted_sleep,[T]), + ?t:continue(), + break_and_continue_loop([{From,Case,RealT,Start}|Breaks],Continued); + {continued,From} -> + break_and_continue_loop(Breaks,[{From,now()}|Continued]); + {done,From} -> + From ! {lists:reverse(Breaks),lists:reverse(Continued)} + end. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl new file mode 100644 index 0000000000..e4f40f6c03 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf01_SUITE.erl @@ -0,0 +1,188 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_conf01_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +all(doc) -> ["Test simple conf case structure, with and without nested cases"]; +all(suite) -> + [ + {conf, conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, + + {conf, [], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, + + {conf, conf3_init, [conf3_tc1, + + {conf, [], conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, + + conf3_tc2], conf3_end}, + + conf5 + ]. + +%%---------- conf cases ---------- + +conf1_init(Config) when is_list(Config) -> + [{cc1,conf1}|Config]. +conf1_end(_Config) -> + ok. + +conf2_init(Config) when is_list(Config) -> + [{cc2,conf2}|Config]. +conf2_end(_Config) -> + ok. + +conf3_init(Config) when is_list(Config) -> + [{cc3,conf3}|Config]. +conf3_end(_Config) -> + ok. + +conf4_init(Config) when is_list(Config) -> + [{cc4,conf4}|Config]. +conf4_end(_Config) -> + ok. + +conf5_init(Config) when is_list(Config) -> + [{cc5,conf5}|Config]. +conf5_end(_Config) -> + ok. + +conf6_init(Config) when is_list(Config) -> + [{cc6,conf6}|Config]. +conf6_end(_Config) -> + ok. + + +conf5(suite) -> % test specification + [{conf, conf5_init, [conf5_tc1, + + {conf, [], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, + + conf5_tc2], conf5_end}]. + + +%%---------- test cases ---------- + +conf1_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + conf1 = ?config(cc1,Config), + ok. +conf1_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf1 = ?config(cc1,Config), + ok. + +conf2_tc1(Config) when is_list(Config) -> + undefined = ?config(cc1,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + conf2 = ?config(cc2,Config), + ok. +conf2_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf2 = ?config(cc2,Config), + ok. + +conf3_tc1(Config) when is_list(Config) -> + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + ok. +conf3_tc2(Config) when is_list(Config) -> + conf3 = ?config(cc3,Config), + undefined = ?config(cc4,Config), + ok. + +conf4_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + ok. +conf4_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + ok. + +conf5_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + ok. +conf5_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + undefined = ?config(cc6,Config), + ok. + +conf6_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + ok. +conf6_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + ok. + diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl new file mode 100644 index 0000000000..1c6fe6dd0b --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_conf02_SUITE.erl @@ -0,0 +1,295 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_conf02_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +all(doc) -> ["Test simple conf case structure, with and without nested cases"]; +all(suite) -> + [ + {conf, conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, + + {conf, [], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, + + {conf, conf3_init, [conf3_tc1, + + {conf, [], conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, + + conf3_tc2], conf3_end}, + + conf5 + ]. + + +%%---------- conf cases ---------- + +init_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + [{suite,init}|Config]. +end_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + ok. + +init_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + [{tc11,TC}|Config]; +init_per_testcase(TC=conf1_tc2, Config) -> + [{tc12,TC}|Config]; +init_per_testcase(TC=conf2_tc1, Config) -> + [{tc21,TC}|Config]; +init_per_testcase(TC=conf2_tc2, Config) -> + [{tc22,TC}|Config]; +init_per_testcase(TC=conf3_tc1, Config) -> + [{tc31,TC}|Config]; +init_per_testcase(TC=conf3_tc2, Config) -> + [{tc32,TC}|Config]; +init_per_testcase(TC=conf4_tc1, Config) -> + [{tc41,TC}|Config]; +init_per_testcase(TC=conf4_tc2, Config) -> + [{tc42,TC}|Config]; +init_per_testcase(TC=conf5_tc1, Config) -> + [{tc51,TC}|Config]; +init_per_testcase(TC=conf5_tc2, Config) -> + [{tc52,TC}|Config]; +init_per_testcase(TC=conf6_tc1, Config) -> + [{tc61,TC}|Config]; +init_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + [{tc62,TC}|Config]. + +end_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + TC = ?config(tc11,Config), + ok; +end_per_testcase(TC=conf1_tc2, Config) -> + TC = ?config(tc12,Config), + ok; +end_per_testcase(TC=conf2_tc1, Config) -> + TC = ?config(tc21,Config), + ok; +end_per_testcase(TC=conf2_tc2, Config) -> + TC = ?config(tc22,Config), + ok; +end_per_testcase(TC=conf3_tc1, Config) -> + TC = ?config(tc31,Config), + ok; +end_per_testcase(TC=conf3_tc2, Config) -> + TC = ?config(tc32,Config), + ok; +end_per_testcase(TC=conf4_tc1, Config) -> + TC = ?config(tc41,Config), + ok; +end_per_testcase(TC=conf4_tc2, Config) -> + TC = ?config(tc42,Config), + ok; +end_per_testcase(TC=conf5_tc1, Config) -> + TC = ?config(tc51,Config), + ok; +end_per_testcase(TC=conf5_tc2, Config) -> + TC = ?config(tc52,Config), + ok; +end_per_testcase(TC=conf6_tc1, Config) -> + TC = ?config(tc61,Config), + ok; +end_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + TC = ?config(tc62,Config), + ok. + +conf1_init(Config) when is_list(Config) -> + init = ?config(suite,Config), + [{cc1,conf1}|Config]. +conf1_end(_Config) -> + ok. + +conf2_init(Config) when is_list(Config) -> + [{cc2,conf2}|Config]. +conf2_end(_Config) -> + ok. + +conf3_init(Config) when is_list(Config) -> + [{cc3,conf3}|Config]. +conf3_end(_Config) -> + ok. + +conf4_init(Config) when is_list(Config) -> + [{cc4,conf4}|Config]. +conf4_end(_Config) -> + ok. + +conf5_init(Config) when is_list(Config) -> + [{cc5,conf5}|Config]. +conf5_end(_Config) -> + ok. + +conf6_init(Config) when is_list(Config) -> + init = ?config(suite,Config), + [{cc6,conf6}|Config]. +conf6_end(_Config) -> + ok. + +conf5(suite) -> % test specification + [{conf, conf5_init, [conf5_tc1, + + {conf, [], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, + + conf5_tc2], conf5_end}]. + +%%---------- test cases ---------- + +conf1_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc1 = ?config(tc11,Config), + ok. +conf1_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc2 = ?config(tc12,Config), + ok. + +conf2_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + undefined = ?config(cc1,Config), + undefined = ?config(tc11,Config), + conf2 = ?config(cc2,Config), + conf2_tc1 = ?config(tc21,Config), + ok. +conf2_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + conf2 = ?config(cc2,Config), + undefined = ?config(tc21,Config), + conf2_tc2 = ?config(tc22,Config), + ok. + +conf3_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + undefined = ?config(cc2,Config), + undefined = ?config(tc22,Config), + conf3 = ?config(cc3,Config), + conf3_tc1 = ?config(tc31,Config), + ok. +conf3_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + conf3 = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(tc31,Config), + undefined = ?config(tc41,Config), + conf3_tc2 = ?config(tc32,Config), + ok. + +conf4_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + undefined = ?config(tc32,Config), + conf4_tc1 = ?config(tc41,Config), + ok. +conf4_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + undefined = ?config(tc41,Config), + conf4_tc2 = ?config(tc42,Config), + ok. + +conf5_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + undefined = ?config(tc42,Config), + conf5_tc1 = ?config(tc51,Config), + ok. +conf5_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + undefined = ?config(cc6,Config), + undefined = ?config(tc51,Config), + undefined = ?config(tc62,Config), + conf5_tc2 = ?config(tc52,Config), + ok. + +conf6_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + undefined = ?config(tc52,Config), + conf6_tc1 = ?config(tc61,Config), + ok. +conf6_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + undefined = ?config(tc61,Config), + conf6_tc2 = ?config(tc62,Config), + ok. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl new file mode 100644 index 0000000000..3371418980 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_cover_SUITE). + +-export([all/1, init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). +-export([tc1/1, tc2/1]). + +-include_lib("common_test/include/ct.hrl"). + +all(suite) -> + [tc1,tc2]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Case,Config) -> + Dog = ?t:timetrap({minutes,10}), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case,Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + + +%%%----------------------------------------------------------------- +%%% Test cases +tc1(Config) when is_list(Config) -> + cover_helper:foo(), + ok. + +tc2(Config) when is_list(Config) -> + cover_helper:bar(), + ok. + +%%%----------------------------------------------------------------- +%%% Internal functions + diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl new file mode 100644 index 0000000000..6c74eb4e8a --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl @@ -0,0 +1,4 @@ +-module(cover_helper). +-compile(export_all). +foo() -> ok. +bar() -> ok. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl new file mode 100644 index 0000000000..ad639b585d --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl @@ -0,0 +1,519 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_parallel01_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +%% ------------------------------------------------------------------- +%% Notes on parallel execution of test cases +%% ------------------------------------------------------------------- +%% +%% A group nested under a parallel group will start executing in +%% parallel with previous (parallel) test cases (no matter what +%% properties the nested group has). Test cases are however never +%% executed in parallel with the start or end conf case of the same +%% group! Because of this, the test_server_ctrl loop waits at +%% the end conf of a group for all parallel cases to finish +%% before the end conf case actually executes. This has the effect +%% that it's only after a nested group has finished that any +%% remaining parallel cases in the previous group get spawned (*). +%% Example (all parallel cases): +%% +%% group1_init |----> +%% group1_case1 | ---------> +%% group1_case2 | ---------------------------------> +%% group2_init | ----> +%% group2_case1 | ------> +%% group2_case2 | ----------> +%% group2_end | ---> +%% group1_case3 (*)| ----> +%% group1_case4 (*)| --> +%% group1_end | ---> +%% + +all(doc) -> ["Test simple conf case structure, with and without nested cases"]; +all(suite) -> + [ + {conf, [parallel], conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, + + {conf, [parallel], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, + + {conf, [parallel], conf3_init, [conf3_tc1, conf3_tc1, + + {conf, [], + conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, + + conf3_tc2], conf3_end}, + + conf5, + + {conf, [parallel], conf7_init, [conf7_tc1, conf7_tc1, + + {conf, [parallel], + conf8_init, [conf8_tc1, conf8_tc2], conf8_end}, + + conf7_tc2], conf7_end} + + ]. + + +%%---------- conf cases ---------- + +init_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + [{suite,init}|Config]. +end_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + ok. + +init_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + [{tc11,TC}|Config]; +init_per_testcase(TC=conf1_tc2, Config) -> + [{tc12,TC}|Config]; +init_per_testcase(TC=conf2_tc1, Config) -> + [{tc21,TC}|Config]; +init_per_testcase(TC=conf2_tc2, Config) -> + [{tc22,TC}|Config]; +init_per_testcase(TC=conf3_tc1, Config) -> + [{tc31,TC}|Config]; +init_per_testcase(TC=conf3_tc2, Config) -> + [{tc32,TC}|Config]; +init_per_testcase(TC=conf4_tc1, Config) -> + [{tc41,TC}|Config]; +init_per_testcase(TC=conf4_tc2, Config) -> + [{tc42,TC}|Config]; +init_per_testcase(TC=conf5_tc1, Config) -> + [{tc51,TC}|Config]; +init_per_testcase(TC=conf5_tc2, Config) -> + [{tc52,TC}|Config]; +init_per_testcase(TC=conf6_tc1, Config) -> + [{tc61,TC}|Config]; +init_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + [{tc62,TC}|Config]; +init_per_testcase(TC=conf7_tc1, Config) -> + [{tc71,TC}|Config]; +init_per_testcase(TC=conf7_tc2, Config) -> + [{tc72,TC}|Config]; +init_per_testcase(TC=conf8_tc1, Config) -> + [{tc81,TC}|Config]; +init_per_testcase(TC=conf8_tc2, Config) -> + init = ?config(suite,Config), + [{tc82,TC}|Config]. + +end_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + TC = ?config(tc11,Config), + ok; +end_per_testcase(TC=conf1_tc2, Config) -> + TC = ?config(tc12,Config), + ok; +end_per_testcase(TC=conf2_tc1, Config) -> + TC = ?config(tc21,Config), + ok; +end_per_testcase(TC=conf2_tc2, Config) -> + TC = ?config(tc22,Config), + ok; +end_per_testcase(TC=conf3_tc1, Config) -> + TC = ?config(tc31,Config), + ok; +end_per_testcase(TC=conf3_tc2, Config) -> + TC = ?config(tc32,Config), + ok; +end_per_testcase(TC=conf4_tc1, Config) -> + TC = ?config(tc41,Config), + ok; +end_per_testcase(TC=conf4_tc2, Config) -> + TC = ?config(tc42,Config), + ok; +end_per_testcase(TC=conf5_tc1, Config) -> + TC = ?config(tc51,Config), + ok; +end_per_testcase(TC=conf5_tc2, Config) -> + TC = ?config(tc52,Config), + ok; +end_per_testcase(TC=conf6_tc1, Config) -> + TC = ?config(tc61,Config), + ok; +end_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + TC = ?config(tc62,Config), + ok; +end_per_testcase(TC=conf7_tc1, Config) -> + TC = ?config(tc71,Config), + ok; +end_per_testcase(TC=conf7_tc2, Config) -> + TC = ?config(tc72,Config), + ok; +end_per_testcase(TC=conf8_tc1, Config) -> + TC = ?config(tc81,Config), + ok; +end_per_testcase(TC=conf8_tc2, Config) -> + init = ?config(suite,Config), + TC = ?config(tc82,Config), + ok. + +conf1_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + init = ?config(suite,Config), + [{t0,now()},{cc1,conf1}|Config]. +conf1_end(Config) -> + %% check 2s & 3s < 4s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); + Ms < 3000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf2_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + [{t0,now()},{cc2,conf2}|Config]. +conf2_end(Config) -> + %% check 3s & 2s < 4s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); + Ms < 3000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf3_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + [{t0,now()},{cc3,conf3}|Config]. +conf3_end(Config) -> + %% check 6s & 6s & (2s & 3s) & 1s = ~6s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 7000000 -> exit({bad_parallel_exec,Ms}); + Ms < 6000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf4_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [] = ?config(tc_group_properties,Config), + [{t0,now()},{cc4,conf4}|Config]. +conf4_end(Config) -> + %% check 2s & 3s >= 5s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 6000000 -> exit({bad_parallel_exec,Ms}); + Ms < 5000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf5_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [] = ?config(tc_group_properties,Config), + [{t0,now()},{cc5,conf5}|Config]. +conf5_end(Config) -> + %% check 1s & 1s & (3s & 2s) & 1s = ~6s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 7500000 -> exit({bad_parallel_exec,Ms}); + Ms < 6000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf6_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + init = ?config(suite,Config), + [{t0,now()},{cc6,conf6}|Config]. +conf6_end(Config) -> + %% check 3s & 2s < 5s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 4500000 -> exit({bad_parallel_exec,Ms}); + Ms < 3000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf5(suite) -> % test specification + [{conf, conf5_init, [conf5_tc1, conf5_tc1, + + {conf, [parallel], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, + + conf5_tc2], conf5_end}]. + +conf7_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + [{t0,now()},{cc7,conf7}|Config]. +conf7_end(Config) -> + %% check 1s & 1s & (2s & 2s) & 1s = ~3s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); + Ms < 3000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + +conf8_init(Config) when is_list(Config) -> + test_server:comment(io_lib:format("~p",[now()])), + [parallel] = ?config(tc_group_properties,Config), + init = ?config(suite,Config), + [{t0,now()},{cc8,conf8}|Config]. +conf8_end(Config) -> + %% check 2s & 2s < 4s + Ms = timer:now_diff(now(),?config(t0,Config)), + test_server:comment(io_lib:format("~p",[now()])), + if Ms > 3000000 -> exit({bad_parallel_exec,Ms}); + Ms < 2000000 -> exit({bad_parallel_exec,Ms}); + true -> ok + end. + + +%%---------- test cases ---------- + +conf1_tc1(Config) when is_list(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc1 = ?config(tc11,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf1_tc2(Config) when is_list(Config) -> + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc2 = ?config(tc12,Config), + timer:sleep(3000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf2_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + undefined = ?config(cc1,Config), + undefined = ?config(tc11,Config), + conf2 = ?config(cc2,Config), + conf2_tc1 = ?config(tc21,Config), + timer:sleep(3000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf2_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + conf2 = ?config(cc2,Config), + undefined = ?config(tc21,Config), + conf2_tc2 = ?config(tc22,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf3_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + undefined = ?config(cc2,Config), + undefined = ?config(tc22,Config), + conf3 = ?config(cc3,Config), + conf3_tc1 = ?config(tc31,Config), + timer:sleep(6000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf3_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + conf3 = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(tc31,Config), + undefined = ?config(tc41,Config), + conf3_tc2 = ?config(tc32,Config), + timer:sleep(1000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf4_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + undefined = ?config(tc32,Config), + conf4_tc1 = ?config(tc41,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf4_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + undefined = ?config(tc41,Config), + conf4_tc2 = ?config(tc42,Config), + timer:sleep(3000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf5_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + undefined = ?config(tc42,Config), + conf5_tc1 = ?config(tc51,Config), + timer:sleep(1000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf5_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + undefined = ?config(cc6,Config), + undefined = ?config(tc51,Config), + undefined = ?config(tc62,Config), + conf5_tc2 = ?config(tc52,Config), + timer:sleep(1000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf6_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + undefined = ?config(tc52,Config), + conf6_tc1 = ?config(tc61,Config), + timer:sleep(3000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf6_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + undefined = ?config(tc61,Config), + conf6_tc2 = ?config(tc62,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf7_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(cc5,Config), + undefined = ?config(cc6,Config), + conf7 = ?config(cc7,Config), + undefined = ?config(tc62,Config), + conf7_tc1 = ?config(tc71,Config), + timer:sleep(1000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf7_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf7 = ?config(cc7,Config), + undefined = ?config(cc8,Config), + undefined = ?config(tc71,Config), + undefined = ?config(tc82,Config), + conf7_tc2 = ?config(tc72,Config), + timer:sleep(1000), + test_server:comment(io_lib:format("~p",[now()])), + ok. + +conf8_tc1(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(cc5,Config), + undefined = ?config(cc6,Config), + conf7 = ?config(cc7,Config), + conf8 = ?config(cc8,Config), + undefined = ?config(tc72,Config), + conf8_tc1 = ?config(tc81,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. +conf8_tc2(Config) when is_list(Config) -> + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf7 = ?config(cc7,Config), + conf8 = ?config(cc8,Config), + undefined = ?config(tc81,Config), + conf8_tc2 = ?config(tc82,Config), + timer:sleep(2000), + test_server:comment(io_lib:format("~p",[now()])), + ok. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl new file mode 100644 index 0000000000..0f7118a810 --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl @@ -0,0 +1,477 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_shuffle01_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +all(doc) -> ["Test simple conf case structure, with and without nested cases"]; +all(suite) -> + [ + {conf, [shuffle], conf1_init, [conf1_tc1, conf1_tc2, conf1_tc3], conf1_end}, + + {conf, [{shuffle,{1,2,3}}], conf2_init, [conf2_tc1, conf2_tc2, conf2_tc3], conf2_end}, + + {conf, [shuffle], conf3_init, [conf3_tc1, conf3_tc2, conf3_tc3, + + {conf, [], conf4_init, + [conf4_tc1, conf4_tc2], conf4_end}], + conf3_end}, + + conf5, + + {conf, [shuffle,{repeat,5},parallel], conf7_init, [conf7_tc1, + + {conf, [{shuffle,{3,2,1}},{repeat,3}], + conf8_init, [conf8_tc1, conf8_tc2, conf8_tc3], + conf8_end}, + + conf7_tc2, conf7_tc3], conf7_end} + + ]. + + +%%---------- conf cases ---------- + +init_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + [{suite,init}|Config]. +end_per_suite(Config) -> + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + ok. + +init_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + [{tc11,TC}|Config]; +init_per_testcase(TC=conf1_tc2, Config) -> + [{tc12,TC}|Config]; +init_per_testcase(TC=conf1_tc3, Config) -> + [{tc13,TC}|Config]; +init_per_testcase(TC=conf2_tc1, Config) -> + [{tc21,TC}|Config]; +init_per_testcase(TC=conf2_tc2, Config) -> + [{tc22,TC}|Config]; +init_per_testcase(TC=conf2_tc3, Config) -> + [{tc23,TC}|Config]; +init_per_testcase(TC=conf3_tc1, Config) -> + [{tc31,TC}|Config]; +init_per_testcase(TC=conf3_tc2, Config) -> + [{tc32,TC}|Config]; +init_per_testcase(TC=conf3_tc3, Config) -> + [{tc33,TC}|Config]; +init_per_testcase(TC=conf4_tc1, Config) -> + [{tc41,TC}|Config]; +init_per_testcase(TC=conf4_tc2, Config) -> + [{tc42,TC}|Config]; +init_per_testcase(TC=conf5_tc1, Config) -> + [{tc51,TC}|Config]; +init_per_testcase(TC=conf5_tc2, Config) -> + [{tc52,TC}|Config]; +init_per_testcase(TC=conf6_tc1, Config) -> + [{tc61,TC}|Config]; +init_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + [{tc62,TC}|Config]; +init_per_testcase(TC=conf6_tc3, Config) -> + [{tc63,TC}|Config]; +init_per_testcase(TC=conf7_tc1, Config) -> + [{tc71,TC}|Config]; +init_per_testcase(TC=conf7_tc2, Config) -> + [{tc72,TC}|Config]; +init_per_testcase(TC=conf7_tc3, Config) -> + [{tc73,TC}|Config]; +init_per_testcase(TC=conf8_tc1, Config) -> + [{tc81,TC}|Config]; +init_per_testcase(TC=conf8_tc2, Config) -> + init = ?config(suite,Config), + [{tc82,TC}|Config]; +init_per_testcase(TC=conf8_tc3, Config) -> + [{tc83,TC}|Config]. + +end_per_testcase(TC=conf1_tc1, Config) -> + init = ?config(suite,Config), + TC = ?config(tc11,Config), + ok; +end_per_testcase(TC=conf1_tc2, Config) -> + TC = ?config(tc12,Config), + ok; +end_per_testcase(TC=conf1_tc3, Config) -> + TC = ?config(tc13,Config), + ok; +end_per_testcase(TC=conf2_tc1, Config) -> + TC = ?config(tc21,Config), + ok; +end_per_testcase(TC=conf2_tc2, Config) -> + TC = ?config(tc22,Config), + ok; +end_per_testcase(TC=conf2_tc3, Config) -> + TC = ?config(tc23,Config), + ok; +end_per_testcase(TC=conf3_tc1, Config) -> + TC = ?config(tc31,Config), + ok; +end_per_testcase(TC=conf3_tc2, Config) -> + TC = ?config(tc32,Config), + ok; +end_per_testcase(TC=conf3_tc3, Config) -> + TC = ?config(tc33,Config), + ok; +end_per_testcase(TC=conf4_tc1, Config) -> + TC = ?config(tc41,Config), + ok; +end_per_testcase(TC=conf4_tc2, Config) -> + TC = ?config(tc42,Config), + ok; +end_per_testcase(TC=conf5_tc1, Config) -> + TC = ?config(tc51,Config), + ok; +end_per_testcase(TC=conf5_tc2, Config) -> + TC = ?config(tc52,Config), + ok; +end_per_testcase(TC=conf6_tc1, Config) -> + TC = ?config(tc61,Config), + ok; +end_per_testcase(TC=conf6_tc2, Config) -> + init = ?config(suite,Config), + TC = ?config(tc62,Config), + ok; +end_per_testcase(TC=conf6_tc3, Config) -> + TC = ?config(tc63,Config), + ok; +end_per_testcase(TC=conf7_tc1, Config) -> + TC = ?config(tc71,Config), + ok; +end_per_testcase(TC=conf7_tc2, Config) -> + TC = ?config(tc72,Config), + ok; +end_per_testcase(TC=conf7_tc3, Config) -> + TC = ?config(tc73,Config), + ok; +end_per_testcase(TC=conf8_tc1, Config) -> + TC = ?config(tc81,Config), + ok; +end_per_testcase(TC=conf8_tc2, Config) -> + init = ?config(suite,Config), + TC = ?config(tc82,Config), + ok; +end_per_testcase(TC=conf8_tc3, Config) -> + TC = ?config(tc83,Config), + ok. + + +conf1_init(Config) when is_list(Config) -> + init = ?config(suite,Config), + [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), + test_server:comment("Shuffle (random seed)"), + [{cc1,conf1}|Config]. +conf1_end(_Config) -> + ok. + +conf2_init(Config) when is_list(Config) -> + [{shuffle,{1,2,3}}] = ?config(tc_group_properties,Config), + test_server:comment("Shuffle (user seed)"), + [{cc2,conf2}|Config]. +conf2_end(_Config) -> + ok. + +conf3_init(Config) when is_list(Config) -> + [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), + test_server:comment("Shuffle (random)"), + [{cc3,conf3}|Config]. +conf3_end(_Config) -> + ok. + +conf4_init(Config) when is_list(Config) -> + [] = ?config(tc_group_properties,Config), + test_server:comment("No shuffle"), + [{cc4,conf4}|Config]. +conf4_end(_Config) -> + ok. + +conf5_init(Config) when is_list(Config) -> + [] = ?config(tc_group_properties,Config), + test_server:comment("No shuffle"), + [{cc5,conf5}|Config]. +conf5_end(_Config) -> + ok. + +conf6_init(Config) when is_list(Config) -> + validate_shuffle(Config), + test_server:comment("Shuffle (random)"), + init = ?config(suite,Config), + [{cc6,conf6}|Config]. +conf6_end(_Config) -> + ok. + +conf5(suite) -> % test specification + [{conf, conf5_init, [conf5_tc1, + + {conf, [shuffle], conf6_init, + [conf6_tc1, conf6_tc2, conf6_tc3], + conf6_end}, + + conf5_tc2], conf5_end}]. + +conf7_init(Config) when is_list(Config) -> + test_server:comment("Group 7, Shuffle (random seed)"), + validate_shuffle(Config), + [{cc7,conf7}|Config]. +conf7_end(_Config) -> + ok. + +conf8_init(Config) when is_list(Config) -> + test_server:comment("Group 8, Shuffle (user start seed)"), + validate_shuffle(Config), + init = ?config(suite,Config), + [{cc8,conf8}|Config]. +conf8_end(_Config) -> + ok. + +validate_shuffle(Config) -> + case proplists:get_value(shuffle, ?config(tc_group_properties,Config)) of + {_,_,_} -> + ok; + Seed -> + %% Must be a valid seed. + _ = rand:seed_s(rand:export_seed_s(Seed)) + end. + + +%%---------- test cases ---------- + +conf1_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc1 = ?config(tc11,Config), + ok. +conf1_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + init = ?config(suite,Config), + conf1 = ?config(cc1,Config), + conf1_tc2 = ?config(tc12,Config), + ok. +conf1_tc3(suite) -> []; +conf1_tc3(_Config) -> + test_server:comment("Case 3"), + ok. + +conf2_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + undefined = ?config(cc1,Config), + conf2 = ?config(cc2,Config), + conf2_tc1 = ?config(tc21,Config), + ok. +conf2_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + conf2 = ?config(cc2,Config), + conf2_tc2 = ?config(tc22,Config), + ok. +conf2_tc3(suite) -> []; +conf2_tc3(_Config) -> + test_server:comment("Case 3"), + ok. + +conf3_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + conf3_tc1 = ?config(tc31,Config), + ok. +conf3_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + conf3 = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf3_tc2 = ?config(tc32,Config), + ok. +conf3_tc3(suite) -> []; +conf3_tc3(_Config) -> + test_server:comment("Case 3"), + ok. + +conf4_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + conf4_tc1 = ?config(tc41,Config), + ok. +conf4_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf3 = ?config(cc3,Config), + conf4 = ?config(cc4,Config), + conf4_tc2 = ?config(tc42,Config), + ok. + +conf5_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + conf5_tc1 = ?config(tc51,Config), + ok. +conf5_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + undefined = ?config(cc6,Config), + conf5_tc2 = ?config(tc52,Config), + ok. + +conf6_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + conf6_tc1 = ?config(tc61,Config), + ok. +conf6_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf5 = ?config(cc5,Config), + conf6 = ?config(cc6,Config), + conf6_tc2 = ?config(tc62,Config), + ok. +conf6_tc3(suite) -> []; +conf6_tc3(_Config) -> + test_server:comment("Case 3"), + ok. + +conf7_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(cc5,Config), + undefined = ?config(cc6,Config), + conf7 = ?config(cc7,Config), + conf7_tc1 = ?config(tc71,Config), + ok. +conf7_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf7 = ?config(cc7,Config), + undefined = ?config(cc8,Config), + conf7_tc2 = ?config(tc72,Config), + ok. +conf7_tc3(suite) -> []; +conf7_tc3(_Config) -> + test_server:comment("Case 3"), + ok. + +conf8_tc1(Config) when is_list(Config) -> + test_server:comment("Case 1"), + init = ?config(suite,Config), + case ?config(data_dir,Config) of + undefined -> exit(no_data_dir); + _ -> ok + end, + undefined = ?config(cc1,Config), + undefined = ?config(cc2,Config), + undefined = ?config(cc3,Config), + undefined = ?config(cc4,Config), + undefined = ?config(cc5,Config), + undefined = ?config(cc6,Config), + conf7 = ?config(cc7,Config), + conf8 = ?config(cc8,Config), + conf8_tc1 = ?config(tc81,Config), + ok. +conf8_tc2(Config) when is_list(Config) -> + test_server:comment("Case 2"), + init = ?config(suite,Config), + case ?config(priv_dir,Config) of + undefined -> exit(no_priv_dir); + _ -> ok + end, + conf7 = ?config(cc7,Config), + conf8 = ?config(cc8,Config), + conf8_tc2 = ?config(tc82,Config), + ok. +conf8_tc3(suite) -> []; +conf8_tc3(_Config) -> + test_server:comment("Case 3"), + ok. diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl new file mode 100644 index 0000000000..ae2321c6ad --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_skip_SUITE.erl @@ -0,0 +1,43 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_skip_SUITE). + +-export([all/1, init_per_suite/1, end_per_suite/1]). +-export([dummy/1]). + +-include_lib("common_test/include/ct.hrl"). + +all(suite) -> + [dummy]. + +init_per_suite(Config) when is_list(Config) -> + {skip,"Skipping init_per_suite - check that \'dummy\' and" + " \'end_per_suite\' are also skipped"}. + +dummy(suite) -> []; +dummy(doc) -> ["This testcase should never be executed"]; +dummy(Config) when is_list(Config) -> + ?t:fail("This testcase should be executed since" + " init_per_suite/1 is skipped"). + +end_per_suite(doc) -> ["This testcase should never be executed"]; +end_per_suite(Config) when is_list(Config) -> + ?t:fail("end_per_suite/1 should not be executed when" + " init_per_suite/1 is skipped"). diff --git a/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl new file mode 100644 index 0000000000..0cabce995f --- /dev/null +++ b/lib/common_test/test/test_server_SUITE_data/test_server_unicode_SUITE.erl @@ -0,0 +1,82 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_unicode_SUITE). + +-export([all/1, init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). +-export(['#=@: difficult_case_name_äöå'/1, + print_and_log_unicode/1, + print_and_log_latin1/1]). + +-include_lib("common_test/include/ct.hrl"). + +all(suite) -> + ['#=@: difficult_case_name_äöå', + print_and_log_unicode, + print_and_log_latin1]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Case,Config) -> + init_timetrap(500,Config). + +init_timetrap(T,Config) -> + Dog = ?t:timetrap(T), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case,Config) -> + cancel_timetrap(Config). + +cancel_timetrap(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + + +%%%----------------------------------------------------------------- +%%% Test cases + +'#=@: difficult_case_name_äöå'(Config) when is_list(Config) -> + ok. + +print_and_log_unicode(Config) when is_list(Config) -> + String = "שלום-שלום+של 日本語", + test_server:comment(String), + test_server:capture_start(), + io:format("String with ts: ~ts",[String]), + test_server:capture_stop(), + "String with ts: "++String = lists:flatten(test_server:capture_get()), + ok. + +print_and_log_latin1(Config) when is_list(Config) -> + String = "æøå", + test_server:comment(String), + test_server:capture_start(), + io:format("String with s: ~s",[String]), + io:format("String with ts: ~ts",[String]), + test_server:capture_stop(), + ["String with s: "++String, + "String with ts: "++String] = + [lists:flatten(L) || L<- test_server:capture_get()], + ok. diff --git a/lib/common_test/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl new file mode 100644 index 0000000000..e2680938e0 --- /dev/null +++ b/lib/common_test/test/test_server_test_lib.erl @@ -0,0 +1,217 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_test_lib). + +-export([parse_suite/1]). +-export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). + +%% for test_server_SUITE when node can not be started as slave +-export([prepare_tester_node/2]). + +-include("test_server_test_lib.hrl"). + +%% The CTH hooks all tests +init(_Id, _Opts) -> + []. + +pre_init_per_testcase(_TC,Config,State) -> + case os:type() of + {win32, _} -> + %% Extend timeout for windows as starting node + %% can take a long time there + test_server:timetrap( 120000 * test_server:timetrap_scale_factor()); + _ -> + ok + end, + {start_slave(Config, 50),State}. + +start_slave(Config,_Level) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + + ct:log("Trying to start ~s~n", + ["test_server_tester@"++Host]), + case slave:start(Host, test_server_tester, []) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + IsCover = test_server:is_cover(), + if IsCover -> + cover:start(Node); + true-> + ok + end, + prepare_tester_node(Node,Config) + end. + +prepare_tester_node(Node,Config) -> + DataDir = proplists:get_value(data_dir, Config), + %% We would normally use priv_dir for temporary data, + %% but the pathnames gets too long on Windows. + %% Until the run-time system can support long pathnames, + %% use the data dir. + WorkDir = DataDir, + + %% WorkDir as well as directory of Test Server suites + %% have to be in code path on Test Server node. + [_ | Parts] = lists:reverse(filename:split(DataDir)), + TSDir = filename:join(lists:reverse(Parts)), + AddPathDirs = case proplists:get_value(path_dirs, Config) of + undefined -> []; + Ds -> Ds + end, + PathDirs = [WorkDir,TSDir | AddPathDirs], + [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], + io:format("Dirs added to code path (on ~w):~n", + [Node]), + [io:format("~s~n", [D]) || D <- PathDirs], + + true = rpc:call(Node, os, putenv, + ["TEST_SERVER_FRAMEWORK", "undefined"]), + + ok = rpc:call(Node, file, set_cwd, [WorkDir]), + [{node,Node}, {work_dir,WorkDir} | Config]. + +post_end_per_testcase(_TC, Config, Return, State) -> + Node = proplists:get_value(node, Config), + Cover = test_server:is_cover(), + if Cover-> cover:flush(Node); + true -> ok + end, + erlang:monitor_node(Node, true), + slave:stop(Node), + receive + {nodedown, Node} -> + if Cover -> cover:stop(Node); + true -> ok + end + after 5000 -> + erlang:monitor_node(Node, false), + receive {nodedown, Node} -> ok after 0 -> ok end %flush + end, + {Return, State}. + +%% Parse an .suite log file +parse_suite(FileName) -> + + case file:open(FileName, [read, raw, read_ahead]) of + {ok, Fd} -> + Data = parse_suite(Fd, #suite{ }), + file:close(Fd), + {ok, Data}; + _ -> + error + end. + +fline(Fd) -> + case prim_file:read_line(Fd) of + eof -> eof; + {ok, Line} -> Line + end. + +parse_suite(Fd, S) -> + _Started = fline(Fd), + _Starting = fline(Fd), + "=cases" ++ NCases = fline(Fd), + "=user" ++ _User = fline(Fd), + "=host" ++ Host = fline(Fd), + "=hosts" ++ _Hosts = fline(Fd), + "=emulator_vsn" ++ Evsn = fline(Fd), + "=emulator" ++ Emu = fline(Fd), + "=otp_release" ++ OtpRel = fline(Fd), + "=started" ++ Start = fline(Fd), + NewS = parse_cases(Fd, S#suite{ + n_cases_expected = list_to_int(clean(NCases)), + host = list_to_binary(clean(Host)), + emulator_vsn = list_to_binary(clean(Evsn)), + emulator = list_to_binary(clean(Emu)), + otp_release = list_to_binary(clean(OtpRel)), + started = list_to_binary(clean(Start)) + }), + "=failed" ++ Failed = fline(Fd), + "=successful" ++ Succ = fline(Fd), + "=user_skipped" ++ UsrSkip = fline(Fd), + "=auto_skipped" ++ AutSkip = fline(Fd), + NewS#suite{ n_cases_failed = list_to_int(clean(Failed)), + n_cases_succ = list_to_int(clean(Succ)), + n_cases_user_skip = list_to_int(clean(UsrSkip)), + n_cases_auto_skip = list_to_int(clean(AutSkip)) }. + + +parse_cases(Fd, #suite{ n_cases = N, + cases = Cases } = S) -> + case parse_case(Fd) of + finished -> S#suite{ log_ok = true }; + {eof, Tc} -> + S#suite{ n_cases = N + 1, + cases = [Tc#tc{ result = crashed }|Cases]}; + {ok, Case} -> + parse_cases(Fd, S#suite{ n_cases = N + 1, + cases = [Case|Cases]}) + end. + +parse_case(Fd) -> parse_case(Fd, #tc{}). +parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc). + +parse_case(eof, _, Tc) -> {eof, Tc}; +parse_case("=case" ++ Case, Fd, Tc) -> + Name = list_to_binary(clean(Case)), + parse_case(fline(Fd), Fd, Tc#tc{ name = Name }); +parse_case("=logfile" ++ File, Fd, Tc) -> + Log = list_to_binary(clean(File)), + parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log }); +parse_case("=elapsed" ++ Elapsed, Fd, Tc) -> + {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)), + parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time }); +parse_case("=result" ++ Result, _, Tc) -> + case clean(Result) of + "ok" ++ _ -> + {ok, Tc#tc{ result = ok } }; + "failed" ++ _ -> + {ok, Tc#tc{ result = failed } }; + "skipped" ++ _ -> + {ok, Tc#tc{ result = skip } }; + "auto_skipped" ++ _ -> + {ok, Tc#tc{ result = auto_skip } } + end; +parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) -> + finished; +parse_case(_, Fd, Tc) -> + parse_case(fline(Fd), Fd, Tc). + +skip([]) -> []; +skip([$ |Ts]) -> skip(Ts); +skip(Ts) -> Ts. + +%rmnl(L) -> L. +rmnl([]) -> []; +rmnl([$\n | Ts]) -> rmnl(Ts); +rmnl([T|Ts]) -> [T | rmnl(Ts)]. + +clean(L) -> + rmnl(skip(L)). + +list_to_int(L) -> + try + list_to_integer(L) + catch + _:_ -> + 0 + end. diff --git a/lib/common_test/test/test_server_test_lib.hrl b/lib/common_test/test/test_server_test_lib.hrl new file mode 100644 index 0000000000..27b7be9618 --- /dev/null +++ b/lib/common_test/test/test_server_test_lib.hrl @@ -0,0 +1,23 @@ +-record(tc, { + name, + result, + elapsed, + logfile + }). + +-record(suite, { + application, + n_cases = 0, + n_cases_failed = 0, + n_cases_expected = 0, + n_cases_succ, + n_cases_user_skip, + n_cases_auto_skip, + cases = [], + host, + emulator_vsn, + emulator, + otp_release, + started, + log_ok = false + }). diff --git a/lib/common_test/test_server/Makefile b/lib/common_test/test_server/Makefile new file mode 100644 index 0000000000..0adf64b837 --- /dev/null +++ b/lib/common_test/test_server/Makefile @@ -0,0 +1,96 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk + +# ---------------------------------------------------- +# Configuration info. +# ---------------------------------------------------- +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +EBIN=. + +TS_MODULES= \ + ts \ + ts_run \ + ts_lib \ + ts_make \ + ts_erl_config \ + ts_autoconf_win32 \ + ts_install \ + ts_install_cth \ + ts_benchmark + +TARGET_MODULES= $(MODULES:%=$(EBIN)/%) +TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) + +TS_ERL_FILES = $(TS_MODULES:=.erl) +TS_HRL_FILES = ts.hrl +AUTOCONF_FILES = configure.in conf_vars.in +PROGRAMS = configure config.sub config.guess install-sh +CONFIG = ts.config ts.unix.config ts.win32.config + +TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) + +TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += -I../include -Werror + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +tests debug opt: $(TS_TARGETS) + +clean: + rm -f $(TS_TARGET_FILES) + rm -f core + +docs: + +configure: configure.in + autoconf configure.in > configure + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_tests_spec: opt + $(INSTALL_DIR) "$(RELEASE_PATH)/test_server" + $(INSTALL_DATA) $(TS_ERL_FILES) $(TS_HRL_FILES) \ + $(TS_TARGET_FILES) \ + $(AUTOCONF_FILES) $(CONFIG) \ + "$(RELEASE_PATH)/test_server" + $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server" + +release_docs_spec: + diff --git a/lib/common_test/test_server/conf_vars.in b/lib/common_test/test_server/conf_vars.in new file mode 100644 index 0000000000..7c55d7b9ed --- /dev/null +++ b/lib/common_test/test_server/conf_vars.in @@ -0,0 +1,25 @@ +CC:@CC@ +LD:@LD@ +CFLAGS:@CFLAGS@ +EI_CFLAGS:@EI_CFLAGS@ +ERTS_CFLAGS:@ERTS_CFLAGS@ +CROSSLDFLAGS:@CROSSLDFLAGS@ +SHLIB_LD:@SHLIB_LD@ +SHLIB_LDFLAGS:@SHLIB_LDFLAGS@ +SHLIB_LDLIBS:@SHLIB_LDLIBS@ +SHLIB_CFLAGS:@SHLIB_CFLAGS@ +SHLIB_EXTRACT_ALL:@SHLIB_EXTRACT_ALL@ +dll:@SHLIB_SUFFIX@ +DEFS:@DEFS@ +ERTS_LIBS:@ERTS_LIBS@ +LIBS:@LIBS@ +target_host:@target_host@ +CPU:@host_cpu@ +os:@host_os@ +target:@host@ +obj:@obj@ +exe:@exe@ +SSLEAY_ROOT:@SSLEAY_ROOT@ +JAVAC:@JAVAC@ +make_command:@make_command@ +test_c_compiler:@test_c_compiler@ diff --git a/lib/common_test/test_server/configure.in b/lib/common_test/test_server/configure.in new file mode 100644 index 0000000000..001de72a1e --- /dev/null +++ b/lib/common_test/test_server/configure.in @@ -0,0 +1,509 @@ +dnl Process this file with autoconf to produce a configure script for Erlang. +dnl +dnl %CopyrightBegin% +dnl +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. +dnl +dnl Licensed under the Apache License, Version 2.0 (the "License"); +dnl you may not use this file except in compliance with the License. +dnl You may obtain a copy of the License at +dnl +dnl http://www.apache.org/licenses/LICENSE-2.0 +dnl +dnl Unless required by applicable law or agreed to in writing, software +dnl distributed under the License is distributed on an "AS IS" BASIS, +dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +dnl See the License for the specific language governing permissions and +dnl limitations under the License. +dnl +dnl %CopyrightEnd% +dnl + +AC_INIT(conf_vars.in) + +AC_CANONICAL_HOST + +dnl Checks for programs. +AC_PROG_CC + +DEBUG_FLAGS="-g -DDEBUG" +if test "$GCC" = yes; then + DEBUG_FLAGS="$DEBUG_FLAGS -Wall $CFLAGS" +fi +AC_SUBST(DEBUG_FLAGS) + +AC_ARG_ENABLE(debug-mode, +[ --enable-debug-mode enable debug mode], +[ case "$enableval" in + no) ;; + *) CFLAGS=$DEBUG_FLAGS ;; + esac ], ) + +AC_ARG_ENABLE(m64-build, +AS_HELP_STRING([--enable-m64-build], + [build 64-bit binaries using the -m64 flag to (g)cc]), +[ case "$enableval" in + no) enable_m64_build=no ;; + *) enable_m64_build=yes ;; + esac +],enable_m64_build=no) + +AC_ARG_ENABLE(m32-build, +AS_HELP_STRING([--enable-m32-build], + [build 32-bit binaries using the -m32 flag to (g)cc]), +[ case "$enableval" in + no) enable_m32_build=no ;; + *) enable_m32_build=yes ;; + esac +],enable_m32_build=no) + +no_mXX_LDFLAGS="$LDFLAGS" + +if test X${enable_m64_build} = Xyes; then + CFLAGS="-m64 $CFLAGS" + LDFLAGS="-m64 $LDFLAGS" +fi +if test X${enable_m32_build} = Xyes; then + CFLAGS="-m32 $CFLAGS" + LDFLAGS="-m32 $LDFLAGS" +fi + +AC_CHECK_LIB(m, sin) + +#-------------------------------------------------------------------- +# Interactive UNIX requires -linet instead of -lsocket, plus it +# needs net/errno.h to define the socket-related error codes. +#-------------------------------------------------------------------- + +AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"]) +AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H)) + +#-------------------------------------------------------------------- +# Linux/tcp.h may be needed for sockopt test in kernel +#-------------------------------------------------------------------- + +AC_CHECK_HEADER(linux/tcp.h, AC_DEFINE(HAVE_LINUX_TCP_H)) +AC_MSG_CHECKING(for sane linux/tcp.h) +AC_TRY_COMPILE([#include + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include ], + [return 0;], + have_sane_linux_tcp_h=yes, + have_sane_linux_tcp_h=no) + +if test $have_sane_linux_tcp_h = yes; then + AC_DEFINE(HAVE_SANE_LINUX_TCP_H,[1], + [Define if we have sane linux/tcp.h]) + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi + + + +#-------------------------------------------------------------------- +# Linux requires sys/socketio.h instead of sys/sockio.h +#-------------------------------------------------------------------- +AC_CHECK_HEADER(sys/socketio.h, AC_DEFINE(HAVE_SOCKETIO_H)) + + +#-------------------------------------------------------------------- +# Misc +#-------------------------------------------------------------------- +AC_CHECK_HEADER(poll.h, AC_DEFINE(HAVE_POLL_H)) + +#-------------------------------------------------------------------- +# The statements below define a collection of symbols related to +# dynamic loading and shared libraries: +# +# SHLIB_CFLAGS - Flags to pass to cc when compiling the components +# of a shared library (may request position-independent +# code, among other things). +# SHLIB_LD - Base command to use for combining object files +# into a shared library. +# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable +# extensions. An empty string means we don't know how +# to use shared libraries on this platform. +#-------------------------------------------------------------------- + +# Step 1: set the variable "system" to hold the name and version number +# for the system. + +AC_MSG_CHECKING([system version (for dynamic loading)]) +system=`./config.sub $host` +AC_MSG_RESULT($system) + +# Step 2: check for existence of -ldl library. This is needed because +# Linux can use either -ldl or -ldld for dynamic loading. + +AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) + +# Step 3: set configuration options based on system name and version. + +SHLIB_LDLIBS= +fullSrcDir=`cd $srcdir; pwd` +case $system in + *-linux-*) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + if test "$have_dl" = yes; then + SHLIB_LD="${CC}" + SHLIB_LDFLAGS="$LDFLAGS -shared" + LD_FLAGS="-rdynamic" + else + AC_CHECK_HEADER(dld.h, [ + SHLIB_LD="ld" + SHLIB_LDFLAGS="-shared"]) + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + fi + SHLIB_EXTRACT_ALL="" + ;; + *-openbsd*) + # Not available on all versions: check for include file. + AC_CHECK_HEADER(dlfcn.h, [ + SHLIB_CFLAGS="-fpic" + SHLIB_LD="${CC}" + SHLIB_LDFLAGS="$LDFLAGS -shared" + SHLIB_SUFFIX=".so" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + ], [ + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_SUFFIX="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ]) + SHLIB_EXTRACT_ALL="" + ;; + *-netbsd*|*-freebsd*|*-dragonfly*) + # Not available on all versions: check for include file. + AC_CHECK_HEADER(dlfcn.h, [ + SHLIB_CFLAGS="-fpic" + SHLIB_LD="ld" + SHLIB_LDFLAGS="$LDFLAGS -Bshareable -x" + SHLIB_SUFFIX=".so" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + ], [ + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_SUFFIX="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ]) + SHLIB_EXTRACT_ALL="" + ;; + *-solaris2*|*-sysv4*) + SHLIB_CFLAGS="-KPIC" + SHLIB_LD="/usr/ccs/bin/ld" + SHLIB_LDFLAGS="$no_mXX_LDFLAGS -G -z text" + if test X${enable_m64_build} = Xyes; then + SHLIB_LDFLAGS="-64 $SHLIB_LDFLAGS" + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + SHLIB_SUFFIX=".so" + SHLIB_EXTRACT_ALL="-z allextract" + ;; + *darwin*) + SHLIB_CFLAGS="-fno-common" + SHLIB_LD="cc" + SHLIB_LDFLAGS="$LDFLAGS -bundle -flat_namespace -undefined suppress" + SHLIB_SUFFIX=".so" + SHLIB_EXTRACT_ALL="" + ;; + *osf1*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="ld" + SHLIB_LDFLAGS="$LDFLAGS -shared" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + SHLIB_SUFFIX=".so" + SHLIB_EXTRACT_ALL="" + ;; + *osf5*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="${CC} -shared" + SHLIB_LDFLAGS="$LDFLAGS" + SHLIB_SUFFIX=".so" + SHLIB_EXTRACT_ALL="" + ;; + *) + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_LDLIBS="" + SHLIB_SUFFIX="" + SHLIB_EXTRACT_ALL="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ;; +esac + +# If we're running gcc, then change the C flags for compiling shared +# libraries to the right flags for gcc, instead of those for the +# standard manufacturer compiler. + +if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then + case $system in + *-aix) + ;; + *-bsd*) + ;; + *-irix) + ;; + *-netbsd|*-freebsd|*-openbsd) + ;; + *-riscos) + ;; + *ultrix4.*) + ;; + *darwin*) + ;; + *) + SHLIB_CFLAGS="-fPIC" + ;; + esac +fi + +# Make it possible for erl_interface to use it's own compiler options +EI_CFLAGS="$CFLAGS" + +# Add thread-safety flags if requested +AC_ARG_ENABLE(shlib-thread-safety, +[ --enable-shlib-thread-safety enable thread safety for build shared libraries], +[ case "$enableval" in + no) ;; + *) SHLIB_CFLAGS="$SHLIB_CFLAGS -D_THREAD_SAFE -D_REENTRANT" + CFLAGS="$CFLAGS -D_THREAD_SAFE -D_REENTRANT" + ;; + esac ], ) + +SHLIB_CFLAGS="$SHLIB_CFLAGS $CFLAGS" + + +AC_SUBST(CFLAGS) +AC_SUBST(SHLIB_LD) +AC_SUBST(SHLIB_LDFLAGS) +AC_SUBST(SHLIB_LDLIBS) +AC_SUBST(SHLIB_CFLAGS) +AC_SUBST(SHLIB_SUFFIX) +AC_SUBST(SHLIB_EXTRACT_ALL) +AC_SUBST(EI_CFLAGS) + +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- + +erl_checkBoth=0 +AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1) +if test "$erl_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1) +fi +if test "$erl_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +dnl Checks for library functions. +AC_CHECK_FUNCS(strerror) +AC_CHECK_FUNCS(vsnprintf) +AC_CHECK_FUNCS(usleep) + +# First check if the library is available, then if we can choose between +# two versions of gethostbyname +AC_HAVE_LIBRARY(resolv) +AC_CHECK_LIB(resolv, res_gethostbyname,[AC_DEFINE(HAVE_RES_GETHOSTBYNAME,1)]) + +#-------------------------------------------------------------------- +# Check for isfinite +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([for isfinite]) +AC_TRY_LINK([#include ], + [isfinite(0);], have_isfinite=yes, have_isfinite=no) + +if test $have_isfinite = yes; then + AC_DEFINE(HAVE_ISFINITE,1) + AC_MSG_RESULT(yes) +else + AC_DEFINE(HAVE_FINITE,1) + AC_MSG_RESULT(no) +fi + +#-------------------------------------------------------------------- +# Emulator compatible flags (for drivers) +#-------------------------------------------------------------------- + +ERTS_CFLAGS=$CFLAGS +AC_SUBST(ERTS_CFLAGS) + +ERTS_LIBS=$LIBS +AC_SUBST(ERTS_LIBS) + +#-------------------------------------------------------------------- +# Special compiler macro to handle cross compiling +# (HCC) is used to compile tools run in the HOST environment +#-------------------------------------------------------------------- +HCC='$(CC)' +AC_SUBST(HCC) + +#-------------------------------------------------------------------- +# ld is used for linking on vxworks +#-------------------------------------------------------------------- +LD='$(CC) $(CFLAGS)' +AC_SUBST(LD) + +#-------------------------------------------------------------------- +# object file suffix +#-------------------------------------------------------------------- +obj='.o' +AC_SUBST(obj) + +#-------------------------------------------------------------------- +# executable file suffix +#-------------------------------------------------------------------- +exe='' +AC_SUBST(exe) + +#-------------------------------------------------------------------- +# flags when linking for cross platform targets (yet 'tis useful with +# native builds) +#-------------------------------------------------------------------- +CROSSLDFLAGS='' +AC_SUBST(CROSSLDFLAGS) + +dnl +dnl SSL and CRYPTO needs the library openSSL/ssleay +dnl +dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. +dnl If no option is given or --with-ssl is set without a path then we +dnl search for SSL libraries and header files in the standard locations. +dnl If set to --without-ssl we disable the use of SSL +dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we +dnl use "PATH/include" and "PATH/lib". + +AC_SUBST(SSLEAY_ROOT) +TARGET=$host + +# We search for SSL. First in the OTP team ClearCase standard location, +# then in the common OS standard locations +# No we do not. +SSL_APP=ssl +CRYPTO_APP=crypto +SSLEAY_ROOT=$TARGET +#for dir in /usr /usr/pkg /usr/local /usr/local/ssl /usr/lib/ssl /usr/ssl; do +# AC_CHECK_HEADER($dir/include/openssl/opensslv.h, +# ac_cv_openssl=yes, ac_cv_openssl=no) +# if test $ac_cv_openssl = yes ; then +# SSLEAY_ROOT="$dir" +# ssl_found=yes +# break +# fi +#done + +# Find a usable java compiler +# +# WARNING this code is copied from ERTS configure.in, and should be +# updated if that code changes. I hate duplicating code, but what +# can I do. +# +dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY +dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]]) +dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a +dnl AC_LANG_JAVA instead...) +AC_DEFUN(ERL_TRY_LINK_JAVA, +[java_link='$JAVAC conftest.java 1>&AC_FD_CC' +changequote(, )dnl +cat > conftest.java <&AC_FD_CC + cat conftest.java 1>&AC_FD_CC + echo "configure: PATH was $PATH" 1>&AC_FD_CC +ifelse([$4], , , [ rm -rf conftest* + $4 +])dnl +fi +rm -f conftest*]) +dnl +AC_CHECK_PROGS(JAVAC, javac guavac gcj jikes bock) +if test -n "$JAVAC"; then + dnl Make sure it's at least JDK 1.5 + AC_CACHE_CHECK(for JDK version 1.5, + ac_cv_prog_javac_ver_1_5, + [ERL_TRY_LINK_JAVA([], [for (String i : args);], + ac_cv_prog_javac_ver_1_5=yes, ac_cv_prog_javac_ver_1_5=no)]) + if test $ac_cv_prog_javac_ver_1_5 = no; then + unset -v JAVAC + fi +fi +if test -n "$JAVAC"; then + AC_SUBST(JAVAC) + : +fi + +AC_CHECK_PROGS([make_command], [make gmake], [false]) +AC_SUBST(make_command) + +if test "$GCC" = yes; then + test_c_compiler="{gnuc, undefined}" +else + test_c_compiler="undefined" +fi +AC_SUBST(test_c_compiler) + +AC_OUTPUT(conf_vars) diff --git a/lib/common_test/test_server/cross.cover b/lib/common_test/test_server/cross.cover new file mode 100644 index 0000000000..07bf0bed5c --- /dev/null +++ b/lib/common_test/test_server/cross.cover @@ -0,0 +1,20 @@ +%%% This is an -*- erlang -*- file. +%%% +%%% Elements in this file shall be on the form +%%% {Application,Modules}. +%%% +%%% Application is the name of an application or the atom all. +%%% Modules is a list of module names +%%% +%%% The Application shall include the listed Modules in its cover compilation, +%%% but not in the cover analysis. +%%% If Application=all it means that all application shall include the listed +%%% Modules in the cover compilation. +%%% +%%% After all tests are completed, the listed modules are analysed with cover +%%% data from all tests and the result is stored under the application where +%%% the modules belong. + +{all,[]}. + +{observer,[dbg]}. diff --git a/lib/common_test/test_server/ts.config b/lib/common_test/test_server/ts.config new file mode 100644 index 0000000000..cf3d269616 --- /dev/null +++ b/lib/common_test/test_server/ts.config @@ -0,0 +1,46 @@ +%% -*- erlang -*- + +%%% Change these to suite the environment. See the inet_SUITE for info about +%%% what they are used for. +%%% test_hosts are looked up using "ypmatch xx yy zz hosts.byname" +%{test_hosts,[my_ip4_host]}. + +%% IPv4 host only - no ipv6 entry must exist! +%{test_host_ipv4_only, +% {"my_ip4_host", %Short hostname +% "my_ip4_host.mydomain.com", %Long hostname +% "10.10.0.1", %IP string +% {10,10,0,1}, %IP tuple +% ["my_ip4_host"], %Any aliases +% "::ffff:10.10.0.1", %IPv6 string (compatibility addr) +% {0,0,0,0,0,65535,2570,1} %IPv6 tuple +% }}. + +%{test_dummy_host, {"dummy", +% "dummy.mydomain.com", +% "192.168.0.1", +% {192,168,0,1}, +% ["dummy"], +% "::ffff:192.168.0.1", +% {0,0,0,0,0,65535,49320,1} +% }}. + + +%%% test_hosts are looked up using "ypmatch xx yy zz ipnodes.byname" +%{ipv6_hosts,[my_ip6_host]}. + + +%{test_host_ipv6_only, +% {"my_ip6_host", %Short hostname +% "my_ip6_host.mydomain.com", %Long hostname +% "::2eff:f2b0:1ea0", %IPv6 string +% {0,0,0,0,0,12031,62128,7840}, %IPv6 tuple +% ["my_ip6_host"] %Aliases. +% }}. + +%{test_dummy_ipv6_host, {"dummy6", +% "dummy6.mydomain.com", +% "127::1", +% {295,0,0,0,0,0,0,1}, +% ["dummy6-ip6"] +% }}. diff --git a/lib/common_test/test_server/ts.erl b/lib/common_test/test_server/ts.erl new file mode 100644 index 0000000000..8bbdc8f8cf --- /dev/null +++ b/lib/common_test/test_server/ts.erl @@ -0,0 +1,1019 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : ts.erl +%%% Purpose : Frontend for running tests. +%%%------------------------------------------------------------------- + +-module(ts). + +-export([cl_run/1, + run/0, run/1, run/2, run/3, run/4, run/5, + run_category/1, run_category/2, run_category/3, + tests/0, tests/1, suites/1, categories/1, + install/0, install/1, + estone/0, estone/1, + cross_cover_analyse/1, + compile_testcases/0, compile_testcases/1, + help/0]). + +%% Functions kept for backwards compatibility +-export([bench/0, bench/1, bench/2, benchmarks/0, + smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0]). + +-export([i/0, l/1, r/0, r/1, r/2, r/3]). + +%%%---------------------------------------------------------------------- +%%% This module, ts, is the interface to all of the functionality of +%%% the TS framework. The picture below shows the relationship of +%%% the modules: +%%% +%%% +-- ts_install --+------ ts_autoconf_win32 +%%% | +%%% ts ---+ +------ ts_erl_config +%%% | | ts_lib +%%% +-- ts_run -----+------ ts_make +%%% | | ts_filelib +%%% | +------ ts_make_erl +%%% | +%%% +-- ts_benchmark +%%% +%%% The modules ts_lib and ts_filelib contains utilities used by +%%% the other modules. +%%% +%%% Module Description +%%% ------ ----------- +%%% ts Frontend to the test server framework. Contains all +%%% interface functions. +%%% ts_install Installs the test suite. On Unix, `autoconf' is +%%% is used; on Windows, ts_autoconf_win32 is used. +%%% The result is written to the file `variables'. +%%% ts_run Supervises running of the tests. +%%% ts_autconf_win32 An `autoconf' for Windows. +%%% ts_autconf_cross_env `autoconf' for other platforms (cross environment) +%%% ts_erl_config Finds out information about the Erlang system, +%%% for instance the location of erl_interface. +%%% This works for either an installed OTP or an Erlang +%%% system running in a git repository/source tree. +%%% ts_make Interface to run the `make' program on Unix +%%% and other platforms. +%%% ts_make_erl A corrected version of the standar Erlang module +%%% make (used for rebuilding test suites). +%%% ts_lib Miscellanous utility functions, each used by several +%%% other modules. +%%% ts_benchmark Supervises otp benchmarks and collects results. +%%%---------------------------------------------------------------------- + +-include_lib("kernel/include/file.hrl"). +-include("ts.hrl"). + +-define( + install_help, + [ + " ts:install()\n", + " Install ts with no options.\n", + "\n", + " ts:install(Options)\n", + " Install ts with a list of options, see below.\n", + "\n", + "Installation options supported:\n\n", + " {longnames, true} - Use fully qualified hostnames\n", + " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n" + " quiet(default).\n" + " {crossroot, ErlTop}\n" + " - Erlang root directory on build host, ~n" + " normally same value as $ERL_TOP\n" + " {crossenv, [{Key,Val}]}\n" + " - Environmentals used by test configure on build host\n" + " {crossflags, FlagsString}\n" + " - Flags used by test configure on build host\n" + " {xcomp, XCompFile}\n" + " - The xcomp file to use for cross compiling the~n" + " testcases. Using this option will override any~n" + " cross* configurations given to ts. Note that you~n" + " have to have a correct ERL_TOP as well.~n" + ]). + +help() -> + case filelib:is_file(?variables) of + false -> help(uninstalled); + true -> help(installed) + end. + +help(uninstalled) -> + H = ["ts is not yet installed. To install use:\n\n"], + show_help([H,?install_help]); +help(installed) -> + H = ["\n", + "Run functions:\n\n", + " ts:run()\n", + " Run the tests for all apps. The tests are defined by the\n", + " main test specification for each app: ../App_test/App.spec.\n", + "\n", + " ts:run(Apps)\n", + " Apps = atom() | [atom()]\n", + " Run the tests for an app, or set of apps. The tests are\n", + " defined by the main test specification for each app:\n", + " ../App_test/App.spec.\n", + "\n", + " ts:run(App, Suites)\n", + " App = atom(), Suites = atom() | [atom()]\n", + " Run one or more test suites for App (i.e. modules named\n", + " *_SUITE.erl, located in ../App_test/).\n", + "\n", + " ts:run(App, Suite, TestCases)\n", + " App = atom(), Suite = atom(),\n", + " TestCases = TCs | {testcase,TCs}, TCs = atom() | [atom()]\n", + " Run one or more test cases (functions) in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Groups})\n", + " App = atom(), Suite = atom(), Groups = atom() | [atom()]\n", + " Run one or more test case groups in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Group}, {testcase,TestCases})\n", + " App = atom(), Suite = atom(), Group = atom(),\n", + " TestCases = atom() | [atom()]\n", + " Run one or more test cases in a test case group in Suite.\n", + "\n", + " ts:run_category(TestCategory)\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for all apps.\n", + " For each app, the tests are defined by the specification:\n", + " ../App_test/App_TestCategory.spec.\n", + "\n", + " ts:run_category(Apps, TestCategory)\n", + " Apps = atom() | [atom()],\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for the given app or apps.\n", + "\n", + " Note that the test category parameter may have arbitrary value,\n", + " but should correspond to an existing test specification with file\n", + " name: ../App_test/App_TestCategory.spec.\n", + " Predefined categories exist for smoke tests, essential tests and\n", + " benchmark tests. The corresponding specs are:\n", + " ../*_test/Spec_smoke.spec, ../*_test/Spec_essential.spec and\n", + " ../*_test/Spec_bench.spec.\n", + "\n", + " All above run functions can take an additional last argument,\n", + " Options, which is a list of options (e.g. ts:run(App, Options),\n", + " or ts:run_category(Apps, TestCategory, Options)).\n", + "\n", + "Run options supported:\n\n", + " batch - Do not start a new xterm\n", + " {verbose, Level} - Same as the verbosity option for install\n", + " verbose - Same as {verbose, 1}\n", + " {vars, Vars} - Variables in addition to the 'variables' file\n", + " Can be any of the install options\n", + " {trace, TraceSpec}- Start call trace on target and slave nodes\n", + " TraceSpec is the name of a file containing\n", + " trace specifications or a list of trace\n", + " specification elements.\n", + " {config, Path} - Specify which directory ts should get it's \n" + " config files from. The files should follow\n" + " the convention lib/test_server/src/ts*.config.\n" + " These config files can also be specified by\n" + " setting the TEST_CONFIG_PATH environment\n" + " variable to the directory where the config\n" + " files are. The default location is\n" + " tests/test_server/.\n" + "\n", + "Supported trace information elements:\n\n", + " {tp | tpl, Mod, [] | match_spec()}\n", + " {tp | tpl, Mod, Func, [] | match_spec()}\n", + " {tp | tpl, Mod, Func, Arity, [] | match_spec()}\n", + " {ctp | ctpl, Mod}\n", + " {ctp | ctpl, Mod, Func}\n", + " {ctp | ctpl, Mod, Func, Arity}\n", + "\n\n", + "Support functions:\n\n", + " ts:tests()\n", + " Returns all apps available for testing.\n", + "\n", + " ts:tests(TestCategory)\n", + " Returns all apps that provide tests in the given category.\n", + "\n", + " ts:suites(App)\n", + " Returns all available test suites for App,\n", + " i.e. ../App_test/*_SUITE.erl\n", + "\n", + " ts:categories(App)\n", + " Returns all test categories available for App.\n", + "\n", + " ts:estone()\n", + " Runs estone_SUITE in the kernel application with no run options\n", + "\n", + " ts:estone(Opts)\n", + " Runs estone_SUITE in the kernel application with the given\n", + " run options\n", + "\n", + " ts:cross_cover_analyse(Level)\n", + " Use after ts:run with option cover or cover_details. Analyses\n", + " modules specified with a 'cross' statement in the cover spec file.\n", + " Level can be 'overview' or 'details'.\n", + "\n", + " ts:compile_testcases()\n", + " ts:compile_testcases(Apps)\n", + " Compiles all test cases for the given apps, for usage in a\n", + " cross compilation environment.\n", + "\n\n", + "Installation (already done):\n\n" + ], + show_help([H,?install_help]). + +show_help(H) -> + io:format(lists:flatten(H)). + + +%% Installs tests. +install() -> + ts_install:install(install_local,[]). +install(Options) when is_list(Options) -> + ts_install:install(install_local,Options). + +%% run/0 +%% Runs all specs found by ts:tests(), if any, or returns +%% {error, no_tests_available}. (batch) +run() -> + case ts:tests() of + [] -> + {error, no_tests_available}; + _ -> + check_and_run(fun(Vars) -> run_all(Vars) end) + end. +run_all(_Vars) -> + run_some(tests(), [batch]). + +run_some([], _Opts) -> + ok; +run_some(Apps, Opts) -> + case proplists:get_value(test_category, Opts) of + bench -> + check_and_run(fun(Vars) -> ts_benchmark:run(Apps, Opts, Vars) end); + _Other -> + run_some1(Apps, Opts) + end. + +run_some1([], _Opts) -> + ok; +run_some1([{App,Mod}|Apps], Opts) -> + case run(App, Mod, Opts) of + ok -> ok; + Error -> io:format("~p: ~p~n",[{App,Mod},Error]) + end, + run_some1(Apps, Opts); +run_some1([App|Apps], Opts) -> + case run(App, Opts) of + ok -> ok; + Error -> io:format("~p: ~p~n",[App,Error]) + end, + run_some1(Apps, Opts). + +%% This can be used from command line. Both App and +%% TestCategory must be specified. App may be 'all' +%% and TestCategory may be 'main'. Examples: +%% erl -s ts cl_run kernel smoke +%% erl -s ts cl_run kernel main +%% erl -s ts cl_run all essential +%% erl -s ts cl_run all main +%% When using the 'main' category and running with cover, +%% one can also use the cross_cover_analysis flag. +cl_run([App,Cat|Options0]) when is_atom(App) -> + + AllAtomsFun = fun(X) when is_atom(X) -> true; + (_) -> false + end, + Options1 = + case lists:all(AllAtomsFun, Options0) of + true -> + %% Could be from command line + lists:map(fun(Opt) -> + to_erlang_term(Opt) + end, Options0) -- [batch]; + false -> + Options0 -- [batch] + end, + %% Make sure there is exactly one occurence of 'batch' + Options2 = [batch|Options1], + + Result = + case {App,Cat} of + {all,main} -> + run(tests(), Options2); + {all,Cat} -> + run_category(Cat, Options2); + {_,main} -> + run(App, Options2); + {_,Cat} -> + run_category(App, Cat, Options2) + end, + case check_for_cross_cover_analysis_flag(Options2) of + false -> + ok; + Level -> + cross_cover_analyse(Level) + end, + Result. + +%% run/1 +%% Runs tests for one app (interactive). +run(App) when is_atom(App) -> + Options = check_test_get_opts(App, []), + File = atom_to_list(App), + run_test(File, [{spec,[File++".spec"]},{allow_user_terms,true}], Options); + +%% This can be used from command line, e.g. +%% erl -s ts run all +%% erl -s ts run main +run([all,main|Opts]) -> + cl_run([all,main|Opts]); +run([all|Opts]) -> + cl_run([all,main|Opts]); +run([main|Opts]) -> + cl_run([all,main|Opts]); +%% Backwards compatible +run([all_tests|Opts]) -> + cl_run([all,main|Opts]); + +%% run/1 +%% Runs the main tests for all available apps +run(Apps) when is_list(Apps) -> + run(Apps, [batch]). + +%% run/2 +%% Runs the main tests for all available apps +run(Apps, Opts) when is_list(Apps), is_list(Opts) -> + run_some(Apps, Opts); + +%% Runs tests for one app with list of suites or with options +run(App, ModsOrOpts) when is_atom(App), + is_list(ModsOrOpts) -> + case is_list_of_suites(ModsOrOpts) of + false -> + run(App, {opts_list,ModsOrOpts}); + true -> + run_some([{App,M} || M <- ModsOrOpts], + [batch]) + end; + +run(App, {opts_list,Opts}) -> + Options = check_test_get_opts(App, Opts), + File = atom_to_list(App), + + %% check if other test category than main has been specified + {CatSpecName,TestCat} = + case proplists:get_value(test_category, Opts) of + undefined -> + {"",main}; + Cat -> + {"_" ++ atom_to_list(Cat),Cat} + end, + + WhatToDo = + case App of + %% Known to exist but fails generic tests below + emulator -> test; + system -> test; + erl_interface -> test; + epmd -> test; + _ -> + case code:lib_dir(App) of + {error,bad_name} -> + %% Application does not exist + skip; + Path -> + case file:read_file_info(filename:join(Path,"ebin")) of + {ok,#file_info{type=directory}} -> + %% Erlang application is built + test; + _ -> + case filelib:wildcard( + filename:join([Path,"priv","*.jar"])) of + [] -> + %% The application is not built + skip; + [_|_] -> + %% Java application is built + test + end + end + end + end, + case WhatToDo of + skip -> + SkipSpec = create_skip_spec(App, suites(App)), + run_test(File, [{spec,[SkipSpec]}], Options); + test when TestCat == bench -> + check_and_run(fun(Vars) -> + ts_benchmark:run([App], Options, Vars) + end); + test -> + Spec = File ++ CatSpecName ++ ".spec", + run_test(File, [{spec,[Spec]},{allow_user_terms,true}], Options) + end; + +%% Runs one module for an app (interactive) +run(App, Mod) when is_atom(App), is_atom(Mod) -> + run_test({atom_to_list(App),Mod}, + [{suite,Mod}], + [interactive]). + +%% run/3 +%% Run one module for an app with Opts +run(App, Mod, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + run_test({atom_to_list(App),Mod}, + [{suite,Mod}], Options); + +%% Run multiple modules with Opts +run(App, Mods, Opts) when is_atom(App), + is_list(Mods), + is_list(Opts) -> + run_some([{App,M} || M <- Mods], Opts); + +%% Runs one test case in a module. +run(App, Mod, Case) when is_atom(App), + is_atom(Mod), + is_atom(Case) -> + Options = check_test_get_opts(App, []), + Args = [{suite,Mod},{testcase,Case}], + run_test(atom_to_list(App), Args, Options); + +%% Runs one or more groups in a module. +run(App, Mod, Grs={group,_Groups}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), + Args = [{suite,Mod},Grs], + run_test(atom_to_list(App), Args, Options); + +%% Runs one or more test cases in a module. +run(App, Mod, TCs={testcase,_Cases}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), + Args = [{suite,Mod},TCs], + run_test(atom_to_list(App), Args, Options). + +%% run/4 +%% Run one test case in a module with Options. +run(App, Mod, Case, Opts) when is_atom(App), + is_atom(Mod), + is_atom(Case), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + Args = [{suite,Mod},{testcase,Case}], + run_test(atom_to_list(App), Args, Options); + +%% Run one or more test cases in a module with Options. +run(App, Mod, {testcase,Cases}, Opts) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Cases, Opts); +run(App, Mod, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Cases), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + Args = [{suite,Mod},Cases], + run_test(atom_to_list(App), Args, Options); + +%% Run one or more test cases in a group. +run(App, Mod, Gr={group,_Group}, {testcase,Cases}) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Gr, Cases, [batch]); + + +%% Run one or more groups in a module with Options. +run(App, Mod, Grs={group,_Groups}, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + Args = [{suite,Mod},Grs], + run_test(atom_to_list(App), Args, Options). + +%% run/5 +%% Run one or more test cases in a group with Options. +run(App, Mod, Group, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + 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(App, Opts), + Args = [{suite,Mod},Group1,Cases1], + run_test(atom_to_list(App), Args, Options). + +%% run_category/1 +run_category(TestCategory) when is_atom(TestCategory) -> + run_category(TestCategory, [batch]). + +%% run_category/2 +run_category(TestCategory, Opts) when is_atom(TestCategory), + is_list(Opts) -> + case ts:tests(TestCategory) of + [] -> + {error, no_tests_available}; + Apps -> + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1) + end; + +run_category(Apps, TestCategory) when is_atom(TestCategory) -> + run_category(Apps, TestCategory, [batch]). + +%% run_category/3 +run_category(App, TestCategory, Opts) -> + Apps = if is_atom(App) -> [App]; + is_list(App) -> App + end, + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1). + +%%----------------------------------------------------------------- +%% Functions kept for backwards compatibility + +bench() -> + run_category(bench, []). +bench(Opts) when is_list(Opts) -> + run_category(bench, Opts); +bench(App) -> + run_category(App, bench, []). +bench(App, Opts) when is_atom(App) -> + run_category(App, bench, Opts); +bench(Apps, Opts) when is_list(Apps) -> + run_category(Apps, bench, Opts). + +benchmarks() -> + tests(bench). + +smoke_test() -> + run_category(smoke, []). +smoke_test(Opts) when is_list(Opts) -> + run_category(smoke, Opts); +smoke_test(App) -> + run_category(App, smoke, []). +smoke_test(App, Opts) when is_atom(App) -> + run_category(App, smoke, Opts); +smoke_test(Apps, Opts) when is_list(Apps) -> + run_category(Apps, smoke, Opts). + +smoke_tests() -> + tests(smoke). + +%%----------------------------------------------------------------- + +is_list_of_suites(List) -> + lists:all(fun(Suite) -> + S = if is_atom(Suite) -> atom_to_list(Suite); + true -> Suite + end, + try lists:last(string:tokens(S,"_")) of + "SUITE" -> true; + "suite" -> true; + _ -> false + catch + _:_ -> false + end + end, List). + +%% Create a spec to skip all SUITES, this is used when the application +%% to be tested is not part of the OTP release to be tested. +create_skip_spec(App, SuitesToSkip) -> + {ok,Cwd} = file:get_cwd(), + AppString = atom_to_list(App), + Specname = AppString++"_skip.spec", + {ok,D} = file:open(filename:join([filename:dirname(Cwd), + AppString++"_test",Specname]), + [write]), + TestDir = "\"../"++AppString++"_test\"", + io:format(D,"{suites, "++TestDir++", all}.~n",[]), + io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application" + " is not in path!\"}.",[SuitesToSkip]), + Specname. + +%% Check testspec for App to be valid and get possible options +%% from the list. +check_test_get_opts(App, Opts) -> + validate_test(App), + Mode = configmember(batch, {batch, interactive}, Opts), + Vars = configvars(Opts), + Trace = get_config(trace,Opts), + ConfigPath = get_config(config,Opts), + KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Opts), + Cover = configcover(App,Opts), + lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). + +to_erlang_term(Atom) -> + String = atom_to_list(Atom), + {ok, Tokens, _} = erl_scan:string(lists:append([String, ". "])), + {ok, Term} = erl_parse:parse_term(Tokens), + Term. + +%% Validate that Testspec really is a testspec, +%% and exit if not. +validate_test(Testspec) -> + case lists:member(Testspec, tests()) of + true -> + ok; + false -> + io:format("This testspec does not seem to be " + "available.~n Please try ts:tests() " + "to see available tests.~n"), + exit(self(), {error, test_not_available}) + end. + +configvars(Opts) -> + case lists:keysearch(vars, 1, Opts) of + {value, {vars, List}} -> + List0 = special_vars(Opts), + Key = fun(T) -> element(1,T) end, + DelDupList = + lists:filter(fun(V) -> + case lists:keysearch(Key(V),1,List0) of + {value,_} -> false; + _ -> true + end + end, List), + {vars, [List0|DelDupList]}; + _ -> + {vars, special_vars(Opts)} + end. + +%% Allow some shortcuts in the options... +special_vars(Opts) -> + SpecVars = + case lists:member(verbose, Opts) of + true -> + [{verbose, 1}]; + false -> + case lists:keysearch(verbose, 1, Opts) of + {value, {verbose, Lvl}} -> + [{verbose, Lvl}]; + _ -> + [{verbose, 0}] + end + end, + SpecVars1 = + case lists:keysearch(diskless, 1, Opts) of + {value,{diskless, true}} -> + [{diskless, true} | SpecVars]; + _ -> + SpecVars + end, + case lists:keysearch(testcase_callback, 1, Opts) of + {value,{testcase_callback, CBM, CBF}} -> + [{ts_testcase_callback, {CBM,CBF}} | SpecVars1]; + {value,{testcase_callback, CB}} -> + [{ts_testcase_callback, CB} | SpecVars1]; + _ -> + SpecVars1 + end. + +get_config(Key,Config) -> + case lists:keysearch(Key,1,Config) of + {value,Value} -> Value; + false -> [] + end. + +configcover(Testspec,[cover|_]) -> + {cover,Testspec,default_coverfile(Testspec),overview}; +configcover(Testspec,[cover_details|_]) -> + {cover,Testspec,default_coverfile(Testspec),details}; +configcover(Testspec,[{cover,File}|_]) -> + {cover,Testspec,File,overview}; +configcover(Testspec,[{cover_details,File}|_]) -> + {cover,Testspec,File,details}; +configcover(Testspec,[_H|T]) -> + configcover(Testspec,T); +configcover(_Testspec,[]) -> + []. + +default_coverfile(Testspec) -> + {ok,Cwd} = file:get_cwd(), + CoverFile = filename:join([filename:dirname(Cwd), + atom_to_list(Testspec)++"_test", + atom_to_list(Testspec)++".cover"]), + case filelib:is_file(CoverFile) of + true -> + CoverFile; + false -> + none + end. + +configmember(Member, {True, False}, Config) -> + case lists:member(Member, Config) of + true -> + True; + false -> + False + end. + + +check_for_cross_cover_analysis_flag(Config) -> + check_for_cross_cover_analysis_flag(Config,false,false). +check_for_cross_cover_analysis_flag([cover|Config],false,false) -> + check_for_cross_cover_analysis_flag(Config,overview,false); +check_for_cross_cover_analysis_flag([cover|_Config],false,true) -> + overview; +check_for_cross_cover_analysis_flag([cover_details|Config],false,false) -> + check_for_cross_cover_analysis_flag(Config,details,false); +check_for_cross_cover_analysis_flag([cover_details|_Config],false,true) -> + details; +check_for_cross_cover_analysis_flag([cross_cover_analysis|Config],false,_) -> + check_for_cross_cover_analysis_flag(Config,false,true); +check_for_cross_cover_analysis_flag([cross_cover_analysis|_Config],Level,_) -> + Level; +check_for_cross_cover_analysis_flag([_|Config],Level,CrossFlag) -> + check_for_cross_cover_analysis_flag(Config,Level,CrossFlag); +check_for_cross_cover_analysis_flag([],_,_) -> + false. + + +%% Returns all available apps. +tests() -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specs(Cwd). + +%% Returns all apps that provide tests in the given test category +tests(main) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specs(Cwd); +tests(bench) -> + ts_benchmark:benchmarks(); +tests(TestCategory) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specialized_specs(Cwd, atom_to_list(TestCategory)). + +%% Returns a list of available test suites for App. +suites(App) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:suites(Cwd, atom_to_list(App)). + +%% Returns all available test categories for App +categories(App) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:test_categories(Cwd, atom_to_list(App)). + +%% +%% estone/0, estone/1 +%% Opts = same as Opts or Config for the run(...) function, +%% e.g. [batch] +%% +estone() -> run(emulator,estone_SUITE). +estone(Opts) when is_list(Opts) -> run(emulator,estone_SUITE,Opts). + +%% +%% cross_cover_analyse/1 +%% Level = details | overview +%% Can be called on any node after a test (with cover) is +%% completed. The node's current directory must be the same as when +%% the tests were run. +%% +cross_cover_analyse([Level]) -> + cross_cover_analyse(Level); +cross_cover_analyse(Level) -> + Apps = get_last_app_tests(), + test_server_ctrl:cross_cover_analyse(Level,Apps). + +get_last_app_tests() -> + AllTests = filelib:wildcard(filename:join(["*","*_test.logs"])), + {ok,RE} = re:compile("^[^/]*/[^\.]*\.(.*)_test\.logs$"), + get_last_app_tests(AllTests,RE,[]). + +get_last_app_tests([Dir|Dirs],RE,Acc) -> + NewAcc = + case re:run(Dir,RE,[{capture,all,list}]) of + {match,[Dir,AppStr]} -> + Dir1 = filename:dirname(Dir), % cover logs in ct_run. dir + App = list_to_atom(AppStr), + case lists:keytake(App,1,Acc) of + {value,{App,LastDir},Rest} -> + if Dir1 > LastDir -> + [{App,Dir1}|Rest]; + true -> + Acc + end; + false -> + [{App,Dir1} | Acc] + end; + _ -> + Acc + end, + get_last_app_tests(Dirs,RE,NewAcc); +get_last_app_tests([],_,Acc) -> + Acc. + +%%% Implementation. + +check_and_run(Fun) -> + case file:consult(?variables) of + {ok, Vars} -> + check_and_run(Fun, Vars); + {error, Error} when is_atom(Error) -> + {error, not_installed}; + {error, Reason} -> + {error, {bad_installation, file:format_error(Reason)}} + end. + +check_and_run(Fun, Vars) -> + Platform = ts_install:platform_id(Vars), + case lists:keysearch(platform_id, 1, Vars) of + {value, {_, Platform}} -> + case catch apply(Fun, [Vars]) of + {'EXIT', Reason} -> + exit(Reason); + Other -> + Other + end; + {value, {_, OriginalPlatform}} -> + io:format("These test suites were installed for '~s'.\n", + [OriginalPlatform]), + io:format("But the current platform is '~s'.\nPlease " + "install for this platform before running " + "any tests.\n", [Platform]), + {error, inconsistent_platforms}; + false -> + {error, {bad_installation, no_platform}} + end. + +run_test(File, Args, Options) -> + check_and_run(fun(Vars) -> run_test(File, Args, Options, Vars) end). + +run_test(File, Args, Options, Vars) -> + ts_run:run(File, Args, Options, Vars). + + +%% This module provides some convenient shortcuts to running +%% the test server from within a started Erlang shell. +%% (This are here for backwards compatibility.) +%% +%% r() +%% r(Opts) +%% r(SpecOrMod) +%% r(SpecOrMod, Opts) +%% r(Mod, Case) +%% r(Mod, Case, Opts) +%% Each of these functions starts the test server if it +%% isn't already running, then runs the test case(s) selected +%% by the aguments. +%% SpecOrMod can be a module name or the name of a test spec file, +%% with the extension .spec or .spec.OsType. The module Mod will +%% be reloaded before running the test cases. +%% Opts = [Opt], +%% Opt = {Cover,AppOrCoverFile} | {Cover,App,CoverFile} +%% Cover = cover | cover_details +%% AppOrCoverFile = App | CoverFile +%% App = atom(), an application name +%% CoverFile = string(), name of a cover file +%% (see doc of test_server_ctrl:cover/2/3) +%% +%% i() +%% Shows information about the jobs being run, by dumping +%% the process information for the test_server. +%% +%% l(Mod) +%% This function reloads a module just like c:l/1, but works +%% even for a module in one of the sticky library directories +%% (for instance, lists can be reloaded). + +%% Runs all tests cases in the current directory. + +r() -> + r([]). +r(Opts) when is_list(Opts), is_atom(hd(Opts)) -> + ensure_ts_started(Opts), + test_server_ctrl:add_dir("current_dir", "."); + +%% Checks if argument is a spec file or a module +%% (spec file must be named "*.spec" or "*.spec.OsType") +%% If module, reloads module and runs all test cases in it. +%% If spec, runs all test cases in it. + +r(SpecOrMod) -> + r(SpecOrMod,[]). +r(SpecOrMod,Opts) when is_list(Opts) -> + ensure_ts_started(Opts), + case filename:extension(SpecOrMod) of + [] -> + l(SpecOrMod), + test_server_ctrl:add_module(SpecOrMod); + ".spec" -> + test_server_ctrl:add_spec(SpecOrMod); + _ -> + Spec2 = filename:rootname(SpecOrMod), + case filename:extension(Spec2) of + ".spec" -> + %% *.spec.Type + test_server_ctrl:add_spec(SpecOrMod); + _ -> + {error, unknown_filetype} + end + end; + +%% Reloads the given module and runs the given test case in it. + +r(Mod, Case) -> + r(Mod,Case,[]). +r(Mod, Case, Opts) -> + ensure_ts_started(Opts), + l(Mod), + test_server_ctrl:add_case(Mod, Case). + +%% Shows information about the jobs being run. + +i() -> + ensure_ts_started([]), + hformat("Job", "Current", "Total", "Success", "Failed", "Skipped"), + i(test_server_ctrl:jobs()). + +i([{Name, Pid}|Rest]) when is_pid(Pid) -> + {dictionary, PI} = process_info(Pid, dictionary), + {value, {_, CaseNum}} = lists:keysearch(test_server_case_num, 1, PI), + {value, {_, Cases}} = lists:keysearch(test_server_cases, 1, PI), + {value, {_, Failed}} = lists:keysearch(test_server_failed, 1, PI), + {value, {_, {UserSkipped,AutoSkipped}}} = lists:keysearch(test_server_skipped, 1, PI), + {value, {_, Ok}} = lists:keysearch(test_server_ok, 1, PI), + nformat(Name, CaseNum, Cases, Ok, Failed, UserSkipped+AutoSkipped), + i(Rest); +i([]) -> + ok. + +hformat(A1, A2, A3, A4, A5, A6) -> + io:format("~-20s ~8s ~8s ~8s ~8s ~8s~n", [A1,A2,A3,A4,A5,A6]). + +nformat(A1, A2, A3, A4, A5, A6) -> + io:format("~-20s ~8w ~8w ~8w ~8w ~8w~n", [A1,A2,A3,A4,A5,A6]). + +%% Force load of a module even if it is in a sticky directory. + +l(Mod) -> + case do_load(Mod) of + {error, sticky_directory} -> + Dir = filename:dirname(code:which(Mod)), + code:unstick_dir(Dir), + do_load(Mod), + code:stick_dir(Dir); + X -> + X + end. + + +ensure_ts_started(Opts) -> + Pid = case whereis(test_server_ctrl) of + undefined -> + test_server_ctrl:start(); + P when is_pid(P) -> + P + end, + case Opts of + [{Cover,AppOrCoverFile}] when Cover==cover; Cover==cover_details -> + test_server_ctrl:cover(AppOrCoverFile,cover_type(Cover)); + [{Cover,App,CoverFile}] when Cover==cover; Cover==cover_details -> + test_server_ctrl:cover(App,CoverFile,cover_type(Cover)); + _ -> + ok + end, + Pid. + +cover_type(cover) -> overview; +cover_type(cover_details) -> details. + +do_load(Mod) -> + code:purge(Mod), + code:load_file(Mod). + + +compile_testcases() -> + compile_datadirs("../*/*_data"). + +compile_testcases(App) when is_atom(App) -> + compile_testcases([App]); +compile_testcases([App | T]) -> + compile_datadirs(io_lib:format("../~s_test/*_data", [App])), + compile_testcases(T); +compile_testcases([]) -> + ok. + +compile_datadirs(DataDirs) -> + {ok,Variables} = file:consult("variables"), + + lists:foreach(fun(Dir) -> + ts_lib:make_non_erlang(Dir, Variables) + end, + filelib:wildcard(DataDirs)). diff --git a/lib/common_test/test_server/ts.hrl b/lib/common_test/test_server/ts.hrl new file mode 100644 index 0000000000..4c940fdc4f --- /dev/null +++ b/lib/common_test/test_server/ts.hrl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% Defines ripped out from test_server (these must remain the same +%% as in test_server). + +-define(logdir_ext, ".logs"). +-define(suitelog_name, "suite.log"). +-define(last_file, "last_name"). +-define(last_link, "last_link"). +-define(last_test, "last_test"). +-define(run_summary, "suite.summary"). +-define(cover_total,"total_cover.log"). +-define(variables, "variables"). +-define(cross_variables, "variables-cross"). +-define(LF, [10]). % Newline in VxWorks script +-define(CHAR_PER_LINE, 60). % Characters per VxWorks script building line +-define(CROSS_COOKIE, "cross"). % cookie used when cross platform testing +-define(TS_PORT, 7887). +-define(TEST_SERVER_SCRIPT, "test_server_vx.script"). + diff --git a/lib/common_test/test_server/ts.unix.config b/lib/common_test/test_server/ts.unix.config new file mode 100644 index 0000000000..1ba5d9033e --- /dev/null +++ b/lib/common_test/test_server/ts.unix.config @@ -0,0 +1,6 @@ +%% -*- erlang -*- + +%% Always run a (VNC) X server on host +%% {xserver, "xserver.example.com:66"}. + +{unix,[{telnet,"belegost"},{username,"telnet-test"},{password,"tset-tenlet"},{keep_alive,true}]}. diff --git a/lib/common_test/test_server/ts.win32.config b/lib/common_test/test_server/ts.win32.config new file mode 100644 index 0000000000..cae587bea8 --- /dev/null +++ b/lib/common_test/test_server/ts.win32.config @@ -0,0 +1,8 @@ +%% -*- erlang -*- + +%%% There is no equivalent command to ypmatch on Win32... :-( +%{hardcoded_hosts, +% [{"127.0.0.1","localhost"}]}. + +%{hardcoded_ipv6_hosts, +% [{"::1","localhost"}]}. diff --git a/lib/common_test/test_server/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl new file mode 100644 index 0000000000..288305b406 --- /dev/null +++ b/lib/common_test/test_server/ts_autoconf_win32.erl @@ -0,0 +1,256 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% Purpose : Autoconf for Windows. + +-module(ts_autoconf_win32). +-export([configure/0]). + +-include("ts.hrl"). + +configure() -> + case variables() of + {ok, Vars} -> + ts_lib:subst_file("conf_vars.in", "conf_vars", Vars); + Error -> + Error + end. + +variables() -> + run_tests(tests(), []). + +run_tests([{Prompt, Tester}|Rest], Vars) -> + io:format("checking ~s... ", [Prompt]), + case catch Tester(Vars) of + {'EXIT', Reason} -> + io:format("FAILED~nExit status: ~p~n", [Reason]), + {error, auto_conf_failed}; + {Result, NewVars} -> + io:format("~s~n", [lists:concat([Result])]), + run_tests(Rest, NewVars) + end; +run_tests([], Vars) -> + {ok, Vars}. + +%%% The tests. + +tests() -> + [{"host system type", fun system_type/1}, + {"CPU type", fun cpu/1}, + {"for C compiler", fun c_compiler/1}, + {"for make program", fun make/1}, + {"for location of SSL libraries", fun ssl/1}, + {"for location of Java compiler", fun javac/1}]. + +system_type(Vars) -> + Os = case os:type() of + {win32, nt} -> + case os:version() of + {4,_,_} -> "Windows NT"; + {5,0,_} -> "Windows 2000"; + {5,1,_} -> "Windows XP"; + {5,2,_} -> "Windows 2003"; + {6,0,_} -> "Windows Vista"; + {6,1,_} -> "Windows 7"; + {_,_,_} -> "Windows NCC-1701-D" + end; + {win32, windows} -> + case os:version() of + {4,0,_} -> "Windows 95"; + {4,10,_} -> "Windows 98" + end; + {win32, _} -> "Windows" + end, + {Os, [{host_os, Os}, {host, "win32"}|Vars]}. + +cpu(Vars) -> + Arch = os:getenv("PROCESSOR_ARCHITECTURE"), + Level0 = os:getenv("PROCESSOR_Level"), + Cpu = case {Arch, Level0} of + {"x86", Level} when is_list(Level) -> + "i" ++ Level ++ "86"; + {Other, _Level} when is_list(Other) -> + Other; + {false, _} -> + "i386" + end, + {Cpu, [{host_cpu, Cpu}|Vars]}. + +c_compiler(Vars) -> + try + CompTests = [{msc, fun visual_cxx/1}, + {gnuc, fun mingw32/1}], + %% First try to find the same compiler that the system + %% was built with... + UsedCompiler = case erlang:system_info(c_compiler_used) of + {UsedCmplr, _} -> + case lists:keysearch(UsedCmplr, 1, CompTests) of + {value, {UsedCmplr, CompTest}} -> + CompTest(Vars); + _ -> + ok + end, + UsedCmplr; + undefined -> + undefined + end, + %% ... then try to find a compiler... + lists:foreach(fun ({Cmplr, _CmplrTst}) when Cmplr =:= UsedCompiler -> + ok; % Have already checked for this one + ({_Cmplr, CmplrTst}) -> + CmplrTst(Vars) + end, + CompTests), + {no, Vars} + catch + throw:{_Path, _NewVars} = Res -> Res + end. + +visual_cxx(Vars) -> + case os:find_executable("cl") of + false -> + {no, Vars}; + Path when is_list(Path) -> + {DEFAULT_THR_LIB, + ERTS_THR_LIB, + DLL, + DBG_LINK, + DBG_COMP, + OPT} = + case is_debug_build() of + true -> + {"-MTd ", + "-MDd ", + "-LDd ", + "-debug -pdb:none ", + "-Z7 -DDEBUG", + " "}; + false -> + {"-MT ", + "-MD ", + "-LD ", + " ", + " ", + "-Ox "} + end, + WIN32 = "-D__WIN32__ ", + ERTS_CFLAGS = ERTS_THR_LIB ++ WIN32 ++ OPT ++ DBG_COMP, + LIBS = "ws2_32.lib", + CC = "cl -nologo", + throw({Path, [{'CC', CC}, + {'LD', CC}, + {'SHLIB_LD', CC}, + {'SHLIB_LDFLAGS', ERTS_THR_LIB ++ DLL}, + {'SHLIB_LDLIBS', "-link " ++ DBG_LINK ++ "kernel32.lib"}, + {'SHLIB_EXTRACT_ALL', ""}, + {'CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP}, + {'EI_CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP}, + {'ERTS_CFLAGS', ERTS_CFLAGS}, + {'SHLIB_CFLAGS', ERTS_CFLAGS++DLL}, + {'CROSSLDFLAGS', ""}, + {'DEFS', common_c_defs()}, + {'SHLIB_SUFFIX', ".dll"}, + {'ERTS_LIBS', ERTS_THR_LIB ++ LIBS}, + {'LIBS', DEFAULT_THR_LIB ++ "-link " ++ DBG_LINK ++ LIBS}, + {obj,".obj"}, + {exe, ".exe"}, + {test_c_compiler, "{msc, undefined}"} + | Vars]}) + end. + +mingw32(Vars) -> + Gcc = "mingw32-gcc", + case os:find_executable(Gcc) of + false -> + {no, Vars}; + Path when is_list(Path) -> + {DBG_COMP, + OPT} = + case is_debug_build() of + true -> + {"-DDEBUG", + " "}; + false -> + {" ", + "-O2 "} + end, + WIN32 = "-D__WIN32__ ", + ERTS_CFLAGS = WIN32 ++ "-g " ++ OPT ++ DBG_COMP, + LIBS = "-lws2_32", + CC = Gcc, + throw({Path, [{'CC', CC}, + {'LD', CC}, + {'SHLIB_LD', CC}, + {'SHLIB_LDFLAGS', "-shared "}, + {'SHLIB_LDLIBS', " -lkernel32"}, + {'SHLIB_EXTRACT_ALL', ""}, + {'CFLAGS', WIN32 ++ DBG_COMP}, + {'EI_CFLAGS', WIN32 ++ DBG_COMP}, + {'ERTS_CFLAGS', ERTS_CFLAGS}, + {'SHLIB_CFLAGS', ERTS_CFLAGS}, + {'CROSSLDFLAGS', ""}, + {'DEFS', common_c_defs()}, + {'SHLIB_SUFFIX', ".dll"}, + {'ERTS_LIBS', LIBS}, + {'LIBS', LIBS}, + {obj,".o"}, + {exe, ".exe"}, + {test_c_compiler, "{gnuc, undefined}"} + | Vars]}) + end. + +common_c_defs() -> + "-DHAVE_STRERROR=1". + +make(Vars) -> + try + find_make("nmake -nologo", Vars), + find_make("mingw32-make", Vars) + catch + throw:{_Path, _NewVars} = Res -> Res + end. + +find_make(MakeCmd, Vars) -> + [Make|_] = string:tokens(MakeCmd, " \t"), + case os:find_executable(Make) of + false -> + {no, Vars}; + Path when is_list(Path) -> + throw({Path, [{make_command, MakeCmd} | Vars]}) + end. + +ssl(Vars) -> + {"win32",[{'SSLEAY_ROOT',"win32"}|Vars]}. + +javac(Vars) -> + case os:find_executable("javac") of + false -> + {no, Vars}; + Path when is_list(Path) -> + {Path, [{'JAVAC', "javac"} | Vars]} + end. + +is_debug_build() -> + case catch string:str(erlang:system_info(system_version), "debug") of + Int when is_integer(Int), Int > 0 -> + true; + _ -> + false + end. diff --git a/lib/common_test/test_server/ts_benchmark.erl b/lib/common_test/test_server/ts_benchmark.erl new file mode 100644 index 0000000000..3e55edefb0 --- /dev/null +++ b/lib/common_test/test_server/ts_benchmark.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ts_benchmark). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("kernel/include/file.hrl"). +-include("ts.hrl"). + +-export([benchmarks/0, + run/3]). + +%% gen_event callbacks +-export([init/1, handle_event/2]). + +benchmarks() -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specialized_specs(Cwd,"bench"). + +run(Specs, Opts, Vars) -> + {ok, Cwd} = file:get_cwd(), + {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(), + BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]), + BDir = filename:join([Cwd,BName]), + file:make_dir(BDir), + [ts_run:run(atom_to_list(Spec), + [{spec, [atom_to_list(Spec)++"_bench.spec"]}], + [{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars) + || Spec <- Specs], + file:delete(filename:join(Cwd,"latest_benchmark")), + {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]), + io:format(D,BDir,[]), + file:close(D). + + +%%%=================================================================== +%%% gen_event callbacks +%%%=================================================================== + +-record(state, { spec, suite, tc, stats_dir}). + +init([Spec,Dir]) -> + {ok, #state{ spec = Spec, stats_dir = Dir }}. + +handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) -> + {ok,State#state{ suite = Suite, tc = Tc}}; +handle_event(#event{name = benchmark_data, data = Data}, State) -> + Spec = proplists:get_value(application, Data, State#state.spec), + Suite = proplists:get_value(suite, Data, State#state.suite), + Tc = proplists:get_value(name, Data, State#state.tc), + Value = proplists:get_value(value, Data), + {ok, D} = file:open(filename:join( + [State#state.stats_dir, + lists:concat([e(Spec),"-",e(Suite),"-", + e(Tc),".ebench"])]), + [append]), + io:format(D, "~p~n",[Value]), + file:close(D), + {ok, State}; +handle_event(_Event, State) -> + {ok, State}. + + +e(Atom) when is_atom(Atom) -> + Atom; +e(Str) when is_list(Str) -> + lists:map(fun($/) -> + $\\; + (C) -> + C + end,Str). diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl new file mode 100644 index 0000000000..ab7363c106 --- /dev/null +++ b/lib/common_test/test_server/ts_erl_config.erl @@ -0,0 +1,403 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% Purpose : Updates variable list with variables depending on +%%% running Erlang system. + +-module(ts_erl_config). + + +-export([variables/2]). + +%% Returns a list of key, value pairs. + +variables(Base0, OsType) -> + Base1 = erl_include(Base0), + Base2 = get_app_vars(fun erl_interface/2, Base1, OsType), + Base3 = get_app_vars(fun ic/2, Base2, OsType), + Base4 = get_app_vars(fun jinterface/2, Base3, OsType), + Base5 = dl_vars(Base4, Base3, OsType), + Base6 = emu_vars(Base5), + Base7 = get_app_vars(fun ssl/2, Base6, OsType), + Base8 = erts_lib(Base7, OsType), + Base = separators(Base8, OsType), + [{'EMULATOR', tl(code:objfile_extension())}, + {emu_threads, atom_to_list(erlang:system_info(threads))}, + {type_marker, case is_debug_build() of + true -> + ".debug"; + false -> + "" + end} + | Base]. + +get_app_vars(AppFun, Vars, OsType) -> + case catch AppFun(Vars,OsType) of + Res when is_list(Res) -> + Res; + {cannot_find_app, App} -> + io:format("* WARNING: Cannot find ~p!~n", [App]), + Vars; + {'EXIT', Reason} -> + exit(Reason); + Garbage -> + exit({unexpected_internal_error, Garbage}) + end. + +dl_vars(Vars, Base3, OsType) -> + ShlibRules0 = ".SUFFIXES:\n" ++ + ".SUFFIXES: @dll@ @obj@ .c\n\n" ++ + ".c@dll@:\n" ++ + "\t@CC@ -c @SHLIB_CFLAGS@ $(SHLIB_EXTRA_CFLAGS) -I@erl_include@ @DEFS@ $<\n" ++ + "\t@SHLIB_LD@ @CROSSLDFLAGS@ @SHLIB_LDFLAGS@ $(SHLIB_EXTRA_LDFLAGS) -o $@ $*@obj@ @SHLIB_LDLIBS@ $(SHLIB_EXTRA_LDLIBS)", + + ShlibRules = ts_lib:subst(ShlibRules0, Vars), + case get_app_vars2(fun jinterface/2, Base3, OsType) of + {App, not_found} -> + [{'SHLIB_RULES', ShlibRules}, {App, "not_found"}|Vars]; + _ -> + [{'SHLIB_RULES', ShlibRules}|Vars] + end. +get_app_vars2(AppFun, Vars, OsType) -> + case catch AppFun(Vars,OsType) of + Res when is_list(Res) -> + {jinterface, ok}; + {cannot_find_app, App} -> + {App, not_found}; + {'EXIT', Reason} -> + exit(Reason); + Garbage -> + exit({unexpected_internal_error, Garbage}) + end. + +erts_lib_name(multi_threaded, {win32, V}) -> + link_library("erts_MD" ++ case is_debug_build() of + true -> "d"; + false -> "" + end, + {win32, V}); +erts_lib_name(single_threaded, {win32, V}) -> + link_library("erts_ML" ++ case is_debug_build() of + true -> "d"; + false -> "" + end, + {win32, V}); +erts_lib_name(multi_threaded, OsType) -> + link_library("erts_r", OsType); +erts_lib_name(single_threaded, OsType) -> + link_library("erts", OsType). + +erts_lib(Vars,OsType) -> + {ErtsLibInclude, + ErtsLibIncludeGenerated, + ErtsLibIncludeInternal, + ErtsLibIncludeInternalGenerated, + ErtsLibPath, + ErtsLibInternalPath, + ErtsLibEthreadMake, + ErtsLibInternalMake + } + = case erl_root(Vars) of + {installed, _Root} -> + Erts = lib_dir(Vars, erts), + ErtsInclude = filename:join([Erts, "include"]), + ErtsIncludeInternal = filename:join([ErtsInclude, "internal"]), + ErtsLib = filename:join([Erts, "lib"]), + ErtsLibInternal = filename:join([ErtsLib, "internal"]), + ErtsEthreadMake = filename:join([ErtsIncludeInternal, "ethread.mk"]), + ErtsInternalMake = filename:join([ErtsIncludeInternal, "erts_internal.mk"]), + + {ErtsInclude, + ErtsInclude, + ErtsIncludeInternal, + ErtsIncludeInternal, + ErtsLib, + ErtsLibInternal, + ErtsEthreadMake, + ErtsInternalMake}; + {srctree, Root, Target} -> + Erts = filename:join([Root, "erts"]), + ErtsInclude = filename:join([Erts, "include"]), + ErtsIncludeTarget = filename:join([ErtsInclude, Target]), + ErtsIncludeInternal = filename:join([ErtsInclude, + "internal"]), + ErtsIncludeInternalTarget = filename:join([ErtsIncludeInternal, + Target]), + ErtsLib = filename:join([Erts, "lib", Target]), + ErtsLibInternal = filename:join([Erts, + "lib", + "internal", + Target]), + ErtsEthreadMake = filename:join([ErtsIncludeInternalTarget, "ethread.mk"]), + ErtsInternalMake = filename:join([ErtsIncludeInternalTarget, "erts_internal.mk"]), + + {ErtsInclude, + ErtsIncludeTarget, + ErtsIncludeInternal, + ErtsIncludeInternalTarget, + ErtsLib, + ErtsLibInternal, + ErtsEthreadMake, + ErtsInternalMake} + end, + [{erts_lib_include, + quote(filename:nativename(ErtsLibInclude))}, + {erts_lib_include_generated, + quote(filename:nativename(ErtsLibIncludeGenerated))}, + {erts_lib_include_internal, + quote(filename:nativename(ErtsLibIncludeInternal))}, + {erts_lib_include_internal_generated, + quote(filename:nativename(ErtsLibIncludeInternalGenerated))}, + {erts_lib_path, quote(filename:nativename(ErtsLibPath))}, + {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))}, + {erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)}, + {erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)}, + {erts_lib_make_ethread, quote(ErtsLibEthreadMake)}, + {erts_lib_make_internal, quote(ErtsLibInternalMake)} + | Vars]. + +erl_include(Vars) -> + Include = + case erl_root(Vars) of + {installed, Root} -> + quote(filename:join([Root, "usr", "include"])); + {srctree, Root, Target} -> + quote(filename:join([Root, "erts", "emulator", "beam"])) + ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"])) + ++ system_include(Root, Vars) + ++ " -I" ++ quote(filename:join([Root, "erts", "include"])) + ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target])) + end, + [{erl_include, filename:nativename(Include)}|Vars]. + + +system_include(Root, Vars) -> + SysDir = + case ts_lib:var(os, Vars) of + "Windows" ++ _T -> "sys/win32"; + _ -> "sys/unix" + end, + " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))). + +erl_interface(Vars,OsType) -> + {Incl, {LibPath, MkIncl}} = + case lib_dir(Vars, erl_interface) of + {error, bad_name} -> + throw({cannot_find_app, erl_interface}); + Dir -> + {filename:join(Dir, "include"), + case erl_root(Vars) of + {installed, _Root} -> + {filename:join(Dir, "lib"), + filename:join([Dir, "src", "eidefs.mk"])}; + {srctree, _Root, Target} -> + {filename:join([Dir, "obj", Target]), + filename:join([Dir, "src", Target, "eidefs.mk"])} + end} + end, + Lib = link_library("erl_interface",OsType), + Lib1 = link_library("ei",OsType), + {LibDrv, Lib1Drv} = + case erlang:system_info(threads) of + false -> + case OsType of + {unix,_} -> + {link_library("erl_interface_st",OsType), + link_library("ei_st",OsType)}; + _ -> + {Lib, Lib1} + end; + true -> + case OsType of + {win32, _} -> + {link_library("erl_interface_md",OsType), + link_library("ei_md",OsType)}; + _ -> + {Lib, Lib1} + end + end, + ThreadLib = case OsType of + % FIXME: FreeBSD uses gcc flag '-pthread' or linking with + % "libc_r". So it has to be last of libs. This is an + % temporary solution, should be configured elsewhere. + + % This temporary solution have now failed! + % A new temporary solution is installed ... + % {unix,freebsd} -> "-lc_r"; + {unix,freebsd} -> + "-lpthread"; + {unix,_} -> + "-lpthread"; + _ -> + "" + end, + [{erl_interface_libpath, quote(filename:nativename(LibPath))}, + {erl_interface_sock_libs, sock_libraries(OsType)}, + {erl_interface_lib, quote(filename:join(LibPath, Lib))}, + {erl_interface_eilib, quote(filename:join(LibPath, Lib1))}, + {erl_interface_lib_drv, quote(filename:join(LibPath, LibDrv))}, + {erl_interface_eilib_drv, quote(filename:join(LibPath, Lib1Drv))}, + {erl_interface_threadlib, ThreadLib}, + {erl_interface_include, quote(filename:nativename(Incl))}, + {erl_interface_mk_include, quote(filename:nativename(MkIncl))} + | Vars]. + +ic(Vars, OsType) -> + {ClassPath, LibPath, Incl} = + case lib_dir(Vars, ic) of + {error, bad_name} -> + throw({cannot_find_app, ic}); + Dir -> + {filename:join([Dir, "priv", "ic.jar"]), + case erl_root(Vars) of + {installed, _Root} -> + filename:join([Dir, "priv", "lib"]); + {srctree, _Root, Target} -> + filename:join([Dir, "priv", "lib", Target]) + end, + filename:join(Dir, "include")} + end, + [{ic_classpath, quote(filename:nativename(ClassPath))}, + {ic_libpath, quote(filename:nativename(LibPath))}, + {ic_lib, quote(filename:join(filename:nativename(LibPath),link_library("ic", OsType)))}, + {ic_include_path, quote(filename:nativename(Incl))}|Vars]. + +jinterface(Vars, _OsType) -> + ClassPath = + case lib_dir(Vars, jinterface) of + {error, bad_name} -> + throw({cannot_find_app, jinterface}); + Dir -> + filename:join([Dir, "priv", "OtpErlang.jar"]) + end, + [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars]. + +lib_dir(Vars, Lib) -> + LibLibDir = case Lib of + erts -> + filename:join([code:root_dir(), + "erts-" ++ erlang:system_info(version)]); + _ -> + code:lib_dir(Lib) + end, + case {get_var(crossroot, Vars), LibLibDir} of + {{error, _}, _} -> %no crossroot + LibLibDir; + {CrossRoot, _} -> + %% XXX: Ugly. So ugly I won't comment it + %% /Patrik + CLibDirList = case Lib of + erts -> + [CrossRoot, "erts"]; + _ -> + [CrossRoot, "lib", atom_to_list(Lib)] + end, + CLibDir = filename:join(CLibDirList), + Cmd = "ls -d " ++ CLibDir ++ "*", + XLibDir = lists:last(string:tokens(os:cmd(Cmd),"\n")), + case file:list_dir(XLibDir) of + {error, enoent} -> + []; + _ -> + XLibDir + end + end. + +erl_root(Vars) -> + Root = case get_var(crossroot,Vars) of + {error, notfound} -> code:root_dir(); + CrossRoot -> CrossRoot + end, + case ts_lib:erlang_type(Root) of + {srctree, _Version} -> + Target = get_var(target, Vars), + {srctree, Root, Target}; + {_, _Version} -> + {installed, Root} + end. + + +get_var(Key, Vars) -> + case lists:keysearch(Key, 1, Vars) of + {value, {Key, Value}} -> + Value; + _ -> + {error, notfound} + end. + + +sock_libraries({win32, _}) -> + "ws2_32.lib"; +sock_libraries({unix, _}) -> + "". % Included in general libraries if needed. + +link_library(LibName,{win32, _}) -> + LibName ++ ".lib"; +link_library(LibName,{unix, _}) -> + "lib" ++ LibName ++ ".a"; +link_library(_LibName,_Other) -> + exit({link_library, not_supported}). + +%% Returns emulator specific variables. +emu_vars(Vars) -> + [{is_source_build, is_source_build()}, + {erl_name, atom_to_list(lib:progname())}|Vars]. + +is_source_build() -> + string:str(erlang:system_info(system_version), "[source]") > 0. + +is_debug_build() -> + case catch string:str(erlang:system_info(system_version), "debug") of + Int when is_integer(Int), Int > 0 -> + true; + _ -> + false + end. +%% +%% ssl_libdir +%% +ssl(Vars, _OsType) -> + case lib_dir(Vars, ssl) of + {error, bad_name} -> + throw({cannot_find_app, ssl}); + Dir -> + [{ssl_libdir, quote(filename:nativename(Dir))}| Vars] + end. + +separators(Vars, {win32,_}) -> + [{'DS',"\\"},{'PS',";"}|Vars]; +separators(Vars, _) -> + [{'DS',"/"},{'PS',":"}|Vars]. + +quote(List) -> + case lists:member($ , List) of + false -> List; + true -> make_quote(List) + end. + +make_quote(List) -> + case os:type() of + {win32, _} -> %% nmake" + [$"] ++ List ++ [$"]; + _ -> %% make + BackQuote = fun($ , Acc) -> [$\\ , $ |Acc]; + (Char, Acc) -> [Char|Acc] end, + lists:foldr(BackQuote, [], List) + end. diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl new file mode 100644 index 0000000000..600a576820 --- /dev/null +++ b/lib/common_test/test_server/ts_install.erl @@ -0,0 +1,465 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ts_install). + +-export([install/2, platform_id/1]). + +-include("ts.hrl"). +-include_lib("kernel/include/file.hrl"). + +install(install_local, Options) -> + install(os:type(), Options); + +install(TargetSystem, Options) -> + case file:consult(?variables) of + {ok, Vars} -> + case proplists:get_value(cross,Vars) of + "yes" when Options == []-> + target_install(Vars); + _ -> + build_install(TargetSystem, Options) + end; + _ -> + build_install(TargetSystem, Options) + end. + + +build_install(TargetSystem, Options) -> + XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)), + case autoconf(TargetSystem, XComp++Options) of + {ok, Vars0} -> + OsType = os_type(TargetSystem), + Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType), + {Options1, Vars2} = add_vars(Vars1, Options), + Vars3 = lists:flatten([Options1|Vars2]), + write_terms(?variables, Vars3); + {error, Reason} -> + {error, Reason} + end. + +os_type({unix,_}=OsType) -> OsType; +os_type({win32,_}=OsType) -> OsType. + +target_install(CrossVars) -> + io:format("Cross installation detected, skipping configure and data_dir make~n"), + case file:rename(?variables,?cross_variables) of + ok -> + ok; + _ -> + io:format("Could not find variables file from cross make~n"), + throw(cross_installation_failed) + end, + CPU = proplists:get_value('CPU',CrossVars), + OS = proplists:get_value(os,CrossVars), + {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]), + Variables = lists:flatten([Options|Vars]), + write_terms(?variables, Variables). + +%% Autoconf for various platforms. +%% unix uses the configure script +%% win32 uses ts_autoconf_win32 + +autoconf(TargetSystem, XComp) -> + case autoconf1(TargetSystem, XComp) of + ok -> + autoconf2(file:read_file("conf_vars")); + Error -> + Error + end. + +autoconf1({win32, _},[{cross,"no"}]) -> + ts_autoconf_win32:configure(); +autoconf1({unix, _},XCompFile) -> + unix_autoconf(XCompFile); +autoconf1(_,_) -> + io:format("cross compilation not supported for that this platform~n"), + throw(cross_installation_failed). + +autoconf2({ok, Bin}) -> + get_vars(ts_lib:b2s(Bin), name, [], []); +autoconf2(Error) -> + Error. + +get_vars([$:|Rest], name, Current, Result) -> + Name = list_to_atom(lists:reverse(Current)), + get_vars(Rest, value, [], [Name|Result]); +get_vars([$\r|Rest], value, Current, Result) -> + get_vars(Rest, value, Current, Result); +get_vars([$\n|Rest], value, Current, [Name|Result]) -> + Value = lists:reverse(Current), + get_vars(Rest, name, [], [{Name, Value}|Result]); +get_vars([C|Rest], State, Current, Result) -> + get_vars(Rest, State, [C|Current], Result); +get_vars([], name, [], Result) -> + {ok, Result}; +get_vars(_, _, _, _) -> + {error, fatal_bad_conf_vars}. + +config_flags() -> + case os:getenv("CONFIG_FLAGS") of + false -> []; + CF -> string:tokens(CF, " \t\n") + end. + +unix_autoconf(XConf) -> + Configure = filename:absname("configure"), + Flags = proplists:get_value(crossflags,XConf,[]), + Env = proplists:get_value(crossenv,XConf,[]), + Host = get_xcomp_flag("host", Flags), + Build = get_xcomp_flag("build", Flags), + Threads = [" --enable-shlib-thread-safety" || + erlang:system_info(threads) /= false], + Debug = [" --enable-debug-mode" || + string:str(erlang:system_info(system_version),"debug") > 0], + MXX_Build = [Y || Y <- config_flags(), + Y == "--enable-m64-build" + orelse Y == "--enable-m32-build"], + Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build, + case filelib:is_file(Configure) of + true -> + OSXEnv = macosx_cflags(), + UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)), + io:format("Running ~s~nEnv: ~p~n", + [lists:flatten(Configure ++ Args),UnQuotedEnv]), + Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])}, + [stream, eof, {env,UnQuotedEnv}]), + ts_lib:print_data(Port); + false -> + {error, no_configure_script} + end. + +unquote([{Var,Val}|T]) -> + [{Var,unquote(Val)}|unquote(T)]; +unquote([]) -> + []; +unquote("\""++Rest) -> + lists:reverse(tl(lists:reverse(Rest))); +unquote(String) -> + String. + +assign_vars([]) -> + []; +assign_vars([{VAR,FlagsStr} | VARs]) -> + [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)]; +assign_vars(FlagsStr) -> + Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])], + string:strip(lists:flatten(lists:map(fun(Flag) -> + Flag ++ " " + end, Flags)), right). + +assign_all_vars([$$ | Rest], FlagSoFar) -> + {VarName,Rest1} = get_var_name(Rest, []), + assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName)); +assign_all_vars([Char | Rest], FlagSoFar) -> + assign_all_vars(Rest, FlagSoFar ++ [Char]); +assign_all_vars([], Flag) -> + Flag. + +get_var_name([Ch | Rest] = Str, VarR) -> + case valid_char(Ch) of + true -> get_var_name(Rest, [Ch | VarR]); + false -> {lists:reverse(VarR),Str} + end; +get_var_name([], VarR) -> + {lists:reverse(VarR),[]}. + +assign_var(VarName) -> + case os:getenv(VarName) of + false -> ""; + Val -> Val + end. + +valid_char(Ch) when Ch >= $a, Ch =< $z -> true; +valid_char(Ch) when Ch >= $A, Ch =< $Z -> true; +valid_char(Ch) when Ch >= $0, Ch =< $9 -> true; +valid_char($_) -> true; +valid_char(_) -> false. + +get_xcomp_flag(Flag, Flags) -> + get_xcomp_flag(Flag, Flag, Flags). +get_xcomp_flag(Flag, Tag, Flags) -> + case proplists:get_value(Flag,Flags) of + undefined -> ""; + "guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")]; + HostVal -> [" --",Tag,"=",HostVal] + end. + + +macosx_cflags() -> + case os:type() of + {unix, darwin} -> + %% To ensure that the drivers we build can be loaded + %% by the emulator, add either -m32 or -m64 to CFLAGS. + WordSize = erlang:system_info(wordsize), + Mflag = "-m" ++ integer_to_list(8*WordSize), + [{"CFLAGS", Mflag},{"LDFLAGS", Mflag}]; + _ -> + [] + end. + +parse_xcomp_file(undefined) -> + [{cross,"no"}]; +parse_xcomp_file(Filepath) -> + {ok,Bin} = file:read_file(Filepath), + Lines = binary:split(Bin,<<"\n">>,[global,trim]), + {Envs,Flags} = parse_xcomp_file(Lines,[],[]), + [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")}, + {crossenv,Envs},{crossflags,Flags}]. + +parse_xcomp_file([<> = Line|R],Envs,Flags) + when $A =< A, A =< $Z -> + [Var,Value] = binary:split(Line,<<"=">>), + parse_xcomp_file(R,[{ts_lib:b2s(Var), + ts_lib:b2s(Value)}|Envs],Flags); +parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) -> + [Var,Value] = binary:split(Line,<<"=">>), + parse_xcomp_file(R,Envs,[{ts_lib:b2s(Var), + ts_lib:b2s(Value)}|Flags]); +parse_xcomp_file([_|R],Envs,Flags) -> + parse_xcomp_file(R,Envs,Flags); +parse_xcomp_file([],Envs,Flags) -> + {lists:reverse(Envs),lists:reverse(Flags)}. + +write_terms(Name, Terms) -> + case file:open(Name, [write]) of + {ok, Fd} -> + Result = write_terms1(Fd, remove_duplicates(Terms)), + file:close(Fd), + Result; + {error, Reason} -> + {error, Reason} + end. + +write_terms1(Fd, [Term|Rest]) -> + ok = io:format(Fd, "~p.\n", [Term]), + write_terms1(Fd, Rest); +write_terms1(_, []) -> + ok. + +remove_duplicates(List) -> + lists:reverse( + lists:foldl(fun({Key,Val},Acc) -> + R = make_ref(), + case proplists:get_value(Key,Acc,R) of + R -> [{Key,Val}|Acc]; + _Else -> + Acc + end + end,[],List)). + +add_vars(Vars0, Opts0) -> + {Opts,LongNames} = + case lists:keymember(longnames, 1, Opts0) of + true -> + {lists:keydelete(longnames, 1, Opts0),true}; + false -> + {Opts0,false} + end, + {PlatformId, PlatformLabel, PlatformFilename, Version} = + platform([{longnames, LongNames}|Vars0]), + NetDir = lists:concat(["/net", hostname()]), + Mounted = case file:read_file_info(NetDir) of + {ok, #file_info{type = directory}} -> NetDir; + _ -> "" + end, + {Opts, [{longnames, LongNames}, + {platform_id, PlatformId}, + {platform_filename, PlatformFilename}, + {rsh_name, get_rsh_name()}, + {platform_label, PlatformLabel}, + {ts_net_dir, Mounted}, + {erl_flags, []}, + {erl_release, Version}, + {ts_testcase_callback, get_testcase_callback()} | Vars0]}. + +get_testcase_callback() -> + case os:getenv("TS_TESTCASE_CALLBACK") of + ModFunc when is_list(ModFunc), ModFunc /= "" -> + case string:tokens(ModFunc, " ") of + [_Mod,_Func] -> ModFunc; + _ -> "" + end; + _ -> + case init:get_argument(ts_testcase_callback) of + {ok,[[Mod,Func]]} -> Mod ++ " " ++ Func; + _ -> "" + end + end. + +get_rsh_name() -> + case os:getenv("ERL_RSH") of + false -> "rsh"; + Str -> Str + end. + +platform_id(Vars) -> + {Id,_,_,_} = platform(Vars), + Id. + +platform(Vars) -> + Hostname = hostname(), + + {Type,Version} = ts_lib:erlang_type(), + Cpu = ts_lib:var('CPU', Vars), + Os = ts_lib:var(os, Vars), + + ErlType = to_upper(atom_to_list(Type)), + OsType = ts_lib:initial_capital(Os), + CpuType = ts_lib:initial_capital(Cpu), + LinuxDist = linux_dist(), + ExtraLabel = extra_platform_label(), + Schedulers = schedulers(), + BindType = bind_type(), + KP = kernel_poll(), + IOTHR = io_thread(), + LC = lock_checking(), + MT = modified_timing(), + AsyncThreads = async_threads(), + Debug = debug(), + CpuBits = word_size(), + Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist, + Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads, + Debug,ExtraLabel]), + PlatformId = lists:concat([ErlType, " ", Version, Common]), + PlatformLabel = ErlType ++ Common, + PlatformFilename = platform_as_filename(PlatformId), + {PlatformId, PlatformLabel, PlatformFilename, Version}. + +platform_as_filename(Label) -> + lists:map(fun($ ) -> $_; + ($/) -> $_; + (C) when $A =< C, C =< $Z -> C - $A + $a; + (C) -> C end, + Label). + +to_upper(String) -> + lists:map(fun(C) when $a =< C, C =< $z -> C - $a + $A; + (C) -> C end, + String). + +word_size() -> + case {erlang:system_info({wordsize,external}), + erlang:system_info({wordsize,internal})} of + {4,4} -> ""; + {8,8} -> "/64"; + {8,4} -> "/Halfword" + end. + +linux_dist() -> + case os:type() of + {unix,linux} -> + linux_dist_1([fun linux_dist_suse/0]); + _ -> "" + end. + +linux_dist_1([F|T]) -> + case F() of + "" -> linux_dist_1(T); + Str -> Str + end; +linux_dist_1([]) -> "". + +linux_dist_suse() -> + case filelib:is_file("/etc/SuSE-release") of + false -> ""; + true -> + Ver0 = os:cmd("awk '/^VERSION/ {print $3}' /etc/SuSE-release"), + [_|Ver1] = lists:reverse(Ver0), + Ver = lists:reverse(Ver1), + "/Suse" ++ Ver + end. + +hostname() -> + case catch inet:gethostname() of + {ok, Hostname} when is_list(Hostname) -> + "/" ++ lists:takewhile(fun (C) -> C /= $. end, Hostname); + _ -> + "/localhost" + end. + +async_threads() -> + case catch erlang:system_info(threads) of + true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size)); + _ -> "" + end. + +schedulers() -> + case catch erlang:system_info(smp_support) of + true -> + case {erlang:system_info(schedulers), + erlang:system_info(schedulers_online)} of + {S,S} -> + "/S"++integer_to_list(S); + {S,O} -> + "/S"++integer_to_list(S) ++ ":" ++ + integer_to_list(O) + end; + _ -> "" + end. + +bind_type() -> + case catch erlang:system_info(scheduler_bind_type) of + thread_no_node_processor_spread -> "/sbttnnps"; + no_node_processor_spread -> "/sbtnnps"; + no_node_thread_spread -> "/sbtnnts"; + processor_spread -> "/sbtps"; + thread_spread -> "/sbtts"; + no_spread -> "/sbtns"; + _ -> "" + end. + + +debug() -> + case string:str(erlang:system_info(system_version), "debug") of + 0 -> ""; + _ -> "/Debug" + end. + +lock_checking() -> + case catch erlang:system_info(lock_checking) of + true -> "/LC"; + _ -> "" + end. + +modified_timing() -> + case catch erlang:system_info(modified_timing_level) of + N when is_integer(N) -> + "/T" ++ integer_to_list(N); + _ -> "" + end. + +kernel_poll() -> + case catch erlang:system_info(kernel_poll) of + true -> "/KP"; + _ -> "" + end. + +io_thread() -> + case catch erlang:system_info(io_thread) of + true -> "/IOTHR"; + _ -> "" + end. + +extra_platform_label() -> + case os:getenv("TS_EXTRA_PLATFORM_LABEL") of + [] -> ""; + [_|_]=Label -> "/" ++ Label; + false -> "" + end. diff --git a/lib/common_test/test_server/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl new file mode 100644 index 0000000000..ec0d54ccde --- /dev/null +++ b/lib/common_test/test_server/ts_install_cth.erl @@ -0,0 +1,253 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% @doc TS Installed SCB +%%% +%%% This module does what the make parts of the ts:run/x command did, +%%% but not the Makefile.first parts! So they have to be done by ts or +%%% manually!! + +-module(ts_install_cth). + +%% Suite Callbacks +-export([id/1]). +-export([init/2]). + +-export([pre_init_per_suite/3]). +-export([post_init_per_suite/4]). +-export([pre_end_per_suite/3]). +-export([post_end_per_suite/4]). + +-export([pre_init_per_group/3]). +-export([post_init_per_group/4]). +-export([pre_end_per_group/3]). +-export([post_end_per_group/4]). + +-export([pre_init_per_testcase/3]). +-export([post_end_per_testcase/4]). + +-export([on_tc_fail/3]). +-export([on_tc_skip/3]). + +-export([terminate/1]). + +-include_lib("kernel/include/file.hrl"). + +-type config() :: proplists:proplist(). +-type reason() :: term(). +-type skip_or_fail() :: {skip, reason()} | + {auto_skip, reason()} | + {fail, reason()}. + +-record(state, { ts_conf_dir, target_system, install_opts, nodenames, nodes }). + +%% @doc The id of this SCB +-spec id(Opts :: term()) -> + Id :: term(). +id(_Opts) -> + ?MODULE. + +%% @doc Always called before any other callback function. +-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, State :: #state{}}. +init(_Id, Opts) -> + Nodenames = proplists:get_value(nodenames, Opts, 0), + Nodes = proplists:get_value(nodes, Opts, 0), + TSConfDir = proplists:get_value(ts_conf_dir, Opts), + TargetSystem = proplists:get_value(target_system, Opts, install_local), + InstallOpts = proplists:get_value(install_opts, Opts, []), + {ok, #state{ nodenames = Nodenames, + nodes = Nodes, + ts_conf_dir = TSConfDir, + target_system = TargetSystem, + install_opts = InstallOpts } }. + +%% @doc Called before init_per_suite is called. +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) -> + DataDir = proplists:get_value(data_dir, Config), + ParentDir = filename:join( + lists:reverse( + tl(lists:reverse(filename:split(DataDir))))), + TSConfDir = filename:join([ParentDir, "..","test_server"]), + pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir }); +pre_init_per_suite(_Suite,Config,State) -> + DataDir = proplists:get_value(data_dir, Config), + try + {ok,Variables} = + file:consult(filename:join(State#state.ts_conf_dir,"variables")), + case proplists:get_value(cross,Variables) of + "yes" -> + ct:log("Not making data dir as tests have been cross compiled"); + _ -> + ts_lib:make_non_erlang(DataDir, Variables) + end, + + {add_node_name(Config, State), State} + catch error:{badmatch,{error,enoent}} -> + {add_node_name(Config, State), State}; + Error:Reason -> + Stack = erlang:get_stacktrace(), + ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), + {{fail,{?MODULE,{Error,Reason, Stack}}},State} + end. + +%% @doc Called after init_per_suite. +-spec post_init_per_suite(Suite :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_suite(_Suite,_Config,Return,State) -> + test_server_ctrl:kill_slavenodes(), + {Return, State}. + +%% @doc Called before end_per_suite. +-spec pre_end_per_suite(Suite :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_suite(_Suite,Config,State) -> + {Config, State}. + +%% @doc Called after end_per_suite. +-spec post_end_per_suite(Suite :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_suite(_Suite,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each init_per_group. +-spec pre_init_per_group(Group :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_group(_Group,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each init_per_group. +-spec post_init_per_group(Group :: atom(), + Config :: config(), + Return :: config() | skip_or_fail(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +post_init_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after each end_per_group. +-spec pre_end_per_group(Group :: atom(), + Config :: config() | skip_or_fail(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +pre_end_per_group(_Group,Config,State) -> + {Config, State}. + +%% @doc Called after each end_per_group. +-spec post_end_per_group(Group :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_group(_Group,_Config,Return,State) -> + {Return, State}. + +%% @doc Called before each test case. +-spec pre_init_per_testcase(TC :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | skip_or_fail(), NewState :: #state{}}. +pre_init_per_testcase(_TC,Config,State) -> + {add_node_name(Config, State), State}. + +%% @doc Called after each test case. +-spec post_end_per_testcase(TC :: atom(), + Config :: config(), + Return :: term(), + State :: #state{}) -> + {ok | skip_or_fail(), NewState :: #state{}}. +post_end_per_testcase(_TC,_Config,Return,State) -> + {Return, State}. + +%% @doc Called after a test case failed. +-spec on_tc_fail(TC :: init_per_suite | end_per_suite | + init_per_group | end_per_group | atom(), + Reason :: term(), State :: #state{}) -> + NewState :: #state{}. +on_tc_fail(_TC, _Reason, State) -> + State. + +%% @doc Called when a test case is skipped. +-spec on_tc_skip(TC :: end_per_suite | init_per_group | end_per_group | atom(), + {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), + Reason :: term()}}} | + {tc_user_skip, {skipped, Reason :: term()}}, + State :: #state{}) -> + NewState :: #state{}. +on_tc_skip(_TC, _Reason, State) -> + State. + +%% @doc Called when the scope of the SCB is done. +-spec terminate(State :: #state{}) -> + term(). +terminate(_State) -> + ok. + +%%% ============================================================================ +%%% Local functions +%%% ============================================================================ + +%% Add a nodename to config if it does not exist +add_node_name(Config, State) -> + case proplists:get_value(nodenames, Config) of + undefined -> + lists:keystore( + nodenames, 1, Config, + {nodenames,generate_nodenames(State#state.nodenames)}); + _Else -> + Config + end. + + +%% Copied from test_server_ctrl.erl +generate_nodenames(Num) -> + {ok,Name} = inet:gethostname(), + generate_nodenames2(Num, [Name], []). + +generate_nodenames2(0, _Hosts, Acc) -> + Acc; +generate_nodenames2(N, Hosts, Acc) -> + Host=lists:nth((N rem (length(Hosts)))+1, Hosts), + Name=list_to_atom(temp_nodename("nod",N) ++ "@" ++ Host), + generate_nodenames2(N-1, Hosts, [Name|Acc]). + +%% We cannot use erlang:unique_integer([positive]) +%% here since this code in run on older test releases as well. +temp_nodename(Base,I) -> + {A,B,C} = os:timestamp(), + Nstr = integer_to_list(I), + Astr = integer_to_list(A), + Bstr = integer_to_list(B), + Cstr = integer_to_list(C), + Base++Nstr++Astr++Bstr++Cstr. diff --git a/lib/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl new file mode 100644 index 0000000000..7c3f450194 --- /dev/null +++ b/lib/common_test/test_server/ts_lib.erl @@ -0,0 +1,372 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ts_lib). + +-include_lib("kernel/include/file.hrl"). +-include("ts.hrl"). + +%% Avoid warning for local function error/1 clashing with autoimported BIF. +-compile({no_auto_import,[error/1]}). +-export([error/1, var/2, erlang_type/0, + erlang_type/1, + initial_capital/1, + specs/1, suites/2, + test_categories/2, specialized_specs/2, + subst_file/3, subst/2, print_data/1, + make_non_erlang/2, + maybe_atom_to_list/1, progress/4, + b2s/1 + ]). + +error(Reason) -> + throw({error, Reason}). + +%% Returns the value for a variable + +var(Name, Vars) -> + case lists:keysearch(Name, 1, Vars) of + {value, {Name, Value}} -> + Value; + false -> + error({bad_installation, {undefined_var, Name, Vars}}) + end. + +%% Returns the level of verbosity (0-X) +verbosity(Vars) -> + % Check for a single verbose option. + case lists:member(verbose, Vars) of + true -> + 1; + false -> + case lists:keysearch(verbose, 1, Vars) of + {value, {verbose, Level}} -> + Level; + _ -> + 0 + end + end. + +% Displays output to the console if verbosity is equal or more +% than Level. +progress(Vars, Level, Format, Args) -> + V=verbosity(Vars), + if + V>=Level -> + io:format(Format, Args); + true -> + ok + end. + +%% Returns: {Type, Version} where Type is otp|src + +erlang_type() -> + erlang_type(code:root_dir()). +erlang_type(RootDir) -> + {_, Version} = init:script_id(), + RelDir = filename:join(RootDir, "releases"), % Only in installed + case filelib:is_file(RelDir) of + true -> {otp,Version}; % installed OTP + false -> {srctree,Version} % source code tree + end. + +%% Upcases the first letter in a string. + +initial_capital([C|Rest]) when $a =< C, C =< $z -> + [C-$a+$A|Rest]; +initial_capital(String) -> + String. + +specialized_specs(Dir,PostFix) -> + Specs = filelib:wildcard(filename:join([filename:dirname(Dir), + "*_test", "*_"++PostFix++".spec"])), + sort_tests([begin + DirPart = filename:dirname(Name), + AppTest = hd(lists:reverse(filename:split(DirPart))), + list_to_atom(string:substr(AppTest, 1, length(AppTest)-5)) + end || Name <- Specs]). + +specs(Dir) -> + Specs = filelib:wildcard(filename:join([filename:dirname(Dir), + "*_test", "*.{dyn,}spec"])), + %% Make sure only to include the main spec for each application + MainSpecs = + lists:flatmap(fun(FullName) -> + [Spec,TestDir|_] = + lists:reverse(filename:split(FullName)), + [_TestSuffix|TDParts] = + lists:reverse(string:tokens(TestDir,[$_,$.])), + [_SpecSuffix|SParts] = + lists:reverse(string:tokens(Spec,[$_,$.])), + if TDParts == SParts -> + [filename_to_atom(FullName)]; + true -> + [] + end + end, Specs), + sort_tests(MainSpecs). + +test_categories(Dir, App) -> + Specs = filelib:wildcard(filename:join([filename:dirname(Dir), + App++"_test", "*.spec"])), + lists:flatmap(fun(FullName) -> + [Spec,_TestDir|_] = + lists:reverse(filename:split(FullName)), + case filename:rootname(Spec -- App) of + "" -> + []; + [_Sep | Cat] -> + [list_to_atom(Cat)] + end + end, Specs). + +suites(Dir, App) -> + Glob=filename:join([filename:dirname(Dir), App++"_test", + "*_SUITE.erl"]), + Suites=filelib:wildcard(Glob), + [filename_to_atom(Name) || Name <- Suites]. + +filename_to_atom(Name) -> + list_to_atom(filename:rootname(filename:basename(Name))). + +%% Sorts a list of either log files directories or spec files. + +sort_tests(Tests) -> + Sorted = lists:usort([{suite_order(filename_to_atom(X)), X} || + X <- Tests]), + [X || {_, X} <- Sorted]. + +%% This defines the order in which tests should be run and be presented +%% in index files. + +suite_order(emulator) -> 0; +suite_order(test_server) -> 1; +suite_order(kernel) -> 4; +suite_order(stdlib) -> 6; +suite_order(compiler) -> 8; +suite_order(hipe) -> 9; +suite_order(erl_interface) -> 12; +suite_order(jinterface) -> 14; +suite_order(sasl) -> 16; +suite_order(tools) -> 18; +suite_order(runtime_tools) -> 19; +suite_order(parsetools) -> 20; +suite_order(debugger) -> 22; +suite_order(ic) -> 24; +suite_order(orber) -> 26; +suite_order(inets) -> 28; +suite_order(asn1) -> 30; +suite_order(os_mon) -> 32; +suite_order(snmp) -> 38; +suite_order(mnesia) -> 44; +suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last! +suite_order(_) -> 200. + +%% Substitute all occurrences of @var@ in the In file, using +%% the list of variables in Vars, producing the output file Out. +%% Returns: ok | {error, Reason} + +subst_file(In, Out, Vars) -> + case file:read_file(In) of + {ok, Bin} -> + Subst = subst(b2s(Bin), Vars, []), + case file:write_file(Out, unicode:characters_to_binary(Subst)) of + ok -> + ok; + {error, Reason} -> + {error, {file_write, Reason}} + end; + Error -> + Error + end. + +subst(String, Vars) -> + subst(String, Vars, []). + +subst([$@, $_|Rest], Vars, Result) -> + subst_var([$_|Rest], Vars, Result, []); +subst([$@, C|Rest], Vars, Result) when $A =< C, C =< $Z -> + subst_var([C|Rest], Vars, Result, []); +subst([$@, C|Rest], Vars, Result) when $a =< C, C =< $z -> + subst_var([C|Rest], Vars, Result, []); +subst([C|Rest], Vars, Result) -> + subst(Rest, Vars, [C|Result]); +subst([], _Vars, Result) -> + lists:reverse(Result). + +subst_var([$@|Rest], Vars, Result, VarAcc) -> + Key = list_to_atom(lists:reverse(VarAcc)), + {Result1,Rest1} = do_subst_var(Key, Rest, Vars, Result, VarAcc), + subst(Rest1, Vars, Result1); + +subst_var([C|Rest], Vars, Result, VarAcc) -> + subst_var(Rest, Vars, Result, [C|VarAcc]); +subst_var([], Vars, Result, VarAcc) -> + subst([], Vars, [VarAcc++[$@|Result]]). + +%% handle conditional +do_subst_var(Cond, Rest, Vars, Result, _VarAcc) when Cond == 'IFEQ' ; + Cond == 'IFNEQ' -> + {Bool,Comment,Rest1} = do_test(Rest, Vars, Cond), + Rest2 = extract_clause(Bool, Rest1), + {lists:reverse(Comment, Result),Rest2}; +%% variable substitution +do_subst_var(Key, Rest, Vars, Result, VarAcc) -> + case lists:keysearch(Key, 1, Vars) of + {value, {Key, Value}} -> + {lists:reverse(Value, Result),Rest}; + false -> + {[$@|VarAcc++[$@|Result]],Rest} + end. + +%% check arguments in "@IF[N]EQ@ (Arg1, Arg2)" for equality +do_test(Rest, Vars, Test) -> + {Arg1,Rest1} = get_arg(Rest, Vars, $,, []), + {Arg2,Rest2} = get_arg(Rest1, Vars, 41, []), % $) + Result = case Arg1 of + Arg2 when Test == 'IFEQ' -> true; + Arg2 when Test == 'IFNEQ' -> false; + _ when Test == 'IFNEQ' -> true; + _ -> false + end, + Comment = io_lib:format("# Result of test: ~s (~s, ~s) -> ~w", + [atom_to_list(Test),Arg1,Arg2,Result]), + {Result,Comment,Rest2}. + +%% extract an argument +get_arg([$(|Rest], Vars, Stop, _) -> + get_arg(Rest, Vars, Stop, []); +get_arg([Stop|Rest], Vars, Stop, Acc) -> + Arg = string:strip(lists:reverse(Acc)), + Subst = subst(Arg, Vars), + {Subst,Rest}; +get_arg([C|Rest], Vars, Stop, Acc) -> + get_arg(Rest, Vars, Stop, [C|Acc]). + +%% keep only the true or false conditional clause +extract_clause(true, Rest) -> + extract_clause(true, Rest, []); +extract_clause(false, Rest) -> + Rest1 = discard_clause(Rest), % discard true clause + extract_clause(false, Rest1, []). + +%% true clause buffered, done +extract_clause(true, [$@,$E,$L,$S,$E,$@|Rest], Acc) -> + Rest1 = discard_clause(Rest), % discard false clause + lists:reverse(Acc, Rest1); +%% buffering of false clause starts now +extract_clause(false, [$@,$E,$L,$S,$E,$@|Rest], _Acc) -> + extract_clause(false, Rest, []); +%% true clause buffered, done +extract_clause(true, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) -> + lists:reverse(Acc, Rest); +%% false clause buffered, done +extract_clause(false, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) -> + lists:reverse(Acc, Rest); +%% keep buffering +extract_clause(Bool, [C|Rest], Acc) -> + extract_clause(Bool, Rest, [C|Acc]); +%% parse error +extract_clause(_, [], Acc) -> + lists:reverse(Acc). + +discard_clause([$@,$E,$L,$S,$E,$@|Rest]) -> + Rest; +discard_clause([$@,$E,$N,$D,$I,$F,$@|Rest]) -> + Rest; +discard_clause([_C|Rest]) -> + discard_clause(Rest); +discard_clause([]) -> % parse error + []. + + +print_data(Port) -> + receive + {Port, {data, Bytes}} -> + io:put_chars(Bytes), + print_data(Port); + {Port, eof} -> + Port ! {self(), close}, + receive + {Port, closed} -> + true + end, + receive + {'EXIT', Port, _} -> + ok + after 1 -> % force context switch + ok + end + end. + +maybe_atom_to_list(To_list) when is_list(To_list) -> + To_list; +maybe_atom_to_list(To_list) when is_atom(To_list)-> + atom_to_list(To_list). + + +%% Configure and run all the Makefiles in the data dir of the suite +%% in question +make_non_erlang(DataDir, Variables) -> + %% Make the stuff in all_SUITE_data if it exists + AllDir = filename:join(DataDir,"../all_SUITE_data"), + case filelib:is_dir(AllDir) of + true -> + make_non_erlang_do(AllDir,Variables); + false -> + ok + end, + make_non_erlang_do(DataDir, Variables). + +make_non_erlang_do(DataDir, Variables) -> + try + MakeCommand = proplists:get_value(make_command,Variables), + + FirstMakefile = filename:join(DataDir,"Makefile.first"), + case filelib:is_regular(FirstMakefile) of + true -> + io:format("Making ~p",[FirstMakefile]), + ok = ts_make:make( + MakeCommand, DataDir, filename:basename(FirstMakefile)); + false -> + ok + end, + + MakefileSrc = filename:join(DataDir,"Makefile.src"), + MakefileDest = filename:join(DataDir,"Makefile"), + case filelib:is_regular(MakefileSrc) of + true -> + ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), + io:format("Making ~p",[MakefileDest]), + ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} + | Variables]); + false -> + ok + end + after + timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore + end. + +b2s(Bin) -> + unicode:characters_to_list(Bin,default_encoding()). + +default_encoding() -> + try epp:default_encoding() + catch error:undef -> latin1 + end. diff --git a/lib/common_test/test_server/ts_make.erl b/lib/common_test/test_server/ts_make.erl new file mode 100644 index 0000000000..921edb264a --- /dev/null +++ b/lib/common_test/test_server/ts_make.erl @@ -0,0 +1,114 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ts_make). + +-export([make/1,make/3,unmake/1]). + +-include_lib("common_test/include/ct.hrl"). + +%% Functions to be called from make test cases. + +make(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + Makefile = proplists:get_value(makefile, Config), + Make = proplists:get_value(make_command, Config), + case make(Make, DataDir, Makefile) of + ok -> ok; + {error,Reason} -> exit({make_failed,Reason}) + end. + +unmake(Config) when is_list(Config) -> + ok. + +%% Runs `make' in the given directory. +%% Result: ok | {error, Reason} + +make(Make, Dir, Makefile) -> + {RunFile, RunCmd, Script} = run_make_script(os:type(), Make, Dir, Makefile), + case file:write_file(RunFile, Script) of + ok -> + Log = filename:join(Dir, "make.log"), + file:delete(Log), + Port = open_port({spawn, RunCmd}, [eof,stream,in,stderr_to_stdout]), + case get_port_data(Port, [], false) of + "*ok*" ++ _ -> ok; + "*error*" ++ _ -> {error, make}; + Other ->{error,{make,Other}} + end; + Error -> Error + end. + +get_port_data(Port, Last0, Complete0) -> + receive + {Port,{data,Bytes}} -> + {Last, Complete} = update_last(Bytes, Last0, Complete0), + get_port_data(Port, Last, Complete); + {Port, eof} -> + Result = update_last(eof, Last0, Complete0), + unlink(Port), + exit(Port, die), + Result + end. + +update_last([C|Rest], Line, true) -> + try + %% Utf-8 list to utf-8 binary + %% (e.g. we assume utf-8 bytes from port) + io:put_chars(list_to_binary(Line)) + catch + error:badarg -> + %% io:put_chars/1 badarged + %% this likely means we had unicode code points + %% in our bytes buffer (e.g warning from gcc with åäö) + io:put_chars(unicode:characters_to_binary(Line)) + end, + io:nl(), + update_last([C|Rest], [], false); +update_last([$\r|Rest], Result, Complete) -> + update_last(Rest, Result, Complete); +update_last([$\n|Rest], Result, _Complete) -> + update_last(Rest, lists:reverse(Result), true); +update_last([C|Rest], Result, Complete) -> + update_last(Rest, [C|Result], Complete); +update_last([], Result, Complete) -> + {Result, Complete}; +update_last(eof, Result, _) -> + unicode:characters_to_list(list_to_binary(Result)). + +run_make_script({win32, _}, Make, Dir, Makefile) -> + {"run_make.bat", + ".\\run_make", + ["@echo off\r\n", + "cd \"", filename:nativename(Dir), "\"\r\n", + Make, " -f ", Makefile, " \r\n", + "if errorlevel 1 echo *error*\r\n", + "if not errorlevel 1 echo *ok*\r\n"]}; +run_make_script({unix, _}, Make, Dir, Makefile) -> + {"run_make", + "/bin/sh ./run_make", + ["#!/bin/sh\n", + "cd \"", Dir, "\"\n", + Make, " -f ", Makefile, " 2>&1\n", + "case $? in\n", + " 0) echo '*ok*';;\n", + " *) echo '*error*';;\n", + "esac\n"]}; +run_make_script(_Other, _Make, _Dir, _Makefile) -> + exit(dont_know_how_to_make_script_on_this_platform). diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl new file mode 100644 index 0000000000..188094921d --- /dev/null +++ b/lib/common_test/test_server/ts_run.erl @@ -0,0 +1,455 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% Purpose : Supervises running of test cases. + +-module(ts_run). + +-export([run/4,ct_run_test/2]). + +-define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60). +-define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15). + +-include("ts.hrl"). + +-import(lists, [member/2,filter/2]). + +-record(state, + {file, % File given. + mod, % Module to run. + test_server_args, % Arguments to test server. + command, % Command to run. + test_dir, % Directory for test suite. + makefiles, % List of all makefiles. + makefile, % Current makefile. + batch, % Are we running in batch mode? + data_wc, % Wildcard for data dirs. + topcase, % Top case specification. + all % Set if we have all_SUITE_data + }). + +-define(tracefile,"traceinfo"). + +%% Options is a slightly modified version of the options given to +%% ts:run. Vars0 are from the variables file. +run(File, Args0, Options, Vars0) -> + Vars= + case lists:keysearch(vars, 1, Options) of + {value, {vars, Vars1}} -> + Vars1++Vars0; + _ -> + Vars0 + end, + {Batch,Runner} = + case {member(interactive, Options), member(batch, Options)} of + {false, true} -> + {true, fun run_batch/3}; + _ -> + {false, fun run_interactive/3} + end, + Hooks = [fun init_state/3, + fun run_preinits/3, + fun make_command/3, + Runner], + Args = make_common_test_args(Args0,Options,Vars), + St = #state{file=File,test_server_args=Args,batch=Batch}, + R = execute(Hooks, Vars, [], St), + case R of + {ok,_,_,_} -> ok; + Error -> Error + end. + +execute([Hook|Rest], Vars0, Spec0, St0) -> + case Hook(Vars0, Spec0, St0) of + ok -> + execute(Rest, Vars0, Spec0, St0); + {ok, Vars, Spec, St} -> + execute(Rest, Vars, Spec, St); + Error -> + Error + end; +execute([], Vars, Spec, St) -> + {ok, Vars, Spec, St}. + +%% Wrapper to run tests using ct:run_test/1 and handle any errors. + +ct_run_test(Dir, CommonTestArgs) -> + try + ok = file:set_cwd(Dir), + case ct:run_test(CommonTestArgs) of + {_,_,_} -> + ok; + {error,Error} -> + io:format("ERROR: ~P\n", [Error,20]); + Other -> + io:format("~P\n", [Other,20]) + end + catch + _:Crash -> + io:format("CRASH: ~P\n", [Crash,20]) + end. + +%% +%% Deletes File from Files when File is on the form .../_data/ +%% when all of has been skipped in Spec, i.e. there +%% exists a {skip, {, _}} tuple in Spec. +%% +del_skipped_suite_data_dir(Files, Spec) -> + SkipDirNames = lists:foldl(fun ({skip, {SS, _C}}, SSs) -> + [atom_to_list(SS) ++ "_data" | SSs]; + (_, SSs) -> + SSs + end, + [], + Spec), + filter(fun (File) -> + not member(filename:basename(filename:dirname(File)), + SkipDirNames) + end, + Files). + +%% Initialize our internal state. + +init_state(Vars, [], St0) -> + {FileBase,Wc0,Mod} = + case St0#state.file of + {Fil,Mod0} -> {Fil, atom_to_list(Mod0) ++ "*_data",Mod0}; + Fil -> {Fil,"*_SUITE_data",[]} + end, + {ok,Cwd} = file:get_cwd(), + TestDir = filename:join(filename:dirname(Cwd), FileBase++"_test"), + case filelib:is_dir(TestDir) of + true -> + Wc = filename:join(TestDir, Wc0), + {ok,Vars,[],St0#state{file=FileBase,mod=Mod, + test_dir=TestDir,data_wc=Wc}}; + false -> + {error,{no_test_directory,TestDir}} + end. + +%% Run any "Makefile.first" files first. +%% XXX We should fake a failing test case if the make fails. + +run_preinits(Vars, Spec, St) -> + Wc = filename:join(St#state.data_wc, "Makefile.first"), + run_pre_makefiles(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec), + Vars, Spec, St), + {ok,Vars,Spec,St}. + +run_pre_makefiles([Makefile|Ms], Vars0, Spec0, St0) -> + Hooks = [fun run_pre_makefile/3], + case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of + {error,_Reason}=Error -> Error; + {ok,Vars,Spec,St} -> run_pre_makefiles(Ms, Vars, Spec, St) + end; +run_pre_makefiles([], Vars, Spec, St) -> {ok,Vars,Spec,St}. + +run_pre_makefile(Vars, Spec, St) -> + Makefile = St#state.makefile, + Shortname = filename:basename(Makefile), + DataDir = filename:dirname(Makefile), + Make = ts_lib:var(make_command, Vars), + case ts_make:make(Make,DataDir, Shortname) of + ok -> {ok,Vars,Spec,St}; + {error,_Reason}=Error -> Error + end. + +get_config_files() -> + TSConfig = "ts.config", + [TSConfig | case os:type() of + {unix,_} -> ["ts.unix.config"]; + {win32,_} -> ["ts.win32.config"]; + _ -> [] + end]. + +%% Makes the command to start up the Erlang node to run the tests. + +backslashify([$\\, $" | T]) -> + [$\\, $" | backslashify(T)]; +backslashify([$" | T]) -> + [$\\, $" | backslashify(T)]; +backslashify([H | T]) -> + [H | backslashify(T)]; +backslashify([]) -> + []. + +make_command(Vars, Spec, State) -> + {ok,Cwd} = file:get_cwd(), + TestDir = State#state.test_dir, + TestPath = filename:nativename(TestDir), + Erl = case os:getenv("TS_RUN_VALGRIND") of + false -> + atom_to_list(lib:progname()); + _ -> + case State#state.file of + Dir when is_list(Dir) -> + os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-"); + _ -> + ok + end, + "cerl -valgrind" ++ + case erlang:system_info(smp_support) of + true -> " -smp"; + false -> "" + end + end, + Naming = + case ts_lib:var(longnames, Vars) of + true -> + " -name "; + false -> + " -sname " + end, + ExtraArgs = + case lists:keysearch(erl_start_args,1,Vars) of + {value,{erl_start_args,Args}} -> Args; + false -> "" + end, + CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"), + case filelib:is_file(CrashFile) of + true -> + io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]), + file:delete(CrashFile); + false -> + ok + end, + + %% If Common Test specific variables are needed, add them here + %% on form: "{key1,value1}" "{key2,value2}" ... + NetDir = ts_lib:var(ts_net_dir, Vars), + TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ], + + %% NOTE: Do not use ' in these commands as it wont work on windows + Cmd = [Erl, Naming, "test_server" + " -rsh ", ts_lib:var(rsh_name, Vars), + " -env PATH \"", + backslashify(lists:flatten([TestPath, path_separator(), + remove_path_spaces()])), + "\"", + " -env ERL_CRASH_DUMP ", CrashFile, + %% uncomment the line below to disable exception formatting + %% " -test_server_format_exception false", + " -boot start_sasl -sasl errlog_type error", + " -pz \"",Cwd,"\"", + " -ct_test_vars ",TestVars, + " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ", + backslashify(lists:flatten(State#state.test_server_args)),")\"" + " ", + ExtraArgs], + {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}. + + +run_batch(Vars, _Spec, State) -> + process_flag(trap_exit, true), + Command = State#state.command ++ " -noinput -s erlang halt", + ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]), + io:format(user, "Command: ~ts~n",[Command]), + Port = open_port({spawn, Command}, [stream, in, eof]), + Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of + false -> 1; + _ -> 100 + end, + tricky_print_data(Port, Timeout). + +tricky_print_data(Port, Timeout) -> + receive + {Port, {data, Bytes}} -> + io:put_chars(Bytes), + tricky_print_data(Port, Timeout); + {Port, eof} -> + Port ! {self(), close}, + receive + {Port, closed} -> + true + end, + receive + {'EXIT', Port, _} -> + ok + after 1 -> % force context switch + ok + end + after Timeout -> + case erl_epmd:names() of + {ok,Names} -> + case is_testnode_dead(Names) of + true -> + io:put_chars("WARNING: No EOF, but " + "test_server node is down!\n"); + false -> + tricky_print_data(Port, Timeout) + end; + _ -> + tricky_print_data(Port, Timeout) + end + end. + +is_testnode_dead([]) -> true; +is_testnode_dead([{"test_server",_}|_]) -> false; +is_testnode_dead([_|T]) -> is_testnode_dead(T). + +run_interactive(Vars, _Spec, State) -> + Command = State#state.command, + ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), + case ts_lib:var(os, Vars) of + "Windows 95" -> + %% Windows 95 strikes again! We must redirect standard + %% input and output for the `start' command, to force + %% standard input and output to the Erlang shell to be + %% connected to the newly started console. + %% Without these redirections, the Erlang shell would be + %% connected to the pipes provided by the port program + %% and there would be an inactive console window. + os:cmd("start < nul > nul w" ++ Command), + ok; + "Windows 98" -> + os:cmd("start < nul > nul w" ++ Command), + ok; + "Windows"++_ -> + os:cmd("start w" ++ Command), + ok; + _Other -> + %% Assuming ts and controller always run on solaris + start_xterm(Command) + end. + +start_xterm(Command) -> + case os:find_executable("xterm") of + false -> + io:format("The `xterm' program was not found.\n"), + {error, no_xterm}; + _Xterm -> + case os:getenv("DISPLAY") of + false -> + io:format("DISPLAY is not set.\n"), + {error, display_not_set}; + Display -> + io:format("Starting xterm (DISPLAY=~s)...\n", + [Display]), + os:cmd("xterm -sl 10000 -e " ++ Command ++ "&"), + ok + end + end. + +path_separator() -> + case os:type() of + {win32, _} -> ";"; + {unix, _} -> ":" + end. + + +make_common_test_args(Args0, Options0, _Vars) -> + Trace = + case lists:keysearch(trace,1,Options0) of + {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> + ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), + [{ct_trace,?tracefile}]; + {value,{trace,TIFile}} when is_atom(TIFile) -> + [{ct_trace,atom_to_list(TIFile)}]; + {value,{trace,TIFile}} -> + [{ct_trace,TIFile}]; + false -> + [] + end, + Cover = + case lists:keysearch(cover,1,Options0) of + {value,{cover, App, none, _Analyse}} -> + io:format("No cover file found for ~p~n",[App]), + []; + {value,{cover,_App,File,_Analyse}} -> + [{cover,to_list(File)},{cover_stop,false}]; + false -> + [] + end, + + Logdir = case lists:keysearch(logdir, 1, Options0) of + {value,{logdir, _}} -> + []; + false -> + [{logdir,"../test_server"}] + end, + + TimeTrap = [{scale_timetraps, true}], + + {ConfigPath, + Options} = case {os:getenv("TEST_CONFIG_PATH"), + lists:keysearch(config, 1, Options0)} of + {_,{value, {config, Path}}} -> + {Path,lists:keydelete(config, 1, Options0)}; + {false,false} -> + {"../test_server",Options0}; + {Path,_} -> + {Path,Options0} + end, + ConfigFiles = [{config,[filename:join(ConfigPath,File) + || File <- get_config_files()]}], + 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); +to_list(X) when is_list(X) -> + X. + +%% +%% Paths and spaces handling for w2k and XP +%% +remove_path_spaces() -> + Path = os:getenv("PATH"), + case os:type() of + {win32,nt} -> + remove_path_spaces(Path); + _ -> + Path + end. + +remove_path_spaces(Path) -> + SPath = split_path(Path), + [NSHead|NSTail] = lists:map(fun(X) -> filename:nativename( + filename:join( + translate_path(split_one(X)))) + end, + SPath), + NSHead ++ lists:flatten([[$;|X] || X <- NSTail]). + +translate_path(PList) -> + %io:format("translate_path([~p|~p]~n",[Base,PList]), + translate_path(PList,[]). + + +translate_path([],_) -> + []; +translate_path([PC | T],BaseList) -> + FullPath = filename:nativename(filename:join(BaseList ++ [PC])), + NewPC = case catch file:altname(FullPath) of + {ok,X} -> + X; + _ -> + PC + end, + %io:format("NewPC:~s, DirList:~p~n",[NewPC,DirList]), + NewBase = BaseList ++ [NewPC], + [NewPC | translate_path(T,NewBase)]. + +split_one(Path) -> + filename:split(Path). + +split_path(Path) -> + string:tokens(Path,";"). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 23acd7b4d9..cf8863fcd0 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -681,13 +681,9 @@ add_del_path(Config) when is_list(Config) -> clash(Config) when is_list(Config) -> DDir = ?config(data_dir,Config)++"clash/", P = code:get_path(), - [TestServerPath|_] = [Path || Path <- code:get_path(), - re:run(Path,"test_server/?$",[unicode]) /= nomatch], %% test non-clashing entries - %% remove TestServerPath to prevent clash with test-server path - true = code:del_path(TestServerPath), true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"zork-0.8/ebin"), test_server:capture_start(), @@ -699,8 +695,6 @@ clash(Config) when is_list(Config) -> %% test clashing entries - %% remove TestServerPath to prevent clash with test-server path - true = code:del_path(TestServerPath), true = code:add_path(DDir++"foobar-0.1/ebin"), true = code:add_path(DDir++"foobar-0.1.ez/foobar-0.1/ebin"), test_server:capture_start(), @@ -713,9 +707,7 @@ clash(Config) when is_list(Config) -> %% test "Bad path can't read" - %% remove TestServerPath to prevent clash with test-server path Priv = ?config(priv_dir, Config), - true = code:del_path(TestServerPath), TmpEzFile = Priv++"foobar-0.tmp.ez", {ok, _} = file:copy(DDir++"foobar-0.1.ez", TmpEzFile), true = code:add_path(TmpEzFile++"/foobar-0.1/ebin"), diff --git a/lib/test_server/AUTHORS b/lib/test_server/AUTHORS deleted file mode 100644 index 3212999174..0000000000 --- a/lib/test_server/AUTHORS +++ /dev/null @@ -1,12 +0,0 @@ -Original Authors and Contributors: - -Mattias Nilsson -Bjrn Gustavsson -Janne Lindblad -Patrik Winroth -Claes Wikstrm -Siri Hansen -Peter Andersson - -...and others. - diff --git a/lib/test_server/Makefile b/lib/test_server/Makefile deleted file mode 100644 index 382749d1fc..0000000000 --- a/lib/test_server/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2009. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# -# Macros -# - -SUB_DIRECTORIES = src doc/src - -include vsn.mk -VSN = $(TEST_SERVER_VSN) - -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/test_server/README b/lib/test_server/README deleted file mode 100644 index fc71c90ca8..0000000000 --- a/lib/test_server/README +++ /dev/null @@ -1,113 +0,0 @@ -=========================================================================== - OTP Test Server -=========================================================================== - -To compile the 'test_server' application you need to build and install -a Erlang/OTP system from source. Get your open source Erlang/OTP from -http://www.erlang.org/. The resulting "erlc" command must be in the -search path for commands. - -The Erlang test_server application and the example tests are to be -inserted into an existing source tree for Erlang/OTP. - -You don't run the Test Server or the tests from the source tree. -Instead a test installation area $TESTROOT is used with the resulting -directory structure - - $TESTROOT/test_server - $TESTROOT/_test - $TESTROOT/_test - . - . - -For more details see the test_server documentation can be found in the -"$ERL_TOP/lib/test_server/doc/html" directory. - - -Unpacking the sources ---------------------- - -Enter your Erlang/OTP source tree and unpack the OTP Test Server and -optionally the test examples - - % cd otp_src_RXX - % gunzip -c test_server-.tar.gz | tar xf - - % gunzip -c emulator-YYYY-MM-DD.tar.gz | tar xf - - % gunzip -c stdlib-YYYY-MM-DD.tar.gz | tar xf - - - -How to build and install the OTP Test Server --------------------------------------------- - -Set the ERL_TOP variable to the top directory of the source tree - - % cd otp_src_RXX - - % setenv ERL_TOP `pwd` - or - % export ERL_TOP=`pwd` - -If not done before you need to run the configure script - - % ./configure - -Then build and install from the the base directory of the test_server -application - - % cd lib/test_server - % gmake release_tests TESTROOT= - - -How to build and install the example test suites ------------------------------------------------- - -If you want to build and install the example test suites -you build and install from the the test directories - - % cd $ERL_TOP/lib/stdlib/test - % gmake release_tests TESTROOT= - - % cd $ERL_TOP/erts/emulator/test - % gmake release_tests TESTROOT= - - -How to run OTP test suites --------------------------- - -First cd into $TESTROOT/test_server - - % cd $TESTROOT/test_server - -Install the OTP Test Server framework - - % erl - 1> ts:install(). - -Check which tests are available - - 2> ts:tests(). - [...] - -Run the collections of test suites one at the time - - 3> ts:run(emulator). (starts a xterm with an Erlang shell) - 4> ts:run(stdlib). (starts a xterm with an Erlang shell) - -or all at once - - 5> ts:run(). (the node running the tests will be in the background) - -Note that it is normal to see lots of error messages in the Erlang -shell. The tests will stress the system with lots of invalid input to -find problems in the error handling. - -Also note that a failing test case does not always indicate a bug in -Erlang/OTP. Differences in the network setup, machine configuration -etc may cause a test case to fail or time out. - -The result of the tests are recorded in the file named "index.html" in -the "$TESTROOT/test_server" directory. You can follow the progress of -tests suites not yet completed from "last_test.html". - -For more details see the test_server documentation can be found in the -"$ERL_TOP/lib/test_server/doc/html" directory. diff --git a/lib/test_server/doc/html/.gitignore b/lib/test_server/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/doc/man3/.gitignore b/lib/test_server/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/doc/man6/.gitignore b/lib/test_server/doc/man6/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/doc/pdf/.gitignore b/lib/test_server/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile deleted file mode 100644 index 8c5418aee5..0000000000 --- a/lib/test_server/doc/src/Makefile +++ /dev/null @@ -1,140 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2002-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(TEST_SERVER_VSN) -APPLICATION=test_server - -DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ -The Test Server application is obsolete and will be removed \ -in the next major OTP release - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = \ - test_server_ctrl.xml \ - test_server.xml -XML_REF3_INTERNAL = \ - ts.xml -XML_REF6_FILES = test_server_app.xml - -XML_PART_FILES = \ - part.xml \ - part_notes.xml \ - part_notes_history.xml - -XML_CHAPTER_FILES = \ - basics_chapter.xml \ - run_test_chapter.xml \ - write_test_chapter.xml \ - test_spec_chapter.xml \ - example_chapter.xml \ - write_framework_chapter.xml \ - notes.xml \ - notes_history.xml - -BOOK_FILES = book.xml - -XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) - -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -HTML_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN3_INTERNAL = $(XML_REF3_INTERNAL:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/test_server-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN3_INTERNAL) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -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 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) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - -release_spec: - -release_tests_spec: diff --git a/lib/test_server/doc/src/basics_chapter.xml b/lib/test_server/doc/src/basics_chapter.xml deleted file mode 100644 index 9e9f38aab4..0000000000 --- a/lib/test_server/doc/src/basics_chapter.xml +++ /dev/null @@ -1,215 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Basics - Siri Hansen - - - - basics_chapter.xml -
- -
- Introduction -

Test Server is a portable test tool for automated - testing of Erlang programs and OTP applications. It provides an - interface for running test programs directly with Test Server - as well as an interface for integrating Test Server - with a framework application. The latter makes it possible to use - Test Server as the engine of a higher level test tool - application.

- -

It is strongly recommended that Test Server be used from inside - a framework application, rather than interfaced directly for - running test programs. Test Server can be pretty difficult to use - since it's a very general and quite extensive and complex - application. Furthermore, the test_server_ctrl functions - are not meant to be used from within the actual test programs. The - framework should handle communication with Test Server and deal - with the more complex aspects of this interaction automatically so - that a higher level interface may be provided for the tester. For - test tool usage to be productive, a simpler, more intuitive and - (if required) more specific interface is required than what Test Server - can provide.

- -

OTP delivers a general purpose framework for Test Server, called - Common Test. This application is a tool well suited for - automated black box testing of target systems of any kind - (not necessarily implemented in Erlang). Common Test is also a very - useful tool for white box testing of Erlang programs and OTP - applications. Unless a more specific functionality and/or user - interface is required (in which case you might need to implement - your own framework), Common Test should do the job for - you. Please read the Common Test User's Guide and reference manual - for more information.

- -

Under normal circumstances, knowledge about the Test Server - application is not required for using the Common Test framework. - However, if you want to use Test Server without a framework, - or learn how to integrate it with your own framework, please read on... -

-
-
- Getting started -

Testing when using Test Server is done by running test - suites. A test suite is a number of test cases, where each test - case tests one or more things. The test case is the smallest unit - that the test server deals with. One or more test cases are - grouped together into one ordinary Erlang module, which is called - a test suite. Several test suite modules can be grouped together - in special test specification files representing whole application - and/or system test "jobs". -

-

The test suite Erlang module must follow a certain interface, - which is specified by Test Server. See the section on writing - test suites for details about this. -

-

Each test case is considered a success if it returns to the - caller, no matter what the returned value is. An exception to this - is the return value {skip, Reason} which indicates that the - test case is skipped. A failure is specified as a crash, no matter - what the crash reason is. -

-

As a test suite runs, all information (including output to - stdout) is recorded in several different log files. A minimum of - information is displayed to the user console. This only include - start and stop information, plus a note for each failed test case. -

-

The result from each test case is recorded in an HTML log file - which is created for each test run. Every test case gets one row - in a table presenting total time, whether the case was successful - or not, if it was skipped, and possibly also a comment. The HTML - file has links to each test case's logfile, which may be viewed - from e.g. Netscape or any other HTML capable browser. -

-

The Test Server consists of three parts: -

- - The part that executes the test suites and - provides support for the test suite author is called - test_server. This is described in the chapter about - writing test cases in this user's guide, and in the reference - manual for the test_server module. - The controlling part, which provides the low level - operator interface, starts and stops slave nodes and writes - log files, is called - test_server_ctrl. The Test Server Controller should not - be used directly when running tests. Instead a framework built - on top of it should be used. More information - about how to write your own framework can be found - in this user's guide and in the reference manual for the - test_server_ctrl module. - -
- -
- Definition of terms - - conf(iguration) case - This is a group of test cases which need some specific - configuration. A conf case contains an initiation function which - sets up a specific configuration, one or more test cases using - this configuration, and a cleanup function which restores the - configuration. A conf case is specified in a test specification - either like this:{conf,InitFunc,ListOfCases,CleanupFunc}, - or this: {conf,Properties,InitFunc,ListOfCases,CleanupFunc} - - datadir - Data directory for a test suite. This directory contains - any files used by the test suite, e.g. additional erlang - modules, c code or data files. If the data directory contains - code which must be compiled before the test suite is run, it - should also contain a makefile source called Makefile.src - defining how to compile. - - documentation clause - One of the function clauses in a test case. This clause - shall return a list of strings describing what the test case - tests. - - execution clause - One of the function clauses in a test case. This clause - implements the actual test case, i.e. calls the functions that - shall be tested and checks results. The clause shall crash if it - fails. - - major log file - This is the test suites log file. - - Makefile.src - This file is used by the test server framework to generate - a makefile for a datadir. It contains some special characters - which are replaced according to the platform currently tested. - - minor log file - This is a separate log file for each test case. - - privdir - Private directory for a test suite. This directory should - be used when the test suite needs to write to files. - - skip case - A test case which shall be skipped. - - specification clause - One of the function clauses in a test case. This clause - shall return an empty list, a test specification or - {skip,Reason}. If an empty list is returned, it means - that the test case shall be executed, and so it must also have - an execution clause. - - test case - A single test included in a test suite. Typically it tests - one function in a module or application. A test case is - implemented as a function in a test suite module. The function - can have three clauses, the documentation-, specification- and - execution clause. - - test specification - A specification of which test suites and test cases to - run. There can be test specifications on three different levels - in a test. The top level is a test specification file which - roughly specifies what to test for a whole application. Then - there is a test specification for each test suite returned from - the all(suite) function in the suite. And there can also - be a test specification returned from the specification clause - of a test case. - - test specification file - This is a text file containing the test specification for - an application. The file has the extension ".spec" or - ".spec.Platform", where Platform is e.g. "vxworks". - - test suite - An erlang module containing a collection of test cases for - a specific application or module. - - topcase - The first "command" in a test specification file. This - command contains the test specification, like this: - {topcase,TestSpecification} - -
- - diff --git a/lib/test_server/doc/src/book.xml b/lib/test_server/doc/src/book.xml deleted file mode 100644 index 6eb7daae1a..0000000000 --- a/lib/test_server/doc/src/book.xml +++ /dev/null @@ -1,50 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server - Siri Hansen - - 2002-07-11 - - book.xml -
- - - Test Server - - - - - - - - - - - - - - - - diff --git a/lib/test_server/doc/src/example_chapter.xml b/lib/test_server/doc/src/example_chapter.xml deleted file mode 100644 index 43fd4d9d53..0000000000 --- a/lib/test_server/doc/src/example_chapter.xml +++ /dev/null @@ -1,151 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Examples - Siri Hansen - - - - example_chapter.xml -
- -
- Test suite - --module(my_SUITE). - --export([all/1, - not_started/1, not_started_func1/1, not_started_func2/1, - start/1, stop/1, - func1/1, func2/1 - ]). - --export([init_per_testcase/2, end_per_testcase/2]). - --include_lib("common_test/include/ct.hrl"). - --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - Dog=?t:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -all(suite) -> - %% Test specification on test suite level - [not_started, - {conf, start, [func1, func2], stop}]. - -not_started(suite) -> - %% Test specification on test case level - [not_started_func1, not_started_func2]; -not_started(doc) -> - ["Testing all functions when application is not started"]. -%% No execution clause unless the specification clause returns []. - - -not_started_func1(suite) -> - []; -not_started_func1(doc) -> - ["Testing function 1 when application is not started"]. -not_started_func1(Config) when list(Config) -> - {error, not_started} = myapp:func1(dummy_ref,1), - {error, not_started} = myapp:func1(dummy_ref,2), - ok. - -not_started_func2(suite) -> - []; -not_started_func2(doc) -> - ["Testing function 2 when application is not started"]. -not_started_func2(Config) when list(Config) -> - {error, not_started} = myapp:func2(dummy_ref,1), - {error, not_started} = myapp:func2(dummy_ref,2), - ok. - - -%% No specification clause needed for an init function in a conf case!!! -start(doc) -> - ["Testing start of my application."]; -start(Config) when list(Config) -> - Ref = myapp:start(), - case erlang:whereis(my_main_process) of - Pid when pid(Pid) -> - [{myapp_ref,Ref}|Config]; - undefined -> - %% Since this is the init function in a conf case, the rest of the - %% cases in the conf case will be skipped if this case fails. - ?t:fail("my_main_process did not start") - end. - -func1(suite) -> - []; -func1(doc) -> - ["Test that func1 returns ok when argument is 1 and error if argument is 2"]; -func1(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:func1(Ref,1), - error = myapp:func1(Ref,2), - ok. - -func2(suite) -> - []; -func2(doc) -> - ["Test that func1 returns ok when argument is 3 and error if argument is 4"]; -func2(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:func2(Ref,3), - error = myapp:func2(Ref,4), - ok. - -%% No specification clause needed for a cleanup function in a conf case!!! -stop(doc) -> - ["Testing termination of my application"]; -stop(Config) when list(Config) -> - Ref = ?config(myapp_ref,Config), - ok = myapp:stop(Ref), - case erlang:whereis(my_main_process) of - undefined -> - lists:keydelete(myapp_ref,1,Config); - Pid when pid(Pid) -> - ?t:fail("my_main_process did not stop") - end. - -
- -
- Test specification file -

myapp.spec:

- -{topcase, {dir, "../myapp_test"}}. % Test specification on top level -

myapp.spec.vxworks:

- -{topcase, {dir, "../myapp_test"}}. % Test specification on top level -{skip,{my_SUITE,func2,"Not applicable on VxWorks"}}. -
- - - diff --git a/lib/test_server/doc/src/fascicules.xml b/lib/test_server/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/test_server/doc/src/fascicules.xml +++ /dev/null @@ -1,18 +0,0 @@ - - - - - - User's Guide - - - Reference Manual - - - Release Notes - - - Off-Print - - - diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml deleted file mode 100644 index b48bda94d0..0000000000 --- a/lib/test_server/doc/src/notes.xml +++ /dev/null @@ -1,1694 +0,0 @@ - - - - -
- - 20042013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - APPLICATION Release Notes - Peter Andersson - Peter Andersson - - - - 2007-11-30 - A - notes.xml -
- -
Test_Server 3.9.1 - -
Fixed Bugs and Malfunctions - - -

- When generating Makefile from Makefile.src, - ts_lib:get_arg/4 earlier removed all spaces in the - extracted argument. The code was probably meant for - removing leading and trailing spaces only, and is now - corrected to do so.

-

- Own Id: OTP-13015

- - -

- With the Common Test 'create_priv_dir' start option set - to 'auto_per_tc', the name of the priv directory for a - configuration function could clash with the name of the - priv directory for a test case, which would cause Test - Server failure. This error has been corrected.

-

- Own Id: OTP-13181

- - -
- -
- -
Test_Server 3.9 - -
Fixed Bugs and Malfunctions - - -

- The status of an aborted test due to test suite - compilation error has changed from 'auto_skipped' to - 'failed'. This affects both the textual log file, event - handling and CT hook callbacks. The logging of - compilation failures has also been improved, especially - in the case of multiple test suites failing compilation.

-

- Own Id: OTP-10816

- - -

- The Test Server source code parser (erl2html2) failed to - handle the macro tuple in the syntax tree returned by - epp_dodger. This error has been corrected.

-

- Own Id: OTP-12740

- - -
- - -
Improvements and New Features - - -

- The Test Server application has been marked as obsolete - and will be removed from OTP in the next major release - (OTP 19.0).

-

- Own Id: OTP-10923 Aux Id: OTP-12705

- - -

- When running OTP tests using the ts interface, it is now - possible to specify so called test categories per OTP - application. A test category is represented by a CT test - specification and defines an arbitrary subset of existing - test suites, groups and cases. Examples of test - categories are 'smoke' (smoke tests) and 'bench' - (benchmarks). (Call ts:help() for more info). Also, - functions for reading terms from the current test - specification during test, ct:get_testspec_terms/0 and - ct:get_testspec_terms/1, have been implemented.

-

- Own Id: OTP-11962

- - -
- -
- -
Test_Server 3.8.1 - -
Fixed Bugs and Malfunctions - - -

- If the last expression in a test case causes a timetrap - timeout, the stack trace is ignored and not printed to - the test case log file. This happens because the - {Suite,TestCase,Line} info is not available in the stack - trace in this scenario, due to tail call elimination. - Common Test has been modified to handle this situation by - inserting a {Suite,TestCase,last_expr} tuple in the - correct place and printing the stack trace as expected.

-

- Own Id: OTP-12697 Aux Id: seq12848

- - -
- -
- -
Test_Server 3.8 - -
Fixed Bugs and Malfunctions - - -

- When installing test suites in a cross compilation - environment, ts_install was not able to read the values - of the environment variables specified in the - configuration file. This has been fixed.

-

- Own Id: OTP-11441

- - -

- Printouts by means of ct:log/2/3 or ct:pal/2/3 from the - hook functions on_tc_fail/2 and on_tc_skip/2 would (quite - unexpectedly) end up in the "unexpected i/o" log file - instead of in the test case log file. This behaviour has - been changed so that now, all printouts (including stdio - printouts) from these hook functions will be routed to - the test case log file.

-

- Own Id: OTP-12468

- - -
- - -
Improvements and New Features - - -

- The format of the information printed on top of the test - case (and configuration function) log file has been - slightly modified, mainly in order to make the start - configuration data easier to read and interpret.

-

- Own Id: OTP-12518 Aux Id: seq12808

- - -
- -
- -
Test_Server 3.7.2 - -
Fixed Bugs and Malfunctions - - -

- The source code to html code generator in Test Server - (and Common Test) would fail to generate anchors in the - html code for functions with non-expandable macros, - resulting in bad html links to such functions. This - correction lets the code generator ignore macros that - can't be expanded (i.e. not pre-process them), so that - correct anchors will always be produced.

-

- Own Id: OTP-11766 Aux Id: seq12556

- - -

- Make sure to install .hrl files when needed

-

- Own Id: OTP-12197

- - -
- - -
Improvements and New Features - - -

- Distribute autoconf helpers to applications at - build time instead of having multiple identical copies - committed in the repository.

-

- Own Id: OTP-12348

- - -
- -
- -
Test_Server 3.7.1 - -
Fixed Bugs and Malfunctions - - -

- The mechanism for running code cover analysis with - common_test has been improved. Earlier, if a test run - consisted of multiple tests, cover would be started and - stopped for each test. This would give "intermediate" - cover logs available from the "Coverage log" link on the - test suite result pages. To accumulate cover data over - all tests, the 'export' option had to be used in the - cover spec file. This was not well documented, and the - functionality was quite confusing.

-

- Using the 'nodes' option in the cover spec file would - fail when the test run consisted of multiple tests, since - the specified nodes would only be included in the cover - analysis of the first test.

-

- The repeated compilation and analysis of the same modules - was also very time consuming.

-

- To overcome these problems, ct will now only cover - compile and analyze modules once per test run, i.e. once - for each cover spec file. The log file is available via a - new button on the top level index page. The old "Coverage - log" links on the test suite result pages still exist, - but they all point to the same log containing the - accumulated result.

-

- Own Id: OTP-11971

- - -
- -
- -
Test_Server 3.7 - -
Fixed Bugs and Malfunctions - - -

- Application upgrade (appup) files are corrected for the - following applications:

-

- asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl

-

- A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.

-

- (Thanks to Tobias Schlager)

-

- Own Id: OTP-11744

- - -
- - -
Improvements and New Features - - -

- Calls to erlang:open_port/2 with 'spawn' are updated to - handle space in the command path.

-

- Own Id: OTP-10842

- - -
- -
- -
Test_Server 3.6.4 - -
Fixed Bugs and Malfunctions - - -

The way Common Test handles skipping of test cases has - been updated. In previous versions, returning - {skip,Reason} from a configuration function (such - as init_per_suite or init_per_group), resulted in all - affected test cases getting skipped with status - auto_skipped. This was inappropriate, since this - status is supposed to be used to inform that Common Test - has taken the initiative to skip something (e.g. a test - case group if init_per_group failed). Therefore, in this - version of Common Test, whenever the user skips a suite, - group, or individual test case (by means of a - configuration function or test specification term), the - affected test cases get the status user_skipped - instead.

This update has meant a few changes that - may affect Common Test users in various ways:

- The test results and statistics will be affected, - which is important to know when running regression tests - and comparing results to previous test runs. - Users that read or parse the textual log file - suite.log will notice that an auto skipped - function is now reported as auto_skipped rather - than skipped as before. When - require fails in an info function (such as suite/0 - or group/1), all affected configuration functions and - test cases are marked as auto_skipped. - If Common Test detects an error in the test suite - (such as e.g. an invalid all/0 function), all affected - configuration functions and test cases are marked as - auto_skipped. If a repeated test run - session reaches a deadline with force_stop - enabled, all remaining test cases are marked as - auto_skipped rather than user_skipped as - before. The event messages that Common Test - generates during test runs have been affected by this - update. For details see OTP-11524. -

- Own Id: OTP-11305 Aux Id: OTP-11524

- - -
- -
- -
Test_Server 3.6.3 - -
Fixed Bugs and Malfunctions - - -

- Test Server installed an error handler (test_server_h) - only to be able to write the name of the current test - case to stdout whenever it received an error- or progress - report. This functionality was not useful and has been - removed. The built-in Common Test hook, cth_log_redirect, - has instead been improved to now also tag all error- and - progress reports in the log with suite-, group-, and/or - test case name.

-

- Own Id: OTP-11263 Aux Id: seq12251

- - -
- - -
Improvements and New Features - - -

- A new log, the "Pre- and Post Test I/O Log", has been - introduced, which makes it possible to capture error- and - progress reports, as well as printouts made with ct:log/2 - and ct:pal/2, before and after a test run. (Some minor - improvements of the logging system have been made at the - same time). Links to the new log are found on the Common - Test Framework Log page. The Common Test User's Guide has - been updated with information about the new log and also - with a new section on how to synchronize external - applications with Common Test by means of the CT Hook - init and terminate functions.

-

- Own Id: OTP-11272

- - -
- - -
Known Bugs and Problems - - -

- Test Server: Report auto_skipped in major log.

-

- Own Id: OTP-11297

- - -
- -
- -
Test_Server 3.6.2 - -
Fixed Bugs and Malfunctions - - -

- Some unused code related to remote targets is removed, - and documentation is updated.

-

- Own Id: OTP-10607 Aux Id: kunagi-338 [249]

- - -

- A bug in test_server_gl caused io requests containing - invalid data (i.e. not unicode:chardata()) to hang, since - no io reply was sent. This has been corrected.

-

- Own Id: OTP-10991

- - -

- Common Test would, in case of timetrap error, print a - warning in the log if end_per_testcase wasn't implemented - in the suite, even though it's an optional function. This - printout has been removed.

-

- Own Id: OTP-11052

- - -
- - -
Improvements and New Features - - -

- The '-force_stop' flag to use with time-limited repeats - of test runs can now be used with a new 'skip_rest' - option which causes the rest of the test cases in the - ongoing test job to be skipped when the time limit is - reached. E.g. 'ct_run -spec xxx -duration 010000 - -force_stop skip_rest'

-

- Own Id: OTP-10856 Aux Id: OTP-10832

- - -
- -
- -
Test_Server 3.6.1 - -
Fixed Bugs and Malfunctions - - -

- The unicode update of test_server for R16A introduced a - few potential errors when logging to files. Sometimes ~tp - or ~ts was used for formatting also when writing to files - that were not opened with the {encoding,utf8} option. If - then the argument contained unicode characters above 255, - the file descriptor would crash. This has been corrected - by the following modifications:

Since the - 'unexpected_io' log file is used only when the test case - HTML file is not available (e.g. between test cases), - this file is now also a HTML file and as other - test_server HTML logs it is always UTF-8 encoded - Since it is possible to change which information - is going to which log file (with - test_server_ctrl:set_levels/3), we do not have full - control over which information is written to which file. - This means that any printout could be written to the - 'major' log file (suite.log), which was earlier encoded - as latin1. To avoid crashing this file descriptor due to - unicode strings, the 'major' log file is now also encoded - in UTF-8 (possible incopatibility). The - cross_cover.info file is no longer a text file which can - be read with file:consult/1, instead it is written as a - pure binary file using term_to_binary when writing and - binary_to_term when reading. The encoding - of the file named 'last_name', which only content is the - path to the last run.<timestamp> directory, is now - dependent on the file name mode of the VM. If file names - are expected to be unicode, then the 'last_name' file is - UTF-8 encoded, else it is latin1 encoded. -

- Also, ~tp has been changed back to ~p unless it is - somehow likely that the argument includes strings. It is - not obvious that this is the correct thing to do, but - some decission had to be taken...

-

- Own Id: OTP-10780

- - -

- Using the force_stop flag/option to interrupt a test run - caused a crash in Common Test. This problem has been - solved.

-

- Own Id: OTP-10832

- - -
- -
- -
Test_Server 3.6 - -
Fixed Bugs and Malfunctions - - -

- Line numbering of erlang files that were not correctly - indented could be wrong after coverting to html with - erl2html2:convert/[2,3] (the source code pointed to from - the test case). This has been corrected.

-

- Also, there are now link targets for each line and not - only for each 10th line, and link targets for functions - now include the arity and not only the function name - (e.g. func/1 has a link target "func-1").

-

- Own Id: OTP-9710 Aux Id: seq11945, kunagi-201 [112]

- - -

- Severe errors detected by test_server (e.g. if log - files directories cannot be created) will now be reported - to common_test and noted in the common_test - logs.

-

- Own Id: OTP-9769 Aux Id: kunagi-202 [113]

- - -

- The earlier undocumented cross cover feature for - accumulating cover data over multiple tests has now been - fixed and documented.

-

- Own Id: OTP-9870 Aux Id: kunagi-206 [117]

- - -

- If the test suite itself was included in code coverage - analysis, then the test_server would not manage to set - data_dir correctly for the test. This has been corrected.

-

- Own Id: OTP-9956 Aux Id: kunagi-207 [118]

- - -

- Any call to test_server:break/1 should cancel all active - timetramps. However, in some cases - Suite:end_per_testcase/2 is executed on a different - process than the test case itself, and if - test_server:break/1 was called from there, the timetraps - were not cancelled. This has been corrected.

-

- Own Id: OTP-10046 Aux Id: kunagi-174 [85]

- - -

When a test case failed because of a timetrap time - out, the Config data for the case was lost in the - following call to end_per_testcase/2, and also in - calls to the CT Hook function - post_end_per_testcase/4. This problem has been - solved and the Config data is now correctly passed - to the above functions after a timetrap timeout - failure.

-

- Own Id: OTP-10070 Aux Id: kunagi-175 [86]

- - -

In test_server, the same process would supervise the - currently running test case and be group leader (and IO - server) for the test case. Furthermore, when running - parallel test cases, new temporary supervisor/group - leader processes were spawned and the process that was - group leader for sequential test cases would not be - active. That would lead to several problems:

-

* Processes started by init_per_suite will inherit the - group leader of the init_per_suite process (and that - group leader would not process IO requests when parallel - test cases was running). If later a parallel test case - caused such a processto print using (for example) - io:format/2, the calling would hang.

-

* Similarly, if a process was spawned from a parallel - test case, it would inherit the temporary group leader - for that parallel test case. If that spawned process - later - when the group of parallel tests have finished - - attempted to print something, its group leader would be - dead and there would be badarg exception.

-

Those problems have been solved by having group - leaders separate from the processes that supervises the - test cases, and keeping temporary group leader process - for parallel test cases alive until no more process in - the system use them as group leaders.

-

Also, a new unexpected_io.log log file - (reachable from the summary page of each test suite) has - been introduced. All unexpected IO will be printed into - it(for example, IO to a group leader for a parallel test - case that has finished).

-

- Own Id: OTP-10101 Aux Id: OTP-10125

- - -

- The stability of common_test and - test_server when running test cases in parallel - has been improved.

-

- Own Id: OTP-10480 Aux Id: kunagi-318 [229]

- - -
- - -
Improvements and New Features - - -

- Added a general framework for executing benchmarks of - Erlang/OTP. Benchmarks for the Erlang VM and mnesia have - been incorporated in the framework.

-

- For details about how to add more benchmarks see - $ERL_TOP/HOWTO/BENCHMARKS.md in the source distribution.

-

- Own Id: OTP-10156

- - -

- Update common test modules to handle Unicode:

- Use UTF-8 encoding for all HTML files, except the - HTML version of the test suite generated with - erl2html2:convert, which will have the same encoding as - the original test suite (.erl) file. - Encode link targets in HTML files with - test_server_ctrl:uri_encode/1. Use unicode - modifier 't' with ~s when appropriate. Use - unicode:characters_to_list and - unicode:characters_to_binary for conversion between - binaries and strings instead of binary_to_list and - list_to_binary. - - -
- -
- -
Test_Server 3.5.3 - -
Improvements and New Features - - -

- test_server_h will now recognize info_reports written by - ct connection handlers (according to the description in - cth_conn_log) and ignore them as they will be completely - handled by by ct_conn_log_h.

-

- Earlier test_server_h would print a tag (testcase name) - before forwarding the report to error_logger_tty_h. This - would cause lots of tags in the log with no info report - following (since error_logger_tty_h did not handle them).

-

- Own Id: OTP-10571

- - -
- - -
Known Bugs and Problems - - -

- Restore Config data if lost when test case fails.

-

- Own Id: OTP-10070 Aux Id: kunagi-175 [86]

- - -

- IO server error in test_server.

-

- Own Id: OTP-10125 Aux Id: OTP-10101, kunagi-177 [88]

- - -
- -
- -
Test_Server 3.5.2 - -
Fixed Bugs and Malfunctions - - -

- The documentation has been updated with the latest - changes for the test_server_ctrl:report/2 function.

-

- Own Id: OTP-10086 Aux Id: seq12066

- - -

- The ct:get_status/0 function failed to report status if a - parallel test case group was running at the time of the - call. This has been fixed and the return value for the - function has been updated. Please see the ct reference - manual for details.

-

- Own Id: OTP-10172

- - -
- - -
Improvements and New Features - - -

- It is now possible to sort the HTML tables by clicking on - the header elements. In order to reset a sorted table, - the browser window should simply be refreshed. This - feature requires that the browser supports javascript, - and has javascript execution enabled. If the 'ct_run - -basic_html' flag is used, no javascript code is included - in the generated HTML code.

-

- Own Id: OTP-9896 Aux Id: seq12034, OTP-9835

- - -

- Verbosity levels for log printouts has been added. This - makes it possible to specify preferred verbosity for - different categories of log printouts, as well as general - printouts (such as standard IO), to allow control over - which strings get printed and which get ignored. New - versions of the Common Test logging functions, ct:log, - ct:pal and ct:print, have been introduced, with a new - Importance argument added. The Importance value is - compared to the verbosity level at runtime. More - information can be found in the chapter about Logging in - the Common Test User's Guide.

-

- Own Id: OTP-10067 Aux Id: seq12050

- - -

- The Erlang/OTP test runner ts has been extended to allow - cross compilation of test suites. To cross compile the - test suites first follow the normal cross compilation - procedures and release the tests on the build host. Then - install ts using an xcomp specification file and compile - test suites using ts:compile_testcases/0. For more - details see $ERL_TOP/xcomp/README.md.

-

- Own Id: OTP-10074

- - -
- -
- -
Test_Server 3.5.1 - -
Fixed Bugs and Malfunctions - - -

- After a test case timeout or abortion, the - end_per_testcase function executes on a new dedicated - process. The group leader for this process should be set - to the IO server for the test case, which was not done - properly. The result of this error was that no warnings - about end_per_testcase failing or timing out were ever - printed in the test case log. Also, help functions such - as e.g. test_server:stop_node/1, attempting to - synchronize with the IO server, would hang. The fault has - been corrected.

-

- Own Id: OTP-9666

- - -

- A deadlock situation could occur if Common Test is - forwarding error_handler printouts to Test Server at the - same time a new test case is starting. This error has - been fixed.

-

- Own Id: OTP-9894

- - -

- When a test case was killed because of a timetrap - timeout, the current location (suite, case and line) was - not printed correctly in the log files. This has been - corrected.

-

- Own Id: OTP-9930 Aux Id: seq12002

- - -

- Test Server and Common Test would add new error handlers - with each test run and fail to remove previously added - ones. In the case of Test Server, this would only happen - if SASL was not running on the test node. This has been - fixed.

-

- Own Id: OTP-9941 Aux Id: seq12009

- - -

- If a test case process was terminated due to an exit - signal from a linked process, Test Server failed to - report the correct name of the suite and case to the - framework. This has been corrected.

-

- Own Id: OTP-9958 Aux Id: OTP-9855

- - -
- - -
Improvements and New Features - - -

- A new optional feature has been introduced that enables - Common Test to generate priv_dir directory names that are - unique for each test case or config function. The name of - the option/flag is 'create_priv_dir' and it can be set to - value 'auto_per_run' (which is the default, existing, - behaviour), or 'auto_per_tc' or 'manual_per_tc'. If - 'auto_per_tc' is used, Test Server creates a dedicated - priv_dir automatically for each test case (which can be - very expensive in case of many and/or repeated cases). If - 'manual_per_tc' is used, the user needs to create the - priv_dir explicitly by calling the new function - ct:make_priv_dir/0.

-

- Own Id: OTP-9659 Aux Id: seq11930

- - -

- A column for test case group name has been added to the - suite overview HTML log file.

-

- Own Id: OTP-9730 Aux Id: seq11952

- - -

- It is now possible to use the post_end_per_testcase CT - hook function to print a comment for a test case in the - overview log file, even if the test case gets killed by a - timetrap or unknown exit signal, or if the - end_per_testcase function times out.

-

- Own Id: OTP-9855 Aux Id: seq11979

- - -

- Common Test will now print error information (with a time - stamp) in the test case log file immediately when a test - case fails. This makes it easier to see when, in time, - the fault actually occured, and aid the job of locating - relevant trace and debug printouts in the log.

-

- Own Id: OTP-9904 Aux Id: seq11985, OTP-9900

- - -

- Test Server has been modified to check the SASL - errlog_type parameter when receiving an error logger - event, so that it doesn't print reports of type that the - user has disabled.

-

- Own Id: OTP-9955 Aux Id: seq12013

- - -

- If an application cannot be found by ts it is - automatically skipped when testing.

-

- Own Id: OTP-9971

- - -

- By specifying a user defined function ({M,F,A} or fun) as - timetrap value, either by means of an info function or by - calling ct:timetrap/1, it is now possible to set a - timetrap that will be triggered when the user function - returns.

-

- Own Id: OTP-9988 Aux Id: OTP-9501, seq11894

- - -

- If the optional configuration functions init_per_suite/1 - and end_per_suite/1 are not implemented in the test - suite, local Common Test versions of these functions are - called instead, and will be displayed in the overview log - file. Any printouts made by the pre- or - post_init_per_suite and pre- or post_end_per_suite hook - functions are saved in the log files for these functions.

-

- Own Id: OTP-9992

- - -
- -
- -
Test_Server 3.5 - -
Improvements and New Features - - -

- The test case group info function has been implemented in - Common Test. Before execution of a test case group, a - call is now made to TestSuite:group(GroupName). - The function returns a list of test properties, e.g. to - specify timetrap values, require configuration data, etc - (analogue to the test suite- and test case info - function). The scope of the properties set by - group(GroupName) is all test cases and sub-groups - of group GroupName.

-

- Own Id: OTP-9235

- - -

- The look of the HTML log files generated by Common Test - and Test Server has been improved (and made easier to - customize) by means of a CSS file.

-

- Own Id: OTP-9706

- - -
- - -
Known Bugs and Problems - - -

- Fix problems in CT/TS due to line numbers in exceptions.

-

- Own Id: OTP-9203

- - -
- -
- -
Test_Server 3.4.5 - -
Fixed Bugs and Malfunctions - - -

- An error in how comments are colored in the test suite - overview html log file has been corrected. As result, a - new framework callback function, format_comment/1, has - been introduced.

-

- Own Id: OTP-9237

- - -

- Test Server did not release SASL TTY handlers - (sasl_report_tty_h and error_logger_tty_h) properly after - each test run. This error has been fixed.

-

- Own Id: OTP-9311

- - -

- Automatically generated init- and end-configuration - functions for test case groups caused incorrect execution - order of test cases. This has been corrected.

-

- Own Id: OTP-9369

- - -

- If ct:log/2 was called with bad arguments, this could - cause the Common Test IO handling process to crash. This - fault has been corrected.

-

- Own Id: OTP-9371 Aux Id: OTP-8933

- - -

- A bug has been fixed that made Test Server call the - end_tc/3 framework function with an incorrect module name - as first argument.

-

- Own Id: OTP-9379 Aux Id: seq11863

- - -

- If end_per_testcase caused a timetrap timeout, the actual - test case status was discarded and the test case logged - as successful (even if the case had actually failed - before the call to end_per_testcase). This fault has been - fixed.

-

- Own Id: OTP-9397

- - -

- If a timetrap timeout occured during execution of of a - function in a lib module (i.e. a function called directly - or indirectly from a test case), the Suite argument in - the end_tc/3 framework callback function would not - correctly contain the name of the test suite, but the lib - module. (This would only happen if the lib module was - compiled with ct.hrl included). This error has been - solved.

-

- Own Id: OTP-9398

- - -

- Add a proplist() type

-

- Recently I was adding specs to an API and found that - there is no canonical proplist() type defined. (Thanks to - Ryan Zezeski)

-

- Own Id: OTP-9499

- - -

XML files have been corrected.

-

- Own Id: OTP-9550 Aux Id: OTP-9541

- - -

- If a test suite would start with a test case group - defined without the init_per_group/2 and end_per_group/2 - function, init_per_suite/1 would not execute initially - and logging of the test run would fail. This error has - been fixed.

-

- Own Id: OTP-9584

- - -
- - -
Improvements and New Features - - -

- A new option, 'logopts', has been introduced, to make it - possible to modify some aspects of the logging behaviour - in Common Test (or Test Server). For example, whenever an - io printout is made, test_server adds newline (\n) to the - end of the output string. This may not always be a - preferred action and can therefore be disabled by means - of "ct_run ... -logopts no_nl" (or ct:run_test([..., - {logopts,[no_nl]}])). A new framework callback function, - get_logopts/0, has been introduced (see the ct_framework - module for details).

-

- Own Id: OTP-9372 Aux Id: OTP-9396

- - -

- A new option, 'logopts', has been introduced, to make it - possible to modify some aspects of the logging behaviour - in Common Test (or Test Server). For example, if the html - version of the test suite source code should not be - generated during the test run (and consequently be - unavailable in the log file system), the feature may be - disabled by means of "ct_run ... -logopts no_src" (or - ct:run_test([..., {logopts,[no_src]}])). A new framework - callback function, get_logopts/0, has been introduced - (see the ct_framework module for details).

-

- Own Id: OTP-9396 Aux Id: seq11869, OTP-9372

- - -

- It is now possible to use a tuple {M,F,A}, or a fun, as - timetrap specification in the suite info function or test - case info functions. The function must return a valid - timeout value, as documented in the common_test man page - and in the User's Guide.

-

- Own Id: OTP-9501 Aux Id: seq11894

- - -
- -
- -
Test_Server 3.4.4 - -
Fixed Bugs and Malfunctions - - -

- It was previously not possible to use timetrap value - 'infinity' with ct:timetrap/1. This has been fixed.

-

- Own Id: OTP-9159

- - -

- A bug that made it impossible to cancel the previous - timetrap when calling ct:timetrap/1 has been corrected.

-

- Own Id: OTP-9233 Aux Id: OTP-9159

- - -
- - -
Improvements and New Features - - -

- When running tests with auto-compilation disabled, Common - Test could only display the test suite source code on - html format in the test case log if the source file was - located in the same directory as the pre-compiled suite. - This has been modified so that Common Test now tries to - locate the source file by means of the test suite module - info (Suite:module_info/1). As a result, a suite may now - be compiled to a different output directory (e.g. - $MYTEST/bin) than the source code directory (e.g. - $MYTEST/src), without the source-code-to-html generation - being affected.

-

- Own Id: OTP-9138

- - -

- It is now possible to return a tuple {fail,Reason} from - init_per_testcase/2. The result is that the associated - test case gets logged as failed without ever executing.

-

- Own Id: OTP-9160 Aux Id: seq11502

- - -

- Added DragonflyBSD check in test_server configure.

-

- Own Id: OTP-9249

- - -
- -
- -
Test_Server 3.4.3 - -
Fixed Bugs and Malfunctions - - -

- Updated the ts*.config files to contain information - relevant to testing Erlang/OTP in an open source - environment.

-

- Own Id: OTP-9017

- - -
- - -
Improvements and New Features - - -

- Alpha release of Common Test Hooks (CTH). CTHs allow the - users of common test to abtract out common behaviours - from test suites in a much more elegant and flexible way - than was possible before. Note that the addition of this - feature may introduce minor changes in the undocumented - behaviour of the interface inbetween common_test and - test_server.

-

- *** POTENTIAL INCOMPATIBILITY ***

-

- Own Id: OTP-8851

- - -
- -
- -
Test_Server 3.4.2 - -
Improvements and New Features - - -

Miscellaneous updates

-

- Own Id: OTP-8976

- - -
- -
- -
Test_Server 3.4.1 - -
Fixed Bugs and Malfunctions - - -

- Returning {return_group_result,failed} from end_per_group - in a group that is part of a sequence, did not cause the - proceeding cases (or groups) to get skipped. This has - been fixed.

-

- Own Id: OTP-8753 Aux Id: seq11644

- - -
- - -
Improvements and New Features - - -

- Common Test has been updated to handle start options and - test specification terms for test case groups (and test - cases in groups). Also, an option named 'label', has been - added that associates the test run with a name that - Common Test prints in the overview HTML logs.

-

- Own Id: OTP-8725 Aux Id: OTP-8727

- - -

- It is now possible to skip all tests in a suite, or a - group, by returning {fail,Reason} from the end_tc/5 - framework function for init_per_suite, or init_per_group.

-

- Own Id: OTP-8805 Aux Id: seq11664

- - -
- -
- -
Test_Server 3.4 - -
Fixed Bugs and Malfunctions - - -

- Returning {fail,Reason} from the framework end_tc - function was not handled properly by Test Server for all - test suite functions.

-

- Own Id: OTP-8492 Aux Id: seq11502

- - -

- If the framework end_tc function would hang and get - aborted by Test Server, there was no indication of - failure in the logs. This has been fixed.

-

- Own Id: OTP-8682 Aux Id: seq11504

- - -
- - -
Improvements and New Features - - -

- It is now possible for the Test Server framework end_tc - function to change the status of the test case from ok or - auto-skipped to failed by returning {fail,Reason}.

-

- Own Id: OTP-8495 Aux Id: seq11502

- - -

- Test Server will now call the end_per_testcase/2 function - even if the test case has been terminated explicitly - (with abort_current_testcase/1), or after a timetrap - timeout. Under these circumstances the return value of - end_per_testcase is completely ignored. Therefore the - function will not be able to change the reason for test - case termination by returning {fail,Reason}, nor will it - be able to save data with {save_config,Data}.

-

- Own Id: OTP-8500 Aux Id: seq11521

- - -

- Previously, a repeat property of a test case group - specified the number of times the group should be - repeated after the main test run. I.e. {repeat,N} would - case the group to execute 1+N times. To be consistent - with the behaviour of the run_test repeat option, this - has been changed. N now specifies the absolute number of - executions instead.

-

- Own Id: OTP-8689 Aux Id: seq11502

- - -
- -
- -
Test_Server 3.3.6 - -
Fixed Bugs and Malfunctions - - -

- The Test Server parse transform did not handle bit string - comprehensions. This has been fixed.

-

- Own Id: OTP-8458 Aux Id: OTP-8311

- - -
- - -
Improvements and New Features - - -

- The tc_status value in the Config list for a test case - that has failed because of a timetrap timeout, has - changed from {tc_status,timeout} to - {tc_status,timetrap_timeout}.

-

- Own Id: OTP-8302

- - -

The documentation is now possible to build in an open - source environment after a number of bugs are fixed and - some features are added in the documentation build - process.

-

- The arity calculation is updated.

-

- The module prefix used in the function names for - bif's are removed in the generated links so the links - will look like - "http://www.erlang.org/doc/man/erlang.html#append_element-2" - instead of - "http://www.erlang.org/doc/man/erlang.html#erlang:append_element-2".

-

- Enhanced the menu positioning in the html - documentation when a new page is loaded.

-

- A number of corrections in the generation of man - pages (thanks to Sergei Golovan)

-

- The legal notice is taken from the xml book file so - OTP's build process can be used for non OTP - applications.

-

- Own Id: OTP-8343

- - -
- -
- -
Test_Server 3.3.5 - -
Fixed Bugs and Malfunctions - - -

- If the init_per_testcase/2 function fails, the test case - now gets marked and counted as auto skipped, not user - skipped (which would previously happen).

-

- Own Id: OTP-8289

- - -
- - -
Improvements and New Features - - -

- The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.

-

- Own Id: OTP-8201

- - -

- It is now possible to fail a test case from the - end_per_testcase/2 function, by returning {fail,Reason}.

-

- Own Id: OTP-8284

- - -

- It is now possible to fail a test case by having the - end_tc/3 framework function return {fail,Reason} for the - test case.

-

- Own Id: OTP-8285

- - -

- The test_server framework API (e.g. the end_tc/3 - function) has been modified. See the test_server_ctrl - documentation for details.

-

- Own Id: OTP-8286 Aux Id: OTP-8285, OTP-8287

- - -
- -
- -
Test_Server 3.3.4 - -
Fixed Bugs and Malfunctions - - -

- When running a suite starting with a test case group, - Test Server crashed if init_per_suite/1 exited or - returned skip. This has been fixed.

-

- Own Id: OTP-8105 Aux Id: OTP-8089

- - -
- - -
Improvements and New Features - - -

- Various updates and fixes in Common Test and Test Server.

-

- Own Id: OTP-8045 Aux Id: OTP-8089,OTP-8105,OTP-8163

- - -

- Errors in coverage data collection and analysis were - difficult to detect. The logging has been improved so - that more information about e.g. imported and missing - modules is printed to the html log files.

-

- Own Id: OTP-8163 Aux Id: seq11374

- - -

- The Common Test HTML overview pages have been improved. - It is now possible to see if a test case has been skipped - explicitly or because a configuration function has - failed. Also, the history page (all_runs.html) now has - scrolling text displaying the test names. The old format - (showing names as a truncated string) can still be - generated by means of the flag/option 'basic_html'.

-

- Own Id: OTP-8177

- - -
- -
- -
Test_Server 3.3.2 - -
Improvements and New Features - - -

- Various corrections and improvements of Common Test and - Test Server.

-

- Own Id: OTP-7981

- - -
- -
- -
Test_Server 3.3.1 - -
Improvements and New Features - - -

- Minor updates and corrections.

-

- Own Id: OTP-7897

- - -
- -
- -
Test_Server 3.3 - -
Improvements and New Features - - -

- The conf case in Test Server has been extended with - properties that make it possible to execute test cases in - parallel, in sequence and in shuffled order. It is now - also possible to repeat test cases according to different - criterias. The properties can be combined, making it - possible to e.g. repeat a conf case a certain number of - times and execute the test cases in different (random) - order every time. The properties are specified in a list - in the conf case definition: {conf, Properties, InitCase, - TestCases, EndCase}. The available properties are: - parallel, sequence, shuffle, repeat, repeat_until_all_ok, - repeat_until_any_ok, repeat_until_any_fail, - repeat_until_all_fail.

-

- Own Id: OTP-7511 Aux Id: OTP-7839

- - -

The test server starts Cover on nodes of the same - version as the test server itself only.

-

- Own Id: OTP-7699

- - -

- The Erlang mode for Emacs has been updated with new and - modified skeletons for Common Test and TS. Syntax for - test case groups in Common Test (and conf cases with - properties in TS) has been added and a new minimal Common - Test suite skeleton has been introduced.

-

- Own Id: OTP-7856

- - -
- -
-
Test_Server 3.2.4.1 - -
Fixed Bugs and Malfunctions - - -

- The step functionality in Common Test (based on - interaction with Debugger) was broken. This has been - fixed, and some new step features have also been added. - Please see the Common Test User's Guide for details.

-

- Own Id: OTP-7800 Aux Id: seq11106

- - -
- -
- -
Test_Server 3.2.4 - -
Improvements and New Features - - -

- Miscellaneous updates.

-

- Own Id: OTP-7527

- - -
- -
- -
Test_Server 3.2.3 - -
Fixed Bugs and Malfunctions - - -

- When a testcase terminated due to a timetrap, io sent to - the group leader from framework:end_tc/3 (using - ct:pal/2/3 or ct:log/2/3) would cause deadlock. This has - been fixed.

-

- Own Id: OTP-7447 Aux Id: seq11010

- - -
- - -
Improvements and New Features - - -

- Various updates and improvements, plus some minor bug - fixes, have been implemented in Common Test and Test - Server.

-

- Own Id: OTP-7112

- - -

- It is now possible, by means of the new function - ct:abort_current_testcase/1 or - test_server_ctrl:abort_current_testcase/1, to abort the - currently executing test case.

-

- Own Id: OTP-7518 Aux Id: OTP-7112

- - -
- -
- -
Test_Server 3.2.2 - -
Improvements and New Features - - -

erlang:system_info/1 now accepts the - logical_processors, and debug_compiled - arguments. For more info see the, erlang(3) - documentation.

The scale factor returned by - test_server:timetrap_scale_factor/0 is now also - effected if the emulator uses a larger amount of - scheduler threads than the amount of logical processors - on the system.

-

- Own Id: OTP-7175

- - -
- -
- -
Test_Server 3.2.1 - -
Improvements and New Features - - -

- When init_per_suite or end_per_suite terminated due to - runtime failure, test_server failed to format the line - number information properly and crashed. This error has - now been fixed.

-

- Own Id: OTP-7091

- - -
- -
- -
Test_Server 3.2.0 - -
Improvements and New Features - - -

- Test Server is a portable test server for automated - application testing. The server can run test suites on - local or remote targets and log progress and results to - HTML pages. The main purpose of Test Server is to act as - engine inside customized test tools. A callback interface - for such framework applications is provided.

-

- Own Id: OTP-6989

- - -
- -
- - - diff --git a/lib/test_server/doc/src/notes_history.xml b/lib/test_server/doc/src/notes_history.xml deleted file mode 100644 index ca7880d74f..0000000000 --- a/lib/test_server/doc/src/notes_history.xml +++ /dev/null @@ -1,113 +0,0 @@ - - - - -
- - 20062013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Release Notes History - - - - -
- -
- Test Server 3.1.1 - -
- Improvements and new features - - -

Added functions test_server:break/1 and - test_server:continue/0 for semiautomatic testing.

-

test_server:timetrap/1 can now also take - {hours,H} | {minutes,M | {seconds,S}.

-

Added function - test_server_ctrl:multiply_timetraps/1, - test_server_ctrl:add_case/3, - test_server_ctrl:add_cases/2/3.

-

Added test suite functions init_per_suite/1 and - end_per_suite/1.

-

fin_per_testcase/2 is changed to - end_per_testcase/2. fin_per_testcase is kept - for backwards compatibility.

-

Added support for writing own test server frameworks. - Callback functions init_tc/1, end_tc/3, - get_suite/2, report/2, warn/1.

- - -
-
- -
- Test Server 3.1 - -
- Improvements and New Features - - -

Added the options cover and cover_details - to ts:run. When one of these options is used, - the tested application will be cover compiled - before the test is run. The cover compiled code will also - be loaded on all slave or peer nodes started with - test_server:start_node. When the test is completed - coverage data from all nodes is collected and merged, and - presented in the coverage log to which there will be a link - from the test suite result page (i.e. the one with the - heading "Test suite ... results").

-

The cover_details option will do - cover:analyse_to_file for each cover compiled module, - while the cover option only will produce a list of - modules and the number of covered/uncovered lines in each - module.

-

To make it possible to run all test from a script (like in - the OTP daily builds), the following is added: - ts:run([all_tests | Options]).

-

This means that e.g. the following is possible: - erl -s ts run all_tests batch cover.

-

Note that it is also possible to run tests with cover even - if you don't use ts. - See test_server_ctrl:cover/2/3.

-

Own Id: OTP-4703

- - -

Removed module ts_save.erl and function - ts:save/0/1(incompatible).

-

Added config variable ipv6_hosts to - ts:install/1 and test spec file.

-

No longer removing duplicates of test cases from test spec - (incompatible).

-

Added function test_server:run_on_shielded_node/2.

-

Creation of html files for test suite source does no longer - crash if suite contains more than 9999 lines of code.

-

Added functionality for cross cover compilation, - i.e. collection of cover data from all tests.

-

Multiplying timetrap times with 10 when running with cover.

-

Added ts:r/3 for running tests with cover.

-

*** POTENTIAL INCOMPATIBILITY ***

-

Own Id: OTP-5040

- - -
-
- - diff --git a/lib/test_server/doc/src/part.xml b/lib/test_server/doc/src/part.xml deleted file mode 100644 index 685ed16a94..0000000000 --- a/lib/test_server/doc/src/part.xml +++ /dev/null @@ -1,46 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server User's Guide - - - 2002-07-11 - -
- -

Test Server is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.

- - - - - - - - - diff --git a/lib/test_server/doc/src/part_notes.xml b/lib/test_server/doc/src/part_notes.xml deleted file mode 100644 index 8cb9b6c591..0000000000 --- a/lib/test_server/doc/src/part_notes.xml +++ /dev/null @@ -1,41 +0,0 @@ - - - - -
- - 20042013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Release Notes - - - - -
- -

The Test Server is a portable test server for - application testing. The test server can run automatic test suites - and log progress and results to HTML - pages. It also provides some support for test suite authors.

-

For information about older versions, see - Release Notes History.

- - - - diff --git a/lib/test_server/doc/src/part_notes_history.xml b/lib/test_server/doc/src/part_notes_history.xml deleted file mode 100644 index 468b5aa8ba..0000000000 --- a/lib/test_server/doc/src/part_notes_history.xml +++ /dev/null @@ -1,39 +0,0 @@ - - - - -
- - 20062013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Release Notes History - - - - -
- -

The Test Server is a portable test server for - application testing. The test server can run automatic test suites - and log progress and results to HTML - pages. It also provides some support for test suite authors.

- - - - diff --git a/lib/test_server/doc/src/ref_man.xml b/lib/test_server/doc/src/ref_man.xml deleted file mode 100644 index 1b06d9750b..0000000000 --- a/lib/test_server/doc/src/ref_man.xml +++ /dev/null @@ -1,44 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Reference Manual - - - - - ref_man.xml -
- -

Test Server is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.

- - - - - - diff --git a/lib/test_server/doc/src/run_test_chapter.xml b/lib/test_server/doc/src/run_test_chapter.xml deleted file mode 100644 index cb5b29c993..0000000000 --- a/lib/test_server/doc/src/run_test_chapter.xml +++ /dev/null @@ -1,50 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Running Test Suites - Siri Hansen - - - - run_test_chapter.xml -
- -
- Using the test server controller -

The test server controller provides a low level interface to - all the Test Server functionality. It is possible to use this - interface directly, but it is recommended to use a framework - such as Common Test instead. If no existing framework - suits your needs, you could of course build your own - on top of the test server controller. Some information about how - to do this can be found in the section named "Writing you own - test server framework" in the Test Server User's Guide. -

-

For information about using the controller directly, please see - all available functions in the reference manual for - test_server_ctrl. -

-
- - diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml deleted file mode 100644 index 96ff6de3ba..0000000000 --- a/lib/test_server/doc/src/test_server.xml +++ /dev/null @@ -1,853 +0,0 @@ - - - - -
- - 2007 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - test_server - Siri Hansen - - - - - - - test_server_ref.sgml -
- test_server - This module provides support for test suite authors. - -

The test_server module aids the test suite author by providing - various support functions. The supported functionality includes: -

- - Logging and timestamping - - Capturing output to stdout - - Retrieving and flushing the message queue of a process - - Watchdog timers, process sleep, time measurement and unit - conversion - - Private scratch directory for all test suites - - Start and stop of slave- or peer nodes - -

For more information on how to write test cases and for - examples, please see the Test Server User's Guide. -

- - -
- TEST SUITE SUPPORT FUNCTIONS -

The following functions are supposed to be used inside a test - suite. -

-
- - - os_type() -> OSType - Returns the OS type of the target node - - OSType = term() - This is the same as returned from os:type/0 - - -

This function is equivalent to os:type/0. It is kept - for backwards compatibility.

- - - - fail() - fail(Reason) - Makes the test case fail. - - Reason = term() - The reason why the test case failed. - - -

This will make the test suite fail with a given reason, or - with suite_failed if no reason was given. Use this - function if you want to terminate a test case, as this will - make it easier to read the log- and HTML files. Reason - will appear in the comment field in the HTML log.

- - - - timetrap(Timout) -> Handle - - - Timeout = integer() | {hours,H} | {minutes,M} | {seconds,S} - H = M = S = integer() - Pid = pid() - The process that is to be timetrapped (self()by default) - - -

Sets up a time trap for the current process. An expired - timetrap kills the process with reason - timetrap_timeout. The returned handle is to be given - as argument to timetrap_cancel before the timetrap - expires. If Timeout is an integer, it is expected to - be milliseconds.

- -

If the current process is trapping exits, it will not be killed - by the exit signal with reason timetrap_timeout. - If this happens, the process will be sent an exit signal - with reason kill 10 seconds later which will kill the - process. Information about the timetrap timeout will in - this case not be found in the test logs. However, the - error_logger will be sent a warning.

- - - - - timetrap_cancel(Handle) -> ok - Cancels a timetrap. - - Handle = term() - Handle returned from timetrap - - -

This function cancels a timetrap. This must be done before - the timetrap expires.

- - - - timetrap_scale_factor() -> ScaleFactor - Returns the scale factor for timeouts. - - ScaleFactor = integer() - - -

This function returns the scale factor by which all timetraps - are scaled. It is normally 1, but can be greater than 1 if - the test_server is running cover, using a larger amount of - scheduler threads than the amount of logical processors on the - system, running under purify, valgrind or in a debug-compiled - emulator. The scale factor can be used if you need to scale you - own timeouts in test cases with same factor as the test_server - uses.

- - - - sleep(MSecs) -> ok - Suspens the calling task for a specified time. - - MSecs = integer() | float() | infinity - The number of milliseconds to sleep - - -

This function suspends the calling process for at least the - supplied number of milliseconds. There are two major reasons - why you should use this function instead of - timer:sleep, the first being that the module - timer may be unavailable at the time the test suite is - run, and the second that it also accepts floating point - numbers.

- - - - adjusted_sleep(MSecs) -> ok - Suspens the calling task for a specified time. - - MSecs = integer() | float() | infinity - The default number of milliseconds to sleep - - -

This function suspends the calling process for at least the - supplied number of milliseconds. The function behaves the same - way as test_server:sleep/1, only MSecs - will be multiplied by the 'multiply_timetraps' value, if set, - and also automatically scaled up if 'scale_timetraps' is set - to true (which it is by default).

- - - - hours(N) -> MSecs - minutes(N) -> MSecs - seconds(N) -> MSecs - - - N = integer() - Value to convert to milliseconds. - - -

Theese functions convert N number of hours, minutes - or seconds into milliseconds. -

-

Use this function when you want to - test_server:sleep/1 for a number of seconds, minutes or - hours(!).

- - - - format(Format) -> ok - format(Format, Args) - format(Pri, Format) - format(Pri, Format, Args) - - - Format = string() - Format as described for io_:format. - Args = list() - List of arguments to format. - - -

Formats output just like io:format but sends the - formatted string to a logfile. If the urgency value, - Pri, is lower than some threshold value, it will also - be written to the test person's console. Default urgency is - 50, default threshold for display on the console is 1. -

-

Typically, the test person don't want to see everything a - test suite outputs, but is merely interested in if the test - cases succeeded or not, which the test server tells him. If he - would like to see more, he could manually change the threshold - values by using the test_server_ctrl:set_levels/3 - function.

- - - - capture_start() -> ok - capture_stop() -> ok - capture_get() -> list() - Captures all output to stdout for a process. - -

These functions makes it possible to capture all output to - stdout from a process started by the test suite. The list of - characters captured can be purged by using capture_get.

- - - - messages_get() -> list() - Empty the message queue. - -

This function will empty and return all the messages - currently in the calling process' message queue.

- - - - timecall(M, F, A) -> {Time, Value} - Measures the time needed to call a function. - - M = atom() - The name of the module where the function resides. - F = atom() - The name of the function to call in the module. - A = list() - The arguments to supply the called function. - Time = integer() - The number of seconds it took to call the function. - Value = term() - Value returned from the called function. - - -

This function measures the time (in seconds) it takes to - call a certain function. The function call is not - caught within a catch.

- - - - do_times(N, M, F, A) -> ok - do_times(N, Fun) - Calls MFA or Fun N times. - - N = integer() - Number of times to call MFA. - M = atom() - Module name where the function resides. - F = atom() - Function name to call. - A = list() - Arguments to M:F. - - -

Calls MFA or Fun N times. Useful for extensive testing of a - sensitive function.

- - - - m_out_of_n(M, N, Fun) -> ok | exit({m_out_of_n_failed, {R,left_to_do}} - Fault tolerant do_times. - - N = integer() - Number of times to call the Fun. - M = integer() - Number of times to require a successful return. - - -

Repeatedly evaluates the given function until it succeeds - (doesn't crash) M times. If, after N times, M successful - attempts have not been accomplished, the process crashes with - reason {m_out_of_n_failed, {R,left_to_do}}, where R indicates - how many cases that was still to be successfully completed. -

-

For example: -

-

m_out_of_n(1,4,fun() -> tricky_test_case() end)

-Tries to run tricky_test_case() up to 4 times, and is - happy if it succeeds once. -

-

m_out_of_n(7,8,fun() -> clock_sanity_check() end)

-Tries running clock_sanity_check() up to 8 times,and - allows the function to fail once. This might be useful if - clock_sanity_check/0 is known to fail if the clock crosses an - hour boundary during the test (and the up to 8 test runs could - never cross 2 boundaries)

- - - - call_crash(M, F, A) -> Result - call_crash(Time, M, F, A) -> Result - call_crash(Time, Crash, M, F, A) -> Result - Calls MFA and succeeds if it crashes. - - Result = ok | exit(call_crash_timeout) | exit({wrong_crash_reason, Reason}) - Crash = term() - Crash return from the function. - Time = integer() - Timeout in milliseconds. - M = atom() - Module name where the function resides. - F = atom() - Function name to call. - A = list() - Arguments to M:F. - - -

Spawns a new process that calls MFA. The call is considered - successful if the call crashes with the gives reason - (Crash) or any reason if not specified. The call must - terminate within the given time (default infinity), or - it is considered a failure.

- - - - temp_name(Stem) -> Name - Returns a unique filename. - - Stem = string() - - -

Returns a unique filename starting with Stem with - enough extra characters appended to make up a unique - filename. The filename returned is guaranteed not to exist in - the filesystem at the time of the call.

- - - - break(Comment) -> ok - Cancel all timetraps and wait for call to continue/0. - - Comment = string() - - -

Comment is a string which will be written in - the shell, e.g. explaining what to do.

-

This function will cancel all timetraps and pause the - execution of the test case until the user executes the - continue/0 function. It gives the user the opportunity - to interact with the erlang node running the tests, e.g. for - debugging purposes or for manually executing a part of the - test case.

-

When the break/1 function is called, the shell will - look something like this:

- - - - "Here is a comment, it could e.g. instruct to pull out a card" - - - ----------------------------- - - Continue with --> test_server:continue(). ]]> -

The user can now interact with the erlang node, and when - ready call test_server:continue().

-

Note that this function can not be used if the test is - executed with ts:run/0/1/2/3/4 in batch mode.

- - - - continue() -> ok - Continue after break/1. - -

This function must be called in order to continue after a - test case has called break/1.

- - - - run_on_shielded_node(Fun, CArgs) -> term() - Execute a function a shielded node. - - Fun = function() (arity 0) - Function to execute on the shielded node. - CArg = string() - Extra command line arguments to use when starting the shielded node. - - -

Fun is executed in a process on a temporarily created - hidden node with a proxy for communication with the test server - node. The node is called a shielded node (should have been called - a shield node). If Fun is successfully executed, the result - is returned. A peer node (see start_node/3) started from - the shielded node will be shielded from test server node, i.e. - they will not be aware of each other. This is useful when you want - to start nodes from earlier OTP releases than the OTP release of - the test server node.

-

Nodes from an earlier OTP release can normally not be started - if the test server hasn't been started in compatibility mode - (see the +R flag in the erl(1) documentation) of - an earlier release. If a shielded node is started in compatibility - mode of an earlier OTP release than the OTP release of the test - server node, the shielded node can start nodes of an earlier OTP - release.

- -

You must make sure that nodes started by the shielded - node never communicate directly with the test server node.

- - -

Slave nodes always communicate with the test server node; - therefore, never start slave nodes from the - shielded node, always start peer nodes.

- - - - - start_node(Name, Type, Options) -> {ok, Node} | {error, Reason} - Start a node. - - Name = atom() | string() - Name of the slavenode to start (as given to -sname or -name) - Type = slave | peer - The type of node to start. - Options = [{atom(), term()] - Tuplelist of options - - -

This functions starts a node, possibly on a remote machine, - and guarantees cross architecture transparency. Type is set to - either slave or peer. -

-

slave means that the new node will have a master, - i.e. the slave node will terminate if the master terminates, - TTY output produced on the slave will be sent back to the - master node and file I/O is done via the master. The master is - normally the target node unless the target is itself a slave. -

-

peer means that the new node is an independent node - with no master. -

-

Options is a tuplelist which can contain one or more - of -

- - {remote, true} - Start the node on a remote host. If not specified, the - node will be started on the local host. Test cases that - require a remote host will fail with a reasonable comment if - no remote hosts are available at the time they are run. - - {args, Arguments} - Arguments passed directly to the node. This is - typically a string appended to the command line. - - {wait, false} - Don't wait until the node is up. By default, this - function does not return until the node is up and running, - but this option makes it return as soon as the node start - command is given.. -

-Only valid for peer nodes - - {fail_on_error, false} - Returns {error, Reason} rather than failing the - test case. -

-Only valid for peer nodes. Note that slave nodes always - act as if they had fail_on_error=false - {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList when - starting nodes, instead of the same emulator as the test - server is running. ReleaseList is a list of specifiers, - where a specifier is either {release, Rel}, {prog, Prog}, or - 'this'. Rel is either the name of a release, e.g., "r12b_patched" - or 'latest'. 'this' means using the same emulator as the test - server. Prog is the name of an emulator executable. If the - list has more than one element, one of them is picked - randomly. (Only works on Solaris and Linux, and the test server - gives warnings when it notices that nodes are not of the same - version as itself.) -

-

- - When specifying this option to run a previous release, use - is_release_available/1 function to test if the given - release is available and skip the test case if not. -

-

- - In order to avoid compatibility problems (may not appear right - away), use a shielded node (see run_on_shielded_node/2) - when starting nodes from different OTP releases than the test - server. - - {cleanup, false} - Tells the test server not to kill this node if it is - still alive after the test case is completed. This is useful - if the same node is to be used by a group of test cases. - - {env, Env} - Env should be a list of tuples {Name, Val}, - where Name is the name of an environment variable, and - Val is the value it is to have in the started node. - Both Name and Val must be strings. The one - exception is Val being the atom false (in - analogy with os:getenv/1), which removes the - environment variable. Only valid for peer nodes. Not - available on VxWorks. - {start_cover, false} - By default the test server will start cover on all nodes - when the test is run with code coverage analysis. To make - sure cover is not started on a new node, set this option to - false. This can be necessary if the connection to - the node at some point will be broken but the node is - expected to stay alive. The reason is that a remote cover - node can not continue to run without its main node. Another - solution would be to explicitly stop cover on the node - before breaking the connection, but in some situations (if - old code resides in one or more processes) this is not - possible. - - - - - stop_node(NodeName) -> bool() - Stops a node - - NodeName = term() - Name of the node to stop - - -

This functions stops a node previously started with - start_node/3. Use this function to stop any node you - start, or the test server will produce a warning message in - the test logs, and kill the nodes automatically unless it was - started with the {cleanup, false} option.

- - - - is_commercial() -> bool() - Tests whether the emulator is commercially supported - -

This function test whether the emulator is commercially supported - emulator. The tests for a commercially supported emulator could be more - stringent (for instance, a commercial release should always contain - documentation for all applications).

- - - - - is_release_available(Release) -> bool() - Tests whether a release is available - - Release = string() | atom() - Release to test for - - -

This function test whether the release given by - Release (for instance, "r12b_patched") is available - on the computer that the test_server controller is running on. - Typically, you should skip the test case if not.

-

Caution: This function may not be called from the suite - clause of a test case, as the test_server will deadlock.

- - - - is_native(Mod) -> bool() - Checks whether the module is natively compiled or not - - Mod = atom() - A module name - - -

Checks whether the module is natively compiled or not

- - - - app_test(App) -> ok | test_server:fail() - app_test(App,Mode) - Checks an applications .app file for obvious errors - - App = term() - The name of the application to test - Mode = pedantic | tolerant - Default is pedantic - - -

Checks an applications .app file for obvious errors. - The following is checked: -

- - required fields - - that all modules specified actually exists - - that all requires applications exists - - that no module included in the application has export_all - - that all modules in the ebin/ dir is included (If - Mode==tolerant this only produces a warning, as all - modules does not have to be included) - - - - - appup_test(App) -> ok | test_server:fail() - Checks an applications .appup file for obvious errors - - App = term() - The name of the application to test - - -

Checks an applications .appup file for obvious errors. - The following is checked: -

- - syntax - - that .app file version and .appup file version match - - for non-library applications: validity of high-level upgrade - instructions, specifying no instructions is explicitly allowed - (in this case the application is not upgradeable) - for library applications: that there is exactly one wildcard - regexp clause restarting the application when upgrading or - downgrading from any version - - - - - comment(Comment) -> ok - Print a comment on the HTML result page - - Comment = string() - - -

The given String will occur in the comment field of the - table on the HTML result page. If called several times, only - the last comment is printed. comment/1 is also overwritten by - the return value {comment,Comment} from a test case or by - fail/1 (which prints Reason as a comment).

- - - - -
- TEST SUITE EXPORTS -

The following functions must be exported from a test suite - module. -

-
- - - all(suite) -> TestSpec | {skip, Comment} - Returns the module's test specification - - TestSpec = list() - Comment = string() - This comment will be printed on the HTML result page - - -

This function must return the test specification for the - test suite module. The syntax of a test specification is - described in the Test Server User's Guide.

- - - - init_per_suite(Config0) -> Config1 | {skip, Comment} - Test suite initiation - - Config0 = Config1 = [tuple()] - Comment = string() - Describes why the suite is skipped - - -

This function is called before all other test cases in the - suite. Config is the configuration which can be modified - here. Whatever is returned from this function is given as - Config to the test cases. -

-

If this function fails, all test cases in the suite will be - skipped.

- - - - end_per_suite(Config) -> void() - Test suite finalization - - Config = [tuple()] - - -

This function is called after the last test case in the - suite, and can be used to clean up whatever the test cases - have done. The return value is ignored.

- - - - init_per_testcase(Case, Config0) -> Config1 | {skip, Comment} - Test case initiation - - Case = atom() - Config0 = Config1 = [tuple()] - Comment = string() - Describes why the test case is skipped - - -

This function is called before each test case. The - Case argument is the name of the test case, and - Config is the configuration which can be modified - here. Whatever is returned from this function is given as - Config to the test case.

- - - - end_per_testcase(Case, Config) -> void() - Test case finalization - - Case = atom() - Config = [tuple()] - - -

This function is called after each test case, and can be - used to clean up whatever the test case has done. The return - value is ignored.

- - - - Case(doc) -> [Decription] - Case(suite) -> [] | TestSpec | {skip, Comment} - Case(Config) -> {skip, Comment} | {comment, Comment} | Ok - A test case - - Description = string() - Short description of the test case - TestSpec = list() - Comment = string() - This comment will be printed on the HTML result page - Ok = term() - Config = [tuple()] - Elements from the Config parameter can be read with the ?config macro, see section about test suite support macros - - -

The documentation clause (argument doc) can - be used for automatic generation of test documentation or test - descriptions. -

-

The specification clause (argument spec) - shall return an empty list, the test specification for the - test case or {skip,Comment}. The syntax of a test - specification is described in the Test Server User's Guide. -

-

The execution clause (argument Config) is - only called if the specification clause returns an empty list. - The execution clause is the real test case. Here you must call - the functions you want to test, and do whatever you need to - check the result. If something fails, make sure the process - crashes or call test_server:fail/0/1 (which also will - cause the process to crash). -

-

You can return {skip,Comment} if you decide not to - run the test case after all, e.g. if it is not applicable on - this platform. -

-

You can return {comment,Comment} if you wish to - print some information in the 'Comment' field on the HTML - result page. -

-

If the execution clause returns anything else, it is - considered a success, unless it is {'EXIT',Reason} or - {'EXIT',Pid,Reason} which can't be distinguished from a - crash, and thus will be considered a failure. -

-

A conf test case is a group of test cases with an - init and a cleanup function. The init and cleanup functions - are also test cases, but they have special rules:

- - They do not need a specification clause. - They must always have the execution clause. - They must return the Config parameter, a modified - version of it or {skip,Comment} from the execution clause. - The cleanup function may also return a tuple - {return_group_result,Status}, which is used to return the - status of the conf case to Test Server and/or to a conf case on a - higher level. (Status = ok | skipped | failed). - init_per_testcase and end_per_testcase are - not called before and after these functions. - - - - - - -
- TEST SUITE SUPPORT MACROS -

There are some macros defined in the test_server.hrl - that are quite useful for test suite programmers: -

-

The config macro, is used to - retrieve information from the Config variable sent to all - test cases. It is used with two arguments, where the first is the - name of the configuration variable you wish to retrieve, and the - second is the Config variable supplied to the test case - from the test server. -

-

Possible configuration variables include:

- - data_dir - Data file directory. - priv_dir - Scratch file directory. - nodes - Nodes specified in the spec file - nodenames - Generated nodenames. - Whatever added by conf test cases or - init_per_testcase/2 - -

Examples of the config macro can be seen in the Examples chapter - in the user's guide.

-

The line and line_trace macros are deprecated, see - below.

-
- -
- TEST SUITE LINE NUMBERS -

In the past, ERTS did not produce line numbers when generating - stacktraces, test_server was thus unable to provide them when reporting - test failures. It had instead two different mecanisms to do it: either by - using the line macro or by using the test_server_line parse - transform. Both are deprecated and should not be used in new tests - anymore.

-
- - diff --git a/lib/test_server/doc/src/test_server_app.xml b/lib/test_server/doc/src/test_server_app.xml deleted file mode 100644 index 4830916561..0000000000 --- a/lib/test_server/doc/src/test_server_app.xml +++ /dev/null @@ -1,75 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Server Application - Siri Hansen - Peter Andersson - - - - 2002-07-12 - PA1 - test_server_app.xml -
- test_server - Test Server for manual or automatic testing of Erlang code - -

Test Server is a portable test server for - automated application testing. The server can run test suites - and log progress and results to HTML - pages. The main purpose of Test Server is to act as engine - inside customized test tools. A callback interface for - such framework applications is provided.

-

In brief the test server supports:

- - Running multiple, concurrent test suites - Test suites may contain other test suites, in a tree fashion - Logging of the events in a test suite, on both suite and case levels - HTML presentation of test suite results - HTML presentation of test suite code - Support for test suite authors, e.g. start/stop slave nodes - Call trace on target and slave nodes - -

For information about how to write test cases and test suites, - please see the Test Server User's Guide and the reference - manual for the test_server module. -

-

Common Test is an existing test tool application based on the - OTP Test Server. Please read the Common Test User's Guide for more information. -

- - -
- Configuration -

There are currently no configuration parameters available for - this application. -

-
- -
- SEE ALSO -

-
- - diff --git a/lib/test_server/doc/src/test_server_ctrl.xml b/lib/test_server/doc/src/test_server_ctrl.xml deleted file mode 100644 index 2762997ece..0000000000 --- a/lib/test_server/doc/src/test_server_ctrl.xml +++ /dev/null @@ -1,844 +0,0 @@ - - - - -
- - 2007 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - The Test Server Controller - Siri Hansen, Peter Andersson - - - - - - - test_server_ctrl_ref.sgml -
- test_server_ctrl - This module provides a low level interface to the Test Server. - -

The test_server_ctrl module provides a low level - interface to the Test Server. This interface is normally - not used directly by the tester, but through a framework built - on top of test_server_ctrl. -

-

Common Test is such a framework, well suited for automated - black box testing of target systems of any kind (not necessarily - implemented in Erlang). Common Test is also a very useful tool for - white box testing Erlang programs and OTP applications. - Please see the Common Test User's Guide and reference manual for - more information. -

-

If you want to write your own framework, some more information - can be found in the chapter "Writing your own test server - framework" in the Test Server User's Guide. Details about the - interface provided by test_server_ctrl follows below. -

- - - - start() -> Result - Starts the test server. - - Result = ok | {error, {already_started, pid()} - - -

This function starts the test server.

- - - - stop() -> ok - Stops the test server immediately. - -

This stops the test server and - all its activity. The running test suite (if any) will be - halted.

- - - - add_dir(Name, Dir) -> ok - add_dir(Name, Dir, Pattern) -> ok - add_dir(Name, [Dir|Dirs]) -> ok - add_dir(Name, [Dir|Dirs], Pattern) -> ok - Add a directory to the job queue. - - Name = term() - The jobname for this directory. - Dir = term() - The directory to scan for test suites. - Dirs = [term()] - List of directories to scan for test suites. - Pattern = term() - Suite match pattern. Directories will be scanned for Pattern_SUITE.erl files. - - -

Puts a collection of suites matching (*_SUITE) in given - directories into the job queue. Name is an arbitrary - name for the job, it can be any erlang term. If Pattern - is given, only modules matching Pattern* will be added.

- - - - add_module(Mod) -> ok - add_module(Name, [Mod|Mods]) -> ok - Add a module to the job queue with or without a given name. - - Mod = atom() - Mods = [atom()] - The name(s) of the module(s) to add. - Name = term() - Name for the job. - - -

This function adds a module or a list of modules, to the - test servers job queue. Name may be any Erlang - term. When Name is not given, the job gets the name of - the module.

- - - - add_case(Mod, Case) -> ok - Adds one test case to the job queue. - - Mod = atom() - Name of the module the test case is in. - Case = atom() - Function name of the test case to add. - - -

This function will add one test case to the job queue. The - job will be given the module's name.

- - - - add_case(Name, Mod, Case) -> ok - Equivalent to add_case/2, but with specified name. - - Name = string() - Name to use for the test job. - - -

Equivalent to add_case/2, but the test job will get - the specified name.

- - - - add_cases(Mod, Cases) -> ok - Adds a list of test cases to the job queue. - - Mod = atom() - Name of the module the test case is in. - Cases = [Case] - Case = atom() - Function names of the test cases to add. - - -

This function will add one or more test cases to the job - queue. The job will be given the module's name.

- - - - add_cases(Name, Mod, Cases) -> ok - Equivalent to add_cases/2, but with specified name. - - Name = string() - Name to use for the test job. - - -

Equivalent to add_cases/2, but the test job will get - the specified name.

- - - - add_spec(TestSpecFile) -> ok | {error, nofile} - Adds a test specification file to the job queue. - - TestSpecFile = string() - Name of the test specification file - - -

This function will add the content of the given test - specification file to the job queue. The job will be given the - name of the test specification file, e.g. if the file is - called test.spec, the job will be called test. -

-

See the reference manual for the test server application - for details about the test specification file.

- - - - add_dir_with_skip(Name, [Dir|Dirs], Skip) -> ok - add_dir_with_skip(Name, [Dir|Dirs], Pattern, Skip) -> ok - add_module_with_skip(Mod, Skip) -> ok - add_module_with_skip(Name, [Mod|Mods], Skip) -> ok - add_case_with_skip(Mod, Case, Skip) -> ok - add_case_with_skip(Name, Mod, Case, Skip) -> ok - add_cases_with_skip(Mod, Cases, Skip) -> ok - add_cases_with_skip(Name, Mod, Cases, Skip) -> ok - Same purpose as functions listed above, but with extra Skip argument. - - Skip = [SkipItem] - List of items to be skipped from the test. - SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment} - Mod = atom() - Test suite name. - Comment = string() - Reason why suite or case is being skipped. - Cases = [Case] - Case = atom() - Name of test case function. - - -

These functions add test jobs just like the add_dir, add_module, - add_case and add_cases functions above, but carry an additional - argument, Skip. Skip is a list of items that should be skipped - in the current test run. Test job items that occur in the Skip - list will be logged as SKIPPED with the associated Comment.

- - - - add_tests_with_skip(Name, Tests, Skip) -> ok - Adds different types of jobs to the run queue. - - Name = term() - The jobname for this directory. - Tests = [TestItem] - List of jobs to add to the run queue. - TestItem = {Dir,all,all} | {Dir,Mods,all} | {Dir,Mod,Cases} - Dir = term() - The directory to scan for test suites. - Mods = [Mod] - Mod = atom() - Test suite name. - Cases = [Case] - Case = atom() - Name of test case function. - Skip = [SkipItem] - List of items to be skipped from the test. - SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment} - Comment = string() - Reason why suite or case is being skipped. - - -

This function adds various test jobs to the test_server_ctrl - job queue. These jobs can be of different type (all or specific suites - in one directory, all or specific cases in one suite, etc). It is also - possible to get particular items skipped by passing them along in the - Skip list (see the add_*_with_skip functions above).

- - - - abort_current_testcase(Reason) -> ok | {error,no_testcase_running} - Aborts the test case currently executing. - - Reason = term() - The reason for stopping the test case, which will be printed in the log. - - -

When calling this function, the currently executing test case will be aborted. - It is the user's responsibility to know for sure which test case is currently - executing. The function is therefore only safe to call from a function which - has been called (or synchronously invoked) by the test case.

- - - - set_levels(Console, Major, Minor) -> ok - Sets the levels of I/O. - - Console = integer() - Level for I/O to be sent to console. - Major = integer() - Level for I/O to be sent to the major logfile. - Minor = integer() - Level for I/O to be sent to the minor logfile. - - -

Determines where I/O from test suites/test server will - go. All text output from test suites and the test server is - tagged with a priority value which ranges from 0 to 100, 100 - being the most detailed. (see the section about log files in - the user's guide). Output from the test cases (using - io:format/2) has a detail level of 50. Depending on the - levels set by this function, this I/O may be sent to the - console, the major log file (for the whole test suite) or to - the minor logfile (separate for each test case). -

-

All output with detail level:

- - Less than or equal to Console is displayed on - the screen (default 1) - - Less than or equal to Major is logged in the - major log file (default 19) - - Greater than or equal to Minor is logged in the - minor log files (default 10) - - -

To view the currently set thresholds, use the - get_levels/0 function.

- - - - get_levels() -> {Console, Major, Minor} - Returns the current levels. - -

Returns the current levels. See set_levels/3 for - types.

- - - - jobs() -> JobQueue - Returns the job queue. - - JobQueue = [{list(), pid()}] - - -

This function will return all the jobs currently in the job - queue.

- - - - multiply_timetraps(N) -> ok - All timetraps started after this will be multiplied by N. - - N = integer() | infinity - - -

This function should be called before a test is started - which requires extended timetraps, e.g. if extensive tracing - is used. All timetraps started after this call will be - multiplied by N.

- - - - scale_timetraps(Bool) -> ok - . - - Bool = true | false - - -

This function should be called before a test is started. - The parameter specifies if test_server should attempt - to automatically scale the timetrap value in order to compensate - for delays caused by e.g. the cover tool.

- - - - get_timetrap_parameters() -> {N,Bool} - Read the parameter values that affect timetraps. - - N = integer() | infinity - Bool = true | false - - -

This function may be called to read the values set by - multiply_timetraps/1 and scale_timetraps/1.

- - - - cover(Application,Analyse) -> ok - cover(CoverFile,Analyse) -> ok - cover(App,CoverFile,Analyse) -> ok - Informs the test_server controller that next test shall run with code coverage analysis. - - Application = atom() - OTP application to cover compile - CoverFile = string() - Name of file listing modules to exclude from or include in cover compilation. The filename must include full path to the file. - Analyse = details | overview - - -

This function informs the test_server controller that next - test shall run with code coverage analysis. All timetraps will - automatically be multiplied by 10 when cover i run. -

-

Application and CoverFile indicates what to - cover compile. If Application is given, the default is - that all modules in the ebin directory of the - application will be cover compiled. The ebin directory - is found by adding ebin to - code:lib_dir(Application). -

-

A CoverFile can have the following entries:

- -{exclude, all | ExcludeModuleList}. -{include, IncludeModuleList}. -{cross, CrossCoverInfo}. -

Note that each line must end with a full - stop. ExcludeModuleList and IncludeModuleList - are lists of atoms, where each atom is a module name. -

- -

CrossCoverInfo is used when collecting cover data - over multiple tests. Modules listed here are compiled, but - they will not be analysed when the test is finished. See - cross_cover_analyse/2 - for more information about the cross cover mechanism and the - format of CrossCoverInfo. -

-

If both an Application and a CoverFile is - given, all modules in the application are cover compiled, - except for the modules listed in ExcludeModuleList. The - modules in IncludeModuleList are also cover compiled. -

-

If a CoverFile is given, but no Application, - only the modules in IncludeModuleList are cover - compiled. -

-

Analyse indicates the detail level of the cover - analysis. If Analyse = details, each cover compiled - module will be analysed with - cover:analyse_to_file/1. If Analyse = overview - an overview of all cover compiled modules is created, listing - the number of covered and not covered lines for each module. -

-

If the test following this call starts any slave or peer - nodes with test_server:start_node/3, the same cover - compiled code will be loaded on all nodes. If the loading - fails, e.g. if the node runs an old version of OTP, the node - will simply not be a part of the coverage analysis. Note that - slave or peer nodes must be stopped with - test_server:stop_node/1 for the node to be part of the - coverage analysis, else the test server will not be able to - fetch coverage data from the node. -

-

When the test is finished, the coverage analysis is - automatically completed, logs are created and the cover - compiled modules are unloaded. If another test is to be run - with coverage analysis, test_server_ctrl:cover/2/3 must - be called again. -

- - - - cross_cover_analyse(Level, Tests) -> ok - Analyse cover data collected from multiple tests - - Level = details | overview - Tests = [{Tag,LogDir}] - Tag = atom() - Test identifier. - LogDir = string() - Log directory for the test identified by Tag. This - can either be the run.<timestamp> directory or - the parent directory of this (in which case the latest - run.<timestamp> directory is chosen. - - -

Analyse cover data collected from multiple tests. The modules - analysed are the ones listed in cross statements in - the cover files. These are modules that are heavily used by - other tests than the one where they belong or are explicitly - tested. They should then be listed as cross modules in the - cover file for the test where they are used but do not - belong. Se example below.

-

This function should be run after all tests are completed, - and the result will be stored in a file called - cross_cover.html in the run.<timestamp> - directory of the test the modules belong to.

-

Note that the function can be executed on any node, and it - does not require test_server_ctrl to be started first.

-

The cross statement in the cover file must be like this:

- -{cross,[{Tag,Modules}]}. -

where Tag is the same as Tag in the - Tests parameter to this function and Modules is a - list of module names (atoms).

-

Example:

-

If the module m1 belongs to system s1 but is - heavily used also in the tests for another system s2, - then the cover files for the two systems' tests could be like - this:

- -s1.cover: - {include,[m1]}. - -s2.cover: - {include,[....]}. % modules belonging to system s2 - {cross,[{s1,[m1]}]}. -

When the tests for both s1 and s2 are completed, run

- -test_server_ctrl:cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]) - - -

and the accumulated cover data for m1 will be written to - S1LogDir/[run.<timestamp>/]cross_cover.html.

-

Note that the m1 module will also be presented in the - normal coverage log for s1 (due to the include statement in - s1.cover), but that only includes the coverage achieved by the - s1 test itself.

-

The Tag in the cross statement in the cover file has - no other purpose than mapping the list of modules - ([m1] in the example above) to the correct log - directory where it should be included in the - cross_cover.html file (S1LogDir in the example - above). I.e. the value of Tag has no meaning, it - could be foo as well as s1 above, as long as - the same Tag is used in the cover file and in the - call to this function.

- - - - trc(TraceInfoFile) -> ok | {error, Reason} - Starts call trace on target and slave nodes - - TraceInfoFile = atom() | string() - Name of a file defining which functions to trace and how - - -

This function starts call trace on target and on slave or - peer nodes that are started or will be started by the test - suites. -

-

Timetraps are not extended automatically when tracing is - used. Use multiply_timetraps/1 if necessary. -

-

Note that the trace support in the test server is in a very - early stage of the implementation, and thus not yet as - powerful as one might wish for. -

-

The trace information file specified by the - TraceInfoFile argument is a text file containing one or - more of the following elements: -

- - {SetTP,Module,Pattern}. - {SetTP,Module,Function,Pattern}. - {SetTP,Module,Function,Arity,Pattern}. - ClearTP. - {ClearTP,Module}. - {ClearTP,Module,Function}. - {ClearTP,Module,Function,Arity}. - - - SetTP = tp | tpl - This is maps to the corresponding functions in the - ttb module in the observer - application. tp means set trace pattern on global - function calls. tpl means set trace pattern on local - and global function calls. - - ClearTP = ctp | ctpl | ctpg - This is maps to the corresponding functions in the - ttb module in the observer - application. ctp means clear trace pattern (i.e. turn - off) on global and local function calls. ctpl means - clear trace pattern on local function calls only and ctpg - means clear trace pattern on global function calls only. - - Module = atom() - The module to trace - - Function = atom() - The name of the function to trace - - Arity = integer() - The arity of the function to trace - - Pattern = [] | match_spec() - The trace pattern to set for the module or - function. For a description of the match_spec() syntax, - please turn to the User's guide for the runtime system - (erts). The chapter "Match Specification in Erlang" explains - the general match specification language. - - -

The trace result will be logged in a (binary) file called - NodeName-test_server in the current directory of the - test server controller node. The log must be formatted using - ttb:format/1/2. -

- - - - stop_trace() -> ok | {error, not_tracing} - Stops tracing on target and slave nodes. - -

This function stops tracing on target, and on slave or peer - nodes that are currently running. New slave or peer nodes will - no longer be traced after this.

- - - - -
- FUNCTIONS INVOKED FROM COMMAND LINE -

The following functions are supposed to be invoked from the - command line using the -s option when starting the erlang - node.

-
- - - run_test(CommandLine) -> ok - Runs the tests specified on the command line. - - CommandLine = FlagList - - -

This function is supposed to be invoked from the - commandline. It starts the test server, interprets the - argument supplied from the commandline, runs the tests - specified and when all tests are done, stops the test server - and returns to the Erlang prompt. -

-

The CommandLine argument is a list of command line - flags, typically ['KEY1', Value1, 'KEY2', Value2, ...]. - The valid command line flags are listed below. -

-

Under a UNIX command prompt, this function can be invoked like this: -

-erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt

-

Or make an alias (this is for unix/tcsh)

-alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'

-

And then use it like this

-erl_test KEY1 Value1 KEY2 Value2 ...

-

-

The valid command line flags are

- - DIR dir - Adds all test modules in the directory dir to - the job queue. - - MODULE mod - Adds the module mod to the job queue. - - CASE mod case - Adds the case case in module mod to the - job queue. - - SPEC spec - Runs the test specification file spec. - - SKIPMOD mod - Skips all test cases in the module mod - SKIPCASE mod case - Skips the test case case in module mod. - - NAME name - Names the test suite to something else than the - default name. This does not apply to SPEC which keeps - its names. - - COVER app cover_file analyse - Indicates that the test should be run with cover - analysis. app, cover_file and analyse - corresponds to the parameters to - test_server_ctrl:cover/3. If no cover file is used, - the atom none should be given. - - TRACE traceinfofile - Specifies a trace information file. When this option - is given, call tracing is started on the target node and all - slave or peer nodes that are started. The trace information - file specifies which modules and functions to trace. See the - function trc/1 above for more information about the - syntax of this file. - - - - - - -
- FRAMEWORK CALLBACK FUNCTIONS -

A test server framework can be defined by setting the - environment variable TEST_SERVER_FRAMEWORK to a module - name. This module will then be framework callback module, and it - must export the following function:

-
- - - get_suite(Mod,Func) -> TestCaseList - Get subcases. - - Mod = atom() - Test suite name. - Func = atom() - Name of test case. - TestCaseList = [SubCase] - List of test cases. - SubCase = atom() - Name of a case. - - -

This function is called before a test case is started. The - purpose is to retrieve a list of subcases. The default - behaviour of this function should be to call - Mod:Func(suite) and return the result from this call.

- - - - init_tc(Mod,Func,Args0) -> {ok,Args1} | {skip,ReasonToSkip} | {auto_skip,ReasonToSkip} | {fail,ReasonToFail} - Preparation for a test case or configuration function. - - Mod = atom() - Test suite name. - Func = atom() - Name of test case or configuration function. - Args0 = Args1 = [tuple()] - Normally Args = [Config] - ReasonToSkip = term() - Reason to skip the test case or configuration function. - ReasonToFail = term() - Reason to fail the test case or configuration function. - - -

This function is called before a test case or configuration - function starts. It is called on the process executing the function - Mod:Func. Typical use of this function can be to alter - the input parameters to the test case function (Args) or - to set properties for the executing process.

-

By returning {skip,Reason}, Func gets skipped. - Func also gets skipped if {auto_skip,Reason} is returned, - but then gets an auto skipped status (rather than user skipped).

-

To fail Func immediately instead of executing it, return - {fail,ReasonToFail}.

- - - - end_tc(Mod,Func,Status) -> ok | {fail,ReasonToFail} - Cleanup after a test case or configuration function. - - Mod = atom() - Test suite name. - Func = atom() - Name of test case or configuration function. - Status = {Result,Args} | {TCPid,Result,Args} - The status of the test case or configuration function. - ReasonToFail = term() - Reason to fail the test case or configuration function. - Result = ok | Skip | Fail - The final result of the test case or configuration function. - TCPid = pid() - Pid of the process executing Func - Skip = {skip,SkipReason} - SkipReason = term() | {failed,{Mod,init_per_testcase,term()}} - Reason why the function was skipped. - Fail = {error,term()} | {'EXIT',term()} | {timetrap_timeout,integer()} | - {testcase_aborted,term()} | testcase_aborted_or_killed | - {failed,term()} | {failed,{Mod,end_per_testcase,term()}} - Reason why the function failed. - Args = [tuple()] - Normally Args = [Config] - - -

This function is called when a test case, or a configuration function, - is finished. It is normally called on the process where the function - Mod:Func has been executing, but if not, the pid of the test - case process is passed with the Status argument.

-

Typical use of the end_tc/3 function can be to clean up - after init_tc/3.

-

If Func is a test case, it is possible to analyse the value of - Result to verify that init_per_testcase/2 and - end_per_testcase/2 executed successfully.

-

It is possible with end_tc/3 to fail an otherwise successful - test case, by returning {fail,ReasonToFail}. The test case Func - will be logged as failed with the provided term as reason.

- - - - report(What,Data) -> ok - Progress report for test. - - What = atom() - Data = term() - - -

This function is called in order to keep the framework up-to-date with - the progress of the test. This is useful e.g. if the - framework implements a GUI where the progress information is - constantly updated. The following can be reported: -

-

What = tests_start, Data = {Name,NumCases}

- What = loginfo, Data = [{topdir,TestRootDir},{rundir,CurrLogDir}]

- What = tests_done, Data = {Ok,Failed,{UserSkipped,AutoSkipped}}

- What = tc_start, Data = {{Mod,{Func,GroupName}},TCLogFile}

- What = tc_done, Data = {Mod,{Func,GroupName},Result}

- What = tc_user_skip, Data = {Mod,{Func,GroupName},Comment}

- What = tc_auto_skip, Data = {Mod,{Func,GroupName},Comment}

- What = framework_error, Data = {{FWMod,FWFunc},Error}

-

Note that for a test case function that doesn't belong to a group, - GroupName has value undefined, otherwise the name of the test - case group.

- - - - error_notification(Mod, Func, Args, Error) -> ok - Inform framework of crashing testcase or configuration function. - - Mod = atom() - Test suite name. - Func = atom() - Name of test case or configuration function. - Args = [tuple()] - Normally Args = [Config] - Error = {Reason,Location} - Reason = term() - Reason for termination. - Location = unknown | [{Mod,Func,Line}] - Last known position in Mod before termination. - Line = integer() - Line number in file Mod.erl. - - -

This function is called as the result of function Mod:Func failing - with Reason at Location. The function is intended mainly to aid - specific logging or error handling in the framework application. Note - that for Location to have relevant values (i.e. other than unknown), - the line macro or test_server_line parse transform must - be used. For details, please see the section about test suite line numbers - in the test_server reference manual page.

- - - - warn(What) -> boolean() - Ask framework if test server should issue a warning for What. - - What = processes | nodes - - -

The test server checks the number of processes and nodes - before and after the test is executed. This function is a - question to the framework if the test server should warn when - the number of processes or nodes has changed during the test - execution. If true is returned, a warning will be written - in the test case minor log file.

- - - - target_info() -> InfoStr - Print info about the target system to the test case log. - - InfoStr = string() | "" - - -

The test server will ask the framework for information about - the test target system and print InfoStr in the test case - log file below the host information.

- - - - - diff --git a/lib/test_server/doc/src/test_spec_chapter.xml b/lib/test_server/doc/src/test_spec_chapter.xml deleted file mode 100644 index 0a62010364..0000000000 --- a/lib/test_server/doc/src/test_spec_chapter.xml +++ /dev/null @@ -1,375 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Test Structure and Test Specifications - Siri Hansen - - - - test_spec_chapter.xml -
- -
- Test structure -

A test consists of a set of test cases. Each test case is - implemented as an erlang function. An erlang module implementing - one or more test cases is called a test suite. -

-
- -
- Test specifications -

A test specification is a specification of which test suites - and test cases to run and which to skip. A test specification can - also group several test cases into conf cases with init and - cleanup functions (see section about configuration cases - below). In a test there can be test specifications on three - different levels: -

-

The top level is a test specification file which roughly - specifies what to test for a whole application. The test - specification in such a file is encapsulated in a topcase - command. -

-

Then there is a test specification for each test suite, - specifying which test cases to run within the suite. The test - specification for a test suite is returned from the - all(suite) function in the test suite module. -

-

And finally there can be a test specification per test case, - specifying sub test cases to run. The test specification for a - test case is returned from the specification clause of the test - case. -

-

When a test starts, the total test specification is built in a - tree fashion, starting from the top level test specification. -

-

The following are the valid elements of a test - specification. The specification can be one of these elements or a - list with any combination of the elements: -

- - {Mod, Case} - This specifies the test case Mod:Case/1 - - {dir, Dir} - This specifies all modules *_SUITE in the directory - Dir - {dir, Dir, Pattern} - This specifies all modules Pattern* in the - directory Dir - {conf, Init, TestSpec, Fin} - This is a configuration case. In a test specification - file, Init and Fin must be - {Mod,Func}. Inside a module they can also be just - Func. See the section named Configuration Cases below for - more information about this. - - {conf, Properties, Init, TestSpec, Fin} - This is a configuration case as explained above, but - which also takes a list of execution properties for its group - of test cases and nested sub-groups. - - {make, Init, TestSpec, Fin} - This is a special version of a conf case which is only - used by the test server framework ts. Init and - Fin are make and unmake functions for a data - directory. TestSpec is the test specification for the - test suite owning the data directory in question. If the make - function fails, all tests in the test suite are skipped. The - difference between this "make case" and a normal conf case is - that for the make case, Init and Fin are given with - arguments ({Mod,Func,Args}). - - Case - This can only be used inside a module, i.e. not a test - specification file. It specifies the test case - CurrentModule:Case. - - -
- -
- Test Specification Files -

A test specification file is a text file containing the top - level test specification (a topcase command), and possibly one or - more additional commands. A "command" in a test specification file - means a key-value tuple ended by a dot-newline sequence. -

-

The following commands are valid: -

- - {topcase, TestSpec} - This command is mandatory in all test specification - files. TestSpec is the top level test specification of a - test. - - {skip, {Mod, Comment}} - This specifies that all cases in the module Mod - shall be skipped. Comment is a string. - - {skip, {Mod, Case, Comment}} - This specifies that the case Mod:Case shall be - skipped. - - {skip, {Mod, CaseList, Comment}} - This specifies that all cases Mod:Case, where - Case is in CaseList, shall be skipped. - - {nodes, Nodes} - Nodes is a list of nodenames available to the test - suite. It will be added to the Config argument to all - test cases. Nodes is a list of atoms. - - {require_nodenames, Num} - Specifies how many nodenames the test suite will - need. Theese will be automatically generated and inserted into the - Config argument to all test cases. Num is an - integer. - - {hosts, Hosts} - This is a list of available hosts on which to start slave - nodes. It is used when the {remote, true} option is given - to the test_server:start_node/3 function. Also, if - {require_nodenames, Num} is contained in a test - specification file, the generated nodenames will be spread over - all hosts given in this Hosts list. The hostnames are - atoms or strings. - - {diskless, true} - Adds {diskless, true} to the Config argument - to all test cases. This is kept for backwards compatibility and - should not be used. Use a configuration case instead. - - {ipv6_hosts, Hosts} - Adds {ipv6_hosts, Hosts} to the Config - argument to all test cases. - -

All test specification files shall have the extension - ".spec". If special test specification files are needed for - Windows or VxWorks platforms, additional files with the - extension ".spec.win" and ".spec.vxworks" shall be - used. This is useful e.g. if some test cases shall be skipped on - these platforms. -

-

Some examples for test specification files can be found in the - Examples section of this user's guide. -

-
- -
- Configuration cases -

If a group of test cases need the same initialization, a so called - configuration or conf case can be used. A conf - case consists of an initialization function, the group of test cases - needing this initialization and a cleanup or finalization function. -

-

If the init function in a conf case fails or returns - {skip,Comment}, the rest of the test cases in the conf case - (including the cleanup function) are skipped. If the init function - succeeds, the cleanup function will always be called, even if some - of the test cases in between failed. -

-

Both the init function and the cleanup function in a conf case - get the Config parameter as only argument. This parameter - can be modified or returned as is. Whatever is returned by the - init function is given as Config parameter to the rest of - the test cases in the conf case, including the cleanup function. -

-

If the Config parameter is changed by the init function, - it must be restored by the cleanup function. Whatever is returned - by the cleanup function will be given to the next test case called. -

-

The optional Properties list can be used to specify - execution properties for the test cases and possibly nested - sub-groups of the configuration case. The available properties are:

- 
-      Properties = [parallel | sequence | Shuffle | {RepeatType,N}]
-      Shuffle = shuffle | {shuffle,Seed}
-      Seed = {integer(),integer(),integer()}
-      RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail |
-                   repeat_until_any_ok | repeat_until_any_fail
-      N = integer() | forever
- -

If the parallel property is specified, Test Server will execute - all test cases in the group in parallel. If sequence is specified, - the cases will be executed in a sequence, meaning if one case fails, all - following cases will be skipped. If shuffle is specified, the cases - in the group will be executed in random order. The repeat property - orders Test Server to repeat execution of the cases in the group a given - number of times, or until any, or all, cases fail or succeed.

- -

Properties may be combined so that e.g. if shuffle, - repeat_until_any_fail and sequence are all specified, the test - cases in the group will be executed repeatedly and in random order until - a test case fails, when execution is immediately stopped and the rest of - the cases skipped.

- -

The properties for a conf case is always printed on the top of the HTML log - for the group's init function. Also, the total execution time for a conf case - can be found at the bottom of the log for the group's end function.

- -

Configuration cases may be nested so that sets of grouped cases can be - configured with the same init- and end functions.

-
- -
- The parallel property and nested configuration cases -

If a conf case has a parallel property, its test cases will be spawned - simultaneously and get executed in parallel. A test case is not allowed - to execute in parallel with the end function however, which means - that the time it takes to execute a set of parallel cases is equal to the - execution time of the slowest test case in the group. A negative side - effect of running test cases in parallel is that the HTML summary pages - are not updated with links to the individual test case logs until the - end function for the conf case has finished.

- -

A conf case nested under a parallel conf case will start executing in - parallel with previous (parallel) test cases (no matter what properties the - nested conf case has). Since, however, test cases are never executed in - parallel with the init- or the end function of the same conf case, it's - only after a nested group of cases has finished that any remaining parallel - cases in the previous conf case get spawned.

-
- -
- Repeated execution of test cases - -

A conf case may be repeated a certain number of times - (specified by an integer) or indefinitely (specified by forever). - The repetition may also be stopped prematurely if any or all cases - fail or succeed, i.e. if the property repeat_until_any_fail, - repeat_until_any_ok, repeat_until_all_fail, or - repeat_until_all_ok is used. If the basic repeat - property is used, status of test cases is irrelevant for the repeat - operation.

- -

It is possible to return the status of a conf case (ok or - failed), to affect the execution of the conf case on the level above. - This is accomplished by, in the end function, looking up the value - of tc_group_properties in the Config list and checking the - result of the finished test cases. If status failed should be - returned from the conf case as a result, the end function should return - the value {return_group_result,failed}. The status of a nested conf - case is taken into account by Test Server when deciding if execution - should be repeated or not (unless the basic repeat property is used).

- -

The tc_group_properties value is a list of status tuples, - each with the key ok, skipped and failed. The - value of a status tuple is a list containing names of test cases - that have been executed with the corresponding status as result.

- -

Here's an example of how to return the status from a conf case:

- 
-      conf_end_function(Config) ->
-          Status = ?config(tc_group_result, Config),
-          case proplists:get_value(failed, Status) of
-              [] ->                                   % no failed cases 
-	          {return_group_result,ok};
-	      _Failed ->                              % one or more failed
-	          {return_group_result,failed}
-          end.
- -

It is also possible in the end function to check the status of - a nested conf case (maybe to determine what status the current conf case should - return). This is as simple as illustrated in the example above, only the - name of the end function of the nested conf case is stored in a tuple - {group_result,EndFunc}, which can be searched for in the status lists. - Example:

- 
-      conf_end_function_X(Config) ->
-          Status = ?config(tc_group_result, Config),
-          Failed = proplists:get_value(failed, Status),
-          case lists:member({group_result,conf_end_function_Y}, Failed) of
-	        true ->
-		    {return_group_result,failed};
-                false ->                                                    
-	            {return_group_result,ok}
-          end; 
-      ...
- -

When a conf case is repeated, the init- and end functions - are also always called with each repetition.

 -
- -
- Shuffled test case order -

The order that test cases in a conf case are executed, is under normal - circumstances the same as the order defined in the test specification. - With the shuffle property set, however, Test Server will instead - execute the test cases in random order.

- -

The user may provide a seed value (a tuple of three integers) with - the shuffle property: {shuffle,Seed}. This way, the same shuffling - order can be created every time the conf case is executed. If no seed value - is given, Test Server creates a "random" seed for the shuffling operation - (using the return value of erlang:now()). The seed value is always - printed to the log file of the init function so that it can be used to - recreate the same execution order in subsequent test runs.

- -

If execution of a conf case with shuffled test cases is repeated, - the seed will not be reset in between turns.

 - -

If a nested conf case is specified in a conf case with a shuffle - property, the execution order of the nested cases in relation to the test cases - (and other conf cases) is also random. The order of the test cases in the nested - conf case is however not random (unless, of course, this one also has a - shuffle property).

-
- -
- Skipping test cases -

It is possible to skip certain test cases, for example if you - know beforehand that a specific test case fails. This might be - functionality which isn't yet implemented, a bug that is known but - not yet fixed or some functionality which doesn't work or isn't - applicable on a specific platform. -

-

There are several different ways to state that a test case - should be skipped:

- - Using the {skip,What} command in a test - specification file - - Returning {skip,Reason} from the - init_per_testcase/2 function - - Returning {skip,Reason} from the specification - clause of the test case - - Returning {skip,Reason} from the execution clause - of the test case - - -

The latter of course means that the execution clause is - actually called, so the author must make sure that the test case - is not run. For more information about the different clauses in a - test case, see the chapter about writing test cases. -

-

When a test case is skipped, it will be noted as SKIPPED - in the HTML log. -

-
- - diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml deleted file mode 100644 index 60dfdbc545..0000000000 --- a/lib/test_server/doc/src/ts.xml +++ /dev/null @@ -1,568 +0,0 @@ - - - - -
- - 2007 - 2013 - Ericsson AB, All Rights Reserved - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - - - The OTP Test Server Framework - Mattias Nilsson - - - - - - - ts.xml -
- ts - Test Server Framework for testing OTP - -

This is a framework for testing OTP. The ts module - implements the interface to all the functionality in the - framework. -

-

The framework is built on top of the Test Server Controller, - test_server_ctrl, and provides a high level operator - interface. The main features added by the framework are: -

- - Automatic compilation of test suites and data directories - - Collection of files in central directories and creation of - additional HTML pages for better overview. - - Single command interface for running all available tests - - Spawns a new node with correct parameters before starting - the test server - - Atomatically creates the parameter file needed when - running tests on remote target - - -

More information about the Test Server Framework and how to run - test cases can be found in the Test Server User's Guide. -

-

For writing you own test server framework, please turn to the - reference manual for the Test Server Controller and chapter named - "Writing your own test server framework" in the Test Server User's - Guide. -

-

SETUP

-

To be able to run ts, you must first `install' - ts for the current environment. This is done by calling - ts:install/0/1/2. A file called `variables' is created - and used by ts when running test suites. It is not - recommended to edit this file, but it is possible to alter if - ts gets the wrong idea about your environment. -

-

ts:install/0 is used if the target platform is the - same as the controller host, i.e. if you run on "local target" - and no options are needed. Then running ts:install/0 ts - will run an autoconf script for your current - environment and set up the necessary variables needed by the - test suites. -

-

ts:install/1 or ts:install/2 is used if the - target platform is different from the controller host, i.e. if - you run on "remote target" or if special options are required - for your system. -

-

See the reference manual for detailed information about - ts:install/0/1/2. -

-

Some of the common variables in the 'variables' file are - described below. Do not make any assumptions as of what is found - in this file, as it may change at any time. -

- - longnames

- Set to true if the system is using fully qualified - nodenames. - - platform_id

- This is the currently installed platform identification - string. - - platform_filename

- This is the name used to create the final save directory - for test runs. - - platform_label

- This is the string presented in the generated test - results index page. - - rsh_name

- This is the rsh program to use when starting slave or - peer nodes on a remote host. - - erl_flags

- Compile time flags used when compiling test suites. - - erl_release

- The Erlang/OTP release being tested. - - 'EMULATOR'

- The emulator being tested (e.g. beam) - - 'CPU'

- The CPU in the machine running the tests, e.g. sparc. - - target_host

- The target host name - - os

- The target operating system, e.g. solaris2.8 - - target

- The current target platform, e.g. sparc-sun-solaris2.8 - - -

RUNNING TESTS

-

After installing ts, you can run your test with the - ts:run/0/1/2/3/4 functions. These functions, however, - require a special directory structure to be able to find your - test suites. Both the test server and all tests must be located - under your $TESTROOT directory. The test server implementation - shall be located in the directory $TESTROOT/test_server - and for each application there must be a directory named - _test]]> containing the .spec file - and all test suites and data directories for the - application. Note that there shall only be one .spec file for - each application. -

-

$TESTROOT/test_server must be the current directory - when calling the ts:run/* function. -

-

All available tests can be found with ts:tests(). This - will list all applications for which a test specification file - _test/.spec]]> can be found. -

-

To run all these tests, use ts:run(). -

-

To run one or some of the tests, use ts:run(Tests), - where Tests is the name of the application you want to - test, or a list of such names. -

-

To run one test suite within a test, use - ts:run(Test,Suite). -

-

To run one test case within a suite, use - ts:run(Test,Suite,Case)

-

To all these functions, you can also add a list of - options. Please turn to the reference manual for the ts - module to see the valid options to use. -

-

The function ts:help() displays some simple help for - the functions in ts. Use this for quick reference. -

-

LOG FILES

-

As the execution of the test suites go on, events are logged in - four different ways: -

- - Text to the operator's console. - Suite related information is sent to the major log file. - Case related information is sent to the minor log file. - The HTML log file gets updated with test results. - -

Typically the operator, who may run hundreds or thousands of - test cases, doesn't want to fill the screen with details - about/from the specific test cases. By default, the operator will - only see: -

- - A confirmation that the test has started. - - A small note about each failed test case. - - A summary of all the run test cases. - - A confirmation that the test run is complete - - Some special information like error reports and progress - reports, printouts written with erlang:display/1 or io:format/3 - specifically addressed to somewhere other than - standard_io. - -

This is enough for the operator to know, and if he wants to dig - in deeper into a specific test case result, he can do so by - following the links in the HTML presentation to take a look in the - major or minor log files. -

-

A detailed report of the entire test suite is stored in the - major logfile, the exact reason for failure, time spent etc. -

-

The HTML log file is a summary of the major log file, but gives - a much better overview of the test run. It also has links to every - test case's log file for quick viewing with a HTML browser. -

-

The minor log file contain full details of every single test - case, each one in a separate file. This way the files should be - easy to compare with previous test runs, even if the set of test - cases change. -

-

Which information that goes where is user configurable via the - test server controller. Three threshold values determine what - comes out on screen, and in the major or minor log files. The - contents that goes to the HTML log file is fixed, and cannot be - altered. -

- - - - - install() -> ok | {error, Reason} - install(TargetSystem) -> ok | {error, Reason} - install(Opts) -> ok | {error, Reason} - install(TargetSystem,Opts) -> ok | {error, Reason} - Installs the Test Server Framework - - TargetSystem = {Architecture, TargetHost} - Architecture = atom() or string() - e.g. "ose" or "vxworks_ppc603" - TargetHost = atom() or string() - The name of the target host - Opts = list() - - -

Installs and configures the Test Server Framework for - running test suites. If a remote host is to be used, the - TargetSystem argument must be given so that "cross - installation" can be done. Installation is required for - any of the functions in ts to work. -

-

Opts may be one or more of -

- - {longnames, Bool}

- Use fully qualified hostnames for test_server and - slave nodes. Bool is true or false (default). - - {verbose, Level}

- Verbosity level for test server output, set to 0, 1 or - 2, where 0 is quiet(default). - - {hosts, Hosts}

- This is a list of available hosts on which to start - slave nodes. It is used when the {remote, true} - option is given to the test_server:start_node/3 - function. Also, if {require_nodenames, Num} is - contained in a test specification file, the generated - nodenames will be spread over all hosts given in this - Hosts list. The hostnames are given as atoms or - strings. - - {slavetargets, SlaveTarges}

- For VxWorks only. This is a list of - available hosts where slave nodes can be started. This is - necessary because only one node can run per host in the - VxWorks environment. This is not the same as - {hosts, Hosts} because it is used for all slave nodes - - not only the ones started with {remote, true}. The - hostnames are given as atoms or strings. - - {crossroot, TargetErlRoot}

- Erlang root directory on target host -

-This option is mandatory for remote targets - - {master, {MasterHost, MasterCookie}}

- If target is remote and the target node is started as - a slave node, this option - indicates which master and cookie to use. The given master - will also be used as master for slave nodes started with - test_server:start_node/3. It is expected that the - erl_boot_server is started on the master node before - the test is run. If this option is not given, the test - server controller node is used as master and the - erl_boot_server is automatically started. - - {erl_start_args, ArgString}

- Additional arguments to be used when starting the test - server controller node. ArgString will be appended to - the command line when starting the erlang node. Note that - this will only affect the startup of the controller node, - i.e. not the target node or any slave nodes - startet from a test case. - - {ipv6_hosts, HostList}

- This option will be inserted in the - Config parameter for each test case. HostList - is a list of hosts supporting IPv6. - - - - - - help() -> ok - Presents simple help on the functions in ts - -

Presents simple help on the functions in ts. Useful - for quick reference.

- - - - tests() -> Tests - Returns the list of available tests - -

Returns the list of available tests. This is actually just - a list of all test specification files found by looking up - "../*_test/*.spec". -

-

In each ../Name_test/ directory there should be one test - specification file named Name.spec.

- - - - run() -> ok | {error, Reason} - run([all_tests|Opts]) - run(Specs) - run(Specs, Opts) - run(Spec, Module) - run(Spec, Module, Opts) - run(Spec, Module, Case) - run(Spec, Module, Case, Opts) - Runs (specified) test suite(s) - - Specs = Spec | [Spec] - Spec = atom() - Module = atom() - Case = atom() - Opts = [Opt] - Opt = batch | verbose | {verbose, Level} | {vars, Vars} | keep_topcase | cover | cover_details |{cover,CoverFile} | {cover_details,CoverFile} | {trace, TraceSpec} - Level = integer(); 0 means silent - Vars = list() of key-value tuples - CoverFile = string(); name of file listing modules to exclude from or include in cover compilation. The name must include full path to the file. - Reason = term() - - -

This function runs test suite(s)/case(s). To be able to run - any tests, ts:install must first be called to create the - variables file needed. To run a whole test specification, - only specify the name of the test specification, and all test - suite modules belonging to that test spec will be run. To run - a single module in a test specification, use the Module - argument to specify the name of the module to run and all test - cases in that module will be run, and to run a specified test - case, specify the name of the test case using the Case - argument. If called with no argument, all test specifications - available will be run. Use ts:tests/0 to see the available - test specifications. -

-

If the batch option is not given, a new xterm is - started (unix) when ts:run is called. -

-

The verbose option sets the verbosity level for test - server output. This has the same effect as if given to - ts:install/1/2

-

The vars option can be used for adding configuration - variables that are not in the variables file generated - during installation. Can be any of the Opts valid for - ts:install/1/2. -

-

The keep_topcase option forces ts to keep the - topcase in your test specification file as is. This option can - only be used if you don't give the Module or - Case parameters to ts:run. The - keep_topcase option is necessary if your topcase - contains anything other than _test"}]]>. If - the option is not used, ts will modify your topcase. -

-

The cover and cover_details options indicates - that the test shall be run with code coverage - analysis. cover_details means that analysis shall be - done on the most detailed level. If the test is run with a - remote target, this option creates a list of uncovered lines - in each cover compiled module. If the test is run with a local - target, each cover compiled module will be analysed with - cover:analyse_to_file/1. The cover options will - only create an overview of all cover compiled modules with the - number of covered and not covered lines. -

-

The CoverFile which can be given with the - cover and cover_details options must be the - filename of a file listing modules to be excluded from or - included in the cover compilation. By default, ts - believes that Spec is the name of an OTP application - and that all modules in this application shall be cover - compiled. The CoverFile can exclude modules that belong - to the application and add modules that don't belong to the - application. The file can have the following entries:

- -{exclude, all | ExcludeModuleList}. -{include, IncludeModuleList}. -

Note that each line must end with a full - stop. ExcludeModuleList and IncludeModuleList - are lists of atoms, where each atom is a module name. -

-

If the cover or cover_details options are - given on their own, the directory _test]]> is - searched for a CoverFile named .cover]]>. If - this file is not found, Spec is assumed to be the name - of an OTP application, and all modules in the ebin - directory for the application are cover compiled. The - ebin directory is found by adding ebin to - code:lib_dir(Spec). -

-

The same cover compiled code will be loaded on all slave or - peer nodes started with test_server:start_node/3. The - exception is nodes that run an old version of OTP. If the loading - fails, the node will simply not be a part of the coverage - analysis. Note that slave and peer nodes must be stopped with - test_server:stop_node/1 for the node to be part of the - coverage analysis, else the test server will not be able to - fetch coverage data from the node. -

-

The trace option is used to turn on call trace on - target and on slave or peer nodes started with - test_server:start_node/3. TraceSpec can be the - name of a trace information file, or a list of elements like - the ones in a trace information file. Please turn to the - reference manual for test_server_ctrl:trc/1 for details - about the trace information file. -

- - - - cross_cover_analyse(Level) -> ok - cross_cover_analyse([Level]) -> ok - Analyse cover data collected from all tests - -

Analyse cover data collected from all tests. -

-

See test_server_ctrl:cross_cover_analyse/2 -

- - - - r() -> ok - r(Opts) -> ok - r(SpecOrSuite) -> ok - r(SpecOrSuite,Opts) -> ok - r(Suite,Case) -> ok - r(Suite,Case,Opts) -> ok - Run test suite or test case without tsinstalled - - SpecOrSuite = Spec | Suite - Spec = string() - "Name.spec" or "Name.spec.OsType", where OsType is vxworks - Suite = atom() - Case = atom() - Opts = [Opt] - Opt = {Cover,AppOrCoverFile} | {Cover,Application,CoverFile} - Cover = cover | cover_details - AppOrCoverFile = Application | CoverFile - Application = atom() - OTP application to cover compile - CoverFile = string() - Name of file listing modules to exclude from or include in cover compilation - - -

This function can be used to run a test suites or test - cases directly, without any of the additional features added - by the test server framework. It is simply a wrapper function - for the add_dir, add_spec, add_module and - add_case functions in test_server_ctrl: -

-

r() -> add_dir(".")

-r(Spec) -> add_spec(Spec)

-r(Suite) -> add_module(Suite)

-r(Suite,Case) -> add_case(Suite,Case)

-

To use this function, it is required that the test suite is - compiled and in the code path of the node where the function - is called. The function can be used without having ts - installed. -

-

For information about the cover and - cover_details options, see test_server_ctrl:cover/2/3.

- - - - estone() -> ok | {error, Reason} - estone(Opts) -> ok - Runs the EStone test - -

This function runs the EStone test. It is a shortcut for - running the test suite estone_SUITE in the - kernel application. -

-

Opts is the same as the Opts argument for the - ts:run functions.

- - - - -
- Makfile.src in Data Directory -

If a data directory contains code which must be compiled before - the test suite is run, a makefile source called - Makefile.src can be placed in the data directory. This file - will be converted to a valid makefile by ts:run/0/1/2/3/4. -

-

The reason for generating the makefile is that you can use - variables from the variables file which was generated by - ts:install/0/1/2. All occurrences of @Key@ in - Makefile.src is substituted by the Value from - {Key,Value} found in the variables file. Example: -

-

Cut from variables:

- - ... - {'EMULATOR',"beam"}. - {'CFLAGS',"-g -O2"}. - {'LD',"$(CC) $(CFLAGS)"}. - {'CC',"gcc"}. - ... - -

Makefile.src for compiling erlang code could look - something like this:

- - EFLAGS=+debug_info - - all: ordsets1.@EMULATOR@ - - ordsets1.@EMULATOR@: ordsets1.erl - erlc $(EFLAGS) ordsets1.erl - -

Makefile.src for compiling c code could look - something like this:

- - CC = @CC@ - LD = @LD@ - CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ - CROSSLDFLAGS = @CROSSLDFLAGS@ - - PROGS = nfs_check@exe@ - - all: $(PROGS) - - nfs_check@exe@: nfs_check@obj@ - $(LD) $(CROSSLDFLAGS) -o nfs_check nfs_check@obj@ @LIBS@ - - nfs_check@obj@: nfs_check.c - $(CC) -c -o nfs_check@obj@ $(CFLAGS) nfs_check.c - -
- - diff --git a/lib/test_server/doc/src/why_test_chapter.xml b/lib/test_server/doc/src/why_test_chapter.xml deleted file mode 100644 index 3d0e8271b1..0000000000 --- a/lib/test_server/doc/src/why_test_chapter.xml +++ /dev/null @@ -1,141 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Why Test - Siri Hansen - - - -
- -
- Goals -

It's not possible to prove that a program is correct by - testing. On the contrary, it has been formally proven that it is - impossible to prove programs in general by testing. Theoretical - program proofs or plain examination of code may be viable options - for those that wish to certify that a program is correct. The test - server, as it is based on testing, cannot be used for - certification. Its intended use is instead to (cost effectively) - find bugs. A successful test suite is one that reveals a - bug. If a test suite results in Ok, then we know very little that - we didn't know before. -

-
- -
- What to test? -

There are many kinds of test suites. Some concentrate on - calling every function in the interface to some module or - server. Some other do the same, but uses all kinds of illegal - parameters, and verifies that the server stays alive and rejects - the requests with reasonable error codes. Some test suites - simulate an application (typically consisting of a few modules of - an application), some try to do tricky requests in general, some - test suites even test internal functions. -

-

Another interesting category of test suites are the ones that - check that fixed bugs don't reoccur. When a bugfix is introduced, - a test case that checks for that specific bug should be written - and submitted to the affected test suite(s). -

-

Aim for finding bugs. Write whatever test that has the highest - probability of finding a bug, now or in the future. Concentrate - more on the critical parts. Bugs in critical subsystems are a lot - more expensive than others. -

-

Aim for functionality testing rather than implementation - details. Implementation details change quite often, and the test - suites should be long lived. Often implementation details differ - on different platforms and versions. If implementation details - have to be tested, try to factor them out into separate test - cases. Later on these test cases may be rewritten, or just - skipped. -

-

Also, aim for testing everything once, no less, no more. It's - not effective having every test case fail just because one - function in the interface changed. -

-
- -
- How much to test -

There is a unix shell script that counts the number of non - commented words (lines and characters too) of source code in each - application's test directory and divides with the number of such - source words in the src directory. This is a measure of how much - test code there is. -

-

There has been much debate over how much test code, compared to - production code, should be written in a project. More test code - finds more bugs, but test code needs to be maintained just like - the production code, and it's expensive to write it in the first - place. In several articles from relatively mature software - organizations that I have read, the amount of test code has been - about the same as the production code.

-

In OTP, at the time of - writing, few applications come even close to this, some have no - test code at all. -

- -
- Full coverage -

It is possible to cover compile the modules being tested - before running the test suites. Doing so displays which branches - of the code that are tested by the test suite, and which are - not. Many use this as a measure of a good test suite. When every - single line of source code is covered once by the test suite, - the test suite is finished. -

-

A coverage of 100% still proves nothing, though. It doesn't - mean that the code is error free, that everything is tested. For - instance, if a function contains a division, it has to be - executed at least twice. Once with parameters that cause - division by zero, and once with other parameters. -

-

High degree of coverage is good of course, it means that no - major parts of the code has been left untested. It's another - question whether it's cost effective. You're only likely to find - 50% more bugs when going from 67% to 100% coverage, but the work - (cost) is maybe 200% as large, or more, because reaching all of - those obscure branches is usually complicated. -

-

Again, the reason for testing with the test server is to find - bugs, not to create certificates of valid code. Maximizing the - number of found bugs per hour probably means not going for 100% - coverage. For some module the optimum may be 70%, for some other - maybe 250%. 100% shouldn't be a goal in itself.

-
- -
- User interface testing -

It is very difficult to do sensible testing of user - interfaces, especially the graphic ones. The test server has - some support for capturing the text I/O that goes to the user, - but none for graphics. There are several tools on the market - that help with this.

-
-
- - diff --git a/lib/test_server/doc/src/write_framework_chapter.xml b/lib/test_server/doc/src/write_framework_chapter.xml deleted file mode 100644 index d10b580c34..0000000000 --- a/lib/test_server/doc/src/write_framework_chapter.xml +++ /dev/null @@ -1,160 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Write you own test server framework - Siri Hansen - - - - write_framework_chapter.xml -
- -
- Introduction -

The test server controller can be interfaced from the operating - system or from within Erlang. The nature of your new framework - will decide which interface to use. If you want your framework to - start a new node for each test, the operating system interface is - very convenient. If your node is already started, going from - within Erlang might be a more flexible solution. -

-

The two methods are described below. -

-
- -
- Interfacing the test server controller from Erlang -

Using the test server from Erlang means that you have to start - the test server and then add test jobs. Use - test_server_ctrl:start/0 to start the test server, and - test_server_ctrl:stop/0 to stop it. -

- -
- Adding test jobs -

There are many commands available for adding test cases to - the test server's job queue:

-

- - Single test case

-test_server_ctrl:add_case/2/3 - Multiple test cases from same suite

-test_server_ctrl:add_cases/2/3 - Test suite module or modules

-test_server_ctrl:add_module/1/2 - Some or all test suite modules in a directory

-test_server_ctrl:add_dir/2/3 - Test cases specified in a test specification file

-test_server_ctrl:add_spec/1 - -

All test suites are given a unique name, which is usually - given when the test suite is added to the job queue. In some - cases, a default name is used, as in the case when a module is - added without a specified name. The test job name is used to - store logfiles, which are stored in the `name.logs' directory - under the current directory. -

-

See the reference manual for details about the functions for - adding test jobs. -

-
-
- -
- Interfacing the test server controller from the operating system. -

The function run_test/1 is your interface in the test - server controller if you wish to use it from the operating - system. You simply start an erlang shell and invoke this function - with the -s option. run_test/1 starts the test - server, runs the test specified by the command line and stops the - test server. The argument to run_test/1 is a list of - command line flags, typically - ['KEY1', Value1, 'KEY2', Value2, ...]. - The valid command line flags are listed in the reference manual - for test_server_ctrl. -

-

A typical command line may look like this

-erl -noshell -s test_server_ctrl run_test KEY1 Value1 KEY2 Value2 ... -s erlang halt

-

Or make an alias (this is for unix/tcsh)

-alias erl_test 'erl -noshell -s test_server_ctrl run_test \!* -s erlang halt'

-

And then use it like this

-erl_test KEY1 Value1 KEY2 Value2 ...

-

- -
- An Example -

An example of starting a test run from the command line

-

-

erl -name test_srv -noshell -rsh /home/super/otp/bin/ctrsh

--pa /clearcase/otp/erts/lib/kernel/test

--boot start_sasl -sasl errlog_type error

--s test_server_ctrl run_test SPEC kernel.spec -s erlang halt

-

-
-
- -
- Framework callback functions -

By defining the environment variable - TEST_SERVER_FRAMEWORK to a module name, the framework - callback functions can be used. The framework callback functions - are called by the test server in order let the framework interact - with the execution of the tests and to keep the framework upto - date with information about the test progress. -

-

The framework callback functions are described in the reference - manual for test_server_ctrl. -

-

Note that this topic is in an early stage of development, and - changes might occur. -

-
- -
- Other concerns -

Some things to think about when writing you own test server - framework: -

- - emulator version - Make sure that the intended - version of the emulator is started. - - operating system path - If test cases use port - programs, make sure the paths are correct. - - recompilation - Make sure all test suites are fresh - compiled. - - test_server.hrl - Make sure the - test_server.hrl file is in the include path when - compiling test suites. - - running applications - Some test suites require - some applications to be running (e.g. sasl). Make sure they are - started. - - -
- - diff --git a/lib/test_server/doc/src/write_test_chapter.xml b/lib/test_server/doc/src/write_test_chapter.xml deleted file mode 100644 index c3e1881b8a..0000000000 --- a/lib/test_server/doc/src/write_test_chapter.xml +++ /dev/null @@ -1,228 +0,0 @@ - - - - -
- - 20022013 - Ericsson AB. All Rights Reserved. - - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - - - Writing Test Suites - Siri Hansen - - - - write_test_chapter.xml -
- -
- Support for test suite authors -

The test_server module provides some useful functions - to support the test suite author. This includes: -

- - Starting and stopping slave or peer nodes - Capturing and checking stdout output - Retrieving and flushing process message queue - Watchdog timers - Checking that a function crashes - Checking that a function succeeds at least m out of n times - Checking .app files - -

Please turn to the reference manual for the test_server - module for details about these functions. -

-
- -
- Test suites -

A test suite is an ordinary Erlang module that contains test - cases. It's recommended that the module has a name on the form - *_SUITE.erl. Otherwise, the directory function will not find the - modules (by default). -

-

For some of the test server support, the test server include - file test_server.hrl must be included. Never include it - with the full path, for portability reasons. Use the compiler - include directive instead. -

-

The special function all(suite) in each module is called - to get the test specification for that module. The function - typically returns a list of test cases in that module, but any - test specification could be returned. Please see the chapter - about test specifications for details about this. -

-
- -
- Init per test case -

In each test suite module, the functions - init_per_testcase/2 and end_per_testcase/2 must be - implemented. -

-

init_per_testcase is called before each test case in the - test suite, giving a (limited) possibility for initialization. -

-

end_per_testcase/2 is called after each test case is - completed, giving a possibility to clean up. -

-

The first argument to these functions is the name of the test - case. This can be used to do individual initialization and cleanup for - each test cases. -

-

The second argument is a list of tuples called - Config. The first element in a Config tuple - should be an atom - a key value to be used for searching. - init_per_testcase/2 may modify the Config - parameter or just return it as is. Whatever is retuned by - init_per_testcase/2 is given as Config parameter to - the test case itself. -

-

The return value of end_per_testcase/2 is ignored by the - test server. -

-
- -
- Test cases -

The smallest unit that the test server is concerned with is a - test case. Each test case can in turn test many things, for - example make several calls to the same interface function with - different parameters. -

-

It is possible to put many or few tests into each test - case. How many things each test case tests is up to the author, - but here are some things to keep in mind. -

-

Very small test cases often leads to more code, since - initialization has to be duplicated. Larger code, especially with - a lot of duplication, increases maintenance and reduces - readability. -

-

Larger test cases make it harder to tell what went wrong if it - fails, and force us to skip larger portions of test code if a - specific part fails. These effects are accentuated when running on - multiple platforms because test cases often have to be skipped. -

-

A test case generally consists of three parts, the - documentation part, the specification part and the execution - part. These are implemented as three clauses of the same function. -

-

The documentation clause matches the argument 'doc' and - returns a list for strings describing what the test case tests. -

-

The specification clause matches the argument 'suite' - and returns the test specification for this particular test - case. If the test specification is an empty list, this indicates - that the test case is a leaf test case, i.e. one to be executed. -

-

The execution clause implements the actual test case. It takes - one argument, Config, which contain configuration - information like data_dir and priv_dir. See Data and Private Directories for - more information about these. -

-

The Config variable can also contain the - nodenames key, if requested by the require_nodenames - command in the test suite specification file. All Config - items should be extracted using the ?config macro. This is - to ensure future compatibility if the Config format - changes. See the reference manual for test_server for - details about this macro. -

-

If the execution clause crashes or exits, it is considered a - failure. If it returns {skip,Reason}, the test case is - considered skipped. If it returns {comment,String}, - the string will be added in the 'Comment' field on the HTML - result page. If the execution clause returns anything else, it is - considered a success, unless it is {'EXIT',Reason} or - {'EXIT',Pid,Reason} which can't be distinguished from a - crash, and thus will be considered a failure. -

-
- -
- - Data and Private Directories -

The data directory (data_dir) is the directory where the test - module has its own files needed for the testing. A compiler test - case may have source files to feed into the compiler, a release - upgrade test case may have some old and new release of - something. A graphics test case may have some icons and a test - case doing a lot of math with bignums might store the correct - answers there. The name of the data_dir is the the name of - the test suite and then "_data". For example, - "some_path/foo_SUITE.beam" has the data directory - "some_path/foo_SUITE_data/". -

-

The priv_dir is the test suite's private directory. This - directory should be used when a test case needs to write to - files. The name of the private directory is generated by the test - server, which also creates the directory. -

-

Warning: Do not depend on current directory to be - writable, or to point to anything in particular. All scratch files - are to be written in the priv_dir, and all data files found - in data_dir. If the current directory has to be something - specific, it must be set with file:set_cwd/1. -

-
- -
- Execution environment -

Each time a test case is about to be executed, a new process is - created with spawn_link. This is so that the test case will - have no dependencies to earlier tests, with respect to process flags, - process links, messages in the queue, other processes having registered - the process, etc. As little as possible is done to change the initial - context of the process (what is created by plain spawn). Here is a - list of differences: -

- - It has a link to the test server. If this link is removed, - the test server will not know when the test case is finished, - just wait infinitely. - - It often holds a few items in the process dictionary, all - with names starting with 'test_server_'. This is to keep - track of if/where a test case fails. - - There is a top-level catch. All of the test case code is - catched, so that the location of a crash can be reported back to - the test server. If the test case process is killed by another - process (thus the catch code is never executed) the test server - is not able to tell where the test case was executing. - - It has a special group leader implemented by the test - server. This way the test server is able to capture the io that - the test case provokes. This is also used by some of the test - server support functions. - - -

There is no time limit for a test case, unless the test case - itself imposes such a limit, by calling - test_server:timetrap/1 for example. The call can be made - in each test case, or in the init_per_testcase/2 - function. Make sure to call the corresponding - test_server:timetrap_cancel/1 function as well, e.g in the - end_per_testcase/2 function, or else the test cases will - always fail. -

-
- - - diff --git a/lib/test_server/ebin/.gitignore b/lib/test_server/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl deleted file mode 100644 index 77864ef3b5..0000000000 --- a/lib/test_server/include/test_server.hrl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --ifdef(line_trace). --line_trace(true). --define(line, - io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]), - [erlang:monotonic_time()-erlang:system_info(start_time)]),). --else. --define(line,). --endif. --define(t,test_server). --define(config,test_server:lookup_config). - - diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl deleted file mode 100644 index 37da956cd0..0000000000 --- a/lib/test_server/include/test_server_line.hrl +++ /dev/null @@ -1,20 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - diff --git a/lib/test_server/info b/lib/test_server/info deleted file mode 100644 index 7a9ed6c700..0000000000 --- a/lib/test_server/info +++ /dev/null @@ -1,2 +0,0 @@ -group: test Test Applications -short: The OTP Test Server diff --git a/lib/test_server/prebuild.skip b/lib/test_server/prebuild.skip deleted file mode 100644 index 8ee4101f6a..0000000000 --- a/lib/test_server/prebuild.skip +++ /dev/null @@ -1 +0,0 @@ -src/autom4te.cache diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile deleted file mode 100644 index 6a26ee2933..0000000000 --- a/lib/test_server/src/Makefile +++ /dev/null @@ -1,144 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1996-2013. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk - -# ---------------------------------------------------- -# Configuration info. -# ---------------------------------------------------- -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(TEST_SERVER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= test_server_ctrl \ - test_server_gl \ - test_server_io \ - test_server_node \ - test_server \ - test_server_sup \ - erl2html2 - -TS_MODULES= \ - ts \ - ts_run \ - ts_lib \ - ts_make \ - ts_erl_config \ - ts_autoconf_win32 \ - ts_install \ - ts_install_cth \ - ts_benchmark - -TARGET_MODULES= $(MODULES:%=$(EBIN)/%) -TS_TARGET_MODULES= $(TS_MODULES:%=$(EBIN)/%) - -ERL_FILES= $(MODULES:=.erl) -TS_ERL_FILES= $(TS_MODULES:=.erl) -HRL_FILES = ../include/test_server.hrl ../include/test_server_line.hrl -INTERNAL_HRL_FILES = test_server_internal.hrl -TS_HRL_FILES= ts.hrl -C_FILES = -AUTOCONF_FILES = configure.in conf_vars.in -PROGRAMS = configure config.sub config.guess install-sh -CONFIG = ts.config ts.unix.config ts.win32.config - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) $(APPUP_TARGET) -TS_TARGET_FILES = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) - -TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(PROGRAMS) \ - $(APP_TARGET) $(APPUP_TARGET) -TS_TARGETS = $(TS_MODULES:%=$(EBIN)/%.$(EMULATOR)) - -APP_FILE= test_server.app -APP_SRC= $(APP_FILE).src -APP_TARGET= $(EBIN)/$(APP_FILE) - -APPUP_FILE= test_server.appup -APPUP_SRC= $(APPUP_FILE).src -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I../include -Werror - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -tests debug opt: $(TARGETS) $(TS_TARGETS) - -clean: - rm -f $(TARGET_FILES) $(TS_TARGET_FILES) - rm -f core - -docs: - -configure: configure.in - autoconf configure.in > configure - -# ---------------------------------------------------- -# 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_DATA) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - -release_tests_spec: opt - $(INSTALL_DIR) "$(RELEASE_PATH)/test_server" - $(INSTALL_DATA) $(ERL_FILES) $(TS_ERL_FILES) \ - $(HRL_FILES) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) \ - $(TS_TARGET_FILES) \ - $(AUTOCONF_FILES) $(C_FILES) $(CONFIG) \ - "$(RELEASE_PATH)/test_server" - $(INSTALL_SCRIPT) $(PROGRAMS) "$(RELEASE_PATH)/test_server" - -release_docs_spec: - diff --git a/lib/test_server/src/conf_vars.in b/lib/test_server/src/conf_vars.in deleted file mode 100644 index 7c55d7b9ed..0000000000 --- a/lib/test_server/src/conf_vars.in +++ /dev/null @@ -1,25 +0,0 @@ -CC:@CC@ -LD:@LD@ -CFLAGS:@CFLAGS@ -EI_CFLAGS:@EI_CFLAGS@ -ERTS_CFLAGS:@ERTS_CFLAGS@ -CROSSLDFLAGS:@CROSSLDFLAGS@ -SHLIB_LD:@SHLIB_LD@ -SHLIB_LDFLAGS:@SHLIB_LDFLAGS@ -SHLIB_LDLIBS:@SHLIB_LDLIBS@ -SHLIB_CFLAGS:@SHLIB_CFLAGS@ -SHLIB_EXTRACT_ALL:@SHLIB_EXTRACT_ALL@ -dll:@SHLIB_SUFFIX@ -DEFS:@DEFS@ -ERTS_LIBS:@ERTS_LIBS@ -LIBS:@LIBS@ -target_host:@target_host@ -CPU:@host_cpu@ -os:@host_os@ -target:@host@ -obj:@obj@ -exe:@exe@ -SSLEAY_ROOT:@SSLEAY_ROOT@ -JAVAC:@JAVAC@ -make_command:@make_command@ -test_c_compiler:@test_c_compiler@ diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in deleted file mode 100644 index 001de72a1e..0000000000 --- a/lib/test_server/src/configure.in +++ /dev/null @@ -1,509 +0,0 @@ -dnl Process this file with autoconf to produce a configure script for Erlang. -dnl -dnl %CopyrightBegin% -dnl -dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. -dnl -dnl Licensed under the Apache License, Version 2.0 (the "License"); -dnl you may not use this file except in compliance with the License. -dnl You may obtain a copy of the License at -dnl -dnl http://www.apache.org/licenses/LICENSE-2.0 -dnl -dnl Unless required by applicable law or agreed to in writing, software -dnl distributed under the License is distributed on an "AS IS" BASIS, -dnl WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -dnl See the License for the specific language governing permissions and -dnl limitations under the License. -dnl -dnl %CopyrightEnd% -dnl - -AC_INIT(conf_vars.in) - -AC_CANONICAL_HOST - -dnl Checks for programs. -AC_PROG_CC - -DEBUG_FLAGS="-g -DDEBUG" -if test "$GCC" = yes; then - DEBUG_FLAGS="$DEBUG_FLAGS -Wall $CFLAGS" -fi -AC_SUBST(DEBUG_FLAGS) - -AC_ARG_ENABLE(debug-mode, -[ --enable-debug-mode enable debug mode], -[ case "$enableval" in - no) ;; - *) CFLAGS=$DEBUG_FLAGS ;; - esac ], ) - -AC_ARG_ENABLE(m64-build, -AS_HELP_STRING([--enable-m64-build], - [build 64-bit binaries using the -m64 flag to (g)cc]), -[ case "$enableval" in - no) enable_m64_build=no ;; - *) enable_m64_build=yes ;; - esac -],enable_m64_build=no) - -AC_ARG_ENABLE(m32-build, -AS_HELP_STRING([--enable-m32-build], - [build 32-bit binaries using the -m32 flag to (g)cc]), -[ case "$enableval" in - no) enable_m32_build=no ;; - *) enable_m32_build=yes ;; - esac -],enable_m32_build=no) - -no_mXX_LDFLAGS="$LDFLAGS" - -if test X${enable_m64_build} = Xyes; then - CFLAGS="-m64 $CFLAGS" - LDFLAGS="-m64 $LDFLAGS" -fi -if test X${enable_m32_build} = Xyes; then - CFLAGS="-m32 $CFLAGS" - LDFLAGS="-m32 $LDFLAGS" -fi - -AC_CHECK_LIB(m, sin) - -#-------------------------------------------------------------------- -# Interactive UNIX requires -linet instead of -lsocket, plus it -# needs net/errno.h to define the socket-related error codes. -#-------------------------------------------------------------------- - -AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"]) -AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H)) - -#-------------------------------------------------------------------- -# Linux/tcp.h may be needed for sockopt test in kernel -#-------------------------------------------------------------------- - -AC_CHECK_HEADER(linux/tcp.h, AC_DEFINE(HAVE_LINUX_TCP_H)) -AC_MSG_CHECKING(for sane linux/tcp.h) -AC_TRY_COMPILE([#include - #include - #include - #include - #include - #include - #include - #include - #include - #include - #include ], - [return 0;], - have_sane_linux_tcp_h=yes, - have_sane_linux_tcp_h=no) - -if test $have_sane_linux_tcp_h = yes; then - AC_DEFINE(HAVE_SANE_LINUX_TCP_H,[1], - [Define if we have sane linux/tcp.h]) - AC_MSG_RESULT(yes) -else - AC_MSG_RESULT(no) -fi - - - -#-------------------------------------------------------------------- -# Linux requires sys/socketio.h instead of sys/sockio.h -#-------------------------------------------------------------------- -AC_CHECK_HEADER(sys/socketio.h, AC_DEFINE(HAVE_SOCKETIO_H)) - - -#-------------------------------------------------------------------- -# Misc -#-------------------------------------------------------------------- -AC_CHECK_HEADER(poll.h, AC_DEFINE(HAVE_POLL_H)) - -#-------------------------------------------------------------------- -# The statements below define a collection of symbols related to -# dynamic loading and shared libraries: -# -# SHLIB_CFLAGS - Flags to pass to cc when compiling the components -# of a shared library (may request position-independent -# code, among other things). -# SHLIB_LD - Base command to use for combining object files -# into a shared library. -# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable -# extensions. An empty string means we don't know how -# to use shared libraries on this platform. -#-------------------------------------------------------------------- - -# Step 1: set the variable "system" to hold the name and version number -# for the system. - -AC_MSG_CHECKING([system version (for dynamic loading)]) -system=`./config.sub $host` -AC_MSG_RESULT($system) - -# Step 2: check for existence of -ldl library. This is needed because -# Linux can use either -ldl or -ldld for dynamic loading. - -AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) - -# Step 3: set configuration options based on system name and version. - -SHLIB_LDLIBS= -fullSrcDir=`cd $srcdir; pwd` -case $system in - *-linux-*) - SHLIB_CFLAGS="-fPIC" - SHLIB_SUFFIX=".so" - if test "$have_dl" = yes; then - SHLIB_LD="${CC}" - SHLIB_LDFLAGS="$LDFLAGS -shared" - LD_FLAGS="-rdynamic" - else - AC_CHECK_HEADER(dld.h, [ - SHLIB_LD="ld" - SHLIB_LDFLAGS="-shared"]) - if test X${enable_m64_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) - fi - if test X${enable_m32_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) - fi - fi - SHLIB_EXTRACT_ALL="" - ;; - *-openbsd*) - # Not available on all versions: check for include file. - AC_CHECK_HEADER(dlfcn.h, [ - SHLIB_CFLAGS="-fpic" - SHLIB_LD="${CC}" - SHLIB_LDFLAGS="$LDFLAGS -shared" - SHLIB_SUFFIX=".so" - if test X${enable_m64_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) - fi - if test X${enable_m32_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) - fi - ], [ - # No dynamic loading. - SHLIB_CFLAGS="" - SHLIB_LD="ld" - SHLIB_LDFLAGS="" - SHLIB_SUFFIX="" - AC_MSG_ERROR(don't know how to compile and link dynamic drivers) - ]) - SHLIB_EXTRACT_ALL="" - ;; - *-netbsd*|*-freebsd*|*-dragonfly*) - # Not available on all versions: check for include file. - AC_CHECK_HEADER(dlfcn.h, [ - SHLIB_CFLAGS="-fpic" - SHLIB_LD="ld" - SHLIB_LDFLAGS="$LDFLAGS -Bshareable -x" - SHLIB_SUFFIX=".so" - if test X${enable_m64_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) - fi - if test X${enable_m32_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) - fi - ], [ - # No dynamic loading. - SHLIB_CFLAGS="" - SHLIB_LD="ld" - SHLIB_LDFLAGS="" - SHLIB_SUFFIX="" - AC_MSG_ERROR(don't know how to compile and link dynamic drivers) - ]) - SHLIB_EXTRACT_ALL="" - ;; - *-solaris2*|*-sysv4*) - SHLIB_CFLAGS="-KPIC" - SHLIB_LD="/usr/ccs/bin/ld" - SHLIB_LDFLAGS="$no_mXX_LDFLAGS -G -z text" - if test X${enable_m64_build} = Xyes; then - SHLIB_LDFLAGS="-64 $SHLIB_LDFLAGS" - fi - if test X${enable_m32_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) - fi - SHLIB_SUFFIX=".so" - SHLIB_EXTRACT_ALL="-z allextract" - ;; - *darwin*) - SHLIB_CFLAGS="-fno-common" - SHLIB_LD="cc" - SHLIB_LDFLAGS="$LDFLAGS -bundle -flat_namespace -undefined suppress" - SHLIB_SUFFIX=".so" - SHLIB_EXTRACT_ALL="" - ;; - *osf1*) - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="ld" - SHLIB_LDFLAGS="$LDFLAGS -shared" - if test X${enable_m64_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) - fi - if test X${enable_m32_build} = Xyes; then - AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) - fi - SHLIB_SUFFIX=".so" - SHLIB_EXTRACT_ALL="" - ;; - *osf5*) - SHLIB_CFLAGS="-fPIC" - SHLIB_LD="${CC} -shared" - SHLIB_LDFLAGS="$LDFLAGS" - SHLIB_SUFFIX=".so" - SHLIB_EXTRACT_ALL="" - ;; - *) - # No dynamic loading. - SHLIB_CFLAGS="" - SHLIB_LD="ld" - SHLIB_LDFLAGS="" - SHLIB_LDLIBS="" - SHLIB_SUFFIX="" - SHLIB_EXTRACT_ALL="" - AC_MSG_ERROR(don't know how to compile and link dynamic drivers) - ;; -esac - -# If we're running gcc, then change the C flags for compiling shared -# libraries to the right flags for gcc, instead of those for the -# standard manufacturer compiler. - -if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then - case $system in - *-aix) - ;; - *-bsd*) - ;; - *-irix) - ;; - *-netbsd|*-freebsd|*-openbsd) - ;; - *-riscos) - ;; - *ultrix4.*) - ;; - *darwin*) - ;; - *) - SHLIB_CFLAGS="-fPIC" - ;; - esac -fi - -# Make it possible for erl_interface to use it's own compiler options -EI_CFLAGS="$CFLAGS" - -# Add thread-safety flags if requested -AC_ARG_ENABLE(shlib-thread-safety, -[ --enable-shlib-thread-safety enable thread safety for build shared libraries], -[ case "$enableval" in - no) ;; - *) SHLIB_CFLAGS="$SHLIB_CFLAGS -D_THREAD_SAFE -D_REENTRANT" - CFLAGS="$CFLAGS -D_THREAD_SAFE -D_REENTRANT" - ;; - esac ], ) - -SHLIB_CFLAGS="$SHLIB_CFLAGS $CFLAGS" - - -AC_SUBST(CFLAGS) -AC_SUBST(SHLIB_LD) -AC_SUBST(SHLIB_LDFLAGS) -AC_SUBST(SHLIB_LDLIBS) -AC_SUBST(SHLIB_CFLAGS) -AC_SUBST(SHLIB_SUFFIX) -AC_SUBST(SHLIB_EXTRACT_ALL) -AC_SUBST(EI_CFLAGS) - -#-------------------------------------------------------------------- -# Check for the existence of the -lsocket and -lnsl libraries. -# The order here is important, so that they end up in the right -# order in the command line generated by make. Here are some -# special considerations: -# 1. Use "connect" and "accept" to check for -lsocket, and -# "gethostbyname" to check for -lnsl. -# 2. Use each function name only once: can't redo a check because -# autoconf caches the results of the last check and won't redo it. -# 3. Use -lnsl and -lsocket only if they supply procedures that -# aren't already present in the normal libraries. This is because -# IRIX 5.2 has libraries, but they aren't needed and they're -# bogus: they goof up name resolution if used. -# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. -# To get around this problem, check for both libraries together -# if -lsocket doesn't work by itself. -#-------------------------------------------------------------------- - -erl_checkBoth=0 -AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1) -if test "$erl_checkSocket" = 1; then - AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1) -fi -if test "$erl_checkBoth" = 1; then - tk_oldLibs=$LIBS - LIBS="$LIBS -lsocket -lnsl" - AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs]) -fi -AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) - -dnl Checks for library functions. -AC_CHECK_FUNCS(strerror) -AC_CHECK_FUNCS(vsnprintf) -AC_CHECK_FUNCS(usleep) - -# First check if the library is available, then if we can choose between -# two versions of gethostbyname -AC_HAVE_LIBRARY(resolv) -AC_CHECK_LIB(resolv, res_gethostbyname,[AC_DEFINE(HAVE_RES_GETHOSTBYNAME,1)]) - -#-------------------------------------------------------------------- -# Check for isfinite -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([for isfinite]) -AC_TRY_LINK([#include ], - [isfinite(0);], have_isfinite=yes, have_isfinite=no) - -if test $have_isfinite = yes; then - AC_DEFINE(HAVE_ISFINITE,1) - AC_MSG_RESULT(yes) -else - AC_DEFINE(HAVE_FINITE,1) - AC_MSG_RESULT(no) -fi - -#-------------------------------------------------------------------- -# Emulator compatible flags (for drivers) -#-------------------------------------------------------------------- - -ERTS_CFLAGS=$CFLAGS -AC_SUBST(ERTS_CFLAGS) - -ERTS_LIBS=$LIBS -AC_SUBST(ERTS_LIBS) - -#-------------------------------------------------------------------- -# Special compiler macro to handle cross compiling -# (HCC) is used to compile tools run in the HOST environment -#-------------------------------------------------------------------- -HCC='$(CC)' -AC_SUBST(HCC) - -#-------------------------------------------------------------------- -# ld is used for linking on vxworks -#-------------------------------------------------------------------- -LD='$(CC) $(CFLAGS)' -AC_SUBST(LD) - -#-------------------------------------------------------------------- -# object file suffix -#-------------------------------------------------------------------- -obj='.o' -AC_SUBST(obj) - -#-------------------------------------------------------------------- -# executable file suffix -#-------------------------------------------------------------------- -exe='' -AC_SUBST(exe) - -#-------------------------------------------------------------------- -# flags when linking for cross platform targets (yet 'tis useful with -# native builds) -#-------------------------------------------------------------------- -CROSSLDFLAGS='' -AC_SUBST(CROSSLDFLAGS) - -dnl -dnl SSL and CRYPTO needs the library openSSL/ssleay -dnl -dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. -dnl If no option is given or --with-ssl is set without a path then we -dnl search for SSL libraries and header files in the standard locations. -dnl If set to --without-ssl we disable the use of SSL -dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we -dnl use "PATH/include" and "PATH/lib". - -AC_SUBST(SSLEAY_ROOT) -TARGET=$host - -# We search for SSL. First in the OTP team ClearCase standard location, -# then in the common OS standard locations -# No we do not. -SSL_APP=ssl -CRYPTO_APP=crypto -SSLEAY_ROOT=$TARGET -#for dir in /usr /usr/pkg /usr/local /usr/local/ssl /usr/lib/ssl /usr/ssl; do -# AC_CHECK_HEADER($dir/include/openssl/opensslv.h, -# ac_cv_openssl=yes, ac_cv_openssl=no) -# if test $ac_cv_openssl = yes ; then -# SSLEAY_ROOT="$dir" -# ssl_found=yes -# break -# fi -#done - -# Find a usable java compiler -# -# WARNING this code is copied from ERTS configure.in, and should be -# updated if that code changes. I hate duplicating code, but what -# can I do. -# -dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY -dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]]) -dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a -dnl AC_LANG_JAVA instead...) -AC_DEFUN(ERL_TRY_LINK_JAVA, -[java_link='$JAVAC conftest.java 1>&AC_FD_CC' -changequote(, )dnl -cat > conftest.java <&AC_FD_CC - cat conftest.java 1>&AC_FD_CC - echo "configure: PATH was $PATH" 1>&AC_FD_CC -ifelse([$4], , , [ rm -rf conftest* - $4 -])dnl -fi -rm -f conftest*]) -dnl -AC_CHECK_PROGS(JAVAC, javac guavac gcj jikes bock) -if test -n "$JAVAC"; then - dnl Make sure it's at least JDK 1.5 - AC_CACHE_CHECK(for JDK version 1.5, - ac_cv_prog_javac_ver_1_5, - [ERL_TRY_LINK_JAVA([], [for (String i : args);], - ac_cv_prog_javac_ver_1_5=yes, ac_cv_prog_javac_ver_1_5=no)]) - if test $ac_cv_prog_javac_ver_1_5 = no; then - unset -v JAVAC - fi -fi -if test -n "$JAVAC"; then - AC_SUBST(JAVAC) - : -fi - -AC_CHECK_PROGS([make_command], [make gmake], [false]) -AC_SUBST(make_command) - -if test "$GCC" = yes; then - test_c_compiler="{gnuc, undefined}" -else - test_c_compiler="undefined" -fi -AC_SUBST(test_c_compiler) - -AC_OUTPUT(conf_vars) diff --git a/lib/test_server/src/cross.cover b/lib/test_server/src/cross.cover deleted file mode 100644 index 07bf0bed5c..0000000000 --- a/lib/test_server/src/cross.cover +++ /dev/null @@ -1,20 +0,0 @@ -%%% This is an -*- erlang -*- file. -%%% -%%% Elements in this file shall be on the form -%%% {Application,Modules}. -%%% -%%% Application is the name of an application or the atom all. -%%% Modules is a list of module names -%%% -%%% The Application shall include the listed Modules in its cover compilation, -%%% but not in the cover analysis. -%%% If Application=all it means that all application shall include the listed -%%% Modules in the cover compilation. -%%% -%%% After all tests are completed, the listed modules are analysed with cover -%%% data from all tests and the result is stored under the application where -%%% the modules belong. - -{all,[]}. - -{observer,[dbg]}. diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl deleted file mode 100644 index e281c9de1b..0000000000 --- a/lib/test_server/src/erl2html2.erl +++ /dev/null @@ -1,311 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Purpose:Convert Erlang files to html. -%%%------------------------------------------------------------------ - --module(erl2html2). --export([convert/3, convert/4]). - -convert([], _Dest, _InclPath) -> % Fake clause. - ok; -convert(File, Dest, InclPath) -> - %% The generated code uses the BGCOLOR attribute in the - %% BODY tag, which wasn't valid until HTML 3.2. Also, - %% good HTML should either override all colour attributes - %% or none of them -- *never* just a few. - %% - %% FIXME: The colours should *really* be set with - %% stylesheets... - %% - %% The html file is written with the same encoding as the input file. - Encoding = encoding(File), - Header = ["\n" - "\n" - "\n" - "\n" - "\n" - "", to_raw_list(File,Encoding), "\n" - "\n\n" - "\n"], - convert(File, Dest, InclPath, Header). - - -convert(File, Dest, InclPath, Header) -> - %% statistics(runtime), - case parse_file(File, InclPath) of - {ok,Functions} -> - %% {_, Time1} = statistics(runtime), - %% io:format("Parsed file in ~.2f Seconds.~n",[Time1/1000]), - case file:open(File,[raw,{read_ahead,10000}]) of - {ok,SFd} -> - case file:open(Dest,[write,raw]) of - {ok,DFd} -> - file:write(DFd,[Header,"
\n"]),
-			    _Lines = build_html(SFd,DFd,encoding(File),Functions),
-			    file:write(DFd,["
\n",footer(), - "\n\n"]), - %% {_, Time2} = statistics(runtime), - %% io:format("Converted ~p lines in ~.2f Seconds.~n", - %% [_Lines, Time2/1000]), - file:close(SFd), - file:close(DFd), - ok; - Error -> - Error - end; - Error -> - Error - end; - Error -> - Error - end. - -%%%----------------------------------------------------------------- -%%% Parse the input file to get the line numbers for all function -%%% definitions. This will be used when creating link targets for each -%%% function in build_html/5. -%%% -%%% All function clauses are also marked in order to allow -%%% possibly_enhance/2 to write these in bold. -%%% -%%% Use expanded preprocessor directives if possible (epp). Only if -%%% this fails, fall back on using non-expanded code (epp_dodger). - -parse_file(File, InclPath) -> - case epp:open(File, InclPath, []) of - {ok,Epp} -> - try parse_preprocessed_file(Epp,File,false) of - Forms -> - epp:close(Epp), - {ok,Forms} - catch - _:{error,_Reason,true} -> - parse_non_preprocessed_file(File); - _:{error,_Reason,false} -> - {ok,[]} - end; - Error = {error,_} -> - Error - end. - -parse_preprocessed_file(Epp, File, InCorrectFile) -> - case epp:parse_erl_form(Epp) of - {ok,Form} -> - case Form of - {attribute,_,file,{File,_}} -> - parse_preprocessed_file(Epp, File, true); - {attribute,_,file,{_OtherFile,_}} -> - parse_preprocessed_file(Epp, File, false); - {function,L,F,A,Cs} when InCorrectFile -> - {CLs,LastCL} = find_clause_lines(Cs, []), - %% tl(CLs) cause we know the start line already - [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ - parse_preprocessed_file(Epp, File, true); - _ -> - parse_preprocessed_file(Epp, File, InCorrectFile) - end; - {error,Reason={_L,epp,{undefined,_Macro,none}}} -> - throw({error,Reason,InCorrectFile}); - {error,_Reason} -> - parse_preprocessed_file(Epp, File, InCorrectFile); - {eof,_Location} -> - [] - end. - -parse_non_preprocessed_file(File) -> - case file:open(File, []) of - {ok,Epp} -> - Forms = parse_non_preprocessed_file(Epp, File, 1), - file:close(Epp), - {ok,Forms}; - Error = {error,_E} -> - Error - end. - -parse_non_preprocessed_file(Epp, File, Location) -> - case epp_dodger:parse_form(Epp, Location) of - {ok,Tree,Location1} -> - try erl_syntax:revert(Tree) of - {function,L,F,A,Cs} -> - {CLs,LastCL} = find_clause_lines(Cs, []), - %% tl(CLs) cause we know the start line already - [{atom_to_list(F),A,get_line(L),LastCL} | tl(CLs)] ++ - parse_non_preprocessed_file(Epp, File, Location1); - _ -> - parse_non_preprocessed_file(Epp, File, Location1) - catch - _:_ -> parse_non_preprocessed_file(Epp, File, Location1) - end; - {error,_E,Location1} -> - parse_non_preprocessed_file(Epp, File, Location1); - {eof,_Location} -> - [] - end. - -get_line(Anno) -> - erl_anno:line(Anno). - -%%%----------------------------------------------------------------- -%%% Find the line number of the last expression in the function -find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause - case classify_exprs(Exprs) of - {anno, Anno} -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(Anno)}; - {tree, Exprs1} -> - find_clause_lines([{clause,CL,undefined,undefined,Exprs1}], CLs); - unknown -> - {lists:reverse([{clause,get_line(CL)}|CLs]), get_line(CL)} - end; -find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> - find_clause_lines(Cs, [{clause,get_line(CL)}|CLs]). - -classify_exprs(Exprs) -> - case tuple_to_list(lists:last(Exprs)) of - [macro,{_var,Anno,_MACRO} | _] -> - {anno, Anno}; - [T,ExprAnno | Exprs1] -> - case erl_anno:is_anno(ExprAnno) of - true -> - {anno, ExprAnno}; - false when T =:= tree -> - {tree, Exprs1}; - false -> - unknown - end - end. - -%%%----------------------------------------------------------------- -%%% Add a link target for each line and one for each function definition. -build_html(SFd,DFd,Encoding,FuncsAndCs) -> - build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs, - false,undefined). - -%% line of last expression in function found -build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) -> - LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8), - file:write(DFd,[""]), - build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined); -%% function start line found -build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs], - _IsFuncDef,_FAndLastL) -> - FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8), - file:write(DFd,[""]), - build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL}); -build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs], - _IsFuncDef,FAndLastL) -> - build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL); -build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) -> - LStr = line_number(L), - Str1 = line(Str,IsFuncDef), - file:write(DFd,[LStr,Str1]), - build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL); -build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) -> - L. - -line_number(L) -> - LStr = integer_to_list(L), - Pred = - case length(LStr) of - Length when Length < 5 -> - lists:duplicate(5-Length,$\s); - _ -> - [] - end, - ["",Pred,LStr,": "]. - -line(Str,IsFuncDef) -> - Str1 = htmlize(Str), - possibly_enhance(Str1,IsFuncDef). - -%%%----------------------------------------------------------------- -%%% Substitute special characters that should not appear in HTML -htmlize([$<|Str]) -> - [$&,$l,$t,$;|htmlize(Str)]; -htmlize([$>|Str]) -> - [$&,$g,$t,$;|htmlize(Str)]; -htmlize([$&|Str]) -> - [$&,$a,$m,$p,$;|htmlize(Str)]; -htmlize([$"|Str]) -> - [$&,$q,$u,$o,$t,$;|htmlize(Str)]; -htmlize([Ch|Str]) -> - [Ch|htmlize(Str)]; -htmlize([]) -> - []. - -%%%----------------------------------------------------------------- -%%% Write comments in italic and function definitions in bold. -possibly_enhance(Str,true) -> - case lists:splitwith(fun($() -> false; (_) -> true end, Str) of - {_,[]} -> Str; - {F,A} -> ["",F,"",A] - end; -possibly_enhance([$%|_]=Str,_) -> - ["",Str--"\n","","\n"]; -possibly_enhance([$-|_]=Str,_) -> - possibly_enhance(Str,true); -possibly_enhance(Str,false) -> - Str. - -%%%----------------------------------------------------------------- -%%% End of the file -footer() -> - "". - -%%%----------------------------------------------------------------- -%%% Read encoding from source file -encoding(File) -> - case epp:read_encoding(File) of - none -> - epp:default_encoding(); - E -> - E - end. - -%%%----------------------------------------------------------------- -%%% Covert encoding atom to string for use in HTML header -html_encoding(latin1) -> - "iso-8859-1"; -html_encoding(utf8) -> - "utf-8". - -%%%----------------------------------------------------------------- -%%% Convert a string to a list of raw printable characters in the -%%% given encoding. This is necessary since the files (source and -%%% destination) are both opened in raw mode (default encoding). Byte -%%% by byte is read from source and written to the destination. This -%%% conversion is needed when printing data that is not first read -%%% from the source. -%%% -%%% Example: if the encoding of the file is utf8, and we have a string -%%% containing "å" = [229], then we need to convert this to [195,165] -%%% before writing. Note that this conversion is only necessary -%%% because the destination file is not (necessarily) opened with utf8 -%%% encoding - it is opened with default encoding in order to allow -%%% raw file mode and byte by byte copying from source. -to_raw_list(X,latin1) when is_list(X) -> - X; -to_raw_list(X,utf8) when is_list(X) -> - binary_to_list(unicode:characters_to_binary(X)). diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src deleted file mode 100644 index 334be8109d..0000000000 --- a/lib/test_server/src/test_server.app.src +++ /dev/null @@ -1,39 +0,0 @@ -% This is an -*- erlang -*- file. -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% - -{application, test_server, - [{description, "The OTP Test Server application"}, - {vsn, "%VSN%"}, - {modules, [ - erl2html2, - test_server_ctrl, - test_server, - test_server_io, - test_server_node, - test_server_sup - ]}, - {registered, [test_server_ctrl, - test_server, - test_server_break_process]}, - {applications, [kernel,stdlib]}, - {env, []}, - {runtime_dependencies, ["tools-2.8","stdlib-2.5","runtime_tools-1.8.16", - "observer-2.1","kernel-4.0","inets-6.0", - "syntax_tools-1.7","erts-7.0"]}]}. - diff --git a/lib/test_server/src/test_server.appup.src b/lib/test_server/src/test_server.appup.src deleted file mode 100644 index 7c4aa630ae..0000000000 --- a/lib/test_server/src/test_server.appup.src +++ /dev/null @@ -1,22 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -{"%VSN%", - [{<<".*">>,[{restart_application, test_server}]}], - [{<<".*">>,[{restart_application, test_server}]}] -}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl deleted file mode 100644 index da6bf491ac..0000000000 --- a/lib/test_server/src/test_server.erl +++ /dev/null @@ -1,2655 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% --module(test_server). - --define(DEFAULT_TIMETRAP_SECS, 60). - -%%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([run_test_case_apply/1,init_target_info/0,init_purify/0]). --export([cover_compile/1,cover_analyse/2]). - -%%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([get_loc/1,set_tc_state/1]). - -%%% TEST SUITE INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([lookup_config/2]). --export([fail/0,fail/1,format/1,format/2,format/3]). --export([capture_start/0,capture_stop/0,capture_get/0]). --export([messages_get/0]). --export([permit_io/2]). --export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). --export([timetrap_scale_factor/0,timetrap/1,get_timetrap_info/0, - timetrap_cancel/1,timetrap_cancel/0]). --export([m_out_of_n/3,do_times/4,do_times/2]). --export([call_crash/3,call_crash/4,call_crash/5]). --export([temp_name/1]). --export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). --export([app_test/1, app_test/2, appup_test/1]). --export([is_native/1]). --export([comment/1, make_priv_dir/0]). --export([os_type/0]). --export([run_on_shielded_node/2]). --export([is_cover/0,is_debug/0,is_commercial/0]). - --export([break/1,break/2,break/3,continue/0,continue/1]). - -%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([purify_new_leaks/0, purify_format/2, purify_new_fds_inuse/0, - purify_is_running/0]). - -%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --include("test_server_internal.hrl"). --include_lib("kernel/include/file.hrl"). - -init_target_info() -> - [$.|Emu] = code:objfile_extension(), - {_, OTPRel} = init:script_id(), - TestServerDir = filename:absname(filename:dirname(code:which(?MODULE))), - #target_info{os_family=test_server_sup:get_os_family(), - os_type=os:type(), - version=erlang:system_info(version), - system_version=erlang:system_info(system_version), - root_dir=code:root_dir(), - test_server_dir=TestServerDir, - emulator=Emu, - otp_release=OTPRel, - username=test_server_sup:get_username(), - cookie=atom_to_list(erlang:get_cookie())}. - -init_purify() -> - purify_new_leaks(). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% cover_compile(#cover{app=App,incl=Include,excl=Exclude,cross=Cross}) -> -%% {ok,#cover{mods=AnalyseModules}} | {error,Reason} -%% -%% App = atom() , name of application to be compiled -%% Exclude = [atom()], list of modules to exclude -%% Include = [atom()], list of modules outside of App that should be included -%% in the cover compilation -%% Cross = [atoms()], list of modules outside of App shat should be included -%% in the cover compilation, but that shall not be part of -%% the cover analysis for this application. -%% AnalyseModules = [atom()], list of successfully compiled modules -%% -%% Cover compile the given application. Return {ok,CoverInfo} if -%% compilation succeeds, else (if application is not found and there -%% are no modules to compile) {error,application_not_found}. - -cover_compile(CoverInfo=#cover{app=none,incl=Include,cross=Cross}) -> - CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), - CompileMods = Include++CrossMods, - case length(CompileMods) of - 0 -> - io:fwrite("WARNING: No modules to cover compile!\n\n",[]), - cover:start(), % start cover server anyway - {ok,CoverInfo#cover{mods=[]}}; - N -> - io:fwrite("Cover compiling ~w modules - " - "this may take some time... ",[N]), - do_cover_compile(CompileMods), - io:fwrite("done\n\n",[]), - {ok,CoverInfo#cover{mods=Include}} - end; -cover_compile(CoverInfo=#cover{app=App,excl=all,incl=Include,cross=Cross}) -> - CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), - CompileMods = Include++CrossMods, - case length(CompileMods) of - 0 -> - io:fwrite("WARNING: No modules to cover compile!\n\n",[]), - cover:start(), % start cover server anyway - {ok,CoverInfo#cover{mods=[]}}; - N -> - io:fwrite("Cover compiling '~w' (~w files) - " - "this may take some time... ",[App,N]), - io:format("\nWARNING: All modules in \'~w\' are excluded\n" - "Only cover compiling modules in include list " - "and the modules\nin the cross cover file:\n" - "~tp\n", [App,CompileMods]), - do_cover_compile(CompileMods), - io:fwrite("done\n\n",[]), - {ok,CoverInfo#cover{mods=Include}} - end; -cover_compile(CoverInfo=#cover{app=App,excl=Exclude, - incl=Include,cross=Cross}) -> - CrossMods = lists:flatmap(fun({_,M}) -> M end,Cross), - case code:lib_dir(App) of - {error,bad_name} -> - case Include++CrossMods of - [] -> - io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" - "Not cover compiling!\n\n",[App]), - {error,application_not_found}; - CompileMods -> - io:fwrite("Cover compiling '~w' (~w files) - " - "this may take some time... ", - [App,length(CompileMods)]), - io:format("\nWARNING: Can't find lib_dir for \'~w\'\n" - "Only cover compiling modules in include list: " - "~tp\n", [App,Include]), - do_cover_compile(CompileMods), - io:fwrite("done\n\n",[]), - {ok,CoverInfo#cover{mods=Include}} - end; - LibDir -> - EbinDir = filename:join([LibDir,"ebin"]), - WC = filename:join(EbinDir,"*.beam"), - AllMods = module_names(filelib:wildcard(WC)), - AnalyseMods = (AllMods ++ Include) -- Exclude, - CompileMods = AnalyseMods ++ CrossMods, - case length(CompileMods) of - 0 -> - io:fwrite("WARNING: No modules to cover compile!\n\n",[]), - cover:start(), % start cover server anyway - {ok,CoverInfo#cover{mods=[]}}; - N -> - io:fwrite("Cover compiling '~w' (~w files) - " - "this may take some time... ",[App,N]), - do_cover_compile(CompileMods), - io:fwrite("done\n\n",[]), - {ok,CoverInfo#cover{mods=AnalyseMods}} - end - end. - - -module_names(Beams) -> - [list_to_atom(filename:basename(filename:rootname(Beam))) || Beam <- Beams]. - - -do_cover_compile(Modules) -> - cover:start(), - Sticky = prepare_cover_compile(Modules,[]), - R = cover:compile_beam(Modules), - [warn_compile(Error) || Error <- R,element(1,Error)=/=ok], - [code:stick_mod(M) || M <- Sticky], - ok. - -warn_compile({error,{Reason,Module}}) -> - io:fwrite("\nWARNING: Could not cover compile ~ts: ~p\n", - [Module,{error,Reason}]). - -%% Make sure all modules are loaded and unstick if sticky -prepare_cover_compile([M|Ms],Sticky) -> - case {code:is_sticky(M),code:is_loaded(M)} of - {true,_} -> - code:unstick_mod(M), - prepare_cover_compile(Ms,[M|Sticky]); - {false,false} -> - case code:load_file(M) of - {module,_} -> - prepare_cover_compile([M|Ms],Sticky); - Error -> - io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]), - prepare_cover_compile(Ms,Sticky) - end; - {false,_} -> - prepare_cover_compile(Ms,Sticky) - end; -prepare_cover_compile([],Sticky) -> - Sticky. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop) -> -%% [{M,{Cov,NotCov,Details}}] -%% -%% Dir = string() -%% Analyse = details | overview -%% Modules = [atom()], the modules to analyse -%% -%% Cover analysis. If Analyse==details analyse_to_file is used. -%% -%% If Analyse==overview analyse_to_file is not used, only an overview -%% containing the number of covered/not covered lines in each module. -%% -%% Also, cover data will be exported to a file called all.coverdata in -%% the given directory. -%% -%% Finally, if Stop==true, then cover will be stopped after the -%% analysis is completed. Stopping cover causes the original (non -%% cover compiled) modules to be loaded back in. If a process at this -%% point is still running old code of any of the cover compiled -%% modules, meaning that is has not done any fully qualified function -%% call after the cover compilation, the process will now be -%% killed. To avoid this scenario, it is possible to set Stop=false, -%% which means that the modules will stay cover compiled. Note that -%% this is only recommended if the erlang node is being terminated -%% after the test is completed. -cover_analyse(Dir,#cover{level=Analyse,mods=Modules,stop=Stop}) -> - io:fwrite(user, "Cover analysing... ", []), - {ATFOk,ATFFail} = - case Analyse of - details -> - case cover:export(filename:join(Dir,"all.coverdata")) of - ok -> - {result,Ok1,Fail1} = - cover:analyse_to_file(Modules,[{outdir,Dir},html]), - {lists:map(fun(OutFile) -> - M = list_to_atom( - filename:basename( - filename:rootname(OutFile, - ".COVER.html") - ) - ), - {M,{file,OutFile}} - end, Ok1), - lists:map(fun({Reason,M}) -> - {M,{error,Reason}} - end, Fail1)}; - Error -> - {[],lists:map(fun(M) -> {M,Error} end, Modules)} - end; - overview -> - case cover:export(filename:join(Dir,"all.coverdata")) of - ok -> - {[],lists:map(fun(M) -> {M,undefined} end, Modules)}; - Error -> - {[],lists:map(fun(M) -> {M,Error} end, Modules)} - end - end, - {result,AOk,AFail} = cover:analyse(Modules,module), - R0 = merge_analysis_results(AOk,ATFOk++ATFFail,[]) ++ - [{M,{error,Reason}} || {Reason,M} <- AFail], - R = lists:sort(R0), - io:fwrite(user, "done\n\n", []), - - case Stop of - true -> - Sticky = unstick_all_sticky(node()), - cover:stop(), - stick_all_sticky(node(),Sticky); - false -> - ok - end, - R. - -merge_analysis_results([{M,{Cov,NotCov}}|T],ATF,Acc) -> - case lists:keytake(M,1,ATF) of - {value,{_,R},ATF1} -> - merge_analysis_results(T,ATF1,[{M,{Cov,NotCov,R}}|Acc]); - false -> - merge_analysis_results(T,ATF,Acc) - end; -merge_analysis_results([],_,Acc) -> - Acc. - -do_cover_for_node(Node,CoverFunc) -> - do_cover_for_node(Node,CoverFunc,true). -do_cover_for_node(Node,CoverFunc,StickUnstick) -> - %% In case a slave node is starting another slave node! I.e. this - %% function is executed on a slave node - then the cover function - %% must be executed on the master node. This is for instance the - %% case in test_server's own tests. - MainCoverNode = cover:get_main_node(), - Sticky = - if StickUnstick -> unstick_all_sticky(MainCoverNode,Node); - true -> ok - end, - rpc:call(MainCoverNode,cover,CoverFunc,[Node]), - if StickUnstick -> stick_all_sticky(Node,Sticky); - true -> ok - end. - -unstick_all_sticky(Node) -> - unstick_all_sticky(node(),Node). -unstick_all_sticky(MainCoverNode,Node) -> - lists:filter( - fun(M) -> - case code:is_sticky(M) of - true -> - rpc:call(Node,code,unstick_mod,[M]), - true; - false -> - false - end - end, - rpc:call(MainCoverNode,cover,modules,[])). - -stick_all_sticky(Node,Sticky) -> - lists:foreach( - fun(M) -> - rpc:call(Node,code,stick_mod,[M]) - end, - Sticky). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> -%% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} -%% -%% Time = float() (seconds) -%% Value = term() -%% Loc = term() -%% Comment = string() -%% Reason = term() -%% -%% Spawns off a process (case process) that actually runs the test suite. -%% The case process will have the job process as group leader, which makes -%% it possible to capture all it's output from io:format/2, etc. -%% -%% The job process then sits down and waits for news from the case process. -%% -%% Returns a tuple with the time spent (in seconds) in the test case, -%% the return value from the test case or an {'EXIT',Reason} if the case -%% failed, Loc points out where the test case crashed (if it did). Loc -%% is either the name of the function, or {,} of the last -%% line executed that had a ?line macro. If the test case did execute -%% erase/0 or similar, it may be empty. Comment is the last comment added -%% by test_server:comment/1, the reason if test_server:fail has been -%% called or the comment given by the return value {comment,Comment} from -%% a test case. -%% -%% {died,Reason,unknown,Comment} is returned if the test case was killed -%% by some other process. Reason is the kill reason provided. -%% -%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}, which indicates a -%% possible extension of all timetraps. Timetraps will be multiplied by -%% MultiplyTimetrap. If it is infinity, no timetraps will be started at all. -%% ScaleTimetrap indicates if test_server should attemp to automatically -%% compensate timetraps for runtime delays introduced by e.g. tools like -%% cover. - -run_test_case_apply({CaseNum,Mod,Func,Args,Name, - RunInit,TimetrapData}) -> - purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), - case os:getenv("TS_RUN_VALGRIND") of - false -> - ok; - _ -> - os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ - atom_to_list(Func)++"-") - end, - ProcBef = erlang:system_info(process_count), - Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData), - ProcAft = erlang:system_info(process_count), - purify_new_leaks(), - DetFail = get(test_server_detected_fail), - {Result,DetFail,ProcBef,ProcAft}. - --type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | - 'end_per_testcase' | {'framework',atom(),atom()} | - 'tc'. --record(st, - { - ref :: reference(), - pid :: pid(), - mf :: {atom(),atom()}, - last_known_loc :: term(), - status :: tc_status() | 'undefined', - ret_val :: term(), - comment :: list(char()), - timeout :: non_neg_integer() | 'infinity', - config :: list() | 'undefined', - end_conf_pid :: pid() | 'undefined' - }). - -run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> - print_timestamp(minor,"Started at "), - print(minor, "", [], internal_raw), - TCCallback = get(test_server_testcase_callback), - LogOpts = get(test_server_logopts), - Ref = make_ref(), - Pid = - spawn_link( - fun() -> - run_test_case_eval(Mod, Func, Args, Name, Ref, - RunInit, TimetrapData, - LogOpts, TCCallback) - end), - put(test_server_detected_fail, []), - St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, - status=starting,ret_val=[],comment="",timeout=infinity, - config=hd(Args)}, - run_test_case_msgloop(St). - -%% Ugly bug (pre R5A): -%% If this process (group leader of the test case) terminates before -%% all messages have been replied back to the io server, the io server -%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in -%% io.erl. -%% -%% A test case is known to have failed if it returns {'EXIT', _} tuple, -%% or sends a message {failed, File, Line} to it's group_leader -%% -run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> - receive - {set_tc_state=Tag,From,{Status,Config0}} -> - Config = case Config0 of - unknown -> St0#st.config; - _ -> Config0 - end, - St = St0#st{status=Status,config=Config}, - From ! {self(),Tag,ok}, - run_test_case_msgloop(St); - {abort_current_testcase,_,_}=Abort when St0#st.status =:= starting -> - %% we're in init phase, must must postpone this operation - %% until test case execution is in progress (or FW:init_tc - %% gets killed) - self() ! Abort, - erlang:yield(), - run_test_case_msgloop(St0); - {abort_current_testcase,Reason,From} -> - Line = case is_process_alive(Pid) of - true -> get_loc(Pid); - false -> unknown - end, - Mon = erlang:monitor(process, Pid), - exit(Pid,{testcase_aborted,Reason,Line}), - erlang:yield(), - From ! {self(),abort_current_testcase,ok}, - St = receive - {'DOWN', Mon, process, Pid, _} -> - St0 - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - exit(Pid, kill), - %% here's the only place we know Reason, so we save - %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~p", - [Reason])), - Error1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(Error, - [$\n])]), - Comment = if length(Error1) > 63 -> - string:substr(Error1,1,60) ++ "..."; - true -> - Error1 - end, - St0#st{comment=Comment} - end, - run_test_case_msgloop(St); - {sync_apply,From,MFA} -> - do_sync_apply(false,From,MFA), - run_test_case_msgloop(St0); - {sync_apply_proxy,Proxy,From,MFA} -> - do_sync_apply(Proxy,From,MFA), - run_test_case_msgloop(St0); - {comment,NewComment0} -> - NewComment1 = test_server_ctrl:to_string(NewComment0), - NewComment = test_server_sup:framework_call(format_comment, - [NewComment1], - NewComment1), - run_test_case_msgloop(St0#st{comment=NewComment}); - {read_comment,From} -> - From ! {self(),read_comment,St0#st.comment}, - run_test_case_msgloop(St0); - {make_priv_dir,From} -> - Config = case St0#st.config of - undefined -> []; - Config0 -> Config0 - end, - Result = - case proplists:get_value(priv_dir, Config) of - undefined -> - {error,no_priv_dir_in_config}; - PrivDir -> - case file:make_dir(PrivDir) of - ok -> - ok; - {error, eexist} -> - ok; - MkDirError -> - {error,{MkDirError,PrivDir}} - end - end, - From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(St0); - {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> - RetVal = {Time/1000000,Value,Loc,Opts}, - St = setup_termination(RetVal, St0#st{config=undefined}), - run_test_case_msgloop(St); - {'EXIT',Pid,Reason} -> - %% This exit typically happens when an unknown external process - %% has caused a test case process to terminate (e.g. if a linked - %% process has crashed). - St = - case Reason of - {What,[Loc0={_M,_F,A,[{file,_}|_]}|_]} when - is_integer(A) -> - Loc = rewrite_loc_item(Loc0), - handle_tc_exit(What, St0#st{last_known_loc=[Loc]}); - {What,[Details,Loc0={_M,_F,A,[{file,_}|_]}|_]} when - is_integer(A) -> - Loc = rewrite_loc_item(Loc0), - handle_tc_exit({What,Details}, St0#st{last_known_loc=[Loc]}); - _ -> - handle_tc_exit(Reason, St0) - end, - run_test_case_msgloop(St); - {EndConfPid0,{call_end_conf,Data,_Result}} -> - #st{mf={Mod,Func},config=CurrConf} = St0, - case CurrConf of - _ when is_list(CurrConf) -> - {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, - spawn_fw_call(Mod,Func,CurrConf,TCPid, - TCExitReason,Loc,self()), - St = St0#st{config=undefined,end_conf_pid=undefined}, - run_test_case_msgloop(St); - _ -> - run_test_case_msgloop(St0) - end; - {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> - %% the framework has been notified, we're finished - RetVal = {T,Value,Loc,Opts}, - Comment0 = St0#st.comment, - Comment = case AddToComment of - undefined -> - Comment0; - _ -> - if Comment0 =:= "" -> - AddToComment; - true -> - Comment0 ++ - test_server_ctrl:xhtml("
", - "
") ++ - AddToComment - end - end, - St = setup_termination(RetVal, St0#st{comment=Comment, - config=undefined}), - run_test_case_msgloop(St); - {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> - %% a framework function failed - CB = os:getenv("TEST_SERVER_FRAMEWORK"), - Loc = case CB of - FW when FW =:= false; FW =:= "undefined" -> - [{test_server,Func}]; - _ -> - [{list_to_atom(CB),Func}] - end, - RetVal = {died,{framework_error,Loc,Error},Loc}, - St = setup_termination(RetVal, St0#st{comment="Framework error", - config=undefined}), - run_test_case_msgloop(St); - {failed,File,Line} -> - put(test_server_detected_fail, - [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(St0); - - {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> - case update_user_timetraps(Pid, StartTime) of - proceed -> - self() ! {abort_current_testcase,E,Pid}; - ignore -> - ok - end, - run_test_case_msgloop(St0); - {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> - %% a user timetrap is triggered, ignore it if new - %% timetrap has been started since - case update_user_timetraps(Pid, StartTime) of - proceed -> - TotalTime = if is_integer(TrapTime) -> - TrapTime + ElapsedTime; - true -> - TrapTime - end, - timetrap(TrapTime, TotalTime, Pid, Scale); - ignore -> - ok - end, - run_test_case_msgloop(St0); - {timetrap_cancel_one,Handle,_From} -> - timetrap_cancel_one(Handle, false), - run_test_case_msgloop(St0); - {timetrap_cancel_all,TCPid,_From} -> - timetrap_cancel_all(TCPid, false), - run_test_case_msgloop(St0); - {get_timetrap_info,From,TCPid} -> - Info = get_timetrap_info(TCPid, false), - From ! {self(),get_timetrap_info,Info}, - run_test_case_msgloop(St0); - _Other when not is_tuple(_Other) -> - %% ignore anything not generated by test server - run_test_case_msgloop(St0); - _Other when element(1, _Other) /= 'EXIT', - element(1, _Other) /= started, - element(1, _Other) /= finished, - element(1, _Other) /= print -> - %% ignore anything not generated by test server - run_test_case_msgloop(St0) - after St0#st.timeout -> - #st{ret_val=RetVal,comment=Comment} = St0, - erlang:append_element(RetVal, Comment) - end. - -setup_termination(RetVal, #st{pid=Pid}=St) -> - timetrap_cancel_all(Pid, false), - St#st{ret_val=RetVal,timeout=20}. - -set_tc_state(State) -> - set_tc_state(State,unknown). -set_tc_state(State, Config) -> - tc_supervisor_req(set_tc_state, {State,Config}). - -handle_tc_exit(killed, St) -> - %% probably the result of an exit(TestCase,kill) call, which is the - %% only way to abort a testcase process that traps exits - %% (see abort_current_testcase). - #st{config=Config,mf={Mod,Func},pid=Pid} = St, - Msg = testcase_aborted_or_killed, - spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), - St; -handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> - #st{config=Config,mf={Mod,Func},pid=Pid} = St, - spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), - St; -handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, - config=Config,pid=Pid}=St) -> - R = case Reason of - {timetrap_timeout,TVal,_} -> - {timetrap,TVal}; - {testcase_aborted=E,AbortReason,_} -> - {E,AbortReason}; - {fw_error,{FwMod,FwFunc,FwError}} -> - FwError; - Other -> - Other - end, - Error = {framework_error,R}, - spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()), - St; -handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) - when is_list(Config0) -> - {R,Loc1,F} = case Reason of - {timetrap_timeout=E,TVal,Loc0} -> - {{E,TVal},Loc0,E}; - {testcase_aborted=E,AbortReason,Loc0} -> - Msg = {E,AbortReason}, - {Msg,Loc0,Msg}; - Other -> - {{'EXIT',Other},unknown,Other} - end, - Timeout = end_conf_timeout(Reason, St), - Config = [{tc_status,{failed,F}}|Config0], - EndConfPid = call_end_conf(Mod, Func, Pid, R, Loc1, Config, Timeout), - St#st{end_conf_pid=EndConfPid}; -handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, - status=Status}=St) -> - {R,Loc1} = case Reason of - {timetrap_timeout=E,TVal,Loc0} -> - {{E,TVal},Loc0}; - {testcase_aborted=E,AbortReason,Loc0} -> - {{E,AbortReason},Loc0}; - Other -> - {{'EXIT',Other},St#st.last_known_loc} - end, - Func = case Status of - init_per_testcase=F -> {F,Func0}; - end_per_testcase=F -> {F,Func0}; - _ -> Func0 - end, - spawn_fw_call(Mod, Func, Config, Pid, R, Loc1, self()), - St. - -end_conf_timeout({timetrap_timeout,Timeout,_}, _) -> - Timeout; -end_conf_timeout(_, #st{config=Config}) when is_list(Config) -> - proplists:get_value(default_timeout, Config, ?DEFAULT_TIMETRAP_SECS*1000); -end_conf_timeout(_, _) -> - ?DEFAULT_TIMETRAP_SECS*1000. - -call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> - Starter = self(), - Data = {Mod,Func,TCPid,TCExitReason,Loc}, - case erlang:function_exported(Mod,end_per_testcase,2) of - false -> - spawn_link(fun() -> - Starter ! {self(),{call_end_conf,Data,ok}} - end); - true -> - do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) - end. - -do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) -> - EndConfProc = - fun() -> - process_flag(trap_exit,true), % to catch timetraps - Supervisor = self(), - EndConfApply = - fun() -> - timetrap(TVal), - try apply(Mod,end_per_testcase,[Func,Conf]) of - _ -> ok - catch - _:Why -> - timer:sleep(1), - group_leader() ! {printout,12, - "WARNING! " - "~w:end_per_testcase(~w, ~p)" - " crashed!\n\tReason: ~p\n", - [Mod,Func,Conf,Why]} - end, - Supervisor ! {self(),end_conf} - end, - Pid = spawn_link(EndConfApply), - receive - {Pid,end_conf} -> - Starter ! {self(),{call_end_conf,Data,ok}}; - {'EXIT',Pid,Reason} -> - group_leader() ! {printout,12, - "WARNING! ~w:end_per_testcase(~w, ~p)" - " failed!\n\tReason: ~p\n", - [Mod,Func,Conf,Reason]}, - Starter ! {self(),{call_end_conf,Data,{error,Reason}}}; - {'EXIT',_OtherPid,Reason} -> - %% Probably the parent - not much to do about that - exit(Reason) - end - end, - spawn_link(EndConfProc). - -spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid, - {timetrap_timeout,TVal}=Why, - Loc,SendTo) -> - FwCall = - fun() -> - Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, - %% if init_per_testcase fails, the test case - %% should be skipped - try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of - _ -> ok - catch - _:FwEndTCErr -> - exit({fw_notify_done,end_tc,FwEndTCErr}) - end, - %% finished, report back - SendTo ! {self(),fw_notify_done, - {TVal/1000,Skip,Loc,[],undefined}} - end, - spawn_link(FwCall); - -spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, - {timetrap_timeout,TVal}=Why,_Loc,SendTo) -> - FwCall = - fun() -> - {RetVal,Report} = - case proplists:get_value(tc_status, EndConf) of - undefined -> - E = {failed,{Mod,end_per_testcase,Why}}, - {E,E}; - E = {failed,Reason} -> - {E,{error,Reason}}; - Result -> - E = {failed,{Mod,end_per_testcase,Why}}, - {Result,E} - end, - group_leader() ! {printout,12, - "WARNING! ~w:end_per_testcase(~w, ~p)" - " failed!\n\tReason: timetrap timeout" - " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, - FailLoc = proplists:get_value(tc_fail_loc, EndConf), - try do_end_tc_call(Mod,Func, - {Pid,Report,[EndConf]}, Why) of - _ -> ok - catch - _:FwEndTCErr -> - exit({fw_notify_done,end_tc,FwEndTCErr}) - end, - Warn = "" - "WARNING: end_per_testcase timed out!", - %% finished, report back (if end_per_testcase fails, a warning - %% should be printed as part of the comment) - SendTo ! {self(),fw_notify_done, - {TVal/1000,RetVal,FailLoc,[],Warn}} - end, - spawn_link(FwCall); - -spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> - FwCall = - fun() -> - test_server_sup:framework_call(report, [framework_error, - {{FwMod,FwFunc}, - FwError}]), - Comment = - lists:flatten( - io_lib:format("" - "WARNING! ~w:~w failed!", - [FwMod,FwFunc])), - %% finished, report back - SendTo ! {self(),fw_notify_done, - {died,{error,{FwMod,FwFunc,FwError}}, - {FwMod,FwFunc},[],Comment}} - end, - spawn_link(FwCall); - -spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> - Func1 = case Func of - {_InitOrEndPerTC,F} -> F; - F -> F - end, - FwCall = - fun() -> - try fw_error_notify(Mod,Func1,[], - Error,Loc) of - _ -> ok - catch - _:FwErrorNotifyErr -> - exit({fw_notify_done,error_notification, - FwErrorNotifyErr}) - end, - Conf = [{tc_status,{failed,Error}}|CurrConf], - try do_end_tc_call(Mod,Func1, - {Pid,Error,[Conf]},Error) of - _ -> ok - catch - _:FwEndTCErr -> - exit({fw_notify_done,end_tc,FwEndTCErr}) - end, - %% finished, report back - SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}} - end, - spawn_link(FwCall). - -%% The job proxy process forwards messages between the test case -%% process on a shielded node (and its descendants) and the job process. -%% -%% The job proxy process have to be started by the test-case process -%% on the shielded node! -start_job_proxy() -> - group_leader(spawn(fun () -> job_proxy_msgloop() end), self()), ok. - -%% The io_reply_proxy is not the most satisfying solution but it works... -io_reply_proxy(ReplyTo) -> - receive - IoReply when is_tuple(IoReply), - element(1, IoReply) == io_reply -> - ReplyTo ! IoReply; - _ -> - io_reply_proxy(ReplyTo) - end. - -job_proxy_msgloop() -> - receive - - %% - %% Messages that need intervention by proxy... - %% - - %% io stuff ... - IoReq when tuple_size(IoReq) >= 2, - element(1, IoReq) == io_request -> - - ReplyProxy = spawn(fun () -> io_reply_proxy(element(2, IoReq)) end), - group_leader() ! setelement(2, IoReq, ReplyProxy); - - %% test_server stuff... - {sync_apply, From, MFA} -> - group_leader() ! {sync_apply_proxy, self(), From, MFA}; - {sync_result_proxy, To, Result} -> - To ! {sync_result, Result}; - - %% - %% Messages that need no intervention by proxy... - %% - Msg -> - group_leader() ! Msg - end, - job_proxy_msgloop(). - -%% A test case is known to have failed if it returns {'EXIT', _} tuple, -%% or sends a message {failed, File, Line} to it's group_leader - -run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, - TimetrapData, LogOpts, TCCallback) -> - put(test_server_multiply_timetraps, TimetrapData), - put(test_server_logopts, LogOpts), - Where = [{Mod,Func}], - put(test_server_loc, Where), - - FWInitResult = test_server_sup:framework_call(init_tc,[Mod,Func,Args0], - {ok,Args0}), - set_tc_state(running), - {{Time,Value},Loc,Opts} = - case FWInitResult of - {ok,Args} -> - run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); - Error = {error,_Reason} -> - NewResult = do_end_tc_call(Mod,Func, {Error,Args0}, - {auto_skip,{failed,Error}}), - {{0,NewResult},Where,[]}; - {fail,Reason} -> - Conf = [{tc_status,{failed,Reason}} | hd(Args0)], - fw_error_notify(Mod, Func, Conf, Reason), - NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]}, - {fail,Reason}), - {{0,NewResult},Where,[]}; - Skip = {SkipType,_Reason} when SkipType == skip; - SkipType == skipped -> - NewResult = do_end_tc_call(Mod,Func, - {Skip,Args0}, Skip), - {{0,NewResult},Where,[]}; - AutoSkip = {auto_skip,_Reason} -> - %% special case where a conf case "pretends" to be skipped - NewResult = - do_end_tc_call(Mod,Func, {AutoSkip,Args0}, AutoSkip), - {{0,NewResult},Where,[]} - end, - exit({Ref,Time,Value,Loc,Opts}). - -run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> - case RunInit of - run_init -> - set_tc_state(init_per_testcase, hd(Args)), - ensure_timetrap(Args), - case init_per_testcase(Mod, Func, Args) of - Skip = {SkipType,Reason} when SkipType == skip; - SkipType == skipped -> - Line = get_loc(), - Conf = [{tc_status,{skipped,Reason}}|hd(Args)], - NewRes = do_end_tc_call(Mod,Func, - {Skip,[Conf]}, Skip), - {{0,NewRes},Line,[]}; - {skip_and_save,Reason,SaveCfg} -> - Line = get_loc(), - Conf = [{tc_status,{skipped,Reason}}, - {save_config,SaveCfg}|hd(Args)], - NewRes = do_end_tc_call(Mod,Func, {{skip,Reason},[Conf]}, - {skip,Reason}), - {{0,NewRes},Line,[]}; - FailTC = {fail,Reason} -> % user fails the testcase - EndConf = [{tc_status,{failed,Reason}} | hd(Args)], - fw_error_notify(Mod, Func, EndConf, Reason), - NewRes = do_end_tc_call(Mod,Func, - {{error,Reason},[EndConf]}, - FailTC), - {{0,NewRes},[{Mod,Func}],[]}; - {ok,NewConf} -> - %% call user callback function if defined - NewConf1 = - user_callback(TCCallback, Mod, Func, init, NewConf), - %% save current state in controller loop - set_tc_state(tc, NewConf1), - %% execute the test case - {{T,Return},Loc} = {ts_tc(Mod,Func,[NewConf1]), get_loc()}, - {EndConf,TSReturn,FWReturn} = - case Return of - {E,TCError} when E=='EXIT' ; E==failed -> - fw_error_notify(Mod, Func, NewConf1, - TCError, Loc), - {[{tc_status,{failed,TCError}}, - {tc_fail_loc,Loc}|NewConf1], - Return,{error,TCError}}; - SaveCfg={save_config,_} -> - {[{tc_status,ok},SaveCfg|NewConf1],Return,ok}; - {skip_and_save,Why,SaveCfg} -> - Skip = {skip,Why}, - {[{tc_status,{skipped,Why}}, - {save_config,SaveCfg}|NewConf1], - Skip,Skip}; - {SkipType,Why} when SkipType == skip; - SkipType == skipped -> - {[{tc_status,{skipped,Why}}|NewConf1],Return, - Return}; - _ -> - {[{tc_status,ok}|NewConf1],Return,ok} - end, - %% call user callback function if defined - EndConf1 = - user_callback(TCCallback, Mod, Func, 'end', EndConf), - %% update current state in controller loop - {FWReturn1,TSReturn1,EndConf2} = - case end_per_testcase(Mod, Func, EndConf1) of - SaveCfg1={save_config,_} -> - {FWReturn,TSReturn, - [SaveCfg1|lists:keydelete(save_config,1, - EndConf1)]}; - {fail,ReasonToFail} -> - %% user has failed the testcase - fw_error_notify(Mod, Func, EndConf1, - ReasonToFail), - {{error,ReasonToFail}, - {failed,ReasonToFail}, - EndConf1}; - {failed,{_,end_per_testcase,_}} = Failure when - FWReturn == ok -> - %% unexpected termination in end_per_testcase - %% report this as the result to the framework - {Failure,TSReturn,EndConf1}; - _ -> - %% test case result should be reported to - %% framework no matter the status of - %% end_per_testcase - {FWReturn,TSReturn,EndConf1} - end, - %% clear current state in controller loop - case do_end_tc_call(Mod,Func, - {FWReturn1,[EndConf2]}, TSReturn1) of - {failed,Reason} = NewReturn -> - fw_error_notify(Mod,Func,EndConf2, Reason), - {{T,NewReturn},[{Mod,Func}],[]}; - NewReturn -> - {{T,NewReturn},Loc,[]} - end - end; - skip_init -> - set_tc_state(running, hd(Args)), - %% call user callback function if defined - Args1 = user_callback(TCCallback, Mod, Func, init, Args), - ensure_timetrap(Args1), - %% ts_tc does a catch - %% if this is a named conf group, the test case (init or end conf) - %% should be called with the name as the first argument - Args2 = if Name == undefined -> Args1; - true -> [Name | Args1] - end, - %% execute the conf test case - {{T,Return},Loc} = {ts_tc(Mod, Func, Args2),get_loc()}, - %% call user callback function if defined - Return1 = user_callback(TCCallback, Mod, Func, 'end', Return), - {Return2,Opts} = process_return_val([Return1], Mod, Func, - Args1, [{Mod,Func}], Return1), - {{T,Return2},Loc,Opts} - end. - -do_end_tc_call(Mod, Func, Res, Return) -> - FwMod = os:getenv("TEST_SERVER_FRAMEWORK"), - Ref = make_ref(), - if FwMod == "ct_framework" ; FwMod == "undefined"; FwMod == false -> - case test_server_sup:framework_call( - end_tc, [Mod,Func,Res, Return], ok) of - {fail,FWReason} -> - {failed,FWReason}; - ok -> - case Return of - {fail,Reason} -> - {failed,Reason}; - Return -> - Return - end; - NewReturn -> - NewReturn - end; - true -> - case test_server_sup:framework_call(FwMod, end_tc, - [Mod,Func,Res], Ref) of - {fail,FWReason} -> - {failed,FWReason}; - _Else -> - Return - end - end. - -%% the return value is a list and we have to check if it contains -%% the result of an end conf case or if it's a Config list -process_return_val([Return], M,F,A, Loc, Final) when is_list(Return) -> - ReturnTags = [skip,skip_and_save,save_config,comment,return_group_result], - %% check if all elements in the list are valid end conf return value tuples - case lists:all(fun(Val) when is_tuple(Val) -> - lists:any(fun(T) -> T == element(1, Val) end, - ReturnTags); - (ok) -> - true; - (_) -> - false - end, Return) of - true -> % must be return value from end conf case - process_return_val1(Return, M,F,A, Loc, Final, []); - false -> % must be Config value from init conf case - case do_end_tc_call(M, F, {ok,A}, Return) of - {failed, FWReason} = Failed -> - fw_error_notify(M,F,A, FWReason), - {Failed, []}; - NewReturn -> - {NewReturn, []} - end - end; -%% the return value is not a list, so it's the return value from an -%% end conf case or it's a dummy value that can be ignored -process_return_val(Return, M,F,A, Loc, Final) -> - process_return_val1(Return, M,F,A, Loc, Final, []). - -process_return_val1([Failed={E,TCError}|_], M,F,A=[Args], Loc, _, SaveOpts) - when E=='EXIT'; - E==failed -> - fw_error_notify(M,F,A, TCError, Loc), - case do_end_tc_call(M,F, {{error,TCError}, - [[{tc_status,{failed,TCError}}|Args]]}, - Failed) of - {failed,FWReason} -> - {{failed,FWReason},SaveOpts}; - NewReturn -> - {NewReturn,SaveOpts} - end; -process_return_val1([SaveCfg={save_config,_}|Opts], M,F,[Args], - Loc, Final, SaveOpts) -> - process_return_val1(Opts, M,F,[[SaveCfg|Args]], Loc, Final, SaveOpts); -process_return_val1([{skip_and_save,Why,SaveCfg}|Opts], M,F,[Args], - Loc, _, SaveOpts) -> - process_return_val1(Opts, M,F,[[{save_config,SaveCfg}|Args]], - Loc, {skip,Why}, SaveOpts); -process_return_val1([GR={return_group_result,_}|Opts], M,F,A, - Loc, Final, SaveOpts) -> - process_return_val1(Opts, M,F,A, Loc, Final, [GR|SaveOpts]); -process_return_val1([RetVal={Tag,_}|Opts], M,F,A, - Loc, _, SaveOpts) when Tag==skip; - Tag==comment -> - process_return_val1(Opts, M,F,A, Loc, RetVal, SaveOpts); -process_return_val1([_|Opts], M,F,A, Loc, Final, SaveOpts) -> - process_return_val1(Opts, M,F,A, Loc, Final, SaveOpts); -process_return_val1([], M,F,A, _Loc, Final, SaveOpts) -> - case do_end_tc_call(M,F, {Final,A}, Final) of - {failed,FWReason} -> - {{failed,FWReason},SaveOpts}; - NewReturn -> - {NewReturn,lists:reverse(SaveOpts)} - end. - -user_callback(undefined, _, _, _, Args) -> - Args; -user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, - [Args]) when is_list(Args) -> - case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of - Args1 when is_list(Args1) -> - [Args1]; - _ -> - [Args] - end; -user_callback({CBMod,CBFunc}, Mod, Func, InitOrEnd, Args) -> - case catch apply(CBMod, CBFunc, [InitOrEnd,Mod,Func,Args]) of - Args1 when is_list(Args1) -> - Args1; - _ -> - Args - end. - -init_per_testcase(Mod, Func, Args) -> - case code:is_loaded(Mod) of - false -> code:load_file(Mod); - _ -> ok - end, - case erlang:function_exported(Mod, init_per_testcase, 2) of - true -> - do_init_per_testcase(Mod, [Func|Args]); - false -> - %% Optional init_per_testcase is not defined -- keep quiet. - [Config] = Args, - {ok, Config} - end. - -do_init_per_testcase(Mod, Args) -> - try apply(Mod, init_per_testcase, Args) of - {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> - {skip,Reason}; - {skip_and_save,_,_}=Res -> - Res; - NewConf when is_list(NewConf) -> - case lists:filter(fun(T) when is_tuple(T) -> false; - (_) -> true end, NewConf) of - [] -> - {ok,NewConf}; - Bad -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}} - end; - {fail,_Reason}=Res -> - Res; - _Other -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase did not return " - "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(), - FormattedLoc = test_server_sup:format_loc(Line), - group_leader() ! {printout,12, - "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~ts\n\tReason: ~p\n", - [FormattedLoc, Other]}, - {skip,{failed,{Mod,init_per_testcase,Other}}}; - _:Reason0 -> - Stk = erlang:get_stacktrace(), - Reason = {Reason0,Stk}, - set_loc(Stk), - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(Line), - group_leader() ! {printout,12, - "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~ts\n\tReason: ~p\n", - [FormattedLoc,Reason]}, - {skip,{failed,{Mod,init_per_testcase,Reason}}} - end. - -end_per_testcase(Mod, Func, Conf) -> - case erlang:function_exported(Mod,end_per_testcase,2) of - true -> - do_end_per_testcase(Mod,end_per_testcase,Func,Conf); - false -> - %% Backwards compatibility! - case erlang:function_exported(Mod,fin_per_testcase,2) of - true -> - do_end_per_testcase(Mod,fin_per_testcase,Func,Conf); - false -> - ok - end - end. - -do_end_per_testcase(Mod,EndFunc,Func,Conf) -> - set_tc_state(end_per_testcase, Conf), - try Mod:EndFunc(Func, Conf) of - {save_config,_}=SaveCfg -> - SaveCfg; - {fail,_}=Fail -> - Fail; - _ -> - ok - catch - throw:Other -> - Comment0 = case read_comment() of - "" -> ""; - Cmt -> Cmt ++ test_server_ctrl:xhtml("
", - "
") - end, - set_loc(erlang:get_stacktrace()), - comment(io_lib:format("~ts" - "WARNING: ~w thrown!" - "\n",[Comment0,EndFunc])), - group_leader() ! {printout,12, - "WARNING: ~w thrown!\n" - "Reason: ~p\n" - "Line: ~ts\n", - [EndFunc, Other, - test_server_sup:format_loc(get_loc())]}, - {failed,{Mod,end_per_testcase,Other}}; - Class:Reason -> - Stk = erlang:get_stacktrace(), - set_loc(Stk), - Why = case Class of - exit -> {'EXIT',Reason}; - error -> {'EXIT',{Reason,Stk}} - end, - Comment0 = case read_comment() of - "" -> ""; - Cmt -> Cmt ++ test_server_ctrl:xhtml("
", - "
") - end, - comment(io_lib:format("~ts" - "WARNING: ~w crashed!" - "\n",[Comment0,EndFunc])), - group_leader() ! {printout,12, - "WARNING: ~w crashed!\n" - "Reason: ~p\n" - "Line: ~ts\n", - [EndFunc, Reason, - test_server_sup:format_loc(get_loc())]}, - {failed,{Mod,end_per_testcase,Why}} - end. - -get_loc() -> - get(test_server_loc). - -get_loc(Pid) -> - [{current_stacktrace,Stk0},{dictionary,Dict}] = - process_info(Pid, [current_stacktrace,dictionary]), - lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), - Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], - case get(test_server_loc) of - [{Suite,Case}] -> - %% Location info unknown, check if {Suite,Case,Line} - %% is available in stacktrace and if so, use stacktrace - %% instead of current test_server_loc. - %% If location is the last expression in a test case - %% function, the info is not available due to tail call - %% elimination. We need to check if the test case has been - %% called by ts_tc/3 and, if so, insert the test case info - %% at that position. - case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of - [match|_] -> - put(test_server_loc, Stk); - _ -> - {PreTC,PostTC} = - lists:splitwith(fun({test_server,ts_tc,_}) -> - false; - (_) -> - true - end, Stk), - if PostTC == [] -> - ok; - true -> - put(test_server_loc, - PreTC++[{Suite,Case,last_expr} | PostTC]) - end - end; - _ -> - put(test_server_loc, Stk) - end, - get_loc(). - -fw_error_notify(Mod, Func, Args, Error) -> - test_server_sup:framework_call(error_notification, - [Mod,Func,[Args], - {Error,unknown}]). -fw_error_notify(Mod, Func, Args, Error, Loc) -> - test_server_sup:framework_call(error_notification, - [Mod,Func,[Args], - {Error,Loc}]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print(Detail,Format,Args,Printer) -> ok -%% Detail = integer() -%% Format = string() -%% Args = [term()] -%% -%% Just like io:format, except that depending on the Detail value, the output -%% is directed to console, major and/or minor log files. - -%% print(Detail,Format,Args) -> -%% test_server_ctrl:print(Detail, Format, Args). - -print(Detail,Format,Args,Printer) -> - test_server_ctrl:print(Detail, Format, Args, Printer). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print_timsteamp(Detail,Leader) -> ok -%% -%% Prints Leader followed by a time stamp (date and time). Depending on -%% the Detail value, the output is directed to console, major and/or minor -%% log files. - -print_timestamp(Detail,Leader) -> - test_server_ctrl:print_timestamp(Detail, Leader). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% lookup_config(Key,Config) -> {value,{Key,Value}} | undefined -%% Key = term() -%% Value = term() -%% Config = [{Key,Value},...] -%% -%% Looks up a specific key in the config list, and returns the value -%% of the associated key, or undefined if the key doesn't exist. - -lookup_config(Key,Config) -> - case lists:keysearch(Key,1,Config) of - {value,{Key,Val}} -> - Val; - _ -> - io:format("Could not find element ~p in Config.~n",[Key]), - undefined - end. - -%% -%% IMPORTANT: get_loc/1 uses the name of this function when analysing -%% stack traces. If the name changes, get_loc/1 must be updated! -%% -ts_tc(M, F, A) -> - Before = erlang:monotonic_time(), - 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), - case Type of - throw -> - {failed,{thrown,Reason}}; - error -> - {'EXIT',{Reason,Stk}}; - exit -> - {'EXIT',Reason} - end - end, - After = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds), - {Elapsed, Result}. - -set_loc(Stk) -> - Loc = case [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk] of - [{M,F,0}|Stack] -> - [{M,F}|Stack]; - Other -> - Other - end, - put(test_server_loc, Loc). - -rewrite_loc_item({M,F,_,Loc}) -> - {M,F,proplists:get_value(line, Loc, 0)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% TEST SUITE SUPPORT FUNCTIONS %% -%% %% -%% Note: Some of these functions have been moved to test_server_sup %% -%% in an attempt to keep this modules small (yeah, right!) %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% format(Format) -> IoLibReturn -%% format(Detail,Format) -> IoLibReturn -%% format(Format,Args) -> IoLibReturn -%% format(Detail,Format,Args) -> IoLibReturn -%% Detail = integer() -%% Format = string() -%% Args = [term(),...] -%% IoLibReturn = term() -%% -%% Logs the Format string and Args, similar to io:format/1/2 etc. If -%% Detail is not specified, the default detail level (which is 50) is used. -%% Which log files the string will be logged in depends on the thresholds -%% set with set_levels/3. Typically with default detail level, only the -%% minor log file is used. -format(Format) -> - format(minor, Format, []). - -format(major, Format) -> - format(major, Format, []); -format(minor, Format) -> - format(minor, Format, []); -format(Detail, Format) when is_integer(Detail) -> - format(Detail, Format, []); -format(Format, Args) -> - format(minor, Format, Args). - -format(Detail, Format, Args) -> - Str = - case catch io_lib:format(Format,Args) of - {'EXIT',_} -> - io_lib:format("illegal format; ~p with args ~p.\n", - [Format,Args]); - Valid -> Valid - end, - log({Detail, Str}). - -log(Msg) -> - group_leader() ! {structured_io, self(), Msg}, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% capture_start() -> ok -%% capture_stop() -> ok -%% -%% Starts/stops capturing all output from io:format, and similar. Capturing -%% output doesn't stop output from happening. It just makes it possible -%% to retrieve the output using capture_get/0. -%% Starting and stopping capture doesn't affect already captured output. -%% All output is stored as messages in the message queue until retrieved - -capture_start() -> - group_leader() ! {capture,self()}, - ok. - -capture_stop() -> - group_leader() ! {capture,false}, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% capture_get() -> Output -%% Output = [string(),...] -%% -%% Retrieves all the captured output since last call to capture_get/0. -%% Note that since output arrive as messages to the process, it takes -%% a short while from the call to io:format until all output is available -%% by capture_get/0. It is not necessary to call capture_stop/0 before -%% retreiving the output. -capture_get() -> - test_server_sup:capture_get([]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% messages_get() -> Messages -%% Messages = [term(),...] -%% -%% Returns all messages in the message queue. -messages_get() -> - test_server_sup:messages_get([]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% permit_io(GroupLeader, FromPid) -> ok -%% -%% Make sure proceeding IO from FromPid won't get rejected -permit_io(GroupLeader, FromPid) -> - GroupLeader ! {permit_io,FromPid}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% sleep(Time) -> ok -%% Time = integer() | float() | infinity -%% -%% Sleeps the specified number of milliseconds. This sleep also accepts -%% floating point numbers (which are truncated) and the atom 'infinity'. -sleep(infinity) -> - receive - after infinity -> - ok - end; -sleep(MSecs) -> - receive - after trunc(MSecs) -> - ok - end, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% adjusted_sleep(Time) -> ok -%% Time = integer() | float() | infinity -%% -%% Sleeps the specified number of milliseconds, multiplied by the -%% 'multiply_timetraps' value (if set) and possibly also automatically scaled -%% up if 'scale_timetraps' is set to true (which is default). -%% This function also accepts floating point numbers (which are truncated) and -%% the atom 'infinity'. -adjusted_sleep(infinity) -> - receive - after infinity -> - ok - end; -adjusted_sleep(MSecs) -> - {Multiplier,ScaleFactor} = - case test_server_ctrl:get_timetrap_parameters() of - {undefined,undefined} -> - {1,1}; - {undefined,false} -> - {1,1}; - {undefined,true} -> - {1,timetrap_scale_factor()}; - {infinity,_} -> - {infinity,1}; - {Mult,undefined} -> - {Mult,1}; - {Mult,false} -> - {Mult,1}; - {Mult,true} -> - {Mult,timetrap_scale_factor()} - end, - receive - after trunc(MSecs*Multiplier*ScaleFactor) -> - ok - end, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% fail(Reason) -> exit({suite_failed,Reason}) -%% -%% Immediately calls exit. Included because test suites are easier -%% to read when using this function, rather than exit directly. -fail(Reason) -> - comment(cast_to_list(Reason)), - try - exit({suite_failed,Reason}) - catch - Class:R -> - case erlang:get_stacktrace() of - [{?MODULE,fail,1,_}|Stk] -> ok; - Stk -> ok - end, - erlang:raise(Class, R, Stk) - end. - -cast_to_list(X) when is_list(X) -> X; -cast_to_list(X) when is_atom(X) -> atom_to_list(X); -cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% fail() -> exit(suite_failed) -%% -%% Immediately calls exit. Included because test suites are easier -%% to read when using this function, rather than exit directly. -fail() -> - try - exit(suite_failed) - catch - Class:R -> - case erlang:get_stacktrace() of - [{?MODULE,fail,0,_}|Stk] -> ok; - Stk -> ok - end, - erlang:raise(Class, R, Stk) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% break(Comment) -> ok -%% -%% Break a test case so part of the test can be done manually. -%% Use continue/0 to continue. -break(Comment) -> - break(?MODULE, Comment). - -break(CBM, Comment) -> - break(CBM, '', Comment). - -break(CBM, TestCase, Comment) -> - timetrap_cancel(), - {TCName,CntArg,PName} = - if TestCase == '' -> - {"", "", test_server_break_process}; - true -> - Str = atom_to_list(TestCase), - {[32 | Str], Str, - list_to_atom("test_server_break_process_" ++ Str)} - end, - io:format(user, - "\n\n\n--- SEMIAUTOMATIC TESTING ---" - "\nThe test case~ts executes on process ~w" - "\n\n\n~ts" - "\n\n\n-----------------------------\n\n" - "Continue with --> ~w:continue(~ts).\n", - [TCName,self(),Comment,CBM,CntArg]), - case whereis(PName) of - undefined -> - spawn_break_process(self(), PName); - OldBreakProcess -> - OldBreakProcess ! cancel, - spawn_break_process(self(), PName) - end, - receive continue -> ok end. - -spawn_break_process(Pid, PName) -> - spawn(fun() -> - register(PName, self()), - receive - continue -> continue(Pid); - cancel -> ok - end - end). - -continue() -> - case whereis(test_server_break_process) of - undefined -> ok; - BreakProcess -> BreakProcess ! continue - end. - -continue(TestCase) when is_atom(TestCase) -> - PName = list_to_atom("test_server_break_process_" ++ - atom_to_list(TestCase)), - case whereis(PName) of - undefined -> ok; - BreakProcess -> BreakProcess ! continue - end; - -continue(Pid) when is_pid(Pid) -> - Pid ! continue. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap_scale_factor() -> Factor -%% -%% Returns the amount to scale timetraps with. - -%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true -timetrap_scale_factor() -> - timetrap_scale_factor([ - { 2, fun() -> has_lock_checking() end}, - { 3, fun() -> has_superfluous_schedulers() end}, - { 5, fun() -> purify_is_running() end}, - { 6, fun() -> is_debug() end}, - {10, fun() -> is_cover() end} - ]). - -timetrap_scale_factor(Scales) -> - %% The fun in {S, Fun} a filter input to the list comprehension - lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap(Timeout) -> Handle -%% Handle = term() -%% -%% Creates a time trap, that will kill the calling process if the -%% trap is not cancelled with timetrap_cancel/1, within Timeout milliseconds. -timetrap(Timeout) -> - MultAndScale = - case get(test_server_multiply_timetraps) of - undefined -> {fun(T) -> T end, true}; - {undefined,false} -> {fun(T) -> T end, false}; - {undefined,_} -> {fun(T) -> T end, true}; - {infinity,_} -> {fun(_) -> infinity end, false}; - {Int,Scale} -> {fun(infinity) -> infinity; - (T) -> T*Int end, Scale} - end, - timetrap(Timeout, Timeout, self(), MultAndScale). - -%% when the function is called from different process than -%% the test case, the test_server_multiply_timetraps data -%% is unknown and must be passed as argument -timetrap(Timeout, TCPid, MultAndScale) -> - timetrap(Timeout, Timeout, TCPid, MultAndScale). - -timetrap(Timeout0, TimeToReport0, TCPid, MultAndScale = {Multiplier,Scale}) -> - %% the time_ms call will either convert Timeout to ms or spawn a - %% user timetrap which sends the result to the IO server process - Timeout = time_ms(Timeout0, TCPid, MultAndScale), - Timeout1 = Multiplier(Timeout), - TimeToReport = if Timeout0 == TimeToReport0 -> - Timeout1; - true -> - %% only convert to ms, don't start a - %% user timetrap - time_ms_check(TimeToReport0) - end, - cancel_default_timetrap(self() == TCPid), - Handle = case Timeout1 of - infinity -> - infinity; - _ -> - spawn_link(test_server_sup,timetrap,[Timeout1,TimeToReport, - Scale,TCPid]) - end, - - %% ERROR! This sets dict on IO process instead of testcase process - %% if Timeout is return value from previous user timetrap!! - - case get(test_server_timetraps) of - undefined -> - put(test_server_timetraps,[{Handle,TCPid,{TimeToReport,Scale}}]); - List -> - List1 = lists:delete({infinity,TCPid,{infinity,false}}, List), - put(test_server_timetraps,[{Handle,TCPid, - {TimeToReport,Scale}}|List1]) - end, - Handle. - -ensure_timetrap(Config) -> - case get(test_server_timetraps) of - [_|_] -> - ok; - _ -> - case get(test_server_default_timetrap) of - undefined -> ok; - Garbage -> - erase(test_server_default_timetrap), - format("=== WARNING: garbage in " - "test_server_default_timetrap: ~p~n", - [Garbage]) - end, - DTmo = case lists:keysearch(default_timeout,1,Config) of - {value,{default_timeout,Tmo}} -> Tmo; - _ -> ?DEFAULT_TIMETRAP_SECS - end, - format("=== test_server setting default " - "timetrap of ~p seconds~n", - [DTmo]), - put(test_server_default_timetrap, timetrap(seconds(DTmo))) - end. - -%% executing on IO process, no default timetrap ever set here -cancel_default_timetrap(false) -> - ok; -cancel_default_timetrap(true) -> - case get(test_server_default_timetrap) of - undefined -> - ok; - TimeTrap when is_pid(TimeTrap) -> - timetrap_cancel(TimeTrap), - erase(test_server_default_timetrap), - format("=== test_server canceled default timetrap " - "since another timetrap was set~n"), - ok; - Garbage -> - erase(test_server_default_timetrap), - format("=== WARNING: garbage in " - "test_server_default_timetrap: ~p~n", - [Garbage]), - error - end. - -time_ms({hours,N}, _, _) -> hours(N); -time_ms({minutes,N}, _, _) -> minutes(N); -time_ms({seconds,N}, _, _) -> seconds(N); -time_ms({Other,_N}, _, _) -> - format("=== ERROR: Invalid time specification: ~p. " - "Should be seconds, minutes, or hours.~n", [Other]), - exit({invalid_time_format,Other}); -time_ms(Ms, _, _) when is_integer(Ms) -> Ms; -time_ms(infinity, _, _) -> infinity; -time_ms(Fun, TCPid, MultAndScale) when is_function(Fun) -> - time_ms_apply(Fun, TCPid, MultAndScale); -time_ms({M,F,A}=MFA, TCPid, MultAndScale) when is_atom(M), - is_atom(F), - is_list(A) -> - time_ms_apply(MFA, TCPid, MultAndScale); -time_ms(Other, _, _) -> exit({invalid_time_format,Other}). - -time_ms_check(MFA = {M,F,A}) when is_atom(M), is_atom(F), is_list(A) -> - MFA; -time_ms_check(Fun) when is_function(Fun) -> - Fun; -time_ms_check(Other) -> - time_ms(Other, undefined, undefined). - -time_ms_apply(Func, TCPid, MultAndScale) -> - {_,GL} = process_info(TCPid, group_leader), - WhoAmI = self(), % either TC or IO server - T0 = erlang:monotonic_time(), - UserTTSup = - spawn(fun() -> - user_timetrap_supervisor(Func, WhoAmI, TCPid, - GL, T0, MultAndScale) - end), - receive - {UserTTSup,infinity} -> - %% remember the user timetrap so that it can be cancelled - save_user_timetrap(TCPid, UserTTSup, T0), - %% we need to make sure the user timetrap function - %% gets time to execute and return - timetrap(infinity, TCPid, MultAndScale) - after 5000 -> - exit(UserTTSup, kill), - if WhoAmI /= GL -> - exit({user_timetrap_error,time_ms_apply}); - true -> - format("=== ERROR: User timetrap execution failed!", []), - ignore - end - end. - -user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> - process_flag(trap_exit, true), - Spawner ! {self(),infinity}, - MonRef = monitor(process, TCPid), - UserTTSup = self(), - group_leader(GL, UserTTSup), - UserTT = spawn_link(fun() -> call_user_timetrap(Func, UserTTSup) end), - receive - {UserTT,Result} -> - demonitor(MonRef, [flush]), - T1 = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), - try time_ms_check(Result) of - TimeVal -> - %% this is the new timetrap value to set (return value - %% from a fun or an MFA) - GL ! {user_timetrap,TCPid,TimeVal,T0,Elapsed,MultAndScale} - catch _:_ -> - %% when other than a legal timetrap value is returned - %% which will be the normal case for user timetraps - GL ! {user_timetrap,TCPid,0,T0,Elapsed,MultAndScale} - end; - {'EXIT',UserTT,Error} when Error /= normal -> - demonitor(MonRef, [flush]), - GL ! {user_timetrap,TCPid,0,T0,{user_timetrap_error,Error}, - MultAndScale}; - {'DOWN',MonRef,_,_,_} -> - demonitor(MonRef, [flush]), - exit(UserTT, kill) - end. - -call_user_timetrap(Func, Sup) when is_function(Func) -> - try Func() of - Result -> - Sup ! {self(),Result} - catch _:Error -> - exit({Error,erlang:get_stacktrace()}) - end; -call_user_timetrap({M,F,A}, Sup) -> - try apply(M,F,A) of - Result -> - Sup ! {self(),Result} - catch _:Error -> - exit({Error,erlang:get_stacktrace()}) - end. - -save_user_timetrap(TCPid, UserTTSup, StartTime) -> - %% save pid of user timetrap supervisor process so that - %% it may be stopped even before the timetrap func has returned - NewUserTT = {TCPid,{UserTTSup,StartTime}}, - case get(test_server_user_timetrap) of - undefined -> - put(test_server_user_timetrap, [NewUserTT]); - UserTTSups -> - case proplists:get_value(TCPid, UserTTSups) of - undefined -> - put(test_server_user_timetrap, - [NewUserTT | UserTTSups]); - PrevTTSup -> - %% remove prev user timetrap - remove_user_timetrap(PrevTTSup), - put(test_server_user_timetrap, - [NewUserTT | proplists:delete(TCPid, - UserTTSups)]) - end - end. - -update_user_timetraps(TCPid, StartTime) -> - %% called when a user timetrap is triggered - case get(test_server_user_timetrap) of - undefined -> - proceed; - UserTTs -> - case proplists:get_value(TCPid, UserTTs) of - {_UserTTSup,StartTime} -> % same timetrap - put(test_server_user_timetrap, - proplists:delete(TCPid, UserTTs)), - proceed; - {OtherUserTTSup,OtherStartTime} -> - case OtherStartTime - StartTime of - Diff when Diff >= 0 -> - ignore; - _ -> - exit(OtherUserTTSup, kill), - put(test_server_user_timetrap, - proplists:delete(TCPid, UserTTs)), - proceed - end; - undefined -> - proceed - end - end. - -remove_user_timetrap(TTSup) -> - exit(TTSup, kill). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap_cancel(Handle) -> ok -%% Handle = term() -%% -%% Cancels a time trap. -timetrap_cancel(Handle) -> - timetrap_cancel_one(Handle, true). - -timetrap_cancel_one(infinity, _SendToServer) -> - ok; -timetrap_cancel_one(Handle, SendToServer) -> - case get(test_server_timetraps) of - undefined -> - ok; - [{Handle,_,_}] -> - erase(test_server_timetraps); - Timers -> - case lists:keysearch(Handle, 1, Timers) of - {value,_} -> - put(test_server_timetraps, - lists:keydelete(Handle, 1, Timers)); - false when SendToServer == true -> - group_leader() ! {timetrap_cancel_one,Handle,self()}; - false -> - ok - end - end, - test_server_sup:timetrap_cancel(Handle). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap_cancel() -> ok -%% -%% Cancels timetrap for current test case. -timetrap_cancel() -> - timetrap_cancel_all(self(), true). - -timetrap_cancel_all(TCPid, SendToServer) -> - case get(test_server_timetraps) of - undefined -> - ok; - Timers -> - [timetrap_cancel_one(Handle, false) || - {Handle,Pid,_} <- Timers, Pid == TCPid] - end, - case get(test_server_user_timetrap) of - undefined -> - ok; - UserTTs -> - case proplists:get_value(TCPid, UserTTs) of - {UserTTSup,_StartTime} -> - remove_user_timetrap(UserTTSup), - put(test_server_user_timetrap, - proplists:delete(TCPid, UserTTs)); - undefined -> - ok - end - end, - if SendToServer == true -> - group_leader() ! {timetrap_cancel_all,TCPid,self()}; - true -> - ok - end, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% get_timetrap_info() -> {Timeout,Scale} | undefined -%% -%% Read timetrap info for current test case -get_timetrap_info() -> - get_timetrap_info(self(), true). - -get_timetrap_info(TCPid, SendToServer) -> - case get(test_server_timetraps) of - undefined -> - undefined; - Timers -> - case [Info || {Handle,Pid,Info} <- Timers, - Pid == TCPid, Handle /= infinity] of - [I|_] -> - I; - [] when SendToServer == true -> - tc_supervisor_req({get_timetrap_info,TCPid}); - [] -> - undefined - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% hours(N) -> Milliseconds -%% minutes(N) -> Milliseconds -%% seconds(N) -> Milliseconds -%% N = integer() | float() -%% Milliseconds = integer() -%% -%% Transforms the named units to milliseconds. Fractions in the input -%% are accepted. The output is an integer. -hours(N) -> trunc(N * 1000 * 60 * 60). -minutes(N) -> trunc(N * 1000 * 60). -seconds(N) -> trunc(N * 1000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% tc_supervisor_req(Tag) -> Result -%% tc_supervisor_req(Tag, Msg) -> Result -%% - -tc_supervisor_req(Tag) -> - Pid = test_server_gl:get_tc_supervisor(group_leader()), - Pid ! {Tag,self()}, - receive - {Pid,Tag,Result} -> - Result - after 5000 -> - error(no_answer_from_tc_supervisor) - end. - -tc_supervisor_req(Tag, Msg) -> - Pid = test_server_gl:get_tc_supervisor(group_leader()), - Pid ! {Tag,self(),Msg}, - receive - {Pid,Tag,Result} -> - Result - after 5000 -> - error(no_answer_from_tc_supervisor) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timecall(M,F,A) -> {Time,Val} -%% Time = float() -%% -%% Measures the time spent evaluating MFA. The measurement is done with -%% erlang:now/0, and should have pretty good accuracy on most platforms. -%% The function is not evaluated in a catch context. -timecall(M, F, A) -> - test_server_sup:timecall(M,F,A). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_times(N,M,F,A) -> ok -%% do_times(N,Fun) -> -%% N = integer() -%% Fun = fun() -> void() -%% -%% Evaluates MFA or Fun N times, and returns ok. -do_times(N,M,F,A) when N>0 -> - apply(M,F,A), - do_times(N-1,M,F,A); -do_times(0,_,_,_) -> - ok. - -do_times(N,Fun) when N>0 -> - Fun(), - do_times(N-1,Fun); -do_times(0,_) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% m_out_of_n(M,N,Fun) -> ok | exit({m_out_of_n_failed,{R,left_to_do}}) -%% M = integer() -%% N = integer() -%% Fun = fun() -> void() -%% R = integer() -%% -%% Repeats evaluating the given function until it succeeded (didn't crash) -%% M times. If, after N times, M successful attempts have not been -%% accomplished, the process crashes with reason {m_out_of_n_failed -%% {R,left_to_do}}, where R indicates how many cases that remained to be -%% successfully completed. -%% -%% For example: -%% m_out_of_n(1,4,fun() -> tricky_test_case() end) -%% Tries to run tricky_test_case() up to 4 times, -%% and is happy if it succeeds once. -%% -%% m_out_of_n(7,8,fun() -> clock_sanity_check() end) -%% Tries running clock_sanity_check() up to 8 -%% times and allows the function to fail once. -%% This might be useful if clock_sanity_check/0 -%% is known to fail if the clock crosses an hour -%% boundary during the test (and the up to 8 -%% test runs could never cross 2 boundaries) -m_out_of_n(0,_,_) -> - ok; -m_out_of_n(M,0,_) -> - exit({m_out_of_n_failed,{M,left_to_do}}); -m_out_of_n(M,N,Fun) -> - case catch Fun() of - {'EXIT',_} -> - m_out_of_n(M,N-1,Fun); - _Other -> - m_out_of_n(M-1,N-1,Fun) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%call_crash(M,F,A) -%%call_crash(Time,M,F,A) -%%call_crash(Time,Crash,M,F,A) -%% M - atom() -%% F - atom() -%% A - [term()] -%% Time - integer() in milliseconds. -%% Crash - term() -%% -%% Spaws a new process that calls MFA. The call is considered -%% successful if the call crashes with the given reason (Crash), -%% or any other reason if Crash is not specified. -%% ** The call must terminate withing the given Time (defaults -%% to infinity), or it is considered a failure (exit with reason -%% 'call_crash_timeout' is generated). - -call_crash(M,F,A) -> - call_crash(infinity,M,F,A). -call_crash(Time,M,F,A) -> - call_crash(Time,any,M,F,A). -call_crash(Time,Crash,M,F,A) -> - test_server_sup:call_crash(Time,Crash,M,F,A). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% start_node(SlaveName, Type, Options) -> -%% {ok, Slave} | {error, Reason} -%% -%% SlaveName = string(), atom(). -%% Type = slave | peer -%% Options = [{tuple(), term()}] -%% -%% OptionList is a tuplelist wich may contain one -%% or more of these members: -%% -%% Slave and Peer: -%% {remote, true} - Start the node on a remote host. If not specified, -%% the node will be started on the local host (with -%% some exceptions, for instance VxWorks, -%% where all nodes are started on a remote host). -%% {args, Arguments} - Arguments passed directly to the node. -%% {cleanup, false} - Nodes started with this option will not be killed -%% by the test server after completion of the test case -%% Therefore it is IMPORTANT that the USER terminates -%% the node!! -%% {erl, ReleaseList} - Use an Erlang emulator determined by ReleaseList -%% when starting nodes, instead of the same emulator -%% as the test server is running. ReleaseList is a list -%% of specifiers, where a specifier is either -%% {release, Rel}, {prog, Prog}, or 'this'. Rel is -%% either the name of a release, e.g., "r7a" or -%% 'latest'. 'this' means using the same emulator as -%% the test server. Prog is the name of an emulator -%% executable. If the list has more than one element, -%% one of them is picked randomly. (Only -%% works on Solaris and Linux, and the test -%% server gives warnings when it notices that -%% nodes are not of the same version as -%% itself.) -%% -%% Peer only: -%% {wait, false} - Don't wait for the node to be started. -%% {fail_on_error, false} - Returns {error, Reason} rather than failing -%% the test case. This option can only be used with -%% peer nodes. -%% Note that slave nodes always act as if they had -%% fail_on_error==false. -%% - -start_node(Name, Type, Options) -> - lists:foreach( - fun(N) -> - case firstname(N) of - Name -> - format("=== WARNING: Trying to start node \'~w\' when node" - " with same first name exists: ~w", [Name, N]); - _other -> ok - end - end, - nodes()), - - group_leader() ! {sync_apply, - self(), - {test_server_ctrl,start_node,[Name,Type,Options]}}, - Result = receive {sync_result,R} -> R end, - - case Result of - {ok,Node} -> - - %% Cannot run cover on shielded node or on a node started - %% by a shielded node. - Cover = case is_cover(Node) of - true -> - proplists:get_value(start_cover,Options,true); - false -> - false - end, - - net_adm:ping(Node), - case Cover of - true -> - do_cover_for_node(Node,start); - _ -> - ok - end, - {ok,Node}; - {fail,Reason} -> fail(Reason); - Error -> Error - end. - -firstname(N) -> - list_to_atom(upto($@,atom_to_list(N))). - -%% This should!!! crash if H is not member in list. -upto(H, [H | _T]) -> []; -upto(H, [X | T]) -> [X | upto(H,T)]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% wait_for_node(Name) -> ok | {error,timeout} -%% -%% If a node is started with the options {wait,false}, this function -%% can be used to wait for the node to come up from the -%% test server point of view (i.e. wait until it has contacted -%% the test server controller after startup) -wait_for_node(Slave) -> - group_leader() ! {sync_apply, - self(), - {test_server_ctrl,wait_for_node,[Slave]}}, - Result = receive {sync_result,R} -> R end, - case Result of - ok -> - net_adm:ping(Slave), - case is_cover(Slave) of - true -> - do_cover_for_node(Slave,start); - _ -> - ok - end; - _ -> - ok - end, - Result. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% stop_node(Name) -> true|false -%% -%% Kills a (remote) node. -%% Also inform test_server_ctrl so it can clean up! -stop_node(Slave) -> - Cover = is_cover(Slave), - if Cover -> do_cover_for_node(Slave,flush,false); - true -> ok - end, - group_leader() ! {sync_apply,self(),{test_server_ctrl,stop_node,[Slave]}}, - Result = receive {sync_result,R} -> R end, - case Result of - ok -> - erlang:monitor_node(Slave, true), - slave:stop(Slave), - receive - {nodedown, Slave} -> - format(minor, "Stopped slave node: ~w", [Slave]), - format(major, "=node_stop ~w", [Slave]), - if Cover -> do_cover_for_node(Slave,stop,false); - true -> ok - end, - true - after 30000 -> - format("=== WARNING: Node ~w does not seem to terminate.", - [Slave]), - erlang:monitor_node(Slave, false), - receive {nodedown, Slave} -> ok after 0 -> ok end, - false - end; - {error, _Reason} -> - %% Either, the node is already dead or it was started - %% with the {cleanup,false} option, or it was started - %% in some other way than test_server:start_node/3 - format("=== WARNING: Attempt to stop a nonexisting slavenode (~w)~n" - "=== Trying to kill it anyway!!!", - [Slave]), - case net_adm:ping(Slave)of - pong -> - erlang:monitor_node(Slave, true), - slave:stop(Slave), - receive - {nodedown, Slave} -> - format(minor, "Stopped slave node: ~w", [Slave]), - format(major, "=node_stop ~w", [Slave]), - if Cover -> do_cover_for_node(Slave,stop,false); - true -> ok - end, - true - after 30000 -> - format("=== WARNING: Node ~w does not seem to terminate.", - [Slave]), - erlang:monitor_node(Slave, false), - receive {nodedown, Slave} -> ok after 0 -> ok end, - false - end; - pang -> - if Cover -> do_cover_for_node(Slave,stop,false); - true -> ok - end, - false - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_release_available(Release) -> true | false -%% Release -> string() -%% -%% Test if a release (such as "r10b") is available to be -%% started using start_node/3. - -is_release_available(Release) -> - group_leader() ! {sync_apply, - self(), - {test_server_ctrl,is_release_available,[Release]}}, - receive {sync_result,R} -> R end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_on_shielded_node(Fun, CArgs) -> term() -%% Fun -> function() -%% CArg -> list() -%% -%% -%% Fun is executed in a process on a temporarily created -%% hidden node. Communication with the job process goes -%% via a job proxy process on the hidden node, i.e. the -%% group leader of the test case process is the job proxy -%% process. This makes it possible to start nodes from the -%% hidden node that are unaware of the test server node. -%% Without the job proxy process all processes would have -%% a process residing on the test_server node as group_leader. -%% -%% Fun - Function to execute -%% CArg - Extra command line arguments to use when starting -%% the shielded node. -%% -%% If Fun is successfully executed, the result is returned. -%% - -run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> - Nr = erlang:unique_integer([positive]), - Name = "shielded_node-" ++ integer_to_list(Nr), - Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of - {ok, N} -> N; - Err -> fail({failed_to_start_shielded_node, Err}) - end, - Master = self(), - Ref = make_ref(), - Slave = spawn(Node, - fun () -> - start_job_proxy(), - receive - Ref -> - Master ! {Ref, Fun()} - end, - receive after infinity -> infinity end - end), - MRef = erlang:monitor(process, Slave), - Slave ! Ref, - receive - {'DOWN', MRef, _, _, Info} -> - stop_node(Node), - fail(Info); - {Ref, Res} -> - stop_node(Node), - receive - {'DOWN', MRef, _, _, _} -> - Res - end - end. - -%% Return true if Name or node() is a shielded node -is_shielded(Name) -> - case {cast_to_list(Name),atom_to_list(node())} of - {"shielded_node"++_,_} -> true; - {_,"shielded_node"++_} -> true; - _ -> false - end. - -same_version(Name) -> - ThisVersion = erlang:system_info(version), - OtherVersion = rpc:call(Name, erlang, system_info, [version]), - ThisVersion =:= OtherVersion. - -is_cover(Name) -> - case is_cover() of - true -> - not is_shielded(Name) andalso same_version(Name); - false -> - false - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% temp_name(Stem) -> string() -%% Stem = string() -%% -%% Create a unique file name, based on (starting with) Stem. -%% A filename of the form is generated, and the -%% function checks that that file doesn't already exist. -temp_name(Stem) -> - Num = erlang:unique_integer([positive]), - RandomName = Stem ++ integer_to_list(Num), - {ok,Files} = file:list_dir(filename:dirname(Stem)), - case lists:member(RandomName,Files) of - true -> - %% oh, already exists - bad luck. Try again. - temp_name(Stem); %% recursively try again - false -> - RandomName - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% app_test/1 -%% -app_test(App) -> - app_test(App, pedantic). -app_test(App, Mode) -> - test_server_sup:app_test(App, Mode). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% appup_test/1 -%% -appup_test(App) -> - test_server_sup:appup_test(App). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_native(Mod) -> true | false -%% -%% Checks wether the module is natively compiled or not. - -is_native(Mod) -> - (catch Mod:module_info(native)) =:= true. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% comment(String) -> ok -%% -%% The given String will occur in the comment field -%% of the table on the test suite result page. If -%% called several times, only the last comment is -%% printed. -%% comment/1 is also overwritten by the return value -%% {comment,Comment} or fail/1 (which prints Reason -%% as a comment). -comment(String) -> - group_leader() ! {comment,String}, - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% read_comment() -> string() -%% -%% Read the current comment string stored in -%% state during test case execution. -read_comment() -> - tc_supervisor_req(read_comment). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% make_priv_dir() -> ok -%% -%% Order test server to create the private directory -%% for the current test case. -make_priv_dir() -> - tc_supervisor_req(make_priv_dir). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% os_type() -> OsType -%% -%% Returns the OsType of the target node. OsType is -%% the same as returned from os:type() -os_type() -> - os:type(). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_cover() -> boolean() -%% -%% Returns true if cover is running, else false -is_cover() -> - case whereis(cover_server) of - undefined -> false; - _ -> true - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_debug() -> boolean() -%% -%% Returns true if the emulator is debug-compiled, false otherwise. -is_debug() -> - case catch erlang:system_info(debug_compiled) of - {'EXIT', _} -> - case string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> true; - _ -> false - end; - Res -> - Res - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% has_lock_checking() -> boolean() -%% -%% Returns true if the emulator has lock checking enabled, false otherwise. -has_lock_checking() -> - case catch erlang:system_info(lock_checking) of - {'EXIT', _} -> false; - Res -> Res - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% has_superfluous_schedulers() -> boolean() -%% -%% Returns true if the emulator has more scheduler threads than logical -%% processors, false otherwise. -has_superfluous_schedulers() -> - case catch {erlang:system_info(schedulers), - erlang:system_info(logical_processors)} of - {S, P} when is_integer(S), is_integer(P), S > P -> true; - _ -> false - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_commercial_build() -> boolean() -%% -%% Returns true if the current emulator is commercially supported. -%% (The emulator will not have "[source]" in its start-up message.) -%% We might want to do more tests on a commercial platform, for instance -%% ensuring that all applications have documentation). -is_commercial() -> - case string:str(erlang:system_info(system_version), "source") of - Int when is_integer(Int), Int > 0 -> false; - _ -> true - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% DEBUGGER INTERFACE %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% purify_is_running() -> false|true -%% -%% Tests if Purify is currently running. - -purify_is_running() -> - case catch erlang:system_info({error_checker, running}) of - {'EXIT', _} -> false; - Res -> Res - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% purify_new_leaks() -> false|BytesLeaked -%% BytesLeaked = integer() -%% -%% Checks for new memory leaks if Purify is active. -%% Returns the number of bytes leaked, or false if Purify -%% is not running. -purify_new_leaks() -> - case catch erlang:system_info({error_checker, memory}) of - {'EXIT', _} -> false; - Leaked when is_integer(Leaked) -> Leaked - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% purify_new_fds_inuse() -> false|FdsInuse -%% FdsInuse = integer() -%% -%% Checks for new file descriptors in use. -%% Returns the number of new file descriptors in use, or false -%% if Purify is not running. -purify_new_fds_inuse() -> - case catch erlang:system_info({error_checker, fd}) of - {'EXIT', _} -> false; - Inuse when is_integer(Inuse) -> Inuse - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% purify_format(Format, Args) -> ok -%% Format = string() -%% Args = lists() -%% -%% Outputs the formatted string to Purify's logfile,if Purify is active. -purify_format(Format, Args) -> - (catch erlang:system_info({error_checker, io_lib:format(Format, Args)})), - ok. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Apply given function and reply to caller or proxy. -%% -do_sync_apply(Proxy, From, {M,F,A}) -> - Result = apply(M, F, A), - if is_pid(Proxy) -> Proxy ! {sync_result_proxy,From,Result}; - true -> From ! {sync_result,Result} - end. diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl deleted file mode 100644 index cd08a25bd8..0000000000 --- a/lib/test_server/src/test_server_ctrl.erl +++ /dev/null @@ -1,5652 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_ctrl). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The Erlang Test Server %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% MODULE DEPENDENCIES: -%% HARD TO REMOVE: erlang, lists, io_lib, gen_server, file, io, string, -%% code, ets, rpc, gen_tcp, inet, erl_tar, sets, -%% test_server, test_server_sup, test_server_node -%% EASIER TO REMOVE: filename, filelib, lib, re -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%% SUPERVISOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([start/0, start/1, start_link/1, stop/0]). - -%%% OPERATOR INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([add_spec/1, add_dir/2, add_dir/3]). --export([add_module/1, add_module/2, - add_conf/3, - add_case/2, add_case/3, add_cases/2, add_cases/3]). --export([add_dir_with_skip/3, add_dir_with_skip/4, add_tests_with_skip/3]). --export([add_module_with_skip/2, add_module_with_skip/3, - add_conf_with_skip/4, - add_case_with_skip/3, add_case_with_skip/4, - add_cases_with_skip/3, add_cases_with_skip/4]). --export([jobs/0, run_test/1, wait_finish/0, idle_notify/1, - abort_current_testcase/1, abort/0]). --export([start_get_totals/1, stop_get_totals/0]). --export([reject_io_reqs/1, get_levels/0, set_levels/3]). --export([multiply_timetraps/1, scale_timetraps/1, get_timetrap_parameters/0]). --export([create_priv_dir/1]). --export([cover/1, cover/2, cover/3, - cover_compile/7, cover_analyse/2, cross_cover_analyse/2, - trc/1, stop_trace/0]). --export([testcase_callback/1]). --export([set_random_seed/1]). --export([kill_slavenodes/0]). - -%%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([print/2, print/3, print/4, print_timestamp/2]). --export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). --export([format/1, format/2, format/3, to_string/1]). --export([get_target_info/0]). --export([get_hosts/0]). --export([node_started/1]). --export([uri_encode/1,uri_encode/2]). - -%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([i/0, p/1, p/3, pi/2, pi/4, t/0, t/1]). - -%%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([init/1, terminate/2]). --export([handle_call/3, handle_cast/2, handle_info/2]). --export([do_test_cases/4]). --export([do_spec/2, do_spec_list/2]). --export([xhtml/2]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --include("test_server_internal.hrl"). --include_lib("kernel/include/file.hrl"). --define(suite_ext, "_SUITE"). --define(log_ext, ".log.html"). --define(src_listing_ext, ".src.html"). --define(logdir_ext, ".logs"). --define(data_dir_suffix, "_data/"). --define(suitelog_name, "suite.log"). --define(coverlog_name, "cover.html"). --define(raw_coverlog_name, "cover.log"). --define(cross_coverlog_name, "cross_cover.html"). --define(raw_cross_coverlog_name, "cross_cover.log"). --define(cross_cover_info, "cross_cover.info"). --define(cover_total, "total_cover.log"). --define(unexpected_io_log, "unexpected_io.log.html"). --define(last_file, "last_name"). --define(last_link, "last_link"). --define(last_test, "last_test"). --define(html_ext, ".html"). --define(now, os:timestamp()). - --define(void_fun, fun() -> ok end). --define(mod_result(X), if X == skip -> skipped; - X == auto_skip -> skipped; - true -> X end). - --define(auto_skip_color, "#FFA64D"). --define(user_skip_color, "#FF8000"). --define(sortable_table_name, "SortableTable"). - --record(state,{jobs=[], levels={1,19,10}, reject_io_reqs=false, - multiply_timetraps=1, scale_timetraps=true, - create_priv_dir=auto_per_run, finish=false, - target_info, trc=false, cover=false, wait_for_node=[], - testcase_callback=undefined, idle_notify=[], - get_totals=false, random_seed=undefined}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% OPERATOR INTERFACE - -add_dir(Name, Job=[Dir|_Dirs]) when is_list(Dir) -> - add_job(cast_to_list(Name), - lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job)); -add_dir(Name, Dir) -> - add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}). - -add_dir(Name, Job=[Dir|_Dirs], Pattern) when is_list(Dir) -> - add_job(cast_to_list(Name), - lists:map(fun(D)-> {dir,cast_to_list(D), - cast_to_list(Pattern)} end, Job)); -add_dir(Name, Dir, Pattern) -> - add_job(cast_to_list(Name), {dir,cast_to_list(Dir),cast_to_list(Pattern)}). - -add_module(Mod) when is_atom(Mod) -> - add_job(atom_to_list(Mod), {Mod,all}). - -add_module(Name, Mods) when is_list(Mods) -> - add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods)). - -add_conf(Name, Mod, Conf) when is_tuple(Conf) -> - add_job(cast_to_list(Name), {Mod,[Conf]}); - -add_conf(Name, Mod, Confs) when is_list(Confs) -> - add_job(cast_to_list(Name), {Mod,Confs}). - -add_case(Mod, Case) when is_atom(Mod), is_atom(Case) -> - add_job(atom_to_list(Mod), {Mod,Case}). - -add_case(Name, Mod, Case) when is_atom(Mod), is_atom(Case) -> - add_job(Name, {Mod,Case}). - -add_cases(Mod, Cases) when is_atom(Mod), is_list(Cases) -> - add_job(atom_to_list(Mod), {Mod,Cases}). - -add_cases(Name, Mod, Cases) when is_atom(Mod), is_list(Cases) -> - add_job(Name, {Mod,Cases}). - -add_spec(Spec) -> - Name = filename:rootname(Spec, ".spec"), - case filelib:is_file(Spec) of - true -> add_job(Name, {spec,Spec}); - false -> {error,nofile} - end. - -%% This version of the interface is to be used if there are -%% suites or cases that should be skipped. - -add_dir_with_skip(Name, Job=[Dir|_Dirs], Skip) when is_list(Dir) -> - add_job(cast_to_list(Name), - lists:map(fun(D)-> {dir,cast_to_list(D)} end, Job), - Skip); -add_dir_with_skip(Name, Dir, Skip) -> - add_job(cast_to_list(Name), {dir,cast_to_list(Dir)}, Skip). - -add_dir_with_skip(Name, Job=[Dir|_Dirs], Pattern, Skip) when is_list(Dir) -> - add_job(cast_to_list(Name), - lists:map(fun(D)-> {dir,cast_to_list(D), - cast_to_list(Pattern)} end, Job), - Skip); -add_dir_with_skip(Name, Dir, Pattern, Skip) -> - add_job(cast_to_list(Name), - {dir,cast_to_list(Dir),cast_to_list(Pattern)}, Skip). - -add_module_with_skip(Mod, Skip) when is_atom(Mod) -> - add_job(atom_to_list(Mod), {Mod,all}, Skip). - -add_module_with_skip(Name, Mods, Skip) when is_list(Mods) -> - add_job(cast_to_list(Name), lists:map(fun(Mod) -> {Mod,all} end, Mods), Skip). - -add_conf_with_skip(Name, Mod, Conf, Skip) when is_tuple(Conf) -> - add_job(cast_to_list(Name), {Mod,[Conf]}, Skip); - -add_conf_with_skip(Name, Mod, Confs, Skip) when is_list(Confs) -> - add_job(cast_to_list(Name), {Mod,Confs}, Skip). - -add_case_with_skip(Mod, Case, Skip) when is_atom(Mod), is_atom(Case) -> - add_job(atom_to_list(Mod), {Mod,Case}, Skip). - -add_case_with_skip(Name, Mod, Case, Skip) when is_atom(Mod), is_atom(Case) -> - add_job(Name, {Mod,Case}, Skip). - -add_cases_with_skip(Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) -> - add_job(atom_to_list(Mod), {Mod,Cases}, Skip). - -add_cases_with_skip(Name, Mod, Cases, Skip) when is_atom(Mod), is_list(Cases) -> - add_job(Name, {Mod,Cases}, Skip). - -add_tests_with_skip(LogDir, Tests, Skip) -> - add_job(LogDir, - lists:map(fun({Dir,all,all}) -> - {Dir,{dir,Dir}}; - ({Dir,Mods,all}) -> - {Dir,lists:map(fun(M) -> {M,all} end, Mods)}; - ({Dir,Mod,Cases}) -> - {Dir,{Mod,Cases}} - end, Tests), - Skip). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% COMMAND LINE INTERFACE - -parse_cmd_line(Cmds) -> - parse_cmd_line(Cmds, [], [], local, false, false, undefined). - -parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - case file:consult(Spec) of - {ok, TermList} -> - Name = filename:rootname(Spec), - parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param, - Trc, Cov, TCCB); - {error,Reason} -> - io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]), - parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB) - end; -parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - parse_cmd_line(Cmds, SpecList, [{name,atom_to_list(Name)}|Names], - Param, Trc, Cov, TCCB); -parse_cmd_line(['SKIPMOD',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - parse_cmd_line(Cmds, [{skip,{Mod,"by command line"}}|SpecList], Names, - Param, Trc, Cov, TCCB); -parse_cmd_line(['SKIPCASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - parse_cmd_line(Cmds, [{skip,{Mod,Case,"by command line"}}|SpecList], Names, - Param, Trc, Cov, TCCB); -parse_cmd_line(['DIR',Dir|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - Name = filename:basename(Dir), - parse_cmd_line(Cmds, [{topcase,{dir,Name}}|SpecList], [Name|Names], - Param, Trc, Cov, TCCB); -parse_cmd_line(['MODULE',Mod|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - parse_cmd_line(Cmds,[{topcase,{Mod,all}}|SpecList],[atom_to_list(Mod)|Names], - Param, Trc, Cov, TCCB); -parse_cmd_line(['CASE',Mod,Case|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> - parse_cmd_line(Cmds,[{topcase,{Mod,Case}}|SpecList],[atom_to_list(Mod)|Names], - Param, Trc, Cov, TCCB); -parse_cmd_line(['TRACE',Trc|Cmds], SpecList, Names, Param, _Trc, Cov, TCCB) -> - parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB); -parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov, TCCB) -> - parse_cmd_line(Cmds, SpecList, Names, Param, Trc, {{App,CF}, Analyse}, TCCB); -parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) -> - parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func}); -parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) -> - io:format("~w: Bad argument: ~w\n", [?MODULE,Obj]), - io:format(" Use the `ts' module to start tests.\n", []), - io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []), - halt(1); -parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) -> - NameList = lists:reverse(Names, ["suite"]), - Name = case lists:keysearch(name, 1, NameList) of - {value,{name,N}} -> N; - false -> hd(NameList) - end, - {lists:reverse(SpecList), Name, Param, Trc, Cov, TCCB}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% cast_to_list(X) -> string() -%% X = list() | atom() | void() -%% Returns a string representation of whatever was input - -cast_to_list(X) when is_list(X) -> X; -cast_to_list(X) when is_atom(X) -> atom_to_list(X); -cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% START INTERFACE - -%% Kept for backwards compatibility -start(_) -> - start(). -start_link(_) -> - start_link(). - - -start() -> - case gen_server:start({local,?MODULE}, ?MODULE, [], []) of - {ok, Pid} -> - {ok, Pid}; - Other -> - Other - end. - -start_link() -> - case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of - {ok, Pid} -> - {ok, Pid}; - Other -> - Other - end. - -run_test(CommandLine) -> - process_flag(trap_exit,true), - {SpecList,Name,Param,Trc,Cov,TCCB} = parse_cmd_line(CommandLine), - {ok,_TSPid} = start_link(Param), - case Trc of - false -> ok; - File -> trc(File) - end, - case Cov of - false -> ok; - {{App,CoverFile},Analyse} -> cover(App, maybe_file(CoverFile), Analyse) - end, - testcase_callback(TCCB), - add_job(Name, {command_line,SpecList}), - - wait_finish(). - -%% Converted CoverFile to a string unless it is 'none' -maybe_file(none) -> - none; -maybe_file(CoverFile) -> - atom_to_list(CoverFile). - -idle_notify(Fun) -> - {ok, Pid} = controller_call({idle_notify,Fun}), - Pid. - -start_get_totals(Fun) -> - {ok, Pid} = controller_call({start_get_totals,Fun}), - Pid. - -stop_get_totals() -> - ok = controller_call(stop_get_totals), - ok. - -wait_finish() -> - OldTrap = process_flag(trap_exit, true), - {ok, Pid} = finish(true), - link(Pid), - receive - {'EXIT',Pid,_} -> - ok - end, - process_flag(trap_exit, OldTrap), - ok. - -abort_current_testcase(Reason) -> - controller_call({abort_current_testcase,Reason}). - -abort() -> - OldTrap = process_flag(trap_exit, true), - {ok, Pid} = finish(abort), - link(Pid), - receive - {'EXIT',Pid,_} -> - ok - end, - process_flag(trap_exit, OldTrap), - ok. - -finish(Abort) -> - controller_call({finish,Abort}). - -stop() -> - controller_call(stop). - -jobs() -> - controller_call(jobs). - -get_levels() -> - controller_call(get_levels). - -set_levels(Show, Major, Minor) -> - controller_call({set_levels,Show,Major,Minor}). - -reject_io_reqs(Bool) -> - controller_call({reject_io_reqs,Bool}). - -multiply_timetraps(N) -> - controller_call({multiply_timetraps,N}). - -scale_timetraps(Bool) -> - controller_call({scale_timetraps,Bool}). - -get_timetrap_parameters() -> - controller_call(get_timetrap_parameters). - -create_priv_dir(Value) -> - controller_call({create_priv_dir,Value}). - -trc(TraceFile) -> - controller_call({trace,TraceFile}, 2*?ACCEPT_TIMEOUT). - -stop_trace() -> - controller_call(stop_trace). - -node_started(Node) -> - gen_server:cast(?MODULE, {node_started,Node}). - -cover(App, Analyse) when is_atom(App) -> - cover(App, none, Analyse); -cover(CoverFile, Analyse) -> - cover(none, CoverFile, Analyse). -cover(App, CoverFile, Analyse) -> - {Excl,Incl,Cross} = read_cover_file(CoverFile), - CoverInfo = #cover{app=App, - file=CoverFile, - excl=Excl, - incl=Incl, - cross=Cross, - level=Analyse}, - controller_call({cover,CoverInfo}). - -cover(CoverInfo) -> - controller_call({cover,CoverInfo}). - -cover_compile(App,File,Excl,Incl,Cross,Analyse,Stop) -> - cover_compile(#cover{app=App, - file=File, - excl=Excl, - incl=Incl, - cross=Cross, - level=Analyse, - stop=Stop}). - -testcase_callback(ModFunc) -> - controller_call({testcase_callback,ModFunc}). - -set_random_seed(Seed) -> - controller_call({set_random_seed,Seed}). - -kill_slavenodes() -> - controller_call(kill_slavenodes). - -get_hosts() -> - get(test_server_hosts). - -%%-------------------------------------------------------------------- - -add_job(Name, TopCase) -> - add_job(Name, TopCase, []). - -add_job(Name, TopCase, Skip) -> - SuiteName = - case Name of - "." -> "current_dir"; - ".." -> "parent_dir"; - Other -> Other - end, - Dir = filename:absname(SuiteName), - controller_call({add_job,Dir,SuiteName,TopCase,Skip}). - -controller_call(Arg) -> - case catch gen_server:call(?MODULE, Arg, infinity) of - {'EXIT',{{badarg,_},{gen_server,call,_}}} -> - exit(test_server_ctrl_not_running); - {'EXIT',Reason} -> - exit(Reason); - Other -> - Other - end. -controller_call(Arg, Timeout) -> - case catch gen_server:call(?MODULE, Arg, Timeout) of - {'EXIT',{{badarg,_},{gen_server,call,_}}} -> - exit(test_server_ctrl_not_running); - {'EXIT',Reason} -> - exit(Reason); - Other -> - Other - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% init([]) -%% -%% init() is the init function of the test_server's gen_server. -%% -init([]) -> - case os:getenv("TEST_SERVER_CALL_TRACE") of - false -> - ok; - "" -> - ok; - TraceSpec -> - test_server_sup:call_trace(TraceSpec) - end, - process_flag(trap_exit, true), - %% copy format_exception setting from init arg to application environment - case init:get_argument(test_server_format_exception) of - {ok,[[TSFE]]} -> - application:set_env(test_server, format_exception, list_to_atom(TSFE)); - _ -> - ok - end, - test_server_sup:cleanup_crash_dumps(), - test_server_sup:util_start(), - State = #state{jobs=[],finish=false}, - TI0 = test_server:init_target_info(), - TargetHost = test_server_sup:hoststr(), - TI = TI0#target_info{host=TargetHost, - naming=naming(), - master=TargetHost}, - ets:new(slave_tab, [named_table,set,public,{keypos,2}]), - set_hosts([TI#target_info.host]), - {ok,State#state{target_info=TI}}. - -naming() -> - case lists:member($., test_server_sup:hoststr()) of - true -> "-name"; - false -> "-sname" - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(kill_slavenodes, From, State) -> ok -%% -%% Kill all slave nodes that remain after a test case -%% is completed. -%% -handle_call(kill_slavenodes, _From, State) -> - Nodes = test_server_node:kill_nodes(), - {reply, Nodes, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({set_hosts, HostList}, From, State) -> ok -%% -%% Set the global hostlist. -%% -handle_call({set_hosts, Hosts}, _From, State) -> - set_hosts(Hosts), - {reply, ok, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(get_hosts, From, State) -> [Hosts] -%% -%% Returns the lists of hosts that the test server -%% can use for slave nodes. This is primarily used -%% for nodename generation. -%% -handle_call(get_hosts, _From, State) -> - Hosts = get_hosts(), - {reply, Hosts, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({add_job,Dir,Name,TopCase,Skip}, _, State) -> -%% ok | {error,Reason} -%% -%% Dir = string() -%% Name = string() -%% TopCase = term() -%% Skip = [SkipItem] -%% SkipItem = {Mod,Comment} | {Mod,Case,Comment} | {Mod,Cases,Comment} -%% Mod = Case = atom() -%% Comment = string() -%% Cases = [Case] -%% -%% Adds a job to the job queue. The name of the job is Name. A log directory -%% will be created in Dir/Name.logs. TopCase may be anything that -%% collect_cases/3 accepts, plus the following: -%% -%% {spec,SpecName} executes the named test suite specification file. Commands -%% in the file should be in the format accepted by do_spec_list/1. -%% -%% {command_line,SpecList} executes the list of specification instructions -%% supplied, which should be in the format accepted by do_spec_list/1. - -handle_call({add_job,Dir,Name,TopCase,Skip}, _From, State) -> - LogDir = Dir ++ ?logdir_ext, - ExtraTools = - case State#state.cover of - false -> []; - CoverInfo -> [{cover,CoverInfo}] - end, - ExtraTools1 = - case State#state.random_seed of - undefined -> ExtraTools; - Seed -> [{random_seed,Seed}|ExtraTools] - end, - case lists:keysearch(Name, 1, State#state.jobs) of - false -> - case TopCase of - {spec,SpecName} -> - Pid = spawn_tester( - ?MODULE, do_spec, - [SpecName,{State#state.multiply_timetraps, - State#state.scale_timetraps}], - LogDir, Name, State#state.levels, - State#state.reject_io_reqs, - State#state.create_priv_dir, - State#state.testcase_callback, ExtraTools1), - NewJobs = [{Name,Pid}|State#state.jobs], - {reply, ok, State#state{jobs=NewJobs}}; - {command_line,SpecList} -> - Pid = spawn_tester( - ?MODULE, do_spec_list, - [SpecList,{State#state.multiply_timetraps, - State#state.scale_timetraps}], - LogDir, Name, State#state.levels, - State#state.reject_io_reqs, - State#state.create_priv_dir, - State#state.testcase_callback, ExtraTools1), - NewJobs = [{Name,Pid}|State#state.jobs], - {reply, ok, State#state{jobs=NewJobs}}; - TopCase -> - case State#state.get_totals of - {CliPid,Fun} -> - Result = count_test_cases(TopCase, Skip), - Fun(CliPid, Result), - {reply, ok, State}; - _ -> - Cfg = make_config([]), - Pid = spawn_tester( - ?MODULE, do_test_cases, - [TopCase,Skip,Cfg, - {State#state.multiply_timetraps, - State#state.scale_timetraps}], - LogDir, Name, State#state.levels, - State#state.reject_io_reqs, - State#state.create_priv_dir, - State#state.testcase_callback, ExtraTools1), - NewJobs = [{Name,Pid}|State#state.jobs], - {reply, ok, State#state{jobs=NewJobs}} - end - end; - _ -> - {reply,{error,name_already_in_use},State} - end; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(jobs, _, State) -> JobList -%% JobList = [{Name,Pid}, ...] -%% Name = string() -%% Pid = pid() -%% -%% Return the list of current jobs. - -handle_call(jobs, _From, State) -> - {reply,State#state.jobs,State}; - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({abort_current_testcase,Reason}, _, State) -> Result -%% Reason = term() -%% Result = ok | {error,no_testcase_running} -%% -%% Attempts to abort the test case that's currently running. - -handle_call({abort_current_testcase,Reason}, _From, State) -> - case State#state.jobs of - [{_,Pid}|_] -> - Pid ! {abort_current_testcase,Reason,self()}, - receive - {Pid,abort_current_testcase,Result} -> - {reply, Result, State} - after 10000 -> - {reply, {error,no_testcase_running}, State} - end; - _ -> - {reply, {error,no_testcase_running}, State} - end; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({finish,Fini}, _, State) -> {ok,Pid} -%% Fini = true | abort -%% -%% Tells the test_server to stop as soon as there are no test suites -%% running. Immediately if none are running. Abort is handled as soon -%% as current test finishes. - -handle_call({finish,Fini}, _From, State) -> - case State#state.jobs of - [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end, - State#state.idle_notify), - State2 = State#state{finish=false}, - {stop,shutdown,{ok,self()}, State2}; - _SomeJobs -> - State2 = State#state{finish=Fini}, - {reply, {ok,self()}, State2} - end; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({idle_notify,Fun}, From, State) -> {ok,Pid} -%% -%% Lets a test client subscribe to receive a notification when the -%% test server becomes idle (can be used to syncronize jobs). -%% test_server calls Fun(From) when idle. - -handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> - case State#state.jobs of - [] -> self() ! report_idle; - _ -> ok - end, - Subscribed = State#state.idle_notify, - {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(start_get_totals, From, State) -> {ok,Pid} -%% -%% Switch on the mode where the test server will only -%% report back the number of tests it would execute -%% given some subsequent jobs. - -handle_call({start_get_totals,Fun}, {Cli,_Ref}, State) -> - {reply, {ok,self()}, State#state{get_totals={Cli,Fun}}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(stop_get_totals, From, State) -> ok -%% -%% Lets a test client subscribe to receive a notification when the -%% test server becomes idle (can be used to syncronize jobs). -%% test_server calls Fun(From) when idle. - -handle_call(stop_get_totals, {_Cli,_Ref}, State) -> - {reply, ok, State#state{get_totals=false}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(get_levels, _, State) -> {Show,Major,Minor} -%% Show = integer() -%% Major = integer() -%% Minor = integer() -%% -%% Returns a 3-tuple with the logging thresholds. -%% All output and information from a test suite is tagged with a detail -%% level. Lower values are more "important". Text that is output using -%% io:format or similar is automatically tagged with detail level 50. -%% -%% All output with detail level: -%% less or equal to Show is displayed on the screen (default 1) -%% less or equal to Major is logged in the major log file (default 19) -%% greater or equal to Minor is logged in the minor log files (default 10) - -handle_call(get_levels, _From, State) -> - {reply,State#state.levels,State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({set_levels,Show,Major,Minor}, _, State) -> ok -%% Show = integer() -%% Major = integer() -%% Minor = integer() -%% -%% Sets the logging thresholds, see handle_call(get_levels,...) above. - -handle_call({set_levels,Show,Major,Minor}, _From, State) -> - {reply,ok,State#state{levels={Show,Major,Minor}}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({reject_io_reqs,Bool}, _, State) -> ok -%% Bool = bool() -%% -%% May be used to switch off stdout printouts to the minor log file - -handle_call({reject_io_reqs,Bool}, _From, State) -> - {reply,ok,State#state{reject_io_reqs=Bool}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({multiply_timetraps,N}, _, State) -> ok -%% N = integer() | infinity -%% -%% Multiplies all timetraps set by test cases with N - -handle_call({multiply_timetraps,N}, _From, State) -> - {reply,ok,State#state{multiply_timetraps=N}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({scale_timetraps,Bool}, _, State) -> ok -%% Bool = true | false -%% -%% Specifies if test_server should scale the timetrap value -%% automatically if e.g. cover is running. - -handle_call({scale_timetraps,Bool}, _From, State) -> - {reply,ok,State#state{scale_timetraps=Bool}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(get_timetrap_parameters, _, State) -> {Multiplier,Scale} -%% Multiplier = integer() | infinity -%% Scale = true | false -%% -%% Returns the parameter values that affect timetraps. - -handle_call(get_timetrap_parameters, _From, State) -> - {reply,{State#state.multiply_timetraps,State#state.scale_timetraps},State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({trace,TraceFile}, _, State) -> ok | {error,Reason} -%% -%% Starts a separate node (trace control node) which -%% starts tracing on target and all slave nodes -%% -%% TraceFile is a text file with elements of type -%% {Trace,Mod,TracePattern}. -%% {Trace,Mod,Func,TracePattern}. -%% {Trace,Mod,Func,Arity,TracePattern}. -%% -%% Trace = tp | tpl; local or global call trace -%% Mod,Func = atom(), Arity=integer(); defines what to trace -%% TracePattern = [] | match_spec() -%% -%% The 'call' trace flag is set on all processes, and then -%% the given trace patterns are set. - -handle_call({trace,TraceFile}, _From, State=#state{trc=false}) -> - TI = State#state.target_info, - case test_server_node:start_tracer_node(TraceFile, TI) of - {ok,Tracer} -> {reply,ok,State#state{trc=Tracer}}; - Error -> {reply,Error,State} - end; -handle_call({trace,_TraceFile}, _From, State) -> - {reply,{error,already_tracing},State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(stop_trace, _, State) -> ok | {error,Reason} -%% -%% Stops tracing on target and all slave nodes and -%% terminates trace control node - -handle_call(stop_trace, _From, State=#state{trc=false}) -> - {reply,{error,not_tracing},State}; -handle_call(stop_trace, _From, State) -> - R = test_server_node:stop_tracer_node(State#state.trc), - {reply,R,State#state{trc=false}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({cover,CoverInfo}, _, State) -> ok | {error,Reason} -%% -%% Set specification of cover analysis to be used when running tests -%% (see start_extra_tools/1 and stop_extra_tools/1) - -handle_call({cover,CoverInfo}, _From, State) -> - {reply,ok,State#state{cover=CoverInfo}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({create_priv_dir,Value}, _, State) -> ok | {error,Reason} -%% -%% Set create_priv_dir to either auto_per_run (create common priv dir once -%% per test run), manual_per_tc (the priv dir name will be unique for each -%% test case, but the user has to call test_server:make_priv_dir/0 to create -%% it), or auto_per_tc (unique priv dir created automatically for each test -%% case). - -handle_call({create_priv_dir,Value}, _From, State) -> - {reply,ok,State#state{create_priv_dir=Value}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({testcase_callback,{Mod,Func}}, _, State) -> ok | {error,Reason} -%% -%% Add a callback function that will be called before and after every -%% test case (on the test case process): -%% -%% Mod:Func(Suite,TestCase,InitOrEnd,Config) -%% -%% InitOrEnd = init | 'end'. - -handle_call({testcase_callback,ModFunc}, _From, State) -> - case ModFunc of - {Mod,Func} -> - case code:is_loaded(Mod) of - {file,_} -> - ok; - false -> - code:load_file(Mod) - end, - case erlang:function_exported(Mod,Func,4) of - true -> - ok; - false -> - io:format(user, - "WARNING! Callback function ~w:~w/4 undefined.~n~n", - [Mod,Func]) - end; - _ -> - ok - end, - {reply,ok,State#state{testcase_callback=ModFunc}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({set_random_seed,Seed}, _, State) -> ok | {error,Reason} -%% -%% Let operator set a random seed value to be used e.g. for shuffling -%% test cases. - -handle_call({set_random_seed,Seed}, _From, State) -> - {reply,ok,State#state{random_seed=Seed}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(stop, _, State) -> ok -%% -%% Stops the test server immediately. -%% Some cleanup is done by terminate/2 - -handle_call(stop, _From, State) -> - {stop, shutdown, ok, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call(get_target_info, _, State) -> TI -%% -%% TI = #target_info{} -%% -%% Returns information about target - -handle_call(get_target_info, _From, State) -> - {reply, State#state.target_info, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({start_node,Name,Type,Options}, _, State) -> -%% ok | {error,Reason} -%% -%% Starts a new node (slave or peer) - -handle_call({start_node, Name, Type, Options}, From, State) -> - %% test_server_ctrl does gen_server:reply/2 explicitly - test_server_node:start_node(Name, Type, Options, From, - State#state.target_info), - {noreply,State}; - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({wait_for_node,Node}, _, State) -> ok -%% -%% Waits for a new node to take contact. Used if -%% node is started with option {wait,false} - -handle_call({wait_for_node, Node}, From, State) -> - NewWaitList = - case ets:lookup(slave_tab,Node) of - [] -> - [{Node,From}|State#state.wait_for_node]; - _ -> - gen_server:reply(From,ok), - State#state.wait_for_node - end, - {noreply,State#state{wait_for_node=NewWaitList}}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({stop_node,Name}, _, State) -> ok | {error,Reason} -%% -%% Stops a slave or peer node. This is actually only some cleanup -%% - the node is really stopped by test_server when this returns. - -handle_call({stop_node, Name}, _From, State) -> - R = test_server_node:stop_node(Name), - {reply, R, State}; - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_call({is_release_available,Name}, _, State) -> ok | {error,Reason} -%% -%% Tests if the release is available. - -handle_call({is_release_available, Release}, _From, State) -> - R = test_server_node:is_release_available(Release), - {reply, R, State}. - -%%-------------------------------------------------------------------- -set_hosts(Hosts) -> - put(test_server_hosts, Hosts). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_cast({node_started,Name}, _, State) -%% -%% Called by test_server_node when a slave/peer node is fully started. - -handle_cast({node_started,Node}, State) -> - case State#state.trc of - false -> ok; - Trc -> test_server_node:trace_nodes(Trc, [Node]) - end, - NewWaitList = - case lists:keysearch(Node,1,State#state.wait_for_node) of - {value,{Node,From}} -> - gen_server:reply(From, ok), - lists:keydelete(Node, 1, State#state.wait_for_node); - false -> - State#state.wait_for_node - end, - {noreply, State#state{wait_for_node=NewWaitList}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_info({'EXIT',Pid,Reason}, State) -%% Pid = pid() -%% Reason = term() -%% -%% Handles exit messages from linked processes. Only test suites are -%% expected to be linked. When a test suite terminates, it is removed -%% from the job queue. - -handle_info(report_idle, State) -> - Finish = State#state.finish, - lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, - State#state.idle_notify), - {noreply,State#state{idle_notify=[]}}; - - -handle_info({'EXIT',Pid,Reason}, State) -> - case lists:keysearch(Pid,2,State#state.jobs) of - false -> - %% not our problem - {noreply,State}; - {value,{Name,_}} -> - NewJobs = lists:keydelete(Pid, 2, State#state.jobs), - case Reason of - normal -> - fine; - killed -> - io:format("Suite ~ts was killed\n", [Name]); - _Other -> - io:format("Suite ~ts was killed with reason ~p\n", - [Name,Reason]) - end, - State2 = State#state{jobs=NewJobs}, - Finish = State2#state.finish, - case NewJobs of - [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, - State2#state.idle_notify), - case Finish of - false -> - {noreply,State2#state{idle_notify=[]}}; - _ -> % true | abort - %% test_server:finish() has been called and - %% there are no jobs in the job queue => - %% stop the test_server_ctrl - {stop,shutdown,State2#state{finish=false}} - end; - _ -> % pending jobs - case Finish of - abort -> % abort test now! - lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, - State2#state.idle_notify), - {stop,shutdown,State2#state{finish=false}}; - _ -> % true | false - {noreply, State2} - end - end - end; - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_info({tcp_closed,Sock}, State) -%% -%% A Socket was closed. This indicates that a node died. -%% This can be -%% *Slave or peer node started by a test suite -%% *Trace controll node - -handle_info({tcp_closed,Sock}, State=#state{trc=Sock}) -> - %% Tracer node died - can't really do anything - %%! Maybe print something??? - {noreply,State#state{trc=false}}; -handle_info({tcp_closed,Sock}, State) -> - test_server_node:nodedown(Sock), - {noreply,State}; -handle_info(_, State) -> - %% dummy; accept all, do nothing. - {noreply, State}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% terminate(Reason, State) -> ok -%% Reason = term() -%% -%% Cleans up when the test_server is terminating. Kills the running -%% test suites (if any) and any possible remainting slave node - -terminate(_Reason, State) -> - test_server_sup:util_stop(), - case State#state.trc of - false -> ok; - Sock -> test_server_node:stop_tracer_node(Sock) - end, - kill_all_jobs(State#state.jobs), - test_server_node:kill_nodes(), - ok. - -kill_all_jobs([{_Name,JobPid}|Jobs]) -> - exit(JobPid, kill), - kill_all_jobs(Jobs); -kill_all_jobs([]) -> - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%----------------------- INTERNAL FUNCTIONS -----------------------%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, -%% CreatePrivDir, TestCaseCallback, ExtraTools) -> Pid -%% Mod = atom() -%% Func = atom() -%% Args = [term(),...] -%% Dir = string() -%% Name = string() -%% Levels = {integer(),integer(),integer()} -%% RejectIoReqs = bool() -%% CreatePrivDir = auto_per_run | manual_per_tc | auto_per_tc -%% TestCaseCallback = {CBMod,CBFunc} | undefined -%% ExtraTools = [ExtraTool,...] -%% ExtraTool = CoverInfo | TraceInfo | RandomSeed -%% -%% Spawns a test suite execute-process, just an ordinary spawn, except -%% that it will set a lot of dictionary information before starting the -%% named function. Also, the execution is timed and protected by a catch. -%% When the named function is done executing, a summary of the results -%% is printed to the log files. - -spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, - CreatePrivDir, TCCallback, ExtraTools) -> - spawn_link(fun() -> - init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, - CreatePrivDir, TCCallback, ExtraTools) - end). - -init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, - RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) -> - process_flag(trap_exit, true), - test_server_io:start_link(), - put(test_server_name, Name), - put(test_server_dir, Dir), - put(test_server_total_time, 0), - put(test_server_ok, 0), - put(test_server_failed, 0), - put(test_server_skipped, {0,0}), - put(test_server_minor_level, MinLev), - put(test_server_create_priv_dir, CreatePrivDir), - put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)), - put(test_server_testcase_callback, TCCallback), - case os:getenv("TEST_SERVER_FRAMEWORK") of - FW when FW =:= false; FW =:= "undefined" -> - put(test_server_framework, '$none'); - FW -> - put(test_server_framework_name, list_to_atom(FW)), - case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of - FWName when FWName =:= false; FWName =:= "undefined" -> - put(test_server_framework_name, '$none'); - FWName -> - put(test_server_framework_name, list_to_atom(FWName)) - end - end, - - %% before first print, read and set logging options - LogOpts = test_server_sup:framework_call(get_logopts, [], []), - put(test_server_logopts, LogOpts), - - StartedExtraTools = start_extra_tools(ExtraTools), - - test_server_io:set_job_name(Name), - test_server_io:set_gl_props([{levels,Levels}, - {auto_nl,not lists:member(no_nl, LogOpts)}, - {reject_io_reqs,RejectIoReqs}]), - group_leader(test_server_io:get_gl(true), self()), - {TimeMy,Result} = ts_tc(Mod, Func, Args), - set_io_buffering(undefined), - test_server_io:set_job_name(undefined), - catch stop_extra_tools(StartedExtraTools), - case Result of - {'EXIT',test_suites_done} -> - ok; - {'EXIT',_Pid,Reason} -> - print(1, "EXIT, reason ~p", [Reason]); - {'EXIT',Reason} -> - report_severe_error(Reason), - print(1, "EXIT, reason ~p", [Reason]) - end, - Time = TimeMy/1000000, - SuccessStr = - case get(test_server_failed) of - 0 -> "Ok"; - _ -> "FAILED" - end, - {SkippedN,SkipStr} = - case get(test_server_skipped) of - {0,0} -> - {0,""}; - {USkipped,ASkipped} -> - Skipped = USkipped+ASkipped, - {Skipped,io_lib:format(", ~w Skipped", [Skipped])} - end, - OkN = get(test_server_ok), - FailedN = get(test_server_failed), - print(html,"\n\n\n" - "TOTAL" - "~.3fs~ts~w Ok, ~w Failed~ts of ~w\n" - "\n", - [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]), - - test_server_io:stop([major,html,unexpected_io]), - {UnexpectedIoName,UnexpectedIoFooter} = get(test_server_unexpected_footer), - {ok,UnexpectedIoFd} = open_html_file(UnexpectedIoName, [append]), - io:put_chars(UnexpectedIoFd, "\n\n"++UnexpectedIoFooter), - file:close(UnexpectedIoFd), - ok. - -report_severe_error(Reason) -> - test_server_sup:framework_call(report, [severe_error,Reason]). - -ts_tc(M,F,A) -> - Before = erlang:monotonic_time(), - Result = (catch apply(M, F, A)), - After = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(After-Before, - native, - micro_seconds), - {Elapsed, Result}. - -start_extra_tools(ExtraTools) -> - start_extra_tools(ExtraTools, []). -start_extra_tools([{cover,CoverInfo} | ExtraTools], Started) -> - case start_cover(CoverInfo) of - {ok,NewCoverInfo} -> - start_extra_tools(ExtraTools,[{cover,NewCoverInfo}|Started]); - {error,_} -> - start_extra_tools(ExtraTools, Started) - end; -start_extra_tools([_ | ExtraTools], Started) -> - start_extra_tools(ExtraTools, Started); -start_extra_tools([], Started) -> - Started. - -stop_extra_tools(ExtraTools) -> - TestDir = get(test_server_log_dir_base), - case lists:keymember(cover, 1, ExtraTools) of - false -> - write_default_coverlog(TestDir); - true -> - ok - end, - stop_extra_tools(ExtraTools, TestDir). - -stop_extra_tools([{cover,CoverInfo}|ExtraTools], TestDir) -> - stop_cover(CoverInfo,TestDir), - stop_extra_tools(ExtraTools, TestDir); -%%stop_extra_tools([_ | ExtraTools], TestDir) -> -%% stop_extra_tools(ExtraTools, TestDir); -stop_extra_tools([], _) -> - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_spec(SpecName, TimetrapSpec) -> {error,Reason} | exit(Result) -%% SpecName = string() -%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} -%% MultiplyTimetrap = integer() | infinity -%% ScaleTimetrap = bool() -%% -%% Reads the named test suite specification file, and executes it. -%% -%% This function is meant to be called by a process created by -%% spawn_tester/10, which sets up some necessary dictionary values. - -do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> - case file:consult(SpecName) of - {ok,TermList} -> - do_spec_list(TermList,TimetrapSpec); - {error,Reason} -> - io:format("Can't open ~ts: ~p\n", [SpecName,Reason]), - {error,{cant_open_spec,Reason}} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_spec_list(TermList, TimetrapSpec) -> exit(Result) -%% TermList = [term()|...] -%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} -%% MultiplyTimetrap = integer() | infinity -%% ScaleTimetrap = bool() -%% -%% Executes a list of test suite specification commands. The following -%% commands are available, and may occur zero or more times (if several, -%% the contents is appended): -%% -%% {topcase,TopCase} Specifies top level test goals. TopCase has the syntax -%% specified by collect_cases/3. -%% -%% {skip,Skip} Specifies test cases to skip, and lists requirements that -%% cannot be granted during the test run. Skip has the syntax specified -%% by collect_cases/3. -%% -%% {nodes,Nodes} Lists node names avaliable to the test suites. Nodes have -%% the syntax specified by collect_cases/3. -%% -%% {require_nodenames, Num} Specifies how many nodenames the test suite will -%% need. Theese are automaticly generated and inserted into the Config by the -%% test_server. The caller may specify other hosts to run theese nodes by -%% using the {hosts, Hosts} option. If there are no hosts specified, all -%% nodenames will be generated from the local host. -%% -%% {hosts, Hosts} Specifies a list of available hosts on which to start -%% slave nodes. It is used when the {remote, true} option is given to the -%% test_server:start_node/3 function. Also, if {require_nodenames, Num} is -%% contained in the TermList, the generated nodenames will be spread over -%% all hosts given in this Hosts list. The hostnames are given as atoms or -%% strings. -%% -%% {diskless, true} is kept for backwards compatiblilty and -%% should not be used. Use a configuration test case instead. -%% -%% This function is meant to be called by a process created by -%% spawn_tester/10, which sets up some necessary dictionary values. - -do_spec_list(TermList0, TimetrapSpec) -> - Nodes = [], - TermList = - case lists:keysearch(hosts, 1, TermList0) of - {value, {hosts, Hosts0}} -> - Hosts = lists:map(fun(H) -> cast_to_list(H) end, Hosts0), - controller_call({set_hosts, Hosts}), - lists:keydelete(hosts, 1, TermList0); - _ -> - TermList0 - end, - DefaultConfig = make_config([{nodes,Nodes}]), - {TopCases,SkipList,Config} = do_spec_terms(TermList, [], [], DefaultConfig), - do_test_cases(TopCases, SkipList, Config, TimetrapSpec). - -do_spec_terms([], TopCases, SkipList, Config) -> - {TopCases,SkipList,Config}; -do_spec_terms([{topcase,TopCase}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms,[TopCase|TopCases], SkipList, Config); -do_spec_terms([{skip,Skip}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms, TopCases, [Skip|SkipList], Config); -do_spec_terms([{nodes,Nodes}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms, TopCases, SkipList, - update_config(Config, {nodes,Nodes})); -do_spec_terms([{diskless,How}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms, TopCases, SkipList, - update_config(Config, {diskless,How})); -do_spec_terms([{config,MoreConfig}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms, TopCases, SkipList, Config++MoreConfig); -do_spec_terms([{default_timeout,Tmo}|Terms], TopCases, SkipList, Config) -> - do_spec_terms(Terms, TopCases, SkipList, - update_config(Config, {default_timeout,Tmo})); - -do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) -> - NodeNames0=generate_nodenames(NumNames), - NodeNames=lists:delete([], NodeNames0), - do_spec_terms(Terms, TopCases, SkipList, - update_config(Config, {nodenames,NodeNames})); -do_spec_terms([Other|Terms], TopCases, SkipList, Config) -> - io:format("** WARNING: Spec file contains unknown directive ~p\n", - [Other]), - do_spec_terms(Terms, TopCases, SkipList, Config). - - - -generate_nodenames(Num) -> - Hosts = case controller_call(get_hosts) of - [] -> - TI = controller_call(get_target_info), - [TI#target_info.host]; - List -> - List - end, - generate_nodenames2(Num, Hosts, []). - -generate_nodenames2(0, _Hosts, Acc) -> - Acc; -generate_nodenames2(N, Hosts, Acc) -> - Host=lists:nth((N rem (length(Hosts)))+1, Hosts), - Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), - generate_nodenames2(N-1, Hosts, [Name|Acc]). - -temp_nodename([], Acc) -> - lists:flatten(Acc); -temp_nodename([Chr|Base], Acc) -> - {A,B,C} = ?now, - New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], - temp_nodename(Base, [New|Acc]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% count_test_cases(TopCases, SkipCases) -> {Suites,NoOfCases} | error -%% TopCases = term() (See collect_cases/3) -%% SkipCases = term() (See collect_cases/3) -%% Suites = list() -%% NoOfCases = integer() | unknown -%% -%% Counts the test cases that are about to run and returns that number. -%% If there's a conf group in TestSpec with a repeat property, the total number -%% of cases can not be calculated and NoOfCases = unknown. -count_test_cases(TopCases, SkipCases) when is_list(TopCases) -> - case collect_all_cases(TopCases, SkipCases) of - {error,_Why} = Error -> - Error; - TestSpec -> - {get_suites(TestSpec, []), - case remove_conf(TestSpec) of - {repeats,_} -> - unknown; - TestSpec1 -> - length(TestSpec1) - end} - end; - -count_test_cases(TopCase, SkipCases) -> - count_test_cases([TopCase], SkipCases). - - -remove_conf(Cases) -> - remove_conf(Cases, [], false). - -remove_conf([{conf, _Ref, Props, _MF}|Cases], NoConf, Repeats) -> - case get_repeat(Props) of - undefined -> - remove_conf(Cases, NoConf, Repeats); - {_RepType,1} -> - remove_conf(Cases, NoConf, Repeats); - _ -> - remove_conf(Cases, NoConf, true) - end; -remove_conf([{make,_Ref,_MF}|Cases], NoConf, Repeats) -> - remove_conf(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; - Type==make -> - remove_conf(Cases, NoConf, Repeats); -remove_conf([{skip_case,{Type,_Ref,_MF,_Cmt},_Mode}|Cases], - NoConf, Repeats) when Type==conf; - Type==make -> - remove_conf(Cases, NoConf, Repeats); -remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) -> - FwMod = get_fw_mod(?MODULE), - if Mod == FwMod -> - remove_conf(Cases, NoConf, Repeats); - true -> - remove_conf(Cases, [C|NoConf], Repeats) - end; -remove_conf([C|Cases], NoConf, Repeats) -> - remove_conf(Cases, [C|NoConf], Repeats); -remove_conf([], NoConf, true) -> - {repeats,lists:reverse(NoConf)}; -remove_conf([], NoConf, false) -> - lists:reverse(NoConf). - -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) - end; -get_suites([{Mod,_Case}|Tests], Mods) when is_atom(Mod) -> - case add_mod(Mod, Mods) of - true -> get_suites(Tests, [Mod|Mods]); - false -> get_suites(Tests, Mods) - end; -get_suites([{Mod,_Func,_Args}|Tests], Mods) when is_atom(Mod) -> - case add_mod(Mod, Mods) of - true -> get_suites(Tests, [Mod|Mods]); - false -> get_suites(Tests, Mods) - end; -get_suites([_|Tests], Mods) -> - get_suites(Tests, Mods); - -get_suites([], Mods) -> - lists:reverse(Mods). - -add_mod(Mod, Mods) -> - case string:rstr(atom_to_list(Mod), "_SUITE") of - 0 -> false; - _ -> % test suite - case lists:member(Mod, Mods) of - true -> false; - false -> true - end - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% do_test_cases(TopCases, SkipCases, Config, TimetrapSpec) -> -%% exit(Result) -%% -%% TopCases = term() (See collect_cases/3) -%% SkipCases = term() (See collect_cases/3) -%% Config = term() (See collect_cases/3) -%% TimetrapSpec = MultiplyTimetrap | {MultiplyTimetrap,ScaleTimetrap} -%% MultiplyTimetrap = integer() | infinity -%% ScaleTimetrap = bool() -%% -%% Initializes and starts the test run, for "ordinary" test suites. -%% Creates log directories and log files, inserts initial timestamps and -%% configuration information into the log files. -%% -%% This function is meant to be called by a process created by -%% spawn_tester/10, which sets up some necessary dictionary values. -do_test_cases(TopCases, SkipCases, - Config, MultiplyTimetrap) when is_integer(MultiplyTimetrap); - MultiplyTimetrap == infinity -> - do_test_cases(TopCases, SkipCases, Config, {MultiplyTimetrap,true}); - -do_test_cases(TopCases, SkipCases, - Config, TimetrapData) when is_list(TopCases), - is_tuple(TimetrapData) -> - {ok,TestDir} = start_log_file(), - FwMod = get_fw_mod(?MODULE), - case collect_all_cases(TopCases, SkipCases) of - {error,Why} -> - print(1, "Error starting: ~p", [Why]), - exit(test_suites_done); - TestSpec0 -> - N = case remove_conf(TestSpec0) of - {repeats,_} -> unknown; - TS -> length(TS) - end, - put(test_server_cases, N), - put(test_server_case_num, 0), - - TestSpec = - add_init_and_end_per_suite(TestSpec0, undefined, undefined, FwMod), - - TI = get_target_info(), - print(1, "Starting test~ts", - [print_if_known(N, {", ~w test cases",[N]}, - {" (with repeated test cases)",[]})]), - Test = get(test_server_name), - TestName = if is_list(Test) -> - lists:flatten(io_lib:format("~ts", [Test])); - true -> - lists:flatten(io_lib:format("~tp", [Test])) - end, - TestDescr = "Test " ++ TestName ++ " results", - - test_server_sup:framework_call(report, [tests_start,{Test,N}]), - - {Header,Footer} = - case test_server_sup:framework_call(get_html_wrapper, - [TestDescr,true,TestDir, - {[],[2,3,4,7,8],[1,6]}], "") of - Empty when (Empty == "") ; (element(2,Empty) == "") -> - put(basic_html, true), - {[html_header(TestDescr), - "

Results for test ", TestName, "

\n"], - "\n\n\n"}; - {basic_html,Html0,Html1} -> - put(basic_html, true), - {Html0++["

Results for ",TestName,"

\n"], - Html1}; - {xhtml,Html0,Html1} -> - put(basic_html, false), - {Html0++["

Results for ",TestName,"

\n"], - Html1} - end, - - print(html, Header), - - print(html, xhtml("

", "

")), - print_timestamp(html, "Test started at "), - print(html, xhtml("

", "

")), - - print(html, xhtml("\n

Host info:
\n", - "\n

Host info:
\n")), - print_who(test_server_sup:hoststr(), test_server_sup:get_username()), - print(html, xhtml("
Used Erlang v~ts in ~ts

\n", - "
Used Erlang v~ts in \"~ts\"

\n"), - [erlang:system_info(version), code:root_dir()]), - - if FwMod == ?MODULE -> - print(html, xhtml("\n

Target Info:
\n", - "\n

Target Info:
\n")), - print_who(TI#target_info.host, TI#target_info.username), - print(html,xhtml("
Used Erlang v~ts in ~ts

\n", - "
Used Erlang v~ts in \"~ts\"

\n"), - [TI#target_info.version, TI#target_info.root_dir]); - true -> - case test_server_sup:framework_call(target_info, []) of - TargetInfo when is_list(TargetInfo), - length(TargetInfo) > 0 -> - print(html, xhtml("\n

Target info:
\n", - "\n

Target info:
\n")), - print(html, "~ts

\n", [TargetInfo]); - _ -> - ok - end - end, - CoverLog = - case get(test_server_cover_log_dir) of - undefined -> - ?coverlog_name; - AbsLogDir -> - AbsLog = filename:join(AbsLogDir,?coverlog_name), - make_relative(AbsLog, TestDir) - end, - print(html, - "

\n", - [?suitelog_name,CoverLog,?unexpected_io_log]), - print(html, - "

~ts

\n" ++ - xhtml(["\n", - "\n"], - ["
\n", - "\n"]) ++ - "" ++ - "" ++ - "\n\n\n", - [print_if_known(N, {"Executing ~w test cases..." - ++ xhtml("\n
\n", "\n
\n"),[N]}, - {"",[]})]), - - print(major, "=cases ~w", [get(test_server_cases)]), - print(major, "=user ~ts", [TI#target_info.username]), - print(major, "=host ~ts", [TI#target_info.host]), - - %% If there are no hosts specified,use only the local host - case controller_call(get_hosts) of - [] -> - print(major, "=hosts ~ts", [TI#target_info.host]), - controller_call({set_hosts, [TI#target_info.host]}); - Hosts -> - Str = lists:flatten(lists:map(fun(X) -> [X," "] end, Hosts)), - print(major, "=hosts ~ts", [Str]) - end, - print(major, "=emulator_vsn ~ts", [TI#target_info.version]), - print(major, "=emulator ~ts", [TI#target_info.emulator]), - print(major, "=otp_release ~ts", [TI#target_info.otp_release]), - print(major, "=started ~s", - [lists:flatten(timestamp_get(""))]), - - test_server_io:set_footer(Footer), - - run_test_cases(TestSpec, Config, TimetrapData) - end; - -do_test_cases(TopCase, SkipCases, Config, TimetrapSpec) -> - %% when not list(TopCase) - do_test_cases([TopCase], SkipCases, Config, TimetrapSpec). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% start_log_file() -> {ok,TestDirName} | exit({Error,Reason}) -%% Stem = string() -%% -%% Creates the log directories, the major log file and the html log file. -%% The log files are initialized with some header information. -%% -%% The name of the log directory will be .logs/run./ where -%% Name is the test suite name and Date is the current date and time. - -start_log_file() -> - Dir = get(test_server_dir), - case file:make_dir(Dir) of - ok -> - ok; - {error, eexist} -> - ok; - MkDirError -> - log_file_error(MkDirError, Dir) - end, - TestDir = timestamp_filename_get(filename:join(Dir, "run.")), - TestDir1 = - case file:make_dir(TestDir) of - ok -> - TestDir; - {error,eexist} -> - timer:sleep(1000), - %% we need min 1 second between timestamps unfortunately - TestDirX = timestamp_filename_get(filename:join(Dir, "run.")), - case file:make_dir(TestDirX) of - ok -> - TestDirX; - MkDirError2 -> - log_file_error(MkDirError2, TestDirX) - end; - MkDirError2 -> - log_file_error(MkDirError2, TestDir) - end, - FilenameMode = file:native_name_encoding(), - ok = write_file(filename:join(Dir, ?last_file), - TestDir1 ++ "\n", - FilenameMode), - ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode), - put(test_server_log_dir_base,TestDir1), - - MajorName = filename:join(TestDir1, ?suitelog_name), - HtmlName = MajorName ++ ?html_ext, - UnexpectedName = filename:join(TestDir1, ?unexpected_io_log), - - {ok,Major} = open_utf8_file(MajorName), - {ok,Html} = open_html_file(HtmlName), - - {UnexpHeader,UnexpFooter} = - case test_server_sup:framework_call(get_html_wrapper, - ["Unexpected I/O log",false, - TestDir, undefined],"") of - UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "") -> - {html_header("Unexpected I/O log"),"\n\n\n"}; - {basic_html,UH,UF} -> - {UH,UF}; - {xhtml,UH,UF} -> - {UH,UF} - end, - - {ok,Unexpected} = open_html_file(UnexpectedName), - io:put_chars(Unexpected, [UnexpHeader, - xhtml("
\n

Unexpected I/O

", - "
\n

Unexpected I/O

"), - "\n
\n"]),
-    put(test_server_unexpected_footer,{UnexpectedName,UnexpFooter}),
-
-    test_server_io:set_fd(major, Major),
-    test_server_io:set_fd(html, Html),
-    test_server_io:set_fd(unexpected_io, Unexpected),
-
-    make_html_link(filename:absname(?last_test ++ ?html_ext),
-		   HtmlName, filename:basename(Dir)),
-    LinkName = filename:join(Dir, ?last_link),
-    make_html_link(LinkName ++ ?html_ext, HtmlName,
-		   filename:basename(Dir)),
-
-    PrivDir = filename:join(TestDir1, ?priv_dir),
-    ok = file:make_dir(PrivDir),
-    put(test_server_priv_dir,PrivDir++"/"),
-    print_timestamp(major, "Suite started at "),
-
-    LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}],
-    test_server_sup:framework_call(report, [loginfo,LogInfo]),
-    {ok,TestDir1}.
-
-log_file_error(Error, Dir) ->
-    exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}).
-
-make_html_link(LinkName, Target, Explanation) ->
-    %% if possible use a relative reference to Target.
-    TargetL = filename:split(Target),
-    PwdL = filename:split(filename:dirname(LinkName)),
-    Href = case lists:prefix(PwdL, TargetL) of
-	       true ->
-		   uri_encode(filename:join(lists:nthtail(length(PwdL),TargetL)));
-	       false ->
-		   "file:" ++ uri_encode(Target)
-	   end,
-    H = [html_header(Explanation),
-	 "
Last test
\n"
-	 "",Explanation,"\n"
-	 "\n\n"],
-    ok = write_html_file(LinkName, H).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% start_minor_log_file(Mod, Func, ParallelTC) -> AbsName
-%% Mod = atom()
-%% Func = atom()
-%% ParallelTC = bool()
-%% AbsName = string()
-%%
-%% Create a minor log file for the test case Mod,Func,Args. The log file
-%% will be stored in the log directory under the name ..html.
-%% Some header info will also be inserted into the log file. If the test
-%% case runs in a parallel group, then to avoid clashing file names if the
-%% case is executed more than once, the name ...html
-%% is used.
-
-start_minor_log_file(Mod, Func, ParallelTC) ->
-    MFA = {Mod,Func,1},
-    LogDir = get(test_server_log_dir_base),
-    Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
-    Name = downcase(Name0),
-    AbsName = filename:join(LogDir, Name),
-    case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
-	false ->                           %% normal case, unique name
-	    start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
-	true ->                            %% special case, duplicate names
-	    Tag = test_server_sup:unique_name(),
-	    Name1_0 =
-		lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
-							      ?html_ext])),
-	    Name1 = downcase(Name1_0),
-	    AbsName1 = filename:join(LogDir, Name1),
-	    start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
-    end.
-
-start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
-    {ok,Fd} = open_html_file(AbsName),
-    Lev = get(test_server_minor_level)+1000, %% far down in the minor levels
-    put(test_server_minor_fd, Fd),
-    test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
-
-    TestDescr = io_lib:format("Test ~w:~w result", [Mod,Func]),
-    {Header,Footer} =
-	case test_server_sup:framework_call(get_html_wrapper,
-					    [TestDescr,false,
-					     filename:dirname(AbsName),
-					     undefined], "") of
-	    Empty when (Empty == "") ; (element(2,Empty) == "")  ->
-		put(basic_html, true),
-		{html_header(TestDescr), "\n\n\n"};
-	    {basic_html,Html0,Html1} ->
-		put(basic_html, true),
-		{Html0,Html1};
-	    {xhtml,Html0,Html1} ->
-		put(basic_html, false),
-		{Html0,Html1}
-	end,
-    put(test_server_minor_footer, Footer),
-    io:put_chars(Fd, Header),
-
-    io:put_chars(Fd, ""),
-    io:put_chars(Fd, "
\n"),
-
-    SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext,
-
-    case get_fw_mod(?MODULE) of
-	Mod when Func == error_in_suite ->
-	    ok;
-	_ ->
-	    {Info,Arity} =
-		if Func == init_per_suite; Func == end_per_suite ->
-			{"Config function: ", 1};
-		   Func == init_per_group; Func == end_per_group ->
-			{"Config function: ", 2};
-		   true ->
-			{"Test case: ", 1}
-		end,
-	    
-	    case {filelib:is_file(filename:join(LogDir, SrcListing)),
-		  lists:member(no_src, get(test_server_logopts))} of
-		{true,false} ->
-		    print(Lev, Info ++ "~w:~w/~w "
-			  "(click for source code)\n",
-			  [uri_encode(SrcListing),
-			   uri_encode(atom_to_list(Func)++"-1",utf8),
-			   Mod,Func,Arity]);
-		_ ->
-		    print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity])
-	    end
-    end,
-
-    AbsName.
-
-stop_minor_log_file() ->
-    test_server_gl:unset_minor_fd(group_leader()),
-    Fd = get(test_server_minor_fd),
-    Footer = get(test_server_minor_footer),
-    io:put_chars(Fd, "
\n" ++ Footer),
-    ok = file:close(Fd),
-    put(test_server_minor_fd, undefined).
-
-downcase(S) -> downcase(S, []).
-downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
-    downcase(Rest, [Uc-$A+$a|Result]);
-downcase([C|Rest], Result) ->
-    downcase(Rest, [C|Result]);
-downcase([], Result) ->
-    lists:reverse(Result).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% html_convert_modules(TestSpec, Config) -> ok
-%%  Isolate the modules affected by TestSpec and
-%%  make sure they are converted to html.
-%%
-%%  Errors are silently ignored.
-
-html_convert_modules(TestSpec, _Config, FwMod) ->
-    Mods = html_isolate_modules(TestSpec, FwMod),
-    html_convert_modules(Mods),
-    copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).
-
-%% Retrieve a list of modules out of the test spec.
-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,{_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
-	       undefined -> Set;
-	       Mod -> sets:add_element(Mod, Set)
-	   end,
-    html_isolate_modules(Cases, Set1, FwMod);
-html_isolate_modules([{conf,_Ref,_Props,{Mod,_Func}}|Cases], Set, FwMod) ->
-    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{skip_case,{conf,_Ref,{FwMod,_Func},_Cmt},Mode}|Cases],
-		     Set, FwMod) ->
-    Set1 = case proplists:get_value(suite, get_props(Mode)) of
-	       undefined -> Set;
-	       Mod -> sets:add_element(Mod, Set)
-	   end,
-    html_isolate_modules(Cases, Set1, FwMod);
-html_isolate_modules([{skip_case,{conf,_Ref,{Mod,_Func},_Cmt},_Props}|Cases],
-		     Set, FwMod) ->
-    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{Mod,_Case}|Cases], Set, FwMod) ->
-    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod);
-html_isolate_modules([{Mod,_Case,_Args}|Cases], Set, FwMod) ->
-    html_isolate_modules(Cases, sets:add_element(Mod, Set), FwMod).
-
-%% Given a list of modules, convert each module's source code to HTML.
-html_convert_modules([Mod|Mods]) ->
-    case code:which(Mod) of
-	Path when is_list(Path) ->
-	    SrcFile = filename:rootname(Path) ++ ".erl",
-	    FoundSrcFile =
-		case file:read_file_info(SrcFile) of
-		    {ok,SInfo} ->
-			{SrcFile,SInfo};
-		    {error,_} ->
-			ModInfo = Mod:module_info(compile),
-			case proplists:get_value(source, ModInfo) of
-			    undefined ->
-				undefined;
-			    OtherSrcFile ->
-				case file:read_file_info(OtherSrcFile) of
-				    {ok,SInfo} ->
-					{OtherSrcFile,SInfo};
-				    {error,_} ->
-					undefined
-				end
-			end
-		end,
-	    case FoundSrcFile of
-		undefined ->
-		    html_convert_modules(Mods);
-		{SrcFile1,SrcFileInfo} ->
-		    DestDir = get(test_server_dir),
-		    Name = atom_to_list(Mod),
-		    DestFile = filename:join(DestDir,
-					     downcase(Name)++?src_listing_ext),
-		    html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
-		    html_convert_modules(Mods)
-	    end;
-	_Other ->
-	    html_convert_modules(Mods)
-    end;
-html_convert_modules([]) -> ok.
-
-%% Convert source code to HTML if possible and needed.
-html_possibly_convert(Src, SrcInfo, Dest) ->
-    case file:read_file_info(Dest) of
-	{ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime ->
-	    ok;					% dest file up to date
-	_ ->
-	    InclPath = case application:get_env(test_server, include) of
-			   {ok,Incls} -> Incls;
-			   _ -> []
-		       end,
-
-	    OutDir = get(test_server_log_dir_base),
-	    case test_server_sup:framework_call(get_html_wrapper,
-						["Module "++Src,false,
-						 OutDir,undefined,
-						 encoding(Src)], "") of
-		Empty when (Empty == "") ; (element(2,Empty) == "")  ->
-		    erl2html2:convert(Src, Dest, InclPath);
-		{_,Header,_} ->
-		    erl2html2:convert(Src, Dest, InclPath, Header)
-	    end
-    end.
-
-%% Copy all HTML files in InDir to OutDir.
-copy_html_files(InDir, OutDir) ->
-    Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
-    lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).
-
-copy_html_file(Src, DestDir) ->
-    Dest = filename:join(DestDir, filename:basename(Src)),
-    case file:read_file(Src) of
-	{ok,Bin} ->
-	    ok = write_binary_file(Dest, Bin);
-	{error,_Reason} ->
-	    io:format("File ~ts: read failed\n", [Src])
-    end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% add_init_and_end_per_suite(TestSpec, Mod, Ref, FwMod) -> NewTestSpec
-%%
-%% Expands TestSpec with an initial init_per_suite, and a final
-%% end_per_suite element, per each discovered suite in the list.
-
-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,
-			   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,_},_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, 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, 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([{conf,Ref,Props,{FwMod,Func}}=Case|Cases], LastMod,
-			   LastRef, FwMod) ->
-    %% if Mod == FwMod, this conf test is (probably) a test case group where
-    %% the init- and end-functions are missing in the suite, and if so,
-    %% the suite name should be stored as {suite,Suite} in Props
-    case proplists:get_value(suite, Props) of
-	Suite when Suite =/= undefined, Suite =/= LastMod ->
-	    {PreCases, NextMod, NextRef} =
-		do_add_init_and_end_per_suite(LastMod, LastRef, Suite, FwMod),
-	    Case1 = {conf,Ref,[{suite,NextMod}|proplists:delete(suite,Props)],
-		     {FwMod,Func}},
-	    PreCases ++ [Case1|add_init_and_end_per_suite(Cases, NextMod,
-							  NextRef, FwMod)];
-	_ ->
-	    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]
-    end;
-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)];
-add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod)
-  when element(1,SkipCase) == skip_case;  element(1,SkipCase) == auto_skip_case->
-    [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)];
-add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) ->
-    [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, 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)];
-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)];
-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) ->
-    [];
-add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) ->
-    [];
-add_init_and_end_per_suite([], LastMod, LastRef, FwMod) ->
-    %% we'll add end_per_suite here even if it's not exported
-    %% (and simply let the call fail if it's missing)
-    case erlang:function_exported(LastMod, end_per_suite, 1) of
-	true ->
-	    [{conf,LastRef,[],{LastMod,end_per_suite}}];
-	false ->
-	    %% let's call a "fake" end_per_suite if it exists			
-	    case erlang:function_exported(FwMod, end_per_suite, 1) of
-		true ->					
-		    [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}];
-		false ->		
-		    [{conf,LastRef,[],{LastMod,end_per_suite}}]
-	    end
-    end.    
-
-do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) ->
-    case code:is_loaded(Mod) of
-	false -> code:load_file(Mod);
-	_ -> ok
-    end,
-    {Init,NextMod,NextRef} =
-	case erlang:function_exported(Mod, init_per_suite, 1) of
-	    true ->
-		Ref = make_ref(),
-		{[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref};
-	    false ->
-		%% let's call a "fake" init_per_suite if it exists
-		case erlang:function_exported(FwMod, init_per_suite, 1) of
-		    true ->
-			Ref = make_ref(),
-			{[{conf,Ref,[{suite,Mod}],
-			   {FwMod,init_per_suite}}],Mod,Ref};
-		    false ->
-			{[],Mod,undefined}
-		end
-
-	end,
-    Cases =
-	if LastRef==undefined ->
-		Init;
-	   LastRef==skipped_suite ->
-		Init;
-	   true ->
-		%% we'll add end_per_suite here even if it's not exported
-		%% (and simply let the call fail if it's missing)
-		case erlang:function_exported(LastMod, end_per_suite, 1) of
-		    true ->
-			[{conf,LastRef,[],{LastMod,end_per_suite}}|Init];
-		    false ->
-			%% let's call a "fake" end_per_suite if it exists
-			case erlang:function_exported(FwMod, end_per_suite, 1) of
-			    true ->				
-				[{conf,LastRef,[{suite,Mod}],
-				  {FwMod,end_per_suite}}|Init];
-			    false ->
-				[{conf,LastRef,[],{LastMod,end_per_suite}}|Init]
-			end
-		end
-	end,
-    {Cases,NextMod,NextRef}.
-
-do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) ->
-    case LastRef of
-	No when No==undefined ; No==skipped_suite ->
-	    {[],Mod,skipped_suite};
-	_Ref ->
-	    case erlang:function_exported(LastMod, end_per_suite, 1) of
-		true ->
-		    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
-		     Mod,skipped_suite};
-		false ->
-		    case erlang:function_exported(FwMod, end_per_suite, 1) of
-			true ->				
-			    %% let's call "fake" end_per_suite if it exists
-			    {[{conf,LastRef,[],{FwMod,end_per_suite}}],
-			     Mod,skipped_suite};
-			false ->
-			    {[{conf,LastRef,[],{LastMod,end_per_suite}}],
-			     Mod,skipped_suite}
-		    end
-	    end    	    
-    end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_cases(TestSpec, Config, TimetrapData) -> exit(Result)
-%%
-%% Runs the specified tests, then displays/logs the summary.
-
-run_test_cases(TestSpec, Config, TimetrapData) ->
-    test_server:init_purify(),
-    case lists:member(no_src, get(test_server_logopts)) of
-	true ->
-	    ok;
-	false ->
-	    FwMod = get_fw_mod(?MODULE),
-	    html_convert_modules(TestSpec, Config, FwMod)
-    end,
-
-    run_test_cases_loop(TestSpec, [Config], TimetrapData, [], []),
-
-    {AllSkippedN,UserSkipN,AutoSkipN,SkipStr} =
-	case get(test_server_skipped) of
-	    {0,0} -> {0,0,0,""};
-	    {US,AS} -> {US+AS,US,AS,io_lib:format(", ~w skipped", [US+AS])}
-	end,
-    OkN = get(test_server_ok),
-    FailedN = get(test_server_failed),
-    print(1, "TEST COMPLETE, ~w ok, ~w failed~ts of ~w test cases\n",
-	  [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]),
-    test_server_sup:framework_call(report, [tests_done,
-					    {OkN,FailedN,{UserSkipN,AutoSkipN}}]),
-    print(major, "=finished      ~s", [lists:flatten(timestamp_get(""))]),
-    print(major, "=failed        ~w", [FailedN]),
-    print(major, "=successful    ~w", [OkN]),
-    print(major, "=user_skipped  ~w", [UserSkipN]),
-    print(major, "=auto_skipped  ~w", [AutoSkipN]),
-    exit(test_suites_done).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% run_test_cases_loop(TestCases, Config, TimetrapData, Mode, Status) -> ok
-%% TestCases = [Test,...]
-%% Config = [[{Key,Val},...],...]
-%% TimetrapData = {MultiplyTimetrap,ScaleTimetrap}
-%% MultiplyTimetrap = integer() | infinity
-%% ScaleTimetrap = bool()
-%% Mode = [{Ref,[Prop,..],StartTime}]
-%% Ref = reference()
-%% Prop = {name,Name} | sequence | parallel |
-%%        shuffle | {shuffle,Seed} |
-%%        repeat | {repeat,N} |
-%%        repeat_until_all_ok | {repeat_until_all_ok,N} |
-%%        repeat_until_any_ok | {repeat_until_any_ok,N} |
-%%        repeat_until_any_fail | {repeat_until_any_fail,N} |
-%%        repeat_until_all_fail | {repeat_until_all_fail,N}
-%% Status = [{Ref,{{Ok,Skipped,Failed},CopiedCases}}]
-%% Ok = Skipped = Failed = [Case,...]
-%%
-%% Execute the TestCases under configuration Config. Config is a list
-%% of lists, where hd(Config) holds the config tuples for the current
-%% conf case and tl(Config) is the data for the higher level conf cases.
-%% Config data is "inherited" from top to nested conf cases, but
-%% never the other way around. if length(Config) == 1, Config contains
-%% only the initial config data for the suite.
-%%
-%% Test may be one of the following:
-%%
-%% {conf,Ref,Props,{Mod,Func}} Mod:Func is a configuration modification
-%% function, call it with the current configuration as argument. It will
-%% return a new configuration.
-%%
-%% {make,Ref,{Mod,Func,Args}} Mod:Func is a make function, and it is called
-%% with the given arguments.
-%%
-%% {Mod,Case} This is a normal test case. Determine the correct
-%% configuration, and insert {Mod,Case,Config} as head of the list,
-%% then reiterate.
-%%
-%% {Mod,Case,Args} A test case with predefined argument (usually a normal
-%% test case which just got a fresh configuration (see above)).
-%%
-%% {skip_case,{conf,Ref,Case,Comment}} An init conf case gets skipped
-%% by the user. This will also cause the end conf case to be skipped.
-%% Note that it is not possible to skip an end conf case directly (it
-%% can only be skipped indirectly by a skipped init conf case). The
-%% comment (which gets printed in the log files) describes why the case
-%% was skipped.
-%%
-%% {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.
-%%
-%% {auto_skip_case,{conf,Ref,Case,Comment},Mode} This is the result of
-%% an end conf case being automatically skipped due to a failing init
-%% conf case. It could also be a nested conf case that gets skipped
-%% because of a failed or skipped top level conf.
-%%
-%% {auto_skip_case,{Case,Comment},Mode} This is a normal test case which
-%% gets automatically skipped because of a failing init conf case or
-%% because of a failing previous test case in a sequence.
-%%
-%% -------------------------------------------------------------------
-%% Description of IO handling during execution of parallel test cases:
-%% -------------------------------------------------------------------
-%%
-%% A conf group can have an associated list of properties. If the
-%% parallel property is specified for a group, it means the test cases
-%% should be spawned and run in parallel rather than called sequentially
-%% (which is always the default mode). Test cases that execute in parallel
-%% also write to their respective minor log files in parallel. Printouts
-%% to common log files, such as the summary html file and the major log
-%% file on text format, still have to be processed sequentially. For this
-%% reason, the Mode argument specifies if a parallel group is currently
-%% being executed.
-%%
-%% The low-level mechanism for buffering IO for the common log files
-%% is handled by the test_server_io module. Buffering is turned on by
-%% test_server_io:start_transaction/0 and off by calling
-%% test_server_io:end_transaction/0. The buffered data for the transaction
-%% can printed by calling test_server_io:print_buffered/1.
-%%
-%% This module is responsible for turning on IO buffering and to later
-%% test_server_io:print_buffered/1 to print the data. To help with this,
-%% two variables in the process dictionary are used:
-%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
-%% are set to as follwing:
-%%
-%%   Value	Meaning
-%%   -----     -------
-%%   undefined	No parallel test cases running
-%%   {tc,Pid}	Running test cases in a top-level parallel group
-%%   {Ref,Pid}	Running sequential test case inside a parallel group
-%%
-%% FIXME: The Pid is no longer used.
-%%
-%% If a conf group nested under a parallel group in the test
-%% specification should be started, the 'test_server_common_io_handler'
-%% value gets set also on the main process.
-%%
-%% During execution of a parallel group (or of a group nested under a
-%% parallel group), *any* new test case being started gets registered
-%% in a list saved in the dictionary with 'test_server_queued_io' as key.
-%% When the top level parallel group is finished (only then can we be
-%% sure all parallel test cases have finished and "reported in"), the
-%% list of test cases is traversed in order and test_server_io:print_buffered/1
-%% can be called for each test case. See handle_test_case_io_and_status/0
-%% for details.
-%%
-%% To be able to handle nested conf groups with different properties,
-%% the Mode argument specifies a list of {Ref,Properties} tuples.
-%% The head of the Mode list at any given time identifies the group
-%% currently being processed. The tail of the list identifies groups
-%% on higher level.
-%%
-%% -------------------------------------------------------------------
-%% Notes on parallel execution of test cases
-%% -------------------------------------------------------------------
-%%
-%% A group nested under a parallel group will start executing in
-%% parallel with previous (parallel) test cases (no matter what
-%% properties the nested group has). Test cases are however never
-%% executed in parallel with the start or end conf case of the same
-%% group! Because of this, the test_server_ctrl loop waits at
-%% the end conf of a group for all parallel cases to finish
-%% before the end conf case actually executes. This has the effect
-%% that it's only after a nested group has finished that any
-%% remaining parallel cases in the previous group get spawned (*).
-%% Example (all parallel cases):
-%%
-%% group1_init   |---->
-%% group1_case1        | --------->
-%% group1_case2        | --------------------------------->
-%% group2_init         | ---->
-%% group2_case1               | ------>
-%% group2_case2               | ---------->
-%% group2_end                              | --->
-%% group1_case3                               (*)| ---->
-%% group1_case4                               (*)| -->
-%% group1_end                                              | --->
-%%
-
-run_test_cases_loop([{SkipTag,CaseData={Type,_Ref,_Case,_Comment}}|Cases],
-		    Config, TimetrapData, Mode, Status) when
-      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
-      ((Type==conf) or (Type==make)) ->
-    run_test_cases_loop([{SkipTag,CaseData,Mode}|Cases],
-			Config, TimetrapData, Mode, Status);
-
-run_test_cases_loop([{SkipTag,{Type,Ref,Case,Comment},SkipMode}|Cases],
-		    Config, TimetrapData, Mode, Status) when
-      ((SkipTag==auto_skip_case) or (SkipTag==skip_case)) and
-      ((Type==conf) or (Type==make)) ->
-    file:set_cwd(filename:dirname(get(test_server_dir))),
-    CurrIOHandler = get(test_server_common_io_handler),
-    ParentMode = tl(Mode),
-
-    {AutoOrUser,ReportTag} = 
-	if SkipTag == auto_skip_case -> {auto,tc_auto_skip};
-	   SkipTag == skip_case      -> {user,tc_user_skip}
-	end,
-
-    %% check and update the mode for test case execution and io msg handling
-    case {curr_ref(Mode),check_props(parallel, Mode)} of
-	{Ref,Ref} ->
-	    case check_props(parallel, ParentMode) of
-		false ->
-		    %% this is a skipped end conf for a top level parallel
-		    %% group, buffered io can be flushed
-		    handle_test_case_io_and_status(),
-		    set_io_buffering(undefined),
-		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-					   false, SkipMode),
-		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-		    test_server_sup:framework_call(report,
-						   [ReportTag,ConfData]),
-		    run_test_cases_loop(Cases, Config, TimetrapData, ParentMode,
-					delete_status(Ref, Status));
-		_ ->
-		    %% this is a skipped end conf for a parallel group nested
-		    %% under a parallel group (io buffering is active)
-		    wait_for_cases(Ref),
-		    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-					   true, SkipMode),
-		    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-		    test_server_sup:framework_call(report, [ReportTag,ConfData]),
-		    case CurrIOHandler of
-			{Ref,_} ->
-			    %% current_io_handler was set by start conf of this
-			    %% group, so we can unset it now (no more io from main
-			    %% process needs to be buffered)
-			    set_io_buffering(undefined);
-			_ ->
-			    ok
-		    end,
-		    run_test_cases_loop(Cases, Config,
-					TimetrapData, ParentMode,
-					delete_status(Ref, Status))
-	    end;
-	{Ref,false} ->
-	    %% this is a skipped end conf for a non-parallel group that's not
-	    %% nested under a parallel group
-	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-				   false, SkipMode),
-	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
-
-	    %% Check if this group is auto skipped because of error in the
-	    %% init conf. If so, check if the parent group is a sequence,
-	    %% and if it is, skip all proceeding tests in that group.
-	    GrName = get_name(Mode),
-	    Cases1 =
-		case get_tc_results(Status) of
-		    {_,_,Fails} when length(Fails) > 0 ->
-			case lists:member({group_result,GrName}, Fails) of
-			    true ->
-				case check_prop(sequence, ParentMode) of
-				    false ->
-					Cases;
-				    ParentRef ->
-					Reason = {group_result,GrName,failed},
-					skip_cases_upto(ParentRef, Cases,
-							Reason, tc, ParentMode,
-							SkipTag)
-				end;
-			    false ->
-				Cases
-			end;
-		    _ ->
-			Cases
-		end,
-	    run_test_cases_loop(Cases1, Config, TimetrapData, ParentMode,
-				delete_status(Ref, Status));
-	{Ref,_} ->
-	    %% this is a skipped end conf for a non-parallel group nested under
-	    %% a parallel group (io buffering is active)
-	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-				   true, SkipMode),
-	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
-	    case CurrIOHandler of
-		{Ref,_} ->
-		    %% current_io_handler was set by start conf of this
-		    %% group, so we can unset it now (no more io from main
-		    %% process needs to be buffered)
-		    set_io_buffering(undefined);
-		_ ->
-		    ok
-	    end,
-	    run_test_cases_loop(Cases, Config, TimetrapData, tl(Mode),
-				delete_status(Ref, Status));
-	{_,false} ->
-	    %% this is a skipped start conf for a group which is not nested
-	    %% under a parallel group
-	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-				   false, SkipMode),
-	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
-	    run_test_cases_loop(Cases, Config, TimetrapData,
-				[conf(Ref,[])|Mode], Status);
-	{_,Ref0} when is_reference(Ref0) ->
-	    %% this is a skipped start conf for a group nested under a parallel
-	    %% group and if this is the first nested group, io buffering must
-	    %% be activated
-	    if CurrIOHandler == undefined ->
-		    set_io_buffering({Ref,self()});
-	       true ->
-		    ok
-	    end,
-	    {Mod,Func} = skip_case(AutoOrUser, Ref, 0, Case, Comment,
-				   true, SkipMode),
-	    ConfData = {Mod,{Func,get_name(SkipMode)},Comment},
-	    test_server_sup:framework_call(report, [ReportTag,ConfData]),
-	    run_test_cases_loop(Cases, Config, TimetrapData,
-				[conf(Ref,[])|Mode], Status)
-    end;
-
-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,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},SkipMode}|Cases],
-		    Config, TimetrapData, Mode, Status) ->
-    skip_case(user, undefined, 0, Case, Comment, false, SkipMode),
-    test_server_sup:framework_call(report, [tc_user_skip,
-					    {Mod,{all,get_name(SkipMode)},
-					     Comment}]),
-    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
-
-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(), 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));
-
-%% a start *or* end conf case, wrapping test cases or other conf cases
-run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
-		    Config, TimetrapData, Mode0, Status) ->
-    CurrIOHandler = get(test_server_common_io_handler),
-    %% check and update the mode for test case execution and io msg handling
-    {StartConf,Mode,IOHandler,ConfTime,Status1} =
-	case {curr_ref(Mode0),check_props(parallel, Mode0)} of
-	    {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
-			OkSkipFail = handle_test_case_io_and_status(),
-			file:set_cwd(filename:dirname(get(test_server_dir))),
-			After = ?now,
-			Before = get(test_server_parallel_start_time),
-			Elapsed = timer:now_diff(After, Before)/1000000,
-			put(test_server_total_time, Elapsed),
-			{false,tl(Mode0),undefined,Elapsed,
-			 update_status(Ref, OkSkipFail, Status)};
-		    _ ->
-			%% this is an end conf for a parallel group nested under a
-			%% parallel group (io buffering is active)
-			OkSkipFail = wait_for_cases(Ref),
-			queue_test_case_io(Ref, self(), 0, Mod, Func),
-			Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
-			case CurrIOHandler of
-			    {Ref,_} ->
-				%% current_io_handler was set by start conf of this
-				%% group, so we can unset it after this case (no
-				%% more io from main process needs to be buffered)
-				{false,tl(Mode0),undefined,Elapsed,
-				 update_status(Ref, OkSkipFail, Status)};
-			    _ ->
-				{false,tl(Mode0),CurrIOHandler,Elapsed,
-				 update_status(Ref, OkSkipFail, Status)}
-			end
-		end;
-	    {Ref,false} ->
-		%% this is an end conf for a non-parallel group that's not
-		%% nested under a parallel group, so no need to buffer io
-		{false,tl(Mode0),undefined,
-		 timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status};
-	    {Ref,_} ->
-		%% this is an end conf for a non-parallel group nested under
-		%% a parallel group (io buffering is active)
-		queue_test_case_io(Ref, self(), 0, Mod, Func),
-		Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000,
-		case CurrIOHandler of
-		    {Ref,_} ->
-			%% current_io_handler was set by start conf of this
-			%% group, so we can unset it after this case (no
-			%% more io from main process needs to be buffered)
-			{false,tl(Mode0),undefined,Elapsed,Status};
-		    _ ->
-			{false,tl(Mode0),CurrIOHandler,Elapsed,Status}
-		end;
-	    {_,false} ->
-		%% this is a start conf for a group which is not nested under a
-		%% parallel group, check if this case starts a new parallel group
-		case lists:member(parallel, Props) of
-		    true ->
-			%% prepare for execution of parallel group
-			put(test_server_parallel_start_time, ?now),
-			put(test_server_queued_io, []);
-		    false ->
-			ok
-		end,
-		{true,[conf(Ref,Props)|Mode0],undefined,0,Status};
-	    {_,_Ref0} ->
-		%% this is a start conf for a group nested under a parallel group, the
-		%% parallel_start_time and parallel_test_cases values have already been set
-		queue_test_case_io(Ref, self(), 0, Mod, Func),
-		%% if this is the first nested group under a parallel group, io
-		%% buffering must be activated
-		IOHandler1 = if CurrIOHandler == undefined ->
-				     IOH = {Ref,self()},
-				     set_io_buffering(IOH),
-				     IOH;
-				true ->
-				     CurrIOHandler
-			     end,
-		{true,[conf(Ref,Props)|Mode0],IOHandler1,0,Status}
-	end,
-
-    %% if this is a start conf we check if cases should be shuffled
-    {[_Conf|Cases1]=Cs1,Shuffle} =
-	if StartConf ->
-		case get_shuffle(Props) of
-		    undefined ->
-			{Cs0,undefined};
-		    {_,repeated} ->
-			%% if group is repeated, a new seed should not be set every
-			%% turn - last one is saved in dictionary
-			CurrSeed = get(test_server_curr_random_seed),
-			{shuffle_cases(Ref, Cs0, CurrSeed),{shuffle,CurrSeed}};
-		    {_,Seed} ->
-			UseSeed=
-			    %% Determine which seed to use by:
-			    %% 1. check the TS_RANDOM_SEED env variable
-			    %% 2. check random_seed in process state
-			    %% 3. use value provided with shuffle option
-			    %% 4. use timestamp() values for seed
-			    case os:getenv("TS_RANDOM_SEED") of
-				Undef when Undef == false ; Undef == "undefined" ->
-				    case get(test_server_random_seed) of
-					undefined -> Seed;
-					TSRS -> TSRS
-				    end;
-				NumStr ->
-				    %% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
-				    list_to_tuple([list_to_integer(NS) ||
-						   NS <- string:tokens(NumStr, [$ ,$:,$,])])
-			    end,
-			{shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
-		end;
-	   not StartConf ->
-		{Cs0,undefined}
-	end,
-
-    %% if this is a start conf we check if Props specifies repeat and if so
-    %% we copy the group and carry the copy until the end conf where we
-    %% decide to perform the repetition or not
-    {Repeating,Status2,Cases,ReportRepeatStop} =
-	if StartConf ->
-		case get_repeat(Props) of
-		    undefined ->
-			%% we *must* have a status entry for every conf since we
-			%% will continously update status with test case results
-			%% without knowing the Ref (but update hd(Status))
-			{false,new_status(Ref, Status1),Cases1,?void_fun};
-		    {_RepType,N} when N =< 1 ->
-			{false,new_status(Ref, Status1),Cases1,?void_fun};
-		    _ ->
-			{Copied,_} = copy_cases(Ref, make_ref(), Cs1),
-			{true,new_status(Ref, Copied, Status1),Cases1,?void_fun}
-		end;
-	   not StartConf ->
-		RepVal = get_repeat(get_props(Mode0)),
-		ReportStop =
-		    fun() ->
-			    print(minor, "~n*** Stopping repeat operation ~w", [RepVal]),
-			    print(1, "Stopping repeat operation ~w", [RepVal])
-		    end,
-		CopiedCases = get_copied_cases(Status1),
-		EndStatus = delete_status(Ref, Status1),
-		%% check in Mode0 if this is a repeat conf
-		case RepVal of
-		    undefined ->
-			{false,EndStatus,Cases1,?void_fun};
-		    {_RepType,N} when N =< 1 ->
-			{false,EndStatus,Cases1,?void_fun};
-		    {repeat,_} ->
-			{true,EndStatus,CopiedCases++Cases1,?void_fun};
-		    {repeat_until_all_ok,_} ->
-			{RestCs,Fun} = case get_tc_results(Status1) of
-					   {_,_,[]} ->
-					       {Cases1,ReportStop};
-					   _ ->
-					       {CopiedCases++Cases1,?void_fun}
-				       end,
-			{true,EndStatus,RestCs,Fun};
-		    {repeat_until_any_ok,_} ->
-			{RestCs,Fun} = case get_tc_results(Status1) of
-					   {Ok,_,_Fails} when length(Ok) > 0 ->
-					       {Cases1,ReportStop};
-					   _ ->
-					       {CopiedCases++Cases1,?void_fun}
-				       end,
-			{true,EndStatus,RestCs,Fun};
-		    {repeat_until_any_fail,_} ->
-			{RestCs,Fun} = case get_tc_results(Status1) of
-					   {_,_,Fails} when length(Fails) > 0 ->
-					       {Cases1,ReportStop};
-					   _ ->
-					       {CopiedCases++Cases1,?void_fun}
-				 end,
-			{true,EndStatus,RestCs,Fun};
-		    {repeat_until_all_fail,_} ->
-			{RestCs,Fun} = case get_tc_results(Status1) of
-					   {[],_,_} ->
-					       {Cases1,ReportStop};
-					   _ ->
-					       {CopiedCases++Cases1,?void_fun}
-				       end,
-			{true,EndStatus,RestCs,Fun}
-		end
-	end,
-
-    ReportAbortRepeat = fun(What) when Repeating ->
-				print(minor, "~n*** Aborting repeat operation "
-				      "(configuration case ~w)", [What]),
-				print(1, "Aborting repeat operation "
-				      "(configuration case ~w)", [What]);
-			   (_) -> ok
-			end,
-    CfgProps = if StartConf ->
-		       if Shuffle == undefined ->
-			       [{tc_group_properties,Props}];
-			  true ->
-			       [{tc_group_properties,
-				 [Shuffle|delete_shuffle(Props)]}]
-		       end;
-		  not StartConf ->
-		       {TcOk,TcSkip,TcFail} = get_tc_results(Status1),
-		       [{tc_group_properties,get_props(Mode0)},
-			{tc_group_result,[{ok,TcOk},
-					  {skipped,TcSkip},
-					  {failed,TcFail}]}]
-	       end,
-
-    SuiteName = proplists:get_value(suite, Props),
-    case get(test_server_create_priv_dir) of
-	auto_per_run ->				% use common priv_dir
-	    TSDirs = [{priv_dir,get(test_server_priv_dir)},
-		      {data_dir,get_data_dir(Mod, SuiteName)}];    
-	_ ->
-	    TSDirs = [{data_dir,get_data_dir(Mod, SuiteName)}]
-    end,
-
-    ActualCfg = 
-	if not StartConf ->
-		update_config(hd(Config), TSDirs ++ CfgProps);
-	   true ->
-		GroupPath = lists:flatmap(fun({_Ref,[],_T}) -> [];
-					     ({_Ref,GrProps,_T}) -> [GrProps]
-					  end, Mode0),
-		update_config(hd(Config), 
-			      TSDirs ++ [{tc_group_path,GroupPath} | CfgProps])
-	end,
-
-    CurrMode = curr_mode(Ref, Mode0, Mode),
-    ConfCaseResult = run_test_case(Ref, 0, Mod, Func, [ActualCfg], skip_init,
-				   TimetrapData, CurrMode),
-
-    case ConfCaseResult of
-	{_,NewCfg,_} when Func == init_per_suite, is_list(NewCfg) ->
-	    %% check that init_per_suite returned data on correct format
-	    case lists:filter(fun({_,_}) -> false;
-				 (_) -> true end, NewCfg) of
-		[] ->
-		    set_io_buffering(IOHandler),
-		    stop_minor_log_file(),
-		    run_test_cases_loop(Cases, [NewCfg|Config],
-					TimetrapData, Mode, Status2);
-		Bad ->
-		    print(minor,
-			  "~n*** ~w returned bad elements in Config: ~p.~n",
-			  [Func,Bad]),
-		    Reason = {failed,{Mod,init_per_suite,bad_return}},
-		    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
-					     auto_skip_case),
-		    set_io_buffering(IOHandler),
-		    stop_minor_log_file(),
-		    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
-					delete_status(Ref, Status2))
-	    end;
-	{_,NewCfg,_} when StartConf, is_list(NewCfg) ->
-	    print_conf_time(ConfTime),
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
-	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
-	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
-		  [FwMod,FwFunc,Reason]),
-	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
-	    exit(framework_error);
-	{_,Fail,_} when element(1,Fail) == 'EXIT';
-			element(1,Fail) == timetrap_timeout;
-			element(1,Fail) == user_timetrap_error;
-			element(1,Fail) == failed ->
-	    {Cases2,Config1,Status3} =
-		if StartConf ->
-			ReportAbortRepeat(failed),
-			print(minor, "~n*** ~w failed.~n"
-			      "    Skipping all cases.", [Func]),
-			Reason = {failed,{Mod,Func,Fail}},
-			{skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
-					 auto_skip_case),
-			 Config,
-			 update_status(failed, group_result, get_name(Mode),
-				       delete_status(Ref, Status2))};
-		   not StartConf ->
-			ReportRepeatStop(),
-			print_conf_time(ConfTime),
-			{Cases,tl(Config),delete_status(Ref, Status2)}
-		end,
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
-
-	{_,{auto_skip,SkipReason},_} ->
-	    %% this case can only happen if the framework (not the user)
-	    %% decides to skip execution of a conf function
-	    {Cases2,Config1,Status3} =
-		if StartConf ->
-			ReportAbortRepeat(auto_skipped),
-			print(minor, "~n*** ~w auto skipped.~n"
-			      "    Skipping all cases.", [Func]),
-			{skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
-					 auto_skip_case),
-			 Config,
-			 delete_status(Ref, Status2)};
-		   not StartConf ->
-			ReportRepeatStop(),
-			print_conf_time(ConfTime),
-			{Cases,tl(Config),delete_status(Ref, Status2)}
-		end,
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases2, Config1, TimetrapData, Mode, Status3);
-
-	{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
-	    ReportAbortRepeat(skipped),
-	    print(minor, "~n*** ~w skipped.~n"
-		  "    Skipping all cases.", [Func]),
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
-						CurrMode, skip_case),
-				[hd(Config)|Config], TimetrapData, Mode,
-				delete_status(Ref, Status2));
-	{_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
-	    ReportAbortRepeat(skipped),
-	    print(minor, "~n*** ~w skipped.~n"
-		  "    Skipping all cases.", [Func]),
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(skip_cases_upto(Ref, Cases, Reason, conf,
-						CurrMode, skip_case),
-				[hd(Config)|Config], TimetrapData, Mode,
-				delete_status(Ref, Status2));
-	{_,_Other,_} when Func == init_per_suite ->
-	    print(minor, "~n*** init_per_suite failed to return a Config list.~n", []),
-	    Reason = {failed,{Mod,init_per_suite,bad_return}},
-	    Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
-				     auto_skip_case),
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases2, Config, TimetrapData, Mode,
-				delete_status(Ref, Status2));
-	{_,_Other,_} when StartConf ->
-	    print_conf_time(ConfTime),
-	    set_io_buffering(IOHandler),
-	    ReportRepeatStop(),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases, [hd(Config)|Config], TimetrapData,
-				Mode, Status2);
-	{_,_EndConfRetVal,Opts} ->
-	    %% Check if return_group_result is set (ok, skipped or failed) and
-	    %% if so:
-	    %% 1) *If* the parent group is a sequence, skip all proceeding tests
-	    %%    in that group.
-	    %% 2) Return the value to the group "above" so that result may be
-	    %%    used for evaluating a 'repeat_until_*' property.
-	    GrName = get_name(Mode0, Func),
-	    {Cases2,Status3} =
-		case lists:keysearch(return_group_result, 1, Opts) of
-		    {value,{_,failed}} ->
-			case {curr_ref(Mode),check_prop(sequence, Mode)} of
-			    {ParentRef,ParentRef} ->
-				Reason = {group_result,GrName,failed},
-				{skip_cases_upto(ParentRef, Cases, Reason, tc,
-						 Mode, auto_skip_case),
-				 update_status(failed, group_result, GrName,
-					       delete_status(Ref, Status2))};
-			    _ ->
-				{Cases,update_status(failed, group_result, GrName,
-						     delete_status(Ref, Status2))}
-			end;
-		    {value,{_,GroupResult}} ->
-			{Cases,update_status(GroupResult, group_result, GrName,
-					     delete_status(Ref, Status2))};
-		    false ->
-			{Cases,update_status(ok, group_result, GrName,
-					     delete_status(Ref, Status2))}
-		end,
-	    print_conf_time(ConfTime),
-	    ReportRepeatStop(),
-	    set_io_buffering(IOHandler),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases2, tl(Config), TimetrapData,
-				Mode, Status3)
-    end;
-
-run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
-		    Mode, Status) ->
-    case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
-	{_,Why={'EXIT',_},_} ->
-	    print(minor, "~n*** ~w failed.~n"
- 		  "    Skipping all cases.", [Func]),
-	    Reason = {failed,{Mod,Func,Why}},
-	    Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
-				    auto_skip_case),
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status);
-	{_,_Whatever,_} ->
-	    stop_minor_log_file(),
-	    run_test_cases_loop(Cases0, Config, TimetrapData, Mode, Status)
-    end;
-
-run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0],
-		    Config, _TimetrapData, _Mode, _Status) ->
-    erlang:error(badarg, [Conf,Config]);
-
-run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) ->
-    ActualCfg =
-	case get(test_server_create_priv_dir) of
-	    auto_per_run ->
-		update_config(hd(Config), [{priv_dir,get(test_server_priv_dir)},
-					   {data_dir,get_data_dir(Mod)}]);
-	    _ ->
-		update_config(hd(Config), [{data_dir,get_data_dir(Mod)}])
-	end,
-    run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config,
-			TimetrapData, Mode, Status);
-
-run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) ->
-    {Num,RunInit} =
-	case FwMod = get_fw_mod(?MODULE) of
-	    Mod when Func == error_in_suite ->
-		{-1,skip_init};
-	    _ ->
-		{put(test_server_case_num, get(test_server_case_num)+1),
-		 run_init}
-	end,
-
-    %% check the current execution mode and save info about the case if
-    %% detected that printouts to common log files is handled later
-
-    case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of
-	true ->
-	    %% sequential test case nested in a parallel group;
-	    %% io is buffered, so we must queue this test case
-	    queue_test_case_io(undefined, self(), Num+1, Mod, Func);
-	false ->
-	    ok
-    end,
-
-    case run_test_case(undefined, Num+1, Mod, Func, Args,
-		       RunInit, TimetrapData, Mode) of
-	%% callback to framework module failed, exit immediately
-	{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
-	    print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
-		  [FwMod,FwFunc,Reason]),
-	    print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
-	    stop_minor_log_file(),
-	    exit(framework_error);
-	%% sequential execution of test case finished
-	{Time,RetVal,_} ->
-	    {Failed,Status1} =
-		case Time of
-		    died ->
-			{true,update_status(failed, Mod, Func, Status)};
-		    _ when is_tuple(RetVal) ->
-			case element(1, RetVal) of
-			    R when R=='EXIT'; R==failed ->
-				{true,update_status(failed, Mod, Func, Status)};
-			    R when R==skip; R==skipped ->
-				{false,update_status(skipped, Mod, Func, Status)};
-			    _ ->
-				{false,update_status(ok, Mod, Func, Status)}
-			end;
-		    _ ->
-			{false,update_status(ok, Mod, Func, Status)}
-		end,
-	    case check_prop(sequence, Mode) of
-		false ->
-		    stop_minor_log_file(),
-		    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
-		Ref ->
-		    %% the case is in a sequence; we must check the result and
-		    %% determine if the following cases should run or be skipped
-		    if not Failed ->	      % proceed with next case
-			    stop_minor_log_file(),
-			    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
-		       true ->	              % skip rest of cases in sequence
-			    print(minor, "~n*** ~w failed.~n"
-				  "    Skipping all other cases in sequence.",
-				  [Func]),
-			    Reason = {failed,{Mod,Func}},
-			    Cases2 = skip_cases_upto(Ref, Cases, Reason, tc,
-						     Mode, auto_skip_case),
-			    stop_minor_log_file(),
-			    run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1)
-		    end
-	    end;
-	%% the test case is being executed in parallel with the main process (and
-	%% other test cases) and Pid is the dedicated process executing the case
-	Pid ->
-	    %% io from Pid will be buffered by the test_server_io process and
-	    %% handled later, so we have to save info about the case
-	    queue_test_case_io(undefined, Pid, Num+1, Mod, Func),
-	    run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status)
-    end;
-
-%% TestSpec processing finished
-run_test_cases_loop([], _Config, _TimetrapData, _, _) ->
-    ok.
-
-%%--------------------------------------------------------------------
-%% various help functions
-
-new_status(Ref, Status) ->
-    [{Ref,{{[],[],[]},[]}} | Status].
-
-new_status(Ref, CopiedCases, Status) ->
-    [{Ref,{{[],[],[]},CopiedCases}} | Status].
-
-delete_status(Ref, Status) ->
-    lists:keydelete(Ref, 1, Status).
-
-update_status(ok, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
-    [{Ref,{{Ok++[{Mod,Func}],Skip,Fail},Cs}} | Status];
-
-update_status(skipped, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
-    [{Ref,{{Ok,Skip++[{Mod,Func}],Fail},Cs}} | Status];
-
-update_status(failed, Mod, Func, [{Ref,{{Ok,Skip,Fail},Cs}} | Status]) ->
-    [{Ref,{{Ok,Skip,Fail++[{Mod,Func}]},Cs}} | Status];
-
-update_status(_, _, _, []) ->
-    [].
-
-update_status(Ref, {Ok,Skip,Fail}, [{Ref,{{Ok0,Skip0,Fail0},Cs}} | Status]) ->
-    [{Ref,{{Ok0++Ok,Skip0++Skip,Fail0++Fail},Cs}} | Status].
-
-get_copied_cases([{_,{_,Cases}} | _Status]) ->
-    Cases.
-
-get_tc_results([{_,{OkSkipFail,_}} | _Status]) ->
-    OkSkipFail;
-get_tc_results([]) ->		      % in case init_per_suite crashed
-    {[],[],[]}.
-
-conf(Ref, Props) ->
-    {Ref,Props,?now}.
-
-curr_ref([{Ref,_Props,_}|_]) ->
-    Ref;
-curr_ref([]) ->
-    undefined.
-
-curr_mode(Ref, Mode0, Mode1) ->
-    case curr_ref(Mode1) of
-	Ref -> Mode1;
-	_   -> Mode0
-    end.
-
-get_props([{_,Props,_} | _]) ->
-    Props;
-get_props([]) ->
-    [].
-
-check_prop(_Attrib, []) ->
-    false;
-check_prop(Attrib, [{Ref,Props,_}|_]) ->
-    case lists:member(Attrib, Props) of
-	true -> Ref;
-	false -> false
-    end.
-
-check_props(Attrib, Mode) ->
-    case [R || {R,Ps,_} <- Mode, lists:member(Attrib, Ps)] of
-	[] -> false;
-	[Ref|_] -> Ref
-    end.
-
-get_name(Mode, Def) ->
-    case get_name(Mode) of
-	undefined -> Def;
-	Name      -> Name
-    end.
-
-get_name([{_Ref,Props,_}|_]) ->
-    proplists:get_value(name, Props);
-get_name([]) ->
-    undefined.
-
-conf_start(Ref, Mode) ->
-    case lists:keysearch(Ref, 1, Mode) of
-	{value,{_,_,T}} -> T;
-	false -> 0
-    end.
-
-
-get_data_dir(Mod) ->
-    get_data_dir(Mod, undefined).
-
-get_data_dir(Mod, Suite) ->
-    UseMod = if Suite == undefined -> Mod;
-		true               -> Suite
-	     end,
-    case code:which(UseMod) of
-	non_existing ->
-	    print(12, "The module ~w is not loaded", [Mod]),
-	    [];
-	cover_compiled ->
-	    MainCoverNode = cover:get_main_node(),
-	    {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]),
-	    do_get_data_dir(UseMod,File);
-	FullPath ->
-	    do_get_data_dir(UseMod,FullPath)
-    end.
-
-do_get_data_dir(Mod,File) ->
-    filename:dirname(File) ++ "/" ++ atom_to_list(Mod) ++ ?data_dir_suffix.
-
-print_conf_time(0) ->
-    ok;
-print_conf_time(ConfTime) ->
-    print(major, "=group_time    ~.3fs", [ConfTime]),
-    print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]).
-
-print_props([]) ->
-    ok;
-print_props(Props) ->
-    print(major, "=group_props   ~p", [Props]),
-    print(minor, "Group properties: ~p~n", [Props]).
-
-%% repeat N times:                                  {repeat,N}
-%% repeat N times or until all successful:          {repeat_until_all_ok,N}
-%% repeat N times or until at least one successful: {repeat_until_any_ok,N}
-%% repeat N times or until at least one case fails: {repeat_until_any_fail,N}
-%% repeat N times or until all fails:               {repeat_until_all_fail,N}
-%% N      = integer() | forever
-get_repeat(Props) ->
-    get_prop([repeat,repeat_until_all_ok,repeat_until_any_ok,
-	      repeat_until_any_fail,repeat_until_all_fail], forever, Props).
-
-update_repeat(Props) ->
-    case get_repeat(Props) of
-	undefined ->
-	    Props;
-	{RepType,N} ->
-	    Props1 =
-		if N == forever ->
-			[{RepType,N}|lists:keydelete(RepType, 1, Props)];
-		   N < 3 ->
-			lists:keydelete(RepType, 1, Props);
-		   N >= 3 ->
-			[{RepType,N-1}|lists:keydelete(RepType, 1, Props)]
-		end,
-	    %% if shuffle is used in combination with repeat, a new
-	    %% seed shouldn't be set every new turn
-	    case get_shuffle(Props1) of
-		undefined ->
-		    Props1;
-		_ ->
-		    [{shuffle,repeated}|delete_shuffle(Props1)]
-	    end
-    end.
-
-get_shuffle(Props) ->
-    get_prop([shuffle], ?now, Props).
-
-delete_shuffle(Props) ->
-    delete_prop([shuffle], Props).
-
-%% Return {Item,Value} if found, else if Item alone
-%% is found, return {Item,Default}
-get_prop([Item|Items], Default, Props) ->
-    case lists:keysearch(Item, 1, Props) of
-	{value,R} ->
-	    R;
-	false ->
-	    case lists:member(Item, Props) of
-		true ->
-		    {Item,Default};
-		false ->
-		    get_prop(Items, Default, Props)
-	    end
-    end;
-get_prop([], _Def, _Props) ->
-    undefined.
-
-delete_prop([Item|Items], Props) ->
-    Props1 = lists:delete(Item, lists:keydelete(Item, 1, Props)),
-    delete_prop(Items, Props1);
-delete_prop([], Props) ->
-    Props.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% shuffle_cases(Ref, Cases, Seed) -> Cases1
-%%
-%% Shuffles the order of Cases.
-
-shuffle_cases(Ref, Cases, undefined) ->
-    shuffle_cases(Ref, Cases, rand:seed_s(exsplus));
-
-shuffle_cases(Ref, [{conf,Ref,_,_}=Start | Cases], Seed0) ->
-    {N,CasesToShuffle,Rest} = cases_to_shuffle(Ref, Cases),
-    Seed = case Seed0 of
-	       {X,Y,Z} when is_integer(X+Y+Z) ->
-		   rand:seed(exsplus, Seed0);
-	       _ ->
-		   Seed0
-	   end,
-    ShuffledCases = random_order(N, rand:uniform_s(N, Seed), CasesToShuffle, []),
-    [Start|ShuffledCases] ++ Rest.
-
-cases_to_shuffle(Ref, Cases) ->
-    cases_to_shuffle(Ref, Cases, 1, []).
-
-cases_to_shuffle(Ref, [{conf,Ref,_,_} | _]=Cs, N, Ix) ->          % end
-    {N-1,Ix,Cs};
-cases_to_shuffle(Ref, [{skip_case,{_,Ref,_,_},_} | _]=Cs, N, Ix) -> % end
-    {N-1,Ix,Cs};
-
-cases_to_shuffle(Ref, [{conf,Ref1,_,_}=C | Cs], N, Ix) ->          % nested group
-    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
-    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
-cases_to_shuffle(Ref, [{skip_case,{_,Ref1,_,_},_}=C | Cs], N, Ix) -> % nested group
-    {Cs1,Rest} = get_subcases(Ref1, Cs, []),
-    cases_to_shuffle(Ref, Rest, N+1, [{N,[C|Cs1]} | Ix]);
-
-cases_to_shuffle(Ref, [C | Cs], N, Ix) ->
-    cases_to_shuffle(Ref, Cs, N+1, [{N,[C]} | Ix]).
-
-get_subcases(SubRef, [{conf,SubRef,_,_}=C | Cs], SubCs) ->
-    {lists:reverse([C|SubCs]),Cs};
-get_subcases(SubRef, [{skip_case,{_,SubRef,_,_},_}=C | Cs], SubCs) ->
-    {lists:reverse([C|SubCs]),Cs};
-get_subcases(SubRef, [C|Cs], SubCs) ->
-    get_subcases(SubRef, Cs, [C|SubCs]).
-
-random_order(1, {_Pos,Seed}, [{_Ix,CaseOrGroup}], Shuffled) ->
-    %% save current seed to be used if test cases are repeated
-    put(test_server_curr_random_seed, Seed),
-    Shuffled++CaseOrGroup;
-random_order(N, {Pos,NewSeed}, IxCases, Shuffled) ->
-    {First,[{_Ix,CaseOrGroup}|Rest]} = lists:split(Pos-1, IxCases),
-    random_order(N-1, rand:uniform_s(N-1, NewSeed),
-		 First++Rest, Shuffled++CaseOrGroup).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% skip_case(Type, Ref, CaseNum, Case, Comment, SendSync) -> {Mod,Func}
-%%
-%% Prints info about a skipped case in the major and html log files.
-%% 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, Mode) ->
-    MF = {Mod,Func} = case Case of
-			  {M,F,_A} -> {M,F};
-			  {M,F} -> {M,F}
-		      end,
-    if SendSync ->
-	    queue_test_case_io(Ref, self(), CaseNum, Mod, Func),
-	    self() ! {started,Ref,self(),CaseNum,Mod,Func},
-	    test_server_io:start_transaction(),
-	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode),
-	    test_server_io:end_transaction(),
-	    self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}};
-       not SendSync ->
-	    skip_case1(Type, CaseNum, Mod, Func, Comment, Mode)
-    end,
-    MF.
-
-skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
-    {{Col0,Col1},_} = get_font_style((CaseNum > 0), Mode),
-    ResultCol = if Type == auto -> ?auto_skip_color;
-		   Type == user -> ?user_skip_color
-		end,
-    print(major, "~n=case          ~w:~w", [Mod,Func]),
-    GroupName =	case get_name(Mode) of
-		    undefined ->
-			"";
-		    GrName ->
-			GrName1 = cast_to_list(GrName),
-			print(major, "=group_props   ~p", [[{name,GrName1}]]),
-			GrName1
-		end,
-    print(major, "=started       ~s", [lists:flatten(timestamp_get(""))]),
-    Comment1 = reason_to_string(Comment),
-    if Type == auto ->
-	    print(major, "=result        auto_skipped: ~ts", [Comment1]);
-       Type == user ->
-	    print(major, "=result        skipped: ~ts", [Comment1])
-    end,
-    if CaseNum == 0 ->
-	    print(2,"*** Skipping ~w ***", [{Mod,Func}]);
-       true ->
-	    print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}])
-    end,
-    TR = xhtml("
", [""]), - GroupName = case get_name(Mode) of - undefined -> ""; - Name -> cast_to_list(Name) - end, - print(html, - TR ++ "" - "" - "" - "" - "" - "" - "" - "\n", - [num2str(CaseNum),fw_name(Mod),GroupName,Func,ResultCol,Comment1]), - - if CaseNum > 0 -> - {US,AS} = get(test_server_skipped), - case Type of - user -> put(test_server_skipped, {US+1,AS}); - auto -> put(test_server_skipped, {US,AS+1}) - end, - put(test_server_case_num, CaseNum); - true -> % conf - ok - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> Cases1 -%% -%% SkipType = skip_case | auto_skip_case -%% Mark all cases tagged with Ref as skipped. - -skip_cases_upto(Ref, Cases, Reason, Origin, Mode, SkipType) -> - {_,Modified,Rest} = - modify_cases_upto(Ref, {skip,Reason,Origin,Mode,SkipType}, Cases), - Modified++Rest. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% copy_cases(OrigRef, NewRef, Cases) -> Cases1 -%% -%% Copy the test cases marked with OrigRef and tag the copies with NewRef. -%% The start conf case copy will also get its repeat property updated. - -copy_cases(OrigRef, NewRef, Cases) -> - {Original,Altered,Rest} = modify_cases_upto(OrigRef, {copy,NewRef}, Cases), - {Altered,Original++Altered++Rest}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% modify_cases_upto(Ref, ModOp, Cases) -> {Original,Altered,Remaining} -%% -%% ModOp = {skip,Reason,Origin,Mode} | {copy,NewRef} -%% Origin = conf | tc -%% -%% Modifies Cases according to ModOp and returns the original elements, -%% the modified versions of these elements and the remaining (untouched) -%% cases. - -modify_cases_upto(Ref, ModOp, Cases) -> - {Original,Altered,Rest} = modify_cases_upto(Ref, ModOp, Cases, [], []), - {lists:reverse(Original),lists:reverse(Altered),Rest}. - -%% first case of a copy operation is the start conf -modify_cases_upto(Ref, {copy,NewRef}=Op, [{conf,Ref,Props,MF}=C|T], Orig, Alt) -> - modify_cases_upto(Ref, Op, T, [C|Orig], [{conf,NewRef,update_repeat(Props),MF}|Alt]); - -modify_cases_upto(Ref, ModOp, Cases, Orig, Alt) -> - %% we need to check if there's an end conf case with the - %% same ref in the list, if not, this *is* an end conf case - case lists:any(fun({_,R,_,_}) when R == Ref -> true; - ({_,R,_}) when R == Ref -> true; - ({skip_case,{_,R,_,_},_}) when R == Ref -> true; - ({skip_case,{_,R,_,_}}) when R == Ref -> true; - (_) -> false - end, Cases) of - true -> - modify_cases_upto1(Ref, ModOp, Cases, Orig, Alt); - false -> - {[],[],Cases} - end. - -%% next case is a conf with same ref, must be end conf = we're done -modify_cases_upto1(Ref, {skip,Reason,conf,Mode,skip_case}, - [{conf,Ref,_Props,MF}|T], Orig, Alt) -> - {Orig,[{skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T}; -modify_cases_upto1(Ref, {skip,Reason,conf,Mode,auto_skip_case}, - [{conf,Ref,_Props,MF}|T], Orig, Alt) -> - {Orig,[{auto_skip_case,{conf,Ref,MF,Reason},Mode}|Alt],T}; -modify_cases_upto1(Ref, {copy,NewRef}, [{conf,Ref,Props,MF}=C|T], Orig, Alt) -> - {[C|Orig],[{conf,NewRef,update_repeat(Props),MF}|Alt],T}; - -%% we've skipped all remaining cases in a sequence -modify_cases_upto1(Ref, {skip,_,tc,_,_}, - [{conf,Ref,_Props,_MF}|_]=Cs, Orig, Alt) -> - {Orig,Alt,Cs}; - -%% next is a make case -modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, - [{make,Ref,MF}|T], Orig, Alt) -> - {Orig,[{SkipType,{make,Ref,MF,Reason},Mode}|Alt],T}; -modify_cases_upto1(Ref, {copy,NewRef}, [{make,Ref,MF}=M|T], Orig, Alt) -> - {[M|Orig],[{make,NewRef,MF}|Alt],T}; - -%% next case is a user skipped end conf with the same ref = we're done -modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, - [{skip_case,{Type,Ref,MF,_Cmt},_}|T], Orig, Alt) -> - {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T}; -modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}, - [{skip_case,{Type,Ref,MF,_Cmt}}|T], Orig, Alt) -> - {Orig,[{SkipType,{Type,Ref,MF,Reason},Mode}|Alt],T}; -modify_cases_upto1(Ref, {copy,NewRef}, - [{skip_case,{Type,Ref,MF,Cmt},Mode}=C|T], Orig, Alt) -> - {[C|Orig],[{skip_case,{Type,NewRef,MF,Cmt},Mode}|Alt],T}; -modify_cases_upto1(Ref, {copy,NewRef}, - [{skip_case,{Type,Ref,MF,Cmt}}=C|T], Orig, Alt) -> - {[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},_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,_,Mode,skip_case}=Op, - [{_M,_F}=MF|T], Orig, 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, [_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]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_io_buffering(IOHandler) -> PrevIOHandler -%% -%% Save info about current process (always the main process) buffering -%% io printout messages from parallel test case processes (*and* possibly -%% also the main process). - -set_io_buffering(IOHandler) -> - put(test_server_common_io_handler, IOHandler). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_io_buffered() -> true|false -%% -%% Test whether is being buffered. - -is_io_buffered() -> - get(test_server_common_io_handler) =/= undefined. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% queue_test_case_io(Pid, Num, Mod, Func) -> ok -%% -%% Save info about test case that gets its io buffered. This can -%% be a parallel test case or it can be a test case (conf or normal) -%% that belongs to a group nested under a parallel group. The queue -%% is processed after io buffering is disabled. See run_test_cases_loop/4 -%% and handle_test_case_io_and_status/0 for more info. - -queue_test_case_io(Ref, Pid, Num, Mod, Func) -> - Entry = {Ref,Pid,Num,Mod,Func}, - %% the order of the test cases is very important! - put(test_server_queued_io, - get(test_server_queued_io)++[Entry]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% wait_for_cases(Ref) -> {Ok,Skipped,Failed} -%% -%% At the end of a nested parallel group, we have to wait for the test -%% cases to terminate before we can go on (since test cases never execute -%% in parallel with the end conf case of the group). When a top level -%% parallel group is finished, buffered io messages must be handled and -%% this is taken care of by handle_test_case_io_and_status/0. - -wait_for_cases(Ref) -> - case get(test_server_queued_io) of - [] -> - {[],[],[]}; - Cases -> - [_Start|TCs] = - lists:dropwhile(fun({R,_,_,_,_}) when R == Ref -> false; - (_) -> true - end, Cases), - wait_and_resend(Ref, TCs, [],[],[]) - end. - -wait_and_resend(Ref, [{OtherRef,_,0,_,_}|Ps], - Ok,Skip,Fail) when is_reference(OtherRef), - OtherRef /= Ref -> - %% ignore cases that belong to nested group - Ps1 = rm_cases_upto(OtherRef, Ps), - wait_and_resend(Ref, Ps1, Ok,Skip,Fail); - -wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> - receive - {finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg -> - %% resend message to main process so that it can be used - %% to test_server_io:print_buffered/1 later - self() ! Msg, - MF = {Mod,Func}, - {Ok1,Skip1,Fail1} = - case Result of - ok -> {[MF|Ok],Skip,Fail}; - skipped -> {Ok,[MF|Skip],Fail}; - failed -> {Ok,Skip,[MF|Fail]} - end, - wait_and_resend(Ref, Ps, Ok1,Skip1,Fail1); - {'EXIT',CurrPid,Reason} when Reason /= normal -> - %% unexpected termination of test case process - {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases), - print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", - [CaseNum, Mod, Func, Reason]), - exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}}) - end; - -wait_and_resend(_, [], Ok,Skip,Fail) -> - {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}. - -rm_cases_upto(Ref, [{Ref,_,0,_,_}|Ps]) -> - Ps; -rm_cases_upto(Ref, [_|Ps]) -> - rm_cases_upto(Ref, Ps). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% handle_test_case_io_and_status() -> [Ok,Skipped,Failed} -%% -%% Each parallel test case process prints to its own minor log file during -%% execution. The common log files (major, html etc) must however be -%% written to sequentially. This is handled by calling -%% test_server_io:start_transaction/0 to tell the test_server_io process -%% to buffer all print requests. -%% -%% An io session is always started with a -%% {started,Ref,Pid,Num,Mod,Func} message (and -%% test_server_io:start_transaction/0 will be called) and terminated -%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and -%% test_server_io:end_transaction/0 will be called). The result -%% shipped with the finished message from a parallel process is used -%% to update status data of the current test run. An 'EXIT' message -%% from each parallel test case process (after finishing and -%% terminating) is also received and handled here. -%% -%% During execution of a parallel group, any cases (conf or normal) -%% belonging to a nested group will also get its io printouts buffered. -%% This is necessary to get the major and html log files written in -%% correct sequence. This function handles also the print messages -%% generated by nested group cases that have been executed sequentially -%% by the main process (note that these cases do not generate 'EXIT' -%% messages, only 'start' and 'finished' messages). -%% -%% See the header comment for run_test_cases_loop/4 for more -%% info about IO handling. -%% -%% Note: It is important that the type of messages handled here -%% do not get consumed by test_server:run_test_case_msgloop/5 -%% during the test case execution (e.g. in the catch clause of -%% the receive)! - -handle_test_case_io_and_status() -> - case get(test_server_queued_io) of - [] -> - {[],[],[]}; - Cases -> - %% Cases = [{Ref,Pid,CaseNum,Mod,Func} | ...] - Result = handle_io_and_exit_loop([], Cases, [],[],[]), - Main = self(), - %% flush normal exit messages - lists:foreach(fun({_,Pid,_,_,_}) when Pid /= Main -> - receive - {'EXIT',Pid,normal} -> ok - after - 1000 -> ok - end; - (_) -> - ok - end, Cases), - Result - end. - -%% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = []) -handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> - %% retrieve the start message for the current io session (= testcase) - receive - {started,_,CurrPid,CaseNum,Mod,Func} -> - {Ok1,Skip1,Fail1} = - case handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases) of - {ok,MF} -> {[MF|Ok],Skip,Fail}; - {skipped,MF} -> {Ok,[MF|Skip],Fail}; - {failed,MF} -> {Ok,Skip,[MF|Fail]} - end, - handle_io_and_exit_loop([], Ps, Ok1,Skip1,Fail1) - after - 1000 -> - exit({testcase_failed_to_start,Mod,Func}) - end; - -%% Handle cases that belong to groups nested under top parallel group -handle_io_and_exit_loop(Refs, [{Ref,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> - receive - {started,_,CurrPid,CaseNum,Mod,Func} -> - handle_io_and_exits(self(), CurrPid, CaseNum, Mod, Func, Cases), - Refs1 = - case Refs of - [Ref|Rs] -> % must be end conf case for subgroup - Rs; - _ when is_reference(Ref) -> % must be start of new subgroup - [Ref|Refs]; - _ -> % must be normal subgroup testcase - Refs - end, - handle_io_and_exit_loop(Refs1, Ps, Ok,Skip,Fail) - after - 1000 -> - exit({testcase_failed_to_start,Mod,Func}) - end; - -handle_io_and_exit_loop(_, [], Ok,Skip,Fail) -> - {lists:reverse(Ok),lists:reverse(Skip),lists:reverse(Fail)}. - -handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> - receive - {abort_current_testcase=Tag,_Reason,From} -> - %% If a parallel group is executing, there is no unique - %% current test case, so we must generate an error. - From ! {self(),Tag,{error,parallel_group}}, - handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); - %% end of io session from test case executed by main process - {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} -> - test_server_io:print_buffered(CurrPid), - {Result,{Mod,Func}}; - %% end of io session from test case executed by parallel process - {finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} -> - test_server_io:print_buffered(CurrPid), - case Result of - ok -> - put(test_server_ok, get(test_server_ok)+1); - failed -> - put(test_server_failed, get(test_server_failed)+1); - skipped -> - SkipCounters = - update_skip_counters(RetVal, get(test_server_skipped)), - put(test_server_skipped, SkipCounters) - end, - {Result,{Mod,Func}}; - - %% unexpected termination of test case process - {'EXIT',TCPid,Reason} when Reason /= normal -> - test_server_io:print_buffered(CurrPid), - {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases), - print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", - [Num, M, F, Reason]), - exit({unexpected_termination,{Num,M,F},{TCPid,Reason}}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case(Ref, Num, Mod, Func, Args, RunInit, -%% TimetrapData, Mode) -> RetVal -%% -%% Creates the minor log file and inserts some test case specific headers -%% and footers into the log files. Then the test case is executed and the -%% result is printed to the log files (also info about lingering processes -%% & slave nodes in the system is presented). -%% -%% RunInit decides if the per test case init is to be run (true for all -%% but conf cases). -%% -%% Mode specifies if the test case should be executed by a dedicated, -%% parallel, process rather than sequentially by the main process. If -%% the former, the new process is spawned and the dictionary of the main -%% process is copied to the test case process. -%% -%% RetVal is the result of executing the test case. It contains info -%% about the execution time and the return value of the test case function. - -run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData) -> - file:set_cwd(filename:dirname(get(test_server_dir))), - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, - TimetrapData, [], self()). - -run_test_case(Ref, Num, Mod, Func, Args, skip_init, TimetrapData, Mode) -> - %% a conf case is always executed by the main process - run_test_case1(Ref, Num, Mod, Func, Args, skip_init, - TimetrapData, Mode, self()); - -run_test_case(Ref, Num, Mod, Func, Args, RunInit, TimetrapData, Mode) -> - file:set_cwd(filename:dirname(get(test_server_dir))), - Main = self(), - case check_prop(parallel, Mode) of - false -> - %% this is a sequential test case - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, - TimetrapData, Mode, Main); - _Ref -> - %% this a parallel test case, spawn the new process - Dictionary = get(), - {dictionary,Dictionary} = process_info(self(), dictionary), - spawn_link( - fun() -> - process_flag(trap_exit, true), - [put(Key, Val) || {Key,Val} <- Dictionary], - set_io_buffering({tc,Main}), - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, - TimetrapData, Mode, Main) - end) - end. - -run_test_case1(Ref, Num, Mod, Func, Args, RunInit, - TimetrapData, Mode, Main) -> - group_leader(test_server_io:get_gl(Main == self()), self()), - - %% if io is being buffered, send start io session message - %% (no matter if case runs on parallel or main process) - case is_io_buffered() of - false -> ok; - true -> - test_server_io:start_transaction(), - Main ! {started,Ref,self(),Num,Mod,Func} - end, - TSDir = get(test_server_dir), - - print(major, "=case ~w:~w", [Mod, Func]), - MinorName = start_minor_log_file(Mod, Func, self() /= Main), - MinorBase = filename:basename(MinorName), - print(major, "=logfile ~ts", [filename:basename(MinorName)]), - - UpdatedArgs = - %% maybe create unique private directory for test case or config func - case get(test_server_create_priv_dir) of - auto_per_run -> - update_config(hd(Args), [{tc_logfile,MinorName}]); - PrivDirMode -> - %% create unique private directory for test case - RunDir = filename:dirname(MinorName), - Ext = - if Num == 0 -> - Int = erlang:unique_integer([positive,monotonic]), - lists:flatten(io_lib:format(".cfg.~w", [Int])); - true -> - lists:flatten(io_lib:format(".~w", [Num])) - end, - PrivDir = filename:join(RunDir, ?priv_dir) ++ Ext, - if PrivDirMode == auto_per_tc -> - ok = file:make_dir(PrivDir); - PrivDirMode == manual_per_tc -> - ok - end, - 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,GrName}}, - MinorName}]), - - {ok,Cwd} = file:get_cwd(), - Args2Print = if is_list(UpdatedArgs) -> - lists:keydelete(tc_group_result, 1, UpdatedArgs); - true -> - UpdatedArgs - end, - if RunInit == skip_init -> - print_props(get_props(Mode)); - true -> - ok - end, - print(minor, "Config value:\n\n ~tp\n", [Args2Print]), - print(minor, "Current directory is ~tp\n", [Cwd]), - - GrNameStr = case GrName of - undefined -> ""; - Name -> cast_to_list(Name) - end, - print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), - {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), - TR = xhtml("", [""]), - EncMinorBase = uri_encode(MinorBase), - print(html, TR ++ "" - "" - "" - "" - "", - [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], GrName, - RunInit, TimetrapData), - {Time,RetVal,Loc,Opts,Comment} = - case Result of - Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; - {died,DReason,DLoc,DCmt} -> {died,DReason,DLoc,[],DCmt} - end, - - print(minor, "", [], internal_raw), - print(minor, "\n", [], internal_raw), - print_timestamp(minor, "Ended at "), - print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), - - do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end), - - %% call the appropriate progress function clause to print the results to log - Status = - case {Time,RetVal} of - {died,{timetrap_timeout,TimetrapTimeout}} -> - progress(failed, Num, Mod, Func, GrName, Loc, - timetrap_timeout, TimetrapTimeout, Comment, Style); - {died,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, GrName, Loc, Reason, - Time, Comment, Style); - {_,{'EXIT',_Pid,{Skip,Reason}}} when Skip==skip; Skip==skipped -> - progress(skip, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {_,{'EXIT',_Pid,Reason}} -> - progress(failed, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {_,{'EXIT',Reason}} -> - progress(failed, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {_,{Fail,Reason}} when Fail =:= fail; Fail =:= failed -> - progress(failed, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {_,Reason={auto_skip,_Why}} -> - progress(skip, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {_,{Skip,Reason}} when Skip==skip; Skip==skipped -> - progress(skip, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style); - {Time,RetVal} -> - case DetectedFail of - [] -> - progress(ok, Num, Mod, Func, GrName, Loc, RetVal, - Time, Comment, Style); - - Reason -> - progress(failed, Num, Mod, Func, GrName, Loc, Reason, - Time, Comment, Style) - end - end, - %% if the test case was executed sequentially, this updates the - %% status count on the main process (status of parallel test cases - %% is updated later by the handle_test_case_io_and_status/0 function) - case {RunInit,Status} of - {skip_init,_} -> % conf doesn't count - ok; - {_,ok} -> - put(test_server_ok, get(test_server_ok)+1); - {_,failed} -> - put(test_server_failed, get(test_server_failed)+1); - {_,skip} -> - {US,AS} = get(test_server_skipped), - put(test_server_skipped, {US+1,AS}); - {_,auto_skip} -> - {US,AS} = get(test_server_skipped), - put(test_server_skipped, {US,AS+1}) - end, - %% only if test case execution is sequential do we care about the - %% remaining processes and slave nodes count - case self() of - Main -> - case test_server_sup:framework_call(warn, [processes], true) of - true -> - if ProcsBefore < ProcsAfter -> - print(minor, - "WARNING: ~w more processes in system after test case", - [ProcsAfter-ProcsBefore]); - ProcsBefore > ProcsAfter -> - print(minor, - "WARNING: ~w less processes in system after test case", - [ProcsBefore-ProcsAfter]); - true -> ok - end; - false -> - ok - end, - case test_server_sup:framework_call(warn, [nodes], true) of - true -> - case catch controller_call(kill_slavenodes) of - {'EXIT',_} = Exit -> - print(minor, - "WARNING: There might be slavenodes left in the" - " system. I tried to kill them, but I failed: ~p\n", - [Exit]); - [] -> ok; - List -> - print(minor, "WARNING: ~w slave nodes in system after test"++ - "case. Tried to killed them.~n"++ - " Names:~p", - [length(List),List]) - end; - false -> - ok - end; - _ -> - ok - end, - %% if the test case was executed sequentially, this updates the execution - %% time count on the main process (adding execution time of parallel test - %% case groups is done in run_test_cases_loop/4) - if is_number(Time) -> - put(test_server_total_time, get(test_server_total_time)+Time); - true -> - ok - end, - test_server_sup:check_new_crash_dumps(), - - %% if io is being buffered, send finished message - %% (no matter if case runs on parallel or main process) - case is_io_buffered() of - false -> - ok; - true -> - test_server_io:end_transaction(), - Main ! {finished,Ref,self(),Num,Mod,Func, - ?mod_result(Status),{Time,RetVal,Opts}} - end, - {Time,RetVal,Opts}. - - -%%-------------------------------------------------------------------- -%% various help functions - -%% Call Action if we are running on the main process (not parallel). -do_unless_parallel(Main, Action) when is_function(Action, 0) -> - case self() of - Main -> Action(); - _ -> ok - end. - -num2str(0) -> ""; -num2str(N) -> integer_to_list(N). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% progress(Result, CaseNum, Mod, Func, Location, Reason, Time, -%% Comment, TimeFormat) -> Result -%% -%% Prints the result of the test case to log file. -%% 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, GrName, Loc, Reason, Time, - Comment, {St0,St1}) -> - {Reason1,{Color,Ret,ReportTag}} = - if_auto_skip(Reason, - fun() -> {?auto_skip_color,auto_skip,auto_skipped} end, - fun() -> {?user_skip_color,skip,skipped} end), - 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,GrName}, - {ReportTag,Reason1}}]), - ReasonStr = reason_to_string(Reason1), - ReasonStr1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(ReasonStr,[$\n])]), - ReasonStr2 = - if length(ReasonStr1) > 80 -> - string:substr(ReasonStr1, 1, 77) ++ "..."; - true -> - ReasonStr1 - end, - Comment1 = case Comment of - "" -> ""; - _ -> xhtml("
(","
(") ++ to_string(Comment) ++ ")" - end, - print(html, - "" - "" - "\n", - [Time,Color,ReasonStr2,Comment1]), - FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== Location: ~ts", [FormatLoc]), - print(minor, "=== Reason: ~ts", [ReasonStr1]), - Ret; - -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,GrName}, - {failed,timetrap_timeout}}]), - FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), - ErrorReason = io_lib:format("{timetrap_timeout,~ts}", [FormatLastLoc]), - Comment = - case Comment0 of - "" -> "" ++ ErrorReason ++ ""; - _ -> "" ++ ErrorReason ++ - xhtml("
","
") ++ to_string(Comment0) - end, - print(html, - "" - "" - "\n", - [T/1000,Comment]), - FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== Location: ~ts", [FormatLoc]), - print(minor, "=== Reason: timetrap timeout", []), - failed; - -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,GrName}, - {failed,testcase_aborted}}]), - FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), - ErrorReason = io_lib:format("{testcase_aborted,~ts}", [FormatLastLoc]), - Comment = - case Comment0 of - "" -> "" ++ ErrorReason ++ ""; - _ -> "" ++ ErrorReason ++ - xhtml("
","
") ++ to_string(Comment0) - end, - print(html, - "" - "" - "\n", - [Comment]), - FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== Location: ~ts", [FormatLoc]), - print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]), - failed; - -progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, - Comment0, {St0,St1}) -> - print(major, "=result failed: ~p, ~w", [Reason,unknown_location]), - print(1, "*** FAILED ~ts ***", - [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), - test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, - {failed,Reason}}]), - TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; - true -> "~w" - end, [Time]), - ErrorReason = lists:flatten(io_lib:format("~p", [Reason])), - ErrorReason1 = lists:flatten([string:strip(S,left) || - S <- string:tokens(ErrorReason,[$\n])]), - ErrorReason2 = - if length(ErrorReason1) > 63 -> - string:substr(ErrorReason1, 1, 60) ++ "..."; - true -> - ErrorReason1 - end, - Comment = - case Comment0 of - "" -> "" ++ ErrorReason2 ++ ""; - _ -> "" ++ ErrorReason2 ++ - xhtml("
","
") ++ - to_string(Comment0) - end, - print(html, - "" - "" - "\n", - [TimeStr,Comment]), - print(minor, "=== Location: ~w", [unknown]), - {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== Reason: " ++ FStr, [FormattedReason]), - failed; - -progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, - Comment0, {St0,St1}) -> - {LocMaj,LocMin} = if Func == error_in_suite -> - case get_fw_mod(undefined) of - Mod -> {unknown_location,unknown}; - _ -> {Loc,Loc} - end; - true -> {Loc,Loc} - end, - print(major, "=result failed: ~p, ~p", [Reason,LocMaj]), - print(1, "*** FAILED ~ts ***", - [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), - test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, - {failed,Reason}}]), - TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; - true -> "~w" - end, [Time]), - Comment = - case Comment0 of - "" -> ""; - _ -> xhtml("
","
") ++ to_string(Comment0) - end, - FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)), - print(html, - "" - "" - "\n", - [TimeStr,FormatLastLoc,Comment]), - FormatLoc = test_server_sup:format_loc(LocMin), - print(minor, "=== Location: ~ts", [FormatLoc]), - {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== Reason: " ++ FStr, [FormattedReason]), - failed; - -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,GrName},ok}]), - Comment = - case RetVal of - {comment,RetComment} -> - String = to_string(RetComment), - HtmlCmt = test_server_sup:framework_call(format_comment, - [String], - String), - print(major, "=result ok: ~ts", [String]), - ""; - _ -> - print(major, "=result ok", []), - case Comment0 of - "" -> ""; - _ -> "" - end - end, - print(major, "=elapsed ~p", [Time]), - print(html, - "" - "" - "~ts\n", - [Time,Comment]), - print(minor, "=== Returned value: ~p", [RetVal]), - ok. - -%%-------------------------------------------------------------------- -%% various help functions - -get_fw_mod(Mod) -> - case get(test_server_framework) of - undefined -> - case os:getenv("TEST_SERVER_FRAMEWORK") of - FW when FW =:= false; FW =:= "undefined" -> - Mod; - FW -> - list_to_atom(FW) - end; - '$none' -> Mod; - FW -> FW - end. - -fw_name(?MODULE) -> - test_server; -fw_name(Mod) -> - case get(test_server_framework_name) of - undefined -> - case get_fw_mod(undefined) of - undefined -> - Mod; - Mod -> - case os:getenv("TEST_SERVER_FRAMEWORK_NAME") of - FWName when FWName =:= false; FWName =:= "undefined" -> - Mod; - FWName -> - list_to_atom(FWName) - end; - _ -> - Mod - end; - '$none' -> - Mod; - FWName -> - case get_fw_mod(Mod) of - Mod -> FWName; - _ -> Mod - end - end. - -if_auto_skip(Reason={failed,{_,init_per_testcase,_}}, True, _False) -> - {Reason,True()}; -if_auto_skip({skip,Reason={failed,{_,init_per_testcase,_}}}, True, _False) -> - {Reason,True()}; -if_auto_skip({auto_skip,Reason}, True, _False) -> - {Reason,True()}; -if_auto_skip(Reason, _True, False) -> - {Reason,False()}. - -update_skip_counters({_T,Pat,_Opts}, {US,AS}) -> - {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end), - Result; -update_skip_counters(Pat, {US,AS}) -> - {_,Result} = if_auto_skip(Pat, fun() -> {US,AS+1} end, fun() -> {US+1,AS} end), - Result. - -get_info_str(Mod,Func, 0, _Cases) -> - io_lib:format("~w", [{Mod,Func}]); -get_info_str(_Mod,_Func, CaseNum, unknown) -> - "test case " ++ integer_to_list(CaseNum); -get_info_str(_Mod,_Func, CaseNum, Cases) -> - "test case " ++ integer_to_list(CaseNum) ++ - " of " ++ integer_to_list(Cases). - -print_if_known(Known, {SK,AK}, {SU,AU}) -> - {S,A} = if Known == unknown -> {SU,AU}; - true -> {SK,AK} - end, - io_lib:format(S, A). - -to_string(Term) when is_list(Term) -> - case (catch io_lib:format("~ts", [Term])) of - {'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term])); - String -> lists:flatten(String) - end; -to_string(Term) -> - lists:flatten(io_lib:format("~p", [Term])). - -get_last_loc(Loc) when is_tuple(Loc) -> - Loc; -get_last_loc([Loc|_]) when is_tuple(Loc) -> - [Loc]; -get_last_loc(Loc) -> - Loc. - -reason_to_string({failed,{_,FailFunc,bad_return}}) -> - atom_to_list(FailFunc) ++ " bad return value"; -reason_to_string({failed,{_,FailFunc,{timetrap_timeout,_}}}) -> - atom_to_list(FailFunc) ++ " timed out"; -reason_to_string(FWInitFail = {failed,{_CB,init_tc,_Reason}}) -> - to_string(FWInitFail); -reason_to_string({failed,{_,FailFunc,_}}) -> - atom_to_list(FailFunc) ++ " failed"; -reason_to_string(Other) -> - to_string(Other). - -%get_font_style(Prop) -> -% {Col,St0,St1} = get_font_style1(Prop), -% {{"",""}, -% {""++St0,St1++""}}. - -get_font_style(NormalCase, Mode) -> - Prop = if not NormalCase -> - default; - true -> - case check_prop(parallel, Mode) of - false -> - case check_prop(sequence, Mode) of - false -> - default; - _ -> - sequence - end; - _ -> - parallel - end - end, - {Col,St0,St1} = get_font_style1(Prop), - {{"",""}, - {""++St0,St1++""}}. - -get_font_style1(parallel) -> - {"\"darkslategray\"","",""}; -get_font_style1(sequence) -> -% {"\"darkolivegreen\"","",""}; - {"\"saddlebrown\"","",""}; -get_font_style1(default) -> - {"\"black\"","",""}. -%%get_font_style1(skipped) -> -%% {"\"lightgray\"","",""}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% format_exception({Error,Stack}) -> {CtrlSeq,Term} -%% -%% The default behaviour is that error information gets formatted -%% (like in the erlang shell) before printed to the minor log file. -%% The framework application can switch this feature off by setting -%% *its* application environment variable 'format_exception' to false. -%% It is also possible to switch formatting off by starting the -%% test_server node with init argument 'test_server_format_exception' -%% set to false. - -format_exception(Reason={_Error,Stack}) when is_list(Stack) -> - case get_fw_mod(undefined) of - undefined -> - case application:get_env(test_server, format_exception) of - {ok,false} -> - {"~p",Reason}; - _ -> - do_format_exception(Reason) - end; - FW -> - case application:get_env(FW, format_exception) of - {ok,false} -> - {"~p",Reason}; - _ -> - do_format_exception(Reason) - end - end; -format_exception(Error) -> - format_exception({Error,[]}). - -do_format_exception(Reason={Error,Stack}) -> - StackFun = fun(_, _, _) -> false end, - PF = fun(Term, I) -> - io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term]) - end, - case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of - {'EXIT',_} -> - {"~p",Reason}; - Formatted -> - Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]), - {"~ts",lists:flatten(Formatted1)} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, -%% TimetrapData) -> -%% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | -%% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} -%% Name = atom() -%% Time = float() (seconds) -%% RetVal = term() -%% Loc = term() -%% Comment = string() -%% Reason = term() -%% DetectedFail = [{File,Line}] -%% ProcessesBefore = ProcessesAfter = integer() -%% - -run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, - TimetrapData) -> - test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print(Detail, Format, Args) -> ok -%% Detail = integer() -%% Format = string() -%% Args = [term()] -%% -%% Just like io:format, except that depending on the Detail value, the output -%% is directed to console, major and/or minor log files. - -print(Detail, Format) -> - print(Detail, Format, []). - -print(Detail, Format, Args) -> - print(Detail, Format, Args, internal). - -print(Detail, Format, Args, Printer) -> - Msg = io_lib:format(Format, Args), - print_or_buffer(Detail, Msg, Printer). - -print_or_buffer(Detail, Msg, Printer) -> - test_server_gl:print(group_leader(), Detail, Msg, Printer). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print_timestamp(Detail, Leader) -> ok -%% -%% Prints Leader followed by a time stamp (date and time). Depending on -%% the Detail value, the output is directed to console, major and/or minor -%% log files. - -print_timestamp(Detail, Leader) -> - print(Detail, timestamp_get(Leader), []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% print_who(Host, User) -> ok -%% -%% Logs who runs the suite. - -print_who(Host, User) -> - UserStr = case User of - "" -> ""; - _ -> " by " ++ User - end, - print(html, "Run~ts on ~ts", [UserStr,Host]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% format(Format) -> IoLibReturn -%% format(Detail, Format) -> IoLibReturn -%% format(Format, Args) -> IoLibReturn -%% format(Detail, Format, Args) -> IoLibReturn -%% -%% Detail = integer() -%% Format = string() -%% Args = [term(),...] -%% IoLibReturn = term() -%% -%% Logs the Format string and Args, similar to io:format/1/2 etc. If -%% Detail is not specified, the default detail level (which is 50) is used. -%% Which log files the string will be logged in depends on the thresholds -%% set with set_levels/3. Typically with default detail level, only the -%% minor log file is used. - -format(Format) -> - format(minor, Format, []). - -format(major, Format) -> - format(major, Format, []); -format(minor, Format) -> - format(minor, Format, []); -format(Detail, Format) when is_integer(Detail) -> - format(Detail, Format, []); -format(Format, Args) -> - format(minor, Format, Args). - -format(Detail, Format, Args) -> - Str = - case catch io_lib:format(Format, Args) of - {'EXIT',_} -> - io_lib:format("illegal format; ~p with args ~p.\n", - [Format,Args]); - Valid -> Valid - end, - print_or_buffer(Detail, Str, self()). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml -%% -xhtml(HTML, XHTML) -> - case get(basic_html) of - true -> HTML; - _ -> XHTML - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% odd_or_even() -> "odd" | "even" -%% -odd_or_even() -> - case get(odd_or_even) of - even -> - put(odd_or_even, odd), - "even"; - _ -> - put(odd_or_even, even), - "odd" - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timestamp_filename_get(Leader) -> string() -%% Leader = string() -%% -%% Returns a string consisting of Leader concatenated with the current -%% date and time. The resulting string is suitable as a filename. -timestamp_filename_get(Leader) -> - timestamp_get_internal(Leader, - "~ts~w-~2.2.0w-~2.2.0w_~2.2.0w.~2.2.0w.~2.2.0w"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timestamp_get(Leader) -> string() -%% Leader = string() -%% -%% Returns a string consisting of Leader concatenated with the current -%% date and time. The resulting string is suitable for display. -timestamp_get(Leader) -> - timestamp_get_internal(Leader, - "~ts~w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w"). - -timestamp_get_internal(Leader, Format) -> - {YY,MM,DD,H,M,S} = time_get(), - io_lib:format(Format, [Leader,YY,MM,DD,H,M,S]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% time_get() -> {YY,MM,DD,H,M,S} -%% YY = integer() -%% MM = integer() -%% DD = integer() -%% H = integer() -%% M = integer() -%% S = integer() -%% -%% Returns the current Year,Month,Day,Hours,Minutes,Seconds. -%% The function checks that the date doesn't wrap while calling -%% getting the time. -time_get() -> - {YY,MM,DD} = date(), - {H,M,S} = time(), - case date() of - {YY,MM,DD} -> - {YY,MM,DD,H,M,S}; - _NewDay -> - %% date changed between call to date() and time(), try again - time_get() - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% make_config(Config) -> NewConfig -%% Config = [{Key,Value},...] -%% NewConfig = [{Key,Value},...] -%% -%% Creates a configuration list (currently returns it's input) - -make_config(Initial) -> - Initial. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% update_config(Config, Update) -> NewConfig -%% Config = [{Key,Value},...] -%% Update = [{Key,Value},...] | {Key,Value} -%% NewConfig = [{Key,Value},...] -%% -%% Adds or replaces the key-value pairs in config with those in update. -%% Returns the updated list. - -update_config(Config, {Key,Val}) -> - case lists:keymember(Key, 1, Config) of - true -> - lists:keyreplace(Key, 1, Config, {Key,Val}); - false -> - [{Key,Val}|Config] - end; -update_config(Config, [Assoc|Assocs]) -> - NewConfig = update_config(Config, Assoc), - update_config(NewConfig, Assocs); -update_config(Config, []) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% collect_cases(CurMod, TopCase, SkipList) -> -%% BasicCaseList | {error,Reason} -%% -%% CurMod = atom() -%% TopCase = term() -%% SkipList = [term(),...] -%% BasicCaseList = [term(),...] -%% -%% Parses the given test goal(s) in TopCase, and transforms them to a -%% simple list of test cases to call, when executing the test suite. -%% -%% CurMod is the "current" module, that is, the module the last instruction -%% was read from. May be be set to 'none' initially. -%% -%% SkipList is the list of test cases to skip and requirements to deny. -%% -%% The BasicCaseList is built out of TopCase, which may be any of the -%% following terms: -%% -%% [] Nothing is added -%% List list() The list is decomposed, and each element is -%% treated according to this table -%% Case atom() CurMod:Case(suite) is called -%% {module,Case} CurMod:Case(suite) is called -%% {Module,Case} Module:Case(suite) is called -%% {module,Module,Case} Module:Case(suite) is called -%% {module,Module,Case,Args} Module:Case is called with Args as arguments -%% {dir,Dir} All modules *_SUITE in the named directory -%% are listed, and each Module:all(suite) is called -%% {dir,Dir,Pattern} All modules _SUITE in the named dir -%% are listed, and each Module:all(suite) is called -%% {conf,InitMF,Cases,FinMF} -%% {conf,Props,InitMF,Cases,FinMF} -%% InitMF is placed in the BasicCaseList, then -%% Cases is treated according to this table, then -%% FinMF is placed in the BasicCaseList. InitMF -%% and FinMF are configuration manipulation -%% functions. See below. -%% {make,InitMFA,Cases,FinMFA} -%% InitMFA is placed in the BasicCaseList, then -%% Cases is treated according to this table, then -%% FinMFA is placed in the BasicCaseList. InitMFA -%% and FinMFA are make/unmake functions. If InitMFA -%% fails, Cases are not run. -%% -%% When a function is called, above, it means that the function is invoked -%% and the return is expected to be: -%% -%% [] Leaf case -%% {req,ReqList} Kept for backwards compatibility - same as [] -%% {req,ReqList,Cases} Kept for backwards compatibility - -%% Cases parsed recursively with collect_cases/3 -%% Cases (list) Recursively parsed with collect_cases/3 -%% -%% Leaf cases are added to the BasicCaseList as Module:Case(Config). Each -%% case is checked against the SkipList. If present, a skip instruction -%% is inserted instead, which only prints the case name and the reason -%% why the case was skipped in the log files. -%% -%% Configuration manipulation functions are called with the current -%% configuration list as only argument, and are expected to return a new -%% configuration list. Such a pair of function may, for example, start a -%% server and stop it after a serie of test cases. -%% -%% SkipCases is expected to be in the format: -%% -%% Other Recursively parsed with collect_cases/3 -%% {Mod,Comment} Skip Mod, with Comment -%% {Mod,Funcs,Comment} Skip listed functions in Mod with Comment -%% {Mod,Func,Comment} Skip named function in Mod with Comment -%% --record(cc, {mod, % current module - skip}). % skip list - -collect_all_cases(Top, Skip) when is_list(Skip) -> - Result = - 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, Mode) -> - case collect_cases(Case, St0, Mode) of - {ok,FlatCases1,St1} -> - case collect_cases(Cs0, St1, Mode) of - {ok,FlatCases2,St} -> - {ok,FlatCases1 ++ FlatCases2,St}; - {error,_Reason} = Error -> Error - end; - {error,_Reason} = Error -> Error - end; - - -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, Mode) - end; -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, Mode) - end; -collect_cases({conf,Props,InitMF,CaseList,FinMF} = Conf, St, Mode) -> - case init_props(Props) of - {error,_} -> - {ok,[],St}; - Props1 -> - Ref = make_ref(), - Skips = St#cc.skip, - Props2 = [{suite,St#cc.mod} | lists:delete(suite,Props1)], - 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},Mode1} | - [] ++ [{conf,Ref,[],FinMF}]],St}; - {true,Name,Comment} when is_atom(Name) -> % all cases skipped - case collect_cases(CaseList, St, Mode1) of - {ok,[],_St} = Empty -> - Empty; - {ok,FlatCases,St1} -> - Cases2Skip = FlatCases ++ [{conf,Ref, - keep_name(Props1), - FinMF}], - Skipped = skip_cases_upto(Ref, Cases2Skip, Comment, - 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}, Mode1) of - {ok,[],_St} = Empty -> - Empty; - {ok,FlatCases,St1} -> - {ok,[{conf,Ref,Props1,InitMF} | - FlatCases ++ [{conf,Ref, - keep_name(Props1), - FinMF}]],St1#cc{skip=Skips}}; - {error,_Reason} = Error -> - Error - end; - false -> - case collect_cases(CaseList, St, Mode1) of - {ok,[],_St} = Empty -> - Empty; - {ok,FlatCases,St1} -> - {ok,[{conf,Ref,Props1,InitMF} | - FlatCases ++ [{conf,Ref, - keep_name(Props1), - FinMF}]],St1}; - {error,_Reason} = Error -> - Error - end - end - end; - -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(), - {ok,[{make,Ref,InitMFA}|FlatCases ++ - [{make,Ref,FinMFA}]],St}; - {error,_Reason} = Error -> Error - end; - -collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> - case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of - Result = {ok,_,_} -> - Result; - Other -> - {error,Other} - end; - -collect_cases({_Mod,_Case}=Spec, St, Mode) -> - collect_case(Spec, St, Mode); - -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, Mode) -> - collect_case_invoke(Mod, Conf, [], St, Mode); - -collect_case(MFA, St, Mode) -> - case in_skip_list(MFA, St#cc.skip) of - {true,Comment} when Comment /= make_failed -> - {ok,[{skip_case,{MFA,Comment},Mode}],St}; - _ -> - case MFA of - {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode); - {_Mod,_Case,_Args} -> {ok,[MFA],St} - end - end. - -collect_case([], St, Acc, _Mode) -> - {ok, Acc, St}; - -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, 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, Mode) - end; - _ -> - Suite = test_server_sup:framework_call(get_suite, - [Mod,Case], - []), - collect_subcases(Mod, Case, MFA, St, Suite, Mode) - end. - -collect_subcases(Mod, Case, MFA, St, Suite, Mode) -> - case Suite of - [] when Case == all -> {ok,[],St}; - [] when element(1, Case) == conf -> {ok,[],St}; - [] -> {ok,[MFA],St}; -%%%! --- START Kept for backwards compatibility --- -%%%! Requirements are not used - {req,ReqList} -> - collect_case_deny(Mod, Case, MFA, ReqList, [], St, Mode); - {req,ReqList,SubCases} -> - 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},Mode}],St}; - {error,Reason} -> - throw(Reason); - SubCases -> - collect_case_subcases(Mod, Case, SubCases, St, Mode) - end. - -collect_case_subcases(Mod, Case, SubCases, St0, Mode) -> - OldMod = St0#cc.mod, - 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, Mode) -> - {ok,Cwd} = file:get_cwd(), - Dir1 = filename:join(Cwd, Dir), - Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]), - case catch filelib:wildcard(Wc) of - {'EXIT', Reason} -> - io:format("Could not collect files: ~p~n", [Reason]), - {error,{collect_fail,Dir,Pattern}}; - Files -> - %% convert to module names and remove duplicates - Mods = lists:foldl(fun(File, Acc) -> - Mod = fullname_to_mod(File), - case lists:member(Mod, Acc) of - true -> Acc; - false -> [Mod | Acc] - end - end, [], Files), - Tests = [{Mod,all} || Mod <- lists:sort(Mods)], - collect_cases(Tests, St, Mode) - end. - -fullname_to_mod(Path) when is_list(Path) -> - %% If this is called with a binary, then we are probably in +fnu - %% mode and have found a beam file with name encoded as latin1. We - %% will let this crash since it can not work to load such a module - %% anyway. It should be removed or renamed! - list_to_atom(filename:rootname(filename:basename(Path))). - -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},Mode}],St}; - {granted,[]} -> - {ok,[MFA],St}; - {granted,SubCases} -> - collect_case_subcases(Mod, Case, SubCases, St, Mode) - end. - -check_deny([Req|Reqs], DenyList) -> - case check_deny_req(Req, DenyList) of - {denied,_Comment}=Denied -> Denied; - granted -> check_deny(Reqs, DenyList) - end; -check_deny([], _DenyList) -> granted; -check_deny(Req, DenyList) -> check_deny([Req], DenyList). - -check_deny_req({Req,Val}, DenyList) -> - %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]), - case lists:keysearch(Req, 1, DenyList) of - {value,{_Req,DenyVal}} when Val >= DenyVal -> - {denied,io_lib:format("Requirement ~p=~p", [Req,Val])}; - _ -> - check_deny_req(Req, DenyList) - end; -check_deny_req(Req, DenyList) -> - case lists:member(Req, DenyList) of - true -> {denied,io_lib:format("Requirement ~p", [Req])}; - false -> granted - end. - -in_skip_list({Mod,{conf,Props,InitMF,_CaseList,_FinMF}}, SkipList) -> - case in_skip_list(InitMF, SkipList) of - {true,_} = Yes -> - Yes; - _ -> - case proplists:get_value(name, Props) of - undefined -> - false; - Name -> - ToSkip = - lists:flatmap( - fun({M,{conf,SProps,_,SCaseList,_},Cmt}) when - M == Mod -> - case proplists:get_value(name, SProps) of - all -> - [{M,all,Cmt}]; - Name -> - case SCaseList of - all -> - [{M,all,Cmt}]; - _ -> - [{M,F,Cmt} || F <- SCaseList] - end; - _ -> - [] - end; - (_) -> - [] - end, SkipList), - case ToSkip of - [] -> - false; - _ -> - case lists:keysearch(all, 2, ToSkip) of - {value,{_,_,Cmt}} -> {true,Name,Cmt}; - _ -> {true,ToSkip,""} - end - end - end - end; - -in_skip_list({Mod,Func,_Args}, SkipList) -> - in_skip_list({Mod,Func}, SkipList); -in_skip_list({Mod,Func}, [{Mod,Funcs,Comment}|SkipList]) when is_list(Funcs) -> - case lists:member(Func, Funcs) of - true -> - {true,Comment}; - _ -> - in_skip_list({Mod,Func}, SkipList) - end; -in_skip_list({Mod,Func}, [{Mod,Func,Comment}|_SkipList]) -> - {true,Comment}; -in_skip_list({Mod,_Func}, [{Mod,Comment}|_SkipList]) -> - {true,Comment}; -in_skip_list({Mod,Func}, [_|SkipList]) -> - in_skip_list({Mod,Func}, SkipList); -in_skip_list(_, []) -> - false. - -%% remove unnecessary properties -init_props(Props) -> - case get_repeat(Props) of - Repeat = {_RepType,N} when N < 2 -> - if N == 0 -> - {error,{invalid_property,Repeat}}; - true -> - lists:delete(Repeat, Props) - end; - _ -> - Props - end. - -keep_name(Props) -> - lists:filter(fun({name,_}) -> true; - ({suite,_}) -> true; - (_) -> false end, Props). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Node handling functions %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% get_target_info() -> #target_info -%% -%% Returns a record containing system information for target - -get_target_info() -> - controller_call(get_target_info). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% start_node(SlaveName, Type, Options) -> -%% {ok, Slave} | {error, Reason} -%% -%% Called by test_server. See test_server:start_node/3 for details - -start_node(Name, Type, Options) -> - T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(), - format(minor, "Attempt to start ~w node ~p with options ~p", - [Type, Name, Options]), - case controller_call({start_node,Name,Type,Options}, T) of - {{ok,Nodename}, Host, Cmd, Info, Warning} -> - format(minor, - "Successfully started node ~w on ~tp with command: ~ts", - [Nodename, Host, Cmd]), - format(major, "=node_start ~w", [Nodename]), - case Info of - [] -> ok; - _ -> format(minor, Info) - end, - case Warning of - [] -> ok; - _ -> - format(1, Warning), - format(minor, Warning) - end, - {ok, Nodename}; - {fail,{Ret, Host, Cmd}} -> - format(minor, - "Failed to start node ~tp on ~tp with command: ~ts~n" - "Reason: ~p", - [Name, Host, Cmd, Ret]), - {fail,Ret}; - {Ret, undefined, undefined} -> - format(minor, "Failed to start node ~tp: ~p", [Name,Ret]), - Ret; - {Ret, Host, Cmd} -> - format(minor, - "Failed to start node ~tp on ~tp with command: ~ts~n" - "Reason: ~p", - [Name, Host, Cmd, Ret]), - Ret - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% wait_for_node(Node) -> ok | {error,timeout} -%% -%% Wait for a slave/peer node which has been started with -%% the option {wait,false}. This function returns when -%% when the new node has contacted test_server_ctrl again - -wait_for_node(Slave) -> - T = 10000 * test_server:timetrap_scale_factor(), - case catch controller_call({wait_for_node,Slave},T) of - {'EXIT',{timeout,_}} -> {error,timeout}; - ok -> ok - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_release_available(Release) -> true | false -%% Release -> string() -%% -%% Test if a release (such as "r10b") is available to be -%% started using start_node/3. - -is_release_available(Release) -> - controller_call({is_release_available,Release}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% stop_node(Name) -> ok | {error,Reason} -%% -%% Clean up - test_server will stop this node - -stop_node(Slave) -> - controller_call({stop_node,Slave}). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% DEBUGGER INTERFACE %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -i() -> - hformat("Pid", "Initial Call", "Current Function", "Reducts", "Msgs"), - Line=lists:duplicate(27, "-"), - hformat(Line, Line, Line, Line, Line), - display_info(processes(), 0, 0). - -p(A,B,C) -> - pinfo(ts_pid(A,B,C)). -p(X) when is_atom(X) -> - pinfo(whereis(X)); -p({A,B,C}) -> - pinfo(ts_pid(A,B,C)); -p(X) -> - pinfo(X). - -t() -> - t(wall_clock). -t(X) -> - element(1, statistics(X)). - -pi(Item,X) -> - lists:keysearch(Item,1,p(X)). -pi(Item,A,B,C) -> - lists:keysearch(Item,1,p(A,B,C)). - -%% c:pid/3 -ts_pid(X,Y,Z) when is_integer(X), is_integer(Y), is_integer(Z) -> - list_to_pid("<" ++ integer_to_list(X) ++ "." ++ - integer_to_list(Y) ++ "." ++ - integer_to_list(Z) ++ ">"). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% display_info(Pids, Reductions, Messages) -> void -%% Pids = [pid(),...] -%% Reductions = integer() -%% Messaged = integer() -%% -%% Displays info, similar to c:i() about the processes in the list Pids. -%% Also counts the total number of reductions and msgs for the listed -%% processes, if called with Reductions = Messages = 0. - -display_info([Pid|T], R, M) -> - case pinfo(Pid) of - undefined -> - display_info(T, R, M); - Info -> - Call = fetch(initial_call, Info), - Curr = case fetch(current_function, Info) of - {Mod,F,Args} when is_list(Args) -> - {Mod,F,length(Args)}; - Other -> - Other - end, - Reds = fetch(reductions, Info), - LM = length(fetch(messages, Info)), - pformat(io_lib:format("~w", [Pid]), - io_lib:format("~w", [Call]), - io_lib:format("~w", [Curr]), Reds, LM), - display_info(T, R+Reds, M + LM) - end; -display_info([], R, M) -> - Line=lists:duplicate(27, "-"), - hformat(Line, Line, Line, Line, Line), - pformat("Total", "", "", R, M). - -hformat(A1, A2, A3, A4, A5) -> - io:format("~-10s ~-27s ~-27s ~8s ~4s~n", [A1,A2,A3,A4,A5]). - -pformat(A1, A2, A3, A4, A5) -> - io:format("~-10s ~-27s ~-27s ~8w ~4w~n", [A1,A2,A3,A4,A5]). - -fetch(Key, Info) -> - case lists:keysearch(Key, 1, Info) of - {value, {_, Val}} -> - Val; - _ -> - 0 - end. - -pinfo(P) -> - Node = node(), - case node(P) of - Node -> - process_info(P); - _ -> - rpc:call(node(P),erlang,process_info,[P]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Support functions for COVER %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% A module is included in the cover analysis if -%% - it belongs to the tested application and is not listed in the -%% {exclude,List} part of the App.cover file -%% - it does not belong to the application, but is listed in the -%% {include,List} part of the App.cover file -%% - it does not belong to the application, but is listed in the -%% {cross,[{Tag,List}]} part of the App.cover file -%% -%% The modules listed in the 'cross' part of the cover file are -%% modules that are heavily used by other tests than the one where -%% they are explicitly tested. They should then be listed as 'cross' -%% in the cover file for the test where they are used but do not -%% belong. -%% -%% After all tests are completed, the these modules can be analysed -%% with coverage data from all tests where they are compiled - see -%% cross_cover_analyse/2. The result is stored in a file called -%% cross_cover.html in the run. directory of the -%% test the modules belong to. -%% -%% Example: -%% If the module m1 belongs to system s1 but is heavily used also in -%% the tests for another system s2, then the cover files for the two -%% systems could be like this: -%% -%% s1.cover: -%% {include,[m1]}. -%% -%% s2.cover: -%% {include,[....]}. % modules belonging to system s2 -%% {cross,[{s1,[m1]}]}. -%% -%% When the tests for both s1 and s2 are completed, run -%% cross_cover_analyse(Level,[{s1,S1LogDir},{s2,S2LogDir}]), and -%% the accumulated cover data for m1 will be written to -%% S1LogDir/[run./]cross_cover.html -%% -%% S1LogDir and S2LogDir are either the run. directories -%% for the two tests, or the parent directory of these, in which case -%% the latest run. directory will be chosen. -%% -%% Note that the m1 module will also be presented in the normal -%% coverage log for s1 (due to the include statement in s1.cover), but -%% that only includes the coverage achieved by the s1 test itself. -%% -%% The Tag in the 'cross' statement in the cover file has no other -%% purpose than mapping the list of modules ([m1] in the example -%% above) to the correct log directory where it should be included in -%% the cross_cover.html file (S1LogDir in the example above). -%% I.e. the value of the Tag has no meaning, it could be foo as well -%% as s1 above, as long as the same Tag is used in the cover file and -%% in the call to cross_cover_analyse/2. - - -%% Cover compilation -%% The compilation is executed on the target node -start_cover(#cover{}=CoverInfo) -> - cover_compile(CoverInfo); -start_cover({log,CoverLogDir}=CoverInfo) -> - %% Cover is controlled by the framework - here's the log - put(test_server_cover_log_dir,CoverLogDir), - {ok,CoverInfo}. - -cover_compile(CoverInfo) -> - test_server:cover_compile(CoverInfo). - -%% Read the coverfile for an application and return a list of modules -%% that are members of the application but shall not be compiled -%% (Exclude), and a list of modules that are not members of the -%% application but shall be compiled (Include). -read_cover_file(none) -> - {[],[],[]}; -read_cover_file(CoverFile) -> - case file:consult(CoverFile) of - {ok,List} -> - case check_cover_file(List, [], [], []) of - {ok,Exclude,Include,Cross} -> {Exclude,Include,Cross}; - error -> - io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]), - {[],[],[]} - end; - {error,Reason} -> - io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n", - [CoverFile,Reason]), - {[],[],[]} - end. - -check_cover_file([{exclude,all}|Rest], _, Include, Cross) -> - check_cover_file(Rest, all, Include, Cross); -check_cover_file([{exclude,Exclude}|Rest], _, Include, Cross) -> - case lists:all(fun(M) -> is_atom(M) end, Exclude) of - true -> - check_cover_file(Rest, Exclude, Include, Cross); - false -> - error - end; -check_cover_file([{include,Include}|Rest], Exclude, _, Cross) -> - case lists:all(fun(M) -> is_atom(M) end, Include) of - true -> - check_cover_file(Rest, Exclude, Include, Cross); - false -> - error - end; -check_cover_file([{cross,Cross}|Rest], Exclude, Include, _) -> - case check_cross(Cross) of - true -> - check_cover_file(Rest, Exclude, Include, Cross); - false -> - error - end; -check_cover_file([], Exclude, Include, Cross) -> - {ok,Exclude,Include,Cross}. - -check_cross([{Tag,Modules}|Rest]) -> - case lists:all(fun(M) -> is_atom(M) end, [Tag|Modules]) of - true -> - check_cross(Rest); - false -> - false - end; -check_cross([]) -> - true. - - -%% Cover analysis, per application -%% This analysis is executed on the target node once the test is -%% completed for an application. This is not the same as the cross -%% cover analysis, which can be executed on any node after the tests -%% are finshed. -%% -%% This per application analysis writes the file cover.html in the -%% application's run. directory. -stop_cover(#cover{}=CoverInfo, TestDir) -> - cover_analyse(CoverInfo, TestDir); -stop_cover(_CoverInfo, _TestDir) -> - %% Cover is probably controlled by the framework - ok. - -make_relative(AbsDir, VsDir) -> - DirTokens = filename:split(AbsDir), - VsTokens = filename:split(VsDir), - filename:join(make_relative1(DirTokens, VsTokens)). - -make_relative1([T | DirTs], [T | VsTs]) -> - make_relative1(DirTs, VsTs); -make_relative1(Last = [_File], []) -> - Last; -make_relative1(Last = [_File], VsTs) -> - Ups = ["../" || _ <- VsTs], - Ups ++ Last; -make_relative1(DirTs, []) -> - DirTs; -make_relative1(DirTs, VsTs) -> - Ups = ["../" || _ <- VsTs], - Ups ++ DirTs. - - -cover_analyse(CoverInfo, TestDir) -> - write_default_cross_coverlog(TestDir), - - {ok,CoverLog} = open_html_file(filename:join(TestDir, ?coverlog_name)), - write_coverlog_header(CoverLog), - #cover{app=App, - file=CoverFile, - excl=Excluded, - cross=Cross} = CoverInfo, - io:fwrite(CoverLog, "

Coverage for application '~w'

\n", [App]), - io:fwrite(CoverLog, - "

Coverdata collected over all tests

", - [?cross_coverlog_name]), - - io:fwrite(CoverLog, "

CoverFile: ~tp\n", [CoverFile]), - write_cross_cover_info(TestDir,Cross), - - case length(cover:imported_modules()) of - Imps when Imps > 0 -> - io:fwrite(CoverLog, - "

Analysis includes data from ~w imported module(s).\n", - [Imps]); - _ -> - ok - end, - - io:fwrite(CoverLog, "

Excluded module(s): ~tp\n", [Excluded]), - - Coverage = test_server:cover_analyse(TestDir, CoverInfo), - write_binary_file(filename:join(TestDir,?raw_coverlog_name), - term_to_binary(Coverage)), - - case lists:filter(fun({_M,{_,_,_}}) -> false; - (_) -> true - end, Coverage) of - [] -> - ok; - Bad -> - io:fwrite(CoverLog, "

Analysis failed for ~w module(s): " - "~w\n", - [length(Bad),[BadM || {BadM,{_,_Why}} <- Bad]]) - end, - - TotPercent = write_cover_result_table(CoverLog, Coverage), - write_binary_file(filename:join(TestDir, ?cover_total), - term_to_binary(TotPercent)). - -%% Cover analysis - accumulated over multiple tests -%% This can be executed on any node after all tests are finished. -%% Analyse = overview | details -%% TagDirs = [{Tag,Dir}] -%% Tag = atom(), identifier -%% Dir = string(), the log directory for Tag, it can be a -%% run. directory or the parent directory of -%% such (in which case the latest run. directory -%% is used) -cross_cover_analyse(Analyse, TagDirs0) -> - TagDirs = get_latest_run_dirs(TagDirs0), - TagMods = get_all_cross_info(TagDirs,[]), - TagDirMods = add_cross_modules(TagMods,TagDirs), - CoverdataFiles = get_coverdata_files(TagDirMods), - lists:foreach(fun(CDF) -> cover:import(CDF) end, CoverdataFiles), - io:fwrite("Cover analysing...\n", []), - DetailsFun = - case Analyse of - details -> - fun(Dir,M) -> - OutFile = filename:join(Dir, - atom_to_list(M) ++ - ".CROSS_COVER.html"), - case cover:analyse_to_file(M, OutFile, [html]) of - {ok,_} -> - {file,OutFile}; - Error -> - Error - end - end; - _ -> - fun(_,_) -> undefined end - end, - Coverage = analyse_tests(TagDirMods, DetailsFun, []), - cover:stop(), - write_cross_cover_logs(Coverage,TagDirMods). - -write_cross_cover_info(_Dir,[]) -> - ok; -write_cross_cover_info(Dir,Cross) -> - write_binary_file(filename:join(Dir,?cross_cover_info), - term_to_binary(Cross)). - -%% For each test from which there are cross cover analysed -%% modules, write a cross cover log (cross_cover.html). -write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) -> - case lists:keyfind(Tag,1,TagDirMods) of - {_,Dir,Mods} when Mods=/=[] -> - write_binary_file(filename:join(Dir,?raw_cross_coverlog_name), - term_to_binary(Coverage)), - CoverLogName = filename:join(Dir,?cross_coverlog_name), - {ok,CoverLog} = open_html_file(CoverLogName), - write_coverlog_header(CoverLog), - io:fwrite(CoverLog, - "

Coverage results for \'~w\' from all tests

\n", - [Tag]), - write_cover_result_table(CoverLog, Coverage), - io:fwrite("Written file ~tp\n", [CoverLogName]); - _ -> - ok - end, - write_cross_cover_logs(T,TagDirMods); -write_cross_cover_logs([],_) -> - io:fwrite("done\n", []). - -%% Get the latest run. directories -get_latest_run_dirs([{Tag,Dir}|Rest]) -> - [{Tag,get_latest_run_dir(Dir)} | get_latest_run_dirs(Rest)]; -get_latest_run_dirs([]) -> - []. - -get_latest_run_dir(Dir) -> - case filelib:wildcard(filename:join(Dir,"run.[1-2]*")) of - [] -> - Dir; - [H|T] -> - get_latest_dir(T,H) - end. - -get_latest_dir([H|T],Latest) when H>Latest -> - get_latest_dir(T,H); -get_latest_dir([_|T],Latest) -> - get_latest_dir(T,Latest); -get_latest_dir([],Latest) -> - Latest. - -get_all_cross_info([{_Tag,Dir}|Rest],Acc) -> - case file:read_file(filename:join(Dir,?cross_cover_info)) of - {ok,Bin} -> - TagMods = binary_to_term(Bin), - get_all_cross_info(Rest,TagMods++Acc); - _ -> - get_all_cross_info(Rest,Acc) - end; -get_all_cross_info([],Acc) -> - Acc. - -%% Associate the cross cover modules with their log directories -add_cross_modules(TagMods,TagDirs)-> - do_add_cross_modules(TagMods,[{Tag,Dir,[]} || {Tag,Dir} <- TagDirs]). -do_add_cross_modules([{Tag,Mods1}|TagMods],TagDirMods)-> - NewTagDirMods = - case lists:keytake(Tag,1,TagDirMods) of - {value,{Tag,Dir,Mods},Rest} -> - [{Tag,Dir,lists:umerge(lists:sort(Mods1),Mods)}|Rest]; - false -> - TagDirMods - end, - do_add_cross_modules(TagMods,NewTagDirMods); -do_add_cross_modules([],TagDirMods) -> - %% Just to get the modules in the same order as in the normal cover log - [{Tag,Dir,lists:reverse(Mods)} || {Tag,Dir,Mods} <- TagDirMods]. - -%% Find all exported coverdata files. -get_coverdata_files(TagDirMods) -> - lists:flatmap( - fun({_,LatestDir,_}) -> - filelib:wildcard(filename:join(LatestDir,"all.coverdata")) - end, - TagDirMods). - - -%% For each test, analyse all modules -%% Used for cross cover analysis. -analyse_tests([{Tag,LastTest,Modules}|T], DetailsFun, Acc) -> - Cov = analyse_modules(LastTest, Modules, DetailsFun, []), - analyse_tests(T, DetailsFun, [{Tag,Cov}|Acc]); -analyse_tests([], _DetailsFun, Acc) -> - Acc. - -%% Analyse each module -%% Used for cross cover analysis. -analyse_modules(Dir, [M|Modules], DetailsFun, Acc) -> - {ok,{M,{Cov,NotCov}}} = cover:analyse(M, module), - Acc1 = [{M,{Cov,NotCov,DetailsFun(Dir,M)}}|Acc], - analyse_modules(Dir, Modules, DetailsFun, Acc1); -analyse_modules(_Dir, [], _DetailsFun, Acc) -> - Acc. - - -%% Support functions for writing the cover logs (both cross and normal) -write_coverlog_header(CoverLog) -> - case catch io:put_chars(CoverLog,html_header("Coverage results")) of - {'EXIT',Reason} -> - io:format("\n\nERROR: Could not write normal heading in coverlog.\n" - "CoverLog: ~w\n" - "Reason: ~p\n", - [CoverLog,Reason]), - io:format(CoverLog,"\n", []); - _ -> - ok - end. - - -format_analyse(M,Cov,NotCov,undefined) -> - io_lib:fwrite("" - "" - "" - "\n", - [M,pc(Cov,NotCov),Cov,NotCov]); -format_analyse(M,Cov,NotCov,{file,File}) -> - io_lib:fwrite("" - "" - "" - "\n", - [uri_encode(filename:basename(File)), - M,pc(Cov,NotCov),Cov,NotCov]); -format_analyse(M,Cov,NotCov,{lines,Lines}) -> - CoverOutName = atom_to_list(M)++".COVER.html", - {ok,CoverOut} = open_html_file(CoverOutName), - write_not_covered(CoverOut,M,Lines), - ok = file:close(CoverOut), - io_lib:fwrite("" - "" - "" - "\n", - [uri_encode(CoverOutName),M,pc(Cov,NotCov),Cov,NotCov]); -format_analyse(M,Cov,NotCov,{error,_}) -> - io_lib:fwrite("" - "" - "" - "\n", - [M,pc(Cov,NotCov),Cov,NotCov]). - - -pc(0,0) -> - 0; -pc(Cov,NotCov) -> - round(Cov/(Cov+NotCov)*100). - - -write_not_covered(CoverOut,M,Lines) -> - io:put_chars(CoverOut,html_header("Coverage results for "++atom_to_list(M))), - io:fwrite(CoverOut, - "The following lines in module ~w are not covered:\n" - "
NumModuleGroupCaseLogTimeResultComment
" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "< >" ++ Col1 ++ "" ++ Col0 ++ "0.000s" ++ Col1 ++ "SKIPPED~ts
" ++ Col0 ++ "~ts" ++ Col1 ++ "" ++ Col0 ++ "~w" ++ Col1 ++ "" ++ Col0 ++ "~ts" ++ Col1 ++ "~w< >" ++ St0 ++ "~.3fs" ++ St1 ++ "SKIPPED~ts~ts
" ++ St0 ++ "~.3fs" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "died" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "~ts" ++ St1 ++ "FAILED~ts
" ++ St0 ++ "~ts" ++ St1 ++ "FAILED~ts~ts
" ++ HtmlCmt ++ "" ++ to_string(Comment0) ++ "" ++ St0 ++ "~.3fs" ++ St1 ++ "Ok
~w~w %~w~w
~w~w %~w~w
~w~w %~w~w
~w~w %~w~w
\n" - "\n", - [M]), - lists:foreach(fun({{_M,Line},{0,1}}) -> - io:fwrite(CoverOut,"\n", [Line]); - (_) -> - ok - end, - Lines), - io:put_chars(CoverOut,"
Line Number
~w
\n\n\n"). - - -write_default_coverlog(TestDir) -> - {ok,CoverLog} = open_html_file(filename:join(TestDir,?coverlog_name)), - write_coverlog_header(CoverLog), - io:put_chars(CoverLog,"Cover tool is not used\n\n"), - ok = file:close(CoverLog). - -write_default_cross_coverlog(TestDir) -> - {ok,CrossCoverLog} = - open_html_file(filename:join(TestDir,?cross_coverlog_name)), - write_coverlog_header(CrossCoverLog), - io:put_chars(CrossCoverLog, - ["No cross cover modules exist for this application,", - xhtml("
","
"), - "or cross cover analysis is not completed.\n" - "\n"]), - ok = file:close(CrossCoverLog). - -write_cover_result_table(CoverLog,Coverage) -> - io:fwrite(CoverLog, - "

\n" - "" - "\n", - []), - {TotCov,TotNotCov} = - lists:foldl(fun({M,{Cov,NotCov,Details}},{AccCov,AccNotCov}) -> - Str = format_analyse(M,Cov,NotCov,Details), - io:fwrite(CoverLog,"~ts", [Str]), - {AccCov+Cov,AccNotCov+NotCov}; - ({_M,{error,_Reason}},{AccCov,AccNotCov}) -> - {AccCov,AccNotCov} - end, - {0,0}, - Coverage), - TotPercent = pc(TotCov,TotNotCov), - io:fwrite(CoverLog, - "" - "\n" - "
ModuleCovered (%)Covered (Lines)Not covered (Lines)
Total~w %~w~w
\n" - "\n" - "\n", - [TotPercent,TotCov,TotNotCov]), - ok = file:close(CoverLog), - TotPercent. - - -%%%----------------------------------------------------------------- -%%% Support functions for writing files - -%% HTML files are always written with utf8 encoding -html_header(Title) -> - ["\n" - "\n" - "\n" - "\n" - "", Title, "\n" - "\n" - "\n" - "\n" - "\n"]. - -open_html_file(File) -> - open_utf8_file(File). - -open_html_file(File,Opts) -> - open_utf8_file(File,Opts). - -write_html_file(File,Content) -> - write_file(File,Content,utf8). - -%% The 'major' log file, which is a pure text file is also written -%% with utf8 encoding -open_utf8_file(File) -> - case file:open(File,AllOpts=[write,{encoding,utf8}]) of - {error,Reason} -> {error,{Reason,{File,AllOpts}}}; - Result -> Result - end. - -open_utf8_file(File,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) -> - file:write_file(File,Content); -write_file(File,Content,utf8) -> - write_binary_file(File,unicode:characters_to_binary(Content)). - -%% Write a file with only binary data -write_binary_file(File,Content) -> - file:write_file(File,Content). - -%% Encoding of hyperlinks in HTML files -uri_encode(File) -> - Encoding = file:native_name_encoding(), - uri_encode(File,Encoding). - -uri_encode(File,Encoding) -> - Components = filename:split(File), - filename:join([uri_encode_comp(C,Encoding) || C <- Components]). - -%% Encode the reference to a "filename of the given encoding" so it -%% can be inserted in a utf8 encoded HTML file. -%% This does almost the same as http_uri:encode/1, except -%% 1. it does not convert @, : and / (in order to preserve nodename and c:/) -%% 2. if the file name is in latin1, it also encodes all -%% characters >127 - i.e. latin1 but not ASCII. -uri_encode_comp([Char|Chars],Encoding) -> - Reserved = sets:is_element(Char, reserved()), - case (Char>127 andalso Encoding==latin1) orelse Reserved of - true -> - [ $% | http_util:integer_to_hexlist(Char)] ++ - uri_encode_comp(Chars,Encoding); - false -> - [Char | uri_encode_comp(Chars,Encoding)] - end; -uri_encode_comp([],_) -> - []. - -%% Copied from http_uri.erl, but slightly modified -%% (not converting @, : and /) -reserved() -> - sets:from_list([$;, $&, $=, $+, $,, $?, - $#, $[, $], $<, $>, $\", ${, $}, $|, - $\\, $', $^, $%, $ ]). - -encoding(File) -> - case epp:read_encoding(File) of - none -> - epp:default_encoding(); - E -> - E - end. diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl deleted file mode 100644 index 31098d9726..0000000000 --- a/lib/test_server/src/test_server_gl.erl +++ /dev/null @@ -1,301 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% This module implements group leader processes for test cases. -%% Each group leader process handles output to the minor log file for -%% a test case, and calls test_server_io to handle output to the common -%% log files. The group leader processes are created and destroyed -%% through the test_server_io module/process. - --module(test_server_gl). --export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1, - get_tc_supervisor/1,print/4,set_props/2]). - --export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). - --record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor - tc :: mfa() | 'undefined', %Current test case MFA - minor :: 'none'|pid(), %Minor fd - minor_monitor, %Monitor ref for minor fd - capture :: 'none'|pid(), %Capture output - reject_io :: boolean(), %Reject I/O requests... - permit_io, %... and exceptions - auto_nl=true :: boolean(), %Automatically add NL - levels %{Stdout,Major,Minor} - }). - -%% start_link() -%% Start a new group leader process. Only to be called by -%% the test_server_io process. - -start_link() -> - case gen_server:start_link(?MODULE, [], []) of - {ok,Pid} -> - {ok,Pid}; - Other -> - Other - end. - - -%% stop(Pid) -%% Stop a group leader process. Only to be called by -%% the test_server_io process. - -stop(GL) -> - gen_server:cast(GL, stop). - - -%% set_minor_fd(GL, Fd, MFA) -%% GL = Pid for the group leader process -%% Fd = file descriptor for the minor log file -%% MFA = {M,F,A} for the test case owning the minor log file -%% -%% Register the file descriptor for the minor log file. Subsequent -%% IO directed to the minor log file will be written to this file. -%% Also register the currently executing process at the testcase -%% supervisor corresponding to this group leader process. - -set_minor_fd(GL, Fd, MFA) -> - req(GL, {set_minor_fd,Fd,MFA,self()}). - - -%% unset_minor_fd(GL, Fd, MFA) -%% GL = Pid for the group leader process -%% -%% Unregister the file descriptor for minor log file (typically -%% because the test case has ended the minor log file is about -%% to be closed). Subsequent IO (for example, by a process spawned -%% by the testcase process) will go to the unexpected_io log file. - -unset_minor_fd(GL) -> - req(GL, unset_minor_fd). - - -%% get_tc_supervisor(GL) -%% GL = Pid for the group leader process -%% -%% Return the Pid for the process that supervises the test case -%% that has this group leader. - -get_tc_supervisor(GL) -> - req(GL, get_tc_supervisor). - - -%% print(GL, Detail, Format, Args) -> ok -%% GL = Pid for the group leader process -%% Detail = integer() | minor | major | html | stdout -%% Msg = iodata() -%% Printer = internal | pid() -%% -%% Print a message to one of the log files. If Detail is an integer, -%% it will be compared to the levels (set by set_props/2) to -%% determine which log file(s) that are to receive the output. If -%% Detail is an atom, the value of the atom will directly determine -%% which log file to use. IO to the minor log file will be handled -%% directly by this group leader process (printing to the file set by -%% set_minor_fd/3), and all other IO will be handled by calling -%% test_server_io:print/3. - -print(GL, Detail, Msg, Printer) -> - req(GL, {print,Detail,Msg,Printer}). - - -%% set_props(GL, [PropertyTuple]) -%% GL = Pid for the group leader process -%% PropertyTuple = {levels,{Show,Major,Minor}} | -%% {auto_nl,boolean()} | -%% {reject_io_reqs,boolean()} -%% -%% Set properties for this group leader process. - -set_props(GL, PropList) -> - req(GL, {set_props,PropList}). - -%%% Internal functions. - -init([]) -> - {ok,#st{tc_supervisor=none, - minor=none, - minor_monitor=none, - capture=none, - reject_io=false, - permit_io=gb_sets:empty(), - auto_nl=true, - levels={1,19,10} - }}. - -req(GL, Req) -> - gen_server:call(GL, Req, infinity). - -handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) -> - {reply,Pid,St}; -handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) -> - Ref = erlang:monitor(process, Fd), - {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref, - tc_supervisor=Supervisor}}; -handle_call(unset_minor_fd, _From, St) -> - {reply,ok,St#st{minor=none,tc_supervisor=none}}; -handle_call({set_props,PropList}, _From, St) -> - {reply,ok,do_set_props(PropList, St)}; -handle_call({print,Detail,Msg,Printer}, {From,_}, St) -> - output(Detail, Msg, Printer, From, St), - {reply,ok,St}. - -handle_cast(stop, St) -> - {stop,normal,St}. - -handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) -> - case Reason of - normal -> ok; - _ -> - Data = io_lib:format("=== WARNING === TC: ~w\n" - "Got down from minor Fd ~w: ~w\n\n", - [St#st.tc,St#st.minor,D]), - test_server_io:print_unexpected(Data) - end, - {noreply,St#st{minor=none,minor_monitor=none}}; -handle_info({permit_io,Pid}, #st{permit_io=P}=St) -> - {noreply,St#st{permit_io=gb_sets:add(Pid, P)}}; -handle_info({capture,Cap0}, St) -> - Cap = case Cap0 of - false -> none; - Pid when is_pid(Cap0) -> Pid - end, - {noreply,St#st{capture=Cap}}; -handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> - try io_req(Req, From, St) of - passthrough -> - group_leader() ! IoReq; - Data -> - case is_io_permitted(From, St) of - false -> - ok; - true -> - case St of - #st{capture=none} -> - ok; - #st{capture=CapturePid} -> - CapturePid ! {captured,Data} - end, - output(minor, Data, From, From, St) - end, - From ! {io_reply,ReplyAs,ok} - catch - _:_ -> - From ! {io_reply,ReplyAs,{error,arguments}} - end, - {noreply,St}; -handle_info({structured_io,ClientPid,{Detail,Str}}, St) -> - output(Detail, Str, ClientPid, ClientPid, St), - {noreply,St}; -handle_info({printout,Detail,Format,Args}, St) -> - Str = io_lib:format(Format, Args), - output(Detail, Str, internal, none, St), - {noreply,St}; -handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) -> - %% The process overseeing the testcase process also used to be - %% the group leader; thus, it is widely expected that it can be - %% reached by sending a message to the group leader. Therefore - %% we'll need to forward any non-recognized messaged to the test - %% case supervisor. - Pid ! Msg, - {noreply,St}; -handle_info(_Msg, #st{}=St) -> - %% There is no known supervisor process. Ignore this message. - {noreply,St}. - -terminate(_, _) -> - ok. - -do_set_props([{levels,Levels}|Ps], St) -> - do_set_props(Ps, St#st{levels=Levels}); -do_set_props([{auto_nl,AutoNL}|Ps], St) -> - do_set_props(Ps, St#st{auto_nl=AutoNL}); -do_set_props([{reject_io_reqs,Bool}|Ps], St) -> - do_set_props(Ps, St#st{reject_io=Bool}); -do_set_props([], St) -> St. - -io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode -> - unicode:characters_to_list(Bytes, Enc); -io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) -> - Str = Mod:Func(Format, Args), - unicode:characters_to_list(Str, Encoding); -io_req(_, _, _) -> passthrough. - -output(Level, Str, Sender, From, St) when is_integer(Level) -> - case selected_by_level(Level, stdout, St) of - true -> output(stdout, Str, Sender, From, St); - false -> ok - end, - case selected_by_level(Level, major, St) of - true -> output(major, Str, Sender, From, St); - false -> ok - end, - case selected_by_level(Level, minor, St) of - true -> output(minor, Str, Sender, From, St); - false -> ok - end; -output(stdout, Str, _Sender, From, St) -> - output_to_file(stdout, Str, From, St); -output(html, Str, _Sender, From, St) -> - output_to_file(html, Str, From, St); -output(Level, Str, Sender, From, St) when is_atom(Level) -> - output_to_file(Level, dress_output(Str, Sender, St), From, St). - -output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) -> - Data = [io_lib:format("=== ~w:~w/~w\n", [M,F,A]),Data0], - test_server_io:print(From, unexpected_io, Data), - ok; -output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) -> - try - io:put_chars(Fd, Data) - catch - Type:Reason -> - Data1 = - [io_lib:format("=== ERROR === TC: ~w\n" - "Failed to write to minor Fd: ~w\n" - "Type: ~w\n" - "Reason: ~w\n", - [TC,Fd,Type,Reason]), - Data,"\n"], - test_server_io:print(From, unexpected_io, Data1) - end; -output_to_file(Detail, Data, From, _) -> - test_server_io:print(From, Detail, Data). - -is_io_permitted(From, #st{reject_io=true,permit_io=P}) -> - gb_sets:is_member(From, P); -is_io_permitted(_, #st{reject_io=false}) -> true. - -selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) -> - Level =< Stdout; -selected_by_level(Level, major, #st{levels={_,Major,_}}) -> - Level =< Major; -selected_by_level(Level, minor, #st{levels={_,_,Minor}}) -> - Level >= Minor. - -dress_output([$=|_]=Str, internal, _) -> - [Str,$\n]; -dress_output(Str, internal, _) -> - ["=== ",Str,$\n]; -dress_output(Str, _, #st{auto_nl=AutoNL}) -> - case AutoNL of - true -> [Str,$\n]; - false -> Str - end. diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl deleted file mode 100644 index 578f359010..0000000000 --- a/lib/test_server/src/test_server_internal.hrl +++ /dev/null @@ -1,61 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --define(priv_dir,"log_private"). --define(MAIN_PORT,3289). --define(ACCEPT_TIMEOUT,20000). - -%% Target information generated by test_server:init_target_info/0 -%% Once initiated, this information will never change!! --record(target_info, {os_family, % atom(); win32 | unix - os_type, % result of os:type() - host, % string(); the name of the target machine - version, % string() - system_version, % string() - root_dir, % string() - test_server_dir, % string() - emulator, % string() - otp_release, % string() - username, % string() - cookie, % string(); Cookie for target node - naming, % string(); "-name" | "-sname" - master}). % string(); Was used for OSE's master - % node for main target and slave nodes. - % For other platforms the target node - % itself is master for slave nodes - -%% Temporary information generated by test_server_ctrl:read_parameters/X -%% This information is used when starting the main target, and for -%% initiating the #target_info record. --record(par, {type, - target, - naming, - master, - cookie}). - - --record(cover, {app, % application; Name | none - file, % cover spec file - incl, % explicitly include modules - excl, % explicitly exclude modules - level, % analyse level; details | overview - mods, % actually cover compiled modules - stop=true, % stop cover after analyse; boolean() - cross}).% cross cover analyse info diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl deleted file mode 100644 index 0d881d0ada..0000000000 --- a/lib/test_server/src/test_server_io.erl +++ /dev/null @@ -1,452 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% This module implements a process with the registered name 'test_server_io', -%% which has two main responsibilities: -%% -%% * Manage group leader processes (see the test_server_gl module) -%% for test cases. A group_leader process is obtained by calling -%% get_gl/1. Group leader processes will be kept alive as along as -%% the 'test_server_io' process is alive. -%% -%% * Handle output to the common log files (stdout, major, html, -%% unexpected_io). -%% - --module(test_server_io). --export([start_link/0,stop/1,get_gl/1,set_fd/2, - start_transaction/0,end_transaction/0, - print_buffered/1,print/3,print_unexpected/1, - set_footer/1,set_job_name/1,set_gl_props/1, - reset_state/0,finish/0]). - --export([init/1,handle_call/3,handle_info/2,terminate/2]). - --record(st, {fds, % Singleton fds (gb_tree) - tags=[], % Known tag types - shared_gl :: pid(), % Shared group leader - gls, % Group leaders (gb_set) - io_buffering=false, % I/O buffering - buffered, % Buffered I/O requests - html_footer, % HTML footer - job_name, % Name of current job. - gl_props, % Properties for GL - phase, % Indicates current mode - offline_buffer, % Buffer I/O during startup - stopping, % Reply to when process stopped - pending_ops % Perform when process idle - }). - -start_link() -> - case whereis(?MODULE) of - undefined -> - case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of - {ok,Pid} -> - {ok,Pid}; - Other -> - Other - end; - Pid -> - %% already running, reset the state - reset_state(), - {ok,Pid} - end. - -stop(FilesToClose) -> - OldGL = group_leader(), - group_leader(self(), self()), - req({stop,FilesToClose}), - group_leader(OldGL, self()), - ok. - -finish() -> - req(finish). - -%% get_gl(Shared) -> Pid -%% Shared = boolean() -%% Pid = pid() -%% -%% Return a group leader (a process using the test_server_gl module). -%% If Shared is true, the shared group leader is returned (suitable for -%% running sequential test cases), otherwise a new group leader process -%% is spawned. Group leader processes will live until the -%% 'test_server_io' process is stopped. - -get_gl(Shared) when is_boolean(Shared) -> - req({get_gl,Shared}). - -%% set_fd(Tag, Fd) -> ok. -%% Tag = major | html | unexpected_io -%% Fd = a file descriptor (as returned by file:open/2) -%% -%% Associate a file descriptor with the given Tag. This -%% Tag can later be used in when calling to print/3. - -set_fd(Tag, Fd) -> - req({set_fd,Tag,Fd}). - -%% start_transaction() -%% -%% Subsequent calls to print/3 from the process executing start_transaction/0 -%% will cause the messages to be buffered instead of printed directly. - -start_transaction() -> - req({start_transaction,self()}). - -%% end_transaction() -%% -%% End the transaction started by start_transaction/0. Subsequent calls to -%% print/3 will cause the message to be printed directly. - -end_transaction() -> - req({end_transaction,self()}). - -%% print(From, Tag, Msg) -%% From = pid() -%% Tag = stdout, or any tag that has been registered using set_fd/2 -%% Msg = string or iolist -%% -%% Either print Msg to the file identified by Tag, or buffer the message -%% start_transaction/0 has been called from the process From. -%% -%% NOTE: The tags have various special meanings. For example, 'html' -%% is assumed to be a HTML file. - -print(From, Tag, Msg) -> - req({print,From,Tag,Msg}). - -%% print_buffered(Pid) -%% Pid = pid() -%% -%% Print all messages buffered in the *first* transaction buffered for Pid. -%% (If start_transaction/0 and end_transaction/0 has been called N times, -%% print_buffered/1 must be called N times to print all transactions.) - -print_buffered(Pid) -> - req({print_buffered,Pid}). - -%% print_unexpected(Msg) -%% Msg = string or iolist -%% -%% Print the given string in the unexpected_io log. - -print_unexpected(Msg) -> - print(xxxFrom,unexpected_io,Msg). - -%% set_footer(IoData) -%% -%% Set a footer for the file associated with the 'html' tag. -%% It will be used by print/3 to print a footer for the HTML file. - -set_footer(Footer) -> - req({set_footer,Footer}). - -%% set_job_name(Name) -%% -%% Set a name for the currently running job. The name will be used -%% when printing to 'stdout'. -%% - -set_job_name(Name) -> - req({set_job_name,Name}). - -%% set_gl_props(PropList) -%% -%% Set properties for group leader processes. When a group_leader process -%% is created, test_server_gl:set_props(PropList) will be called. - -set_gl_props(PropList) -> - req({set_gl_props,PropList}). - -%% reset_state -%% -%% Reset the initial state -reset_state() -> - req(reset_state). - -%%% Internal functions. - -init([]) -> - process_flag(trap_exit, true), - Empty = gb_trees:empty(), - {ok,Shared} = test_server_gl:start_link(), - {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), - io_buffering=gb_sets:empty(), - buffered=Empty, - html_footer="\n\n", - job_name="", - gl_props=[], - phase=starting, - offline_buffer=[], - pending_ops=[]}}. - -req(Req) -> - gen_server:call(?MODULE, Req, infinity). - -handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) -> - {ok,Pid} = test_server_gl:start_link(), - test_server_gl:set_props(Pid, Props), - {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}}; -handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) -> - {reply,Shared,St}; -handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0,tags=Tags0, - offline_buffer=OfflineBuff}=St) -> - Fds = gb_trees:enter(Tag, Fd, Fds0), - St1 = St#st{fds=Fds,tags=[Tag|lists:delete(Tag, Tags0)]}, - OfflineBuff1 = - if OfflineBuff == [] -> - []; - true -> - %% Fd ready, print anything buffered for associated Tag - lists:filtermap(fun({T,From,Str}) when T == Tag -> - output(From, Tag, Str, St1), - false; - (_) -> - true - end, lists:reverse(OfflineBuff)) - end, - {reply,ok,St1#st{phase=started, - offline_buffer=lists:reverse(OfflineBuff1)}}; -handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0, - buffered=Buf0}=St) -> - Buf = case gb_trees:is_defined(Pid, Buf0) of - false -> gb_trees:insert(Pid, queue:new(), Buf0); - true -> Buf0 - end, - Buffer = gb_sets:add(Pid, Buffer0), - {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}}; -handle_call({print,From,Tag,Str}, _From, St0) -> - St = output(From, Tag, Str, St0), - {reply,ok,St}; -handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0, - buffered=Buffered0}=St0) -> - Q0 = gb_trees:get(Pid, Buffered0), - Q = queue:in(eot, Q0), - Buffered = gb_trees:update(Pid, Q, Buffered0), - Buffer = gb_sets:delete_any(Pid, Buffer0), - St = St0#st{io_buffering=Buffer,buffered=Buffered}, - {reply,ok,St}; -handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) -> - Q0 = gb_trees:get(Pid, Buffered0), - Q = do_print_buffered(Q0, St0), - Buffered = gb_trees:update(Pid, Q, Buffered0), - St = St0#st{buffered=Buffered}, - {reply,ok,St}; -handle_call({set_footer,Footer}, _From, St) -> - {reply,ok,St#st{html_footer=Footer}}; -handle_call({set_job_name,Name}, _From, St) -> - {reply,ok,St#st{job_name=Name}}; -handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) -> - test_server_gl:set_props(Shared, Props), - {reply,ok,St#st{gl_props=Props}}; -handle_call(reset_state, From, #st{phase=stopping,pending_ops=Ops}=St) -> - %% can't reset during stopping phase, save op for later - Op = fun(NewSt) -> - {_,Result,NewSt1} = handle_call(reset_state, From, NewSt), - {Result,NewSt1} - end, - {noreply,St#st{pending_ops=[{From,Op}|Ops]}}; -handle_call(reset_state, _From, #st{fds=Fds,tags=Tags,gls=Gls, - offline_buffer=OfflineBuff}) -> - %% close open log files - lists:foreach(fun(Tag) -> - case gb_trees:lookup(Tag, Fds) of - none -> - ok; - {value,Fd} -> - file:close(Fd) - end - end, Tags), - GlList = gb_sets:to_list(Gls), - [test_server_gl:stop(GL) || GL <- GlList], - timer:sleep(100), - case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlList) of - [] -> - ok; - _ -> - timer:sleep(2000), - [exit(GL, kill) || GL <- GlList] - end, - Empty = gb_trees:empty(), - {ok,Shared} = test_server_gl:start_link(), - {reply,ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), - io_buffering=gb_sets:empty(), - buffered=Empty, - html_footer="\n\n", - job_name="", - gl_props=[], - phase=starting, - offline_buffer=OfflineBuff, - pending_ops=[]}}; -handle_call({stop,FdTags}, From, #st{fds=Fds0,tags=Tags0, - shared_gl=SGL,gls=Gls0}=St0) -> - St = St0#st{gls=gb_sets:insert(SGL, Gls0),phase=stopping,stopping=From}, - gc(St), - %% close open log files - {Fds1,Tags1} = lists:foldl(fun(Tag, {Fds,Tags}) -> - case gb_trees:lookup(Tag, Fds) of - none -> - {Fds,Tags}; - {value,Fd} -> - file:close(Fd), - {gb_trees:delete(Tag, Fds), - lists:delete(Tag, Tags)} - end - end, {Fds0,Tags0}, FdTags), - %% Give the users of the surviving group leaders some - %% time to finish. - erlang:send_after(1000, self(), stop_group_leaders), - {noreply,St#st{fds=Fds1,tags=Tags1}}; -handle_call(finish, From, St) -> - gen_server:reply(From, ok), - {stop,normal,St}. - -handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> - Gls = gb_sets:delete_any(Pid, Gls0), - case gb_sets:is_empty(Gls) andalso stopping =/= undefined of - true -> - %% No more group leaders left. - gen_server:reply(From, ok), - {noreply,St#st{gls=Gls,phase=stopping,stopping=undefined}}; - false -> - %% Wait for more group leaders to finish. - {noreply,St#st{gls=Gls,phase=stopping}} - end; -handle_info({'EXIT',_Pid,Reason}, _St) -> - exit(Reason); -handle_info(stop_group_leaders, #st{gls=Gls}=St) -> - %% Stop the remaining group leaders. - GlPids = gb_sets:to_list(Gls), - [test_server_gl:stop(GL) || GL <- GlPids], - timer:sleep(100), - Wait = - case lists:filter(fun(GlPid) -> is_process_alive(GlPid) end, GlPids) of - [] -> 0; - _ -> 2000 - end, - erlang:send_after(Wait, self(), kill_group_leaders), - {noreply,St}; -handle_info(kill_group_leaders, #st{gls=Gls,stopping=From, - pending_ops=Ops}=St) -> - [exit(GL, kill) || GL <- gb_sets:to_list(Gls)], - if From /= undefined -> - gen_server:reply(From, ok); - true -> % reply has been sent already - ok - end, - %% we're idle, check if any ops are pending - St1 = lists:foldr(fun({ReplyTo,Op},NewSt) -> - {Result,NewSt1} = Op(NewSt), - gen_server:reply(ReplyTo, Result), - NewSt1 - end, St#st{phase=idle,pending_ops=[]}, Ops), - {noreply,St1}; -handle_info(Other, St) -> - io:format("Ignoring: ~p\n", [Other]), - {noreply,St}. - -terminate(_, _) -> - ok. - -output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0, - phase=Phase,offline_buffer=OfflineBuff}=St) -> - case gb_sets:is_member(From, Buffered) of - false -> - case do_output(Tag, Str, Phase, St) of - buffer when length(OfflineBuff)>500 -> - %% something's wrong, clear buffer - St#st{offline_buffer=[]}; - buffer -> - St#st{offline_buffer=[{Tag,From,Str}|OfflineBuff]}; - _ -> - St - end; - true -> - Q0 = gb_trees:get(From, Buf0), - Q = queue:in({Tag,Str}, Q0), - Buf = gb_trees:update(From, Q, Buf0), - St#st{buffered=Buf} - end. - -do_output(stdout, Str, _, #st{job_name=undefined}) -> - io:put_chars(Str); -do_output(stdout, Str0, _, #st{job_name=Name}) -> - Str = io_lib:format("Testing ~ts: ~ts\n", [Name,Str0]), - io:put_chars(Str); -do_output(Tag, Str, Phase, #st{fds=Fds}=St) -> - case gb_trees:lookup(Tag, Fds) of - none when Phase /= started -> - buffer; - none -> - S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n", - [?MODULE,?LINE,Tag]), - do_output(stdout, [S,Str], Phase, St); - {value,Fd} -> - try - io:put_chars(Fd, Str), - case Tag of - html -> finalise_table(Fd, St); - _ -> ok - end - catch _:Error -> - S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to " - "log file '~p': ~p\n", - [?MODULE,?LINE,Tag,Error]), - do_output(stdout, [S,Str], Phase, St) - end - end. - -finalise_table(Fd, #st{html_footer=Footer}) -> - case file:position(Fd, {cur,0}) of - {ok,Pos} -> - %% We are writing to a seekable file. Finalise so - %% we get complete valid (and viewable) HTML code. - %% Then rewind to overwrite the finalising code. - io:put_chars(Fd, ["\n\n",Footer]), - file:position(Fd, Pos); - {error,epipe} -> - %% The file is not seekable. We cannot erase what - %% we've already written --- so the reader will - %% have to wait until we're done. - ok - end. - -do_print_buffered(Q0, St) -> - Item = queue:get(Q0), - Q = queue:drop(Q0), - case Item of - eot -> - Q; - {Tag,Str} -> - do_output(Tag, Str, undefined, St), - do_print_buffered(Q, St) - end. - -gc(#st{gls=Gls0}) -> - InUse0 = [begin - case process_info(P, group_leader) of - {group_leader,GL} -> GL; - undefined -> undefined - end - end || P <- processes()], - InUse = ordsets:from_list(InUse0), - Gls = gb_sets:to_list(Gls0), - NotUsed = ordsets:subtract(Gls, InUse), - [test_server_gl:stop(Pid) || Pid <- NotUsed], - ok. diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl deleted file mode 100644 index 3419f3f5d0..0000000000 --- a/lib/test_server/src/test_server_node.erl +++ /dev/null @@ -1,758 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_node). --compile(r12). - -%%% -%%% The same compiled code for this module must be possible to load -%%% in R12B and later. -%%% - -%% Test Controller interface --export([is_release_available/1]). --export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]). --export([start_node/5, stop_node/1]). --export([kill_nodes/0, nodedown/1]). -%% Internal export --export([node_started/1,trc/1,handle_debug/4]). - --include("test_server_internal.hrl"). --record(slave_info, {name,socket,client}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% %%% -%%% All code in this module executes on the test_server_ctrl process %%% -%%% except for node_started/1 and trc/1 which execute on a new node. %%% -%%% %%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -is_release_available(Rel) when is_atom(Rel) -> - is_release_available(atom_to_list(Rel)); -is_release_available(Rel) -> - case os:type() of - {unix,_} -> - Erl = find_release(Rel), - case Erl of - none -> false; - _ -> filelib:is_regular(Erl) - end; - _ -> - false - end. - -nodedown(Sock) -> - Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'}, - case ets:match(slave_tab,Match) of - [[Node,_Client]] -> % Slave node died - gen_tcp:close(Sock), - ets:delete(slave_tab,Node), - slave_died; - [] -> - ok - end. - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Start trace node -%%% -start_tracer_node(TraceFile,TI) -> - Match = #slave_info{name='$1',_='_'}, - SlaveNodes = lists:map(fun([N]) -> [" ",N] end, - ets:match(slave_tab,Match)), - TargetNode = node(), - Cookie = TI#target_info.cookie, - {ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]), - {ok,TracePort} = inet:port(LSock), - Prog = quote_progname(pick_erl_program(default)), - Cmd = lists:concat([Prog, " -sname tracer -hidden -setcookie ", Cookie, - " -s ", ?MODULE, " trc ", TraceFile, " ", - TracePort, " ", TI#target_info.os_family]), - spawn(fun() -> print_data(open_port({spawn,Cmd},[stream])) end), -%! open_port({spawn,Cmd},[stream]), - case gen_tcp:accept(LSock,?ACCEPT_TIMEOUT) of - {ok,Sock} -> - gen_tcp:close(LSock), - receive - {tcp,Sock,Result} when is_binary(Result) -> - case unpack(Result) of - error -> - gen_tcp:close(Sock), - {error,timeout}; - {ok,started} -> - trace_nodes(Sock,[TargetNode | SlaveNodes]), - {ok,Sock}; - {ok,Error} -> Error - end; - {tcp_closed,Sock} -> - gen_tcp:close(Sock), - {error,could_not_start_tracernode} - after ?ACCEPT_TIMEOUT -> - gen_tcp:close(Sock), - {error,timeout} - end; - Error -> - gen_tcp:close(LSock), - {error,{could_not_start_tracernode,Error}} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Start a tracer on each of these nodes and set flags and patterns -%%% -trace_nodes(Sock,Nodes) -> - Bin = term_to_binary({add_nodes,Nodes}), - ok = gen_tcp:send(Sock, [1|Bin]), - receive_ack(Sock). - - -receive_ack(Sock) -> - receive - {tcp,Sock,Bin} when is_binary(Bin) -> - case unpack(Bin) of - error -> receive_ack(Sock); - {ok,_} -> ok - end; - _ -> - receive_ack(Sock) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Stop trace node -%%% -stop_tracer_node(Sock) -> - Bin = term_to_binary(id(stop)), - ok = gen_tcp:send(Sock, [1|Bin]), - receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, - ok. - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% trc([TraceFile,Nodes]) -> ok -%% -%% Start tracing on the given nodes -%% -%% This function executes on the new node -%% -trc([TraceFile, PortAtom, Type]) -> - {Result,Patterns} = - case file:consult(TraceFile) of - {ok,TI} -> - Pat = parse_trace_info(lists:flatten(TI)), - {started,Pat}; - Error -> - {Error,[]} - end, - Port = list_to_integer(atom_to_list(PortAtom)), - case catch gen_tcp:connect("localhost", Port, [binary, - {reuseaddr,true}, - {packet,2}]) of - {ok,Sock} -> - BinResult = term_to_binary(Result), - ok = gen_tcp:send(Sock,[1|BinResult]), - trc_loop(Sock,Patterns,Type); - _else -> - ok - end, - erlang:halt(). -trc_loop(Sock,Patterns,Type) -> - receive - {tcp,Sock,Bin} -> - case unpack(Bin) of - error -> - ttb:stop(), - gen_tcp:close(Sock); - {ok,{add_nodes,Nodes}} -> - add_nodes(Nodes,Patterns,Type), - Bin = term_to_binary(id(ok)), - ok = gen_tcp:send(Sock, [1|Bin]), - trc_loop(Sock,Patterns,Type); - {ok,stop} -> - ttb:stop(), - gen_tcp:close(Sock) - end; - {tcp_closed,Sock} -> - ttb:stop(), - gen_tcp:close(Sock) - end. -add_nodes(Nodes,Patterns,_Type) -> - ttb:tracer(Nodes,[{file,{local, test_server}}, - {handler, {{?MODULE,handle_debug},initial}}]), - ttb:p(all,[call,timestamp]), - lists:foreach(fun({TP,M,F,A,Pat}) -> ttb:TP(M,F,A,Pat); - ({CTP,M,F,A}) -> ttb:CTP(M,F,A) - end, - Patterns). - -parse_trace_info([{TP,M,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> - [{TP,M,'_','_',Pat}|parse_trace_info(Pats)]; -parse_trace_info([{TP,M,F,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> - [{TP,M,F,'_',Pat}|parse_trace_info(Pats)]; -parse_trace_info([{TP,M,F,A,Pat}|Pats]) when TP=:=tp; TP=:=tpl -> - [{TP,M,F,A,Pat}|parse_trace_info(Pats)]; -parse_trace_info([CTP|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> - [{CTP,'_','_','_'}|parse_trace_info(Pats)]; -parse_trace_info([{CTP,M}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> - [{CTP,M,'_','_'}|parse_trace_info(Pats)]; -parse_trace_info([{CTP,M,F}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> - [{CTP,M,F,'_'}|parse_trace_info(Pats)]; -parse_trace_info([{CTP,M,F,A}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg -> - [{CTP,M,F,A}|parse_trace_info(Pats)]; -parse_trace_info([]) -> - []; -parse_trace_info([_other|Pats]) -> % ignore - parse_trace_info(Pats). - -handle_debug(Out,Trace,TI,initial) -> - handle_debug(Out,Trace,TI,0); -handle_debug(_Out,end_of_trace,_TI,N) -> - N; -handle_debug(Out,Trace,_TI,N) -> - print_trc(Out,Trace,N), - N+1. - -print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) -> - io:format(Out, - "~w: ~s~n" - "Process : ~w~n" - "Call : ~w:~w/~w~n" - "Arguments : ~p~n" - "Caller : ~w~n~n", - [N,ts(Ts),P,M,F,length(A),A,C]); -print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) -> - io:format(Out, - "~w: ~s~n" - "Process : ~w~n" - "Call : ~w:~w/~w~n" - "Arguments : ~p~n~n", - [N,ts(Ts),P,M,F,length(A),A]); -print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> - io:format(Out, - "~w: ~s~n" - "Process : ~w~n" - "Return from : ~w:~w/~w~n" - "Return value : ~p~n~n", - [N,ts(Ts),P,M,F,A,R]); -print_trc(Out,{drop,X},N) -> - io:format(Out, - "~w: Tracer dropped ~w messages - too busy~n~n", - [N,X]); -print_trc(Out,Trace,N) -> - Ts = element(size(Trace),Trace), - io:format(Out, - "~w: ~s~n" - "Trace : ~p~n~n", - [N,ts(Ts),Trace]). -ts({_, _, Micro} = Now) -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now), - io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w,~6.6.0w", - [Y,M,D,H,Min,S,Micro]). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Start slave/peer nodes (initiated by test_server:start_node/5) -%%% -start_node(SlaveName, slave, Options, From, TI) when is_list(SlaveName) -> - start_node_slave(list_to_atom(SlaveName), Options, From, TI); -start_node(SlaveName, slave, Options, From, TI) -> - start_node_slave(SlaveName, Options, From, TI); -start_node(SlaveName, peer, Options, From, TI) when is_atom(SlaveName) -> - start_node_peer(atom_to_list(SlaveName), Options, From, TI); -start_node(SlaveName, peer, Options, From, TI) -> - start_node_peer(SlaveName, Options, From, TI); -start_node(_SlaveName, _Type, _Options, _From, _TI) -> - not_implemented_yet. - -%% -%% Peer nodes are always started on the same host as test_server_ctrl -%% -%% (Socket communication is used since in early days the test target -%% and the test server controller node could be on different hosts and -%% the target could not know the controller node via erlang -%% distribution) -%% -start_node_peer(SlaveName, OptList, From, TI) -> - SuppliedArgs = start_node_get_option_value(args, OptList, []), - Cleanup = start_node_get_option_value(cleanup, OptList, true), - HostStr = test_server_sup:hoststr(), - {ok,LSock} = gen_tcp:listen(0,[binary, - {reuseaddr,true}, - {packet,2}]), - {ok,WaitPort} = inet:port(LSock), - NodeStarted = lists:concat([" -s ", ?MODULE, " node_started ", - HostStr, " ", WaitPort]), - - % Support for erl_crash_dump files.. - CrashFile = filename:join([TI#target_info.test_server_dir, - "erl_crash_dump."++cast_to_list(SlaveName)]), - CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), - FailOnError = start_node_get_option_value(fail_on_error, OptList, true), - Pa = TI#target_info.test_server_dir, - Prog0 = start_node_get_option_value(erl, OptList, default), - Prog = quote_progname(pick_erl_program(Prog0)), - Args = - case string:str(SuppliedArgs,"-setcookie") of - 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs; - _ -> SuppliedArgs - end, - Cmd = lists:concat([Prog, - " -detached ", - TI#target_info.naming, " ", SlaveName, - " -pa \"", Pa,"\"", - NodeStarted, - CrashArgs, - " ", Args]), - Opts = case start_node_get_option_value(env, OptList, []) of - [] -> []; - Env -> [{env, Env}] - end, - %% peer is always started on localhost - %% - %% Bad environment can cause open port to fail. If this happens, - %% we ignore it and let the testcase handle the situation... - catch open_port({spawn, Cmd}, [stream|Opts]), - - Tmo = 60000 * test_server:timetrap_scale_factor(), - - case start_node_get_option_value(wait, OptList, true) of - true -> - Ret = wait_for_node_started(LSock,Tmo,undefined,Cleanup,TI,self()), - case {Ret,FailOnError} of - {{{ok, Node}, Warning},_} -> - gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning}); - {_,false} -> - gen_server:reply(From,{Ret, HostStr, Cmd}); - {_,true} -> - gen_server:reply(From,{fail,{Ret, HostStr, Cmd}}) - end; - false -> - Nodename = list_to_atom(SlaveName ++ "@" ++ HostStr), - I = "=== Not waiting for node", - gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}), - Self = self(), - spawn_link( - fun() -> - wait_for_node_started(LSock,Tmo,undefined, - Cleanup,TI,Self), - receive after infinity -> ok end - end), - ok - end. - -%% -%% Slave nodes are started on a remote host if -%% - the option remote is given when calling test_server:start_node/3 -%% -start_node_slave(SlaveName, OptList, From, TI) -> - SuppliedArgs = start_node_get_option_value(args, OptList, []), - Cleanup = start_node_get_option_value(cleanup, OptList, true), - - CrashFile = filename:join([TI#target_info.test_server_dir, - "erl_crash_dump."++cast_to_list(SlaveName)]), - CrashArgs = lists:concat([" -env ERL_CRASH_DUMP \"",CrashFile,"\" "]), - Pa = TI#target_info.test_server_dir, - Args = lists:concat([" -pa \"", Pa, "\" ", SuppliedArgs, CrashArgs]), - - Prog0 = start_node_get_option_value(erl, OptList, default), - Prog = pick_erl_program(Prog0), - Ret = - case start_which_node(OptList) of - {error,Reason} -> {{error,Reason},undefined,undefined}; - Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup) - end, - gen_server:reply(From,Ret). - - -do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup) -> - Host = - case Host0 of - local -> test_server_sup:hoststr(); - _ -> cast_to_list(Host0) - end, - Cmd = Prog ++ " " ++ Args, - case slave:start(Host, SlaveName, Args, no_link, Prog) of - {ok,Nodename} -> - case Cleanup of - true -> ets:insert(slave_tab,#slave_info{name=Nodename}); - false -> ok - end, - {{ok,Nodename}, Host, Cmd, [], []}; - Ret -> - {Ret, Host, Cmd} - end. - - -wait_for_node_started(LSock,Timeout,Client,Cleanup,TI,CtrlPid) -> - case gen_tcp:accept(LSock,Timeout) of - {ok,Sock} -> - gen_tcp:close(LSock), - receive - {tcp,Sock,Started0} when is_binary(Started0) -> - case unpack(Started0) of - error -> - gen_tcp:close(Sock), - {error, connection_closed}; - {ok,Started} -> - Version = TI#target_info.otp_release, - VsnStr = TI#target_info.system_version, - {ok,Nodename, W} = - handle_start_node_return(Version, - VsnStr, - Started), - case Cleanup of - true -> - ets:insert(slave_tab,#slave_info{name=Nodename, - socket=Sock, - client=Client}); - false -> ok - end, - gen_tcp:controlling_process(Sock,CtrlPid), - test_server_ctrl:node_started(Nodename), - {{ok,Nodename},W} - end; - {tcp_closed,Sock} -> - gen_tcp:close(Sock), - {error, connection_closed} - after Timeout -> - gen_tcp:close(Sock), - {error, timeout} - end; - {error,Reason} -> - gen_tcp:close(LSock), - {error, {no_connection,Reason}} - end. - - - -handle_start_node_return(Version,VsnStr,{started, Node, Version, VsnStr}) -> - {ok, Node, []}; -handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) -> - Str = io_lib:format("WARNING: Started node " - "reports different system " - "version than current node! " - "Current node version: ~p, ~p " - "Started node version: ~p, ~p", - [Version, VsnStr, - OVersion, OVsnStr]), - Str1 = lists:flatten(Str), - {ok, Node, Str1}. - - -%% -%% This function executes on the new node -%% -node_started([Host,PortAtom]) -> - %% Must spawn a new process because the boot process should not - %% hang forever!! - spawn(fun() -> node_started(Host,PortAtom) end). - -%% This process hangs forever, just waiting for the socket to be -%% closed and terminating the node -node_started(Host,PortAtom) -> - {_, Version} = init:script_id(), - VsnStr = erlang:system_info(system_version), - Port = list_to_integer(atom_to_list(PortAtom)), - case catch gen_tcp:connect(Host,Port, [binary, - {reuseaddr,true}, - {packet,2}]) of - - {ok,Sock} -> - Started = term_to_binary({started, node(), Version, VsnStr}), - ok = gen_tcp:send(Sock, [1|Started]), - receive _Anyting -> - gen_tcp:close(Sock), - erlang:halt() - end; - _else -> - erlang:halt() - end. - - - - - -% start_which_node(Optlist) -> hostname -start_which_node(Optlist) -> - case start_node_get_option_value(remote, Optlist) of - undefined -> - local; - true -> - case find_remote_host() of - {error, Other} -> - {error, Other}; - RHost -> - RHost - end - end. - -find_remote_host() -> - HostList=test_server_ctrl:get_hosts(), - case lists:delete(test_server_sup:hoststr(), HostList) of - [] -> - {error, no_remote_hosts}; - [RHost|_Rest] -> - RHost - end. - -start_node_get_option_value(Key, List) -> - start_node_get_option_value(Key, List, undefined). - -start_node_get_option_value(Key, List, Default) -> - case lists:keysearch(Key, 1, List) of - {value, {Key, Value}} -> - Value; - false -> - Default - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% stop_node(Name) -> ok | {error,Reason} -%% -%% Clean up - test_server will stop this node -stop_node(Name) -> - case ets:lookup(slave_tab,Name) of - [#slave_info{}] -> - ets:delete(slave_tab,Name), - ok; - [] -> - {error, not_a_slavenode} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% kill_nodes() -> ok -%% -%% Brutally kill all slavenodes that were not stopped by test_server -kill_nodes() -> - case ets:match_object(slave_tab,'_') of - [] -> []; - List -> - lists:map(fun(SI) -> kill_node(SI) end, List) - end. - -kill_node(SI) -> - Name = SI#slave_info.name, - ets:delete(slave_tab,Name), - case SI#slave_info.socket of - undefined -> - catch rpc:call(Name,erlang,halt,[]); - Sock -> - gen_tcp:close(Sock) - end, - Name. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% cast_to_list(X) -> string() -%%% X = list() | atom() | void() -%%% Returns a string representation of whatever was input - -cast_to_list(X) when is_list(X) -> X; -cast_to_list(X) when is_atom(X) -> atom_to_list(X); -cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])). - - -%%% L contains elements of the forms -%%% {prog, String} -%%% {release, Rel} where Rel = String | latest | previous -%%% this -%%% -pick_erl_program(default) -> - cast_to_list(lib:progname()); -pick_erl_program(L) -> - P = random_element(L), - case P of - {prog, S} -> - S; - {release, S} -> - find_release(S); - this -> - cast_to_list(lib:progname()) - end. - -%% 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. -%% -%% Arguments could exist either if the executable is excplicitly given -%% ({prog,String}) or if the -program switch to beam is used and -%% includes arguments (typically done by cerl in OTP test environment -%% in order to ensure that slave/peer nodes are started with the same -%% emulator and flags as the test node. The return from lib:progname() -%% could then typically be '//cerl -gcov'). -quote_progname(Progname) -> - do_quote_progname(string:tokens(Progname," ")). - -do_quote_progname([Prog]) -> - "\""++Prog++"\""; -do_quote_progname([Prog,Arg|Args]) -> - case os:find_executable(Prog) of - false -> - do_quote_progname([Prog++" "++Arg | Args]); - _ -> - %% this one has an executable - we assume the rest are arguments - "\""++Prog++"\""++ - lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args])) - end. - -random_element(L) -> - lists:nth(rand:uniform(length(L)), L). - -find_release(latest) -> - "/usr/local/otp/releases/latest/bin/erl"; -find_release(previous) -> - "kaka"; -find_release(Rel) -> - find_release(os:type(), Rel). - -find_release({unix,sunos}, Rel) -> - case os:cmd("uname -p") of - "sparc" ++ _ -> - "/usr/local/otp/releases/otp_beam_solaris8_" ++ Rel ++ "/bin/erl"; - _ -> - none - end; -find_release({unix,linux}, Rel) -> - Candidates = find_rel_linux(Rel), - case lists:dropwhile(fun(N) -> - not filelib:is_regular(N) - end, Candidates) of - [] -> none; - [Erl|_] -> Erl - end; -find_release(_, _) -> none. - -find_rel_linux(Rel) -> - case suse_release() of - none -> []; - SuseRel -> find_rel_suse(Rel, SuseRel) - end. - -find_rel_suse(Rel, SuseRel) -> - Root = "/usr/local/otp/releases/sles", - case SuseRel of - "11" -> - %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order. - find_rel_suse_1(Rel, Root++"11") ++ - find_rel_suse_1(Rel, Root++"10") ++ - find_rel_suse_1(Rel, Root++"9"); - "10" -> - %% Try both SuSE 10 and SuSe 9 in that order. - find_rel_suse_1(Rel, Root++"10") ++ - find_rel_suse_1(Rel, Root++"9"); - "9" -> - find_rel_suse_1(Rel, Root++"9"); - _ -> - [] - end. - -find_rel_suse_1(Rel, RootWc) -> - case erlang:system_info(wordsize) of - 4 -> - find_rel_suse_2(Rel, RootWc++"_32"); - 8 -> - find_rel_suse_2(Rel, RootWc++"_64") ++ - find_rel_suse_2(Rel, RootWc++"_32") - end. - -find_rel_suse_2(Rel, RootWc) -> - RelDir = filename:dirname(RootWc), - Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*", - case file:list_dir(RelDir) of - {ok,Dirs} -> - case lists:filter(fun(Dir) -> - case re:run(Dir, Pat) of - nomatch -> false; - _ -> true - end - end, Dirs) of - [] -> - []; - [R|_] -> - [filename:join([RelDir,R,"bin","erl"])] - end; - _ -> - [] - end. - -%% suse_release() -> VersionString | none. -%% Return the major SuSE version number for this platform or -%% 'none' if this is not a SuSE platform. -suse_release() -> - case file:open("/etc/SuSE-release", [read]) of - {ok,Fd} -> - try - suse_release(Fd) - after - file:close(Fd) - end; - {error,_} -> none - end. - -suse_release(Fd) -> - case io:get_line(Fd, '') of - eof -> none; - Line when is_list(Line) -> - case re:run(Line, "^VERSION\\s*=\\s*(\\d+)\s*", - [{capture,all_but_first,list}]) of - nomatch -> - suse_release(Fd); - {match,[Version]} -> - Version - end - end. - -unpack(Bin) -> - {One,Term} = split_binary(Bin, 1), - case binary_to_list(One) of - [1] -> - case catch {ok,binary_to_term(Term)} of - {'EXIT',_} -> error; - {ok,_}=Res -> Res - end; - _ -> error - end. - -id(I) -> I. - -print_data(Port) -> - receive - {Port, {data, Bytes}} -> - io:put_chars(Bytes), - print_data(Port); - {Port, eof} -> - Port ! {self(), close}, - receive - {Port, closed} -> - true - end, - receive - {'EXIT', Port, _} -> - ok - after 1 -> % force context switch - ok - end - end. diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl deleted file mode 100644 index fc2cfd57bd..0000000000 --- a/lib/test_server/src/test_server_sup.erl +++ /dev/null @@ -1,939 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------- -%%% Purpose: Test server support functions. -%%%------------------------------------------------------------------- --module(test_server_sup). --export([timetrap/2, timetrap/3, timetrap/4, - timetrap_cancel/1, capture_get/1, messages_get/1, - timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, - cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, - get_username/0, get_os_family/0, - hostatom/0, hostatom/1, hoststr/0, hoststr/1, - framework_call/2,framework_call/3,framework_call/4, - format_loc/1, - util_start/0, util_stop/0, unique_name/0, - call_trace/1, - appup_test/1]). --include("test_server_internal.hrl"). --define(crash_dump_tar,"crash_dumps.tar.gz"). --define(src_listing_ext, ".src.html"). --record(util_state, {starter, latest_name}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap(Timeout,Scale,Pid) -> Handle -%% Handle = term() -%% -%% Creates a time trap, that will kill the given process if the -%% trap is not cancelled with timetrap_cancel/1, within Timeout -%% milliseconds. -%% Scale says if the time should be scaled up to compensate for -%% delays during the test (e.g. if cover is running). - -timetrap(Timeout0, Pid) -> - timetrap(Timeout0, Timeout0, true, Pid). - -timetrap(Timeout0, Scale, Pid) -> - timetrap(Timeout0, Timeout0, Scale, Pid). - -timetrap(Timeout0, ReportTVal, Scale, Pid) -> - process_flag(priority, max), - Timeout = if not Scale -> Timeout0; - true -> test_server:timetrap_scale_factor() * Timeout0 - end, - TruncTO = trunc(Timeout), - receive - after TruncTO -> - kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) - end. - -kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) -> - case is_process_alive(Pid) of - true -> - TimeToReport = if Timeout0 == ReportTVal -> TruncTO; - true -> ReportTVal end, - MFLs = test_server:get_loc(Pid), - Mon = erlang:monitor(process, Pid), - Trap = {timetrap_timeout,TimeToReport,MFLs}, - exit(Pid, Trap), - receive - {'DOWN', Mon, process, Pid, _} -> - ok - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - catch error_logger:warning_msg( - "Testcase process ~w not " - "responding to timetrap " - "timeout:~n" - " ~p.~n" - "Killing testcase...~n", - [Pid, Trap]), - exit(Pid, kill) - end; - false -> - ok - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% timetrap_cancel(Handle) -> ok -%% Handle = term() -%% -%% Cancels a time trap. -timetrap_cancel(Handle) -> - unlink(Handle), - MonRef = erlang:monitor(process, Handle), - exit(Handle, kill), - receive {'DOWN',MonRef,_,_,_} -> ok - after - 2000 -> - erlang:demonitor(MonRef, [flush]), - ok - end. - -capture_get(Msgs) -> - receive - {captured,Msg} -> - capture_get([Msg|Msgs]) - after 0 -> - lists:reverse(Msgs) - end. - -messages_get(Msgs) -> - receive - Msg -> - messages_get([Msg|Msgs]) - after 0 -> - lists:reverse(Msgs) - end. - -timecall(M, F, A) -> - {Elapsed, Val} = timer:tc(M, F, A), - {Elapsed / 1000000, Val}. - - -call_crash(Time,Crash,M,F,A) -> - OldTrapExit = process_flag(trap_exit,true), - Pid = spawn_link(M,F,A), - Answer = - receive - {'EXIT',Crash} -> - ok; - {'EXIT',Pid,Crash} -> - ok; - {'EXIT',_Reason} when Crash==any -> - ok; - {'EXIT',Pid,_Reason} when Crash==any -> - ok; - {'EXIT',Reason} -> - test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", - [Crash, Reason]), - exit({wrong_crash_reason,Reason}); - {'EXIT',Pid,Reason} -> - test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", - [Crash, Reason]), - exit({wrong_crash_reason,Reason}); - {'EXIT',OtherPid,Reason} when OldTrapExit == false -> - exit({'EXIT',OtherPid,Reason}) - after do_trunc(Time) -> - exit(call_crash_timeout) - end, - process_flag(trap_exit,OldTrapExit), - Answer. - -do_trunc(infinity) -> infinity; -do_trunc(T) -> trunc(T). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% app_test/2 -%% -%% Checks one applications .app file for obvious errors. -%% Checks.. -%% * .. required fields -%% * .. that all modules specified actually exists -%% * .. that all requires applications exists -%% * .. that no module included in the application has export_all -%% * .. that all modules in the ebin/ dir is included -%% (This only produce a warning, as all modules does not -%% have to be included (If the `pedantic' option isn't used)) -app_test(Application, Mode) -> - case is_app(Application) of - {ok, AppFile} -> - do_app_tests(AppFile, Application, Mode); - Error -> - test_server:fail(Error) - end. - -is_app(Application) -> - case file:consult(filename:join([code:lib_dir(Application),"ebin", - atom_to_list(Application)++".app"])) of - {ok, [{application, Application, AppFile}] } -> - {ok, AppFile}; - _ -> - test_server:format(minor, - "Application (.app) file not found, " - "or it has very bad syntax.~n"), - {error, not_an_application} - end. - - -do_app_tests(AppFile, AppName, Mode) -> - DictList= - [ - {missing_fields, []}, - {missing_mods, []}, - {superfluous_mods_in_ebin, []}, - {export_all_mods, []}, - {missing_apps, []} - ], - fill_dictionary(DictList), - - %% An appfile must (?) have some fields.. - check_fields([description, modules, registered, applications], AppFile), - - %% Check for missing and extra modules. - {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile), - EBinList=lists:sort(get_ebin_modnames(AppName)), - {Missing, Extra} = common(lists:sort(Mods), EBinList), - put(superfluous_mods_in_ebin, Extra), - put(missing_mods, Missing), - - %% Check that no modules in the application has export_all. - app_check_export_all(Mods), - - %% Check that all specified applications exists. - {value, {applications, Apps}}= - lists:keysearch(applications, 1, AppFile), - check_apps(Apps), - - A=check_dict(missing_fields, "Inconsistent app file, " - "missing fields"), - B=check_dict(missing_mods, "Inconsistent app file, " - "missing modules"), - C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, " - "Modules not included in app file.", Mode), - D=check_dict(export_all_mods, "Inconsistent app file, " - "Modules have `export_all'."), - E=check_dict(missing_apps, "Inconsistent app file, " - "missing applications."), - - erase_dictionary(DictList), - case A+B+C+D+E of - 5 -> - ok; - _ -> - test_server:fail() - end. - -app_check_export_all([]) -> - ok; -app_check_export_all([Mod|Mods]) -> - case catch apply(Mod, module_info, [compile]) of - {'EXIT', {undef,_}} -> - app_check_export_all(Mods); - COpts -> - case lists:keysearch(options, 1, COpts) of - false -> - app_check_export_all(Mods); - {value, {options, List}} -> - case lists:member(export_all, List) of - true -> - put(export_all_mods, [Mod|get(export_all_mods)]), - app_check_export_all(Mods); - false -> - app_check_export_all(Mods) - end - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% appup_test/1 -%% -%% Checks one applications .appup file for obvious errors. -%% Checks.. -%% * .. syntax -%% * .. that version in app file matches appup file version -%% * .. validity of appup instructions -%% -%% For library application this function checks that the proper -%% 'restart_application' upgrade and downgrade clauses exist. -appup_test(Application) -> - case is_app(Application) of - {ok, AppFile} -> - case is_appup(Application, proplists:get_value(vsn, AppFile)) of - {ok, Up, Down} -> - StartMod = proplists:get_value(mod, AppFile), - Modules = proplists:get_value(modules, AppFile), - do_appup_tests(StartMod, Application, Up, Down, Modules); - Error -> - test_server:fail(Error) - end; - Error -> - test_server:fail(Error) - end. - -is_appup(Application, Version) -> - AppupFile = atom_to_list(Application) ++ ".appup", - AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]), - case file:consult(AppupPath) of - {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) -> - {ok, Up, Down}; - _ -> - test_server:format( - minor, - "Application upgrade (.appup) file not found, " - "or it has very bad syntax.~n"), - {error, appup_not_readable} - end. - -do_appup_tests(undefined, Application, Up, Down, _Modules) -> - %% library application - case Up of - [{<<".*">>, [{restart_application, Application}]}] -> - case Down of - [{<<".*">>, [{restart_application, Application}]}] -> - ok; - _ -> - test_server:format( - minor, - "Library application needs restart_application " - "downgrade instruction.~n"), - {error, library_downgrade_instruction_malformed} - end; - _ -> - test_server:format( - minor, - "Library application needs restart_application " - "upgrade instruction.~n"), - {error, library_upgrade_instruction_malformed} - end; -do_appup_tests(_, _Application, Up, Down, Modules) -> - %% normal application - case check_appup_clauses_plausible(Up, up, Modules) of - ok -> - case check_appup_clauses_plausible(Down, down, Modules) of - ok -> - test_server:format(minor, "OK~n"); - Error -> - test_server:format(minor, "ERROR ~p~n", [Error]), - test_server:fail(Error) - end; - Error -> - test_server:format(minor, "ERROR ~p~n", [Error]), - test_server:fail(Error) - end. - -check_appup_clauses_plausible([], _Direction, _Modules) -> - ok; -check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules) - when is_binary(Re) -> - case re:compile(Re) of - {ok, _} -> - case check_appup_instructions(Instrs, Direction, Modules) of - ok -> - check_appup_clauses_plausible(Rest, Direction, Modules); - Error -> - Error - end; - {error, Error} -> - {error, {version_regex_malformed, Re, Error}} - end; -check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules) - when is_list(V) -> - case check_appup_instructions(Instrs, Direction, Modules) of - ok -> - check_appup_clauses_plausible(Rest, Direction, Modules); - Error -> - Error - end; -check_appup_clauses_plausible(Clause, _Direction, _Modules) -> - {error, {clause_malformed, Clause}}. - -check_appup_instructions(Instrs, Direction, Modules) -> - case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of - {_Good, []} -> - ok; - {_, Bad} -> - {error, {bad_instructions, Bad}} - end. - -check_instructions(_, [], _, Good, Bad, _) -> - {lists:reverse(Good), lists:reverse(Bad)}; -check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) -> - case catch check_instruction(UpDown, Instr, All, Modules) of - ok -> - check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules); - {error, Reason} -> - NewBad = [{Instr, Reason} | Bad], - check_instructions(UpDown, Rest, All, Good, NewBad, Modules) - end. - -check_instruction(up, {add_module, Module}, _, Modules) -> - %% A new module is added - check_module(Module, Modules); -check_instruction(down, {add_module, Module}, _, Modules) -> - %% An old module is re-added - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> ok; - ok -> throw({error, {existing_readded_module, Module}}) - end; -check_instruction(_, {load_module, Module}, _, Modules) -> - check_module(Module, Modules); -check_instruction(_, {load_module, Module, DepMods}, _, Modules) -> - check_module(Module, Modules), - check_depend(DepMods); -check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) -> - check_module(Module, Modules), - check_depend(DepMods), - check_purge(Pre), - check_purge(Post); -check_instruction(up, {delete_module, Module}, _, Modules) -> - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> - ok; - ok -> - throw({error,{existing_module_deleted, Module}}) - end; -check_instruction(down, {delete_module, Module}, _, Modules) -> - check_module(Module, Modules); -check_instruction(_, {update, Module}, _, Modules) -> - check_module(Module, Modules); -check_instruction(_, {update, Module, supervisor}, _, Modules) -> - check_module(Module, Modules); -check_instruction(_, {update, Module, DepMods}, _, Modules) - when is_list(DepMods) -> - check_module(Module, Modules); -check_instruction(_, {update, Module, Change}, _, Modules) -> - check_module(Module, Modules), - check_change(Change); -check_instruction(_, {update, Module, Change, DepMods}, _, Modules) -> - check_module(Module, Modules), - check_change(Change), - check_depend(DepMods); -check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) -> - check_module(Module, Modules), - check_change(Change), - check_purge(Pre), - check_purge(Post), - check_depend(DepMods); -check_instruction(_, - {update, Module, Timeout, Change, Pre, Post, DepMods}, - _, - Modules) -> - check_module(Module, Modules), - check_timeout(Timeout), - check_change(Change), - check_purge(Pre), - check_purge(Post), - check_depend(DepMods); -check_instruction(_, - {update, Module, ModType, Timeout, Change, Pre, Post, DepMods}, - _, - Modules) -> - check_module(Module, Modules), - check_mod_type(ModType), - check_timeout(Timeout), - check_change(Change), - check_purge(Pre), - check_purge(Post), - check_depend(DepMods); -check_instruction(_, {restart_application, Application}, _, _) -> - check_application(Application); -check_instruction(_, {remove_application, Application}, _, _) -> - check_application(Application); -check_instruction(_, {add_application, Application}, _, _) -> - check_application(Application); -check_instruction(_, {add_application, Application, Type}, _, _) -> - check_application(Application), - check_restart_type(Type); -check_instruction(_, Instr, _, _) -> - throw({error, {low_level_or_invalid_instruction, Instr}}). - -check_module(Module, Modules) -> - case {is_atom(Module), lists:member(Module, Modules)} of - {true, true} -> ok; - {true, false} -> throw({error, {unknown_module, Module}}); - {false, _} -> throw({error, {bad_module, Module}}) - end. - -check_application(App) -> - case is_atom(App) of - true -> ok; - false -> throw({error, {bad_application, App}}) - end. - -check_depend(Dep) when is_list(Dep) -> ok; -check_depend(Dep) -> throw({error, {bad_depend, Dep}}). - -check_restart_type(permanent) -> ok; -check_restart_type(transient) -> ok; -check_restart_type(temporary) -> ok; -check_restart_type(load) -> ok; -check_restart_type(none) -> ok; -check_restart_type(Type) -> throw({error, {bad_restart_type, Type}}). - -check_timeout(T) when is_integer(T), T > 0 -> ok; -check_timeout(default) -> ok; -check_timeout(infinity) -> ok; -check_timeout(T) -> throw({error, {bad_timeout, T}}). - -check_mod_type(static) -> ok; -check_mod_type(dynamic) -> ok; -check_mod_type(Type) -> throw({error, {bad_mod_type, Type}}). - -check_purge(soft_purge) -> ok; -check_purge(brutal_purge) -> ok; -check_purge(Purge) -> throw({error, {bad_purge, Purge}}). - -check_change(soft) -> ok; -check_change({advanced, _}) -> ok; -check_change(Change) -> throw({error, {bad_change, Change}}). - -%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1}, -%% NotInL2 is the elements of L1 which don't occurr in L2, -%% NotInL1 is the elements of L2 which don't ocurr in L1. - -common(L1, L2) -> - common(L1, L2, [], []). - -common([X|Rest1], [X|Rest2], A1, A2) -> - common(Rest1, Rest2, A1, A2); -common([X|Rest1], [Y|Rest2], A1, A2) when X < Y -> - common(Rest1, [Y|Rest2], [X|A1], A2); -common([X|Rest1], [Y|Rest2], A1, A2) -> - common([X|Rest1], Rest2, A1, [Y|A2]); -common([], L, A1, A2) -> - {A1, L++A2}; -common(L, [], A1, A2) -> - {L++A1, A2}. - -check_apps([]) -> - ok; -check_apps([App|Apps]) -> - case is_app(App) of - {ok, _AppFile} -> - ok; - {error, _} -> - put(missing_apps, [App|get(missing_apps)]) - end, - check_apps(Apps). - -check_fields([], _AppFile) -> - ok; -check_fields([L|Ls], AppFile) -> - check_field(L, AppFile), - check_fields(Ls, AppFile). - -check_field(FieldName, AppFile) -> - case lists:keymember(FieldName, 1, AppFile) of - true -> - ok; - false -> - put(missing_fields, [FieldName|get(missing_fields)]), - ok - end. - -check_dict(Dict, Reason) -> - case get(Dict) of - [] -> - 1; % All ok. - List -> - io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), - 0 - end. - -check_dict_tolerant(Dict, Reason, Mode) -> - case get(Dict) of - [] -> - 1; % All ok. - List -> - io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), - case Mode of - pedantic -> - 0; - _ -> - 1 - end - end. - -get_ebin_modnames(AppName) -> - Wc=filename:join([code:lib_dir(AppName),"ebin", - "*"++code:objfile_extension()]), - TheFun=fun(X, Acc) -> - [list_to_atom(filename:rootname( - filename:basename(X)))|Acc] end, - _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)). - -%% -%% This function removes any erl_crash_dump* files found in the -%% test server directory. Done only once when the test server -%% is started. -%% -cleanup_crash_dumps() -> - Dir = crash_dump_dir(), - Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), - delete_files(Dumps). - -crash_dump_dir() -> - filename:dirname(code:which(?MODULE)). - -tar_crash_dumps() -> - Dir = crash_dump_dir(), - case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of - [] -> {error,no_crash_dumps}; - Dumps -> - TarFileName = filename:join(Dir,?crash_dump_tar), - {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]), - lists:foreach( - fun(File) -> - ok = erl_tar:add(Tar,File,filename:basename(File),[]) - end, - Dumps), - ok = erl_tar:close(Tar), - delete_files(Dumps), - {ok,TarFileName} - end. - - -check_new_crash_dumps() -> - Dir = crash_dump_dir(), - Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), - case length(Dumps) of - 0 -> - ok; - Num -> - test_server_ctrl:format(minor, - "Found ~w crash dumps:~n", [Num]), - append_files_to_logfile(Dumps), - delete_files(Dumps) - end. - -append_files_to_logfile([]) -> ok; -append_files_to_logfile([File|Files]) -> - NodeName=from($., File), - test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]), - Fd=get(test_server_minor_fd), - case file:read_file(File) of - {ok, Bin} -> - case file:write(Fd, Bin) of - ok -> - ok; - {error,Error} -> - %% Write failed. The following io:format/3 will probably also - %% fail, but in that case it will throw an exception so that - %% we will be aware of the problem. - io:format(Fd, "Unable to write the crash dump " - "to this file: ~p~n", [file:format_error(Error)]) - end; - _Error -> - io:format(Fd, "Failed to read: ~ts\n", [File]) - end, - append_files_to_logfile(Files). - -delete_files([]) -> ok; -delete_files([File|Files]) -> - io:format("Deleting file: ~ts~n", [File]), - case file:delete(File) of - {error, _} -> - case file:rename(File, File++".old") of - {error, Error} -> - io:format("Could neither delete nor rename file " - "~ts: ~ts.~n", [File, Error]); - _ -> - ok - end; - _ -> - ok - end, - delete_files(Files). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% erase_dictionary(Vars) -> ok -%% Vars = [atom(),...] -%% -%% Takes a list of dictionary keys, KeyVals, erases -%% each key and returns ok. -erase_dictionary([{Var, _Val}|Vars]) -> - erase(Var), - erase_dictionary(Vars); -erase_dictionary([]) -> - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% fill_dictionary(KeyVals) -> void() -%% KeyVals = [{atom(),term()},...] -%% -%% Takes each Key-Value pair, and inserts it in the process dictionary. -fill_dictionary([{Var,Val}|Vars]) -> - put(Var,Val), - fill_dictionary(Vars); -fill_dictionary([]) -> - []. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% get_username() -> UserName -%% -%% Returns the current user -get_username() -> - getenv_any(["USER","USERNAME"]). - -getenv_any([Key|Rest]) -> - case catch os:getenv(Key) of - String when is_list(String) -> String; - false -> getenv_any(Rest) - end; -getenv_any([]) -> "". - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% get_os_family() -> OsFamily -%% -%% Returns the OS family -get_os_family() -> - {OsFamily,_OsName} = os:type(), - OsFamily. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% hostatom()/hostatom(Node) -> Host; atom() -%% hoststr() | hoststr(Node) -> Host; string() -%% -%% Returns the OS family -hostatom() -> - hostatom(node()). -hostatom(Node) -> - list_to_atom(hoststr(Node)). -hoststr() -> - hoststr(node()). -hoststr(Node) when is_atom(Node) -> - hoststr(atom_to_list(Node)); -hoststr(Node) when is_list(Node) -> - from($@, Node). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_H, []) -> []. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn -%% -%% Calls the given Func in Callback -framework_call(Func,Args) -> - framework_call(Func,Args,ok). -framework_call(Func,Args,DefaultReturn) -> - CB = os:getenv("TEST_SERVER_FRAMEWORK"), - framework_call(CB,Func,Args,DefaultReturn). -framework_call(FW,_Func,_Args,DefaultReturn) - when FW =:= false; FW =:= "undefined" -> - DefaultReturn; -framework_call(Callback,Func,Args,DefaultReturn) -> - Mod = list_to_atom(Callback), - case code:is_loaded(Mod) of - false -> code:load_file(Mod); - _ -> ok - end, - case erlang:function_exported(Mod,Func,length(Args)) of - true -> - EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end, - SetTcState = case Func of - end_tc -> true; - init_tc -> true; - _ -> false - end, - case SetTcState of - true -> - test_server:set_tc_state({framework,Mod,Func}); - false -> - ok - end, - try apply(Mod,Func,Args) of - Result -> - Result - catch - exit:Why -> - EH(Why); - error:Why -> - EH({Why,erlang:get_stacktrace()}); - throw:Why -> - EH(Why) - end; - false -> - DefaultReturn - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% format_loc(Loc) -> string() -%% -%% Formats the printout of the line of code read from -%% process dictionary (test_server_loc). Adds link to -%% correct line in source code. -format_loc([{Mod,Func,Line}]) -> - [format_loc1({Mod,Func,Line})]; -format_loc([{Mod,Func,Line}|Rest]) -> - ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; -format_loc([{Mod,LineOrFunc}]) -> - format_loc({Mod,LineOrFunc}); -format_loc({Mod,Func}) when is_atom(Func) -> - io_lib:format("{~w,~w}",[Mod,Func]); -format_loc(Loc) -> - io_lib:format("~p",[Loc]). - -format_loc1([{Mod,Func,Line}]) -> - [" ",format_loc1({Mod,Func,Line}),"]"]; -format_loc1([{Mod,Func,Line}|Rest]) -> - [" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; -format_loc1({Mod,Func,Line}) -> - ModStr = atom_to_list(Mod), - case {lists:member(no_src, get(test_server_logopts)), - lists:reverse(ModStr)} of - {false,[$E,$T,$I,$U,$S,$_|_]} -> - Link = if is_integer(Line) -> - integer_to_list(Line); - Line == last_expr -> - list_to_atom(atom_to_list(Func)++"-last_expr"); - is_atom(Line) -> - atom_to_list(Line); - true -> - Line - end, - io_lib:format("{~w,~w,~w}", - [Mod,Func, - test_server_ctrl:uri_encode(downcase(ModStr)), - ?src_listing_ext,Link,Line]); - _ -> - io_lib:format("{~w,~w,~w}",[Mod,Func,Line]) - end. - -downcase(S) -> downcase(S, []). -downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z -> - downcase(Rest, [Uc-$A+$a|Result]); -downcase([C|Rest], Result) -> - downcase(Rest, [C|Result]); -downcase([], Result) -> - lists:reverse(Result). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% util_start() -> ok -%% -%% Start local utility process -util_start() -> - Starter = self(), - case whereis(?MODULE) of - undefined -> - spawn_link(fun() -> - register(?MODULE, self()), - util_loop(#util_state{starter=Starter}) - end); - _Pid -> - ok - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% util_stop() -> ok -%% -%% Stop local utility process -util_stop() -> - try (?MODULE ! {self(),stop}) of - _ -> - receive {?MODULE,stopped} -> ok - after 5000 -> exit(whereis(?MODULE), kill) - end - catch - _:_ -> - ok - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% unique_name() -> string() -%% -unique_name() -> - ?MODULE ! {self(),unique_name}, - receive {?MODULE,Name} -> Name - after 5000 -> exit({?MODULE,no_util_process}) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% util_loop(State) -> ok -%% -util_loop(State) -> - receive - {From,unique_name} -> - Nr = erlang:unique_integer([positive]), - Name = integer_to_list(Nr), - if Name == State#util_state.latest_name -> - timer:sleep(1), - self() ! {From,unique_name}, - util_loop(State); - true -> - From ! {?MODULE,Name}, - util_loop(State#util_state{latest_name = Name}) - end; - {From,stop} -> - catch unlink(State#util_state.starter), - From ! {?MODULE,stopped}, - ok - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% call_trace(TraceSpecFile) -> ok -%% -%% Read terms on format {m,Mod} | {f,Mod,Func} -%% from TraceSpecFile and enable call trace for -%% specified functions. -call_trace(TraceSpec) -> - case catch try_call_trace(TraceSpec) of - {'EXIT',Reason} -> - erlang:display(Reason), - exit(Reason); - Ok -> - Ok - end. - -try_call_trace(TraceSpec) -> - case file:consult(TraceSpec) of - {ok,Terms} -> - dbg:tracer(), - %% dbg:p(self(), [p, m, sos, call]), - dbg:p(self(), [sos, call]), - lists:foreach(fun({m,M}) -> - case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of - {error,What} -> exit({error,{tracing_failed,What}}); - _ -> ok - end; - ({f,M,F}) -> - case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of - {error,What} -> exit({error,{tracing_failed,What}}); - _ -> ok - end; - (Huh) -> - exit({error,{unrecognized_trace_term,Huh}}) - end, Terms), - ok; - {_,Error} -> - exit({error,{tracing_failed,TraceSpec,Error}}) - end. - diff --git a/lib/test_server/src/things/distr_startup_SUITE.erl b/lib/test_server/src/things/distr_startup_SUITE.erl deleted file mode 100644 index 2423566fc0..0000000000 --- a/lib/test_server/src/things/distr_startup_SUITE.erl +++ /dev/null @@ -1,239 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(distr_startup_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include_lib("common_test/include/ct.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [reads,writes]. - --define(iterations,10000). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -app1() -> - {application, app1, - [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, - {applications, [kernel, stdlib]}, - {mod, {ch_sup, {app1, 1, 3}}}]}. - -app3() -> - {application, app3, - [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, - {applications, [kernel, stdlib]}, - {mod, {ch_sup, {app3, 7, 9}}}]}. - - -config(Fd,C1,C2,C3) -> - io:format(Fd, - "[{kernel, [{sync_nodes_optional, ['~s','~s','~s']}," - "{sync_nodes_timeout, 1}," - "{distributed, [{app1, ['~s', '~s', '~s']}," - "{app2, 10000, ['~s', '~s', '~s']}," - "{app3, 5000, [{'~s', '~s'}, '~s']}]}]}].~n", - [C1,C2,C3, C1,C2,C3, C1,C2,C3, C1,C2,C3]). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(H, []) -> []. - -%%----------------------------------------------------------------- -%% Test suite for distributed applications, tests start, load -%% etc indirectly. -%% Should be started in a CC view with: -%% erl -sname master -rsh ctrsh -%%----------------------------------------------------------------- -start_nodes(Conf) -> - % Write a config file - ?line Nodes = ?config(nodes,Conf), - ?line [C1,C2,C3|_] = Nodes, %% Need at least 3 nodes - ?line Dir = ?config(priv_dir,Conf), - ?line {ok, Fd} = file:open(Dir ++ "sys.config", write), - ?line config(Fd,C1,C2,C3), - ?line file:close(Fd), - ?line Config = Dir ++ "sys", - - % Test [cp1, cp2, cp3] - ?line {ok, Cp1} = start_node(lists:nth(1,Nodes), Config), - ?line {ok, Cp2} = start_node(lists:nth(2,Nodes), Config), - ?line {ok, Cp3} = start_node(lists:nth(3,Nodes), Config), - % Start app1 and make sure cp1 starts it - %%?line rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]), - %%?line rpc:multicall([Cp1, Cp2, Cp3], application, start,[app1,permanent]), - ?line test_server:sleep(1000), - {Cp1,Cp2,Cp3}. - -stop_nodes({Cp1,Cp2,Cp3}) -> - ?line stop_node(Cp1), - ?line stop_node(Cp2), - ?line stop_node(Cp3). - -start_node(NodeAtHost, Config) -> - ?line NodeAtHostStr = atom_to_list(NodeAtHost), - ?line HostStr = from($@,NodeAtHostStr), - ?line NodeStr = lists:reverse(from($@,lists:reverse(NodeAtHostStr))), - ?line Host = list_to_atom(HostStr), - ?line Node = list_to_atom(NodeStr), - ?line io:format("Launching slave node ~p@~p ~p",[Node,Host,Config]), - ?line slave:start(Host, Node, lists:concat(["-config ", Config])). - -stop_node(Node) -> - ?line rpc:cast(Node, erlang, halt, []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -start_client_process(Cp,Mode,NodeNum) -> - io:format("Starting client process at ~p in mode ~p",[Cp,Mode]), - ?line case rpc:call(Cp, erlang, spawn, - [?MODULE, client, - [Mode,NodeNum,self(),random:uniform(1000)]]) of - {badrpc,Reason} -> - ?line exit({badrpc,{Cp,Reason}}); - Client -> - ?line Client - end. - -start_clients(Mode,Conf) -> - ?line random:seed(4711,0,0), - ?line {Cp1,Cp2,Cp3} = start_nodes(Conf), - ?line Client1 = start_client_process(Cp1,Mode,1), - ?line Client2 = start_client_process(Cp2,Mode,2), - ?line Client3 = start_client_process(Cp3,Mode,3), - test_server:format(1,"All 3 nodes started, " - "power off client(s) any time...",[]), - Client1 ! go, - Client2 ! go, - Client3 ! go, - {{Cp1,Cp2,Cp3},{Client1,Client2,Client3}}. - -stop_clients(Cps) -> - test_server:format(1,"Test completed.",[]), - ?line stop_nodes(Cps). - -data() -> - {{self(),foo,bar,[1,2,3,4,5,6,7],{{{{}}}}, - "We need pretty long packages, so that there is a big risk " - "of cutting it in the middle when suddenly turning off " - "the power or breaking the connection. " - "We don't check the contents of the data very much, but " - "at least there is a magic cookie at the end (123456)." - "If that one arrives correctly, the link is ok as far " - "as we are concerned."}, - 123456}. - -reads(suite) -> []; -reads(Conf) -> - ?line {Cps,_} = start_clients(w,Conf), - ?line read_loop(?iterations,0), - ?line stop_clients(Cps), - ok. - -read_loop(0,M) -> - ok; -read_loop(N,M) -> - ?line Dog = test_server:timetrap(test_server:seconds(0.5)), - M2 = - receive - {Node,Count,{_,123456}} -> - ?line setelement(Node,M,element(Node,M)+1); - {Node,Count,Data} -> - ?line exit({network_transmission_error,Data}); - {nodedown,Node} -> - ?line test_server:format(1,"Node ~s went down",[Node]), - ?line M; - Other -> - ?line M - after test_server:seconds(0.1) -> - ?line io:format("No message!"), - ?line M - end, - ?line test_server:timetrap_cancel(Dog), - ?line M3 = - case N rem 100 of - 0 -> io:format("~p reads to go (~w msgs)",[N,M2]), - {0,0,0}; - _ -> M2 - end, - ?line read_loop(N-1,M3). - -client(w,NodeNum,Pid,Seed) -> - random:seed(Seed,0,0), - receive - go -> ok - end, - client_write_loop(Pid,0,NodeNum,data()); -client(r,NodeNum,Pid,Seed) -> - random:seed(Seed,0,0), - receive - go -> ok - end, - client_read_loop(0). - -client_write_loop(Pid,N,NodeNum,Data) -> - test_server:sleep(random:uniform(20)), - Pid ! {NodeNum,N,Data}, - client_write_loop(Pid,N+1,NodeNum,Data). - -writes(suite) -> []; -writes(Conf) -> - ?line {Cps,{C1,C2,C3}} = start_clients(r,Conf), - ?line write_loop(2*?iterations,{C1,C2,C3},data()), - ?line stop_clients(Cps), - ok. - -write_loop(0,_,_) -> - ok; -write_loop(N,Clients,Data) -> - ?line Dog = test_server:timetrap(test_server:seconds(0.5)), - ?line Client = element(random:uniform(size(Clients)),Clients), - ?line Client ! {node(),N,Data}, - ?line test_server:timetrap_cancel(Dog), - receive - {nodedown,Node} -> - ?line test_server:format(1,"Node ~s went down",[Node]) - after 0 -> - ?line ok - end, - ?line case N rem 100 of - 0 -> io:format("~p writes to go",[N]); - _ -> ok - end, - ?line write_loop(N-1,Clients,Data). - -client_read_loop(N) -> - receive - {Node,Count,{_,123456}} -> - ?line ok; - {Node,Count,Data} -> - ?line io:format("~p(~p): transmission error from node ~p(~p): ~p", - [node(),N,Node,Count,Data]); - Other -> - ?line io:format("~p(~p): got a strange message: ~p", - [node(),N,Other]) - end, - client_read_loop(N+1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/test_server/src/things/mnesia_power_SUITE.erl b/lib/test_server/src/things/mnesia_power_SUITE.erl deleted file mode 100644 index 84a41d6594..0000000000 --- a/lib/test_server/src/things/mnesia_power_SUITE.erl +++ /dev/null @@ -1,126 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(mnesia_power_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include_lib("common_test/include/ct.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [run]. - --define(iterations,3). %% nof power-off cycles to do before acceptance --define(rows,8). %% nof database rows to use (not too big, please) - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --record(sum_table_1,{row,a,b,c,s}). - -run(suite) -> []; -run(Config) -> - ?line mnesia:create_schema([node()]), - ?line mnesia:start(), - ?line mnesia:create_table([{name, sum_table_1}, {disc_copies,[node()]}, - {attributes,record_info(fields,sum_table_1)}]), - ?line run_test(Config,?iterations). - -run(Config,N) -> - ?line mnesia:start(), - ?line check_consistency(sum_table_1), - case N of - 0 -> ?line ok; - N -> ?line run_test(Config,N) - end. - -run_test(Config,N) -> - ?line Pid1a = start_manipulator(sum_table_1), - ?line Pid1b = start_manipulator(sum_table_1), - ?line Pid1c = start_manipulator(sum_table_1), - ?line test_server:resume_point(?MODULE,run,[Config,N-1]), - ?line test_server:format(1,"Manipulating data like crazy now, " - "power off any time..."), - ?line test_server:sleep(infinity). - -start_manipulator(Table) -> - ?line spawn_link(?MODULE,manipulator_init,[Table]). - -manipulator_init(Table) -> - random:seed(4711,0,0), - manipulator(0,Table). - -manipulator(N,Table) -> - ?line Fun = - fun() -> - ?line Row = random:uniform(?rows), - ?line A = random:uniform(100000), - ?line B = random:uniform(100000), - ?line C = random:uniform(100000), - ?line Sum = A+B+C, - ?line case mnesia:write(#sum_table_1 - {row=Row,a=A,b=B,c=C,s=Sum}) of - ok -> ok; - Other -> - ?line io:format("Trans failed: ~p\n",[Other]) - end - end, - ?line mnesia:transaction(Fun), - case mnesia:table_info(sum_table_1,size) of - 0 -> exit(still_empty); - _ -> ok - end, - case N rem 2000 of - 0 -> io:format("~p did ~p operations",[self(),N]), - check_consistency(sum_table_1); - _ -> ok - end, - ?line manipulator(N+1,Table). - -check_consistency(Table) -> - io:format("Checking consistency of table ~p\n",[Table]), - All = mnesia:table_info(Table,wild_pattern), - ?line Fun = - fun() -> - mnesia:match_object(All) - end, - ?line case mnesia:transaction(Fun) of - {atomic,Val} -> - check_consistency_rows(Val,0); - Other -> - io:format("Trans failed: ~p\n",[Other]), - exit(failed), - check_consistency(Table) - end. - -check_consistency_rows([#sum_table_1{a=A,b=B,c=C,s=Sum}|Rows],N) -> - ?line Sum=A+B+C, - ?line check_consistency_rows(Rows,N+1); -check_consistency_rows([],N) -> - io:format("All ~p rows were consistent\n",[N]), - {ok,N}; -check_consistency_rows(Thing,N) -> - io:format("Mnesia transaction returned:\n~p\n",[Thing]), - exit({bad_format,Thing}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - - - - diff --git a/lib/test_server/src/things/random_kill_SUITE.erl b/lib/test_server/src/things/random_kill_SUITE.erl deleted file mode 100644 index 4dc44b108a..0000000000 --- a/lib/test_server/src/things/random_kill_SUITE.erl +++ /dev/null @@ -1,82 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(random_kill_SUITE). --compile([export_all]). -%%-define(line_trace,1). --include_lib("common_test/include/ct.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> [run]. - --define(iterations,25). %% Kill this many processes, - %% possibly with reboots in between - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -run(suite) -> []; -run(Config) -> - registered(?iterations). - -registered(0) -> - ok; -registered(N) -> - random:seed(3461*N,1159*N,351*N), - Pid = select_victim(registered), - test_server:resume_point(?MODULE,registered,[N-1]), - test_server:format("About to kill pid ~p (~p)\n~p", - [Pid,process_info(Pid,registered_name),info(Pid)]), - %%exit(Pid,kill), - registered(N-1). - -info(Pid) -> - Rest0 = tl(pid_to_list(Pid)), - {P1,Rest1} = get_until($.,Rest0), - {P2,Rest2} = get_until($.,Rest1), - {P3,_} = get_until($>,Rest2), - c:i(list_to_integer(P1),list_to_integer(P2),list_to_integer(P3)). - -get_until(Ch,L) -> - get_until(Ch,L,[]). -get_until(Ch,[],Acc) -> - {lists:reverse(Acc),[]}; -get_until(Ch,[Ch|T],Acc) -> - {lists:reverse(Acc),T}; -get_until(Ch,[H|T],Acc) -> - get_until(Ch,T,[H|Acc]). - -select_victim(registered) -> - Pids = - lists:map(fun(Server)-> whereis(Server) end,registered()), - ImmunePids = - [self()|lists:map(fun(Job)-> element(2,Job) end,test_server:jobs())], - SuitablePids = - lists:filter(fun(Pid)-> case lists:member(Pid,ImmunePids) of - true -> false; - false -> true - end - end, Pids), - Selected = random:uniform(length(SuitablePids)), - io:format("Selected ~p if ~p",[Selected,length(SuitablePids)]), - lists:nth(Selected,SuitablePids). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/test_server/src/things/soft.gs.txt b/lib/test_server/src/things/soft.gs.txt deleted file mode 100644 index ec57884997..0000000000 --- a/lib/test_server/src/things/soft.gs.txt +++ /dev/null @@ -1,16 +0,0 @@ -6> gs:start(). -RealTimeViolation, 478ms (after 1164 good) -{1,<0.65.0>} -RealTimeViolation, 352ms (after 0 good) -RealTimeViolation, 492ms (after 0 good) -RealTimeViolation, 166ms (after 0 good) -RealTimeInfo, 18ms (after 7 good) -RealTimeViolation, 115ms (after 13 good) -7> application-specific initialization failed: couldn't connect to display ":0.0" -RealTimeViolation, 20340ms (after 0 good) -gs error: user backend died reason {port_handler,#Port,normal} - -RealTimeInfo, 31ms (after 21 good) -RealTimeInfo, 21ms (after 69 good) -RealTimeInfo, 21ms (after 119 good) -RealTimeInfo, 21ms (after 169 good) diff --git a/lib/test_server/src/things/verify.erl b/lib/test_server/src/things/verify.erl deleted file mode 100644 index b09d0fbda9..0000000000 --- a/lib/test_server/src/things/verify.erl +++ /dev/null @@ -1,200 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(verify). - --export([dir/0, dir/1]). - -%% usage verify:dir() -%% or verify:dir(Dir) -%% -%% runs tests on all files with the extension ".t1" -%% creates an error log file verify.log in the directory where the -%% tests were run - --import(lists, [reverse/1, foldl/3, map/2]). - -dir() -> - dir("."). - -dir(Dir) -> - case file:list_dir(Dir) of - {ok, Files} -> - VFiles = collect_vers(Files, []), - VFiles1 = map(fun(F) -> Dir ++ "/" ++ F end, VFiles), - Nerrs = foldl(fun(F, Sum) -> - case file(F) of - {file,_,had,N,errors} -> - Sum + N; - no_errors -> - Sum; - Other -> - Sum + 1 - end - end, 0, VFiles1), - case Nerrs of - 0 -> no_errors; - _ -> {dir,Dir,had,Nerrs,errors} - end; - _ -> - {error, cannot,list_dir, Dir} - end. - -collect_vers([H|T], L) -> - case reverse(H) of - [$1,$t,$.|T1] -> collect_vers(T, [reverse(T1)|L]); - _ -> collect_vers(T, L) - end; -collect_vers([], L) -> - L. - -file(File) -> - case file:open(File ++ ".t1", read) of - {ok, S} -> - io:format("Verifying: ~s\n", [File]), - ErrFile = File ++ ".errs", - {ok, E} = file:open(ErrFile, write), - Bind0 = erl_eval:new_bindings(), - NErrs = do(S, {E, File, Bind0, 0}, 1), - file:close(S), - file:close(E), - case NErrs of - 0 -> - file:delete(ErrFile), - no_errors; - _ -> - {file,File,had,NErrs,errors} - end; - _ -> - error_in_opening_file - end. - -do(S, Env, Line) -> - R = io:scan_erl_exprs(S, '', Line), - do1(R, S, Env). - -do1({eof,_}, _, {_,_,_,NErrs}) -> - NErrs; -do1({ok,Toks,Next}, S, Env0) -> - E1 = handle_toks(Toks, Next, Env0), - do(S, E1, Next); -do1({error, {Line,Mod,Args}, Next}, S, E) -> - io:format("*** ~w ~p~n", [Line,Mod:format_error(Args)]), - E1 = add_error(E), - do(S, E1, Next). - -add_error({Stream, File, Bindings, N}) -> {Stream, File, Bindings, N+1}. - -handle_toks(Toks, Line, Env0) -> - %% io:format("Toks:~p\n", [Toks]). - case erl_parse:parse_exprs(Toks) of - {ok, Exprs} -> - %% io:format("Got:~p\n", [Exprs]), - eval(Exprs, Line, Env0); - {error, {LineNo, Mod, What}} -> - Str = apply(Mod, format_error, [What]), - io:format("*** Line:~w ***~s\n", [LineNo, Str]), - add_error(Env0); - Parse_error -> - io:format("Parse Error:~p\n",[Parse_error]), - add_error(Env0) - end. - -forget([{var,_,Name}], B0) -> erl_eval:del_binding(Name, B0); -forget([], _) -> erl_eval:new_bindings(). - -eval([{call,_,{atom,_,f}, Args}], _, {Stream, Bind0, Errs}) -> - Bind1 = forget(Args, Bind0), - {Stream, Bind1, Errs}; -eval(Exprs, Line, {Stream, File, Bind0, NErrs}) -> - %% io:format("Bindings >> ~p\n", [Bind0]), - %% io:format("Exprs >> ~p\n", [Exprs]), - case catch erl_eval:exprs(Exprs, Bind0) of - {'EXIT', Reason} -> - out_both(Stream, "----------------------------------~n", []), - out_both(Stream, "File:~s Error in:~s~n", [File, pp(Exprs)]), - print_bindings(Stream, Exprs, Bind0), - print_lhs(Stream, Exprs), - out_both(Stream, '*** Rhs evaluated to:~p~n',[rhs(Exprs, Bind0)]), - {Stream, File, Bind0, NErrs+1}; - {value, _, Bind1} -> - {Stream, File, Bind1, NErrs} - end. - -pp([H]) -> erl_pp:expr(H); -pp([H|T]) -> [erl_pp:expr(H),$,|pp(T)]; -pp([]) -> []. - -print_bindings(E, Form, Bindings) -> - case varsin(Form) of - [] -> - true; - Vars -> - print_vars(E, Vars, Bindings) - end. - -print_vars(E, [Var|T], Bindings) -> - case erl_eval:binding(Var, Bindings) of - {value, Val} -> - out_both(E, '~s = ~p\n',[Var, Val]); - unbound -> - out_both(E, '~s *is unbound*\n', [Var]) - end, - print_vars(E, T, Bindings); -print_vars(_, [], _) -> - true. - - -out_both(E, Format, Data) -> - io:format(Format, Data), - io:format(E, Format, Data). - -print_lhs(E, [{match, _, Lhs, Rhs}]) -> - %% io:format(">>>> here:~w\n",[Lhs]), - out_both(E, '*** Lhs was:~s\n',[erl_pp:expr(Lhs)]); -print_lhs(E, _) -> - out_both(E, '** UNDEFINED **', []). - - -rhs([{match, _, Lhs, Rhs}], Bindings) -> - case catch erl_eval:exprs([Rhs], Bindings) of - {value, Val, _} -> Val; - Other -> undefined() - end; -rhs(_, _) -> - undefined(). - -varsin(X) -> varsin(X, []). - -varsin({var,_,'_'}, L) -> - L; -varsin({var,_,V}, L) -> - case lists:member(V, L) of - true -> L; - false -> [V|L] - end; -varsin([H|T], L) -> - varsin(T, varsin(H, L)); -varsin(T, L) when tuple(T) -> - varsin(tuple_to_list(T), L); -varsin(_, L) -> - L. - -undefined() -> - '** UNDEFINED **'. diff --git a/lib/test_server/src/ts.config b/lib/test_server/src/ts.config deleted file mode 100644 index cf3d269616..0000000000 --- a/lib/test_server/src/ts.config +++ /dev/null @@ -1,46 +0,0 @@ -%% -*- erlang -*- - -%%% Change these to suite the environment. See the inet_SUITE for info about -%%% what they are used for. -%%% test_hosts are looked up using "ypmatch xx yy zz hosts.byname" -%{test_hosts,[my_ip4_host]}. - -%% IPv4 host only - no ipv6 entry must exist! -%{test_host_ipv4_only, -% {"my_ip4_host", %Short hostname -% "my_ip4_host.mydomain.com", %Long hostname -% "10.10.0.1", %IP string -% {10,10,0,1}, %IP tuple -% ["my_ip4_host"], %Any aliases -% "::ffff:10.10.0.1", %IPv6 string (compatibility addr) -% {0,0,0,0,0,65535,2570,1} %IPv6 tuple -% }}. - -%{test_dummy_host, {"dummy", -% "dummy.mydomain.com", -% "192.168.0.1", -% {192,168,0,1}, -% ["dummy"], -% "::ffff:192.168.0.1", -% {0,0,0,0,0,65535,49320,1} -% }}. - - -%%% test_hosts are looked up using "ypmatch xx yy zz ipnodes.byname" -%{ipv6_hosts,[my_ip6_host]}. - - -%{test_host_ipv6_only, -% {"my_ip6_host", %Short hostname -% "my_ip6_host.mydomain.com", %Long hostname -% "::2eff:f2b0:1ea0", %IPv6 string -% {0,0,0,0,0,12031,62128,7840}, %IPv6 tuple -% ["my_ip6_host"] %Aliases. -% }}. - -%{test_dummy_ipv6_host, {"dummy6", -% "dummy6.mydomain.com", -% "127::1", -% {295,0,0,0,0,0,0,1}, -% ["dummy6-ip6"] -% }}. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl deleted file mode 100644 index 8bbdc8f8cf..0000000000 --- a/lib/test_server/src/ts.erl +++ /dev/null @@ -1,1019 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------- -%%% File : ts.erl -%%% Purpose : Frontend for running tests. -%%%------------------------------------------------------------------- - --module(ts). - --export([cl_run/1, - run/0, run/1, run/2, run/3, run/4, run/5, - run_category/1, run_category/2, run_category/3, - tests/0, tests/1, suites/1, categories/1, - install/0, install/1, - estone/0, estone/1, - cross_cover_analyse/1, - compile_testcases/0, compile_testcases/1, - help/0]). - -%% Functions kept for backwards compatibility --export([bench/0, bench/1, bench/2, benchmarks/0, - smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0]). - --export([i/0, l/1, r/0, r/1, r/2, r/3]). - -%%%---------------------------------------------------------------------- -%%% This module, ts, is the interface to all of the functionality of -%%% the TS framework. The picture below shows the relationship of -%%% the modules: -%%% -%%% +-- ts_install --+------ ts_autoconf_win32 -%%% | -%%% ts ---+ +------ ts_erl_config -%%% | | ts_lib -%%% +-- ts_run -----+------ ts_make -%%% | | ts_filelib -%%% | +------ ts_make_erl -%%% | -%%% +-- ts_benchmark -%%% -%%% The modules ts_lib and ts_filelib contains utilities used by -%%% the other modules. -%%% -%%% Module Description -%%% ------ ----------- -%%% ts Frontend to the test server framework. Contains all -%%% interface functions. -%%% ts_install Installs the test suite. On Unix, `autoconf' is -%%% is used; on Windows, ts_autoconf_win32 is used. -%%% The result is written to the file `variables'. -%%% ts_run Supervises running of the tests. -%%% ts_autconf_win32 An `autoconf' for Windows. -%%% ts_autconf_cross_env `autoconf' for other platforms (cross environment) -%%% ts_erl_config Finds out information about the Erlang system, -%%% for instance the location of erl_interface. -%%% This works for either an installed OTP or an Erlang -%%% system running in a git repository/source tree. -%%% ts_make Interface to run the `make' program on Unix -%%% and other platforms. -%%% ts_make_erl A corrected version of the standar Erlang module -%%% make (used for rebuilding test suites). -%%% ts_lib Miscellanous utility functions, each used by several -%%% other modules. -%%% ts_benchmark Supervises otp benchmarks and collects results. -%%%---------------------------------------------------------------------- - --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - --define( - install_help, - [ - " ts:install()\n", - " Install ts with no options.\n", - "\n", - " ts:install(Options)\n", - " Install ts with a list of options, see below.\n", - "\n", - "Installation options supported:\n\n", - " {longnames, true} - Use fully qualified hostnames\n", - " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n" - " quiet(default).\n" - " {crossroot, ErlTop}\n" - " - Erlang root directory on build host, ~n" - " normally same value as $ERL_TOP\n" - " {crossenv, [{Key,Val}]}\n" - " - Environmentals used by test configure on build host\n" - " {crossflags, FlagsString}\n" - " - Flags used by test configure on build host\n" - " {xcomp, XCompFile}\n" - " - The xcomp file to use for cross compiling the~n" - " testcases. Using this option will override any~n" - " cross* configurations given to ts. Note that you~n" - " have to have a correct ERL_TOP as well.~n" - ]). - -help() -> - case filelib:is_file(?variables) of - false -> help(uninstalled); - true -> help(installed) - end. - -help(uninstalled) -> - H = ["ts is not yet installed. To install use:\n\n"], - show_help([H,?install_help]); -help(installed) -> - H = ["\n", - "Run functions:\n\n", - " ts:run()\n", - " Run the tests for all apps. The tests are defined by the\n", - " main test specification for each app: ../App_test/App.spec.\n", - "\n", - " ts:run(Apps)\n", - " Apps = atom() | [atom()]\n", - " Run the tests for an app, or set of apps. The tests are\n", - " defined by the main test specification for each app:\n", - " ../App_test/App.spec.\n", - "\n", - " ts:run(App, Suites)\n", - " App = atom(), Suites = atom() | [atom()]\n", - " Run one or more test suites for App (i.e. modules named\n", - " *_SUITE.erl, located in ../App_test/).\n", - "\n", - " ts:run(App, Suite, TestCases)\n", - " App = atom(), Suite = atom(),\n", - " TestCases = TCs | {testcase,TCs}, TCs = atom() | [atom()]\n", - " Run one or more test cases (functions) in Suite.\n", - "\n", - " ts:run(App, Suite, {group,Groups})\n", - " App = atom(), Suite = atom(), Groups = atom() | [atom()]\n", - " Run one or more test case groups in Suite.\n", - "\n", - " ts:run(App, Suite, {group,Group}, {testcase,TestCases})\n", - " App = atom(), Suite = atom(), Group = atom(),\n", - " TestCases = atom() | [atom()]\n", - " Run one or more test cases in a test case group in Suite.\n", - "\n", - " ts:run_category(TestCategory)\n", - " TestCategory = smoke | essential | bench | atom()\n", - " Run the specified category of tests for all apps.\n", - " For each app, the tests are defined by the specification:\n", - " ../App_test/App_TestCategory.spec.\n", - "\n", - " ts:run_category(Apps, TestCategory)\n", - " Apps = atom() | [atom()],\n", - " TestCategory = smoke | essential | bench | atom()\n", - " Run the specified category of tests for the given app or apps.\n", - "\n", - " Note that the test category parameter may have arbitrary value,\n", - " but should correspond to an existing test specification with file\n", - " name: ../App_test/App_TestCategory.spec.\n", - " Predefined categories exist for smoke tests, essential tests and\n", - " benchmark tests. The corresponding specs are:\n", - " ../*_test/Spec_smoke.spec, ../*_test/Spec_essential.spec and\n", - " ../*_test/Spec_bench.spec.\n", - "\n", - " All above run functions can take an additional last argument,\n", - " Options, which is a list of options (e.g. ts:run(App, Options),\n", - " or ts:run_category(Apps, TestCategory, Options)).\n", - "\n", - "Run options supported:\n\n", - " batch - Do not start a new xterm\n", - " {verbose, Level} - Same as the verbosity option for install\n", - " verbose - Same as {verbose, 1}\n", - " {vars, Vars} - Variables in addition to the 'variables' file\n", - " Can be any of the install options\n", - " {trace, TraceSpec}- Start call trace on target and slave nodes\n", - " TraceSpec is the name of a file containing\n", - " trace specifications or a list of trace\n", - " specification elements.\n", - " {config, Path} - Specify which directory ts should get it's \n" - " config files from. The files should follow\n" - " the convention lib/test_server/src/ts*.config.\n" - " These config files can also be specified by\n" - " setting the TEST_CONFIG_PATH environment\n" - " variable to the directory where the config\n" - " files are. The default location is\n" - " tests/test_server/.\n" - "\n", - "Supported trace information elements:\n\n", - " {tp | tpl, Mod, [] | match_spec()}\n", - " {tp | tpl, Mod, Func, [] | match_spec()}\n", - " {tp | tpl, Mod, Func, Arity, [] | match_spec()}\n", - " {ctp | ctpl, Mod}\n", - " {ctp | ctpl, Mod, Func}\n", - " {ctp | ctpl, Mod, Func, Arity}\n", - "\n\n", - "Support functions:\n\n", - " ts:tests()\n", - " Returns all apps available for testing.\n", - "\n", - " ts:tests(TestCategory)\n", - " Returns all apps that provide tests in the given category.\n", - "\n", - " ts:suites(App)\n", - " Returns all available test suites for App,\n", - " i.e. ../App_test/*_SUITE.erl\n", - "\n", - " ts:categories(App)\n", - " Returns all test categories available for App.\n", - "\n", - " ts:estone()\n", - " Runs estone_SUITE in the kernel application with no run options\n", - "\n", - " ts:estone(Opts)\n", - " Runs estone_SUITE in the kernel application with the given\n", - " run options\n", - "\n", - " ts:cross_cover_analyse(Level)\n", - " Use after ts:run with option cover or cover_details. Analyses\n", - " modules specified with a 'cross' statement in the cover spec file.\n", - " Level can be 'overview' or 'details'.\n", - "\n", - " ts:compile_testcases()\n", - " ts:compile_testcases(Apps)\n", - " Compiles all test cases for the given apps, for usage in a\n", - " cross compilation environment.\n", - "\n\n", - "Installation (already done):\n\n" - ], - show_help([H,?install_help]). - -show_help(H) -> - io:format(lists:flatten(H)). - - -%% Installs tests. -install() -> - ts_install:install(install_local,[]). -install(Options) when is_list(Options) -> - ts_install:install(install_local,Options). - -%% run/0 -%% Runs all specs found by ts:tests(), if any, or returns -%% {error, no_tests_available}. (batch) -run() -> - case ts:tests() of - [] -> - {error, no_tests_available}; - _ -> - check_and_run(fun(Vars) -> run_all(Vars) end) - end. -run_all(_Vars) -> - run_some(tests(), [batch]). - -run_some([], _Opts) -> - ok; -run_some(Apps, Opts) -> - case proplists:get_value(test_category, Opts) of - bench -> - check_and_run(fun(Vars) -> ts_benchmark:run(Apps, Opts, Vars) end); - _Other -> - run_some1(Apps, Opts) - end. - -run_some1([], _Opts) -> - ok; -run_some1([{App,Mod}|Apps], Opts) -> - case run(App, Mod, Opts) of - ok -> ok; - Error -> io:format("~p: ~p~n",[{App,Mod},Error]) - end, - run_some1(Apps, Opts); -run_some1([App|Apps], Opts) -> - case run(App, Opts) of - ok -> ok; - Error -> io:format("~p: ~p~n",[App,Error]) - end, - run_some1(Apps, Opts). - -%% This can be used from command line. Both App and -%% TestCategory must be specified. App may be 'all' -%% and TestCategory may be 'main'. Examples: -%% erl -s ts cl_run kernel smoke -%% erl -s ts cl_run kernel main -%% erl -s ts cl_run all essential -%% erl -s ts cl_run all main -%% When using the 'main' category and running with cover, -%% one can also use the cross_cover_analysis flag. -cl_run([App,Cat|Options0]) when is_atom(App) -> - - AllAtomsFun = fun(X) when is_atom(X) -> true; - (_) -> false - end, - Options1 = - case lists:all(AllAtomsFun, Options0) of - true -> - %% Could be from command line - lists:map(fun(Opt) -> - to_erlang_term(Opt) - end, Options0) -- [batch]; - false -> - Options0 -- [batch] - end, - %% Make sure there is exactly one occurence of 'batch' - Options2 = [batch|Options1], - - Result = - case {App,Cat} of - {all,main} -> - run(tests(), Options2); - {all,Cat} -> - run_category(Cat, Options2); - {_,main} -> - run(App, Options2); - {_,Cat} -> - run_category(App, Cat, Options2) - end, - case check_for_cross_cover_analysis_flag(Options2) of - false -> - ok; - Level -> - cross_cover_analyse(Level) - end, - Result. - -%% run/1 -%% Runs tests for one app (interactive). -run(App) when is_atom(App) -> - Options = check_test_get_opts(App, []), - File = atom_to_list(App), - run_test(File, [{spec,[File++".spec"]},{allow_user_terms,true}], Options); - -%% This can be used from command line, e.g. -%% erl -s ts run all -%% erl -s ts run main -run([all,main|Opts]) -> - cl_run([all,main|Opts]); -run([all|Opts]) -> - cl_run([all,main|Opts]); -run([main|Opts]) -> - cl_run([all,main|Opts]); -%% Backwards compatible -run([all_tests|Opts]) -> - cl_run([all,main|Opts]); - -%% run/1 -%% Runs the main tests for all available apps -run(Apps) when is_list(Apps) -> - run(Apps, [batch]). - -%% run/2 -%% Runs the main tests for all available apps -run(Apps, Opts) when is_list(Apps), is_list(Opts) -> - run_some(Apps, Opts); - -%% Runs tests for one app with list of suites or with options -run(App, ModsOrOpts) when is_atom(App), - is_list(ModsOrOpts) -> - case is_list_of_suites(ModsOrOpts) of - false -> - run(App, {opts_list,ModsOrOpts}); - true -> - run_some([{App,M} || M <- ModsOrOpts], - [batch]) - end; - -run(App, {opts_list,Opts}) -> - Options = check_test_get_opts(App, Opts), - File = atom_to_list(App), - - %% check if other test category than main has been specified - {CatSpecName,TestCat} = - case proplists:get_value(test_category, Opts) of - undefined -> - {"",main}; - Cat -> - {"_" ++ atom_to_list(Cat),Cat} - end, - - WhatToDo = - case App of - %% Known to exist but fails generic tests below - emulator -> test; - system -> test; - erl_interface -> test; - epmd -> test; - _ -> - case code:lib_dir(App) of - {error,bad_name} -> - %% Application does not exist - skip; - Path -> - case file:read_file_info(filename:join(Path,"ebin")) of - {ok,#file_info{type=directory}} -> - %% Erlang application is built - test; - _ -> - case filelib:wildcard( - filename:join([Path,"priv","*.jar"])) of - [] -> - %% The application is not built - skip; - [_|_] -> - %% Java application is built - test - end - end - end - end, - case WhatToDo of - skip -> - SkipSpec = create_skip_spec(App, suites(App)), - run_test(File, [{spec,[SkipSpec]}], Options); - test when TestCat == bench -> - check_and_run(fun(Vars) -> - ts_benchmark:run([App], Options, Vars) - end); - test -> - Spec = File ++ CatSpecName ++ ".spec", - run_test(File, [{spec,[Spec]},{allow_user_terms,true}], Options) - end; - -%% Runs one module for an app (interactive) -run(App, Mod) when is_atom(App), is_atom(Mod) -> - run_test({atom_to_list(App),Mod}, - [{suite,Mod}], - [interactive]). - -%% run/3 -%% Run one module for an app with Opts -run(App, Mod, Opts) when is_atom(App), - is_atom(Mod), - is_list(Opts) -> - Options = check_test_get_opts(App, Opts), - run_test({atom_to_list(App),Mod}, - [{suite,Mod}], Options); - -%% Run multiple modules with Opts -run(App, Mods, Opts) when is_atom(App), - is_list(Mods), - is_list(Opts) -> - run_some([{App,M} || M <- Mods], Opts); - -%% Runs one test case in a module. -run(App, Mod, Case) when is_atom(App), - is_atom(Mod), - is_atom(Case) -> - Options = check_test_get_opts(App, []), - Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(App), Args, Options); - -%% Runs one or more groups in a module. -run(App, Mod, Grs={group,_Groups}) when is_atom(App), - is_atom(Mod) -> - Options = check_test_get_opts(App, []), - Args = [{suite,Mod},Grs], - run_test(atom_to_list(App), Args, Options); - -%% Runs one or more test cases in a module. -run(App, Mod, TCs={testcase,_Cases}) when is_atom(App), - is_atom(Mod) -> - Options = check_test_get_opts(App, []), - Args = [{suite,Mod},TCs], - run_test(atom_to_list(App), Args, Options). - -%% run/4 -%% Run one test case in a module with Options. -run(App, Mod, Case, Opts) when is_atom(App), - is_atom(Mod), - is_atom(Case), - is_list(Opts) -> - Options = check_test_get_opts(App, Opts), - Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(App), Args, Options); - -%% Run one or more test cases in a module with Options. -run(App, Mod, {testcase,Cases}, Opts) when is_atom(App), - is_atom(Mod) -> - run(App, Mod, Cases, Opts); -run(App, Mod, Cases, Opts) when is_atom(App), - is_atom(Mod), - is_list(Cases), - is_list(Opts) -> - Options = check_test_get_opts(App, Opts), - Args = [{suite,Mod},Cases], - run_test(atom_to_list(App), Args, Options); - -%% Run one or more test cases in a group. -run(App, Mod, Gr={group,_Group}, {testcase,Cases}) when is_atom(App), - is_atom(Mod) -> - run(App, Mod, Gr, Cases, [batch]); - - -%% Run one or more groups in a module with Options. -run(App, Mod, Grs={group,_Groups}, Opts) when is_atom(App), - is_atom(Mod), - is_list(Opts) -> - Options = check_test_get_opts(App, Opts), - Args = [{suite,Mod},Grs], - run_test(atom_to_list(App), Args, Options). - -%% run/5 -%% Run one or more test cases in a group with Options. -run(App, Mod, Group, Cases, Opts) when is_atom(App), - is_atom(Mod), - is_list(Opts) -> - 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(App, Opts), - Args = [{suite,Mod},Group1,Cases1], - run_test(atom_to_list(App), Args, Options). - -%% run_category/1 -run_category(TestCategory) when is_atom(TestCategory) -> - run_category(TestCategory, [batch]). - -%% run_category/2 -run_category(TestCategory, Opts) when is_atom(TestCategory), - is_list(Opts) -> - case ts:tests(TestCategory) of - [] -> - {error, no_tests_available}; - Apps -> - Opts1 = [{test_category,TestCategory} | Opts], - run_some(Apps, Opts1) - end; - -run_category(Apps, TestCategory) when is_atom(TestCategory) -> - run_category(Apps, TestCategory, [batch]). - -%% run_category/3 -run_category(App, TestCategory, Opts) -> - Apps = if is_atom(App) -> [App]; - is_list(App) -> App - end, - Opts1 = [{test_category,TestCategory} | Opts], - run_some(Apps, Opts1). - -%%----------------------------------------------------------------- -%% Functions kept for backwards compatibility - -bench() -> - run_category(bench, []). -bench(Opts) when is_list(Opts) -> - run_category(bench, Opts); -bench(App) -> - run_category(App, bench, []). -bench(App, Opts) when is_atom(App) -> - run_category(App, bench, Opts); -bench(Apps, Opts) when is_list(Apps) -> - run_category(Apps, bench, Opts). - -benchmarks() -> - tests(bench). - -smoke_test() -> - run_category(smoke, []). -smoke_test(Opts) when is_list(Opts) -> - run_category(smoke, Opts); -smoke_test(App) -> - run_category(App, smoke, []). -smoke_test(App, Opts) when is_atom(App) -> - run_category(App, smoke, Opts); -smoke_test(Apps, Opts) when is_list(Apps) -> - run_category(Apps, smoke, Opts). - -smoke_tests() -> - tests(smoke). - -%%----------------------------------------------------------------- - -is_list_of_suites(List) -> - lists:all(fun(Suite) -> - S = if is_atom(Suite) -> atom_to_list(Suite); - true -> Suite - end, - try lists:last(string:tokens(S,"_")) of - "SUITE" -> true; - "suite" -> true; - _ -> false - catch - _:_ -> false - end - end, List). - -%% Create a spec to skip all SUITES, this is used when the application -%% to be tested is not part of the OTP release to be tested. -create_skip_spec(App, SuitesToSkip) -> - {ok,Cwd} = file:get_cwd(), - AppString = atom_to_list(App), - Specname = AppString++"_skip.spec", - {ok,D} = file:open(filename:join([filename:dirname(Cwd), - AppString++"_test",Specname]), - [write]), - TestDir = "\"../"++AppString++"_test\"", - io:format(D,"{suites, "++TestDir++", all}.~n",[]), - io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application" - " is not in path!\"}.",[SuitesToSkip]), - Specname. - -%% Check testspec for App to be valid and get possible options -%% from the list. -check_test_get_opts(App, Opts) -> - validate_test(App), - Mode = configmember(batch, {batch, interactive}, Opts), - Vars = configvars(Opts), - Trace = get_config(trace,Opts), - ConfigPath = get_config(config,Opts), - KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Opts), - Cover = configcover(App,Opts), - lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). - -to_erlang_term(Atom) -> - String = atom_to_list(Atom), - {ok, Tokens, _} = erl_scan:string(lists:append([String, ". "])), - {ok, Term} = erl_parse:parse_term(Tokens), - Term. - -%% Validate that Testspec really is a testspec, -%% and exit if not. -validate_test(Testspec) -> - case lists:member(Testspec, tests()) of - true -> - ok; - false -> - io:format("This testspec does not seem to be " - "available.~n Please try ts:tests() " - "to see available tests.~n"), - exit(self(), {error, test_not_available}) - end. - -configvars(Opts) -> - case lists:keysearch(vars, 1, Opts) of - {value, {vars, List}} -> - List0 = special_vars(Opts), - Key = fun(T) -> element(1,T) end, - DelDupList = - lists:filter(fun(V) -> - case lists:keysearch(Key(V),1,List0) of - {value,_} -> false; - _ -> true - end - end, List), - {vars, [List0|DelDupList]}; - _ -> - {vars, special_vars(Opts)} - end. - -%% Allow some shortcuts in the options... -special_vars(Opts) -> - SpecVars = - case lists:member(verbose, Opts) of - true -> - [{verbose, 1}]; - false -> - case lists:keysearch(verbose, 1, Opts) of - {value, {verbose, Lvl}} -> - [{verbose, Lvl}]; - _ -> - [{verbose, 0}] - end - end, - SpecVars1 = - case lists:keysearch(diskless, 1, Opts) of - {value,{diskless, true}} -> - [{diskless, true} | SpecVars]; - _ -> - SpecVars - end, - case lists:keysearch(testcase_callback, 1, Opts) of - {value,{testcase_callback, CBM, CBF}} -> - [{ts_testcase_callback, {CBM,CBF}} | SpecVars1]; - {value,{testcase_callback, CB}} -> - [{ts_testcase_callback, CB} | SpecVars1]; - _ -> - SpecVars1 - end. - -get_config(Key,Config) -> - case lists:keysearch(Key,1,Config) of - {value,Value} -> Value; - false -> [] - end. - -configcover(Testspec,[cover|_]) -> - {cover,Testspec,default_coverfile(Testspec),overview}; -configcover(Testspec,[cover_details|_]) -> - {cover,Testspec,default_coverfile(Testspec),details}; -configcover(Testspec,[{cover,File}|_]) -> - {cover,Testspec,File,overview}; -configcover(Testspec,[{cover_details,File}|_]) -> - {cover,Testspec,File,details}; -configcover(Testspec,[_H|T]) -> - configcover(Testspec,T); -configcover(_Testspec,[]) -> - []. - -default_coverfile(Testspec) -> - {ok,Cwd} = file:get_cwd(), - CoverFile = filename:join([filename:dirname(Cwd), - atom_to_list(Testspec)++"_test", - atom_to_list(Testspec)++".cover"]), - case filelib:is_file(CoverFile) of - true -> - CoverFile; - false -> - none - end. - -configmember(Member, {True, False}, Config) -> - case lists:member(Member, Config) of - true -> - True; - false -> - False - end. - - -check_for_cross_cover_analysis_flag(Config) -> - check_for_cross_cover_analysis_flag(Config,false,false). -check_for_cross_cover_analysis_flag([cover|Config],false,false) -> - check_for_cross_cover_analysis_flag(Config,overview,false); -check_for_cross_cover_analysis_flag([cover|_Config],false,true) -> - overview; -check_for_cross_cover_analysis_flag([cover_details|Config],false,false) -> - check_for_cross_cover_analysis_flag(Config,details,false); -check_for_cross_cover_analysis_flag([cover_details|_Config],false,true) -> - details; -check_for_cross_cover_analysis_flag([cross_cover_analysis|Config],false,_) -> - check_for_cross_cover_analysis_flag(Config,false,true); -check_for_cross_cover_analysis_flag([cross_cover_analysis|_Config],Level,_) -> - Level; -check_for_cross_cover_analysis_flag([_|Config],Level,CrossFlag) -> - check_for_cross_cover_analysis_flag(Config,Level,CrossFlag); -check_for_cross_cover_analysis_flag([],_,_) -> - false. - - -%% Returns all available apps. -tests() -> - {ok, Cwd} = file:get_cwd(), - ts_lib:specs(Cwd). - -%% Returns all apps that provide tests in the given test category -tests(main) -> - {ok, Cwd} = file:get_cwd(), - ts_lib:specs(Cwd); -tests(bench) -> - ts_benchmark:benchmarks(); -tests(TestCategory) -> - {ok, Cwd} = file:get_cwd(), - ts_lib:specialized_specs(Cwd, atom_to_list(TestCategory)). - -%% Returns a list of available test suites for App. -suites(App) -> - {ok, Cwd} = file:get_cwd(), - ts_lib:suites(Cwd, atom_to_list(App)). - -%% Returns all available test categories for App -categories(App) -> - {ok, Cwd} = file:get_cwd(), - ts_lib:test_categories(Cwd, atom_to_list(App)). - -%% -%% estone/0, estone/1 -%% Opts = same as Opts or Config for the run(...) function, -%% e.g. [batch] -%% -estone() -> run(emulator,estone_SUITE). -estone(Opts) when is_list(Opts) -> run(emulator,estone_SUITE,Opts). - -%% -%% cross_cover_analyse/1 -%% Level = details | overview -%% Can be called on any node after a test (with cover) is -%% completed. The node's current directory must be the same as when -%% the tests were run. -%% -cross_cover_analyse([Level]) -> - cross_cover_analyse(Level); -cross_cover_analyse(Level) -> - Apps = get_last_app_tests(), - test_server_ctrl:cross_cover_analyse(Level,Apps). - -get_last_app_tests() -> - AllTests = filelib:wildcard(filename:join(["*","*_test.logs"])), - {ok,RE} = re:compile("^[^/]*/[^\.]*\.(.*)_test\.logs$"), - get_last_app_tests(AllTests,RE,[]). - -get_last_app_tests([Dir|Dirs],RE,Acc) -> - NewAcc = - case re:run(Dir,RE,[{capture,all,list}]) of - {match,[Dir,AppStr]} -> - Dir1 = filename:dirname(Dir), % cover logs in ct_run. dir - App = list_to_atom(AppStr), - case lists:keytake(App,1,Acc) of - {value,{App,LastDir},Rest} -> - if Dir1 > LastDir -> - [{App,Dir1}|Rest]; - true -> - Acc - end; - false -> - [{App,Dir1} | Acc] - end; - _ -> - Acc - end, - get_last_app_tests(Dirs,RE,NewAcc); -get_last_app_tests([],_,Acc) -> - Acc. - -%%% Implementation. - -check_and_run(Fun) -> - case file:consult(?variables) of - {ok, Vars} -> - check_and_run(Fun, Vars); - {error, Error} when is_atom(Error) -> - {error, not_installed}; - {error, Reason} -> - {error, {bad_installation, file:format_error(Reason)}} - end. - -check_and_run(Fun, Vars) -> - Platform = ts_install:platform_id(Vars), - case lists:keysearch(platform_id, 1, Vars) of - {value, {_, Platform}} -> - case catch apply(Fun, [Vars]) of - {'EXIT', Reason} -> - exit(Reason); - Other -> - Other - end; - {value, {_, OriginalPlatform}} -> - io:format("These test suites were installed for '~s'.\n", - [OriginalPlatform]), - io:format("But the current platform is '~s'.\nPlease " - "install for this platform before running " - "any tests.\n", [Platform]), - {error, inconsistent_platforms}; - false -> - {error, {bad_installation, no_platform}} - end. - -run_test(File, Args, Options) -> - check_and_run(fun(Vars) -> run_test(File, Args, Options, Vars) end). - -run_test(File, Args, Options, Vars) -> - ts_run:run(File, Args, Options, Vars). - - -%% This module provides some convenient shortcuts to running -%% the test server from within a started Erlang shell. -%% (This are here for backwards compatibility.) -%% -%% r() -%% r(Opts) -%% r(SpecOrMod) -%% r(SpecOrMod, Opts) -%% r(Mod, Case) -%% r(Mod, Case, Opts) -%% Each of these functions starts the test server if it -%% isn't already running, then runs the test case(s) selected -%% by the aguments. -%% SpecOrMod can be a module name or the name of a test spec file, -%% with the extension .spec or .spec.OsType. The module Mod will -%% be reloaded before running the test cases. -%% Opts = [Opt], -%% Opt = {Cover,AppOrCoverFile} | {Cover,App,CoverFile} -%% Cover = cover | cover_details -%% AppOrCoverFile = App | CoverFile -%% App = atom(), an application name -%% CoverFile = string(), name of a cover file -%% (see doc of test_server_ctrl:cover/2/3) -%% -%% i() -%% Shows information about the jobs being run, by dumping -%% the process information for the test_server. -%% -%% l(Mod) -%% This function reloads a module just like c:l/1, but works -%% even for a module in one of the sticky library directories -%% (for instance, lists can be reloaded). - -%% Runs all tests cases in the current directory. - -r() -> - r([]). -r(Opts) when is_list(Opts), is_atom(hd(Opts)) -> - ensure_ts_started(Opts), - test_server_ctrl:add_dir("current_dir", "."); - -%% Checks if argument is a spec file or a module -%% (spec file must be named "*.spec" or "*.spec.OsType") -%% If module, reloads module and runs all test cases in it. -%% If spec, runs all test cases in it. - -r(SpecOrMod) -> - r(SpecOrMod,[]). -r(SpecOrMod,Opts) when is_list(Opts) -> - ensure_ts_started(Opts), - case filename:extension(SpecOrMod) of - [] -> - l(SpecOrMod), - test_server_ctrl:add_module(SpecOrMod); - ".spec" -> - test_server_ctrl:add_spec(SpecOrMod); - _ -> - Spec2 = filename:rootname(SpecOrMod), - case filename:extension(Spec2) of - ".spec" -> - %% *.spec.Type - test_server_ctrl:add_spec(SpecOrMod); - _ -> - {error, unknown_filetype} - end - end; - -%% Reloads the given module and runs the given test case in it. - -r(Mod, Case) -> - r(Mod,Case,[]). -r(Mod, Case, Opts) -> - ensure_ts_started(Opts), - l(Mod), - test_server_ctrl:add_case(Mod, Case). - -%% Shows information about the jobs being run. - -i() -> - ensure_ts_started([]), - hformat("Job", "Current", "Total", "Success", "Failed", "Skipped"), - i(test_server_ctrl:jobs()). - -i([{Name, Pid}|Rest]) when is_pid(Pid) -> - {dictionary, PI} = process_info(Pid, dictionary), - {value, {_, CaseNum}} = lists:keysearch(test_server_case_num, 1, PI), - {value, {_, Cases}} = lists:keysearch(test_server_cases, 1, PI), - {value, {_, Failed}} = lists:keysearch(test_server_failed, 1, PI), - {value, {_, {UserSkipped,AutoSkipped}}} = lists:keysearch(test_server_skipped, 1, PI), - {value, {_, Ok}} = lists:keysearch(test_server_ok, 1, PI), - nformat(Name, CaseNum, Cases, Ok, Failed, UserSkipped+AutoSkipped), - i(Rest); -i([]) -> - ok. - -hformat(A1, A2, A3, A4, A5, A6) -> - io:format("~-20s ~8s ~8s ~8s ~8s ~8s~n", [A1,A2,A3,A4,A5,A6]). - -nformat(A1, A2, A3, A4, A5, A6) -> - io:format("~-20s ~8w ~8w ~8w ~8w ~8w~n", [A1,A2,A3,A4,A5,A6]). - -%% Force load of a module even if it is in a sticky directory. - -l(Mod) -> - case do_load(Mod) of - {error, sticky_directory} -> - Dir = filename:dirname(code:which(Mod)), - code:unstick_dir(Dir), - do_load(Mod), - code:stick_dir(Dir); - X -> - X - end. - - -ensure_ts_started(Opts) -> - Pid = case whereis(test_server_ctrl) of - undefined -> - test_server_ctrl:start(); - P when is_pid(P) -> - P - end, - case Opts of - [{Cover,AppOrCoverFile}] when Cover==cover; Cover==cover_details -> - test_server_ctrl:cover(AppOrCoverFile,cover_type(Cover)); - [{Cover,App,CoverFile}] when Cover==cover; Cover==cover_details -> - test_server_ctrl:cover(App,CoverFile,cover_type(Cover)); - _ -> - ok - end, - Pid. - -cover_type(cover) -> overview; -cover_type(cover_details) -> details. - -do_load(Mod) -> - code:purge(Mod), - code:load_file(Mod). - - -compile_testcases() -> - compile_datadirs("../*/*_data"). - -compile_testcases(App) when is_atom(App) -> - compile_testcases([App]); -compile_testcases([App | T]) -> - compile_datadirs(io_lib:format("../~s_test/*_data", [App])), - compile_testcases(T); -compile_testcases([]) -> - ok. - -compile_datadirs(DataDirs) -> - {ok,Variables} = file:consult("variables"), - - lists:foreach(fun(Dir) -> - ts_lib:make_non_erlang(Dir, Variables) - end, - filelib:wildcard(DataDirs)). diff --git a/lib/test_server/src/ts.hrl b/lib/test_server/src/ts.hrl deleted file mode 100644 index 4c940fdc4f..0000000000 --- a/lib/test_server/src/ts.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% Defines ripped out from test_server (these must remain the same -%% as in test_server). - --define(logdir_ext, ".logs"). --define(suitelog_name, "suite.log"). --define(last_file, "last_name"). --define(last_link, "last_link"). --define(last_test, "last_test"). --define(run_summary, "suite.summary"). --define(cover_total,"total_cover.log"). --define(variables, "variables"). --define(cross_variables, "variables-cross"). --define(LF, [10]). % Newline in VxWorks script --define(CHAR_PER_LINE, 60). % Characters per VxWorks script building line --define(CROSS_COOKIE, "cross"). % cookie used when cross platform testing --define(TS_PORT, 7887). --define(TEST_SERVER_SCRIPT, "test_server_vx.script"). - diff --git a/lib/test_server/src/ts.unix.config b/lib/test_server/src/ts.unix.config deleted file mode 100644 index 1ba5d9033e..0000000000 --- a/lib/test_server/src/ts.unix.config +++ /dev/null @@ -1,6 +0,0 @@ -%% -*- erlang -*- - -%% Always run a (VNC) X server on host -%% {xserver, "xserver.example.com:66"}. - -{unix,[{telnet,"belegost"},{username,"telnet-test"},{password,"tset-tenlet"},{keep_alive,true}]}. diff --git a/lib/test_server/src/ts.win32.config b/lib/test_server/src/ts.win32.config deleted file mode 100644 index cae587bea8..0000000000 --- a/lib/test_server/src/ts.win32.config +++ /dev/null @@ -1,8 +0,0 @@ -%% -*- erlang -*- - -%%% There is no equivalent command to ypmatch on Win32... :-( -%{hardcoded_hosts, -% [{"127.0.0.1","localhost"}]}. - -%{hardcoded_ipv6_hosts, -% [{"::1","localhost"}]}. diff --git a/lib/test_server/src/ts_autoconf_win32.erl b/lib/test_server/src/ts_autoconf_win32.erl deleted file mode 100644 index 288305b406..0000000000 --- a/lib/test_server/src/ts_autoconf_win32.erl +++ /dev/null @@ -1,256 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Autoconf for Windows. - --module(ts_autoconf_win32). --export([configure/0]). - --include("ts.hrl"). - -configure() -> - case variables() of - {ok, Vars} -> - ts_lib:subst_file("conf_vars.in", "conf_vars", Vars); - Error -> - Error - end. - -variables() -> - run_tests(tests(), []). - -run_tests([{Prompt, Tester}|Rest], Vars) -> - io:format("checking ~s... ", [Prompt]), - case catch Tester(Vars) of - {'EXIT', Reason} -> - io:format("FAILED~nExit status: ~p~n", [Reason]), - {error, auto_conf_failed}; - {Result, NewVars} -> - io:format("~s~n", [lists:concat([Result])]), - run_tests(Rest, NewVars) - end; -run_tests([], Vars) -> - {ok, Vars}. - -%%% The tests. - -tests() -> - [{"host system type", fun system_type/1}, - {"CPU type", fun cpu/1}, - {"for C compiler", fun c_compiler/1}, - {"for make program", fun make/1}, - {"for location of SSL libraries", fun ssl/1}, - {"for location of Java compiler", fun javac/1}]. - -system_type(Vars) -> - Os = case os:type() of - {win32, nt} -> - case os:version() of - {4,_,_} -> "Windows NT"; - {5,0,_} -> "Windows 2000"; - {5,1,_} -> "Windows XP"; - {5,2,_} -> "Windows 2003"; - {6,0,_} -> "Windows Vista"; - {6,1,_} -> "Windows 7"; - {_,_,_} -> "Windows NCC-1701-D" - end; - {win32, windows} -> - case os:version() of - {4,0,_} -> "Windows 95"; - {4,10,_} -> "Windows 98" - end; - {win32, _} -> "Windows" - end, - {Os, [{host_os, Os}, {host, "win32"}|Vars]}. - -cpu(Vars) -> - Arch = os:getenv("PROCESSOR_ARCHITECTURE"), - Level0 = os:getenv("PROCESSOR_Level"), - Cpu = case {Arch, Level0} of - {"x86", Level} when is_list(Level) -> - "i" ++ Level ++ "86"; - {Other, _Level} when is_list(Other) -> - Other; - {false, _} -> - "i386" - end, - {Cpu, [{host_cpu, Cpu}|Vars]}. - -c_compiler(Vars) -> - try - CompTests = [{msc, fun visual_cxx/1}, - {gnuc, fun mingw32/1}], - %% First try to find the same compiler that the system - %% was built with... - UsedCompiler = case erlang:system_info(c_compiler_used) of - {UsedCmplr, _} -> - case lists:keysearch(UsedCmplr, 1, CompTests) of - {value, {UsedCmplr, CompTest}} -> - CompTest(Vars); - _ -> - ok - end, - UsedCmplr; - undefined -> - undefined - end, - %% ... then try to find a compiler... - lists:foreach(fun ({Cmplr, _CmplrTst}) when Cmplr =:= UsedCompiler -> - ok; % Have already checked for this one - ({_Cmplr, CmplrTst}) -> - CmplrTst(Vars) - end, - CompTests), - {no, Vars} - catch - throw:{_Path, _NewVars} = Res -> Res - end. - -visual_cxx(Vars) -> - case os:find_executable("cl") of - false -> - {no, Vars}; - Path when is_list(Path) -> - {DEFAULT_THR_LIB, - ERTS_THR_LIB, - DLL, - DBG_LINK, - DBG_COMP, - OPT} = - case is_debug_build() of - true -> - {"-MTd ", - "-MDd ", - "-LDd ", - "-debug -pdb:none ", - "-Z7 -DDEBUG", - " "}; - false -> - {"-MT ", - "-MD ", - "-LD ", - " ", - " ", - "-Ox "} - end, - WIN32 = "-D__WIN32__ ", - ERTS_CFLAGS = ERTS_THR_LIB ++ WIN32 ++ OPT ++ DBG_COMP, - LIBS = "ws2_32.lib", - CC = "cl -nologo", - throw({Path, [{'CC', CC}, - {'LD', CC}, - {'SHLIB_LD', CC}, - {'SHLIB_LDFLAGS', ERTS_THR_LIB ++ DLL}, - {'SHLIB_LDLIBS', "-link " ++ DBG_LINK ++ "kernel32.lib"}, - {'SHLIB_EXTRACT_ALL', ""}, - {'CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP}, - {'EI_CFLAGS', DEFAULT_THR_LIB ++ WIN32 ++ DBG_COMP}, - {'ERTS_CFLAGS', ERTS_CFLAGS}, - {'SHLIB_CFLAGS', ERTS_CFLAGS++DLL}, - {'CROSSLDFLAGS', ""}, - {'DEFS', common_c_defs()}, - {'SHLIB_SUFFIX', ".dll"}, - {'ERTS_LIBS', ERTS_THR_LIB ++ LIBS}, - {'LIBS', DEFAULT_THR_LIB ++ "-link " ++ DBG_LINK ++ LIBS}, - {obj,".obj"}, - {exe, ".exe"}, - {test_c_compiler, "{msc, undefined}"} - | Vars]}) - end. - -mingw32(Vars) -> - Gcc = "mingw32-gcc", - case os:find_executable(Gcc) of - false -> - {no, Vars}; - Path when is_list(Path) -> - {DBG_COMP, - OPT} = - case is_debug_build() of - true -> - {"-DDEBUG", - " "}; - false -> - {" ", - "-O2 "} - end, - WIN32 = "-D__WIN32__ ", - ERTS_CFLAGS = WIN32 ++ "-g " ++ OPT ++ DBG_COMP, - LIBS = "-lws2_32", - CC = Gcc, - throw({Path, [{'CC', CC}, - {'LD', CC}, - {'SHLIB_LD', CC}, - {'SHLIB_LDFLAGS', "-shared "}, - {'SHLIB_LDLIBS', " -lkernel32"}, - {'SHLIB_EXTRACT_ALL', ""}, - {'CFLAGS', WIN32 ++ DBG_COMP}, - {'EI_CFLAGS', WIN32 ++ DBG_COMP}, - {'ERTS_CFLAGS', ERTS_CFLAGS}, - {'SHLIB_CFLAGS', ERTS_CFLAGS}, - {'CROSSLDFLAGS', ""}, - {'DEFS', common_c_defs()}, - {'SHLIB_SUFFIX', ".dll"}, - {'ERTS_LIBS', LIBS}, - {'LIBS', LIBS}, - {obj,".o"}, - {exe, ".exe"}, - {test_c_compiler, "{gnuc, undefined}"} - | Vars]}) - end. - -common_c_defs() -> - "-DHAVE_STRERROR=1". - -make(Vars) -> - try - find_make("nmake -nologo", Vars), - find_make("mingw32-make", Vars) - catch - throw:{_Path, _NewVars} = Res -> Res - end. - -find_make(MakeCmd, Vars) -> - [Make|_] = string:tokens(MakeCmd, " \t"), - case os:find_executable(Make) of - false -> - {no, Vars}; - Path when is_list(Path) -> - throw({Path, [{make_command, MakeCmd} | Vars]}) - end. - -ssl(Vars) -> - {"win32",[{'SSLEAY_ROOT',"win32"}|Vars]}. - -javac(Vars) -> - case os:find_executable("javac") of - false -> - {no, Vars}; - Path when is_list(Path) -> - {Path, [{'JAVAC', "javac"} | Vars]} - end. - -is_debug_build() -> - case catch string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> - true; - _ -> - false - end. diff --git a/lib/test_server/src/ts_benchmark.erl b/lib/test_server/src/ts_benchmark.erl deleted file mode 100644 index 3e55edefb0..0000000000 --- a/lib/test_server/src/ts_benchmark.erl +++ /dev/null @@ -1,87 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ts_benchmark). - --include_lib("common_test/include/ct_event.hrl"). --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - --export([benchmarks/0, - run/3]). - -%% gen_event callbacks --export([init/1, handle_event/2]). - -benchmarks() -> - {ok, Cwd} = file:get_cwd(), - ts_lib:specialized_specs(Cwd,"bench"). - -run(Specs, Opts, Vars) -> - {ok, Cwd} = file:get_cwd(), - {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(), - BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]), - BDir = filename:join([Cwd,BName]), - file:make_dir(BDir), - [ts_run:run(atom_to_list(Spec), - [{spec, [atom_to_list(Spec)++"_bench.spec"]}], - [{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars) - || Spec <- Specs], - file:delete(filename:join(Cwd,"latest_benchmark")), - {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]), - io:format(D,BDir,[]), - file:close(D). - - -%%%=================================================================== -%%% gen_event callbacks -%%%=================================================================== - --record(state, { spec, suite, tc, stats_dir}). - -init([Spec,Dir]) -> - {ok, #state{ spec = Spec, stats_dir = Dir }}. - -handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) -> - {ok,State#state{ suite = Suite, tc = Tc}}; -handle_event(#event{name = benchmark_data, data = Data}, State) -> - Spec = proplists:get_value(application, Data, State#state.spec), - Suite = proplists:get_value(suite, Data, State#state.suite), - Tc = proplists:get_value(name, Data, State#state.tc), - Value = proplists:get_value(value, Data), - {ok, D} = file:open(filename:join( - [State#state.stats_dir, - lists:concat([e(Spec),"-",e(Suite),"-", - e(Tc),".ebench"])]), - [append]), - io:format(D, "~p~n",[Value]), - file:close(D), - {ok, State}; -handle_event(_Event, State) -> - {ok, State}. - - -e(Atom) when is_atom(Atom) -> - Atom; -e(Str) when is_list(Str) -> - lists:map(fun($/) -> - $\\; - (C) -> - C - end,Str). diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl deleted file mode 100644 index ab7363c106..0000000000 --- a/lib/test_server/src/ts_erl_config.erl +++ /dev/null @@ -1,403 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Updates variable list with variables depending on -%%% running Erlang system. - --module(ts_erl_config). - - --export([variables/2]). - -%% Returns a list of key, value pairs. - -variables(Base0, OsType) -> - Base1 = erl_include(Base0), - Base2 = get_app_vars(fun erl_interface/2, Base1, OsType), - Base3 = get_app_vars(fun ic/2, Base2, OsType), - Base4 = get_app_vars(fun jinterface/2, Base3, OsType), - Base5 = dl_vars(Base4, Base3, OsType), - Base6 = emu_vars(Base5), - Base7 = get_app_vars(fun ssl/2, Base6, OsType), - Base8 = erts_lib(Base7, OsType), - Base = separators(Base8, OsType), - [{'EMULATOR', tl(code:objfile_extension())}, - {emu_threads, atom_to_list(erlang:system_info(threads))}, - {type_marker, case is_debug_build() of - true -> - ".debug"; - false -> - "" - end} - | Base]. - -get_app_vars(AppFun, Vars, OsType) -> - case catch AppFun(Vars,OsType) of - Res when is_list(Res) -> - Res; - {cannot_find_app, App} -> - io:format("* WARNING: Cannot find ~p!~n", [App]), - Vars; - {'EXIT', Reason} -> - exit(Reason); - Garbage -> - exit({unexpected_internal_error, Garbage}) - end. - -dl_vars(Vars, Base3, OsType) -> - ShlibRules0 = ".SUFFIXES:\n" ++ - ".SUFFIXES: @dll@ @obj@ .c\n\n" ++ - ".c@dll@:\n" ++ - "\t@CC@ -c @SHLIB_CFLAGS@ $(SHLIB_EXTRA_CFLAGS) -I@erl_include@ @DEFS@ $<\n" ++ - "\t@SHLIB_LD@ @CROSSLDFLAGS@ @SHLIB_LDFLAGS@ $(SHLIB_EXTRA_LDFLAGS) -o $@ $*@obj@ @SHLIB_LDLIBS@ $(SHLIB_EXTRA_LDLIBS)", - - ShlibRules = ts_lib:subst(ShlibRules0, Vars), - case get_app_vars2(fun jinterface/2, Base3, OsType) of - {App, not_found} -> - [{'SHLIB_RULES', ShlibRules}, {App, "not_found"}|Vars]; - _ -> - [{'SHLIB_RULES', ShlibRules}|Vars] - end. -get_app_vars2(AppFun, Vars, OsType) -> - case catch AppFun(Vars,OsType) of - Res when is_list(Res) -> - {jinterface, ok}; - {cannot_find_app, App} -> - {App, not_found}; - {'EXIT', Reason} -> - exit(Reason); - Garbage -> - exit({unexpected_internal_error, Garbage}) - end. - -erts_lib_name(multi_threaded, {win32, V}) -> - link_library("erts_MD" ++ case is_debug_build() of - true -> "d"; - false -> "" - end, - {win32, V}); -erts_lib_name(single_threaded, {win32, V}) -> - link_library("erts_ML" ++ case is_debug_build() of - true -> "d"; - false -> "" - end, - {win32, V}); -erts_lib_name(multi_threaded, OsType) -> - link_library("erts_r", OsType); -erts_lib_name(single_threaded, OsType) -> - link_library("erts", OsType). - -erts_lib(Vars,OsType) -> - {ErtsLibInclude, - ErtsLibIncludeGenerated, - ErtsLibIncludeInternal, - ErtsLibIncludeInternalGenerated, - ErtsLibPath, - ErtsLibInternalPath, - ErtsLibEthreadMake, - ErtsLibInternalMake - } - = case erl_root(Vars) of - {installed, _Root} -> - Erts = lib_dir(Vars, erts), - ErtsInclude = filename:join([Erts, "include"]), - ErtsIncludeInternal = filename:join([ErtsInclude, "internal"]), - ErtsLib = filename:join([Erts, "lib"]), - ErtsLibInternal = filename:join([ErtsLib, "internal"]), - ErtsEthreadMake = filename:join([ErtsIncludeInternal, "ethread.mk"]), - ErtsInternalMake = filename:join([ErtsIncludeInternal, "erts_internal.mk"]), - - {ErtsInclude, - ErtsInclude, - ErtsIncludeInternal, - ErtsIncludeInternal, - ErtsLib, - ErtsLibInternal, - ErtsEthreadMake, - ErtsInternalMake}; - {srctree, Root, Target} -> - Erts = filename:join([Root, "erts"]), - ErtsInclude = filename:join([Erts, "include"]), - ErtsIncludeTarget = filename:join([ErtsInclude, Target]), - ErtsIncludeInternal = filename:join([ErtsInclude, - "internal"]), - ErtsIncludeInternalTarget = filename:join([ErtsIncludeInternal, - Target]), - ErtsLib = filename:join([Erts, "lib", Target]), - ErtsLibInternal = filename:join([Erts, - "lib", - "internal", - Target]), - ErtsEthreadMake = filename:join([ErtsIncludeInternalTarget, "ethread.mk"]), - ErtsInternalMake = filename:join([ErtsIncludeInternalTarget, "erts_internal.mk"]), - - {ErtsInclude, - ErtsIncludeTarget, - ErtsIncludeInternal, - ErtsIncludeInternalTarget, - ErtsLib, - ErtsLibInternal, - ErtsEthreadMake, - ErtsInternalMake} - end, - [{erts_lib_include, - quote(filename:nativename(ErtsLibInclude))}, - {erts_lib_include_generated, - quote(filename:nativename(ErtsLibIncludeGenerated))}, - {erts_lib_include_internal, - quote(filename:nativename(ErtsLibIncludeInternal))}, - {erts_lib_include_internal_generated, - quote(filename:nativename(ErtsLibIncludeInternalGenerated))}, - {erts_lib_path, quote(filename:nativename(ErtsLibPath))}, - {erts_lib_internal_path, quote(filename:nativename(ErtsLibInternalPath))}, - {erts_lib_multi_threaded, erts_lib_name(multi_threaded, OsType)}, - {erts_lib_single_threaded, erts_lib_name(single_threaded, OsType)}, - {erts_lib_make_ethread, quote(ErtsLibEthreadMake)}, - {erts_lib_make_internal, quote(ErtsLibInternalMake)} - | Vars]. - -erl_include(Vars) -> - Include = - case erl_root(Vars) of - {installed, Root} -> - quote(filename:join([Root, "usr", "include"])); - {srctree, Root, Target} -> - quote(filename:join([Root, "erts", "emulator", "beam"])) - ++ " -I" ++ quote(filename:join([Root, "erts", "emulator"])) - ++ system_include(Root, Vars) - ++ " -I" ++ quote(filename:join([Root, "erts", "include"])) - ++ " -I" ++ quote(filename:join([Root, "erts", "include", Target])) - end, - [{erl_include, filename:nativename(Include)}|Vars]. - - -system_include(Root, Vars) -> - SysDir = - case ts_lib:var(os, Vars) of - "Windows" ++ _T -> "sys/win32"; - _ -> "sys/unix" - end, - " -I" ++ quote(filename:nativename(filename:join([Root, "erts", "emulator", SysDir]))). - -erl_interface(Vars,OsType) -> - {Incl, {LibPath, MkIncl}} = - case lib_dir(Vars, erl_interface) of - {error, bad_name} -> - throw({cannot_find_app, erl_interface}); - Dir -> - {filename:join(Dir, "include"), - case erl_root(Vars) of - {installed, _Root} -> - {filename:join(Dir, "lib"), - filename:join([Dir, "src", "eidefs.mk"])}; - {srctree, _Root, Target} -> - {filename:join([Dir, "obj", Target]), - filename:join([Dir, "src", Target, "eidefs.mk"])} - end} - end, - Lib = link_library("erl_interface",OsType), - Lib1 = link_library("ei",OsType), - {LibDrv, Lib1Drv} = - case erlang:system_info(threads) of - false -> - case OsType of - {unix,_} -> - {link_library("erl_interface_st",OsType), - link_library("ei_st",OsType)}; - _ -> - {Lib, Lib1} - end; - true -> - case OsType of - {win32, _} -> - {link_library("erl_interface_md",OsType), - link_library("ei_md",OsType)}; - _ -> - {Lib, Lib1} - end - end, - ThreadLib = case OsType of - % FIXME: FreeBSD uses gcc flag '-pthread' or linking with - % "libc_r". So it has to be last of libs. This is an - % temporary solution, should be configured elsewhere. - - % This temporary solution have now failed! - % A new temporary solution is installed ... - % {unix,freebsd} -> "-lc_r"; - {unix,freebsd} -> - "-lpthread"; - {unix,_} -> - "-lpthread"; - _ -> - "" - end, - [{erl_interface_libpath, quote(filename:nativename(LibPath))}, - {erl_interface_sock_libs, sock_libraries(OsType)}, - {erl_interface_lib, quote(filename:join(LibPath, Lib))}, - {erl_interface_eilib, quote(filename:join(LibPath, Lib1))}, - {erl_interface_lib_drv, quote(filename:join(LibPath, LibDrv))}, - {erl_interface_eilib_drv, quote(filename:join(LibPath, Lib1Drv))}, - {erl_interface_threadlib, ThreadLib}, - {erl_interface_include, quote(filename:nativename(Incl))}, - {erl_interface_mk_include, quote(filename:nativename(MkIncl))} - | Vars]. - -ic(Vars, OsType) -> - {ClassPath, LibPath, Incl} = - case lib_dir(Vars, ic) of - {error, bad_name} -> - throw({cannot_find_app, ic}); - Dir -> - {filename:join([Dir, "priv", "ic.jar"]), - case erl_root(Vars) of - {installed, _Root} -> - filename:join([Dir, "priv", "lib"]); - {srctree, _Root, Target} -> - filename:join([Dir, "priv", "lib", Target]) - end, - filename:join(Dir, "include")} - end, - [{ic_classpath, quote(filename:nativename(ClassPath))}, - {ic_libpath, quote(filename:nativename(LibPath))}, - {ic_lib, quote(filename:join(filename:nativename(LibPath),link_library("ic", OsType)))}, - {ic_include_path, quote(filename:nativename(Incl))}|Vars]. - -jinterface(Vars, _OsType) -> - ClassPath = - case lib_dir(Vars, jinterface) of - {error, bad_name} -> - throw({cannot_find_app, jinterface}); - Dir -> - filename:join([Dir, "priv", "OtpErlang.jar"]) - end, - [{jinterface_classpath, quote(filename:nativename(ClassPath))}|Vars]. - -lib_dir(Vars, Lib) -> - LibLibDir = case Lib of - erts -> - filename:join([code:root_dir(), - "erts-" ++ erlang:system_info(version)]); - _ -> - code:lib_dir(Lib) - end, - case {get_var(crossroot, Vars), LibLibDir} of - {{error, _}, _} -> %no crossroot - LibLibDir; - {CrossRoot, _} -> - %% XXX: Ugly. So ugly I won't comment it - %% /Patrik - CLibDirList = case Lib of - erts -> - [CrossRoot, "erts"]; - _ -> - [CrossRoot, "lib", atom_to_list(Lib)] - end, - CLibDir = filename:join(CLibDirList), - Cmd = "ls -d " ++ CLibDir ++ "*", - XLibDir = lists:last(string:tokens(os:cmd(Cmd),"\n")), - case file:list_dir(XLibDir) of - {error, enoent} -> - []; - _ -> - XLibDir - end - end. - -erl_root(Vars) -> - Root = case get_var(crossroot,Vars) of - {error, notfound} -> code:root_dir(); - CrossRoot -> CrossRoot - end, - case ts_lib:erlang_type(Root) of - {srctree, _Version} -> - Target = get_var(target, Vars), - {srctree, Root, Target}; - {_, _Version} -> - {installed, Root} - end. - - -get_var(Key, Vars) -> - case lists:keysearch(Key, 1, Vars) of - {value, {Key, Value}} -> - Value; - _ -> - {error, notfound} - end. - - -sock_libraries({win32, _}) -> - "ws2_32.lib"; -sock_libraries({unix, _}) -> - "". % Included in general libraries if needed. - -link_library(LibName,{win32, _}) -> - LibName ++ ".lib"; -link_library(LibName,{unix, _}) -> - "lib" ++ LibName ++ ".a"; -link_library(_LibName,_Other) -> - exit({link_library, not_supported}). - -%% Returns emulator specific variables. -emu_vars(Vars) -> - [{is_source_build, is_source_build()}, - {erl_name, atom_to_list(lib:progname())}|Vars]. - -is_source_build() -> - string:str(erlang:system_info(system_version), "[source]") > 0. - -is_debug_build() -> - case catch string:str(erlang:system_info(system_version), "debug") of - Int when is_integer(Int), Int > 0 -> - true; - _ -> - false - end. -%% -%% ssl_libdir -%% -ssl(Vars, _OsType) -> - case lib_dir(Vars, ssl) of - {error, bad_name} -> - throw({cannot_find_app, ssl}); - Dir -> - [{ssl_libdir, quote(filename:nativename(Dir))}| Vars] - end. - -separators(Vars, {win32,_}) -> - [{'DS',"\\"},{'PS',";"}|Vars]; -separators(Vars, _) -> - [{'DS',"/"},{'PS',":"}|Vars]. - -quote(List) -> - case lists:member($ , List) of - false -> List; - true -> make_quote(List) - end. - -make_quote(List) -> - case os:type() of - {win32, _} -> %% nmake" - [$"] ++ List ++ [$"]; - _ -> %% make - BackQuote = fun($ , Acc) -> [$\\ , $ |Acc]; - (Char, Acc) -> [Char|Acc] end, - lists:foldr(BackQuote, [], List) - end. diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl deleted file mode 100644 index 600a576820..0000000000 --- a/lib/test_server/src/ts_install.erl +++ /dev/null @@ -1,465 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ts_install). - --export([install/2, platform_id/1]). - --include("ts.hrl"). --include_lib("kernel/include/file.hrl"). - -install(install_local, Options) -> - install(os:type(), Options); - -install(TargetSystem, Options) -> - case file:consult(?variables) of - {ok, Vars} -> - case proplists:get_value(cross,Vars) of - "yes" when Options == []-> - target_install(Vars); - _ -> - build_install(TargetSystem, Options) - end; - _ -> - build_install(TargetSystem, Options) - end. - - -build_install(TargetSystem, Options) -> - XComp = parse_xcomp_file(proplists:get_value(xcomp,Options)), - case autoconf(TargetSystem, XComp++Options) of - {ok, Vars0} -> - OsType = os_type(TargetSystem), - Vars1 = ts_erl_config:variables(Vars0++XComp++Options,OsType), - {Options1, Vars2} = add_vars(Vars1, Options), - Vars3 = lists:flatten([Options1|Vars2]), - write_terms(?variables, Vars3); - {error, Reason} -> - {error, Reason} - end. - -os_type({unix,_}=OsType) -> OsType; -os_type({win32,_}=OsType) -> OsType. - -target_install(CrossVars) -> - io:format("Cross installation detected, skipping configure and data_dir make~n"), - case file:rename(?variables,?cross_variables) of - ok -> - ok; - _ -> - io:format("Could not find variables file from cross make~n"), - throw(cross_installation_failed) - end, - CPU = proplists:get_value('CPU',CrossVars), - OS = proplists:get_value(os,CrossVars), - {Options,Vars} = add_vars([{cross,"yes"},{'CPU',CPU},{os,OS}],[]), - Variables = lists:flatten([Options|Vars]), - write_terms(?variables, Variables). - -%% Autoconf for various platforms. -%% unix uses the configure script -%% win32 uses ts_autoconf_win32 - -autoconf(TargetSystem, XComp) -> - case autoconf1(TargetSystem, XComp) of - ok -> - autoconf2(file:read_file("conf_vars")); - Error -> - Error - end. - -autoconf1({win32, _},[{cross,"no"}]) -> - ts_autoconf_win32:configure(); -autoconf1({unix, _},XCompFile) -> - unix_autoconf(XCompFile); -autoconf1(_,_) -> - io:format("cross compilation not supported for that this platform~n"), - throw(cross_installation_failed). - -autoconf2({ok, Bin}) -> - get_vars(ts_lib:b2s(Bin), name, [], []); -autoconf2(Error) -> - Error. - -get_vars([$:|Rest], name, Current, Result) -> - Name = list_to_atom(lists:reverse(Current)), - get_vars(Rest, value, [], [Name|Result]); -get_vars([$\r|Rest], value, Current, Result) -> - get_vars(Rest, value, Current, Result); -get_vars([$\n|Rest], value, Current, [Name|Result]) -> - Value = lists:reverse(Current), - get_vars(Rest, name, [], [{Name, Value}|Result]); -get_vars([C|Rest], State, Current, Result) -> - get_vars(Rest, State, [C|Current], Result); -get_vars([], name, [], Result) -> - {ok, Result}; -get_vars(_, _, _, _) -> - {error, fatal_bad_conf_vars}. - -config_flags() -> - case os:getenv("CONFIG_FLAGS") of - false -> []; - CF -> string:tokens(CF, " \t\n") - end. - -unix_autoconf(XConf) -> - Configure = filename:absname("configure"), - Flags = proplists:get_value(crossflags,XConf,[]), - Env = proplists:get_value(crossenv,XConf,[]), - Host = get_xcomp_flag("host", Flags), - Build = get_xcomp_flag("build", Flags), - Threads = [" --enable-shlib-thread-safety" || - erlang:system_info(threads) /= false], - Debug = [" --enable-debug-mode" || - string:str(erlang:system_info(system_version),"debug") > 0], - MXX_Build = [Y || Y <- config_flags(), - Y == "--enable-m64-build" - orelse Y == "--enable-m32-build"], - Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build, - case filelib:is_file(Configure) of - true -> - OSXEnv = macosx_cflags(), - UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)), - io:format("Running ~s~nEnv: ~p~n", - [lists:flatten(Configure ++ Args),UnQuotedEnv]), - Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])}, - [stream, eof, {env,UnQuotedEnv}]), - ts_lib:print_data(Port); - false -> - {error, no_configure_script} - end. - -unquote([{Var,Val}|T]) -> - [{Var,unquote(Val)}|unquote(T)]; -unquote([]) -> - []; -unquote("\""++Rest) -> - lists:reverse(tl(lists:reverse(Rest))); -unquote(String) -> - String. - -assign_vars([]) -> - []; -assign_vars([{VAR,FlagsStr} | VARs]) -> - [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)]; -assign_vars(FlagsStr) -> - Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])], - string:strip(lists:flatten(lists:map(fun(Flag) -> - Flag ++ " " - end, Flags)), right). - -assign_all_vars([$$ | Rest], FlagSoFar) -> - {VarName,Rest1} = get_var_name(Rest, []), - assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName)); -assign_all_vars([Char | Rest], FlagSoFar) -> - assign_all_vars(Rest, FlagSoFar ++ [Char]); -assign_all_vars([], Flag) -> - Flag. - -get_var_name([Ch | Rest] = Str, VarR) -> - case valid_char(Ch) of - true -> get_var_name(Rest, [Ch | VarR]); - false -> {lists:reverse(VarR),Str} - end; -get_var_name([], VarR) -> - {lists:reverse(VarR),[]}. - -assign_var(VarName) -> - case os:getenv(VarName) of - false -> ""; - Val -> Val - end. - -valid_char(Ch) when Ch >= $a, Ch =< $z -> true; -valid_char(Ch) when Ch >= $A, Ch =< $Z -> true; -valid_char(Ch) when Ch >= $0, Ch =< $9 -> true; -valid_char($_) -> true; -valid_char(_) -> false. - -get_xcomp_flag(Flag, Flags) -> - get_xcomp_flag(Flag, Flag, Flags). -get_xcomp_flag(Flag, Tag, Flags) -> - case proplists:get_value(Flag,Flags) of - undefined -> ""; - "guess" -> [" --",Tag,"=",os:cmd("$ERL_TOP/erts/autoconf/config.guess")]; - HostVal -> [" --",Tag,"=",HostVal] - end. - - -macosx_cflags() -> - case os:type() of - {unix, darwin} -> - %% To ensure that the drivers we build can be loaded - %% by the emulator, add either -m32 or -m64 to CFLAGS. - WordSize = erlang:system_info(wordsize), - Mflag = "-m" ++ integer_to_list(8*WordSize), - [{"CFLAGS", Mflag},{"LDFLAGS", Mflag}]; - _ -> - [] - end. - -parse_xcomp_file(undefined) -> - [{cross,"no"}]; -parse_xcomp_file(Filepath) -> - {ok,Bin} = file:read_file(Filepath), - Lines = binary:split(Bin,<<"\n">>,[global,trim]), - {Envs,Flags} = parse_xcomp_file(Lines,[],[]), - [{cross,"yes"},{crossroot,os:getenv("ERL_TOP")}, - {crossenv,Envs},{crossflags,Flags}]. - -parse_xcomp_file([<> = Line|R],Envs,Flags) - when $A =< A, A =< $Z -> - [Var,Value] = binary:split(Line,<<"=">>), - parse_xcomp_file(R,[{ts_lib:b2s(Var), - ts_lib:b2s(Value)}|Envs],Flags); -parse_xcomp_file([<<"erl_xcomp_",Line/binary>>|R],Envs,Flags) -> - [Var,Value] = binary:split(Line,<<"=">>), - parse_xcomp_file(R,Envs,[{ts_lib:b2s(Var), - ts_lib:b2s(Value)}|Flags]); -parse_xcomp_file([_|R],Envs,Flags) -> - parse_xcomp_file(R,Envs,Flags); -parse_xcomp_file([],Envs,Flags) -> - {lists:reverse(Envs),lists:reverse(Flags)}. - -write_terms(Name, Terms) -> - case file:open(Name, [write]) of - {ok, Fd} -> - Result = write_terms1(Fd, remove_duplicates(Terms)), - file:close(Fd), - Result; - {error, Reason} -> - {error, Reason} - end. - -write_terms1(Fd, [Term|Rest]) -> - ok = io:format(Fd, "~p.\n", [Term]), - write_terms1(Fd, Rest); -write_terms1(_, []) -> - ok. - -remove_duplicates(List) -> - lists:reverse( - lists:foldl(fun({Key,Val},Acc) -> - R = make_ref(), - case proplists:get_value(Key,Acc,R) of - R -> [{Key,Val}|Acc]; - _Else -> - Acc - end - end,[],List)). - -add_vars(Vars0, Opts0) -> - {Opts,LongNames} = - case lists:keymember(longnames, 1, Opts0) of - true -> - {lists:keydelete(longnames, 1, Opts0),true}; - false -> - {Opts0,false} - end, - {PlatformId, PlatformLabel, PlatformFilename, Version} = - platform([{longnames, LongNames}|Vars0]), - NetDir = lists:concat(["/net", hostname()]), - Mounted = case file:read_file_info(NetDir) of - {ok, #file_info{type = directory}} -> NetDir; - _ -> "" - end, - {Opts, [{longnames, LongNames}, - {platform_id, PlatformId}, - {platform_filename, PlatformFilename}, - {rsh_name, get_rsh_name()}, - {platform_label, PlatformLabel}, - {ts_net_dir, Mounted}, - {erl_flags, []}, - {erl_release, Version}, - {ts_testcase_callback, get_testcase_callback()} | Vars0]}. - -get_testcase_callback() -> - case os:getenv("TS_TESTCASE_CALLBACK") of - ModFunc when is_list(ModFunc), ModFunc /= "" -> - case string:tokens(ModFunc, " ") of - [_Mod,_Func] -> ModFunc; - _ -> "" - end; - _ -> - case init:get_argument(ts_testcase_callback) of - {ok,[[Mod,Func]]} -> Mod ++ " " ++ Func; - _ -> "" - end - end. - -get_rsh_name() -> - case os:getenv("ERL_RSH") of - false -> "rsh"; - Str -> Str - end. - -platform_id(Vars) -> - {Id,_,_,_} = platform(Vars), - Id. - -platform(Vars) -> - Hostname = hostname(), - - {Type,Version} = ts_lib:erlang_type(), - Cpu = ts_lib:var('CPU', Vars), - Os = ts_lib:var(os, Vars), - - ErlType = to_upper(atom_to_list(Type)), - OsType = ts_lib:initial_capital(Os), - CpuType = ts_lib:initial_capital(Cpu), - LinuxDist = linux_dist(), - ExtraLabel = extra_platform_label(), - Schedulers = schedulers(), - BindType = bind_type(), - KP = kernel_poll(), - IOTHR = io_thread(), - LC = lock_checking(), - MT = modified_timing(), - AsyncThreads = async_threads(), - Debug = debug(), - CpuBits = word_size(), - Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist, - Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads, - Debug,ExtraLabel]), - PlatformId = lists:concat([ErlType, " ", Version, Common]), - PlatformLabel = ErlType ++ Common, - PlatformFilename = platform_as_filename(PlatformId), - {PlatformId, PlatformLabel, PlatformFilename, Version}. - -platform_as_filename(Label) -> - lists:map(fun($ ) -> $_; - ($/) -> $_; - (C) when $A =< C, C =< $Z -> C - $A + $a; - (C) -> C end, - Label). - -to_upper(String) -> - lists:map(fun(C) when $a =< C, C =< $z -> C - $a + $A; - (C) -> C end, - String). - -word_size() -> - case {erlang:system_info({wordsize,external}), - erlang:system_info({wordsize,internal})} of - {4,4} -> ""; - {8,8} -> "/64"; - {8,4} -> "/Halfword" - end. - -linux_dist() -> - case os:type() of - {unix,linux} -> - linux_dist_1([fun linux_dist_suse/0]); - _ -> "" - end. - -linux_dist_1([F|T]) -> - case F() of - "" -> linux_dist_1(T); - Str -> Str - end; -linux_dist_1([]) -> "". - -linux_dist_suse() -> - case filelib:is_file("/etc/SuSE-release") of - false -> ""; - true -> - Ver0 = os:cmd("awk '/^VERSION/ {print $3}' /etc/SuSE-release"), - [_|Ver1] = lists:reverse(Ver0), - Ver = lists:reverse(Ver1), - "/Suse" ++ Ver - end. - -hostname() -> - case catch inet:gethostname() of - {ok, Hostname} when is_list(Hostname) -> - "/" ++ lists:takewhile(fun (C) -> C /= $. end, Hostname); - _ -> - "/localhost" - end. - -async_threads() -> - case catch erlang:system_info(threads) of - true -> "/A"++integer_to_list(erlang:system_info(thread_pool_size)); - _ -> "" - end. - -schedulers() -> - case catch erlang:system_info(smp_support) of - true -> - case {erlang:system_info(schedulers), - erlang:system_info(schedulers_online)} of - {S,S} -> - "/S"++integer_to_list(S); - {S,O} -> - "/S"++integer_to_list(S) ++ ":" ++ - integer_to_list(O) - end; - _ -> "" - end. - -bind_type() -> - case catch erlang:system_info(scheduler_bind_type) of - thread_no_node_processor_spread -> "/sbttnnps"; - no_node_processor_spread -> "/sbtnnps"; - no_node_thread_spread -> "/sbtnnts"; - processor_spread -> "/sbtps"; - thread_spread -> "/sbtts"; - no_spread -> "/sbtns"; - _ -> "" - end. - - -debug() -> - case string:str(erlang:system_info(system_version), "debug") of - 0 -> ""; - _ -> "/Debug" - end. - -lock_checking() -> - case catch erlang:system_info(lock_checking) of - true -> "/LC"; - _ -> "" - end. - -modified_timing() -> - case catch erlang:system_info(modified_timing_level) of - N when is_integer(N) -> - "/T" ++ integer_to_list(N); - _ -> "" - end. - -kernel_poll() -> - case catch erlang:system_info(kernel_poll) of - true -> "/KP"; - _ -> "" - end. - -io_thread() -> - case catch erlang:system_info(io_thread) of - true -> "/IOTHR"; - _ -> "" - end. - -extra_platform_label() -> - case os:getenv("TS_EXTRA_PLATFORM_LABEL") of - [] -> ""; - [_|_]=Label -> "/" ++ Label; - false -> "" - end. diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl deleted file mode 100644 index ec0d54ccde..0000000000 --- a/lib/test_server/src/ts_install_cth.erl +++ /dev/null @@ -1,253 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%% @doc TS Installed SCB -%%% -%%% This module does what the make parts of the ts:run/x command did, -%%% but not the Makefile.first parts! So they have to be done by ts or -%%% manually!! - --module(ts_install_cth). - -%% Suite Callbacks --export([id/1]). --export([init/2]). - --export([pre_init_per_suite/3]). --export([post_init_per_suite/4]). --export([pre_end_per_suite/3]). --export([post_end_per_suite/4]). - --export([pre_init_per_group/3]). --export([post_init_per_group/4]). --export([pre_end_per_group/3]). --export([post_end_per_group/4]). - --export([pre_init_per_testcase/3]). --export([post_end_per_testcase/4]). - --export([on_tc_fail/3]). --export([on_tc_skip/3]). - --export([terminate/1]). - --include_lib("kernel/include/file.hrl"). - --type config() :: proplists:proplist(). --type reason() :: term(). --type skip_or_fail() :: {skip, reason()} | - {auto_skip, reason()} | - {fail, reason()}. - --record(state, { ts_conf_dir, target_system, install_opts, nodenames, nodes }). - -%% @doc The id of this SCB --spec id(Opts :: term()) -> - Id :: term(). -id(_Opts) -> - ?MODULE. - -%% @doc Always called before any other callback function. --spec init(Id :: term(), Opts :: proplists:proplist()) -> - {ok, State :: #state{}}. -init(_Id, Opts) -> - Nodenames = proplists:get_value(nodenames, Opts, 0), - Nodes = proplists:get_value(nodes, Opts, 0), - TSConfDir = proplists:get_value(ts_conf_dir, Opts), - TargetSystem = proplists:get_value(target_system, Opts, install_local), - InstallOpts = proplists:get_value(install_opts, Opts, []), - {ok, #state{ nodenames = Nodenames, - nodes = Nodes, - ts_conf_dir = TSConfDir, - target_system = TargetSystem, - install_opts = InstallOpts } }. - -%% @doc Called before init_per_suite is called. --spec pre_init_per_suite(Suite :: atom(), - Config :: config(), - State :: #state{}) -> - {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) -> - DataDir = proplists:get_value(data_dir, Config), - ParentDir = filename:join( - lists:reverse( - tl(lists:reverse(filename:split(DataDir))))), - TSConfDir = filename:join([ParentDir, "..","test_server"]), - pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir }); -pre_init_per_suite(_Suite,Config,State) -> - DataDir = proplists:get_value(data_dir, Config), - try - {ok,Variables} = - file:consult(filename:join(State#state.ts_conf_dir,"variables")), - case proplists:get_value(cross,Variables) of - "yes" -> - ct:log("Not making data dir as tests have been cross compiled"); - _ -> - ts_lib:make_non_erlang(DataDir, Variables) - end, - - {add_node_name(Config, State), State} - catch error:{badmatch,{error,enoent}} -> - {add_node_name(Config, State), State}; - Error:Reason -> - Stack = erlang:get_stacktrace(), - ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), - {{fail,{?MODULE,{Error,Reason, Stack}}},State} - end. - -%% @doc Called after init_per_suite. --spec post_init_per_suite(Suite :: atom(), - Config :: config(), - Return :: config() | skip_or_fail(), - State :: #state{}) -> - {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_suite(_Suite,_Config,Return,State) -> - test_server_ctrl:kill_slavenodes(), - {Return, State}. - -%% @doc Called before end_per_suite. --spec pre_end_per_suite(Suite :: atom(), - Config :: config() | skip_or_fail(), - State :: #state{}) -> - {ok | skip_or_fail(), NewState :: #state{}}. -pre_end_per_suite(_Suite,Config,State) -> - {Config, State}. - -%% @doc Called after end_per_suite. --spec post_end_per_suite(Suite :: atom(), - Config :: config(), - Return :: term(), - State :: #state{}) -> - {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_suite(_Suite,_Config,Return,State) -> - {Return, State}. - -%% @doc Called before each init_per_group. --spec pre_init_per_group(Group :: atom(), - Config :: config(), - State :: #state{}) -> - {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_group(_Group,Config,State) -> - {add_node_name(Config, State), State}. - -%% @doc Called after each init_per_group. --spec post_init_per_group(Group :: atom(), - Config :: config(), - Return :: config() | skip_or_fail(), - State :: #state{}) -> - {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_group(_Group,_Config,Return,State) -> - {Return, State}. - -%% @doc Called after each end_per_group. --spec pre_end_per_group(Group :: atom(), - Config :: config() | skip_or_fail(), - State :: #state{}) -> - {ok | skip_or_fail(), NewState :: #state{}}. -pre_end_per_group(_Group,Config,State) -> - {Config, State}. - -%% @doc Called after each end_per_group. --spec post_end_per_group(Group :: atom(), - Config :: config(), - Return :: term(), - State :: #state{}) -> - {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_group(_Group,_Config,Return,State) -> - {Return, State}. - -%% @doc Called before each test case. --spec pre_init_per_testcase(TC :: atom(), - Config :: config(), - State :: #state{}) -> - {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_testcase(_TC,Config,State) -> - {add_node_name(Config, State), State}. - -%% @doc Called after each test case. --spec post_end_per_testcase(TC :: atom(), - Config :: config(), - Return :: term(), - State :: #state{}) -> - {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_testcase(_TC,_Config,Return,State) -> - {Return, State}. - -%% @doc Called after a test case failed. --spec on_tc_fail(TC :: init_per_suite | end_per_suite | - init_per_group | end_per_group | atom(), - Reason :: term(), State :: #state{}) -> - NewState :: #state{}. -on_tc_fail(_TC, _Reason, State) -> - State. - -%% @doc Called when a test case is skipped. --spec on_tc_skip(TC :: end_per_suite | init_per_group | end_per_group | atom(), - {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), - Reason :: term()}}} | - {tc_user_skip, {skipped, Reason :: term()}}, - State :: #state{}) -> - NewState :: #state{}. -on_tc_skip(_TC, _Reason, State) -> - State. - -%% @doc Called when the scope of the SCB is done. --spec terminate(State :: #state{}) -> - term(). -terminate(_State) -> - ok. - -%%% ============================================================================ -%%% Local functions -%%% ============================================================================ - -%% Add a nodename to config if it does not exist -add_node_name(Config, State) -> - case proplists:get_value(nodenames, Config) of - undefined -> - lists:keystore( - nodenames, 1, Config, - {nodenames,generate_nodenames(State#state.nodenames)}); - _Else -> - Config - end. - - -%% Copied from test_server_ctrl.erl -generate_nodenames(Num) -> - {ok,Name} = inet:gethostname(), - generate_nodenames2(Num, [Name], []). - -generate_nodenames2(0, _Hosts, Acc) -> - Acc; -generate_nodenames2(N, Hosts, Acc) -> - Host=lists:nth((N rem (length(Hosts)))+1, Hosts), - Name=list_to_atom(temp_nodename("nod",N) ++ "@" ++ Host), - generate_nodenames2(N-1, Hosts, [Name|Acc]). - -%% We cannot use erlang:unique_integer([positive]) -%% here since this code in run on older test releases as well. -temp_nodename(Base,I) -> - {A,B,C} = os:timestamp(), - Nstr = integer_to_list(I), - Astr = integer_to_list(A), - Bstr = integer_to_list(B), - Cstr = integer_to_list(C), - Base++Nstr++Astr++Bstr++Cstr. diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl deleted file mode 100644 index 7c3f450194..0000000000 --- a/lib/test_server/src/ts_lib.erl +++ /dev/null @@ -1,372 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ts_lib). - --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). --export([error/1, var/2, erlang_type/0, - erlang_type/1, - initial_capital/1, - specs/1, suites/2, - test_categories/2, specialized_specs/2, - subst_file/3, subst/2, print_data/1, - make_non_erlang/2, - maybe_atom_to_list/1, progress/4, - b2s/1 - ]). - -error(Reason) -> - throw({error, Reason}). - -%% Returns the value for a variable - -var(Name, Vars) -> - case lists:keysearch(Name, 1, Vars) of - {value, {Name, Value}} -> - Value; - false -> - error({bad_installation, {undefined_var, Name, Vars}}) - end. - -%% Returns the level of verbosity (0-X) -verbosity(Vars) -> - % Check for a single verbose option. - case lists:member(verbose, Vars) of - true -> - 1; - false -> - case lists:keysearch(verbose, 1, Vars) of - {value, {verbose, Level}} -> - Level; - _ -> - 0 - end - end. - -% Displays output to the console if verbosity is equal or more -% than Level. -progress(Vars, Level, Format, Args) -> - V=verbosity(Vars), - if - V>=Level -> - io:format(Format, Args); - true -> - ok - end. - -%% Returns: {Type, Version} where Type is otp|src - -erlang_type() -> - erlang_type(code:root_dir()). -erlang_type(RootDir) -> - {_, Version} = init:script_id(), - RelDir = filename:join(RootDir, "releases"), % Only in installed - case filelib:is_file(RelDir) of - true -> {otp,Version}; % installed OTP - false -> {srctree,Version} % source code tree - end. - -%% Upcases the first letter in a string. - -initial_capital([C|Rest]) when $a =< C, C =< $z -> - [C-$a+$A|Rest]; -initial_capital(String) -> - String. - -specialized_specs(Dir,PostFix) -> - Specs = filelib:wildcard(filename:join([filename:dirname(Dir), - "*_test", "*_"++PostFix++".spec"])), - sort_tests([begin - DirPart = filename:dirname(Name), - AppTest = hd(lists:reverse(filename:split(DirPart))), - list_to_atom(string:substr(AppTest, 1, length(AppTest)-5)) - end || Name <- Specs]). - -specs(Dir) -> - Specs = filelib:wildcard(filename:join([filename:dirname(Dir), - "*_test", "*.{dyn,}spec"])), - %% Make sure only to include the main spec for each application - MainSpecs = - lists:flatmap(fun(FullName) -> - [Spec,TestDir|_] = - lists:reverse(filename:split(FullName)), - [_TestSuffix|TDParts] = - lists:reverse(string:tokens(TestDir,[$_,$.])), - [_SpecSuffix|SParts] = - lists:reverse(string:tokens(Spec,[$_,$.])), - if TDParts == SParts -> - [filename_to_atom(FullName)]; - true -> - [] - end - end, Specs), - sort_tests(MainSpecs). - -test_categories(Dir, App) -> - Specs = filelib:wildcard(filename:join([filename:dirname(Dir), - App++"_test", "*.spec"])), - lists:flatmap(fun(FullName) -> - [Spec,_TestDir|_] = - lists:reverse(filename:split(FullName)), - case filename:rootname(Spec -- App) of - "" -> - []; - [_Sep | Cat] -> - [list_to_atom(Cat)] - end - end, Specs). - -suites(Dir, App) -> - Glob=filename:join([filename:dirname(Dir), App++"_test", - "*_SUITE.erl"]), - Suites=filelib:wildcard(Glob), - [filename_to_atom(Name) || Name <- Suites]. - -filename_to_atom(Name) -> - list_to_atom(filename:rootname(filename:basename(Name))). - -%% Sorts a list of either log files directories or spec files. - -sort_tests(Tests) -> - Sorted = lists:usort([{suite_order(filename_to_atom(X)), X} || - X <- Tests]), - [X || {_, X} <- Sorted]. - -%% This defines the order in which tests should be run and be presented -%% in index files. - -suite_order(emulator) -> 0; -suite_order(test_server) -> 1; -suite_order(kernel) -> 4; -suite_order(stdlib) -> 6; -suite_order(compiler) -> 8; -suite_order(hipe) -> 9; -suite_order(erl_interface) -> 12; -suite_order(jinterface) -> 14; -suite_order(sasl) -> 16; -suite_order(tools) -> 18; -suite_order(runtime_tools) -> 19; -suite_order(parsetools) -> 20; -suite_order(debugger) -> 22; -suite_order(ic) -> 24; -suite_order(orber) -> 26; -suite_order(inets) -> 28; -suite_order(asn1) -> 30; -suite_order(os_mon) -> 32; -suite_order(snmp) -> 38; -suite_order(mnesia) -> 44; -suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last! -suite_order(_) -> 200. - -%% Substitute all occurrences of @var@ in the In file, using -%% the list of variables in Vars, producing the output file Out. -%% Returns: ok | {error, Reason} - -subst_file(In, Out, Vars) -> - case file:read_file(In) of - {ok, Bin} -> - Subst = subst(b2s(Bin), Vars, []), - case file:write_file(Out, unicode:characters_to_binary(Subst)) of - ok -> - ok; - {error, Reason} -> - {error, {file_write, Reason}} - end; - Error -> - Error - end. - -subst(String, Vars) -> - subst(String, Vars, []). - -subst([$@, $_|Rest], Vars, Result) -> - subst_var([$_|Rest], Vars, Result, []); -subst([$@, C|Rest], Vars, Result) when $A =< C, C =< $Z -> - subst_var([C|Rest], Vars, Result, []); -subst([$@, C|Rest], Vars, Result) when $a =< C, C =< $z -> - subst_var([C|Rest], Vars, Result, []); -subst([C|Rest], Vars, Result) -> - subst(Rest, Vars, [C|Result]); -subst([], _Vars, Result) -> - lists:reverse(Result). - -subst_var([$@|Rest], Vars, Result, VarAcc) -> - Key = list_to_atom(lists:reverse(VarAcc)), - {Result1,Rest1} = do_subst_var(Key, Rest, Vars, Result, VarAcc), - subst(Rest1, Vars, Result1); - -subst_var([C|Rest], Vars, Result, VarAcc) -> - subst_var(Rest, Vars, Result, [C|VarAcc]); -subst_var([], Vars, Result, VarAcc) -> - subst([], Vars, [VarAcc++[$@|Result]]). - -%% handle conditional -do_subst_var(Cond, Rest, Vars, Result, _VarAcc) when Cond == 'IFEQ' ; - Cond == 'IFNEQ' -> - {Bool,Comment,Rest1} = do_test(Rest, Vars, Cond), - Rest2 = extract_clause(Bool, Rest1), - {lists:reverse(Comment, Result),Rest2}; -%% variable substitution -do_subst_var(Key, Rest, Vars, Result, VarAcc) -> - case lists:keysearch(Key, 1, Vars) of - {value, {Key, Value}} -> - {lists:reverse(Value, Result),Rest}; - false -> - {[$@|VarAcc++[$@|Result]],Rest} - end. - -%% check arguments in "@IF[N]EQ@ (Arg1, Arg2)" for equality -do_test(Rest, Vars, Test) -> - {Arg1,Rest1} = get_arg(Rest, Vars, $,, []), - {Arg2,Rest2} = get_arg(Rest1, Vars, 41, []), % $) - Result = case Arg1 of - Arg2 when Test == 'IFEQ' -> true; - Arg2 when Test == 'IFNEQ' -> false; - _ when Test == 'IFNEQ' -> true; - _ -> false - end, - Comment = io_lib:format("# Result of test: ~s (~s, ~s) -> ~w", - [atom_to_list(Test),Arg1,Arg2,Result]), - {Result,Comment,Rest2}. - -%% extract an argument -get_arg([$(|Rest], Vars, Stop, _) -> - get_arg(Rest, Vars, Stop, []); -get_arg([Stop|Rest], Vars, Stop, Acc) -> - Arg = string:strip(lists:reverse(Acc)), - Subst = subst(Arg, Vars), - {Subst,Rest}; -get_arg([C|Rest], Vars, Stop, Acc) -> - get_arg(Rest, Vars, Stop, [C|Acc]). - -%% keep only the true or false conditional clause -extract_clause(true, Rest) -> - extract_clause(true, Rest, []); -extract_clause(false, Rest) -> - Rest1 = discard_clause(Rest), % discard true clause - extract_clause(false, Rest1, []). - -%% true clause buffered, done -extract_clause(true, [$@,$E,$L,$S,$E,$@|Rest], Acc) -> - Rest1 = discard_clause(Rest), % discard false clause - lists:reverse(Acc, Rest1); -%% buffering of false clause starts now -extract_clause(false, [$@,$E,$L,$S,$E,$@|Rest], _Acc) -> - extract_clause(false, Rest, []); -%% true clause buffered, done -extract_clause(true, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) -> - lists:reverse(Acc, Rest); -%% false clause buffered, done -extract_clause(false, [$@,$E,$N,$D,$I,$F,$@|Rest], Acc) -> - lists:reverse(Acc, Rest); -%% keep buffering -extract_clause(Bool, [C|Rest], Acc) -> - extract_clause(Bool, Rest, [C|Acc]); -%% parse error -extract_clause(_, [], Acc) -> - lists:reverse(Acc). - -discard_clause([$@,$E,$L,$S,$E,$@|Rest]) -> - Rest; -discard_clause([$@,$E,$N,$D,$I,$F,$@|Rest]) -> - Rest; -discard_clause([_C|Rest]) -> - discard_clause(Rest); -discard_clause([]) -> % parse error - []. - - -print_data(Port) -> - receive - {Port, {data, Bytes}} -> - io:put_chars(Bytes), - print_data(Port); - {Port, eof} -> - Port ! {self(), close}, - receive - {Port, closed} -> - true - end, - receive - {'EXIT', Port, _} -> - ok - after 1 -> % force context switch - ok - end - end. - -maybe_atom_to_list(To_list) when is_list(To_list) -> - To_list; -maybe_atom_to_list(To_list) when is_atom(To_list)-> - atom_to_list(To_list). - - -%% Configure and run all the Makefiles in the data dir of the suite -%% in question -make_non_erlang(DataDir, Variables) -> - %% Make the stuff in all_SUITE_data if it exists - AllDir = filename:join(DataDir,"../all_SUITE_data"), - case filelib:is_dir(AllDir) of - true -> - make_non_erlang_do(AllDir,Variables); - false -> - ok - end, - make_non_erlang_do(DataDir, Variables). - -make_non_erlang_do(DataDir, Variables) -> - try - MakeCommand = proplists:get_value(make_command,Variables), - - FirstMakefile = filename:join(DataDir,"Makefile.first"), - case filelib:is_regular(FirstMakefile) of - true -> - io:format("Making ~p",[FirstMakefile]), - ok = ts_make:make( - MakeCommand, DataDir, filename:basename(FirstMakefile)); - false -> - ok - end, - - MakefileSrc = filename:join(DataDir,"Makefile.src"), - MakefileDest = filename:join(DataDir,"Makefile"), - case filelib:is_regular(MakefileSrc) of - true -> - ok = ts_lib:subst_file(MakefileSrc,MakefileDest,Variables), - io:format("Making ~p",[MakefileDest]), - ok = ts_make:make([{makefile,"Makefile"},{data_dir,DataDir} - | Variables]); - false -> - ok - end - after - timer:sleep(100) %% maybe unnecessary now when we don't do set_cwd anymore - end. - -b2s(Bin) -> - unicode:characters_to_list(Bin,default_encoding()). - -default_encoding() -> - try epp:default_encoding() - catch error:undef -> latin1 - end. diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl deleted file mode 100644 index 921edb264a..0000000000 --- a/lib/test_server/src/ts_make.erl +++ /dev/null @@ -1,114 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(ts_make). - --export([make/1,make/3,unmake/1]). - --include_lib("common_test/include/ct.hrl"). - -%% Functions to be called from make test cases. - -make(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - Makefile = proplists:get_value(makefile, Config), - Make = proplists:get_value(make_command, Config), - case make(Make, DataDir, Makefile) of - ok -> ok; - {error,Reason} -> exit({make_failed,Reason}) - end. - -unmake(Config) when is_list(Config) -> - ok. - -%% Runs `make' in the given directory. -%% Result: ok | {error, Reason} - -make(Make, Dir, Makefile) -> - {RunFile, RunCmd, Script} = run_make_script(os:type(), Make, Dir, Makefile), - case file:write_file(RunFile, Script) of - ok -> - Log = filename:join(Dir, "make.log"), - file:delete(Log), - Port = open_port({spawn, RunCmd}, [eof,stream,in,stderr_to_stdout]), - case get_port_data(Port, [], false) of - "*ok*" ++ _ -> ok; - "*error*" ++ _ -> {error, make}; - Other ->{error,{make,Other}} - end; - Error -> Error - end. - -get_port_data(Port, Last0, Complete0) -> - receive - {Port,{data,Bytes}} -> - {Last, Complete} = update_last(Bytes, Last0, Complete0), - get_port_data(Port, Last, Complete); - {Port, eof} -> - Result = update_last(eof, Last0, Complete0), - unlink(Port), - exit(Port, die), - Result - end. - -update_last([C|Rest], Line, true) -> - try - %% Utf-8 list to utf-8 binary - %% (e.g. we assume utf-8 bytes from port) - io:put_chars(list_to_binary(Line)) - catch - error:badarg -> - %% io:put_chars/1 badarged - %% this likely means we had unicode code points - %% in our bytes buffer (e.g warning from gcc with åäö) - io:put_chars(unicode:characters_to_binary(Line)) - end, - io:nl(), - update_last([C|Rest], [], false); -update_last([$\r|Rest], Result, Complete) -> - update_last(Rest, Result, Complete); -update_last([$\n|Rest], Result, _Complete) -> - update_last(Rest, lists:reverse(Result), true); -update_last([C|Rest], Result, Complete) -> - update_last(Rest, [C|Result], Complete); -update_last([], Result, Complete) -> - {Result, Complete}; -update_last(eof, Result, _) -> - unicode:characters_to_list(list_to_binary(Result)). - -run_make_script({win32, _}, Make, Dir, Makefile) -> - {"run_make.bat", - ".\\run_make", - ["@echo off\r\n", - "cd \"", filename:nativename(Dir), "\"\r\n", - Make, " -f ", Makefile, " \r\n", - "if errorlevel 1 echo *error*\r\n", - "if not errorlevel 1 echo *ok*\r\n"]}; -run_make_script({unix, _}, Make, Dir, Makefile) -> - {"run_make", - "/bin/sh ./run_make", - ["#!/bin/sh\n", - "cd \"", Dir, "\"\n", - Make, " -f ", Makefile, " 2>&1\n", - "case $? in\n", - " 0) echo '*ok*';;\n", - " *) echo '*error*';;\n", - "esac\n"]}; -run_make_script(_Other, _Make, _Dir, _Makefile) -> - exit(dont_know_how_to_make_script_on_this_platform). diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl deleted file mode 100644 index 188094921d..0000000000 --- a/lib/test_server/src/ts_run.erl +++ /dev/null @@ -1,455 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Supervises running of test cases. - --module(ts_run). - --export([run/4,ct_run_test/2]). - --define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60). --define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15). - --include("ts.hrl"). - --import(lists, [member/2,filter/2]). - --record(state, - {file, % File given. - mod, % Module to run. - test_server_args, % Arguments to test server. - command, % Command to run. - test_dir, % Directory for test suite. - makefiles, % List of all makefiles. - makefile, % Current makefile. - batch, % Are we running in batch mode? - data_wc, % Wildcard for data dirs. - topcase, % Top case specification. - all % Set if we have all_SUITE_data - }). - --define(tracefile,"traceinfo"). - -%% Options is a slightly modified version of the options given to -%% ts:run. Vars0 are from the variables file. -run(File, Args0, Options, Vars0) -> - Vars= - case lists:keysearch(vars, 1, Options) of - {value, {vars, Vars1}} -> - Vars1++Vars0; - _ -> - Vars0 - end, - {Batch,Runner} = - case {member(interactive, Options), member(batch, Options)} of - {false, true} -> - {true, fun run_batch/3}; - _ -> - {false, fun run_interactive/3} - end, - Hooks = [fun init_state/3, - fun run_preinits/3, - fun make_command/3, - Runner], - Args = make_common_test_args(Args0,Options,Vars), - St = #state{file=File,test_server_args=Args,batch=Batch}, - R = execute(Hooks, Vars, [], St), - case R of - {ok,_,_,_} -> ok; - Error -> Error - end. - -execute([Hook|Rest], Vars0, Spec0, St0) -> - case Hook(Vars0, Spec0, St0) of - ok -> - execute(Rest, Vars0, Spec0, St0); - {ok, Vars, Spec, St} -> - execute(Rest, Vars, Spec, St); - Error -> - Error - end; -execute([], Vars, Spec, St) -> - {ok, Vars, Spec, St}. - -%% Wrapper to run tests using ct:run_test/1 and handle any errors. - -ct_run_test(Dir, CommonTestArgs) -> - try - ok = file:set_cwd(Dir), - case ct:run_test(CommonTestArgs) of - {_,_,_} -> - ok; - {error,Error} -> - io:format("ERROR: ~P\n", [Error,20]); - Other -> - io:format("~P\n", [Other,20]) - end - catch - _:Crash -> - io:format("CRASH: ~P\n", [Crash,20]) - end. - -%% -%% Deletes File from Files when File is on the form .../_data/ -%% when all of has been skipped in Spec, i.e. there -%% exists a {skip, {, _}} tuple in Spec. -%% -del_skipped_suite_data_dir(Files, Spec) -> - SkipDirNames = lists:foldl(fun ({skip, {SS, _C}}, SSs) -> - [atom_to_list(SS) ++ "_data" | SSs]; - (_, SSs) -> - SSs - end, - [], - Spec), - filter(fun (File) -> - not member(filename:basename(filename:dirname(File)), - SkipDirNames) - end, - Files). - -%% Initialize our internal state. - -init_state(Vars, [], St0) -> - {FileBase,Wc0,Mod} = - case St0#state.file of - {Fil,Mod0} -> {Fil, atom_to_list(Mod0) ++ "*_data",Mod0}; - Fil -> {Fil,"*_SUITE_data",[]} - end, - {ok,Cwd} = file:get_cwd(), - TestDir = filename:join(filename:dirname(Cwd), FileBase++"_test"), - case filelib:is_dir(TestDir) of - true -> - Wc = filename:join(TestDir, Wc0), - {ok,Vars,[],St0#state{file=FileBase,mod=Mod, - test_dir=TestDir,data_wc=Wc}}; - false -> - {error,{no_test_directory,TestDir}} - end. - -%% Run any "Makefile.first" files first. -%% XXX We should fake a failing test case if the make fails. - -run_preinits(Vars, Spec, St) -> - Wc = filename:join(St#state.data_wc, "Makefile.first"), - run_pre_makefiles(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec), - Vars, Spec, St), - {ok,Vars,Spec,St}. - -run_pre_makefiles([Makefile|Ms], Vars0, Spec0, St0) -> - Hooks = [fun run_pre_makefile/3], - case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of - {error,_Reason}=Error -> Error; - {ok,Vars,Spec,St} -> run_pre_makefiles(Ms, Vars, Spec, St) - end; -run_pre_makefiles([], Vars, Spec, St) -> {ok,Vars,Spec,St}. - -run_pre_makefile(Vars, Spec, St) -> - Makefile = St#state.makefile, - Shortname = filename:basename(Makefile), - DataDir = filename:dirname(Makefile), - Make = ts_lib:var(make_command, Vars), - case ts_make:make(Make,DataDir, Shortname) of - ok -> {ok,Vars,Spec,St}; - {error,_Reason}=Error -> Error - end. - -get_config_files() -> - TSConfig = "ts.config", - [TSConfig | case os:type() of - {unix,_} -> ["ts.unix.config"]; - {win32,_} -> ["ts.win32.config"]; - _ -> [] - end]. - -%% Makes the command to start up the Erlang node to run the tests. - -backslashify([$\\, $" | T]) -> - [$\\, $" | backslashify(T)]; -backslashify([$" | T]) -> - [$\\, $" | backslashify(T)]; -backslashify([H | T]) -> - [H | backslashify(T)]; -backslashify([]) -> - []. - -make_command(Vars, Spec, State) -> - {ok,Cwd} = file:get_cwd(), - TestDir = State#state.test_dir, - TestPath = filename:nativename(TestDir), - Erl = case os:getenv("TS_RUN_VALGRIND") of - false -> - atom_to_list(lib:progname()); - _ -> - case State#state.file of - Dir when is_list(Dir) -> - os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-"); - _ -> - ok - end, - "cerl -valgrind" ++ - case erlang:system_info(smp_support) of - true -> " -smp"; - false -> "" - end - end, - Naming = - case ts_lib:var(longnames, Vars) of - true -> - " -name "; - false -> - " -sname " - end, - ExtraArgs = - case lists:keysearch(erl_start_args,1,Vars) of - {value,{erl_start_args,Args}} -> Args; - false -> "" - end, - CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"), - case filelib:is_file(CrashFile) of - true -> - io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]), - file:delete(CrashFile); - false -> - ok - end, - - %% If Common Test specific variables are needed, add them here - %% on form: "{key1,value1}" "{key2,value2}" ... - NetDir = ts_lib:var(ts_net_dir, Vars), - TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ], - - %% NOTE: Do not use ' in these commands as it wont work on windows - Cmd = [Erl, Naming, "test_server" - " -rsh ", ts_lib:var(rsh_name, Vars), - " -env PATH \"", - backslashify(lists:flatten([TestPath, path_separator(), - remove_path_spaces()])), - "\"", - " -env ERL_CRASH_DUMP ", CrashFile, - %% uncomment the line below to disable exception formatting - %% " -test_server_format_exception false", - " -boot start_sasl -sasl errlog_type error", - " -pz \"",Cwd,"\"", - " -ct_test_vars ",TestVars, - " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ", - backslashify(lists:flatten(State#state.test_server_args)),")\"" - " ", - ExtraArgs], - {ok, Vars, Spec, State#state{command=lists:flatten(Cmd)}}. - - -run_batch(Vars, _Spec, State) -> - process_flag(trap_exit, true), - Command = State#state.command ++ " -noinput -s erlang halt", - ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]), - io:format(user, "Command: ~ts~n",[Command]), - Port = open_port({spawn, Command}, [stream, in, eof]), - Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of - false -> 1; - _ -> 100 - end, - tricky_print_data(Port, Timeout). - -tricky_print_data(Port, Timeout) -> - receive - {Port, {data, Bytes}} -> - io:put_chars(Bytes), - tricky_print_data(Port, Timeout); - {Port, eof} -> - Port ! {self(), close}, - receive - {Port, closed} -> - true - end, - receive - {'EXIT', Port, _} -> - ok - after 1 -> % force context switch - ok - end - after Timeout -> - case erl_epmd:names() of - {ok,Names} -> - case is_testnode_dead(Names) of - true -> - io:put_chars("WARNING: No EOF, but " - "test_server node is down!\n"); - false -> - tricky_print_data(Port, Timeout) - end; - _ -> - tricky_print_data(Port, Timeout) - end - end. - -is_testnode_dead([]) -> true; -is_testnode_dead([{"test_server",_}|_]) -> false; -is_testnode_dead([_|T]) -> is_testnode_dead(T). - -run_interactive(Vars, _Spec, State) -> - Command = State#state.command, - ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), - case ts_lib:var(os, Vars) of - "Windows 95" -> - %% Windows 95 strikes again! We must redirect standard - %% input and output for the `start' command, to force - %% standard input and output to the Erlang shell to be - %% connected to the newly started console. - %% Without these redirections, the Erlang shell would be - %% connected to the pipes provided by the port program - %% and there would be an inactive console window. - os:cmd("start < nul > nul w" ++ Command), - ok; - "Windows 98" -> - os:cmd("start < nul > nul w" ++ Command), - ok; - "Windows"++_ -> - os:cmd("start w" ++ Command), - ok; - _Other -> - %% Assuming ts and controller always run on solaris - start_xterm(Command) - end. - -start_xterm(Command) -> - case os:find_executable("xterm") of - false -> - io:format("The `xterm' program was not found.\n"), - {error, no_xterm}; - _Xterm -> - case os:getenv("DISPLAY") of - false -> - io:format("DISPLAY is not set.\n"), - {error, display_not_set}; - Display -> - io:format("Starting xterm (DISPLAY=~s)...\n", - [Display]), - os:cmd("xterm -sl 10000 -e " ++ Command ++ "&"), - ok - end - end. - -path_separator() -> - case os:type() of - {win32, _} -> ";"; - {unix, _} -> ":" - end. - - -make_common_test_args(Args0, Options0, _Vars) -> - Trace = - case lists:keysearch(trace,1,Options0) of - {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> - ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), - [{ct_trace,?tracefile}]; - {value,{trace,TIFile}} when is_atom(TIFile) -> - [{ct_trace,atom_to_list(TIFile)}]; - {value,{trace,TIFile}} -> - [{ct_trace,TIFile}]; - false -> - [] - end, - Cover = - case lists:keysearch(cover,1,Options0) of - {value,{cover, App, none, _Analyse}} -> - io:format("No cover file found for ~p~n",[App]), - []; - {value,{cover,_App,File,_Analyse}} -> - [{cover,to_list(File)},{cover_stop,false}]; - false -> - [] - end, - - Logdir = case lists:keysearch(logdir, 1, Options0) of - {value,{logdir, _}} -> - []; - false -> - [{logdir,"../test_server"}] - end, - - TimeTrap = [{scale_timetraps, true}], - - {ConfigPath, - Options} = case {os:getenv("TEST_CONFIG_PATH"), - lists:keysearch(config, 1, Options0)} of - {_,{value, {config, Path}}} -> - {Path,lists:keydelete(config, 1, Options0)}; - {false,false} -> - {"../test_server",Options0}; - {Path,_} -> - {Path,Options0} - end, - ConfigFiles = [{config,[filename:join(ConfigPath,File) - || File <- get_config_files()]}], - 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); -to_list(X) when is_list(X) -> - X. - -%% -%% Paths and spaces handling for w2k and XP -%% -remove_path_spaces() -> - Path = os:getenv("PATH"), - case os:type() of - {win32,nt} -> - remove_path_spaces(Path); - _ -> - Path - end. - -remove_path_spaces(Path) -> - SPath = split_path(Path), - [NSHead|NSTail] = lists:map(fun(X) -> filename:nativename( - filename:join( - translate_path(split_one(X)))) - end, - SPath), - NSHead ++ lists:flatten([[$;|X] || X <- NSTail]). - -translate_path(PList) -> - %io:format("translate_path([~p|~p]~n",[Base,PList]), - translate_path(PList,[]). - - -translate_path([],_) -> - []; -translate_path([PC | T],BaseList) -> - FullPath = filename:nativename(filename:join(BaseList ++ [PC])), - NewPC = case catch file:altname(FullPath) of - {ok,X} -> - X; - _ -> - PC - end, - %io:format("NewPC:~s, DirList:~p~n",[NewPC,DirList]), - NewBase = BaseList ++ [NewPC], - [NewPC | translate_path(T,NewBase)]. - -split_one(Path) -> - filename:split(Path). - -split_path(Path) -> - string:tokens(Path,";"). diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile deleted file mode 100644 index 8eec940505..0000000000 --- a/lib/test_server/test/Makefile +++ /dev/null @@ -1,92 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2012. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - test_server_SUITE \ - test_server_test_lib \ - erl2html2_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INSTALL_PROGS= $(TARGET_FILES) - -EMAKEFILE=Emakefile -COVERFILE=test_server.cover - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/test_server_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test - -EBIN = . - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -.PHONY: make_emakefile - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) \ - '*_SUITE_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) $(GEN_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) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)" - $(INSTALL_DATA) test_server_test_lib.hrl test_server.spec test_server.cover "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) - -release_docs_spec: diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/test_server/test/erl2html2_SUITE.erl deleted file mode 100644 index 9e6389109b..0000000000 --- a/lib/test_server/test/erl2html2_SUITE.erl +++ /dev/null @@ -1,277 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(erl2html2_SUITE). - --compile(export_all). - --include_lib("common_test/include/ct.hrl"). - - --define(HEADER, - ["\n", - "\n", - "\n", - "Module ", Src, "\n", - "\n", - "\n", - "\n"]). - -%%-------------------------------------------------------------------- -%% @spec suite() -> Info -%% Info = [tuple()] -%% @end -%%-------------------------------------------------------------------- -suite() -> - [{timetrap,{seconds,30}}, - {ct_hooks,[ts_install_cth,test_server_test_lib]}]. - -%%-------------------------------------------------------------------- -%% @spec init_per_suite(Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% Config0 = Config1 = [tuple()] -%% Reason = term() -%% @end -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - Config. - -%%-------------------------------------------------------------------- -%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} -%% Config0 = Config1 = [tuple()] -%% @end -%%-------------------------------------------------------------------- -end_per_suite(_Config) -> - ok. - -%%-------------------------------------------------------------------- -%% @spec init_per_group(GroupName, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% GroupName = atom() -%% Config0 = Config1 = [tuple()] -%% Reason = term() -%% @end -%%-------------------------------------------------------------------- -init_per_group(_GroupName, Config) -> - Config. - -%%-------------------------------------------------------------------- -%% @spec end_per_group(GroupName, Config0) -> -%% void() | {save_config,Config1} -%% GroupName = atom() -%% Config0 = Config1 = [tuple()] -%% @end -%%-------------------------------------------------------------------- -end_per_group(_GroupName, _Config) -> - ok. - -%%-------------------------------------------------------------------- -%% @spec init_per_testcase(TestCase, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% TestCase = atom() -%% Config0 = Config1 = [tuple()] -%% Reason = term() -%% @end -%%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> - Config. - -%%-------------------------------------------------------------------- -%% @spec end_per_testcase(TestCase, Config0) -> -%% void() | {save_config,Config1} | {fail,Reason} -%% TestCase = atom() -%% Config0 = Config1 = [tuple()] -%% Reason = term() -%% @end -%%-------------------------------------------------------------------- -end_per_testcase(_TestCase, _Config) -> - ok. - -%%-------------------------------------------------------------------- -%% @spec groups() -> [Group] -%% Group = {GroupName,Properties,GroupsAndTestCases} -%% GroupName = atom() -%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] -%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] -%% TestCase = atom() -%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} -%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | -%% repeat_until_any_ok | repeat_until_any_fail -%% N = integer() | forever -%% @end -%%-------------------------------------------------------------------- -groups() -> - []. - -%%-------------------------------------------------------------------- -%% @spec all() -> GroupsAndTestCases | {skip,Reason} -%% GroupsAndTestCases = [{group,GroupName} | TestCase] -%% GroupName = atom() -%% TestCase = atom() -%% Reason = term() -%% @end -%%-------------------------------------------------------------------- -all() -> - [macros_defined, macros_undefined]. - -%%-------------------------------------------------------------------- -%% @spec TestCase(Config0) -> -%% ok | exit() | {skip,Reason} | {comment,Comment} | -%% {save_config,Config1} | {skip_and_save,Reason,Config1} -%% Config0 = Config1 = [tuple()] -%% Reason = term() -%% Comment = term() -%% @end -%%-------------------------------------------------------------------- -macros_defined(Config) -> - %% let erl2html2 use epp as parser - DataDir = ?config(data_dir,Config), - InclDir = filename:join(DataDir, "include"), - {Src,Dst} = convert_module("m1",[InclDir],Config), - {true,L} = check_line_numbers(Src,Dst), - ok = check_link_targets(Src,Dst,L,[{baz,0}],[]), - ok. - -macros_undefined(Config) -> - %% let erl2html2 use epp_dodger as parser - {Src,Dst} = convert_module("m1",[],Config), - {true,L} = check_line_numbers(Src,Dst), - ok = check_link_targets(Src,Dst,L,[{baz,0}],[{quux,0}]), - ok. - -convert_module(Mod,InclDirs,Config) -> - DataDir = ?config(data_dir,Config), - PrivDir = ?config(priv_dir,Config), - Src = filename:join(DataDir,Mod++".erl"), - Dst = filename:join(PrivDir,Mod++".erl.html"), - io:format("~s\n",[Src,filename:basename(Src)]), - ok = erl2html2:convert(Src, Dst, InclDirs, ""), - io:format("~s\n",[Dst,filename:basename(Dst)]), - {Src,Dst}. - -%% Check that there are the same number of lines in each file, and -%% that all line numbers are displayed in the dst file. -check_line_numbers(Src,Dst) -> - {ok,SFd} = file:open(Src,[read]), - {ok,DFd} = file:open(Dst,[read]), - {ok,SN} = count_src_lines(SFd,0), - ok = file:close(SFd), - {ok,DN} = read_dst_line_numbers(DFd), - ok = file:close(DFd), - {SN == DN,SN}. - -count_src_lines(Fd,N) -> - case io:get_line(Fd,"") of - eof -> - {ok,N}; - {error,Reason} -> - {error,Reason,N}; - _Line -> - count_src_lines(Fd,N+1) - end. - -read_dst_line_numbers(Fd) -> - "

\n" = io:get_line(Fd,""),
-    read_dst_line_numbers(Fd,0).
-read_dst_line_numbers(Fd,Last) when is_integer(Last) ->
-    case io:get_line(Fd,"") of
-	eof ->
-	    {ok,Last};
-	{error,Reason} ->
-	    {error,Reason,Last};
-	"
"++_ -> - {ok,Last}; - ""++_ -> - {ok,Last}; - Line -> - %% erlang:display(Line), - Num = check_line_number(Last,Line,Line), - read_dst_line_numbers(Fd,Num) - end. - -check_line_number(Last,Line,OrigLine) -> - case Line of - " ct:fail({no_line_number_after,Last,OrigLine}) - end, - if Num == Last+1 -> - Num; - true -> - ct:fail({unexpected_integer,Num,Last}) - end - end. - - -%% Check that there is one link target for each line and one for each -%% function. -%% The test module has -compile(export_all), so all functions are -%% found by listing the exported ones. -check_link_targets(Src,Dst,L,RmFncs,ShouldRemain) -> - Mod = list_to_atom(filename:basename(filename:rootname(Src))), - Exports = Mod:module_info(exports)--[{module_info,0},{module_info,1}|RmFncs], - LastExprFuncs = [Func || {Func,_A} <- Exports], - {ok,{FAs,Fs,L},_} = - xmerl_sax_parser:file(Dst, - [{event_fun,fun sax_event/3}, - {event_state,{Exports,LastExprFuncs,0}}]), - true = (length(FAs) == length(ShouldRemain)), - [] = [FA || FA <- FAs, not lists:member(FA,ShouldRemain)], - [] = [F || F <- Fs, not lists:keymember(F,1,ShouldRemain)], - ok. - -sax_event(Event,_Loc,State) -> - sax_event(Event,State). - -sax_event({startElement,_Uri,"a",_QN,Attrs},{Exports,LastExprFuncs,PrevLine}) -> - {_,_,"name",Name} = lists:keyfind("name",3,Attrs), - case catch list_to_integer(Name) of - Line when is_integer(Line) -> - case PrevLine + 1 of - Line -> - {Exports,LastExprFuncs,Line}; - Other -> - ct:fail({unexpected_line_number_target,Other}) - end; - {'EXIT',_} -> - {match,[FStr,EndStr]} = - re:run(Name,"^(.*)-(last_expr|[0-9]+)$", - [{capture,all_but_first,list}]), - F = list_to_atom(http_uri:decode(FStr)), - case EndStr of - "last_expr" -> - true = lists:member(F,LastExprFuncs), - {Exports,lists:delete(F,LastExprFuncs),PrevLine}; - _ -> - A = list_to_integer(EndStr), - A = proplists:get_value(F,Exports), - {lists:delete({F,A},Exports),LastExprFuncs,PrevLine} - end - end; -sax_event(_,State) -> - State. diff --git a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src b/lib/test_server/test/erl2html2_SUITE_data/Makefile.src deleted file mode 100644 index 942ac0584b..0000000000 --- a/lib/test_server/test/erl2html2_SUITE_data/Makefile.src +++ /dev/null @@ -1,2 +0,0 @@ -all: - erlc -Iinclude m1.erl \ No newline at end of file diff --git a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl b/lib/test_server/test/erl2html2_SUITE_data/header1.hrl deleted file mode 100644 index 53d1b79ac5..0000000000 --- a/lib/test_server/test/erl2html2_SUITE_data/header1.hrl +++ /dev/null @@ -1,4 +0,0 @@ -baz() -> - ok. - --define(MACRO_DEFINING_A_FUNCTION,quux() -> ok). diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl b/lib/test_server/test/erl2html2_SUITE_data/include/header2.hrl deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl b/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl deleted file mode 100644 index 2a20850a3a..0000000000 --- a/lib/test_server/test/erl2html2_SUITE_data/include/header3.hrl +++ /dev/null @@ -1 +0,0 @@ --define(EPP_SWITCH, on). diff --git a/lib/test_server/test/erl2html2_SUITE_data/m1.erl b/lib/test_server/test/erl2html2_SUITE_data/m1.erl deleted file mode 100644 index 1d405963a5..0000000000 --- a/lib/test_server/test/erl2html2_SUITE_data/m1.erl +++ /dev/null @@ -1,52 +0,0 @@ -%% Comment with code & -%% and also some "quotes" and 'single quotes' - --module(m1). - --compile(export_all). - --include("header1.hrl"). --include("header2.hrl"). --include("header3.hrl"). - --define(MACRO1,value). - -%% This macro is used to select parser in erl2html2. -%% If EPP_SWITCH is defined epp is used, else epp_dodger. -epp_switch() -> - ?EPP_SWITCH. - -%%% Comment -foo(x) -> - %% Comment - ok_x; -foo(y) -> - %% Second clause - ok_y. - -'quoted_foo'() -> - ok. - -'quoted_foo_with_"_and_/'() -> - ok. - -'quoted_foo_with_(_and_)'() -> - ok. - -'quoted_foo_with_<_and_>'() -> - ok. - -bar() -> - do_something(), -ok. % indentation error, OTP-9710 - -%% Function inside macro definition -?MACRO_DEFINING_A_FUNCTION. - -%% Two function one one line -quuux() -> ok. quuuux() -> ok. - -%% do_something/0 does something -do_something() -> - ?MACRO1. -%% comments after last line diff --git a/lib/test_server/test/test_server.cover b/lib/test_server/test/test_server.cover deleted file mode 100644 index 052415377d..0000000000 --- a/lib/test_server/test/test_server.cover +++ /dev/null @@ -1 +0,0 @@ -{incl_app,test_server,details}. diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec deleted file mode 100644 index a3b4d01d08..0000000000 --- a/lib/test_server/test/test_server.spec +++ /dev/null @@ -1 +0,0 @@ -{suites, "../test_server_test", all}. diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl deleted file mode 100644 index 6adf5b8a78..0000000000 --- a/lib/test_server/test/test_server_SUITE.erl +++ /dev/null @@ -1,449 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%%%------------------------------------------------------------------- -%%% @author Lukas Larsson -%%% @copyright (C) 2011, Erlang Solutions Ltd. -%%% @doc -%%% -%%% @end -%%% Created : 15 Feb 2011 by Lukas Larsson -%%%------------------------------------------------------------------- --module(test_server_SUITE). - -%% Note: This directive should only be used in test suites. --compile(export_all). - --include_lib("common_test/include/ct.hrl"). --include("test_server_test_lib.hrl"). --include_lib("kernel/include/file.hrl"). - -%%-------------------------------------------------------------------- -%% COMMON TEST CALLBACK FUNCTIONS -%%-------------------------------------------------------------------- - -%% @spec suite() -> Info -suite() -> - [{ct_hooks,[ts_install_cth,test_server_test_lib]}]. - - -%% @spec init_per_suite(Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -init_per_suite(Config) -> - [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config]. - -%% @spec end_per_suite(Config) -> _ -end_per_suite(_Config) -> - io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]), - ok. - -%% @spec init_per_group(GroupName, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -init_per_group(_GroupName, Config) -> - Config. - -%% @spec end_per_group(GroupName, Config0) -> -%% void() | {save_config,Config1} -end_per_group(_GroupName, _Config) -> - ok. - -%% @spec init_per_testcase(TestCase, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -init_per_testcase(_TestCase, Config) -> - Config. - -%% @spec end_per_testcase(TestCase, Config0) -> -%% void() | {save_config,Config1} | {fail,Reason} -end_per_testcase(test_server_unicode, _Config) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), - N1 = list_to_atom("test_server_tester_latin1" ++ "@" ++ Host), - N2 = list_to_atom("test_server_tester_utf8" ++ "@" ++ Host), - test_server:stop_node(N1), - test_server:stop_node(N2), - ok; -end_per_testcase(_TestCase, _Config) -> - ok. - -%% @spec: groups() -> [Group] -groups() -> - []. - -%% @spec all() -> GroupsAndTestCases | {skip,Reason} -all() -> - [test_server_SUITE, test_server_parallel01_SUITE, - test_server_conf02_SUITE, test_server_conf01_SUITE, - test_server_skip_SUITE, test_server_shuffle01_SUITE, - test_server_break_SUITE, test_server_cover_SUITE, - test_server_unicode]. - - -%%-------------------------------------------------------------------- -%% TEST CASES -%%-------------------------------------------------------------------- -%% @spec TestCase(Config0) -> -%% ok | exit() | {skip,Reason} | {comment,Comment} | -%% {save_config,Config1} | {skip_and_save,Reason,Config1} -test_server_SUITE(Config) -> -% rpc:call(Node,dbg, tracer,[]), -% rpc:call(Node,dbg, p,[all,c]), -% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), - run_test_server_tests("test_server_SUITE", - [{test_server_SUITE,skip_case7,"SKIPPED!"}], - 40, 1, 32, 21, 9, 1, 11, 2, 27, Config). - -test_server_parallel01_SUITE(Config) -> - run_test_server_tests("test_server_parallel01_SUITE", [], - 37, 0, 19, 19, 0, 0, 0, 0, 37, Config). - -test_server_shuffle01_SUITE(Config) -> - run_test_server_tests("test_server_shuffle01_SUITE", [], - 130, 0, 0, 76, 0, 0, 0, 0, 130, Config). - -test_server_skip_SUITE(Config) -> - run_test_server_tests("test_server_skip_SUITE", [], - 3, 0, 1, 0, 1, 0, 3, 0, 0, Config). - -test_server_conf01_SUITE(Config) -> - run_test_server_tests("test_server_conf01_SUITE", [], - 24, 0, 12, 12, 0, 0, 0, 0, 24, Config). - -test_server_conf02_SUITE(Config) -> - run_test_server_tests("test_server_conf02_SUITE", [], - 26, 0, 12, 12, 0, 0, 0, 0, 26, Config). - -test_server_break_SUITE(Config) -> - run_test_server_tests("test_server_break_SUITE", [], - 8, 2, 6, 4, 0, 0, 0, 2, 6, Config). - -test_server_cover_SUITE(Config) -> - case test_server:is_cover() of - true -> - {skip, "Cover already running"}; - false -> - PrivDir = ?config(priv_dir,Config), - - %% Test suite has two test cases - %% tc1 calls cover_helper:foo/0 - %% tc2 calls cover_helper:bar/0 - %% Each function in cover_helper is one line. - %% - %% First test run skips tc2, so only cover_helper:foo/0 is executed. - %% Cover file specifies to include cover_helper in this test run. - CoverFile1 = filename:join(PrivDir,"t1.cover"), - CoverSpec1 = {include,[cover_helper]}, - file:write_file(CoverFile1,io_lib:format("~p.~n",[CoverSpec1])), - run_test_server_tests("test_server_cover_SUITE", - [{test_server_cover_SUITE,tc2,"SKIPPED!"}], - 4, 0, 2, 1, 1, 0, 1, 0, 3, - CoverFile1, Config), - - %% Next test run skips tc1, so only cover_helper:bar/0 is executed. - %% Cover file specifies cross compilation of cover_helper - CoverFile2 = filename:join(PrivDir,"t2.cover"), - CoverSpec2 = {cross,[{t1,[cover_helper]}]}, - file:write_file(CoverFile2,io_lib:format("~p.~n",[CoverSpec2])), - run_test_server_tests("test_server_cover_SUITE", - [{test_server_cover_SUITE,tc1,"SKIPPED!"}], - 4, 0, 2, 1, 1, 0, 1, 0, 3, CoverFile2, Config), - - %% Cross cover analyse - WorkDir = ?config(work_dir,Config), - WC = filename:join([WorkDir,"test_server_cover_SUITE.logs","run.*"]), - [D2,D1|_] = lists:reverse(lists:sort(filelib:wildcard(WC))), - TagDirs = [{t1,D1},{t2,D2}], - test_server_ctrl:cross_cover_analyse(details,TagDirs), - - %% Check that cover log shows only what is really included - %% in the test and cross cover log show the accumulated - %% result. - {ok,Cover1} = file:read_file(filename:join(D1,"cover.log")), - [{cover_helper,{1,1,_}}] = binary_to_term(Cover1), - {ok,Cover2} = file:read_file(filename:join(D2,"cover.log")), - [] = binary_to_term(Cover2), - {ok,Cross} = file:read_file(filename:join(D1,"cross_cover.log")), - [{cover_helper,{2,0,_}}] = binary_to_term(Cross), - ok - end. - -test_server_unicode(Config) -> - run_test_server_tests("test_server_unicode_SUITE", [], - 5, 0, 3, 3, 0, 0, 0, 0, 5, Config), - - %% Create and run two test suites - one with filename and content - %% in latin1 (if the default filename mode is latin1) and one with - %% filename and content in utf8. Both have name and content - %% including letters äöå. Check that all logs are generated with - %% utf8 encoded filenames. - case file:native_name_encoding() of - utf8 -> - ok; - latin1 -> - generate_and_run_unicode_test(Config,latin1) - end, - generate_and_run_unicode_test(Config,utf8). - -%%%----------------------------------------------------------------- -run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, - NUsrSkip, NAutoSkip, - NActualSkip, NActualFail, NActualSucc, Config) -> - run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, - NUsrSkip, NAutoSkip, - NActualSkip, NActualFail, NActualSucc, false, Config). - -run_test_server_tests(SuiteName, Skip, NCases, NFail, NExpected, NSucc, - NUsrSkip, NAutoSkip, - NActualSkip, NActualFail, NActualSucc, Cover, Config) -> - Node = proplists:get_value(node, Config), - Encoding = rpc:call(Node,file,native_name_encoding,[]), - WorkDir = proplists:get_value(work_dir, Config), - LogDir = filename:join(WorkDir, SuiteName++".logs"), - LogDirUri = test_server_ctrl:uri_encode(LogDir, Encoding), - ct:log("Test case log files\n", [LogDirUri]), - - {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), - case Cover of - false -> - ok; - _ -> - rpc:call(Node,test_server_ctrl,cover,[Cover,details]) - end, - rpc:call(Node, - test_server_ctrl,add_dir_with_skip, - [SuiteName, - [proplists:get_value(data_dir,Config)],SuiteName, - Skip]), - - until(fun() -> - rpc:call(Node,test_server_ctrl,jobs,[]) =:= [] - end), - - rpc:call(Node,test_server_ctrl, stop, []), - - LogDir1 = translate_filename(LogDir,Encoding), - LastRunDir = get_latest_run_dir(LogDir1), - LastSuiteLog = filename:join(LastRunDir,"suite.log"), - {ok,Data} = test_server_test_lib:parse_suite(LastSuiteLog), - check([{"Number of cases",NCases,Data#suite.n_cases}, - {"Number failed",NFail,Data#suite.n_cases_failed}, - {"Number expected",NExpected,Data#suite.n_cases_expected}, - {"Number successful",NSucc,Data#suite.n_cases_succ}, - {"Number user skipped",NUsrSkip,Data#suite.n_cases_user_skip}, - {"Number auto skipped",NAutoSkip,Data#suite.n_cases_auto_skip}], ok), - {NActualSkip,NActualFail,NActualSucc} = - lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> - {S+1,F,Su}; - (#tc{ result = auto_skip },{S,F,Su}) -> - {S+1,F,Su}; - (#tc{ result = ok },{S,F,Su}) -> - {S,F,Su+1}; - (#tc{ result = failed },{S,F,Su}) -> - {S,F+1,Su} - end,{0,0,0},Data#suite.cases), - Data. - -translate_filename(Filename,EncodingOnTestNode) -> - case {file:native_name_encoding(),EncodingOnTestNode} of - {X,X} -> Filename; - {utf8,latin1} -> list_to_binary(Filename); - {latin1,utf8} -> unicode:characters_to_binary(Filename) - end. - -get_latest_run_dir(Dir) -> - %% For the time being, filelib:wildcard can not take a binary - %% argument, so we avoid using this here. - case file:list_dir(Dir) of - {ok,Files} -> - {ok,RE} = re:compile(<<"^run.[1-2][-_\.0-9]*$">>), - RunDirs = lists:filter( - fun(F) -> - L = l(F), - case re:run(F,RE) of - {match,[{0,L}]} -> true; - _ -> false - end - end, Files), - case RunDirs of - [] -> - Dir; - [H|T] -> - filename:join(Dir,get_latest_dir(T,H)) - end; - _ -> - Dir - end. - -l(X) when is_binary(X) -> size(X); -l(X) when is_list(X) -> length(X). - -get_latest_dir([H|T],Latest) when H>Latest -> - get_latest_dir(T,H); -get_latest_dir([_|T],Latest) -> - get_latest_dir(T,Latest); -get_latest_dir([],Latest) -> - Latest. - -check([{Str,Same,Same}|T], Status) -> - io:format("~s: ~p\n", [Str,Same]), - check(T, Status); -check([{Str,Expected,Actual}|T], _) -> - io:format("~s: expected ~p, actual ~p\n", [Str,Expected,Actual]), - check(T, error); -check([], ok) -> ok; -check([], error) -> ?t:fail(). - -until(Fun) -> - case Fun() of - true -> - ok; - false -> - timer:sleep(100), - until(Fun) - end. - -generate_and_run_unicode_test(Config0,Encoding) -> - DataDir = ?config(data_dir,Config0), - Suite = create_unicode_test_suite(DataDir,Encoding), - - %% We can not run this test on default node since it must be - %% started with correct file name mode (+fnu/+fnl). - %% OBS: the node are stopped by end_per_testcase/2 - Config1 = lists:keydelete(node,1,Config0), - Config2 = lists:keydelete(work_dir,1,Config1), - NodeName = list_to_atom("test_server_tester_" ++ atom_to_list(Encoding)), - Config = start_node(Config2,NodeName,erts_switch(Encoding)), - - %% Compile the suite - Node = proplists:get_value(node,Config), - {ok,Mod} = rpc:call(Node,compile,file,[Suite,[{outdir,DataDir}]]), - ModStr = atom_to_list(Mod), - - %% Clean logdir - LogDir0 = filename:join(DataDir,ModStr++".logs"), - LogDir = translate_filename(LogDir0,Encoding), - rm_dir(LogDir), - - %% Run the test - run_test_server_tests(ModStr, [], 3, 0, 1, 1, 0, 0, 0, 0, 3, Config), - - %% Check that all logs are created with utf8 encoded filenames - true = filelib:is_dir(LogDir), - - RunDir = get_latest_run_dir(LogDir), - true = filelib:is_dir(RunDir), - - LowerModStr = string:to_lower(ModStr), - SuiteHtml = translate_filename(LowerModStr++".src.html",Encoding), - true = filelib:is_regular(filename:join(RunDir,SuiteHtml)), - - TCLog = translate_filename(LowerModStr++".tc_äöå.html",Encoding), - true = filelib:is_regular(filename:join(RunDir,TCLog)), - ok. - -%% Same as test_server_test_lib:start_slave, but starts a peer with -%% additional arguments. -%% The reason for this is that we need to start nodes with +fnu/+fnl, -%% and that will not work well with a slave node since slave nodes run -%% remote file system on master - i.e. they will use same file name -%% mode as the master. -start_node(Config,Name,Args) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), - ct:log("Trying to start ~w@~s~n",[Name,Host]), - case test_server:start_node(Name, peer, [{args,Args}]) of - {error,Reason} -> - test_server:fail(Reason); - {ok,Node} -> - ct:log("Node ~p started~n", [Node]), - test_server_test_lib:prepare_tester_node(Node,Config) - end. - -create_unicode_test_suite(Dir,Encoding) -> - ModStr = "test_server_"++atom_to_list(Encoding)++"_äöå_SUITE", - File = filename:join(Dir,ModStr++".erl"), - Suite = - ["%% -*- ",epp:encoding_to_string(Encoding)," -*-\n", - "-module(",ModStr,").\n" - "\n" - "-export([all/1, init_per_suite/1, end_per_suite/1]).\n" - "-export([init_per_testcase/2, end_per_testcase/2]).\n" - "-export([tc_äöå/1]).\n" - "\n" - "-include_lib(\"test_server/include/test_server.hrl\").\n" - "\n" - "all(suite) ->\n" - " [tc_äöå].\n" - "\n" - "init_per_suite(Config) ->\n" - " Config.\n" - "\n" - "end_per_suite(_Config) ->\n" - " ok.\n" - "\n" - "init_per_testcase(_Case,Config) ->\n" - " init_timetrap(500,Config).\n" - "\n" - "init_timetrap(T,Config) ->\n" - " Dog = ?t:timetrap(T),\n" - " [{watchdog, Dog}|Config].\n" - "\n" - "end_per_testcase(_Case,Config) ->\n" - " cancel_timetrap(Config).\n" - "\n" - "cancel_timetrap(Config) ->\n" - " Dog=?config(watchdog, Config),\n" - " ?t:timetrap_cancel(Dog),\n" - " ok.\n" - "\n" - "tc_äöå(Config) when is_list(Config) ->\n" - " true = filelib:is_dir(?config(priv_dir,Config)),\n" - " ok.\n"], - {ok,Fd} = file:open(raw_filename(File,Encoding),[write,{encoding,Encoding}]), - io:put_chars(Fd,Suite), - ok = file:close(Fd), - File. - -raw_filename(Name,latin1) -> list_to_binary(Name); -raw_filename(Name,utf8) -> unicode:characters_to_binary(Name). - -rm_dir(Dir) -> - case file:list_dir(Dir) of - {error,enoent} -> - ok; - {ok,Files} -> - rm_files([filename:join(Dir, F) || F <- Files]), - file:del_dir(Dir) - end. - -rm_files([F | Fs]) -> - case file:read_file_info(F) of - {ok,#file_info{type=directory}} -> - rm_dir(F), - rm_files(Fs); - {ok,_Regular} -> - case file:delete(F) of - ok -> - rm_files(Fs); - {error,Errno} -> - exit({del_failed,F,Errno}) - end - end; -rm_files([]) -> - ok. - -erts_switch(latin1) -> "+fnl"; -erts_switch(utf8) -> "+fnu". diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src deleted file mode 100644 index 5aeb035572..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/Makefile.src +++ /dev/null @@ -1,11 +0,0 @@ -all: - erlc test_server_SUITE.erl - erlc test_server_parallel01_SUITE.erl - erlc test_server_conf01_SUITE.erl - erlc test_server_shuffle01_SUITE.erl - erlc test_server_conf02_SUITE.erl - erlc test_server_skip_SUITE.erl - erlc test_server_break_SUITE.erl - erlc test_server_cover_SUITE.erl - erlc +debug_info test_server_cover_SUITE_data/cover_helper.erl - erlc test_server_unicode_SUITE.erl diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl deleted file mode 100644 index c3d4315cb8..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl +++ /dev/null @@ -1,514 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_SUITE). --include_lib("common_test/include/ct.hrl"). --include_lib("kernel/include/file.hrl"). --export([all/1]). - --export([init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). --export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, - init_per_s/1, init_per_tc/1, end_per_tc/1, - timeconv/1, msgs/1, capture/1, timecall/1, - do_times/1, do_times_mfa/1, do_times_fun/1, - skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, - skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, - conf_init/1, check_new_conf/1, conf_cleanup/1, - check_old_conf/1, conf_init_fail/1, start_stop_node/1, - cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, - commercial/1, - io_invalid_data/1, print_unexpected/1]). - --export([dummy_function/0,dummy_function/1,doer/1]). - -all(doc) -> ["Test Server self test"]; -all(suite) -> - [config, comment, timetrap, timetrap_cancel, multiply_timetrap, - init_per_s, init_per_tc, end_per_tc, - timeconv, msgs, capture, timecall, do_times, skip_cases, - commercial, io_invalid_data, print_unexpected, - {conf, conf_init, [check_new_conf], conf_cleanup}, - check_old_conf, - {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, - start_stop_node, - {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, - config - ]. - - -init_per_suite(Config) -> - [{init_per_suite_var,ok}|Config]. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - Config1 = [{watchdog, Dog}|Config], - case Func of - init_per_tc -> - [{strange_var, 1}|Config1]; - skip_case8 -> - {skipped, "This case should be noted as `Skipped'"}; - skip_case9 -> - {skip, "This case should be noted as `Skipped'"}; - _ -> - Config1 - end; -init_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to init_per_testcase not correct"). - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - case Func of - end_per_tc -> io:format("CLEANUP => this test case is ok\n"); - _Other -> ok - end; -end_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to end_per_testcase not correct"). - -fin_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). - - -config(suite) -> []; -config(doc) -> ["Test that the Config variable is decent, ", - "and that the std config variables are correct ", - "(check that data/priv dir exists)." - "Also check that ?config macro works."]; -config(Config) when is_list(Config) -> - is_tuplelist(Config), - {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), - true=is_dir(Dd), - {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), - true=is_dir(Dp), - - Dd = ?config(data_dir,Config), - Dp = ?config(priv_dir,Config), - ok; -config(_Config) -> - ?t:fail("Config variable is not a list."). - -is_tuplelist([]) -> - true; -is_tuplelist([{_A,_B}|Rest]) -> - is_tuplelist(Rest); -is_tuplelist(_) -> - false. - -is_dir(Dir) -> - case file:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> - true; - _ -> - false - end. - -comment(suite) -> []; -comment(doc) -> ["Print a comment in the HTML log"]; -comment(Config) when is_list(Config) -> - ?t:comment("This comment should not occur in the HTML log because a later" - " comment shall overwrite it"), - ?t:comment("This comment is printed with the comment/1 function." - " It should occur in the HTML log"). - - - -timetrap(suite) -> []; -timetrap(doc) -> ["Test that timetrap works."]; -timetrap(Config) when is_list(Config) -> - TrapAfter = 3000, - Dog=?t:timetrap(TrapAfter), - process_flag(trap_exit, true), - TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, - receive - {'EXIT', Dog, {timetrap_timeout, _, _}} -> - ok; - {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> - ?t:fail("EXIT signal from wrong process") - after - TimeOut -> - ?t:fail("Timetrap is not working.") - end, - ?t:timetrap_cancel(Dog), - ok. - - -timetrap_cancel(suite) -> []; -timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; -timetrap_cancel(Config) when is_list(Config) -> - Dog=?t:timetrap(1000), - receive - after - 500 -> - ok - end, - ?t:timetrap_cancel(Dog), - receive - after 1000 -> - ok - end, - ok. - -multiply_timetrap(suite) -> []; -multiply_timetrap(doc) -> ["Test multiply timetrap"]; -multiply_timetrap(Config) when is_list(Config) -> - %% This simulates the call to test_server_ctrl:multiply_timetraps/1: - put(test_server_multiply_timetraps,{2,true}), - - Dog = ?t:timetrap(500), - timer:sleep(800), - ?t:timetrap_cancel(Dog), - - %% Reset - put(test_server_multiply_timetraps,1), - ok. - - -init_per_s(suite) -> []; -init_per_s(doc) -> ["Test that a Config that is altered in ", - "init_per_suite gets through to the testcases."]; -init_per_s(Config) -> - %% Check that the config var sent from init_per_suite - %% really exists. - {value, {init_per_suite_var, ok}} = - lists:keysearch(init_per_suite_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -init_per_tc(suite) -> []; -init_per_tc(doc) -> ["Test that a Config that is altered in ", - "init_per_testcase gets through to the ", - "actual testcase."]; -init_per_tc(Config) -> - %% Check that the config var sent from init_per_testcase - %% really exists. - {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -end_per_tc(suite) -> []; -end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" - " test case fails"]; -end_per_tc(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that \"CLEANUP\" is" - " printed in the minor log file."). - - -timeconv(suite) -> []; -timeconv(doc) -> ["Test that the time unit conversion functions ", - "works."]; -timeconv(Config) when is_list(Config) -> - Val=2, - Secs=Val*1000, - Mins=Secs*60, - Hrs=Mins*60, - Secs=?t:seconds(2), - Mins=?t:minutes(2), - Hrs=?t:hours(2), - ok. - - -msgs(suite) -> []; -msgs(doc) -> ["Tests the messages_get function."]; -msgs(Config) when is_list(Config) -> - self() ! {hej, du}, - self() ! {lite, "data"}, - self() ! en_atom, - [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), - ok. - -capture(suite) -> []; -capture(doc) -> ["Test that the capture functions work properly."]; -capture(Config) when is_list(Config) -> - String1="abcedfghjiklmnopqrstuvwxyz", - String2="0123456789", - ?t:capture_start(), - io:format(String1), - [String1]=?t:capture_get(), - io:format(String2), - [String2]=?t:capture_get(), - ?t:capture_stop(), - []=?t:capture_get(), - io:format(String2), - []=?t:capture_get(), - ok. - -timecall(suite) -> []; -timecall(doc) -> ["Tests that timed calls work."]; -timecall(Config) when is_list(Config) -> - {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), - {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), - DTime=round(Time2), - if - DTime<1 -> - ?t:fail("Timecall reported a too low time."); - DTime==1 -> - ok; - DTime>1 -> - ?t:fail("Timecall reported a too high time.") - end, - ok. - -dummy_function() -> - liten_apa_e_oxo_farlig. -dummy_function(gorilla) -> - receive after 1000 -> ok end, - jag_ar_en_gorilla. - - -do_times(suite) -> [do_times_mfa, do_times_fun]; -do_times(doc) -> ["Test the do_times function."]. - -do_times_mfa(suite) -> []; -do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; -do_times_mfa(Config) when is_list(Config) -> - ?t:do_times(100, ?MODULE, doer, [self()]), - 100=length(?t:messages_get()), - ok. - -do_times_fun(suite) -> []; -do_times_fun(doc) -> ["Test the do_times function with fun given."]; -do_times_fun(Config) when is_list(Config) -> - Self = self(), - ?t:do_times(100, fun() -> doer(Self) end), - 100=length(?t:messages_get()), - ok. - -doer(From) -> - From ! a, - ok. - -skip_cases(doc) -> ["Test all possible ways to skip a test case."]; -skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, - skip_case5, skip_case6, skip_case7, skip_case8, - skip_case9]. - -skip_case1(suite) -> []; -skip_case1(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case1(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - {skipped, "This case should be noted as `Skipped'"}. - -skip_case2(suite) -> []; -skip_case2(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case2(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - exit({skipped, "This case should be noted as `Skipped'"}). - -skip_case3(suite) -> []; -skip_case3(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case3(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - {skip, "This case should be noted as `Skipped'"}. - -skip_case4(suite) -> []; -skip_case4(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case4(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - exit({skip, "This case should be noted as `Skipped'"}). - -skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; -skip_case5(doc) -> ["Test that you can return {skipped, Reason}" - " from the specification clause"]. - -skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; -skip_case6(doc) -> ["Test that you can return {skip, Reason}" - " from the specification clause"]. - -skip_case7(suite) -> []; -skip_case7(doc) -> ["Test that skip works from a test specification file"]; -skip_case7(Config) when is_list(Config) -> - %% This case shall be skipped by adding - %% {skip, {test_server_SUITE, skip_case7, Reason}}. - %% to the test specification file. - ?t:fail("This case should have been Skipped by the .spec file"). - -skip_case8(suite) -> []; -skip_case8(doc) -> ["Test that {skipped, Reason} works from" - " init_per_testcase/2"]; -skip_case8(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skipped, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -skip_case9(suite) -> []; -skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; -skip_case9(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skip, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; -conf_init(Config) when is_list(Config) -> - [{conf_init_var,1389}|Config]. - -check_new_conf(suite) -> []; -check_new_conf(doc) -> ["Check that Config parameter changed by" - " conf_init is used"]; -check_new_conf(Config) when is_list(Config) -> - 1389 = ?config(conf_init_var,Config), - ok. - -conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; -conf_cleanup(Config) when is_list(Config) -> - lists:keydelete(conf_init_var,1,Config). - -check_old_conf(suite) -> []; -check_old_conf(doc) -> ["Test that the restored Config is used after a" - " conf cleanup"]; -check_old_conf(Config) when is_list(Config) -> - undefined = ?config(conf_init_var,Config), - ok. - -conf_init_fail(doc) -> ["Test that config members are skipped if" - " conf init function fails."]; -conf_init_fail(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that conf_member_skip and" - " conf_cleanup_skip are skipped."). - - - -start_stop_node(suite) -> []; -start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; -start_stop_node(Config) when is_list(Config) -> - {ok,Node2} = ?t:start_node(node2,peer,[]), - {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), - true = lists:member(Node2,nodes()), - - {ok,Node3} = ?t:start_node(node3,slave,[]), - {error, _} = ?t:start_node(node3,slave,[]), - true = lists:member(Node3,nodes()), - - {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), - case lists:member(Node4,nodes()) of - true -> - ?t:comment("WARNING: Node started with {wait,false}" - " is up faster than expected..."); - false -> - test_server:wait_for_node(Node4), - true = lists:member(Node4,nodes()) - end, - - true = ?t:stop_node(Node2), - false = lists:member(Node2,nodes()), - - true = ?t:stop_node(Node3), - false = lists:member(Node3,nodes()), - - true = ?t:stop_node(Node4), - false = lists:member(Node4,nodes()), - timer:sleep(2000), - false = ?t:stop_node(Node4), - - ok. - -cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" - " is finished unless {cleanup,false} is given."]; -cleanup_nodes_init(Config) when is_list(Config) -> - {ok,DieSlave} = ?t:start_node(die_slave, slave, []), - {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), - {ok,DiePeer} = ?t:start_node(die_peer, peer, []), - {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), - [{die_slave,DieSlave}, - {survive_slave,SurviveSlave}, - {die_peer,DiePeer}, - {survive_peer,SurvivePeer} | Config]. - - - -check_survive_nodes(suite) -> []; -check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; -check_survive_nodes(Config) when is_list(Config) -> - timer:sleep(1000), - false = lists:member(?config(die_slave,Config),nodes()), - true = lists:member(?config(survive_slave,Config),nodes()), - false = lists:member(?config(die_peer,Config),nodes()), - true = lists:member(?config(survive_peer,Config),nodes()), - ok. - - -cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" - " can be stopped"]; -cleanup_nodes_fin(Config) when is_list(Config) -> - Slave = ?config(survive_slave,Config), - Peer = ?config(survive_peer,Config), - - true = ?t:stop_node(Slave), - false = lists:member(Slave,nodes()), - true = ?t:stop_node(Peer), - false = lists:member(Peer,nodes()), - - C1 = lists:keydelete(die_slave,1,Config), - C2 = lists:keydelete(survive_slave,1,C1), - C3 = lists:keydelete(die_peer,1,C2), - lists:keydelete(survive_peer,1,C3). - -commercial(Config) when is_list(Config) -> - case ?t:is_commercial() of - false -> {comment,"Open-source build"}; - true -> {comment,"Commercial build"} - end. - -io_invalid_data(Config) when is_list(Config) -> - ok = io:put_chars("valid: " ++ [42]), - %% OTP-10991 caused this to hang and produce a timetrap timeout: - {'EXIT',{badarg,_}} = (catch io:put_chars("invalid: " ++ [42.0])), - ok. - -print_unexpected(Config) when is_list(Config) -> - Str = "-x-x-x- test_server_SUITE:print_unexpected -> Unexpected data -x-x-x-", - test_server_io:print_unexpected(Str), - UnexpectedLog = filename:join(filename:dirname(?config(tc_logfile,Config)), - "unexpected_io.log.html"), - {ok,Bin} = file:read_file(UnexpectedLog), - match = re:run(Bin, Str, [global,{capture,none}]), - ok. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file deleted file mode 100644 index 65c88fbd75..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file +++ /dev/null @@ -1 +0,0 @@ -Dummy file. \ No newline at end of file diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl deleted file mode 100644 index 171f83df0f..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_break_SUITE.erl +++ /dev/null @@ -1,149 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_break_SUITE). - --export([all/1, init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2]). --export([break_in_init_tc/1, - break_in_tc/1, - break_in_end_tc/1, - break_in_end_tc_after_fail/1, - break_in_end_tc_after_abort/1, - check_all_breaks/1]). - --include_lib("common_test/include/ct.hrl"). - -all(suite) -> - [break_in_init_tc, - break_in_tc, - break_in_end_tc, - break_in_end_tc_after_fail, - break_in_end_tc_after_abort, - check_all_breaks]. %must be the last test - checks result of previous tests - -init_per_suite(Config) -> - spawn(fun break_and_continue_sup/0), - Config. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(Case,Config) when Case==break_in_init_tc -> - Config1 = init_timetrap(500,Config), - break_and_check(Case), - Config1; -init_per_testcase(Case,Config) when Case==check_all_breaks -> - init_timetrap({seconds,20},Config); -init_per_testcase(_Case,Config) -> - init_timetrap(500,Config). - -init_timetrap(T,Config) -> - Dog = ?t:timetrap(T), - [{watchdog, Dog}|Config]. - -end_per_testcase(Case,Config) when Case==break_in_end_tc; - Case==break_in_end_tc_after_fail; - Case==break_in_end_tc_after_abort -> - break_and_check(Case), - cancel_timetrap(Config); -end_per_testcase(_Case,Config) -> - cancel_timetrap(Config). - -cancel_timetrap(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - - -%%%----------------------------------------------------------------- -%%% Test cases - -break_in_init_tc(Config) when is_list(Config) -> - ok. - -break_in_tc(Config) when is_list(Config) -> - break_and_check(break_in_tc), - ok. - -break_in_end_tc(Config) when is_list(Config) -> - ok. - -break_in_end_tc_after_fail(Config) when is_list(Config) -> - ?t:fail(test_case_should_fail). - -break_in_end_tc_after_abort(Config) when is_list(Config) -> - ?t:adjusted_sleep(2000). % will cause a timetrap timeout - -%% This test case checks that all breaks in previous test cases was -%% also continued, and that the break lasted as long as expected. -%% The reason for this is that some of the breaks above are in -%% end_per_testcase, and failures there will only produce a warning, -%% not an error - so this is to catch the error for real. -check_all_breaks(Config) when is_list(Config) -> - break_and_continue_sup ! {done,self()}, - receive {Breaks,Continued} -> - check_all_breaks(Breaks,Continued) - end. -%%%----------------------------------------------------------------- -%%% Internal functions - - -check_all_breaks([{From,Case,T,Start}|Breaks],[{From,End}|Continued]) -> - Diff = timer:now_diff(End,Start), - DiffSec = round(Diff/1000000), - TSec = round(T/1000000), - if DiffSec==TSec -> - ?t:format("Break in ~p successfully continued after ~p second(s)~n", - [Case,DiffSec]), - check_all_breaks(Breaks,Continued); - true -> - ?t:format("Faulty duration of break in ~p: continued after ~p second(s)~n", - [Case,DiffSec]), - ?t:fail({faulty_diff,Case,DiffSec,TSec}) - end; -check_all_breaks([],[]) -> - ok; -check_all_breaks(Breaks,Continued) -> - %% This is probably a case of a missing continue - i.e. a break - %% has been started, but it was never continued. - ?t:fail({no_match_in_breaks_and_continued,Breaks,Continued}). - -break_and_check(Case) -> - break_and_continue_sup ! {break,Case,1000,self()}, - ?t:break(atom_to_list(Case)), - break_and_continue_sup ! {continued,self()}, - ok. - -break_and_continue_sup() -> - register(break_and_continue_sup,self()), - break_and_continue_loop([],[]). - -break_and_continue_loop(Breaks,Continued) -> - receive - {break,Case,T,From} -> - Start = now(), - {RealT,_} = timer:tc(?t,adjusted_sleep,[T]), - ?t:continue(), - break_and_continue_loop([{From,Case,RealT,Start}|Breaks],Continued); - {continued,From} -> - break_and_continue_loop(Breaks,[{From,now()}|Continued]); - {done,From} -> - From ! {lists:reverse(Breaks),lists:reverse(Continued)} - end. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl deleted file mode 100644 index e4f40f6c03..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl +++ /dev/null @@ -1,188 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_conf01_SUITE). --include_lib("common_test/include/ct.hrl"). - --compile(export_all). - -all(doc) -> ["Test simple conf case structure, with and without nested cases"]; -all(suite) -> - [ - {conf, conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, - - {conf, [], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, - - {conf, conf3_init, [conf3_tc1, - - {conf, [], conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, - - conf3_tc2], conf3_end}, - - conf5 - ]. - -%%---------- conf cases ---------- - -conf1_init(Config) when is_list(Config) -> - [{cc1,conf1}|Config]. -conf1_end(_Config) -> - ok. - -conf2_init(Config) when is_list(Config) -> - [{cc2,conf2}|Config]. -conf2_end(_Config) -> - ok. - -conf3_init(Config) when is_list(Config) -> - [{cc3,conf3}|Config]. -conf3_end(_Config) -> - ok. - -conf4_init(Config) when is_list(Config) -> - [{cc4,conf4}|Config]. -conf4_end(_Config) -> - ok. - -conf5_init(Config) when is_list(Config) -> - [{cc5,conf5}|Config]. -conf5_end(_Config) -> - ok. - -conf6_init(Config) when is_list(Config) -> - [{cc6,conf6}|Config]. -conf6_end(_Config) -> - ok. - - -conf5(suite) -> % test specification - [{conf, conf5_init, [conf5_tc1, - - {conf, [], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, - - conf5_tc2], conf5_end}]. - - -%%---------- test cases ---------- - -conf1_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - conf1 = ?config(cc1,Config), - ok. -conf1_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf1 = ?config(cc1,Config), - ok. - -conf2_tc1(Config) when is_list(Config) -> - undefined = ?config(cc1,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - conf2 = ?config(cc2,Config), - ok. -conf2_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf2 = ?config(cc2,Config), - ok. - -conf3_tc1(Config) when is_list(Config) -> - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - ok. -conf3_tc2(Config) when is_list(Config) -> - conf3 = ?config(cc3,Config), - undefined = ?config(cc4,Config), - ok. - -conf4_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - ok. -conf4_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - ok. - -conf5_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - ok. -conf5_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - undefined = ?config(cc6,Config), - ok. - -conf6_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - ok. -conf6_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - ok. - diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl deleted file mode 100644 index 1c6fe6dd0b..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl +++ /dev/null @@ -1,295 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_conf02_SUITE). --include_lib("common_test/include/ct.hrl"). - --compile(export_all). - -all(doc) -> ["Test simple conf case structure, with and without nested cases"]; -all(suite) -> - [ - {conf, conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, - - {conf, [], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, - - {conf, conf3_init, [conf3_tc1, - - {conf, [], conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, - - conf3_tc2], conf3_end}, - - conf5 - ]. - - -%%---------- conf cases ---------- - -init_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - [{suite,init}|Config]. -end_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - ok. - -init_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - [{tc11,TC}|Config]; -init_per_testcase(TC=conf1_tc2, Config) -> - [{tc12,TC}|Config]; -init_per_testcase(TC=conf2_tc1, Config) -> - [{tc21,TC}|Config]; -init_per_testcase(TC=conf2_tc2, Config) -> - [{tc22,TC}|Config]; -init_per_testcase(TC=conf3_tc1, Config) -> - [{tc31,TC}|Config]; -init_per_testcase(TC=conf3_tc2, Config) -> - [{tc32,TC}|Config]; -init_per_testcase(TC=conf4_tc1, Config) -> - [{tc41,TC}|Config]; -init_per_testcase(TC=conf4_tc2, Config) -> - [{tc42,TC}|Config]; -init_per_testcase(TC=conf5_tc1, Config) -> - [{tc51,TC}|Config]; -init_per_testcase(TC=conf5_tc2, Config) -> - [{tc52,TC}|Config]; -init_per_testcase(TC=conf6_tc1, Config) -> - [{tc61,TC}|Config]; -init_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - [{tc62,TC}|Config]. - -end_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - TC = ?config(tc11,Config), - ok; -end_per_testcase(TC=conf1_tc2, Config) -> - TC = ?config(tc12,Config), - ok; -end_per_testcase(TC=conf2_tc1, Config) -> - TC = ?config(tc21,Config), - ok; -end_per_testcase(TC=conf2_tc2, Config) -> - TC = ?config(tc22,Config), - ok; -end_per_testcase(TC=conf3_tc1, Config) -> - TC = ?config(tc31,Config), - ok; -end_per_testcase(TC=conf3_tc2, Config) -> - TC = ?config(tc32,Config), - ok; -end_per_testcase(TC=conf4_tc1, Config) -> - TC = ?config(tc41,Config), - ok; -end_per_testcase(TC=conf4_tc2, Config) -> - TC = ?config(tc42,Config), - ok; -end_per_testcase(TC=conf5_tc1, Config) -> - TC = ?config(tc51,Config), - ok; -end_per_testcase(TC=conf5_tc2, Config) -> - TC = ?config(tc52,Config), - ok; -end_per_testcase(TC=conf6_tc1, Config) -> - TC = ?config(tc61,Config), - ok; -end_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - TC = ?config(tc62,Config), - ok. - -conf1_init(Config) when is_list(Config) -> - init = ?config(suite,Config), - [{cc1,conf1}|Config]. -conf1_end(_Config) -> - ok. - -conf2_init(Config) when is_list(Config) -> - [{cc2,conf2}|Config]. -conf2_end(_Config) -> - ok. - -conf3_init(Config) when is_list(Config) -> - [{cc3,conf3}|Config]. -conf3_end(_Config) -> - ok. - -conf4_init(Config) when is_list(Config) -> - [{cc4,conf4}|Config]. -conf4_end(_Config) -> - ok. - -conf5_init(Config) when is_list(Config) -> - [{cc5,conf5}|Config]. -conf5_end(_Config) -> - ok. - -conf6_init(Config) when is_list(Config) -> - init = ?config(suite,Config), - [{cc6,conf6}|Config]. -conf6_end(_Config) -> - ok. - -conf5(suite) -> % test specification - [{conf, conf5_init, [conf5_tc1, - - {conf, [], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, - - conf5_tc2], conf5_end}]. - -%%---------- test cases ---------- - -conf1_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc1 = ?config(tc11,Config), - ok. -conf1_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc2 = ?config(tc12,Config), - ok. - -conf2_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - undefined = ?config(cc1,Config), - undefined = ?config(tc11,Config), - conf2 = ?config(cc2,Config), - conf2_tc1 = ?config(tc21,Config), - ok. -conf2_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - conf2 = ?config(cc2,Config), - undefined = ?config(tc21,Config), - conf2_tc2 = ?config(tc22,Config), - ok. - -conf3_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - undefined = ?config(cc2,Config), - undefined = ?config(tc22,Config), - conf3 = ?config(cc3,Config), - conf3_tc1 = ?config(tc31,Config), - ok. -conf3_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - conf3 = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(tc31,Config), - undefined = ?config(tc41,Config), - conf3_tc2 = ?config(tc32,Config), - ok. - -conf4_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - undefined = ?config(tc32,Config), - conf4_tc1 = ?config(tc41,Config), - ok. -conf4_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - undefined = ?config(tc41,Config), - conf4_tc2 = ?config(tc42,Config), - ok. - -conf5_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - undefined = ?config(tc42,Config), - conf5_tc1 = ?config(tc51,Config), - ok. -conf5_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - undefined = ?config(cc6,Config), - undefined = ?config(tc51,Config), - undefined = ?config(tc62,Config), - conf5_tc2 = ?config(tc52,Config), - ok. - -conf6_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - undefined = ?config(tc52,Config), - conf6_tc1 = ?config(tc61,Config), - ok. -conf6_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - undefined = ?config(tc61,Config), - conf6_tc2 = ?config(tc62,Config), - ok. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl deleted file mode 100644 index 3371418980..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE.erl +++ /dev/null @@ -1,59 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_cover_SUITE). - --export([all/1, init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2]). --export([tc1/1, tc2/1]). - --include_lib("common_test/include/ct.hrl"). - -all(suite) -> - [tc1,tc2]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(_Case,Config) -> - Dog = ?t:timetrap({minutes,10}), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case,Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - - -%%%----------------------------------------------------------------- -%%% Test cases -tc1(Config) when is_list(Config) -> - cover_helper:foo(), - ok. - -tc2(Config) when is_list(Config) -> - cover_helper:bar(), - ok. - -%%%----------------------------------------------------------------- -%%% Internal functions - diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl b/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl deleted file mode 100644 index 6c74eb4e8a..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_cover_SUITE_data/cover_helper.erl +++ /dev/null @@ -1,4 +0,0 @@ --module(cover_helper). --compile(export_all). -foo() -> ok. -bar() -> ok. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl deleted file mode 100644 index ad639b585d..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl +++ /dev/null @@ -1,519 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_parallel01_SUITE). --include_lib("common_test/include/ct.hrl"). - --compile(export_all). - -%% ------------------------------------------------------------------- -%% Notes on parallel execution of test cases -%% ------------------------------------------------------------------- -%% -%% A group nested under a parallel group will start executing in -%% parallel with previous (parallel) test cases (no matter what -%% properties the nested group has). Test cases are however never -%% executed in parallel with the start or end conf case of the same -%% group! Because of this, the test_server_ctrl loop waits at -%% the end conf of a group for all parallel cases to finish -%% before the end conf case actually executes. This has the effect -%% that it's only after a nested group has finished that any -%% remaining parallel cases in the previous group get spawned (*). -%% Example (all parallel cases): -%% -%% group1_init |----> -%% group1_case1 | ---------> -%% group1_case2 | ---------------------------------> -%% group2_init | ----> -%% group2_case1 | ------> -%% group2_case2 | ----------> -%% group2_end | ---> -%% group1_case3 (*)| ----> -%% group1_case4 (*)| --> -%% group1_end | ---> -%% - -all(doc) -> ["Test simple conf case structure, with and without nested cases"]; -all(suite) -> - [ - {conf, [parallel], conf1_init, [conf1_tc1, conf1_tc2], conf1_end}, - - {conf, [parallel], conf2_init, [conf2_tc1, conf2_tc2], conf2_end}, - - {conf, [parallel], conf3_init, [conf3_tc1, conf3_tc1, - - {conf, [], - conf4_init, [conf4_tc1, conf4_tc2], conf4_end}, - - conf3_tc2], conf3_end}, - - conf5, - - {conf, [parallel], conf7_init, [conf7_tc1, conf7_tc1, - - {conf, [parallel], - conf8_init, [conf8_tc1, conf8_tc2], conf8_end}, - - conf7_tc2], conf7_end} - - ]. - - -%%---------- conf cases ---------- - -init_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - [{suite,init}|Config]. -end_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - ok. - -init_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - [{tc11,TC}|Config]; -init_per_testcase(TC=conf1_tc2, Config) -> - [{tc12,TC}|Config]; -init_per_testcase(TC=conf2_tc1, Config) -> - [{tc21,TC}|Config]; -init_per_testcase(TC=conf2_tc2, Config) -> - [{tc22,TC}|Config]; -init_per_testcase(TC=conf3_tc1, Config) -> - [{tc31,TC}|Config]; -init_per_testcase(TC=conf3_tc2, Config) -> - [{tc32,TC}|Config]; -init_per_testcase(TC=conf4_tc1, Config) -> - [{tc41,TC}|Config]; -init_per_testcase(TC=conf4_tc2, Config) -> - [{tc42,TC}|Config]; -init_per_testcase(TC=conf5_tc1, Config) -> - [{tc51,TC}|Config]; -init_per_testcase(TC=conf5_tc2, Config) -> - [{tc52,TC}|Config]; -init_per_testcase(TC=conf6_tc1, Config) -> - [{tc61,TC}|Config]; -init_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - [{tc62,TC}|Config]; -init_per_testcase(TC=conf7_tc1, Config) -> - [{tc71,TC}|Config]; -init_per_testcase(TC=conf7_tc2, Config) -> - [{tc72,TC}|Config]; -init_per_testcase(TC=conf8_tc1, Config) -> - [{tc81,TC}|Config]; -init_per_testcase(TC=conf8_tc2, Config) -> - init = ?config(suite,Config), - [{tc82,TC}|Config]. - -end_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - TC = ?config(tc11,Config), - ok; -end_per_testcase(TC=conf1_tc2, Config) -> - TC = ?config(tc12,Config), - ok; -end_per_testcase(TC=conf2_tc1, Config) -> - TC = ?config(tc21,Config), - ok; -end_per_testcase(TC=conf2_tc2, Config) -> - TC = ?config(tc22,Config), - ok; -end_per_testcase(TC=conf3_tc1, Config) -> - TC = ?config(tc31,Config), - ok; -end_per_testcase(TC=conf3_tc2, Config) -> - TC = ?config(tc32,Config), - ok; -end_per_testcase(TC=conf4_tc1, Config) -> - TC = ?config(tc41,Config), - ok; -end_per_testcase(TC=conf4_tc2, Config) -> - TC = ?config(tc42,Config), - ok; -end_per_testcase(TC=conf5_tc1, Config) -> - TC = ?config(tc51,Config), - ok; -end_per_testcase(TC=conf5_tc2, Config) -> - TC = ?config(tc52,Config), - ok; -end_per_testcase(TC=conf6_tc1, Config) -> - TC = ?config(tc61,Config), - ok; -end_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - TC = ?config(tc62,Config), - ok; -end_per_testcase(TC=conf7_tc1, Config) -> - TC = ?config(tc71,Config), - ok; -end_per_testcase(TC=conf7_tc2, Config) -> - TC = ?config(tc72,Config), - ok; -end_per_testcase(TC=conf8_tc1, Config) -> - TC = ?config(tc81,Config), - ok; -end_per_testcase(TC=conf8_tc2, Config) -> - init = ?config(suite,Config), - TC = ?config(tc82,Config), - ok. - -conf1_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - init = ?config(suite,Config), - [{t0,now()},{cc1,conf1}|Config]. -conf1_end(Config) -> - %% check 2s & 3s < 4s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); - Ms < 3000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf2_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - [{t0,now()},{cc2,conf2}|Config]. -conf2_end(Config) -> - %% check 3s & 2s < 4s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); - Ms < 3000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf3_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - [{t0,now()},{cc3,conf3}|Config]. -conf3_end(Config) -> - %% check 6s & 6s & (2s & 3s) & 1s = ~6s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 7000000 -> exit({bad_parallel_exec,Ms}); - Ms < 6000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf4_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [] = ?config(tc_group_properties,Config), - [{t0,now()},{cc4,conf4}|Config]. -conf4_end(Config) -> - %% check 2s & 3s >= 5s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 6000000 -> exit({bad_parallel_exec,Ms}); - Ms < 5000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf5_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [] = ?config(tc_group_properties,Config), - [{t0,now()},{cc5,conf5}|Config]. -conf5_end(Config) -> - %% check 1s & 1s & (3s & 2s) & 1s = ~6s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 7500000 -> exit({bad_parallel_exec,Ms}); - Ms < 6000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf6_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - init = ?config(suite,Config), - [{t0,now()},{cc6,conf6}|Config]. -conf6_end(Config) -> - %% check 3s & 2s < 5s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 4500000 -> exit({bad_parallel_exec,Ms}); - Ms < 3000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf5(suite) -> % test specification - [{conf, conf5_init, [conf5_tc1, conf5_tc1, - - {conf, [parallel], conf6_init, [conf6_tc1, conf6_tc2], conf6_end}, - - conf5_tc2], conf5_end}]. - -conf7_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - [{t0,now()},{cc7,conf7}|Config]. -conf7_end(Config) -> - %% check 1s & 1s & (2s & 2s) & 1s = ~3s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 4000000 -> exit({bad_parallel_exec,Ms}); - Ms < 3000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - -conf8_init(Config) when is_list(Config) -> - test_server:comment(io_lib:format("~p",[now()])), - [parallel] = ?config(tc_group_properties,Config), - init = ?config(suite,Config), - [{t0,now()},{cc8,conf8}|Config]. -conf8_end(Config) -> - %% check 2s & 2s < 4s - Ms = timer:now_diff(now(),?config(t0,Config)), - test_server:comment(io_lib:format("~p",[now()])), - if Ms > 3000000 -> exit({bad_parallel_exec,Ms}); - Ms < 2000000 -> exit({bad_parallel_exec,Ms}); - true -> ok - end. - - -%%---------- test cases ---------- - -conf1_tc1(Config) when is_list(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc1 = ?config(tc11,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf1_tc2(Config) when is_list(Config) -> - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc2 = ?config(tc12,Config), - timer:sleep(3000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf2_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - undefined = ?config(cc1,Config), - undefined = ?config(tc11,Config), - conf2 = ?config(cc2,Config), - conf2_tc1 = ?config(tc21,Config), - timer:sleep(3000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf2_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - conf2 = ?config(cc2,Config), - undefined = ?config(tc21,Config), - conf2_tc2 = ?config(tc22,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf3_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - undefined = ?config(cc2,Config), - undefined = ?config(tc22,Config), - conf3 = ?config(cc3,Config), - conf3_tc1 = ?config(tc31,Config), - timer:sleep(6000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf3_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - conf3 = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(tc31,Config), - undefined = ?config(tc41,Config), - conf3_tc2 = ?config(tc32,Config), - timer:sleep(1000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf4_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - undefined = ?config(tc32,Config), - conf4_tc1 = ?config(tc41,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf4_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - undefined = ?config(tc41,Config), - conf4_tc2 = ?config(tc42,Config), - timer:sleep(3000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf5_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - undefined = ?config(tc42,Config), - conf5_tc1 = ?config(tc51,Config), - timer:sleep(1000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf5_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - undefined = ?config(cc6,Config), - undefined = ?config(tc51,Config), - undefined = ?config(tc62,Config), - conf5_tc2 = ?config(tc52,Config), - timer:sleep(1000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf6_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - undefined = ?config(tc52,Config), - conf6_tc1 = ?config(tc61,Config), - timer:sleep(3000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf6_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - undefined = ?config(tc61,Config), - conf6_tc2 = ?config(tc62,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf7_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(cc5,Config), - undefined = ?config(cc6,Config), - conf7 = ?config(cc7,Config), - undefined = ?config(tc62,Config), - conf7_tc1 = ?config(tc71,Config), - timer:sleep(1000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf7_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf7 = ?config(cc7,Config), - undefined = ?config(cc8,Config), - undefined = ?config(tc71,Config), - undefined = ?config(tc82,Config), - conf7_tc2 = ?config(tc72,Config), - timer:sleep(1000), - test_server:comment(io_lib:format("~p",[now()])), - ok. - -conf8_tc1(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(cc5,Config), - undefined = ?config(cc6,Config), - conf7 = ?config(cc7,Config), - conf8 = ?config(cc8,Config), - undefined = ?config(tc72,Config), - conf8_tc1 = ?config(tc81,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. -conf8_tc2(Config) when is_list(Config) -> - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf7 = ?config(cc7,Config), - conf8 = ?config(cc8,Config), - undefined = ?config(tc81,Config), - conf8_tc2 = ?config(tc82,Config), - timer:sleep(2000), - test_server:comment(io_lib:format("~p",[now()])), - ok. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl deleted file mode 100644 index 0f7118a810..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl +++ /dev/null @@ -1,477 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_shuffle01_SUITE). --include_lib("common_test/include/ct.hrl"). - --compile(export_all). - -all(doc) -> ["Test simple conf case structure, with and without nested cases"]; -all(suite) -> - [ - {conf, [shuffle], conf1_init, [conf1_tc1, conf1_tc2, conf1_tc3], conf1_end}, - - {conf, [{shuffle,{1,2,3}}], conf2_init, [conf2_tc1, conf2_tc2, conf2_tc3], conf2_end}, - - {conf, [shuffle], conf3_init, [conf3_tc1, conf3_tc2, conf3_tc3, - - {conf, [], conf4_init, - [conf4_tc1, conf4_tc2], conf4_end}], - conf3_end}, - - conf5, - - {conf, [shuffle,{repeat,5},parallel], conf7_init, [conf7_tc1, - - {conf, [{shuffle,{3,2,1}},{repeat,3}], - conf8_init, [conf8_tc1, conf8_tc2, conf8_tc3], - conf8_end}, - - conf7_tc2, conf7_tc3], conf7_end} - - ]. - - -%%---------- conf cases ---------- - -init_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - [{suite,init}|Config]. -end_per_suite(Config) -> - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - ok. - -init_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - [{tc11,TC}|Config]; -init_per_testcase(TC=conf1_tc2, Config) -> - [{tc12,TC}|Config]; -init_per_testcase(TC=conf1_tc3, Config) -> - [{tc13,TC}|Config]; -init_per_testcase(TC=conf2_tc1, Config) -> - [{tc21,TC}|Config]; -init_per_testcase(TC=conf2_tc2, Config) -> - [{tc22,TC}|Config]; -init_per_testcase(TC=conf2_tc3, Config) -> - [{tc23,TC}|Config]; -init_per_testcase(TC=conf3_tc1, Config) -> - [{tc31,TC}|Config]; -init_per_testcase(TC=conf3_tc2, Config) -> - [{tc32,TC}|Config]; -init_per_testcase(TC=conf3_tc3, Config) -> - [{tc33,TC}|Config]; -init_per_testcase(TC=conf4_tc1, Config) -> - [{tc41,TC}|Config]; -init_per_testcase(TC=conf4_tc2, Config) -> - [{tc42,TC}|Config]; -init_per_testcase(TC=conf5_tc1, Config) -> - [{tc51,TC}|Config]; -init_per_testcase(TC=conf5_tc2, Config) -> - [{tc52,TC}|Config]; -init_per_testcase(TC=conf6_tc1, Config) -> - [{tc61,TC}|Config]; -init_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - [{tc62,TC}|Config]; -init_per_testcase(TC=conf6_tc3, Config) -> - [{tc63,TC}|Config]; -init_per_testcase(TC=conf7_tc1, Config) -> - [{tc71,TC}|Config]; -init_per_testcase(TC=conf7_tc2, Config) -> - [{tc72,TC}|Config]; -init_per_testcase(TC=conf7_tc3, Config) -> - [{tc73,TC}|Config]; -init_per_testcase(TC=conf8_tc1, Config) -> - [{tc81,TC}|Config]; -init_per_testcase(TC=conf8_tc2, Config) -> - init = ?config(suite,Config), - [{tc82,TC}|Config]; -init_per_testcase(TC=conf8_tc3, Config) -> - [{tc83,TC}|Config]. - -end_per_testcase(TC=conf1_tc1, Config) -> - init = ?config(suite,Config), - TC = ?config(tc11,Config), - ok; -end_per_testcase(TC=conf1_tc2, Config) -> - TC = ?config(tc12,Config), - ok; -end_per_testcase(TC=conf1_tc3, Config) -> - TC = ?config(tc13,Config), - ok; -end_per_testcase(TC=conf2_tc1, Config) -> - TC = ?config(tc21,Config), - ok; -end_per_testcase(TC=conf2_tc2, Config) -> - TC = ?config(tc22,Config), - ok; -end_per_testcase(TC=conf2_tc3, Config) -> - TC = ?config(tc23,Config), - ok; -end_per_testcase(TC=conf3_tc1, Config) -> - TC = ?config(tc31,Config), - ok; -end_per_testcase(TC=conf3_tc2, Config) -> - TC = ?config(tc32,Config), - ok; -end_per_testcase(TC=conf3_tc3, Config) -> - TC = ?config(tc33,Config), - ok; -end_per_testcase(TC=conf4_tc1, Config) -> - TC = ?config(tc41,Config), - ok; -end_per_testcase(TC=conf4_tc2, Config) -> - TC = ?config(tc42,Config), - ok; -end_per_testcase(TC=conf5_tc1, Config) -> - TC = ?config(tc51,Config), - ok; -end_per_testcase(TC=conf5_tc2, Config) -> - TC = ?config(tc52,Config), - ok; -end_per_testcase(TC=conf6_tc1, Config) -> - TC = ?config(tc61,Config), - ok; -end_per_testcase(TC=conf6_tc2, Config) -> - init = ?config(suite,Config), - TC = ?config(tc62,Config), - ok; -end_per_testcase(TC=conf6_tc3, Config) -> - TC = ?config(tc63,Config), - ok; -end_per_testcase(TC=conf7_tc1, Config) -> - TC = ?config(tc71,Config), - ok; -end_per_testcase(TC=conf7_tc2, Config) -> - TC = ?config(tc72,Config), - ok; -end_per_testcase(TC=conf7_tc3, Config) -> - TC = ?config(tc73,Config), - ok; -end_per_testcase(TC=conf8_tc1, Config) -> - TC = ?config(tc81,Config), - ok; -end_per_testcase(TC=conf8_tc2, Config) -> - init = ?config(suite,Config), - TC = ?config(tc82,Config), - ok; -end_per_testcase(TC=conf8_tc3, Config) -> - TC = ?config(tc83,Config), - ok. - - -conf1_init(Config) when is_list(Config) -> - init = ?config(suite,Config), - [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), - test_server:comment("Shuffle (random seed)"), - [{cc1,conf1}|Config]. -conf1_end(_Config) -> - ok. - -conf2_init(Config) when is_list(Config) -> - [{shuffle,{1,2,3}}] = ?config(tc_group_properties,Config), - test_server:comment("Shuffle (user seed)"), - [{cc2,conf2}|Config]. -conf2_end(_Config) -> - ok. - -conf3_init(Config) when is_list(Config) -> - [{shuffle,{_,_,_}}] = ?config(tc_group_properties,Config), - test_server:comment("Shuffle (random)"), - [{cc3,conf3}|Config]. -conf3_end(_Config) -> - ok. - -conf4_init(Config) when is_list(Config) -> - [] = ?config(tc_group_properties,Config), - test_server:comment("No shuffle"), - [{cc4,conf4}|Config]. -conf4_end(_Config) -> - ok. - -conf5_init(Config) when is_list(Config) -> - [] = ?config(tc_group_properties,Config), - test_server:comment("No shuffle"), - [{cc5,conf5}|Config]. -conf5_end(_Config) -> - ok. - -conf6_init(Config) when is_list(Config) -> - validate_shuffle(Config), - test_server:comment("Shuffle (random)"), - init = ?config(suite,Config), - [{cc6,conf6}|Config]. -conf6_end(_Config) -> - ok. - -conf5(suite) -> % test specification - [{conf, conf5_init, [conf5_tc1, - - {conf, [shuffle], conf6_init, - [conf6_tc1, conf6_tc2, conf6_tc3], - conf6_end}, - - conf5_tc2], conf5_end}]. - -conf7_init(Config) when is_list(Config) -> - test_server:comment("Group 7, Shuffle (random seed)"), - validate_shuffle(Config), - [{cc7,conf7}|Config]. -conf7_end(_Config) -> - ok. - -conf8_init(Config) when is_list(Config) -> - test_server:comment("Group 8, Shuffle (user start seed)"), - validate_shuffle(Config), - init = ?config(suite,Config), - [{cc8,conf8}|Config]. -conf8_end(_Config) -> - ok. - -validate_shuffle(Config) -> - case proplists:get_value(shuffle, ?config(tc_group_properties,Config)) of - {_,_,_} -> - ok; - Seed -> - %% Must be a valid seed. - _ = rand:seed_s(rand:export_seed_s(Seed)) - end. - - -%%---------- test cases ---------- - -conf1_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc1 = ?config(tc11,Config), - ok. -conf1_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - init = ?config(suite,Config), - conf1 = ?config(cc1,Config), - conf1_tc2 = ?config(tc12,Config), - ok. -conf1_tc3(suite) -> []; -conf1_tc3(_Config) -> - test_server:comment("Case 3"), - ok. - -conf2_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - undefined = ?config(cc1,Config), - conf2 = ?config(cc2,Config), - conf2_tc1 = ?config(tc21,Config), - ok. -conf2_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - conf2 = ?config(cc2,Config), - conf2_tc2 = ?config(tc22,Config), - ok. -conf2_tc3(suite) -> []; -conf2_tc3(_Config) -> - test_server:comment("Case 3"), - ok. - -conf3_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - conf3_tc1 = ?config(tc31,Config), - ok. -conf3_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - conf3 = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf3_tc2 = ?config(tc32,Config), - ok. -conf3_tc3(suite) -> []; -conf3_tc3(_Config) -> - test_server:comment("Case 3"), - ok. - -conf4_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - conf4_tc1 = ?config(tc41,Config), - ok. -conf4_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf3 = ?config(cc3,Config), - conf4 = ?config(cc4,Config), - conf4_tc2 = ?config(tc42,Config), - ok. - -conf5_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - conf5_tc1 = ?config(tc51,Config), - ok. -conf5_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - undefined = ?config(cc6,Config), - conf5_tc2 = ?config(tc52,Config), - ok. - -conf6_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - conf6_tc1 = ?config(tc61,Config), - ok. -conf6_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf5 = ?config(cc5,Config), - conf6 = ?config(cc6,Config), - conf6_tc2 = ?config(tc62,Config), - ok. -conf6_tc3(suite) -> []; -conf6_tc3(_Config) -> - test_server:comment("Case 3"), - ok. - -conf7_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(cc5,Config), - undefined = ?config(cc6,Config), - conf7 = ?config(cc7,Config), - conf7_tc1 = ?config(tc71,Config), - ok. -conf7_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf7 = ?config(cc7,Config), - undefined = ?config(cc8,Config), - conf7_tc2 = ?config(tc72,Config), - ok. -conf7_tc3(suite) -> []; -conf7_tc3(_Config) -> - test_server:comment("Case 3"), - ok. - -conf8_tc1(Config) when is_list(Config) -> - test_server:comment("Case 1"), - init = ?config(suite,Config), - case ?config(data_dir,Config) of - undefined -> exit(no_data_dir); - _ -> ok - end, - undefined = ?config(cc1,Config), - undefined = ?config(cc2,Config), - undefined = ?config(cc3,Config), - undefined = ?config(cc4,Config), - undefined = ?config(cc5,Config), - undefined = ?config(cc6,Config), - conf7 = ?config(cc7,Config), - conf8 = ?config(cc8,Config), - conf8_tc1 = ?config(tc81,Config), - ok. -conf8_tc2(Config) when is_list(Config) -> - test_server:comment("Case 2"), - init = ?config(suite,Config), - case ?config(priv_dir,Config) of - undefined -> exit(no_priv_dir); - _ -> ok - end, - conf7 = ?config(cc7,Config), - conf8 = ?config(cc8,Config), - conf8_tc2 = ?config(tc82,Config), - ok. -conf8_tc3(suite) -> []; -conf8_tc3(_Config) -> - test_server:comment("Case 3"), - ok. diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl deleted file mode 100644 index ae2321c6ad..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl +++ /dev/null @@ -1,43 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_skip_SUITE). - --export([all/1, init_per_suite/1, end_per_suite/1]). --export([dummy/1]). - --include_lib("common_test/include/ct.hrl"). - -all(suite) -> - [dummy]. - -init_per_suite(Config) when is_list(Config) -> - {skip,"Skipping init_per_suite - check that \'dummy\' and" - " \'end_per_suite\' are also skipped"}. - -dummy(suite) -> []; -dummy(doc) -> ["This testcase should never be executed"]; -dummy(Config) when is_list(Config) -> - ?t:fail("This testcase should be executed since" - " init_per_suite/1 is skipped"). - -end_per_suite(doc) -> ["This testcase should never be executed"]; -end_per_suite(Config) when is_list(Config) -> - ?t:fail("end_per_suite/1 should not be executed when" - " init_per_suite/1 is skipped"). diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl deleted file mode 100644 index 0cabce995f..0000000000 --- a/lib/test_server/test/test_server_SUITE_data/test_server_unicode_SUITE.erl +++ /dev/null @@ -1,82 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_unicode_SUITE). - --export([all/1, init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2]). --export(['#=@: difficult_case_name_äöå'/1, - print_and_log_unicode/1, - print_and_log_latin1/1]). - --include_lib("common_test/include/ct.hrl"). - -all(suite) -> - ['#=@: difficult_case_name_äöå', - print_and_log_unicode, - print_and_log_latin1]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(_Case,Config) -> - init_timetrap(500,Config). - -init_timetrap(T,Config) -> - Dog = ?t:timetrap(T), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case,Config) -> - cancel_timetrap(Config). - -cancel_timetrap(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - - -%%%----------------------------------------------------------------- -%%% Test cases - -'#=@: difficult_case_name_äöå'(Config) when is_list(Config) -> - ok. - -print_and_log_unicode(Config) when is_list(Config) -> - String = "שלום-שלום+של 日本語", - test_server:comment(String), - test_server:capture_start(), - io:format("String with ts: ~ts",[String]), - test_server:capture_stop(), - "String with ts: "++String = lists:flatten(test_server:capture_get()), - ok. - -print_and_log_latin1(Config) when is_list(Config) -> - String = "æøå", - test_server:comment(String), - test_server:capture_start(), - io:format("String with s: ~s",[String]), - io:format("String with ts: ~ts",[String]), - test_server:capture_stop(), - ["String with s: "++String, - "String with ts: "++String] = - [lists:flatten(L) || L<- test_server:capture_get()], - ok. diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl deleted file mode 100644 index e2680938e0..0000000000 --- a/lib/test_server/test/test_server_test_lib.erl +++ /dev/null @@ -1,217 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_test_lib). - --export([parse_suite/1]). --export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). - -%% for test_server_SUITE when node can not be started as slave --export([prepare_tester_node/2]). - --include("test_server_test_lib.hrl"). - -%% The CTH hooks all tests -init(_Id, _Opts) -> - []. - -pre_init_per_testcase(_TC,Config,State) -> - case os:type() of - {win32, _} -> - %% Extend timeout for windows as starting node - %% can take a long time there - test_server:timetrap( 120000 * test_server:timetrap_scale_factor()); - _ -> - ok - end, - {start_slave(Config, 50),State}. - -start_slave(Config,_Level) -> - [_,Host] = string:tokens(atom_to_list(node()), "@"), - - ct:log("Trying to start ~s~n", - ["test_server_tester@"++Host]), - case slave:start(Host, test_server_tester, []) of - {error,Reason} -> - test_server:fail(Reason); - {ok,Node} -> - ct:log("Node ~p started~n", [Node]), - IsCover = test_server:is_cover(), - if IsCover -> - cover:start(Node); - true-> - ok - end, - prepare_tester_node(Node,Config) - end. - -prepare_tester_node(Node,Config) -> - DataDir = proplists:get_value(data_dir, Config), - %% We would normally use priv_dir for temporary data, - %% but the pathnames gets too long on Windows. - %% Until the run-time system can support long pathnames, - %% use the data dir. - WorkDir = DataDir, - - %% WorkDir as well as directory of Test Server suites - %% have to be in code path on Test Server node. - [_ | Parts] = lists:reverse(filename:split(DataDir)), - TSDir = filename:join(lists:reverse(Parts)), - AddPathDirs = case proplists:get_value(path_dirs, Config) of - undefined -> []; - Ds -> Ds - end, - PathDirs = [WorkDir,TSDir | AddPathDirs], - [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], - io:format("Dirs added to code path (on ~w):~n", - [Node]), - [io:format("~s~n", [D]) || D <- PathDirs], - - true = rpc:call(Node, os, putenv, - ["TEST_SERVER_FRAMEWORK", "undefined"]), - - ok = rpc:call(Node, file, set_cwd, [WorkDir]), - [{node,Node}, {work_dir,WorkDir} | Config]. - -post_end_per_testcase(_TC, Config, Return, State) -> - Node = proplists:get_value(node, Config), - Cover = test_server:is_cover(), - if Cover-> cover:flush(Node); - true -> ok - end, - erlang:monitor_node(Node, true), - slave:stop(Node), - receive - {nodedown, Node} -> - if Cover -> cover:stop(Node); - true -> ok - end - after 5000 -> - erlang:monitor_node(Node, false), - receive {nodedown, Node} -> ok after 0 -> ok end %flush - end, - {Return, State}. - -%% Parse an .suite log file -parse_suite(FileName) -> - - case file:open(FileName, [read, raw, read_ahead]) of - {ok, Fd} -> - Data = parse_suite(Fd, #suite{ }), - file:close(Fd), - {ok, Data}; - _ -> - error - end. - -fline(Fd) -> - case prim_file:read_line(Fd) of - eof -> eof; - {ok, Line} -> Line - end. - -parse_suite(Fd, S) -> - _Started = fline(Fd), - _Starting = fline(Fd), - "=cases" ++ NCases = fline(Fd), - "=user" ++ _User = fline(Fd), - "=host" ++ Host = fline(Fd), - "=hosts" ++ _Hosts = fline(Fd), - "=emulator_vsn" ++ Evsn = fline(Fd), - "=emulator" ++ Emu = fline(Fd), - "=otp_release" ++ OtpRel = fline(Fd), - "=started" ++ Start = fline(Fd), - NewS = parse_cases(Fd, S#suite{ - n_cases_expected = list_to_int(clean(NCases)), - host = list_to_binary(clean(Host)), - emulator_vsn = list_to_binary(clean(Evsn)), - emulator = list_to_binary(clean(Emu)), - otp_release = list_to_binary(clean(OtpRel)), - started = list_to_binary(clean(Start)) - }), - "=failed" ++ Failed = fline(Fd), - "=successful" ++ Succ = fline(Fd), - "=user_skipped" ++ UsrSkip = fline(Fd), - "=auto_skipped" ++ AutSkip = fline(Fd), - NewS#suite{ n_cases_failed = list_to_int(clean(Failed)), - n_cases_succ = list_to_int(clean(Succ)), - n_cases_user_skip = list_to_int(clean(UsrSkip)), - n_cases_auto_skip = list_to_int(clean(AutSkip)) }. - - -parse_cases(Fd, #suite{ n_cases = N, - cases = Cases } = S) -> - case parse_case(Fd) of - finished -> S#suite{ log_ok = true }; - {eof, Tc} -> - S#suite{ n_cases = N + 1, - cases = [Tc#tc{ result = crashed }|Cases]}; - {ok, Case} -> - parse_cases(Fd, S#suite{ n_cases = N + 1, - cases = [Case|Cases]}) - end. - -parse_case(Fd) -> parse_case(Fd, #tc{}). -parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc). - -parse_case(eof, _, Tc) -> {eof, Tc}; -parse_case("=case" ++ Case, Fd, Tc) -> - Name = list_to_binary(clean(Case)), - parse_case(fline(Fd), Fd, Tc#tc{ name = Name }); -parse_case("=logfile" ++ File, Fd, Tc) -> - Log = list_to_binary(clean(File)), - parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log }); -parse_case("=elapsed" ++ Elapsed, Fd, Tc) -> - {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)), - parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time }); -parse_case("=result" ++ Result, _, Tc) -> - case clean(Result) of - "ok" ++ _ -> - {ok, Tc#tc{ result = ok } }; - "failed" ++ _ -> - {ok, Tc#tc{ result = failed } }; - "skipped" ++ _ -> - {ok, Tc#tc{ result = skip } }; - "auto_skipped" ++ _ -> - {ok, Tc#tc{ result = auto_skip } } - end; -parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) -> - finished; -parse_case(_, Fd, Tc) -> - parse_case(fline(Fd), Fd, Tc). - -skip([]) -> []; -skip([$ |Ts]) -> skip(Ts); -skip(Ts) -> Ts. - -%rmnl(L) -> L. -rmnl([]) -> []; -rmnl([$\n | Ts]) -> rmnl(Ts); -rmnl([T|Ts]) -> [T | rmnl(Ts)]. - -clean(L) -> - rmnl(skip(L)). - -list_to_int(L) -> - try - list_to_integer(L) - catch - _:_ -> - 0 - end. diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/test_server/test/test_server_test_lib.hrl deleted file mode 100644 index 27b7be9618..0000000000 --- a/lib/test_server/test/test_server_test_lib.hrl +++ /dev/null @@ -1,23 +0,0 @@ --record(tc, { - name, - result, - elapsed, - logfile - }). - --record(suite, { - application, - n_cases = 0, - n_cases_failed = 0, - n_cases_expected = 0, - n_cases_succ, - n_cases_user_skip, - n_cases_auto_skip, - cases = [], - host, - emulator_vsn, - emulator, - otp_release, - started, - log_ok = false - }). diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk deleted file mode 100644 index 3a3815c557..0000000000 --- a/lib/test_server/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -TEST_SERVER_VSN = 3.9.1 diff --git a/otp_build b/otp_build index ac99ced42a..57dc2e3a9c 100755 --- a/otp_build +++ b/otp_build @@ -26,7 +26,7 @@ EXPECTED_AUTOCONF_VERSION=2.59 # # NOTE: lazy_configure depends on '.' always being last directory if [ -z "$ONLY_ERTS" ]; then - AUTOCONF_SUBDIRS="lib lib/* lib/test_server/src" + AUTOCONF_SUBDIRS="lib lib/* lib/common_test/test_server" fi AUTOCONF_SUBDIRS="$AUTOCONF_SUBDIRS erts ." @@ -264,7 +264,7 @@ create_lib_configure_in() distribute_config_helpers () { aclocal_dirs=". ./lib/erl_interface ./lib/odbc ./lib/wx ./lib/megaco" - autoconf_aux_dirs="./lib/common_test/priv/auxdir ./lib/erl_interface/src/auxdir ./lib/test_server/src ./lib/wx/autoconf" + autoconf_aux_dirs="./lib/common_test/priv/auxdir ./lib/erl_interface/src/auxdir ./lib/common_test/test_server ./lib/wx/autoconf" aclocal_master="./erts/aclocal.m4" install_sh_master="./erts/autoconf/install-sh" -- cgit v1.2.3 From de9012628a6b0e97d2f1325bf2f72817f69f84ee Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 30 Nov 2015 09:26:16 +0100 Subject: stdlib: Modify the preprocessor as to expose typed record fields Problem: The types of record fields have since R12B been put in a separate form by epp:parse_file(), leaving the record declaration form untyped. The separate form, however, does not follow the syntax of type declarations, and parse transforms inspecting -type() attributes need to know about the special syntax. Since the compiler stores the return value of epp:parse_file() as debug information in the abstract code chunk ("Abst" or 'abstract_code'), tools too need to know about the special syntax, if they inspect -type() attributes in abstract code. Solution: As of this commit no separate form is created by epp:parse_file(), but the type information kept in the record fields. This means that all parse transforms and all tools inspecting -record() declarations need to recognize {typed_record_field, Field, Type}. We recommend that all parse transforms and tools be updated as to recognize typed record fields. Discussion: As of OTP 19.0, the abstract form of type declarations and function specifications is documented. An (unsatisfactory) alternative to the above solution is to document two formats of the abstract form of typed record fields: one if returned by epp:parse_file(); and one if returned by, for example, epp:parse_erl_form(). Yet another (bad) alternative is to not document the format returned by epp:erl_parse(), but instead document the idempotent function epp:restore_typed_record_fields/1, and urge authors of parse transform and tools to always call this function. --- lib/stdlib/src/epp.erl | 15 +-------------- lib/stdlib/test/epp_SUITE.erl | 21 +++------------------ 2 files changed, 4 insertions(+), 32 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 45f616bb02..be7c2ec346 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -258,20 +258,7 @@ parse_file(Ifile, Options) -> parse_file(Epp) -> case parse_erl_form(Epp) of {ok,Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - |parse_file(Epp)]; - not_typed -> - [Form|parse_file(Epp)] - end; - _ -> - [Form|parse_file(Epp)] - end; + [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; {eof,Location} -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 4c007e76ad..955b482313 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -25,7 +25,7 @@ upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, 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_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, otp_11728/1, encoding/1, extends/1]). @@ -68,7 +68,7 @@ all() -> [rec_1, {group, upcase_mac}, include_local, predef_mac, {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, + overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, encoding, extends]. @@ -1230,23 +1230,8 @@ otp_8470(Config) when is_list(Config) -> ?line receive _ -> fail() after 0 -> ok end, ok. -otp_8503(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; -otp_8503(suite) -> - []; -otp_8503(Config) when is_list(Config) -> - Dir = ?config(priv_dir, Config), - C = <<"-record(r, {}).">>, - ?line File = filename:join(Dir, "otp_8503.erl"), - ?line ok = file:write_file(File, C), - ?line {ok, List} = epp:parse_file(File, [], []), - ?line [_] = [F || {attribute,_,type,{{record,r},[],[]}}=F <- List], - file:delete(File), - ?line receive _ -> fail() after 0 -> ok end, - ok. - otp_8562(doc) -> - ["OTP-8503. Record with no fields is considered typed."]; + ["OTP-8562. Record with no fields is considered typed."]; otp_8562(suite) -> []; otp_8562(Config) when is_list(Config) -> -- cgit v1.2.3 From 173b217a37fbb7439857a833d25ea0703e97ea2b Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 27 Nov 2015 14:14:07 +0100 Subject: stdlib: Update ms_transform to handle typed record fields --- lib/stdlib/src/ms_transform.erl | 13 ++++++++----- lib/stdlib/test/ms_transform_SUITE.erl | 6 +++--- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index b67b6f75d7..24b5fde1db 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -307,15 +307,18 @@ cleanup_filename({Old,OldRec,OldWarnings}) -> add_record_definition({Name,FieldList}) -> {KeyList,_} = lists:foldl( - fun({record_field,_,{atom,Line0,FieldName}},{L,C}) -> - {[{FieldName,C,{atom,Line0,undefined}}|L],C+1}; - ({record_field,_,{atom,_,FieldName},Def},{L,C}) -> - {[{FieldName,C,Def}|L],C+1} - end, + fun(F, {L,C}) -> {[record_field(F, C)|L],C+1} end, {[],2}, FieldList), put_records([{Name,KeyList}|get_records()]). +record_field({record_field,_,{atom,Line0,FieldName}}, C) -> + {FieldName,C,{atom,Line0,undefined}}; +record_field({record_field,_,{atom,_,FieldName},Def}, C) -> + {FieldName,C,Def}; +record_field({typed_record_field,Field,_Type}, C) -> + record_field(Field, C). + forms([F0|Fs0]) -> F1 = form(F0), Fs1 = forms(Fs0), diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index f02e82b39c..5f2167b609 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -342,8 +342,8 @@ records(doc) -> records(Config) when is_list(Config) -> ?line setup(Config), ?line RD = <<"-record(t, {" - "t1 = []," - "t2 = foo," + "t1 = [] :: list()," + "t2 = foo :: atom()," "t3," "t4" "}).">>, -- cgit v1.2.3 From 4854065a042ec1812705dec6ec420bb395854a3a Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 27 Nov 2015 14:38:53 +0100 Subject: stdlib: Update module shell to handle typed record fields --- lib/stdlib/src/shell.erl | 8 +++++--- lib/stdlib/test/shell_SUITE.erl | 4 +++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index ce1d9eb0ff..82a3a2be4f 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -917,9 +917,9 @@ expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], L = erl_anno:new(1), E = prep_rec(E0), - Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], - [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [strict_record_tests]), + Forms0 = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], + Forms = erl_expand_records:module(Forms0, [strict_record_tests]), + {function,L,foo,0,[{clause,L,[],[],[NE]}]} = lists:last(Forms), prep_rec(NE). prep_rec({value,_CommandN,_V}=Value) -> @@ -1081,6 +1081,8 @@ record_fields([{record_field,_,{atom,_,Field}} | Fs]) -> [Field | record_fields(Fs)]; record_fields([{record_field,_,{atom,_,Field},_} | Fs]) -> [Field | record_fields(Fs)]; +record_fields([{typed_record_field,Field,_Type} | Fs]) -> + record_fields([Field | Fs]); record_fields([]) -> []. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index a9dd6b5817..3fb1a5572d 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -393,7 +393,9 @@ records(Config) when is_list(Config) -> Test = filename:join(?config(priv_dir, Config), "test.erl"), Contents = <<"-module(test). - -record(state, {bin, reply, leader}). + -record(state, {bin :: binary(), + reply = no, + leader = some :: atom()}). -ifdef(test1). -record(test1, {f}). -- cgit v1.2.3 From ef8141ff27d0c7d94f71b0bf6a4766e6876b725a Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 27 Nov 2015 14:44:46 +0100 Subject: stdlib: Add a Cover test with typed record field --- lib/tools/test/cover_SUITE_data/d.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/tools/test/cover_SUITE_data/d.erl b/lib/tools/test/cover_SUITE_data/d.erl index 696e27e49b..b1d8ebd62e 100644 --- a/lib/tools/test/cover_SUITE_data/d.erl +++ b/lib/tools/test/cover_SUITE_data/d.erl @@ -6,7 +6,7 @@ size/0]). -export([init/0]). % spawn --record(person, {name, age, location, moved=false}). +-record(person, {name, age :: integer(), location, moved=false :: boolean()}). %%%---------------------------------------------------------------------- %%% User interface functions -- cgit v1.2.3 From a57f06ac6c2986feb14de0557d8051c8489788ee Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Fri, 27 Nov 2015 16:08:24 +0100 Subject: stdlib: Update erl_id_trans to handle types and specs --- lib/stdlib/examples/erl_id_trans.erl | 151 +++++++++++++++++++++++++++++++++-- 1 file changed, 143 insertions(+), 8 deletions(-) diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index 529ae30862..c2e345763a 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -18,11 +18,11 @@ %% -module(erl_id_trans). -%% A identity transformer of Erlang abstract syntax. +%% An identity transformer of Erlang abstract syntax. %% This module only traverses legal Erlang code. This is most noticeable %% in guards where only a limited number of expressions are allowed. -%% N.B. if this module is to be used as a basis for tranforms then +%% N.B. if this module is to be used as a basis for transforms then %% all the error cases must be handled otherwise this module just crashes! -export([parse_transform/2]). @@ -53,6 +53,17 @@ form({attribute,Line,export,Es0}) -> form({attribute,Line,import,{Mod,Is0}}) -> Is1 = farity_list(Is0), {attribute,Line,import,{Mod,Is1}}; +form({attribute,Line,export_type,Es0}) -> + Es1 = farity_list(Es0), + {attribute,Line,export_type,Es1}; +form({attribute,Line,optional_callbacks,Es0}) -> + try farity_list(Es0) of + Es1 -> + {attribute,Line,optional_callbacks,Es1} + catch + _:_ -> + {attribute,Line,optional_callbacks,Es0} + end; form({attribute,Line,compile,C}) -> {attribute,Line,compile,C}; form({attribute,Line,record,{Name,Defs0}}) -> @@ -60,14 +71,28 @@ form({attribute,Line,record,{Name,Defs0}}) -> {attribute,Line,record,{Name,Defs1}}; form({attribute,Line,asm,{function,N,A,Code}}) -> {attribute,Line,asm,{function,N,A,Code}}; +form({attribute,Line,type,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,type,{N,T1,Vs1}}; +form({attribute,Line,opaque,{N,T,Vs}}) -> + T1 = type(T), + Vs1 = variable_list(Vs), + {attribute,Line,opaque,{N,T1,Vs1}}; +form({attribute,Line,spec,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{N,A},FTs1}}; +form({attribute,Line,spec,{{M,N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,spec,{{M,N,A},FTs1}}; +form({attribute,Line,callback,{{N,A},FTs}}) -> + FTs1 = function_type_list(FTs), + {attribute,Line,callback,{{N,A},FTs1}}; form({attribute,Line,Attr,Val}) -> %The general attribute. {attribute,Line,Attr,Val}; form({function,Line,Name0,Arity0,Clauses0}) -> {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), {function,Line,Name,Arity,Clauses}; -% Mnemosyne, ignore... -form({rule,Line,Name,Arity,Body}) -> - {rule,Line,Name,Arity,Body}; % Dont dig into this %% Extra forms from the parser. form({error,E}) -> {error,E}; form({warning,W}) -> {warning,W}; @@ -79,6 +104,12 @@ farity_list([{Name,Arity}|Fas]) -> [{Name,Arity}|farity_list(Fas)]; farity_list([]) -> []. +%% -type variable_list([Var]) -> [Var] + +variable_list([{var,Line,Var}|Vs]) -> + [{var,Line,Var}|variable_list(Vs)]; +variable_list([]) -> []. + %% -type record_defs([RecDef]) -> [RecDef]. %% N.B. Field names are full expressions here but only atoms are allowed %% by the *parser*! @@ -88,6 +119,16 @@ record_defs([{record_field,Line,{atom,La,A},Val0}|Is]) -> [{record_field,Line,{atom,La,A},Val1}|record_defs(Is)]; record_defs([{record_field,Line,{atom,La,A}}|Is]) -> [{record_field,Line,{atom,La,A}}|record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A},Val0},Type}| + Is]) -> + Val1 = expr(Val0), + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A},Val1},Type1}| + record_defs(Is)]; +record_defs([{typed_record_field,{record_field,Line,{atom,La,A}},Type}|Is]) -> + Type1 = type(Type), + [{typed_record_field,{record_field,Line,{atom,La,A}},Type1}| + record_defs(Is)]; record_defs([]) -> []. %% -type function(atom(), integer(), [Clause]) -> {atom(),integer(),[Clause]}. @@ -196,9 +237,9 @@ pattern_grp([]) -> bit_types([]) -> []; -bit_types([Atom | Rest]) when atom(Atom) -> +bit_types([Atom | Rest]) when is_atom(Atom) -> [Atom | bit_types(Rest)]; -bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) -> +bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) -> [{Atom, Integer} | bit_types(Rest)]. @@ -226,7 +267,7 @@ pattern_fields([]) -> []. %% -type guard([GuardTest]) -> [GuardTest]. -guard([G0|Gs]) when list(G0) -> +guard([G0|Gs]) when is_list(G0) -> [guard0(G0) | guard(Gs)]; guard(L) -> guard0(L). @@ -547,3 +588,97 @@ fun_clauses([C0|Cs]) -> C1 = clause(C0), [C1|fun_clauses(Cs)]; fun_clauses([]) -> []. + +function_type_list([{type,Line,bounded_fun,[Ft,Fc]}|Fts]) -> + Ft1 = function_type(Ft), + Fc1 = function_constraint(Fc), + [{type,Line,bounded_fun,[Ft1,Fc1]}|function_type_list(Fts)]; +function_type_list([Ft|Fts]) -> + [function_type(Ft)|function_type_list(Fts)]; +function_type_list([]) -> []. + +function_type({type,Line,'fun',[{type,Lt,product,As},B]}) -> + As1 = type_list(As), + B1 = type(B), + {type,Line,'fun',[{type,Lt,product,As1},B1]}. + +function_constraint([C|Cs]) -> + C1 = constraint(C), + [C1|function_constraint(Cs)]; +function_constraint([]) -> []. + +constraint({type,Line,constraint,[{atom,L,A},[V,T]]}) -> + V1 = type(V), + T1 = type(T), + {type,Line,constraint,[{atom,L,A},[V1,T1]]}. + +type({ann_type,Line,[{var,Lv,V},T]}) -> + T1 = type(T), + {ann_type,Line,[{var,Lv,V},T1]}; +type({atom,Line,A}) -> + {atom,Line,A}; +type({integer,Line,I}) -> + {integer,Line,I}; +type({op,Line,Op,T}) -> + T1 = type(T), + {op,Line,Op,T1}; +type({op,Line,Op,L,R}) -> + L1 = type(L), + R1 = type(R), + {op,Line,Op,L1,R1}; +type({type,Line,binary,[M,N]}) -> + M1 = type(M), + N1 = type(N), + {type,Line,binary,[M1,N1]}; +type({type,Line,'fun',[]}) -> + {type,Line,'fun',[]}; +type({type,Line,'fun',[{type,Lt,any},B]}) -> + B1 = type(B), + {type,Line,'fun',[{type,Lt,any},B1]}; +type({type,Line,range,[L,H]}) -> + L1 = type(L), + H1 = type(H), + {type,Line,range,[L1,H1]}; +type({type,Line,map,any}) -> + {type,Line,map,any}; +type({type,Line,map,Ps}) -> + Ps1 = map_pair_types(Ps), + {type,Line,map,Ps1}; +type({type,Line,record,[{atom,La,N}|Fs]}) -> + Fs1 = field_types(Fs), + {type,Line,record,[{atom,La,N}|Fs1]}; +type({remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As]}) -> + As1 = type_list(As), + {remote_type,Line,[{atom,Lm,M},{atom,Ln,N},As1]}; +type({type,Line,tuple,any}) -> + {type,Line,tuple,any}; +type({type,Line,tuple,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,tuple,Ts1}; +type({type,Line,union,Ts}) -> + Ts1 = type_list(Ts), + {type,Line,union,Ts1}; +type({var,Line,V}) -> + {var,Line,V}; +type({user_type,Line,N,As}) -> + As1 = type_list(As), + {user_type,Line,N,As1}; +type({type,Line,N,As}) -> + As1 = type_list(As), + {type,Line,N,As1}. + +map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) -> + K1 = type(K), + V1 = type(V), + [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)]; +map_pair_types([]) -> []. + +field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) -> + T1 = type(T), + [{type,Line,field_type,[{atom,La,A},T1]}|field_types(Fs)]; +field_types([]) -> []. + +type_list([T|Ts]) -> + T1 = type(T), + [T1|type_list(Ts)]; +type_list([]) -> []. -- cgit v1.2.3 From 32d47fd2d4775df964c6b4d5ee77a8367ef27d67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 30 Nov 2015 13:06:35 +0100 Subject: compiler: Update the compiler to handle typed record fields --- lib/compiler/src/compile.erl | 7 +++---- lib/compiler/src/v3_kernel.erl | 4 +++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 72f1a767ed..46917905de 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1620,11 +1620,8 @@ output_encoding(F, #compile{encoding = Encoding}) -> ok = io:setopts(F, [{encoding, Encoding}]), ok = io:fwrite(F, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). -restore_expanded_types("P", Fs) -> - epp:restore_typed_record_fields(Fs); restore_expanded_types("E", {M,I,Fs0}) -> - Fs1 = restore_expand_module(Fs0), - Fs = epp:restore_typed_record_fields(Fs1), + Fs = restore_expand_module(Fs0), {M,I,Fs}; restore_expanded_types(_Ext, Code) -> Code. @@ -1636,6 +1633,8 @@ restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,record,[R]}|Fs]) -> + [{attribute,Line,record,R}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 011748df3a..4446d5ff1d 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -143,8 +143,10 @@ attributes([]) -> []. include_attribute(type) -> false; include_attribute(spec) -> false; +include_attribute(callback) -> false; include_attribute(opaque) -> false; include_attribute(export_type) -> false; +include_attribute(record) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> -- cgit v1.2.3 From cfbeb80a9733a5604739ebb1aa9acbd377d88d7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 30 Nov 2015 13:06:54 +0100 Subject: stdlib: Update erl_expand_records to handle typed record fields --- lib/stdlib/src/erl_expand_records.erl | 36 +++-------------------------------- 1 file changed, 3 insertions(+), 33 deletions(-) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index bcfeef7321..9c0a7fb7d5 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -33,8 +33,6 @@ vcount=0, % Variable counter imports=[], % Imports records=dict:new(), % Record definitions - trecords=sets:new(), % Typed records - uses_types=false, % Are there -spec or -type in the module strict_ra=[], % strict record accesses checked_ra=[] % successfully accessed records }). @@ -47,45 +45,18 @@ %% erl_lint without errors. module(Fs0, Opts0) -> Opts = compiler_options(Fs0) ++ Opts0, - TRecs = typed_records(Fs0), - UsesTypes = uses_types(Fs0), - St0 = #exprec{compile = Opts, trecords = TRecs, uses_types = UsesTypes}, + St0 = #exprec{compile = Opts}, {Fs,_St} = forms(Fs0, St0), Fs. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -typed_records(Fs) -> - typed_records(Fs, sets:new()). - -typed_records([{attribute,_L,type,{{record, Name},_Defs,[]}} | Fs], Trecs) -> - typed_records(Fs, sets:add_element(Name, Trecs)); -typed_records([_|Fs], Trecs) -> - typed_records(Fs, Trecs); -typed_records([], Trecs) -> - Trecs. - -uses_types([{attribute,_L,spec,_}|_]) -> true; -uses_types([{attribute,_L,type,_}|_]) -> true; -uses_types([{attribute,_L,opaque,_}|_]) -> true; -uses_types([_|Fs]) -> uses_types(Fs); -uses_types([]) -> false. - -forms([{attribute,L,record,{Name,Defs}} | Fs], St0) -> +forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) -> NDefs = normalise_fields(Defs), St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)}, {Fs1, St1} = forms(Fs, St), - %% Check if we need to keep the record information for usage in types. - case St#exprec.uses_types of - true -> - case sets:is_element(Name, St#exprec.trecords) of - true -> {Fs1, St1}; - false -> {[{attribute,L,type,{{record,Name},Defs,[]}}|Fs1], St1} - end; - false -> - {Fs1, St1} - end; + {[Attr | Fs1], St1}; forms([{attribute,L,import,Is} | Fs0], St0) -> St1 = import(Is, St0), {Fs,St2} = forms(Fs0, St1), @@ -513,7 +484,6 @@ lc_tq(Line, [F0 | Qs0], St0) -> lc_tq(_Line, [], St0) -> {[],St0#exprec{checked_ra = []}}. - %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. -- cgit v1.2.3 From e2e216eb72477103cb5930632c9f05a5f4164fae Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 30 Nov 2015 14:52:39 +0100 Subject: stdlib: Update the linter to handle typed record fields --- lib/stdlib/src/erl_lint.erl | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 8d2df1cf66..e821417e8e 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1143,7 +1143,7 @@ check_untyped_records(Forms, St0) -> RecNames = dict:fetch_keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || - {attribute,_,type,{{record,Name},Fields,_}} <- Forms, + {attribute,_,record,{Name,Fields}} <- Forms, lists:all(fun ({typed_record_field,_,_}) -> true; (_) -> false end, Fields)], @@ -1153,7 +1153,8 @@ check_untyped_records(Forms, St0) -> [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) end - end, St0, RecNames -- TRecNames); + end, St0, ordsets:subtract(ordsets:from_list(RecNames), + ordsets:from_list(TRecNames))); false -> St0 end. @@ -2443,7 +2444,10 @@ record_def(Line, Name, Fs0, St0) -> true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St1#lint{records=dict:store(Name, {Line,Fs1}, St1#lint.records)} + St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St1#lint.records)}, + Types = [T || {typed_record_field, _, T} <- Fs0], + check_type({type, nowarn(), product, Types}, St2) end. %% def_fields([RecDef], RecordName, State) -> {[DefField],State}. @@ -2646,11 +2650,6 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. -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. - Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, nowarn(), product, Types}, St0); type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2994,9 +2993,10 @@ add_missing_spec_warnings(Forms, St0, Type) -> [{FA,L} || {function,L,F,A,_} <- Forms, not lists:member(FA = {F,A}, Specs)]; exported -> - Exps = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps0 = gb_sets:to_list(St0#lint.exports) -- pseudolocals(), + Exps = Exps0 -- Specs, [{FA,L} || {function,L,F,A,_} <- Forms, - member(FA = {F,A}, Exps -- Specs)] + member(FA = {F,A}, Exps)] end, foldl(fun ({FA,L}, St) -> add_warning(L, {missing_spec,FA}, St) -- cgit v1.2.3 From c6135114e691a8c2f21f4d79f2566b87300857d5 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 2 Dec 2015 12:41:58 +0100 Subject: stdlib: Let the linter detect old typed records --- lib/stdlib/src/erl_lint.erl | 9 ++++++++- lib/stdlib/test/erl_lint_SUITE.erl | 17 +++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index e821417e8e..4ca9a609a8 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -360,6 +360,9 @@ format_error({redefine_type, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); +format_error(old_abstract_code) -> + io_lib:format("abstract code generated before Erlang/OTP 19.0 and " + "having typed record fields cannot be compiled", []); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); format_error({redefine_spec, {F, A}}) -> @@ -2812,6 +2815,8 @@ check_type({user_type, L, TypeName, Args}, SeenVars, St) -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St1}, Args); +check_type([{typed_record_field,Field,_T}|_], SeenVars, St) -> + {SeenVars, add_error(element(2, Field), old_abstract_code, St)}; check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -3009,7 +3014,9 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(Type, #typeinfo{line = FileLine}, AccSt) -> + fun({{record, _}=_Type, 0}, _, AccSt) -> + AccSt; % Before Erlang/OTP 19.0 + (Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine, AccSt) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 32247ba492..8f0ac828ec 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2607,6 +2607,23 @@ otp_5878(Config) when is_list(Config) -> ">>, ?line [] = run_test2(Config, UsedByType, [warn_unused_record]), + %% Abstract code generated by OTP 18. Note that the type info for + %% record fields has been put in a separate form. + OldAbstract = [{attribute,1,file,{"rec.erl",1}}, + {attribute,1,module,rec}, + {attribute,3,export,[{t,0}]}, + {attribute,7,record,{r,[{record_field,7,{atom,7,f}}]}}, + {attribute,7,type, + {{record,r}, + [{typed_record_field, + {record_field,7,{atom,7,f}}, + {type,7,union,[{atom,7,undefined},{type,7,atom,[]}]}}], + []}}, + {function,9,t,0,[{clause,9,[],[],[{record,10,r,[]}]}]}, + {eof,11}], + {error,[{"rec.erl",[{7,erl_lint,old_abstract_code}]}],[]} = + compile:forms(OldAbstract, [return, report]), + ok. otp_6885(doc) -> -- cgit v1.2.3 From 6285f2874977e033d02b3c0b77da78e35e771961 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 30 Nov 2015 16:38:42 +0100 Subject: stdlib: Update qlc_pt to handle typed record fields --- lib/stdlib/src/qlc_pt.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 9f69cd5003..e4b9768b12 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1914,9 +1914,9 @@ expand_pattern_records(P, State) -> expand_expr_records(E, State) -> RecordDefs = State#state.records, A = anno1(), - Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], - [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = - erl_expand_records:module(Forms, [no_strict_record_tests]), + Forms0 = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], + Forms = erl_expand_records:module(Forms0, [no_strict_record_tests]), + {function,_,foo,0,[{clause,_,[],[],[NE]}]} = lists:last(Forms), NE. %% Partial evaluation. -- cgit v1.2.3 From 68c7362a0c98469a6949bf16abe1be783c87c6ec Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 17 Feb 2016 13:05:50 +0100 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_bsm.beam | Bin 12624 -> 12636 bytes bootstrap/lib/compiler/ebin/compile.beam | Bin 38776 -> 38704 bytes bootstrap/lib/compiler/ebin/v3_kernel.beam | Bin 46856 -> 46880 bytes bootstrap/lib/kernel/ebin/application.beam | Bin 4604 -> 3852 bytes bootstrap/lib/kernel/ebin/disk_log_1.beam | Bin 24640 -> 24876 bytes bootstrap/lib/kernel/ebin/heart.beam | Bin 4064 -> 4128 bytes bootstrap/lib/kernel/ebin/user_drv.beam | Bin 11352 -> 11412 bytes bootstrap/lib/stdlib/ebin/dets_utils.beam | Bin 28684 -> 28756 bytes bootstrap/lib/stdlib/ebin/dets_v8.beam | Bin 27448 -> 27488 bytes bootstrap/lib/stdlib/ebin/dets_v9.beam | Bin 49804 -> 49844 bytes bootstrap/lib/stdlib/ebin/dict.beam | Bin 9272 -> 9332 bytes bootstrap/lib/stdlib/ebin/digraph.beam | Bin 8192 -> 8312 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 26952 -> 26732 bytes bootstrap/lib/stdlib/ebin/erl_expand_records.beam | Bin 22328 -> 21764 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 89528 -> 89756 bytes bootstrap/lib/stdlib/ebin/file_sorter.beam | Bin 30368 -> 30408 bytes bootstrap/lib/stdlib/ebin/gen_event.beam | Bin 19484 -> 13524 bytes bootstrap/lib/stdlib/ebin/gen_fsm.beam | Bin 17324 -> 10476 bytes bootstrap/lib/stdlib/ebin/gen_server.beam | Bin 19508 -> 13744 bytes bootstrap/lib/stdlib/ebin/lists.beam | Bin 29708 -> 29768 bytes bootstrap/lib/stdlib/ebin/ms_transform.beam | Bin 20420 -> 20460 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 11796 -> 11896 bytes bootstrap/lib/stdlib/ebin/qlc.beam | Bin 70108 -> 70148 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 76248 -> 76244 bytes bootstrap/lib/stdlib/ebin/rand.beam | Bin 13440 -> 13560 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 30172 -> 30236 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 23896 -> 23456 bytes bootstrap/lib/stdlib/ebin/supervisor_bridge.beam | Bin 2900 -> 2072 bytes bootstrap/lib/stdlib/ebin/unicode.beam | Bin 11552 -> 11612 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 26568 -> 26632 bytes 30 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam index 4294fcb23f..b65f915978 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bsm.beam and b/bootstrap/lib/compiler/ebin/beam_bsm.beam differ diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam index 8126046e08..5234f98a75 100644 Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam index b3f927ab3c..6555a39c86 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel.beam and b/bootstrap/lib/compiler/ebin/v3_kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam index c80144ec65..ac01acad27 100644 Binary files a/bootstrap/lib/kernel/ebin/application.beam and b/bootstrap/lib/kernel/ebin/application.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam index 9111e3c69c..fc1c4781f1 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log_1.beam and b/bootstrap/lib/kernel/ebin/disk_log_1.beam differ diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam index bd24310b0b..480cb0b878 100644 Binary files a/bootstrap/lib/kernel/ebin/heart.beam and b/bootstrap/lib/kernel/ebin/heart.beam differ diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam index 971c19a824..e306b172bf 100644 Binary files a/bootstrap/lib/kernel/ebin/user_drv.beam and b/bootstrap/lib/kernel/ebin/user_drv.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam index 964ed4e791..ab627d50df 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_utils.beam and b/bootstrap/lib/stdlib/ebin/dets_utils.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam index 6c2a3e9efb..9a1416a316 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v8.beam and b/bootstrap/lib/stdlib/ebin/dets_v8.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam index 46f8d2c6a5..0b966769ba 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v9.beam and b/bootstrap/lib/stdlib/ebin/dets_v9.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam index 45cc303498..3b2b5a4c04 100644 Binary files a/bootstrap/lib/stdlib/ebin/dict.beam and b/bootstrap/lib/stdlib/ebin/dict.beam differ diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam index 28b65ce7b5..76713562bc 100644 Binary files a/bootstrap/lib/stdlib/ebin/digraph.beam and b/bootstrap/lib/stdlib/ebin/digraph.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index d9cd838ca9..dc2b80b019 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam index 001709532a..617913c674 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam and b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index ff2d94324a..3a0681d1bf 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam index d23ec4d0ee..9286aea119 100644 Binary files a/bootstrap/lib/stdlib/ebin/file_sorter.beam and b/bootstrap/lib/stdlib/ebin/file_sorter.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam index 4d64451826..4788735049 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_event.beam and b/bootstrap/lib/stdlib/ebin/gen_event.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam index 5e26fae139..f78a7368d5 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_fsm.beam and b/bootstrap/lib/stdlib/ebin/gen_fsm.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam index d40b5808f3..8ebe9d7a3a 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_server.beam and b/bootstrap/lib/stdlib/ebin/gen_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam index 56b9d2c88a..91297311b2 100644 Binary files a/bootstrap/lib/stdlib/ebin/lists.beam and b/bootstrap/lib/stdlib/ebin/lists.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam index d3ae7b6775..2c0eb8a742 100644 Binary files a/bootstrap/lib/stdlib/ebin/ms_transform.beam and b/bootstrap/lib/stdlib/ebin/ms_transform.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index 66b712b1d1..3e3673577a 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam index e0aeaf3d23..436b62e50e 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc.beam and b/bootstrap/lib/stdlib/ebin/qlc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index af12a888b6..4032af0dd7 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam index 5bc835e2e8..8370469ff4 100644 Binary files a/bootstrap/lib/stdlib/ebin/rand.beam and b/bootstrap/lib/stdlib/ebin/rand.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index ee304db782..8e64036c90 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index ed50c91bf7..e03a3264a6 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam index 279fded868..d2bfe6eea8 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam and b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam differ diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam index e34f8a35cf..17a318c4d4 100644 Binary files a/bootstrap/lib/stdlib/ebin/unicode.beam and b/bootstrap/lib/stdlib/ebin/unicode.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index 943fce47e0..1a19b1f28a 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ -- cgit v1.2.3 From 8dbd8cb1fd7fe2fbe9f29fd5acf314f4cfe70895 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 17 Feb 2016 13:06:58 +0100 Subject: Update preloaded modules --- erts/preloaded/ebin/erl_prim_loader.beam | Bin 49984 -> 49836 bytes erts/preloaded/ebin/erlang.beam | Bin 101988 -> 101968 bytes erts/preloaded/ebin/erts_code_purger.beam | Bin 8724 -> 8704 bytes erts/preloaded/ebin/erts_internal.beam | Bin 9412 -> 9392 bytes erts/preloaded/ebin/init.beam | Bin 44724 -> 44588 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 1468 -> 1448 bytes erts/preloaded/ebin/prim_eval.beam | Bin 1340 -> 1320 bytes erts/preloaded/ebin/prim_file.beam | Bin 44908 -> 44800 bytes erts/preloaded/ebin/prim_inet.beam | Bin 72632 -> 72608 bytes erts/preloaded/ebin/prim_zip.beam | Bin 23308 -> 23156 bytes erts/preloaded/ebin/zlib.beam | Bin 14176 -> 14156 bytes 11 files changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam index 2a54c10273..ca9e6bd20f 100644 Binary files a/erts/preloaded/ebin/erl_prim_loader.beam and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index f1e48b3282..b353129a34 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam index 0b6dc19b66..4188e5fd9b 100644 Binary files a/erts/preloaded/ebin/erts_code_purger.beam and b/erts/preloaded/ebin/erts_code_purger.beam differ diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index e9fbdfd048..5590f5a911 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam index 2f66b5f970..8ac7f5b471 100644 Binary files a/erts/preloaded/ebin/init.beam and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam index 057fe79054..3cd2515ba8 100644 Binary files a/erts/preloaded/ebin/otp_ring0.beam and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam index 33f5de7d3f..9a208d1545 100644 Binary files a/erts/preloaded/ebin/prim_eval.beam and b/erts/preloaded/ebin/prim_eval.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index b96927b72b..a386613eef 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam index 767a48d781..d68d18ecba 100644 Binary files a/erts/preloaded/ebin/prim_inet.beam and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam index 2bc85bbcbf..01b3b1feb8 100644 Binary files a/erts/preloaded/ebin/prim_zip.beam and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam index 0b4afc0a39..7252d866bb 100644 Binary files a/erts/preloaded/ebin/zlib.beam and b/erts/preloaded/ebin/zlib.beam differ -- cgit v1.2.3 From 5f571ca95a0cd22dcd050c43dbf111aeece89fd7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 26 Oct 2015 11:55:42 +0100 Subject: epp: Refactor expand_macros() As a preparation for implementing a ?FUNCTION macro, pass the entire state record to expand_macros/2 and its helpers. That will allow us to have more information available when expanding ?FUNCTION. --- lib/stdlib/src/epp.erl | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index be7c2ec346..f55aff1e00 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -755,7 +755,7 @@ scan_toks([{'-',_Lh},{atom,_Le,elif}=Elif|Toks], From, St) -> scan_toks([{'-',_Lh},{atom,_Le,endif}=Endif|Toks], From, St) -> scan_endif(Toks, Endif, From, St); scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St) of Toks1 when is_list(Toks1) -> scan_file(Toks1, FileToken, From, St); {error,ErrL,What} -> @@ -763,7 +763,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> wait_req_scan(St) end; scan_toks(Toks0, From, St) -> - case catch expand_macros(Toks0, {St#epp.macs, St#epp.uses}) of + case catch expand_macros(Toks0, St) of Toks1 when is_list(Toks1) -> epp_reply(From, {ok,Toks1}), wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)}); @@ -1145,24 +1145,24 @@ macro_expansion([T|Ts], _Anno0) -> [T|macro_expansion(Ts, T)]; macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). -%% expand_macros(Tokens, Macros) +%% expand_macros(Tokens, St) %% expand_macro(Tokens, MacroToken, RestTokens) %% Expand the macros in a list of tokens, making sure that an expansion %% gets the same location as the macro call. -expand_macros(MacT, M, Toks, Ms0) -> - {Ms,U} = Ms0, +expand_macros(MacT, M, Toks, St) -> + #epp{macs=Ms,uses=U} = St, Lm = loc(MacT), Tinfo = element(2, MacT), case expand_macro1(Lm, M, Toks, Ms) of {ok,{none,Exp}} -> check_uses([{M,none}], [], U, Lm), - Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), Ms0), - expand_macros(Toks1++Toks, Ms0); + Toks1 = expand_macros(expand_macro(Exp, Tinfo, [], #{}), St), + expand_macros(Toks1++Toks, St); {ok,{As,Exp}} -> check_uses([{M,length(As)}], [], U, Lm), {Bs,Toks1} = bind_args(Toks, Lm, M, As, #{}), - expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), Ms0) + expand_macros(expand_macro(Exp, Tinfo, Toks1, Bs), St) end. expand_macro1(Lm, M, Toks, Ms) -> @@ -1211,16 +1211,16 @@ get_macro_uses({M,Arity}, U) -> %% Macro expansion %% Note: io:scan_erl_form() does not return comments or white spaces. -expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(MacT, M, Toks, Ms); +expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Special macros -expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> +expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) -> Line = erl_scan:line(Tok), - [{integer,Lm,Line}|expand_macros(Toks, Ms)]; -expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> - expand_macros(MacT, M, Toks, Ms); + [{integer,Lm,Line}|expand_macros(Toks, St)]; +expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], St) -> + expand_macros(MacT, M, Toks, St); %% Illegal macros -expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> +expand_macros([{'?',_Lq},Token|_Toks], _St) -> T = case erl_scan:text(Token) of Text when is_list(Text) -> Text; @@ -1229,9 +1229,9 @@ expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); -expand_macros([T|Ts], Ms) -> - [T|expand_macros(Ts, Ms)]; -expand_macros([], _Ms) -> []. +expand_macros([T|Ts], St) -> + [T|expand_macros(Ts, St)]; +expand_macros([], _St) -> []. %% bind_args(Tokens, MacroLocation, MacroName, ArgumentVars, Bindings) %% Collect the arguments to a macro call. -- cgit v1.2.3 From 061aea4d8ff9b7bac9822317b104431dda0da929 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 17 Feb 2016 15:00:03 +0100 Subject: kernel: Correct contract for inet:getifaddrs/1 See also http://bugs.erlang.org/browse/ERL-95. --- lib/kernel/src/inet.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index b573112445..c1ae99ea24 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -289,7 +289,7 @@ getifaddrs(Socket) -> -spec getifaddrs() -> {ok, Iflist} | {error, posix()} when Iflist :: [{Ifname,[Ifopt]}], Ifname :: string(), - Ifopt :: {flag,[Flag]} | {addr,Addr} | {netmask,Netmask} + Ifopt :: {flags,[Flag]} | {addr,Addr} | {netmask,Netmask} | {broadaddr,Broadaddr} | {dstaddr,Dstaddr} | {hwaddr,Hwaddr}, Flag :: up | broadcast | loopback | pointtopoint -- cgit v1.2.3 From 661aeed3ef57de87330123adf6100e179fd7dad0 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 15 Feb 2016 15:26:45 +0100 Subject: Improve cmpxchg8b inline asm configure test --- erts/aclocal.m4 | 144 +++++++++++++++++++---- erts/include/internal/ethread_header_config.h.in | 4 + erts/include/internal/i386/ethr_dw_atomic.h | 16 ++- 3 files changed, 135 insertions(+), 29 deletions(-) diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 3d52538933..3db6ff5b4c 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -2117,45 +2117,126 @@ esac case "$GCC-$host_cpu" in yes-i86pc | yes-i*86 | yes-x86_64 | yes-amd64) + + if test $ac_cv_sizeof_void_p = 4; then + dw_cmpxchg="cmpxchg8b" + else + dw_cmpxchg="cmpxchg16b" + fi + gcc_dw_cmpxchg_asm=no - AC_MSG_CHECKING([for gcc double word cmpxchg asm support]) - AC_TRY_COMPILE([], + gcc_pic_dw_cmpxchg_asm=no + gcc_cflags_pic=no + gcc_cmpxchg8b_pic_no_clobber_ebx=no + gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage=no + + save_CFLAGS="$CFLAGS" + + # Check if it works out of the box using passed CFLAGS + # and with -fPIC added to CFLAGS if the passed CFLAGS + # doesn't trigger position independent code + pic_cmpxchg=unknown + while true; do + + case $pic_cmpxchg in + yes) pic_text="pic ";; + *) pic_text="";; + esac + + AC_MSG_CHECKING([for gcc $pic_text$dw_cmpxchg plain asm support]) + + plain_cmpxchg=no + AC_TRY_COMPILE([], [ char xchgd; long new[2], xchg[2], *p; __asm__ __volatile__( -#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ - "pushl %%ebx\n\t" - "movl %8, %%ebx\n\t" -#endif #if ETHR_SIZEOF_PTR == 4 "lock; cmpxchg8b %0\n\t" #else "lock; cmpxchg16b %0\n\t" #endif "setz %3\n\t" -#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ - "popl %%ebx\n\t" -#endif : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) - : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]), -#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ - "r"(new[0]) -#else - "b"(new[0]) -#endif + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]), "b"(new[0]) : "cc", "memory"); + ], + [plain_cmpxchg=yes]) + + AC_MSG_RESULT([$plain_cmpxchg]) + + if test $pic_cmpxchg = yes; then + gcc_pic_dw_cmpxchg_asm=$plain_cmpxchg + break + fi + + gcc_dw_cmpxchg_asm=$plain_cmpxchg + # If not already compiling to position independent + # code add -fPIC to CFLAGS and do it again. This + # since we want also want to know how to compile + # to position independent code since this might + # cause problems with the use of the EBX register + # as input to the asm on 32-bit x86 and old gcc + # compilers (gcc vsn < 5). + + AC_TRY_COMPILE([], + [ +#if !defined(__PIC__) || !__PIC__ +# error no pic +#endif ], - [gcc_dw_cmpxchg_asm=yes]) - if test $gcc_dw_cmpxchg_asm = no && test $ac_cv_sizeof_void_p = 4; then + [pic_cmpxchg=yes + gcc_cflags_pic=yes], + [pic_cmpxchg=no]) + + if test $pic_cmpxchg = yes; then + gcc_pic_dw_cmpxchg_asm=$gcc_dw_cmpxchg_asm + break + fi + + CFLAGS="$save_CFLAGS -fPIC" + pic_cmpxchg=yes + + done + + if test $gcc_pic_dw_cmpxchg_asm = no && test $ac_cv_sizeof_void_p = 4; then + + AC_MSG_CHECKING([for gcc pic cmpxchg8b asm support with EBX workaround]) + + # Check if we can work around it by managing the ebx + # register explicitly in the asm... + AC_TRY_COMPILE([], + [ + char xchgd; + long new[2], xchg[2], *p; + __asm__ __volatile__( + "pushl %%ebx\n\t" + "movl %8, %%ebx\n\t" + "lock; cmpxchg8b %0\n\t" + "setz %3\n\t" + "popl %%ebx\n\t" + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]), "r"(new[0]) + : "cc", "memory"); + ], + [gcc_pic_dw_cmpxchg_asm=yes + gcc_cmpxchg8b_pic_no_clobber_ebx=yes]) + + AC_MSG_RESULT([$gcc_pic_dw_cmpxchg_asm]) + + if test $gcc_pic_dw_cmpxchg_asm = no; then + + AC_MSG_CHECKING([for gcc pic cmpxchg8b asm support with EBX and register shortage workarounds]) + # If no optimization is enabled we sometimes get a + # register shortage. Check if we can work around + # this... + + AC_TRY_COMPILE([], [ char xchgd; long new[2], xchg[2], *p; -#if !defined(__PIC__) || !__PIC__ -# error nope -#endif __asm__ __volatile__( "pushl %%ebx\n\t" "movl (%7), %%ebx\n\t" @@ -2168,12 +2249,27 @@ case "$GCC-$host_cpu" in : "cc", "memory"); ], - [gcc_dw_cmpxchg_asm=yes]) - if test "$gcc_dw_cmpxchg_asm" = "yes"; then - AC_DEFINE(ETHR_CMPXCHG8B_REGISTER_SHORTAGE, 1, [Define if you get a register shortage with cmpxchg8b and position independent code]) + [gcc_pic_dw_cmpxchg_asm=yes + gcc_cmpxchg8b_pic_no_clobber_ebx=yes + gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage=yes]) + + AC_MSG_RESULT([$gcc_pic_dw_cmpxchg_asm]) fi + + if test $gcc_cflags_pic = yes; then + gcc_dw_cmpxchg_asm=$gcc_pic_dw_cmpxchg_asm + fi + + fi + + CFLAGS="$save_CFLAGS" + + if test "$gcc_cmpxchg8b_pic_no_clobber_ebx" = "yes"; then + AC_DEFINE(ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX, 1, [Define if gcc wont let you clobber ebx with cmpxchg8b and position independent code]) + fi + if test "$gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage" = "yes"; then + AC_DEFINE(ETHR_CMPXCHG8B_REGISTER_SHORTAGE, 1, [Define if you get a register shortage with cmpxchg8b and position independent code]) fi - AC_MSG_RESULT([$gcc_dw_cmpxchg_asm]) if test "$gcc_dw_cmpxchg_asm" = "yes"; then AC_DEFINE(ETHR_GCC_HAVE_DW_CMPXCHG_ASM_SUPPORT, 1, [Define if you use a gcc that supports the double word cmpxchg instruction]) fi;; diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in index 9cabd0591a..f4b08cfced 100644 --- a/erts/include/internal/ethread_header_config.h.in +++ b/erts/include/internal/ethread_header_config.h.in @@ -166,6 +166,10 @@ /* Define if you use a gcc that supports the double word cmpxchg instruction */ #undef ETHR_GCC_HAVE_DW_CMPXCHG_ASM_SUPPORT +/* Define if gcc wont let you clobber ebx with cmpxchg8b and position + independent code */ +#undef ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX + /* Define if you get a register shortage with cmpxchg8b and position independent code */ #undef ETHR_CMPXCHG8B_REGISTER_SHORTAGE diff --git a/erts/include/internal/i386/ethr_dw_atomic.h b/erts/include/internal/i386/ethr_dw_atomic.h index e8c4119ef0..79de5d80da 100644 --- a/erts/include/internal/i386/ethr_dw_atomic.h +++ b/erts/include/internal/i386/ethr_dw_atomic.h @@ -115,13 +115,19 @@ ethr_native_dw_atomic_addr(ethr_native_dw_atomic_t *var) return (ethr_sint_t *) ETHR_DW_NATMC_MEM__(var); } -#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ +#if defined(ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX) && defined(__PIC__) && __PIC__ +#if ETHR_SIZEOF_PTR != 4 +# error unexpected pic issue +#endif /* * When position independent code is used in 32-bit mode, the EBX 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 - * EBX register explicitly (for some reason gcc doesn't provide this - * service to us). + * is used for storage of global offset table address. When compiling with + * an old gcc (< vsn 5) we may not use it as input or output in an inline + * asm. We then need to save and restore the EBX register explicitly (for + * some reason old gcc compilers didn't provide this service to us). + * ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX will be defined if we need to + * explicitly manage EBX ourselves. + * */ # define ETHR_NO_CLOBBER_EBX__ 1 #else -- cgit v1.2.3 From 1604b874828e8ef992c8e17e06e7af20a0f1574b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 26 Oct 2015 12:02:40 +0100 Subject: Implement ?FUNCTION_NAME and ?FUNCTION_ARITY macros For a long time, users have asked for one or more macros that would return the name and arity of the current function. We could define a single ?FUNCTION macro that would return a {Name,Arity} tuple. However, to access just the name or just the arity for the function, element/2 must be used. That would limit its usefulness, because element/2 is not allowed in all contexts. Therefore, it seems that we will need two macros. ?FUNCTION_NAME that expands to the name of the current function and ?FUNCTION_ARITY that expands to arity of the current function. Converting the function name to a string can be done like this: f() -> atom_to_list(?FUNCTION_NAME) ++ "/" ++ integer_to_list(?FUNCTION_ARITY). f/0 will return "f/0". The BEAM compiler will evaluate the entire expression at compile-time, so there will not be any run-time penalty for the function calls. The implementation is non-trivial because the preprocessor is run before the parser. One way to implement the macros would be to replace them with some placeholder and then let the parser or possibly a later pass replace the placeholder with correct value. That could potentially slow down the compiler and cause incompatibilities for parse transforms. Another way is to let the preprocessor do the whole job. That means that the preprocessor will have to scan the function head to find out the name and arity. The scanning of the function head can be delayed until the first occurrence of a ?FUNCTION_NAME or ?FUNCTION_ARITY. I have chosen the second way because it seems less likely to cause weird compatibility problems. --- lib/stdlib/src/epp.erl | 118 ++++++++++++++++++++++++++++++++- lib/stdlib/test/epp_SUITE.erl | 91 +++++++++++++++++++++++-- system/doc/reference_manual/macros.xml | 4 ++ 3 files changed, 207 insertions(+), 6 deletions(-) diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index f55aff1e00..936c095aef 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -46,6 +46,10 @@ -type tokens() :: [erl_scan:token()]. -type used() :: {name(), argspec()}. +-type function_name_type() :: 'undefined' + | {atom(),non_neg_integer()} + | tokens(). + -define(DEFAULT_ENCODING, utf8). %% Epp state record. @@ -63,7 +67,8 @@ uses = #{} %Macro use structure :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), - pre_opened = false :: boolean() + pre_opened = false :: boolean(), + fname = [] :: function_name_type() }). %% open(Options) @@ -205,6 +210,10 @@ format_error({include,W,F}) -> io_lib:format("can't find include ~s \"~s\"", [W,F]); format_error({illegal,How,What}) -> io_lib:format("~s '-~s'", [How,What]); +format_error({illegal_function,Macro}) -> + io_lib:format("?~s can only be used within a function", [Macro]); +format_error({illegal_function_usage,Macro}) -> + io_lib:format("?~s must not begin a form", [Macro]); format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); format_error(E) -> file:format_error(E). @@ -545,6 +554,8 @@ predef_macros(File) -> Machine = list_to_atom(erlang:system_info(machine)), Anno = line1(), Defs = [{'FILE', {none,[{string,Anno,File}]}}, + {'FUNCTION_NAME', undefined}, + {'FUNCTION_ARITY', undefined}, {'LINE', {none,[{integer,Anno,1}]}}, {'MODULE', undefined}, {'MODULE_STRING', undefined}, @@ -763,7 +774,7 @@ scan_toks([{'-',_Lh},{atom,_Lf,file}=FileToken|Toks0], From, St) -> wait_req_scan(St) end; scan_toks(Toks0, From, St) -> - case catch expand_macros(Toks0, St) of + case catch expand_macros(Toks0, St#epp{fname=Toks0}) of Toks1 when is_list(Toks1) -> epp_reply(From, {ok,Toks1}), wait_req_scan(St#epp{macs=scan_module(Toks1, St#epp.macs)}); @@ -1214,6 +1225,22 @@ get_macro_uses({M,Arity}, U) -> expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], St) -> expand_macros(MacT, M, Toks, St); %% Special macros +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_NAME'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {Name,_} -> + [{atom,Lm,Name}] + end ++ expand_macros(Toks, St); +expand_macros([{'?',_Lq},{var,Lm,'FUNCTION_ARITY'}=Token|Toks], St0) -> + St = update_fun_name(Token, St0), + case St#epp.fname of + undefined -> + [{'?',_Lq},Token]; + {_,Arity} -> + [{integer,Lm,Arity}] + end ++ expand_macros(Toks, St); expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], St) -> Line = erl_scan:line(Tok), [{integer,Lm,Line}|expand_macros(Toks, St)]; @@ -1354,6 +1381,93 @@ expand_arg([A|As], Ts, _L, Rest, Bs) -> expand_arg([], Ts, L, Rest, Bs) -> expand_macro(Ts, L, Rest, Bs). +%%% +%%% Here follows support for the ?FUNCTION_NAME and ?FUNCTION_ARITY +%%% macros. Since the parser has not been run yet, we don't know the +%%% name and arity of the current function. Therefore, we will need to +%%% scan the beginning of the current form to extract the name and +%%% arity of the function. +%%% + +update_fun_name(Token, #epp{fname=Toks0}=St) when is_list(Toks0) -> + %% ?FUNCTION_NAME or ?FUNCTION_ARITY is used for the first time in + %% a function. First expand macros (except ?FUNCTION_NAME and + %% ?FUNCTION_ARITY) in the form. + + Toks1 = (catch expand_macros(Toks0, St#epp{fname=undefined})), + + %% Now extract the name and arity from the stream of tokens, and store + %% the result in the #epp{} record so we don't have to do it + %% again. + + case Toks1 of + [{atom,_,Name},{'(',_}|Toks] -> + %% This is the beginning of a function definition. + %% Scan the token stream up to the matching right + %% parenthesis and count the number of arguments. + FA = update_fun_name_1(Toks, 1, {Name,0}, St), + St#epp{fname=FA}; + [{'?',_}|_] -> + %% ?FUNCTION_NAME/?FUNCTION_ARITY used at the beginning + %% of a form. Does not make sense. + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function_usage,Macro}}); + _ when is_list(Toks1) -> + %% Not the beginning of a function (an attribute or a + %% syntax error). + {var,_,Macro} = Token, + throw({error,loc(Token),{illegal_function,Macro}}); + _ -> + %% A macro expansion error. Return a dummy value and + %% let the caller notice and handle the error. + St#epp{fname={'_',0}} + end; +update_fun_name(_Token, St) -> + St. + +update_fun_name_1([Tok|Toks], L, FA, St) -> + case classify_token(Tok) of + comma -> + if + L =:= 1 -> + {Name,Arity} = FA, + update_fun_name_1(Toks, L, {Name,Arity+1}, St); + true -> + update_fun_name_1(Toks, L, FA, St) + end; + left -> + update_fun_name_1(Toks, L+1, FA, St); + right when L =:= 1 -> + FA; + right -> + update_fun_name_1(Toks, L-1, FA, St); + other -> + case FA of + {Name,0} -> + update_fun_name_1(Toks, L, {Name,1}, St); + {_,_} -> + update_fun_name_1(Toks, L, FA, St) + end + end; +update_fun_name_1([], _, FA, _) -> + %% Syntax error, but never mind. + FA. + +classify_token({C,_}) -> classify_token_1(C); +classify_token(_) -> other. + +classify_token_1(',') -> comma; +classify_token_1('(') -> left; +classify_token_1('{') -> left; +classify_token_1('[') -> left; +classify_token_1('<<') -> left; +classify_token_1(')') -> right; +classify_token_1('}') -> right; +classify_token_1(']') -> right; +classify_token_1('>>') -> right; +classify_token_1(_) -> other. + + %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 955b482313..bd8939ccca 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -27,7 +27,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_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, - otp_11728/1, encoding/1, extends/1]). + otp_11728/1, encoding/1, extends/1, function_macro/1]). -export([epp_parse_erl_form/2]). @@ -70,7 +70,7 @@ all() -> not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, - encoding, extends]. + encoding, extends, function_macro]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -843,8 +843,9 @@ otp_8130(Config) when is_list(Config) -> "t() -> ?a.\n"), ?line {ok,Epp} = epp:open(File, []), PreDefMacs = macs(Epp), - ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE','LINE', - 'MACHINE','MODULE','MODULE_STRING'] = PreDefMacs, + ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE', + 'FUNCTION_ARITY','FUNCTION_NAME', + 'LINE','MACHINE','MODULE','MODULE_STRING'] = PreDefMacs, ?line {ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp), ?line {ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp), ?line {ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp), @@ -1491,6 +1492,88 @@ extends(Config) -> [] = run(Config, Ts), ok. +function_macro(Config) -> + Cs = [{f_c1, + <<"-define(FUNCTION_NAME, a).\n" + "-define(FUNCTION_ARITY, a).\n" + "-define(FS,\n" + " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n" + " integer_to_list(?FUNCTION_ARITY)).\n" + "-attr({f,?FUNCTION_NAME}).\n" + "-attr2(?FS).\n" + "-file(?FUNCTION_ARITY, 1).\n" + "f1() ?FUNCTION_NAME/?FUNCTION_ARITY.\n" + "f2(?FUNCTION_NAME.\n">>, + {errors,[{1,epp,{redefine_predef,'FUNCTION_NAME'}}, + {2,epp,{redefine_predef,'FUNCTION_ARITY'}}, + {6,epp,{illegal_function,'FUNCTION_NAME'}}, + {7,epp,{illegal_function,'FUNCTION_NAME'}}, + {8,epp,{illegal_function,'FUNCTION_ARITY'}}, + {9,erl_parse,["syntax error before: ","f1"]}, + {10,erl_parse,["syntax error before: ","'.'"]}], + []}}, + + {f_c2, + <<"a({a) -> ?FUNCTION_NAME.\n" + "b(}{) -> ?FUNCTION_ARITY.\n" + "c(?FUNCTION_NAME, ?not_defined) -> ok.\n">>, + {errors,[{1,erl_parse,["syntax error before: ","')'"]}, + {2,erl_parse,["syntax error before: ","'}'"]}, + {3,epp,{undefined,not_defined,none}}], + []}}, + + {f_c3, + <<"?FUNCTION_NAME() -> ok.\n" + "?FUNCTION_ARITY() -> ok.\n">>, + {errors,[{1,epp,{illegal_function_usage,'FUNCTION_NAME'}}, + {2,epp,{illegal_function_usage,'FUNCTION_ARITY'}}], + []}} + ], + + [] = compile(Config, Cs), + + Ts = [{f_1, + <<"t() -> {a,0} = a(), {b,1} = b(1), {c,2} = c(1, 2),\n" + " {d,1} = d({d,1}), {foo,1} = foo(foo), ok.\n" + "a() -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "b(_) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "c(_, (_)) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n" + "d({?FUNCTION_NAME,?FUNCTION_ARITY}=F) -> F.\n" + "-define(FOO, foo).\n" + "?FOO(?FOO) -> {?FUNCTION_NAME,?FUNCTION_ARITY}.\n">>, + ok}, + + {f_2, + <<"t() ->\n" + " A = {a,[<<0:24>>,#{a=>1,b=>2}]},\n" + " 1 = a(A),\n" + " ok.\n" + "a({a,[<<_,_,_>>,#{a:=1,b:=2}]}) -> ?FUNCTION_ARITY.\n">>, + ok}, + + {f_3, + <<"-define(FS,\n" + " atom_to_list(?FUNCTION_NAME) ++ \"/\" ++\n" + " integer_to_list(?FUNCTION_ARITY)).\n" + "t() ->\n" + " {t,0} = {?FUNCTION_NAME,?FUNCTION_ARITY},\n" + " \"t/0\" = ?FS,\n" + " ok.\n">>, + ok}, + + {f_4, + <<"-define(__, _, _).\n" + "-define(FF, ?FUNCTION_NAME, ?FUNCTION_ARITY).\n" + "a(?__) -> 2 = ?FUNCTION_ARITY.\n" + "b(?FUNCTION_ARITY, ?__) -> ok.\n" + "c(?FF) -> ok.\n" + "t() -> a(1, 2), b(3, 1, 2), c(c, 2), ok.\n">>, + ok} + ], + [] = run(Config, Ts), + + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index 3b1f72e5d6..42ea639b54 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -146,6 +146,10 @@ bar(X) -> The current line number. ?MACHINE. The machine name, 'BEAM'. + ?FUNCTION_NAME + The name of the current function. + ?FUNCTION_ARITY + The arity (number of arguments) for the current function.
-- cgit v1.2.3 From f5f72324dc1750bb849edda895afc6a5986d4ff6 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 1 Dec 2015 16:00:54 +0000 Subject: Fix typos in ssl.xml --- lib/ssl/doc/src/ssl.xml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index bf87644116..aaf03d1cd8 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -221,7 +221,7 @@ RFC 5746. By default secure_renegotiate is set to false, that is, secure renegotiation is used if possible, - but it fallback to unsecure renegotiation if the peer + but it falls back to insecure renegotiation if the peer does not support RFC 5746.

@@ -307,7 +307,7 @@ atom()}} | unknown_ca

No trusted CA was found in the trusted store. The trusted CA is normally a so called ROOT CA, which is a self-signed certificate. Trust can - be claimed for an intermediat CA (trusted anchor does not have to be + be claimed for an intermediate CA (trusted anchor does not have to be self-signed according to X-509) by using option partial_chain.

 @@ -352,7 +352,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid {http, timeout()}

Enables fetching of CRLs specified as http URIs in X509 cerificate extensions. + marker="public_key:public_key_records"> X509 certificate extensions. Requires the OTP inets application.

 @@ -611,14 +611,14 @@ fun(srp, Username :: string(), UserState :: term()) -> {sni_hosts, [{hostname(), ssloptions()}]}

If the server receives a SNI (Server Name Indication) from the client - matching a host listed in the sni_hosts option, the speicific options for + matching a host listed in the sni_hosts option, the specific options for that host will override previously specified options. The option sni_fun, and sni_hosts are mutually exclusive.

 {sni_fun, SNIfun::fun()}

If the server receives a SNI (Server Name Indication) from the client, - the given function will be called to retrive ssloptions() for indicated server. + the given function will be called to retrieve ssloptions() for the indicated server. These options will be merged into predefined ssloptions(). The function should be defined as: @@ -632,7 +632,7 @@ fun(srp, Username :: string(), UserState :: term()) -> of resources of such an operation is higher for the server than the client. This can act as a vector for denial of service attacks. The SSL application already takes measures to counter-act such attempts, - but client-initiated renegotiation can be stricly disabled by setting + but client-initiated renegotiation can be strictly disabled by setting this option to false. The default value is true. Note that disabling renegotiation can result in long-lived connections becoming unusable due to limits on the number of messages the underlying @@ -748,10 +748,10 @@ fun(srp, Username :: string(), UserState :: term()) -> How = timeout() | {NewController::pid(), timeout()} Reason = term() -

Closes or downgrades an SSL connection, in the later case the transport - connection will be handed over to the NewController process after reciving - the TLS close alert from the peer. The retuned transport socket will have - the following options set [{active, false}, {packet, 0}, {mode, binary}].

+

Closes or downgrades an SSL connection. In the latter case the transport + connection will be handed over to the NewController process after receiving + the TLS close alert from the peer. The returned transport socket will have + the following options set: [{active, false}, {packet, 0}, {mode, binary}]

 @@ -818,7 +818,7 @@ fun(srp, Username :: string(), UserState :: term()) -> Reason = term()

Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. - {ok, Info} will be returned if it executes sucessfully. The Info is a proplists containing the information you requested. + {ok, Info} will be returned if it executes successfully. Info is a proplist containing the information you requested. Otherwise, {error, Reason} will be returned.

 -- cgit v1.2.3 From fb3b718e11c8478c1fcaa2a3afc3f13ee5e10097 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 8 Dec 2015 18:12:08 +0000 Subject: Fix public_key documentation typos --- lib/public_key/doc/src/public_key.xml | 10 +++++----- lib/public_key/doc/src/public_key_records.xml | 6 +++--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 258e7cd1b9..16a7497a22 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -114,8 +114,8 @@ pem_entry () = -

{pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted

-

| cipher_info()}

 +

{pki_asn1_type(), binary(), %% DER or encrypted DER

+

not_encrypted | cipher_info()}

 cipher_info() =

{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)

@@ -786,13 +786,13 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, Decodes an SSH file-binary. SshBin = binary() - Example {ok, SshBin} = file:read_file("known_hosts"). + Example {ok, SshBin} = file:read_file("known_hosts"). Type = public_key | ssh_file() If Type is public_key the binary can be either an RFC4716 public key or an OpenSSH public key. -

Decodes an SSH file-binary. In the case of know_hosts or +

Decodes an SSH file-binary. In the case of known_hosts or auth_keys, the binary can include one or more lines of the file. Returns a list of public keys and their attributes, possible attribute values depends on the file type represented by the @@ -842,7 +842,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, Key = rsa_public_key() | dsa_public_key() | ec_public_key() -

Veryfies a digital signature.

+

Verifies a digital signature.

 diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index fb03da3150..d34f3ed9a3 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -57,9 +57,9 @@ time() = -

uct_time() | general_time()

 +

utc_time() | general_time()

 - uct_time() = + utc_time() =

{utcTime, "YYMMDDHHMMSSZ"}

 general_time() = @@ -144,7 +144,7 @@
DSA -

Erlang representation of Digigital Signature Algorithm (DSA) keys

+

Erlang representation of Digital Signature Algorithm (DSA) keys

#'DSAPrivateKey',{ version, % integer() -- cgit v1.2.3 From 171d7e2a161ef9270240aff0fa15a285df21c1ef Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Fri, 12 Feb 2016 15:04:30 +0100 Subject: [ct_netconfc] Fix XML parsing when multiple messages in package If a ssh package contained more than one netconf end tag, then the second end tag was never detected in ct_netconfc:handle_data. Instead it was included in the XML data given to the xmerl parser, which then failed with reason "\"]]>\" is not allowed in content". This problem was introduced by OTP-13007. --- lib/common_test/src/ct_netconfc.erl | 44 +++-- .../ct_netconfc_SUITE_data/netconfc1_SUITE.erl | 194 ++++++++++++++++++++- lib/common_test/test/ct_netconfc_SUITE_data/ns.erl | 23 ++- 3 files changed, 233 insertions(+), 28 deletions(-) diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 6e3d1ab1d8..3da1115c76 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -264,6 +264,7 @@ session_id, msg_id = 1, hello_status, + no_end_tag_buff = <<>>, buff = <<>>, pending = [], % [#pending] event_receiver}).% pid @@ -1170,7 +1171,7 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) -> end, %% Halfhearted try to get in correct state, this matches %% the implementation before this patch - {R,State#state{pending=Pending1, buff= <<>>}}. + {R,State#state{pending=Pending1, no_end_tag_buff= <<>>, buff= <<>>}}. %% @private %% Called by ct_util_server to close registered connections before terminate. @@ -1205,7 +1206,7 @@ call(Client, Msg, Timeout, WaitStop) -> {error,no_such_client}; {error,{process_down,Pid,normal}} when WaitStop -> %% This will happen when server closes connection - %% before clien received rpc-reply on + %% before client received rpc-reply on %% close-session. ok; {error,{process_down,Pid,normal}} -> @@ -1372,24 +1373,37 @@ to_xml_doc(Simple) -> %%%----------------------------------------------------------------- %%% Parse and handle received XML data -handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> +%%% Two buffers are used: +%%% * 'no_end_tag_buff' contains data that is checked and does not +%%% contain any (part of an) end tag. +%%% * 'buff' contains all other saved data - it may or may not +%%% include (a part of) an end tag. +%%% The reason for this is to avoid running binary:split/3 multiple +%%% times on the same data when it does not contain an end tag. This +%%% can be a considerable optimation in the case when a lot of data is +%%% received (e.g. when fetching all data from a node) and the data is +%%% sent in multiple ssh packages. +handle_data(NewData,#state{connection=Connection} = State0) -> log(Connection,recv,NewData), - {Start,AddSz} = - case byte_size(Buff0) of - BSz when BSz<5 -> {0,BSz}; - BSz -> {BSz-5,5} - end, - Length = byte_size(NewData) + AddSz, + NoEndTag0 = State0#state.no_end_tag_buff, + Buff0 = State0#state.buff, Data = <>, - case binary:split(Data,?END_TAG,[{scope,{Start,Length}}]) of + case binary:split(Data,?END_TAG,[]) of [_NoEndTagFound] -> - {noreply, State0#state{buff=Data}}; + NoEndTagSize = case byte_size(Data) of + Sz when Sz<5 -> 0; + Sz -> Sz-5 + end, + <> = Data, + NoEndTag = <>, + {noreply, State0#state{no_end_tag_buff=NoEndTag, buff=Buff}}; [FirstMsg0,Buff1] -> - FirstMsg = remove_initial_nl(FirstMsg0), + FirstMsg = remove_initial_nl(<>), SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of {ok, Simple, _Thrash} -> - case decode(Simple, State0#state{buff=Buff1}) of + case decode(Simple, State0#state{no_end_tag_buff= <<>>, + buff=Buff1}) of {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> %% Recurse if we have more data in buffer handle_data(<<>>, State); @@ -1401,10 +1415,12 @@ handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> [{parse_error,Reason}, {buffer, Buff0}, {new_data,NewData}]), - handle_error(Reason, State0#state{buff= <<>>}) + handle_error(Reason, State0#state{no_end_tag_buff= <<>>, + buff= <<>>}) end end. + %% xml does not accept a leading nl and some netconf server add a nl after %% each ?END_TAG, ignore them remove_initial_nl(<<"\n", Data/binary>>) -> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index ea49e36608..49b02d2bba 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -99,7 +99,10 @@ all() -> connection_crash, get_event_streams, create_subscription, - receive_event + receive_one_event, + receive_multiple_events, + receive_event_and_rpc, + receive_event_and_rpc_in_chunks ] end. @@ -354,7 +357,7 @@ get(Config) -> get_a_lot(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), - Descr = lists:append(lists:duplicate(100,"Description of myserver! ")), + Descr = lists:append(lists:duplicate(1000,"Description of myserver! ")), Server = {server,[{xmlns,"myns"}],[{name,[],["myserver"]}, {description,[],[Descr]}]}, Data = lists:duplicate(100,Server), @@ -964,16 +967,16 @@ create_subscription(Config) -> ok. -receive_event(Config) -> +receive_one_event(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), - ?NS:hupp(send_event), + ?NS:hupp({send_events,1}), receive - %% Matching ?NS:make_msg(event) + %% Matching ?NS:make_msg({event,_}) {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, [{eventTime,[],[_Time]}, {event,[{xmlns,"http://my.namespaces.com/event"}], @@ -991,6 +994,187 @@ receive_event(Config) -> ok. +receive_multiple_events(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + ?NS:hupp({send_events,3}), + + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + %% Matching ?NS:make_msg({event,_}) + {notification,_,_} -> + ok; + Other3 -> + ct:fail({got_unexpected_while_waiting_for_event, Other3}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + + ok. + +receive_event_and_rpc(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + %% Construct the data to return from netconf server - one + %% rpc-reply and one notification - to be sent in the same ssh + %% package. + Data = [{servers,[{xmlns,"myns"}],[{server,[],[{name,[],["myserver"]}]}]}], + Rpc = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"2"}], + [{data,Data}]}, + RpcXml = list_to_binary(xmerl:export_simple_element(Rpc,xmerl_xml)), + + Notification = + {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, + [{eventTime,["2012-06-14T14:50:54+02:00"]}, + {event,[{xmlns,"http://my.namespaces.com/event"}], + [{severity,["major"]}, + {description,["Something terrible happened"]}]}]}, + NotifXml = + list_to_binary(xmerl:export_simple_element(Notification,xmerl_xml)), + + ?NS:expect_reply('get',[RpcXml,NotifXml]), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + + %% Then do the same again, but now send notification first then + %% the rpc-reply. + Rpc2 = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"3"}], + [{data,Data}]}, + RpcXml2 = list_to_binary(xmerl:export_simple_element(Rpc2,xmerl_xml)), + ?NS:expect_reply('get',[NotifXml,RpcXml2]), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + + ok. + + +receive_event_and_rpc_in_chunks(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + + ?NS:expect_reply({'create-subscription',[stream]},ok), + ?ok = ct_netconfc:create_subscription(Client), + + %% Construct the data to return from netconf server + Data = [{servers,[{xmlns,"myns"}], + [{server,[],[{name,[],["server0"]}]}, + {server,[],[{name,[],["server1"]}]}, + {server,[],[{name,[],["server2"]}]}, + {server,[],[{name,[],["server3"]}]}, + {server,[],[{name,[],["server4"]}]}, + {server,[],[{name,[],["server5"]}]}, + {server,[],[{name,[],["server6"]}]}, + {server,[],[{name,[],["server7"]}]}, + {server,[],[{name,[],["server8"]}]}, + {server,[],[{name,[],["server9"]}]}] + }], + Rpc = {'rpc-reply',?NETCONF_NAMESPACE_ATTR ++ [{'message-id',"2"}], + [{data,Data}]}, + RpcXml = list_to_binary(xmerl:export_simple_element(Rpc,xmerl_xml)), + + Notification = + {notification,?NETCONF_NOTIF_NAMESPACE_ATTR, + [{eventTime,["2012-06-14T14:50:54+02:00"]}, + {event,[{xmlns,"http://my.namespaces.com/event"}], + [{severity,["major"]}, + {description,["Something terrible happened"]}]}]}, + NotifXml = + list_to_binary(xmerl:export_simple_element(Notification,xmerl_xml)), + + + %% First part contains a notif, but only parts of the end tag + Part1 = + <<"\n", + NotifXml/binary,"\n]]">>, + + %% Second part contains rest of end tag, full rpc-reply and full + %% notif except end tag + Part2 = + <<">]]>\n",RpcXml/binary,"\n",?END_TAG/binary,NotifXml/binary>>, + + %% Third part contains last end tag + Part3 = <<"\n",?END_TAG/binary,"\n">>, + + %% Spawn a process which will wait a bit for the client to send + %% the request (below), then order the server to the chunks of the + %% rpc-reply one by one. + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(send,Part3) + end), + + %% Order server to expect a get - then the process above will make + %% sure the rpc-reply is sent. + ?NS:expect('get'), + {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), + + receive + {notification,_,_} -> + ok; + Other1 -> + ct:fail({got_unexpected_while_waiting_for_event, Other1}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + receive + {notification,_,_} -> + ok; + Other2 -> + ct:fail({got_unexpected_while_waiting_for_event, Other2}) + after 3000 -> + ct:fail(timeout_waiting_for_event) + end, + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + ok. + %%%----------------------------------------------------------------- break(_Config) -> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index 07893faabc..67827a053f 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -144,8 +144,8 @@ expect_do_reply(SessionId,Expect,Do,Reply) -> %% Hupp the server - i.e. tell it to do something - %% e.g. hupp(send_event) will cause send_event(State) to be called on %% the session channel process. -hupp(send_event) -> - hupp(send,[make_msg(event)]); +hupp({send_events,N}) -> + hupp(send,[make_msg({event,N})]); hupp(kill) -> hupp(1,fun hupp_kill/1,[]). @@ -446,9 +446,12 @@ reply(ConnRef,Reply) -> from_simple(Simple) -> unicode_c2b(xmerl:export_simple_element(Simple,xmerl_xml)). -xml(Content) -> - <<"\n", - Content/binary,"\n",?END_TAG/binary>>. +xml(Content) when is_binary(Content) -> + xml([Content]); +xml(Content) when is_list(Content) -> + Msgs = [<> || Msg <- Content], + MsgsBin = list_to_binary(Msgs), + <<"\n", MsgsBin/binary>>. rpc_reply(Content) when is_binary(Content) -> MsgId = case erase(msg_id) of @@ -571,15 +574,17 @@ make_msg({ok,Data}) -> make_msg({data,Data}) -> xml(rpc_reply(from_simple({data,Data}))); -make_msg(event) -> - xml(<<"" +make_msg({event,N}) -> + Notification = <<"" "2012-06-14T14:50:54+02:00" "" "major" "Something terrible happened" "" - "">>); -make_msg(Xml) when is_binary(Xml) -> + "">>, + xml(lists:duplicate(N,Notification)); +make_msg(Xml) when is_binary(Xml) orelse + (is_list(Xml) andalso is_binary(hd(Xml))) -> xml(Xml); make_msg(Simple) when is_tuple(Simple) -> xml(from_simple(Simple)). -- cgit v1.2.3 From 5615f7f36f9c3a7e7f7307ade2c3830c83071d0c Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Thu, 18 Feb 2016 12:32:35 +0100 Subject: Prepare release --- lib/common_test/doc/src/notes.xml | 20 ++++++++++++++++++++ lib/common_test/vsn.mk | 2 +- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 9906db2c90..57a8c6c9e2 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,26 @@ notes.xml +
Common_Test 1.11.2 + +
Fixed Bugs and Malfunctions + + +

+ If a ssh package contained more than one netconf end tag, + then the second end tag was never detected in + ct_netconfc:handle_data. Instead it was included in the + XML data given to the xmerl parser, which then failed. + The problem was introduced by OTP-13007, and has now been + corrected.

+

+ Own Id: OTP-13323

+ + +
+ +
+
Common_Test 1.11.1
Fixed Bugs and Malfunctions diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index f33b705dcb..34ed657e01 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.11.1 +COMMON_TEST_VSN = 1.11.2 -- cgit v1.2.3 From d646221c59fbf57d5beac913248b46f5dbebfbe7 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Thu, 18 Feb 2016 12:32:36 +0100 Subject: Updated OTP version --- OTP_VERSION | 2 +- otp_versions.table | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/OTP_VERSION b/OTP_VERSION index 3cac390ba4..93d4fc0a52 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.2.3 +18.2.4 diff --git a/otp_versions.table b/otp_versions.table index 723f8fdf25..377e525448 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.2.4 : common_test-1.11.2 # asn1-4.0.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2.3 : inets-6.1.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2.2 : ssh-4.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : OTP-18.2.1 : erts-7.2.1 # asn1-4.0.1 common_test-1.11.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : -- cgit v1.2.3 From b6135ca68e8caf6ed8528c1274d4ed88b64c1480 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 18 Feb 2016 15:48:01 +0100 Subject: Add --with-ssl-incl and --with-ssl-rpath to docs --- HOWTO/INSTALL.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 51e8648a4a..0a5b5799f8 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -374,9 +374,15 @@ Some of the available `configure` options are: `jinterface` application won't be built) * `--{enable,disable}-dynamic-ssl-lib` - Dynamic OpenSSL libraries * `--{enable,disable}-builtin-zlib` - Use the built-in source for zlib. -* `--with-ssl=PATH` - Specify location of OpenSSL include and lib * `--{with,without}-ssl` - OpenSSL (without implies that the `crypto`, `ssh`, and `ssl` won't be built) +* `--with-ssl=PATH` - Specify location of OpenSSL include and lib +* `--with-ssl-incl=PATH` - Location of OpenSSL `include` directory, + if different than specified by `--with-ssl=PATH` +* `--with-ssl-rpath=yes|no|PATHS` - Runtime library path for OpenSSL. + Default is `yes`, which equates to a number of standard locations. If + `no`, then no runtime library paths wil be used. Anything else should be + a comma separated list of paths. * `--with-libatomic_ops=PATH` - Use the `libatomic_ops` library for atomic memory accesses. If `configure` should inform you about no native atomic implementation available, you typically want to try using the -- cgit v1.2.3 From 85d2337de76ba43f087478d4566641d632f06fec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 18 Feb 2016 15:57:08 +0100 Subject: Update primary bootstrap --- bootstrap/lib/kernel/ebin/error_logger.beam | Bin 4464 -> 5932 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 26732 -> 28208 bytes 2 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam index 64c2d58205..73ab813430 100644 Binary files a/bootstrap/lib/kernel/ebin/error_logger.beam and b/bootstrap/lib/kernel/ebin/error_logger.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index dc2b80b019..d19b427124 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ -- cgit v1.2.3 From eb59e961ae05048ea30362aafb7f91db26ceb939 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 17 Feb 2016 16:56:05 +0100 Subject: Improve cmpxchg8b/cmpxchg16b inline asm Clang didn't like that ecx/rcx was mapped to input and output variables of different types. --- erts/aclocal.m4 | 24 ++++++------ erts/include/internal/i386/ethr_dw_atomic.h | 57 +++++++++++++++++++---------- 2 files changed, 49 insertions(+), 32 deletions(-) diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 3db6ff5b4c..ec9b66bf29 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -2157,8 +2157,8 @@ case "$GCC-$host_cpu" in "lock; cmpxchg16b %0\n\t" #endif "setz %3\n\t" - : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) - : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]), "b"(new[0]) + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "b"(new[0]) : "cc", "memory"); ], [plain_cmpxchg=yes]) @@ -2217,8 +2217,8 @@ case "$GCC-$host_cpu" in "lock; cmpxchg8b %0\n\t" "setz %3\n\t" "popl %%ebx\n\t" - : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) - : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]), "r"(new[0]) + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "r"(new[0]) : "cc", "memory"); ], [gcc_pic_dw_cmpxchg_asm=yes @@ -2238,14 +2238,14 @@ case "$GCC-$host_cpu" in char xchgd; long new[2], xchg[2], *p; __asm__ __volatile__( - "pushl %%ebx\n\t" - "movl (%7), %%ebx\n\t" - "movl 4(%7), %%ecx\n\t" - "lock; cmpxchg8b %0\n\t" - "setz %3\n\t" - "popl %%ebx\n\t" - : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) - : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new) + "pushl %%ebx\n\t" + "movl (%7), %%ebx\n\t" + "movl 4(%7), %%ecx\n\t" + "lock; cmpxchg8b %0\n\t" + "setz %3\n\t" + "popl %%ebx\n\t" + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "r"(new) : "cc", "memory"); ], diff --git a/erts/include/internal/i386/ethr_dw_atomic.h b/erts/include/internal/i386/ethr_dw_atomic.h index 79de5d80da..5444a6345c 100644 --- a/erts/include/internal/i386/ethr_dw_atomic.h +++ b/erts/include/internal/i386/ethr_dw_atomic.h @@ -157,36 +157,53 @@ ethr_native_dw_atomic_cmpxchg_mb(ethr_native_dw_atomic_t *var, ETHR_DW_DBG_ALIGNED__(p); +#if ETHR_NO_CLOBBER_EBX__ && ETHR_CMPXCHG8B_REGISTER_SHORTAGE + /* + * gcc wont let us use ebx as input and we + * get a register shortage + */ + __asm__ __volatile__( -#if ETHR_NO_CLOBBER_EBX__ "pushl %%ebx\n\t" -# if ETHR_CMPXCHG8B_REGISTER_SHORTAGE "movl (%7), %%ebx\n\t" "movl 4(%7), %%ecx\n\t" -# else - "movl %8, %%ebx\n\t" -# endif -#endif - "lock; cmpxchg" ETHR_DW_CMPXCHG_SFX__ " %0\n\t" + "lock; cmpxchg8b %0\n\t" "setz %3\n\t" -#if ETHR_NO_CLOBBER_EBX__ "popl %%ebx\n\t" -#endif : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd) - : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), -#if ETHR_NO_CLOBBER_EBX__ -# if ETHR_CMPXCHG8B_REGISTER_SHORTAGE - "3"(new) -# else - "3"(new[1]), - "r"(new[0]) -# endif + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "r"(new) + : "cc", "memory"); + +#elif ETHR_NO_CLOBBER_EBX__ + /* + * gcc wont let us use ebx as input + */ + + __asm__ __volatile__( + "pushl %%ebx\n\t" + "movl %8, %%ebx\n\t" + "lock; cmpxchg8b %0\n\t" + "setz %3\n\t" + "popl %%ebx\n\t" + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "r"(new[0]) + : "cc", "memory"); + #else - "3"(new[1]), - "b"(new[0]) -#endif + /* + * gcc lets us place values in the registers where + * we want them + */ + + __asm__ __volatile__( + "lock; cmpxchg" ETHR_DW_CMPXCHG_SFX__ " %0\n\t" + "setz %3\n\t" + : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd) + : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "b"(new[0]) : "cc", "memory"); +#endif + return (int) xchgd; } -- cgit v1.2.3 From 3db7370a556d0dd064f005fd745bdbf50840eda1 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 5 Feb 2016 15:56:47 +0100 Subject: ssl: Remove DES ciphers from default configuration DES is not considered secure. Also correct 'Server Name Indication' support description. --- lib/ssl/doc/src/ssl_app.xml | 6 ++++-- lib/ssl/src/ssl_cipher.erl | 18 +++++++++++++++--- lib/ssl/src/ssl_v3.erl | 4 +--- lib/ssl/src/tls_v1.erl | 4 +--- lib/ssl/test/ssl_basic_SUITE.erl | 40 ++++++++++++++++++++++++++++++++++++---- lib/ssl/test/ssl_test_lib.erl | 4 ++++ 6 files changed, 61 insertions(+), 15 deletions(-) diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 6c82e32a74..d05ece3971 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -43,6 +43,8 @@ For security reasons SSL-2.0 is not supported. For security reasons SSL-3.0 is no longer supported by default, but can be configured. + For security reasons DES cipher suites are no longer supported by default, + but can be configured. Ephemeral Diffie-Hellman cipher suites are supported, but not Diffie Hellman Certificates cipher suites. Elliptic Curve cipher suites are supported if the Crypto @@ -55,8 +57,8 @@ motivated to implement them. CRL validation is supported. Policy certificate extensions are not supported. - 'Server Name Indication' extension client side - (RFC 6066, Section 3) is supported. + 'Server Name Indication' extension + (RFC 6066) is supported. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 8c2a16ba96..93a84933a2 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -37,7 +37,7 @@ cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1]). -export_type([cipher_suite/0, @@ -311,7 +311,8 @@ all_suites(Version) -> ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() - ++ rc4_suites(Version). + ++ rc4_suites(Version) + ++ des_suites(Version). %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -415,6 +416,16 @@ rc4_suites({3, N}) when N =< 3 -> ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. +%%-------------------------------------------------------------------- +-spec des_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the cipher suites +%% with DES cipher, only supported if explicitly set by user. +%% Are not considered secure any more. +%%-------------------------------------------------------------------- +des_suites(_)-> + [?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_RSA_WITH_DES_CBC_SHA]. %%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> int_cipher_suite(). @@ -1714,7 +1725,8 @@ dhe_rsa_suites() -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 + ]. psk_rsa_suites() -> [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl index f169059a75..f98ea83771 100644 --- a/lib/ssl/src/ssl_v3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -143,9 +143,7 @@ suites() -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA + ?TLS_RSA_WITH_AES_128_CBC_SHA ]. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 71e5f349dd..09e378cfeb 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -208,9 +208,7 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA + ?TLS_RSA_WITH_AES_128_CBC_SHA ]; suites(3) -> [ diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 05b040a2ab..fb48a33d38 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -182,6 +182,8 @@ cipher_tests() -> rc4_rsa_cipher_suites, rc4_ecdh_rsa_cipher_suites, rc4_ecdsa_cipher_suites, + des_rsa_cipher_suites, + des_ecdh_rsa_cipher_suites, default_reject_anonymous]. cipher_tests_ec() -> @@ -444,7 +446,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa,des_cbc,sha,no_export}]} | + [{ciphers,[{rsa, aes_128_cbc, sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -453,7 +455,7 @@ connection_info(Config) when is_list(Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa, des_cbc, sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -1950,6 +1952,23 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> Ciphers = ssl_test_lib:rc4_suites(NVersion), run_suites(Ciphers, Version, Config, rc4_ecdsa). +%%------------------------------------------------------------------- +des_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +des_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:des_suites(NVersion), + run_suites(Ciphers, Version, Config, des_rsa). +%------------------------------------------------------------------- +des_ecdh_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:des_suites(NVersion), + run_suites(Ciphers, Version, Config, des_dhe_rsa). + %%-------------------------------------------------------------------- default_reject_anonymous()-> [{doc,"Test that by default anonymous cipher suites are rejected "}]. @@ -2686,7 +2705,12 @@ defaults(Config) when is_list(Config)-> true = lists:member(sslv3, Available), false = lists:member(sslv3, Supported), false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()), - true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)). + true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)), + false = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites()), + true = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites(all)), + false = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites()), + true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)). + %%-------------------------------------------------------------------- reuseaddr() -> [{doc,"Test reuseaddr option"}]. @@ -3974,7 +3998,15 @@ run_suites(Ciphers, Version, Config, Type) -> rc4_ecdsa -> {?config(client_opts, Config), [{ciphers, Ciphers} | - ?config(server_ecdsa_opts, Config)]} + ?config(server_ecdsa_opts, Config)]}; + des_dhe_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_rsa_opts, Config)]}; + des_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_opts, Config)]} end, Result = lists:map(fun(Cipher) -> diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 77c29668b5..fc0c0e64d1 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -971,6 +971,10 @@ rc4_suites(Version) -> Suites = ssl_cipher:rc4_suites(Version), ssl_cipher:filter_suites(Suites). +des_suites(Version) -> + Suites = ssl_cipher:des_suites(Version), + ssl_cipher:filter_suites(Suites). + pem_to_der(File) -> {ok, PemBin} = file:read_file(File), public_key:pem_decode(PemBin). -- cgit v1.2.3 From 184a4d38db21cdc3011a5c906f38c880c1ffdc58 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 18 Feb 2016 19:44:24 +0100 Subject: erts: Fix lock checker for process locks Do lock order check *before* trying to seize lock... duh! --- erts/emulator/beam/erl_process_lock.h | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index a64c993e8f..9c59301086 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -523,6 +523,10 @@ erts_smp_proc_lock__(Process *p, ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCKS_ALL) == 0); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_lock(p, locks, file, line); +#endif + old_lflgs = erts_smp_proc_raw_trylock__(p, locks); if (old_lflgs != 0) { @@ -544,9 +548,6 @@ erts_smp_proc_lock__(Process *p, #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_proc_lock_post_x(&(p->lock), locks, file, line); #endif -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_proc_lc_lock(p, locks, file, line); -#endif #ifdef ERTS_PROC_LOCK_DEBUG erts_proc_lock_op_debug(p, locks, 1); -- cgit v1.2.3 From 47fae67ce44af1d6e65f59061bff9d799e8f86f5 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 18 Feb 2016 09:58:34 +0100 Subject: stdlib: Let beam_lib restore typed record forms Forms with record field types created before OTP 19.0 are replaced by well-formed record forms holding the type information. Tools reading the 'abstract_code' chunk can rely on the returned forms being well-formed, that is, there are no badly formed 'type' attribute forms. --- lib/stdlib/src/beam_lib.erl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 00cd1221fa..7a17226e46 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -904,7 +904,11 @@ anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> anno_from_term(T) -> T. -anno_from_forms(Forms) -> +anno_from_forms(Forms0) -> + %% Forms with record field types created before OTP 19.0 are + %% replaced by well-formed record forms holding the type + %% information. + Forms = epp:restore_typed_record_fields(Forms0), [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> -- cgit v1.2.3 From eca306d6d4e2ade65bd743f59526bc072dea1771 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 8 Dec 2015 18:12:08 +0000 Subject: Fix public_key documentation typos --- lib/public_key/doc/src/public_key.xml | 10 +++++----- lib/public_key/doc/src/public_key_records.xml | 6 +++--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 258e7cd1b9..16a7497a22 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -114,8 +114,8 @@ pem_entry () = -

{pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted

-

| cipher_info()}

 +

{pki_asn1_type(), binary(), %% DER or encrypted DER

+

not_encrypted | cipher_info()}

 cipher_info() =

{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)

@@ -786,13 +786,13 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, Decodes an SSH file-binary. SshBin = binary() - Example {ok, SshBin} = file:read_file("known_hosts"). + Example {ok, SshBin} = file:read_file("known_hosts"). Type = public_key | ssh_file() If Type is public_key the binary can be either an RFC4716 public key or an OpenSSH public key. -

Decodes an SSH file-binary. In the case of know_hosts or +

Decodes an SSH file-binary. In the case of known_hosts or auth_keys, the binary can include one or more lines of the file. Returns a list of public keys and their attributes, possible attribute values depends on the file type represented by the @@ -842,7 +842,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, Key = rsa_public_key() | dsa_public_key() | ec_public_key() -

Veryfies a digital signature.

+

Verifies a digital signature.

 diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index fb03da3150..d34f3ed9a3 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -57,9 +57,9 @@ time() = -

uct_time() | general_time()

 +

utc_time() | general_time()

 - uct_time() = + utc_time() =

{utcTime, "YYMMDDHHMMSSZ"}

 general_time() = @@ -144,7 +144,7 @@
DSA -

Erlang representation of Digigital Signature Algorithm (DSA) keys

+

Erlang representation of Digital Signature Algorithm (DSA) keys

#'DSAPrivateKey',{ version, % integer() -- cgit v1.2.3 From 88021d58ff1c5b92689b100d1288ef7d3185233f Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Mon, 1 Feb 2016 21:15:45 +0100 Subject: ssl: Include options form connect/listen/accept in connection_information/[1,2] Make sure that options only relevant for one role (client|server) is set to undefined when the other role is invoked. As there are many options to ssl, and many are optional, we choose to filter out all undefined options to avoid overwhelming the user with not relevant information. This way there is no need for any special handling of the role specific options which is also nice. --- lib/ssl/doc/src/ssl.xml | 57 +++++++------------ lib/ssl/src/ssl.erl | 104 ++++++++++++++++++++-------------- lib/ssl/src/ssl_cipher.erl | 11 ++++ lib/ssl/src/ssl_connection.erl | 38 ++++++++++++- lib/ssl/test/ssl_basic_SUITE.erl | 55 ++++++++++++++++-- lib/ssl/test/ssl_sni_SUITE.erl | 8 ++- lib/ssl/test/ssl_test_lib.erl | 4 +- lib/ssl/test/ssl_to_openssl_SUITE.erl | 8 ++- 8 files changed, 193 insertions(+), 92 deletions(-) diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index aaf03d1cd8..d3881ad117 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -144,7 +144,9 @@

According to old API.

ciphersuite() = -

{key_exchange(), cipher(), hash()}

 + +

{key_exchange(), cipher(), MAC::hash()} | + {key_exchange(), cipher(), MAC::hash(), PRF::hash()}

 key_exchange()=

rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk @@ -156,7 +158,7 @@ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm

 hash() = -

md5 | sha

 +

md5 | sha | sha224 | sha256 | sha348 | sha512

 prf_random() =

client_random | server_random

 @@ -754,20 +756,7 @@ fun(srp, Username :: string(), UserState :: term()) -> the following options set: [{active, false}, {packet, 0}, {mode, binary}]

- - - connection_info(SslSocket) -> - {ok, {ProtocolVersion, CipherSuite}} | {error, Reason} - Returns the Negotiated Protocol version and cipher suite. - - - CipherSuite = ciphersuite() - ProtocolVersion = protocol() - -

Returns the Negotiated Protocol version and cipher suite.

- - - + controlling_process(SslSocket, NewOwner) -> ok | {error, Reason} @@ -786,40 +775,36 @@ fun(srp, Username :: string(), UserState :: term()) -> connection_information(SslSocket) -> - {ok, Info} | {error, Reason} + {ok, Result} | {error, Reason} Returns all the connection information. - Info = [InfoTuple] - InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname} - CipherSuite = ciphersuite() - ProtocolVersion = protocol() - SNIHostname = string() + Item = protocol | cipher_suite | sni_hostname | atom() + Meaningful atoms, not specified above, are the ssl option names. + Result = [{Item::atom(), Value::term()}] Reason = term() -

Return all the connection information containing negotiated protocol version, cipher suite, and the hostname of SNI extension. - Info will be a proplists containing all the connection information on success, otherwise {error, Reason} will be returned.

+

Returns all relevant information about the connection, ssl options that + are undefined will be filtered out.

 connection_information(SslSocket, Items) -> - {ok, Info} | {error, Reason} + {ok, Result} | {error, Reason} Returns the requested connection information. - Items = [Item] - Item = protocol | cipher_suite | sni_hostname - Info = [InfoTuple] - InfoTuple = {protocol, Protocol} | {cipher_suite, CipherSuite} | {sni_hostname, SNIHostname} - CipherSuite = ciphersuite() - ProtocolVersion = protocol() - SNIHostname = string() + Items = [Item] + Item = protocol | cipher_suite | sni_hostname | atom() + Meaningful atoms, not specified above, are the ssl option names. + Result = [{Item::atom(), Value::term()}] Reason = term() -

Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. - {ok, Info} will be returned if it executes successfully. Info is a proplist containing the information you requested. - Otherwise, {error, Reason} will be returned.

+

Returns the requested information items about the connection, + if they are defined.

+

If only undefined options are requested the + resulting list can be empty.

 @@ -1146,7 +1131,7 @@ fun(srp, Username :: string(), UserState :: term()) -> listen/2, and ssl_accept/[1,2,3]. For the negotiated TLS/SSL version, see ssl:connection_info/1 + marker="#connection_information-1">ssl:connection_information/1 . available diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6551308935..c1bc90559e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -37,7 +37,7 @@ close/1, close/2, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2 ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, suite_definition/1, +-export([cipher_suites/0, cipher_suites/1, connection_info/1, versions/0, session_info/1, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1, connection_information/1, connection_information/2]). @@ -105,7 +105,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions0 ++ SocketValues) of + try handle_options(SslOptions0 ++ SocketValues, client) of {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}} -> @@ -127,7 +127,7 @@ connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> - try handle_options(Options) of + try handle_options(Options, client) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) catch @@ -145,7 +145,7 @@ listen(_Port, []) -> {error, nooptions}; listen(Port, Options0) -> try - {ok, Config} = handle_options(Options0), + {ok, Config} = handle_options(Options0, server), ConnectionCb = connection_cb(Options0), #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, ssl = SslOpts, emulated = EmOpts} = Config, @@ -233,7 +233,7 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), - try handle_options(SslOptions ++ SocketValues) of + try handle_options(SslOptions ++ SocketValues, server) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), {ok, Port} = ssl_socket:port(Transport, Socket), @@ -315,24 +315,32 @@ controlling_process(#sslsocket{pid = {Listen, %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- -connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:connection_information(Pid); -connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. - +connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> + case ssl_connection:connection_information(Pid) of + {ok, Info} -> + {ok, [Item || Item = {_Key, Value} <- Info, Value =/= undefined]}; + Error -> + Error + end; +connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}, [atom]) -> {ok, list()} | {error, reason()}. +-spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- connection_information(#sslsocket{} = SSLSocket, Items) -> case connection_information(SSLSocket) of - {ok, I} -> - {ok, lists:filter(fun({K, _}) -> lists:foldl(fun(K1, Acc) when K1 =:= K -> Acc + 1; (_, Acc) -> Acc end, 0, Items) > 0 end, I)}; - E -> - E + {ok, Info} -> + {ok, [Item || Item = {Key, Value} <- Info, lists:member(Key, Items), + Value =/= undefined]}; + Error -> + Error end. %%-------------------------------------------------------------------- +%% Deprecated -spec connection_info(#sslsocket{}) -> {ok, {tls_record:tls_atom_version(), ssl_cipher:erl_cipher_suite()}} | {error, reason()}. %% @@ -371,15 +379,6 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. -%%-------------------------------------------------------------------- --spec suite_definition(ssl_cipher:cipher_suite()) -> ssl_cipher:erl_cipher_suite(). -%% -%% Description: Return erlang cipher suite definition. -%%-------------------------------------------------------------------- -suite_definition(S) -> - {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), - {KeyExchange, Cipher, Hash}. - %%-------------------------------------------------------------------- -spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. %% @@ -410,7 +409,7 @@ negotiated_next_protocol(Socket) -> %%-------------------------------------------------------------------- cipher_suites(erlang) -> Version = tls_record:highest_protocol_version([]), - ssl_cipher:filter_suites([suite_definition(S) + ssl_cipher:filter_suites([ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:suites(Version)]); cipher_suites(openssl) -> Version = tls_record:highest_protocol_version([]), @@ -418,7 +417,7 @@ cipher_suites(openssl) -> || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]; cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), - ssl_cipher:filter_suites([suite_definition(S) + ssl_cipher:filter_suites([ssl_cipher:erl_suite_definition(S) || S <-ssl_cipher:all_suites(Version)]). cipher_suites() -> cipher_suites(erlang). @@ -630,7 +629,8 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, cacertfile = CaCertFile0} = InheritedSslOpts) -> RecordCB = record_cb(Protocol), CaCerts = handle_option(cacerts, Opts0, CaCerts0), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = handle_verify_options(Opts0, CaCerts), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, + VerifyClientOnce} = handle_verify_options(Opts0, CaCerts), CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of undefined -> CaCertDefault; @@ -643,11 +643,12 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, verify = Verify, verify_fun = VerifyFun, partial_chain = PartialChainHanlder, - fail_if_no_peer_cert = FailIfNoPeerCert}, + fail_if_no_peer_cert = FailIfNoPeerCert, + verify_client_once = VerifyClientOnce}, SslOpts1 = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts0, [cacerts, cacertfile, verify, verify_fun, partial_chain, - fail_if_no_peer_cert]), + fail_if_no_peer_cert, verify_client_once]), case handle_option(versions, SslOpts1, []) of [] -> new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); @@ -655,10 +656,10 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value], new_ssl_options(proplists:delete(versions, SslOpts1), NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol)) - end. + end; %% Handle all options in listen and connect -handle_options(Opts0) -> +handle_options(Opts0, Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), assert_proplist(Opts), @@ -667,7 +668,7 @@ handle_options(Opts0) -> ReuseSessionFun = fun(_, _, _, _) -> true end, CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, VerifyClientOnce} = handle_verify_options(Opts, CaCerts), CertFile = handle_option(certfile, Opts, <<>>), @@ -686,7 +687,7 @@ handle_options(Opts0) -> verify_fun = VerifyFun, partial_chain = PartialChainHanlder, fail_if_no_peer_cert = FailIfNoPeerCert, - verify_client_once = handle_option(verify_client_once, Opts, false), + verify_client_once = VerifyClientOnce, depth = handle_option(depth, Opts, 1), cert = handle_option(cert, Opts, undefined), certfile = CertFile, @@ -706,7 +707,9 @@ handle_options(Opts0) -> reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), - client_renegotiation = handle_option(client_renegotiation, Opts, true), + client_renegotiation = handle_option(client_renegotiation, Opts, + default_option_role(server, true, Role), + server, Role), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), @@ -723,10 +726,16 @@ handle_options(Opts0) -> server_name_indication = handle_option(server_name_indication, Opts, undefined), sni_hosts = handle_option(sni_hosts, Opts, []), sni_fun = handle_option(sni_fun, Opts, undefined), - honor_cipher_order = handle_option(honor_cipher_order, Opts, false), + honor_cipher_order = handle_option(honor_cipher_order, Opts, + default_option_role(server, false, Role), + server, Role), protocol = proplists:get_value(protocol, Opts, tls), padding_check = proplists:get_value(padding_check, Opts, true), - fallback = proplists:get_value(fallback, Opts, false), + fallback = handle_option(fallback, Opts, + proplists:get_value(fallback, Opts, + default_option_role(client, + false, Role)), + client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}) }, @@ -756,6 +765,13 @@ handle_options(Opts0) -> inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb }}. + + +handle_option(OptionName, Opts, Default, Role, Role) -> + handle_option(OptionName, Opts, Default); +handle_option(_, _, undefined = Value, _, _) -> + Value. + handle_option(sni_fun, Opts, Default) -> OptFun = validate_option(sni_fun, proplists:get_value(sni_fun, Opts, Default)), @@ -772,7 +788,6 @@ handle_option(OptionName, Opts, Default) -> validate_option(OptionName, proplists:get_value(OptionName, Opts, Default)). - validate_option(versions, Versions) -> validate_versions(Versions, Versions); validate_option(verify, Value) @@ -1216,7 +1231,8 @@ emulated_socket_options(InetValues, #socket_options{ new_ssl_options([], #ssl_options{} = Opts, _) -> Opts; new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> - new_ssl_options(Rest, Opts#ssl_options{verify_client_once = validate_option(verify_client_once, Value)}, RecordCB); + new_ssl_options(Rest, Opts#ssl_options{verify_client_once = + validate_option(verify_client_once, Value)}, RecordCB); new_ssl_options([{depth, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{depth = validate_option(depth, Value)}, RecordCB); new_ssl_options([{cert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> @@ -1295,29 +1311,35 @@ handle_verify_options(Opts, CaCerts) -> PartialChainHanlder = handle_option(partial_chain, Opts, fun(_) -> unknown_ca end), + VerifyClientOnce = handle_option(verify_client_once, Opts, false), + %% Handle 0, 1, 2 for backwards compatibility case proplists:get_value(verify, Opts, verify_none) of 0 -> {verify_none, false, ca_cert_default(verify_none, VerifyNoneFun, CaCerts), - VerifyNoneFun, PartialChainHanlder}; + VerifyNoneFun, PartialChainHanlder, VerifyClientOnce}; 1 -> {verify_peer, false, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; 2 -> {verify_peer, true, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; verify_none -> {verify_none, false, ca_cert_default(verify_none, VerifyNoneFun, CaCerts), - VerifyNoneFun, PartialChainHanlder}; + VerifyNoneFun, PartialChainHanlder, VerifyClientOnce}; verify_peer -> {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), - UserVerifyFun, PartialChainHanlder}; + UserVerifyFun, PartialChainHanlder, VerifyClientOnce}; Value -> throw({error, {options, {verify, Value}}}) end. +default_option_role(Role, Value, Role) -> + Value; +default_option_role(_,_,_) -> + undefined. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 8c2a16ba96..80c4e5fdcd 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,6 +34,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, + erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, @@ -721,6 +722,16 @@ suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> {dhe_rsa, chacha20_poly1305, null, sha256}. +%%-------------------------------------------------------------------- +-spec erl_suite_definition(ssl_cipher:cipher_suite()) -> ssl_cipher:erl_cipher_suite(). +%% +%% Description: Return erlang cipher suite definition. Filters last value +%% for now (compatibility reasons). +%%-------------------------------------------------------------------- +erl_suite_definition(S) -> + {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), + {KeyExchange, Cipher, Hash}. + %%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). %% diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 241871dc38..ec7d086934 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -836,15 +836,22 @@ handle_sync_event(session_info, _, StateName, #state{session = #session{session_id = Id, cipher_suite = Suite}} = State) -> {reply, [{session_id, Id}, - {cipher_suite, ssl:suite_definition(Suite)}], + {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], StateName, State, get_timeout(State)}; handle_sync_event(peer_certificate, _, StateName, #state{session = #session{peer_certificate = Cert}} = State) -> {reply, {ok, Cert}, StateName, State, get_timeout(State)}; -handle_sync_event(connection_information, _, StateName, #state{sni_hostname = SNIHostname, session = #session{cipher_suite = CipherSuite}, negotiated_version = Version} = State) -> - {reply, {ok, [{protocol, tls_record:protocol_version(Version)}, {cipher_suite, ssl:suite_definition(CipherSuite)}, {sni_hostname, SNIHostname}]}, StateName, State, get_timeout(State)}. +handle_sync_event(connection_information, _, StateName, State) -> + Info = connection_info(State), + {reply, {ok, Info}, StateName, State, get_timeout(State)}. +connection_info(#state{sni_hostname = SNIHostname, + session = #session{cipher_suite = CipherSuite}, + negotiated_version = Version, ssl_options = Opts}) -> + [{protocol, tls_record:protocol_version(Version)}, + {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, + {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, @@ -1885,3 +1892,28 @@ negotiated_hashsign(undefined, Alg, Version) -> negotiated_hashsign(HashSign = {_, _}, _, _) -> HashSign. +ssl_options_list(SslOptions) -> + Fileds = record_info(fields, ssl_options), + Values = tl(tuple_to_list(SslOptions)), + ssl_options_list(Fileds, Values, []). + +ssl_options_list([],[], Acc) -> + lists:reverse(Acc); +%% Skip internal options, only return user options +ssl_options_list([protocol | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([erl_dist | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([renegotiate_at | Keys], [_ | Values], Acc) -> + ssl_options_list(Keys, Values, Acc); +ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) -> + ssl_options_list(Keys, Values, + [{Key, lists:map( + fun(Suite) -> + ssl_cipher:erl_suite_definition(Suite) + end, Value)} + | Acc]); +ssl_options_list([Key | Keys], [Value | Values], Acc) -> + ssl_options_list(Keys, Values, [{Key, Value} | Acc]). + + diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 05b040a2ab..9be99afe48 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -121,6 +121,7 @@ options_tests() -> api_tests() -> [connection_info, + connection_information, peername, peercert, peercert_with_client_cert, @@ -460,6 +461,37 @@ connection_info(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- + +connection_information() -> + [{doc,"Test the API function ssl:connection_information/1"}]. +connection_information(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, connection_information_result, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, connection_information_result, []}}, + {options, ClientOpts}]), + + ct:log("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ServerMsg = ClientMsg = ok, + + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + %%-------------------------------------------------------------------- protocol_versions() -> [{doc,"Test to set a list of protocol versions in app environment."}]. @@ -3989,7 +4021,7 @@ run_suites(Ciphers, Version, Config, Type) -> end. erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl:suite_definition(ssl_cipher:openssl_suite(Suite)); + ssl_cipher:erl_suite_definition(ssl_cipher:openssl_suite(Suite)); erlang_cipher_suite(Suite) -> Suite. @@ -4010,11 +4042,11 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, - [{ciphers,[CipherSuite]} | - ClientOpts]}]), + {from, self()}, + {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, + {options, + [{ciphers,[CipherSuite]} | + ClientOpts]}]), Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok), @@ -4028,6 +4060,17 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> [{ErlangCipherSuite, Error}] end. +connection_information_result(Socket) -> + {ok, Info = [_ | _]} = ssl:connection_information(Socket), + case length(Info) > 3 of + true -> + %% Atleast one ssloption() is set + ct:log("Info ~p", [Info]), + ok; + false -> + ct:fail(no_ssl_options_returned) + end. + connection_info_result(Socket) -> {ok, Info} = ssl:connection_information(Socket, [protocol, cipher_suite]), {ok, {proplists:get_value(protocol, Info), proplists:get_value(cipher_suite, Info)}}. diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl index f6ffe91027..90c2a49e61 100644 --- a/lib/ssl/test/ssl_sni_SUITE.erl +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -108,8 +108,12 @@ ssl_recv(SSLSocket, CurrentData, ExpectedData) -> send_and_hostname(SSLSocket) -> ssl:send(SSLSocket, "OK"), - {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), - Hostname. + case ssl:connection_information(SSLSocket, [sni_hostname]) of + {ok, [{sni_hostname, Hostname}]} -> + Hostname; + {ok, []} -> + undefined + end. rdnPart([[#'AttributeTypeAndValue'{type=Type, value=Value} | _] | _], Type) -> Value; diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index afd21f0d2f..90fcd193cc 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -825,7 +825,7 @@ common_ciphers(crypto) -> common_ciphers(openssl) -> OpenSslSuites = string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), - [ssl:suite_definition(S) + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) ]. @@ -1224,7 +1224,7 @@ filter_suites(Ciphers0) -> ++ ssl_cipher:srp_suites() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), - Supported2 = [ssl:suite_definition(S) || S <- Supported1], + Supported2 = [ssl_cipher:erl_suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. -define(OPENSSL_QUIT, "Q\n"). diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index ecf6c4d6b8..6934d7f851 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1268,8 +1268,12 @@ client_check_result(Port, DataExpected) -> send_and_hostname(SSLSocket) -> ssl:send(SSLSocket, "OK"), - {ok, [{sni_hostname, Hostname}]} = ssl:connection_information(SSLSocket, [sni_hostname]), - Hostname. + case ssl:connection_information(SSLSocket, [sni_hostname]) of + {ok, []} -> + undefined; + {ok, [{sni_hostname, Hostname}]} -> + Hostname + end. erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), -- cgit v1.2.3 From e6b2edc8027c40db4c12f8f081648cda4634f9f7 Mon Sep 17 00:00:00 2001 From: tmanevik Date: Mon, 23 Nov 2015 18:27:25 +0100 Subject: Observer: Editorial changes in documentation --- lib/observer/doc/src/cdv.xml | 14 +- lib/observer/doc/src/crashdump.xml | 21 +- lib/observer/doc/src/crashdump_ug.xml | 437 +++++++------ lib/observer/doc/src/etop.xml | 137 ++-- lib/observer/doc/src/etop_ug.xml | 118 ++-- lib/observer/doc/src/introduction_ug.xml | 49 ++ lib/observer/doc/src/observer.xml | 23 +- lib/observer/doc/src/observer_app.xml | 20 +- lib/observer/doc/src/observer_ug.xml | 306 +++++---- lib/observer/doc/src/part.xml | 3 +- lib/observer/doc/src/ref_man.xml | 5 +- lib/observer/doc/src/ttb.xml | 515 ++++++++------- lib/observer/doc/src/ttb_ug.xml | 1032 ++++++++++++++++-------------- 13 files changed, 1455 insertions(+), 1225 deletions(-) create mode 100644 lib/observer/doc/src/introduction_ug.xml diff --git a/lib/observer/doc/src/cdv.xml b/lib/observer/doc/src/cdv.xml index ee629bbd3f..df1032780a 100644 --- a/lib/observer/doc/src/cdv.xml +++ b/lib/observer/doc/src/cdv.xml @@ -4,7 +4,7 @@
- 2013 + 20032016 Ericsson AB. All Rights Reserved. @@ -33,16 +33,16 @@ cdv.xml
cdv - Script used for starting the Crashdump Viewer from the + Script to start the Crashdump Viewer from the OS command line. -

The cdv shell script can be found under the priv - directory of the observer application. The script is used +

The cdv shell script is located in directory priv + of the Observer application. The script is used for starting the Crashdump Viewer tool from the OS command line.

-

For Windows users, cdv.bat can be found in the same +

For Windows users, cdv.bat is found in the same location.

 @@ -51,8 +51,8 @@ cdv [file] Start the Crashdump Viewer and load the given file. -

The file arguments is optional. If not given, a file - dialog will pop up allowing the user to select a crashdump +

Argument file is optional. If not specified, a file + dialog is displayed, allowing you to select a crashdump from the file system.

 diff --git a/lib/observer/doc/src/crashdump.xml b/lib/observer/doc/src/crashdump.xml index 76deee45f6..27e88d07e5 100644 --- a/lib/observer/doc/src/crashdump.xml +++ b/lib/observer/doc/src/crashdump.xml @@ -25,7 +25,7 @@ crashdump_viewer - Siri hansen + Siri Hansen 1 @@ -41,32 +41,31 @@

The Crashdump Viewer is a WxWidgets based tool for browsing Erlang crashdumps.

-

See the user's guide - for more information about how to get started with the Crashdump - Viewer.

+

For details about how to get started with the Crashdump Viewer, see the + User's Guide.

start() -> ok start(File) -> ok - Start the crashdump_viewer + Start the Crashdump Viewer. File = string() - The file name of the crashdump. + The filename of the crashdump. -

This function starts the crashdump_viewer GUI and - loads the given crashdump.

+

Starts the Crashdump Viewer GUI and + loads the specified crashdump.

-

If File is not given, a file dialog will be opened +

If File is not specified, a file dialog is opened where the crashdump can be selected.

 stop() -> ok - Stop the crashdump_viewer + Terminate the Crashdump Viewer. -

This function stops the crashdump_viewer and closes +

Terminates the Crashdump Viewer and closes all GUI windows.

 diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index 4bb3628ab5..4ba057c3fb 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -4,7 +4,7 @@
- 20032013 + 20032016 Ericsson AB. All Rights Reserved. @@ -39,371 +39,390 @@
Getting Started -

The easiest way to start Crashdump Viewer is to use the - provided shell script named cdv with the full path to the - erlang crashdump as an argument. The script can be found in the - priv directory of the observer application. This starts the - Crashdump Viewer GUI and loads the given file. If no file name is - given, a file dialog will be opened where the file can be +

The easiest way to start Crashdump Viewer is to use + shell script cdv with the full path to the + Erlang crashdump as argument. The script is located in + directory priv of the Observer application. This starts the + Crashdump Viewer GUI and loads the specified file. If no filename is + specified, a file dialog is opened where the file can be selected.

-

Under Windows the batch file cdv.bat can be used.

+

Under Windows, the batch file cdv.bat can be used.

-

It is also possible to start the Crashdump Viewer from within - an erlang node by calling Crashdump Viewer can also be started from + an Erlang node by calling crashdump_viewer:start/0 or crashdump_viewer:start/1.

- The graphical interface + GUI -

The main window is opened when Crashdump Viewer has loaded a - crashdump. It contains a title bar, a menu bar, a number of - information panels and a status bar.

+

The GUI main window is opened when Crashdump Viewer has loaded a + crashdump. It contains a title bar, a menu bar, + information tabs, and a status bar.

The title bar shows the name of the currently loaded crashdump.

The menu bar contains a File menu and a Help - menu. From the File menu a new crashdump can be loaded or the tool - can be terminated. From the Help menu this user's guide and the - chapter "How to interpret the Erlang crash dumps" from the user's - guide for Erlang runtime system can be opened. "How to interpret + menu. From the File menu, a new crashdump can be loaded or + the tool can be terminated. From the Help menu, this User's Guide + and section "How to interpret the Erlang crash dumps" from the + ERTS application can be opened. "How to interpret the Erlang crash dumps" describes the raw crashdumps in - detail. Here you will also find information about each single - field in the different information pages. This document can also - be found directly in the OTP online documentation, via the Erlang - runtime system user's guide.

+ detail and includes information about each + field in the information pages."How to interpret the Erlang crash dumps" + is also available in the OTP online documentation.

-

The status bar at the bottom of the window will show a warning +

The status bar at the bottom of the window shows a warning if the currently loaded dump is truncated.

-

The centre area of the main window contains the information - panels. Each panel displays information about a specific item or a - list of items. A panel is selected by clicking the title of the - tab.

+

The center area of the main window contains the information + tabs. Each tab displays information about a specific item or a + list of items. Select a tab by clicking the tab title.

-

From panels that display lists of items, for example the - Processes- or the Ports panel, a new window with further - information can be opened by double clicking a row or by right - clicking the row and selecting an item from the drop down +

From tabs displaying lists of items, for example, the + Processes tab or the Ports tab, a new window with + more information can be opened by double-clicking a row or by right- + clicking the row and selecting an item from the drop-down menu. The new window is called a detail window. Detail windows can - be opened for processes, ports, nodes and modules.

+ be opened for processes, ports, nodes, and modules.

-

The various information shown in a detail window might contain - links to processes or ports. Clicking one of these links will open +

The information shown in a detail window can contain + links to processes or ports. Clicking one of these links opens the detail window for the process or port in question. If the - process or port resided on a remote node, there will be no - information available. Clicking the link will then pop up a dialog - where you can choose whether to open the detail window for the - remote node or not. + process or port resides on a remote node, no + information is available. Clicking the link then displays a dialog + where you can choose to open the detail window for the + remote node.

-

Some of the panels contain a left hand menu where sub items of - the panel's information area can be selected. Click on one of the - rows, and the information will be displayed in the right hand +

Some tabs contain a left-hand menu where subitems of + the information area can be selected. Click one of the + rows, and the information is displayed in the right-hand information area.

- Data content - -

Each panel in the main window contains an information - page. If no information is found for an item, the page will be - empty. The reason for not finding any information about an item - can be that the dump is truncated, that it is a dump from an old - OTP release in which this item was not written or that the item - simply wasn't present in the system at the point of failure.

- -

If the dump was truncated, a warning is displayed in the - status bar of the main window.

- -

Even if some information about an item exists, there might be + Tab Content + +

Each tab in the main window contains an information + page. If no information is found for an item, the page is + empty. The reason for not finding information about an item + can be the following:

+ + It is a dump from an old OTP release in which this item was not written. + The item was not present in the system at the point of failure. + The dump is truncated. In this case, a warning is displayed in the + status bar of the main window. + + +

+ +

Even if some information about an item exists, there can be empty fields if the dump originates from an old OTP release.

-

The value "-1" in any field means "unknown", and in most +

The value -1 in any field means "unknown", and in most cases it means that the dump was truncated somewhere around this field.

-

The sections below describe some of the fields in the - different information panels. These are fields that do not exist +

The following sections describe some of the fields in the + information tabs. These are fields that do not exist in the raw crashdump, or in some way differ from the fields in - the raw crashdump. Details about other fields can be found in - the user's guide for the Erlang runtime system, in the chapter - "How to interpret the Erlang crash dumps". That chapter can also - be opened from the Help menu in the Crashdump Viewer's main - window, and there are also direct links from the specific - sections below to related information in "How to interpret the - Erlang crash dumps".

+ the raw crashdump. For details about other fields, see + the + ERTS User's Guide, section + "How to interpret the Erlang crash dumps". That section can also + be opened from the Help menu in the main window. + There are also links from the following sections to related information + in "How to interpret the Erlang crash dumps".

- General information + General Tab -

The General information panel shows a short overview +

Tab General shows a short overview of the dump.

-

The following fields are not described in the Erlang runtime - system user's guide:

+

The following fields are not described in the ERTS + User's Guide:

- Crashdump created on - Time of failure. - - Memory allocated - The total number of bytes allocated, equivalent to - c:memory(total). - - Memory maximum - The maximum number of bytes that has been allocated during - the lifetime of the originating node. This will only be shown if - the Erlang runtime system was run instrumented. - - Atoms - If available in the dump, this is the total number of - atoms in the atom table. If the size of the atom table is not - available, the number of atoms visible in the dump is - presented. - - Processes, ETS tables and Funs - The number of processes, ETS tables and funs visible in - the dump. + Crashdump created on +

Time of failure.

 + + Memory allocated +

The total number of bytes allocated, equivalent to + c:memory(total).

 + + Memory maximum +

The maximum number of bytes that has been allocated during + the lifetime of the originating node. This is only shown if + the Erlang runtime system is run instrumented.

 + + Atoms +

If available in the dump, this is the total number of + atoms in the atom table. If the size of the atom table is + unavailable, the number of atoms visible in the dump is + displayed.

 + + Processes +

The number of processes visible in the dump.

 + + ETS tables +

The number of ETS tables visible in the dump.

 + + Funs +

The number of funs visible in the dump.

 -

- More... +

For details, see + General Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Processes + Processes Tab -

The Processes panel shows a list of all processes - found in the crashdump, including some short information about - each process. By default the processes are sorted by their - pids. To sort by other topic, click the desired column - heading.

+

Tab Processes shows a list of all processes + found in the crashdump, including brief information about + each process. By default, the processes are sorted by their + pids. To sort by another topic, click the desired column heading.

-

The Memory column shows the 'Memory' field which was - added to crashdumps in R16B01. This is the total amount of memory +

Column Memory shows the 'Memory' field that was + added to crashdumps in Erlang/OTP R16B01. This is the total amount of memory used by the process. For crashdumps from earlier releases, this - column shows the 'Stack+heap' field. The value shown is always in - bytes.

+ column shows the 'Stack+heap' field. The value is always in bytes.

-

To view detailed information about a specific process, double - click the row in the list or right click the row and select - "Properties for <pid>".

+

To view detailed information about a specific process, double- + click the row in the list, or right-click the row and select + Properties for <pid>.

-

- More... +

For details, see + Process Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Ports + Ports Tab -

The Ports panel is similar to the Processes - panel, except it lists all ports found in the crashdump.

+

Tab Ports is similar to the Processes + tab, except it lists all ports found in the crashdump.

-

To see more details about a specific port, dobule click the row - or right click it and select "Properties for <port>". From - the right click menu you can also select "Properties for - <pid>", where <pid> is the process connected to the +

To view more details about a specific port, double-click the row + or right-click it and select Properties for <port>. From + the right-click menu, you can also select Properties for + <pid>, where <pid> is the process connected to the port.

-

- - More... +

For details, see + Port Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- ETS tables + ETS Tables Tab -

The ETS Tables panel shows all ETS table information - found in the dump. The 'Id' is the same as the 'Table' field found - in the raw crashdump, and 'Memory' is the 'Words' field from the - raw crashdump translated into bytes. For tree tables there will - be no value in the 'Objects' field.

+

Tab ETS Tables shows all ETS table information + found in the dump. Id is the same as the 'Table' field + in the raw crashdump. Memory is the 'Words' field from the + raw crashdump translated into bytes. For tree tables, there is + no value in the 'Objects' field.

-

To open the detailed information page about the table, double - click or right click the row and select "Properties for - 'Identifier'".

+

To open the detailed information page about the table, double- + click, or right-click the row and select Properties for + 'Identifier'.

To open the detailed information page about the owner process - of an ETS table, right click the row and select "Properties for - <pid>".

+ of an ETS table, right-click the row and select Properties for + <pid>.

-

- - More... +

For details, see + ETS Tables + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Timers + Timers Tab -

The Timers panel shows all timer information found in +

Tab Timers shows all timer information found in the dump.

To open the detailed information page about the owner process - of a timer, right click the row and select "Properties for - <pid>".

+ of a timer, right-click the row and select Properties for + <pid>.

-

Double clicking a row in the Timers panel has no effect.

+

Double-clicking a row in the Timers tab has no effect.

-

- More... +

For details, see + Timers + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Schedulers + Schedulers Tab -

The Schedulers panel shows all scheduler information +

Tab Schedulers shows all scheduler information found in the dump.

To open the detailed information page about the scheduler, - double click or right click the row and select "Properties for - 'Identifier'".

+ double-click, or right-click the row and select Properties for + 'Identifier'.

-

- More... +

For details, see + Scheduler Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Funs + Funs Tab -

The Funs panel shows all Fun information found in the +

Tab Funs shows all fun information found in the dump.

To open the detailed information page about the module to which - the fun belongs, right click the row and select "Properties for - <mod>".

+ the fun belongs, right-click the row and select Properties for + <mod>.

-

Double clicking a row in the Funs panel has no effect.

+

Double-clicking a row in the Funs tab has no effect.

-

- More... +

For details, see + Fun Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Atoms + Atoms Tab -

The Atoms panel lists all atoms found in the dump. By +

Tab Atoms lists all atoms found in the dump. By default the atoms are sorted in creation order from first to last. This is opposite of the raw crashdump where atoms are listed from last to first, meaning that if the dump was truncated in the - middle of the atom list only the last created atoms will be seen - in the Atoms panel.

+ middle of the atom list, only the last created atoms are visible + in the Atoms tab.

-

- More... +

For details, see + Atoms + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Nodes + Nodes Tab -

The Nodes panel shows a list of all external erlang - nodes which are referenced from the crashdump.

+

Tab Nodes shows a list of all external Erlang + nodes that are referenced from the crashdump.

-

If the page is empty it either means that the crashed node was - not distributed, that it was distributed but had no references to - other nodes or that the dump was truncated.

+

If the page is empty, it means either of the following:

+ + The crashed node is not distributed. + The crashed node is distributed but has no references to other nodes. + The dump is truncated. + -

If the node was distributed, all referenced nodes are - shown. The column named Connection type shows if the node - is visible, hidden or not connected. Visible nodes are alive nodes +

If the node is distributed, all referenced nodes are + visible. Column Connection type shows if the node + is visible, hidden, or not connected. Visible nodes are alive nodes with a living connection to the originating node. Hidden nodes are - the same as visible nodes, except they are started with the - -hidden flag. Not connected nodes are nodes that are not + the same as visible nodes, except they are started with flag + -hidden. Not connected nodes are nodes that are not connected to the originating node anymore, but references - (i.e. process or port identifiers) exist.

+ (that is, process or port identifiers) exist.

-

To see more detailed information about a node, double click the - row or right click the row and select "Properties for node - <node>". From the right click menu you can also select - "Properties for <port>", to open the detailed information +

To see more detailed information about a node, double-click the + row, or right-click the row and select Properties for node + <node>. From the right-click menu, you can also select + Properties for <port>, to open the detailed information window for the controlling port.

-

In the detailed information window for a node, any exsisting +

In the detailed information window for a node, any existing links and monitors between processes on the originating node and - the connected node are shown. Extra Info may contain - debug information (i.e. special information written if the - emulator is debug compiled) or error information.

+ the connected node are displayed. Extra Info can contain + debug information (that is, special information written if the + emulator is debug-compiled) or error information.

-

- - More... +

For details, see + Distribution Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Loaded modules + Modules Tab -

The Modules panel lists all modules that were loaded - on the originating node, and the current size of the code. If old - code exsits, the old size is also shown.

+

Tab Modules lists all modules loaded + on the originating node, and the current code size. If old + code exists, the old size is also shown.

-

To see detailed information about a specific module, double - click the row or right click it and select "Properties for - <mod>".

+

To view detailed information about a specific module, double- + click the row, or right-click it and select Properties for + <mod>.

-

- - More... +

For details, see + Loaded Module Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

- Memory - -

The Memory panel shows memory and allocator - information. From the left hand menu you can select:

+ Memory Tab - +

Tab Memory shows memory and allocator + information. From the left-hand menu you can select the following:

- Memory More... + + Memory +

See + Memory Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

 - Allocator Summary - this page presents a - summary of values from all allocators below. + Allocator Summary +

This page presents a summary of values from all allocators underneath it.

 - <Allocator> - one entry per allocator - More... + <Allocator> +

One entry per allocator. See + Allocator + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

 - Allocated Areas More... + Allocated Areas +

See + Allocated Areas + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

 - +
- Internal tables + Internal Tables Tab -

On the Internal Tables panel you can choose from the - left hand menu to see hash tables or index tables.

+

On tab Internal Tables you can from the + left-hand menu select Hash Tables, Index Tables, + or Internal ETS Tables.

-

- More... +

For details, see + Internal Table Information + in section "How to Interpret the Erlang Crash Dumps" in ERTS.

diff --git a/lib/observer/doc/src/etop.xml b/lib/observer/doc/src/etop.xml index c1e336177f..52f3b2a156 100644 --- a/lib/observer/doc/src/etop.xml +++ b/lib/observer/doc/src/etop.xml @@ -25,7 +25,7 @@ etop - Siri hansen + Siri Hansen @@ -35,89 +35,79 @@
etop - Erlang Top is a tool for presenting information about erlang processes similar to the information presented by "top" in UNIX. + Erlang Top is a tool for presenting information about Erlang + processes similar to the information presented by "top" in UNIX. -

etop should be started with the provided scripts - etop. This will start a hidden erlang node - which connects to the node to be measured. The measured node is - given with the -node option. If the measured node has a +

Start Erlang Top with the provided scripts + etop. This starts a hidden Erlang node + that connects to the node to be measured. The measured node is + specified with option -node. If the measured node has a different cookie than the default cookie for the user who - invokes the script, the cookie must be explicitly given witht - the -setcookie option.

+ invokes the script, the cookie must be explicitly specified with + option -setcookie.

-

Under Windows the batch file etop.bat can be used.

+

Under Windows, batch file etop.bat can be used.

-

The following configuration parameters exist for the - etop tool. When executing the etop script, - these parameters can be given as command line options, - e.g. etop -node testnode@myhost -setcookie MyCookie.

+

When executing the etop script, configuration + parameters can be specified as command-line options, + for example, etop -node testnode@myhost -setcookie MyCookie. + The following configuration parameters exist for the + tool:

- node - The measured node. -

-Value: atom() -

-Mandatory - setcookie - Cookie to use for the etop node - must be the same - as the cookie on the measured node. -

-Value: atom() - lines - Number of lines (processes) to display. -

-Value: integer() -

-Default: 10 - interval - The time interval (in seconds) between each update of - the display. -

-Value: integer() -

-Default: 5 - accumulate - If true the execution time and reductions are - accumulated. -

-Value: boolean() -

-Default: false - sort - Identifies what information to sort by. -

-Value: runtime | reductions | memory | msg_q

-Default: runtime (reductions if - tracing=off) - tracing - etop uses the erlang trace facility, and thus no + node +

The measured node.

+

Value: atom()

+

Mandatory

 + setcookie +

Cookie to use for the etop node. Must be same as the + cookie on the measured node.

+

Value: atom()

 + lines +

Number of lines (processes) to display.

+

Value: integer()

+

Default: 10

 + interval +

Time interval (in seconds) between each update of + the display.

+

Value: integer()

+

Default: 5

 + accumulate +

If true, the execution time and reductions are + accumulated.

+

Value: boolean()

+

Default: false

 + sort +

Identifies what information to sort by.

+

Value: runtime | reductions | memory | msg_q

+

Default: runtime (reductions if tracing=off)

 + tracing +

etop uses the Erlang trace facility, and thus no other tracing is possible on the measured node while etop is running, unless this option is set to off. Also helpful if the etop tracing causes too high load on the measured node. With tracing off, runtime is - not measured. -

-Value: on | off

-Default: on + not measured.

+

Value: on | off

+

Default: on

 -

See the user's guide for - more information about the etop tool.

+

For detalis about Erlang Top, see the + User's Guide.

 start() -> ok - Start etop + Start etop. -

This function starts etop. - Note that etop is preferably started with the etop script.

+

Starts etop. + Notice that etop is preferably started with the etop script.

 start(Options) -> ok - Start etop + Start etop. Options = [Option] Option = {Key, Value} @@ -125,31 +115,30 @@ Default: on Value = term() -

This function starts etop. Use - help/0 to see a - description of the possible options.

+

Starts etop. To view the possible options, use + help/0.

 help() -> ok - Print etop's help + Display the etop help. -

This function prints the help of etop and +

Displays the help of etop and its options.

 config(Key,Value) -> Result - Change tool's configuration + Change the configuration of the tool. Result = ok | {error,Reason} Key = lines | interval | accumulate | sort Value = term() -

This function is used to change the tool's configuration - parameters during runtime. The table above indicates the - allowed values for each parameter.

+

Changes the configuration parameters of the tool during runtime. + Allowed parameters are lines, interval, accumulate, + and sort.

 @@ -160,14 +149,14 @@ Default: on File = string() -

This function dumps the current display to a text file.

+

Dumps the current display to a text file.

 stop() -> stop - Terminate etop + Terminate etop. -

This function terminates etop.

+

Terminates etop.

 diff --git a/lib/observer/doc/src/etop_ug.xml b/lib/observer/doc/src/etop_ug.xml index 7059f689d3..d663b089c2 100644 --- a/lib/observer/doc/src/etop_ug.xml +++ b/lib/observer/doc/src/etop_ug.xml @@ -4,7 +4,7 @@
- 20022013 + 20022016 Ericsson AB. All Rights Reserved. @@ -32,15 +32,25 @@
Introduction -

Erlang Top, etop is a tool for presenting information - about erlang processes similar to the information presented by +

Erlang Top, etop, is a tool for presenting information + about Erlang processes similar to the information presented by top in UNIX.

+
+ Getting Started +

Start Erlang Top in either of the following ways:

+ + Use script etop. + Use batch file etop.bat, for example, + etop -node tiger@durin. + +
+
Output -

The output from etop looks like this:

+

The output from Erlang Top is as follows:

The header includes some system information:

- Load - cpu is Runtime/Wallclock, i.e. the - percentage of time where the node has been - active, procs is the number of processes on the node, - and runq is the number of processes that are ready to - run. - Memory - This is the memory allocated by the node in kilo bytes. + Load + + + cpu +

Runtime/Wallclock, that is, the percentage of time + where the node has been active.

 + procs +

The number of processes on the node.

 + runq +

The number of processes that are ready to run.

 + + + Memory +

The memory allocated by the node in kilobytes.

For each process the following information is presented:

- Time - This is the runtime for the process, i.e. the actual - time the process has been scheduled in. - Reds - This is the number of reductions that has been executed - on the process - Memory - This is the size of the process in bytes, obtained by a - call to process_info(Pid,memory). - MsgQ - This is the length of the message queue for the process. + Time +

The runtime for the process, that is, the time that the process + has been scheduled in.

 + Reds +

The number of reductions executed on the process.

 + Memory +

The size of the process in bytes, obtained by a + call to process_info(Pid,memory).

 + MsgQ +

The length of the message queue for the process.

Time and Reds can be presented as - accumulated values or as values since last update.

+ accumulated values or as values since the last update.
-
- Start -

To start etop use the script - etop or the batch file etop.bat, e.g. etop -node tiger@durin, -

-
- -
+
Configuration

All configuration parameters can be set at start by adding - -OptName Value to the command line, e.g. etop -node tiger@durin -setcookie mycookie -lines 15. -

-

The parameters lines, interval, accumulate - and sort can be changed during runtime by the - function etop:config/2. -

-

A list of all valid configuration parameters can be found in - the reference manual for etop. + -OptName Value to the command line, for example:

+ 
+% etop -node tiger@durin -setcookie mycookie -lines 15
+ +

A list of all valid Erlang Top configuration parameters is available in + module etop.

-
- Example: Change configuration with text based presentation - The parameters lines, interval, accumulate, + and sort can be changed during runtime with function + etop:config/2. +

+

Example:

+

Change configuration parameter lines with text-based presentation. + Before the change, 10 lines are presented as follows:

+ ddll_server 0 582 3744 0 gen_server:loop/6 <127.5.0> application_controll 0 569 6756 0 gen_server:loop/6 ======================================================================================== ]]> -

etop:config(lines,5).

-ok

+

Function etop:config/2 is called to change the number of showed + lines to 5:

+ + 
+> etop:config(lines,5).
+ok
+ +

After the change, 5 lines are presented as follows:

======================================================================================== @@ -156,19 +173,20 @@ Pid Name or Initial Func Time Reds Memory MsgQ Current Func <127.43.0> ddll_server 0 0 3744 0 gen_server:loop/6 ======================================================================================== ]]> -
- Print to file -

At any time, the current etop display can be dumped to a - text file with the function etop:dump/1. + Print to File +

At any time, the current Erlang Top display can be dumped to a + text file with function + etop:dump/1.

Stop -

Use the function etop:stop/0 to stop etop. +

To stop Erlang Top, use function + etop:stop/0.

diff --git a/lib/observer/doc/src/introduction_ug.xml b/lib/observer/doc/src/introduction_ug.xml new file mode 100644 index 0000000000..21f0dc709f --- /dev/null +++ b/lib/observer/doc/src/introduction_ug.xml @@ -0,0 +1,49 @@ + + + + +
+ + 20162016 + Ericsson AB. All Rights Reserved. + + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + + + Introduction + + + + + introduction_ug.xml +
+
+ Scope +

The Observer application is a container including the following + tools for tracing and investigation of distributed systems:

+ + Observer + Trace Tool Builder + Erlang Top + Crashdump Viewer + +
+ +
+ Prerequisites +

It is assumed that the reader is familiar with the Erlang + programming language.

+
+ diff --git a/lib/observer/doc/src/observer.xml b/lib/observer/doc/src/observer.xml index bba5b1e33c..4d43ffe39f 100644 --- a/lib/observer/doc/src/observer.xml +++ b/lib/observer/doc/src/observer.xml @@ -4,7 +4,7 @@
- 20112013 + 20112016 Ericsson AB, All Rights Reserved @@ -34,24 +34,25 @@ observer.xml
observer - A GUI tool for observing an erlang system. + A GUI tool for observing an Erlang system. -

The observer is gui frontend containing various tools to - inspect a system. It displays system information, application - structures, process information, ets or mnesia tables and a frontend - for tracing with ttb. +

Observer is a graphical tool for observing the characteristics of + Erlang systems. The tool Observer displays system information, application + supervisor trees, process information, ETS tables, Mnesia tables, + and contains a front end for Erlang tracing with module + ttb.

-

See the user's guide - for more information about how to get started.

+

For detalis about how to get started, see the + User's Guide.

 start() -> ok - Start the observer gui + Start the Observer GUI. -

This function starts the observer gui. - Close the window to stop the application. +

Starts the Observer GUI. + To stop the tool, close the window.

diff --git a/lib/observer/doc/src/observer_app.xml b/lib/observer/doc/src/observer_app.xml index 543216cee9..a52d6cb4d9 100644 --- a/lib/observer/doc/src/observer_app.xml +++ b/lib/observer/doc/src/observer_app.xml @@ -4,8 +4,7 @@
- 2002 - 2013 + 20022016 Ericsson AB, All Rights Reserved @@ -24,7 +23,7 @@ The Initial Developer of the Original Code is Ericsson AB. - observer + Observer Siri Hansen Siri Hansen @@ -32,26 +31,21 @@ 2002-04-08 PA1 - observer_app.sgml + observer_app.xml
- observer + Observer The Observer Application -

This chapter describes the OBSERVER application in - OTP, which provides tools for tracing and investigation of - distributed systems.

+

The Observer application contains tools for tracing and + investigation of distributed systems.
Configuration -

There are currently no configuration parameters available for +

No configuration parameters are available for this application.

-
- SEE ALSO -

-
diff --git a/lib/observer/doc/src/observer_ug.xml b/lib/observer/doc/src/observer_ug.xml index ff30d70913..ca354df864 100644 --- a/lib/observer/doc/src/observer_ug.xml +++ b/lib/observer/doc/src/observer_ug.xml @@ -4,7 +4,7 @@
- 20112014 + 20112016 Ericsson AB. All Rights Reserved. @@ -32,179 +32,253 @@
Introduction -

Observer, is a graphical tool for observing the characteristics of - erlang systems. Observer displays system information, application - supervisor trees, process information, ets or mnesia tables and contains - a frontend for erlang tracing. +

Observer is a graphical tool for observing the characteristics of + Erlang systems. Observer displays system information, application + supervisor trees, process information, ETS tables, Mnesia tables + and contains a front end for Erlang tracing.

- General -

Normally observer should be run from a standalone node to minimize - the impact of the system being observed. Example: + Getting Started +

Run Observer from a standalone node to minimize the impact of the + system being observed.

- - > erl -sname observer -hidden -setcookie MyCookie -run observer - +

Example:

+ 
+% erl -sname observer -hidden -setcookie MyCookie -run observer

- Choose which node to observe via Nodes menu. The View/Refresh - Interval controls how frequent the view should be updated. + Select the node to observe with menu Nodes. + Menu View > Refresh interval controls how often + the view is to be updated. The refresh interval is set per viewer so you can have different settings for each viewer. To minimize the system - impact only the active viewer is updated and the other - views will be updated when activated. + impact, only the active viewer is updated. Other views are updated + when activated.

-

In general the mouse buttons behaves as expected, use left click - to select objects, right click to pop up a menu with most used - choices and double click to bring up information about the - selected object. In most viewers with several columns you can change - sort order by left clicking on column header. +

The mouse buttons behave as expected. Use left-click + to select objects, right-click to get a menu with the most used + options, and double-click to display information about the + selected object. In most viewers with many columns, you can change + the sort order by left-clicking the column header.

- Applications -

The Applications view lists application information. + System Tab +

Tab System displays general information about the active Erlang node + and its runtime system, such as build configuration, system capabilities, and + overall use statistics. +

+
+ +
+ Load Charts Tab +

Tab Load Charts displays graphs of the current resource use on + the active Erlang node.

+

Graph Scheduler Utilization shows scheduler use per scheduler, + where each scheduler use has a unique color.

+

Graph Memory Usage shows the total memory use and per memory category + use, where each category has a unique color. The categories are as + follows:

+ + Total +

The sum of all memory categories.

 + Processes +

The sum of all process memory used.

 + Atom +

The size used by the atom table.

 + Binary +

The sum of all off-heap binaries allocated.

 + Code +

The memory allocated for code storage.

 + Ets +

The used memory for all ETS tables.

 + + +

Graph IO Usage shows the current I/O load on the system.

+
+ +
+ Memory Allocators Tab +

Tab Memory Allocators displays detailed information of the carrier + size and current memory carriers. For details about memory carriers, + see module + erts_alloc + in application ERTS.

+
+ +
+ Applications Tab +

Tab Applications presents application information. Select an application in the left list to display its supervisor - tree. -

-

Trace process will add the selected process identifier - to Trace Overview view and the node the process resides on - will be added as well. -

-

Trace named process will add the - registered name of the process. This can be useful when tracing on - several nodes, then processes with that name will be traced on all traced - nodes. -

-

Trace process tree and Trace named process - tree will add the selected process and all processes below, - right of, it to the Trace Overview view. + tree. The right-click options in the tree are as follows:

+ + Process info +

Opens a detailed information window on the selected process, + including the following:

+ + Process Information +

Shows the process information.

 + Messages +

Shows the process messages.

 + Dictionary +

Shows the process dictionary.

 + Stack Trace +

Shows the process current stack trace.

 + State +

Shows the process state.

 + Log +

If enabled and available, shows the process SASL + log entries.

 + + + Trace process +

Adds the selected process identifier to tab Trace Overview + plus the node that the process resides on.

 + Trace named process +

Adds the registered name of the process. This can be useful when tracing on + many nodes, as processes with that name are then traced on all traced nodes.

 + Trace process tree +

Adds the selected process and all processes below, + right of it, to tab Trace Overview.

 + Trace named process tree +

Adds the selected process and all processes below, + right of it, to tab Trace Overview.

 +
- Processes -

The Processes view lists process information. - For each process the following information is presented: + Processes Tab +

Tab Processes lists process information in columns. + For each process the following information is displayed:

Pid - The process identifier. +

The process identifier.

 Reds - This is the number of reductions that has been executed - on the process +

The number of reductions executed on the process. + This can be presented as accumulated values or as values since the last update.

 Memory - This is the size of the process in bytes, obtained by a - call to process_info(Pid,memory). +

The size of the process, in bytes, obtained by a + call to process_info(Pid,memory).

 MsgQ - This is the length of the message queue for the process. +

The length of the message queue for the process.

 - -

Reds can be presented as accumulated values or as values since last update.

- -

Process info open a detailed information window on the selected process.

+ +

Option Process info opens a detailed information window on the selected process, + including the following:

Process Information - Shows the process information. +

Shows the process information.

 Messages - Shows the process messages. +

Shows the process messages.

 Dictionary - Shows the process dictionary. +

Shows the process dictionary.

 Stack Trace - Shows the process current stack trace. +

Shows the process current stack trace.

 State - Show the process state. +

Shows the process state.

 Log - If enabled and available, show the process SASL log entries. +

If enabled and available, shows the process SASL log entries.

 + -

Log needs SASL application to be started on the observed node, with log_mf_h as log handler. - The Observed node must be R16B02 or higher. - rb server must not be started on the observed node when clicking on menu 'Log/Toggle log view'. - rb server will be stopped on the observed node when exiting or changing observed node. +

Log requires application SASL to be started on the observed node, + with log_mf_h as log handler. + The Observed node must be Erlang/OTP R16B02 or higher. + The rb server must not be started on the observed node when clicking menu + Log > Toggle log view. The rb server is stopped on the observed node + when exiting or changing the observed node.

-

Trace Processes will add the selected process identifiers to the Trace Overview view and the - node the processes reside on will be added as well. - Trace Named Processes will add the registered name of processes. This can be useful - when tracing is done on several nodes, then processes with that name will be traced on all traced nodes. + +

Option Trace Processes adds the selected process identifiers to tab + Trace Overview plus the node that the processes reside on.

+

Option Trace Named Processes adds the registered name of the processes. This can be + useful when tracing is done on many nodes, as processes with that name are then traced on + all traced nodes.

+
- Table Viewer -

The Table Viewer view lists tables. By default ets tables - are visible and unreadable, private ets, tables and tables created by the OTP - applications are not visible. Use View menu to view "system" - ets tables, unreadable ets tables or mnesia tables. + Table Viewer Tab +

Tab Table Viewer lists tables. By default, ETS tables + are displayed whereas unreadable private ETS tables and tables created by OTP + applications are not diplayed. Use menu View to view "system" + ETS tables, unreadable ETS tables, or Mnesia tables.

-

Double click to view the content of the table. Select table and activate View/Table Information - menu to view table information. -

-

In the table viewer you can regexp search for objects, edit and delete objects. +

Double-click to view the table content. To view table information, select the table + and activate menu View > Table information.

+

You can use regular + expressions and search for objects, and edit or delete them.

- Trace Overview -

The Trace Overview view handles tracing. Tracing is done - by selecting which processes to be traced and how to trace - them. You can trace messages, function calls and events, where - events are process related events such as spawn, - exit and several others. -

- -

When you want to trace function calls, you also need to setup - trace patterns. Trace patterns selects the function calls - that will be traced. The number of traced function calls can be - further reduced with match specifications. Match - specifications can also be used to trigger additional information + Trace Overview Tab +

Tab Trace Overview handles tracing. Trace + by selecting the processes to be traced and how to trace + them. You can trace messages, function calls, and events, where + events are process-related events such as spawn, + exit, and many others. +

+ +

To trace function calls, you also need to set up + trace patterns. Trace patterns select the function calls + to be traced. The number of traced function calls can be + further reduced with match specifications. Match + specifications can also be used to trigger more information in the trace messages.

-

Trace patterns only applies to the traced processes.

 +

Trace patterns only apply to the traced processes.

- Processes are added from the Applications or Processes views. - A special new identifier, meaning all processes spawned after trace start, - can be added with the Add 'new' Process button. + Processes are added from the Applications or Processes tabs. + A special new identifier, meaning all processes spawned after trace + start, can be added with button Add 'new' Process.

- When adding processes, a window with trace options will pop up. The chosen options will - be set for the selected processes. - Process options can be changed by right clicking on a process. + When adding processes, a window with trace options is displayed. The chosen + options are set for the selected processes. + Process options can be changed by right-clicking a process.

- Processes added by process identifiers will add the nodes these - processes resides on in the node list. Additional nodes can be added by the Add - Nodes button. + Processes added by process identifiers add the nodes these + processes reside on in the node list. More nodes can be added by clicking + button Add Nodes.

- If function calls are traced, trace patterns must be added by Add Trace Pattern button. - Select a module, function(s) and a match specification. - If no functions are selected, all functions in the module will be traced. + If function calls are traced, trace patterns must be added by clicking button + Add Trace Pattern. Select a module, function(s), and a match specification. + If no functions are selected, all functions in the module are traced. A few basic match specifications are provided in the tool, and you can provide your own match specifications. The syntax of match - specifications are described in the ERTS User's Guide. To simplify - the writing of a match specification they can also be written as - fun/1 see ms_transform manual page for - further information. -

- -

Use the Start trace button to start the trace. - By default trace output is written to a new window, tracing is stopped when the - window is closed, or with Stop Trace button. - Trace output can be changed via Options/Output menu. - The trace settings, including match specifications, can be saved to, or loaded from, a file. -

-

More information about tracing can be found in dbg and in the chapter "Match - specifications in Erlang" in ERTS User's - Guide and the - ms_transform manual page. + specifications is described in the ERTS User's Guide. To simplify + the writing of a match specification, they can also be written as + fun/1. For details, see module + ms_transform + in application STDLIB. +

+ +

Click button Start Trace to start the trace. + By default, trace output is written to a new window. Tracing is stopped + when the window is closed, or when clicking button Stop Trace. + Trace output can be changed with menu Options > Output. + The trace settings, including match specifications, can be saved to, + or loaded from, a file. +

+

For details about tracing, see module dbg in application Runtime_Tools + and in section "Match specifications in Erlang" in + ERTS User's Guide + and in module + ms_transform + in application STDLIB.

diff --git a/lib/observer/doc/src/part.xml b/lib/observer/doc/src/part.xml index 27b4e93d2d..d8ec7664d9 100644 --- a/lib/observer/doc/src/part.xml +++ b/lib/observer/doc/src/part.xml @@ -29,9 +29,8 @@
-

The Observer application contains tools for tracing - and investigation of distributed systems.

 + diff --git a/lib/observer/doc/src/ref_man.xml b/lib/observer/doc/src/ref_man.xml index 03d7dbe9df..37e20b2643 100644 --- a/lib/observer/doc/src/ref_man.xml +++ b/lib/observer/doc/src/ref_man.xml @@ -30,10 +30,7 @@ application.sgml
-

The Observer application contains tools for tracing - and investigation of distributed systems.

-

- + diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 0a50a20716..2b637551db 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -4,8 +4,7 @@
- 2002 - 2013 + 20022016 Ericsson AB, All Rights Reserved @@ -25,27 +24,28 @@ ttb - Siri hansen, Bartlomiej Puzon + Siri Hansen, Bartlomiej Puzon 1 2010-08-13 PA1 - ttb.sgml + ttb.xml
ttb A base for building trace tools for distributed systems. -

The Trace Tool Builder ttb is a base for building trace +

The Trace Tool Builder, ttb, is a base for building trace tools for distributed systems.

-

When using ttb, dbg shall not be used in parallel.

+

When using ttb, do not use module dbg in application + Runtime_Tools in parallel.

 start_trace(Nodes, Patterns, FlagSpec, Opts) -> Result - Start a trace port on each given node. + Start a trace port on each specified node. Result = see p/2 Nodes = see tracer/2 @@ -57,48 +57,56 @@

This function is a shortcut allowing to start a trace with one command. Each - tuple in Patterns is converted to list which is in turn passed to - ttb:tpl. - The call:

-ttb:start_trace([Node, OtherNode], -[{mod, foo, []}, {mod, bar, 2}], -{all, call}, -[{file, File}, {handler,{fun myhandler/4, S}}]) -

is equivalent to

-ttb:start_trace([Node, OtherNode], [{file, File}, {handler,{fun myhandler/4, S}}]), + tuple in Patterns is converted to a list, which in turn is passed to + ttb:tpl/2,3,4.

+

The call:

+ 
+> ttb:start_trace([Node, OtherNode],
+                  [{mod, foo, []}, {mod, bar, 2}],
+                  {all, call},
+                  [{file, File}, {handler,{fun myhandler/4, S}}]).
+

is equivalent to:

+ 
+> ttb:start_trace([Node, OtherNode],
+                  [{file, File}, {handler,{fun myhandler/4, S}}]),
 ttb:tpl(mod, foo, []),
 ttb:tpl(mod, bar, 2, []),
-ttb:p(all, call)
+ttb:p(all, call).
 + tracer() -> Result - This is equivalent to tracer(node()). + Equivalent to tracer(node()). -

This is equivalent to tracer(node()).

+

Equivalent to tracer(node()).

 + tracer(Shortcut) -> Result - Handy shortcuts for common tracing settings + Handy shortcuts for common tracing settings. Shortcut = shell | dbg +

Handy shortcuts for common tracing settings.

shell is equivalent to tracer(node(),[{file, {local, "ttb"}}, shell]).

dbg is equivalent to tracer(node(),[{shell, only}]).

 + tracer(Nodes) -> Result - This is equivalent to tracer(Nodes,[]). + Equivalent to tracer(Nodes,[]). -

This is equivalent to tracer(Nodes,[]).

+

Equivalent to tracer(Nodes,[]).

 + tracer(Nodes,Opts) -> Result - Start a trace port on each given node. + Start a trace port on each specified node. Result = {ok, ActivatedNodes} | {error,Reason} Nodes = atom() | [atom()] | all | existing | new @@ -120,98 +128,109 @@ ttb:p(all, call) ShellSpec = true | false | only -

This function starts a file trace port on all given nodes - and also points the system tracer for sequential tracing to +

Starts a file trace port on all specified nodes + and points the system tracer for sequential tracing to the same port.

-

The given Filename will be prefixed with the node - name. Default Filename is "ttb". -

-

File={wrap,Filename,Size,Count} can be used if - the size of the trace logs must be limited. Default values are - Size=128*1024 and Count=8. -

-

When tracing diskless nodes, ttb must be started +

Options:

+ + Filename +

The specified Filename is prefixed with the node name. + Default Filename is ttb.

 + File={wrap,Filename,Size,Count} +

Can be used if the size of the trace logs must be limited. + Default values are + Size=128*1024 and Count=8.

 + Client +

When tracing diskless nodes, ttb must be started from an external "trace control node" with disk access, and Client must be {local, File}. All trace information is then sent to the trace control node where - it is written to file. -

-

The process_info option indicates if process - information should be collected. If PI = true (which is + it is written to file.

 + process_info +

Indicates if process + information is to be collected. If PI = true (which is default), each process identifier Pid is replaced by a tuple {Pid,ProcessInfo,Node}, where ProcessInfo - is the process' registered name its globally registered name, - or its initial function. It is possible to turn off this - functionality by setting PI = false. -

-

The {shell, ShellSpec} option indicates that the trace messages should - be printed on the console as they are received by the tracing - process. This implies {local, File} trace client. If the ShellSpec - is only (instead of true), no trace logs are stored. -

-

The shell option is a shortcut for {shell, true}.

-

The timer option indicates that the trace should be + is the registered process name, its globally registered name, + or its initial function. To turn off this functionality, + set PI = false.

 + {shell, ShellSpec} +

Indicates that trace messages are to be printed on the + console as they are received by the tracing process. This implies + trace client {local, File}. If ShellSpec + is only (instead of true), no trace logs are stored.

 + shell +

Shortcut for {shell, true}.

 + timer +

Indicates that the trace is to be automatically stopped after MSec milliseconds. StopOpts - are passed to ttb:stop/2 command if specified (default is []). - Note that the timing is approximate, as delays related to + are passed to command ttb:stop/2 if specified (default is []). + Notice that the timing is approximate, as delays related to network communication are always present. The timer starts after - ttb:p/2 is issued, so you can set up your trace patterns before. -

-

The overload_check option allows to enable overload + ttb:p/2 is issued, so you can set up your trace patterns before.

 + overload_check +

Allows to enable overload checking on the nodes under trace. Module:Function(check) - is performed each MSec milliseconds. If the check returns - true, the tracing is disabled on a given node.
- Module:Function should be able to handle at least three - atoms: init, check and stop. init and - stop give the user a possibility to initialize and clean - up the check environment.
- When a node gets overloaded, it is not possible to issue ttb:p - nor any command from the ttb:tp family, as it would lead to + is performed each MSec millisecond. If the check returns + true, the tracing is disabled on a specified node.

+

Module:Function must be able to handle at least three + atoms: init, check, and stop. init and + stop allows you to initialize and clean + up the check environment.

+

When a node gets overloaded, it is not possible to issue ttb:p/2 + or any command from the ttb:tp/2,3,4 family, as it would lead to inconsistent tracing state (different trace specifications on - different node). -

-

The flush option periodically flushes all file trace - port clients (see dbg:flush_trace_port/1). When enabled, - the buffers are freed each MSec milliseconds. This option is - not allowed with {file, {local, File}} tracing. -

-

{resume, FetchTimeout} enables the autoresume feature. - Whenever enabled, remote nodes try to reconnect to the controlling node - in case they were restarted. The feature requires runtime_tools - application to be started (so it has to be present in the .boot - scripts if the traced nodes run with embedded erlang). If this is - not possible, resume may be performed manually by starting - runtime_tools remotely using rpc:call/4.
- ttb tries to fetch all logs from a reconnecting node before - reinitializing the trace. This has to finish within FetchTimeout milliseconds - or is aborted
- By default, autostart information is stored in a file called + different nodes).

 + flush +

Periodically flushes all file trace + port clients (see + + dbg:flush_trace_port/1). When enabled, + the buffers are freed each MSec millisecond. This option is + not allowed with {file, {local, File}} tracing.

 + {resume, FetchTimeout} +

Enables the autoresume feature. + When enabled, remote nodes try to reconnect to the controlling node + if they are restarted. The feature requires application Runtime_Tools + to be started (so it has to be present in the .boot + scripts if the traced nodes run with embedded Erlang). If this is + not possible, resume can be performed manually by starting + Runtime_Tools remotely using + rpc:call/4.

+

ttb tries to fetch all logs from a reconnecting node before + reinitializing the trace. This must finish within FetchTimeout + milliseconds or is aborted.

+

By default, autostart information is stored in a file named ttb_autostart.bin on each node. If this is not desired - (i.e. on diskless nodes), a custom module to handle autostart + (for example, on diskless nodes), a custom module handling autostart information storage and retrieval can be provided by specifying - ttb_autostart_module environment variable for the runtime_tools - application. The module has to respond to the following API:

- + environment variable ttb_autostart_module for the application + Runtime_Tools. The module must respond to the following API:

+ write_config(Data) -> ok - Store the provided data for further retrieval. It is +

Stores the provided data for further retrieval. It is important to realize that the data storage used must not - be affected by the node crash. + be affected by the node crash.

 read_config() -> {ok, Data} | {error, Error} - Retrieve configuration stored with write_config(Data). +

Retrieves configuration stored with write_config(Data).

 delete_config() -> ok - Delete configuration stored with write_config(Data). - Note that after this call any subsequent calls to read_config - must return {error, Error}. +

Deletes configuration stored with write_config(Data). + Notice that after this call any subsequent calls to read_config + must return {error, Error}.

 - -

The resume option implies the default FetchTimeout, which is + +

resume implies the default FetchTimeout, which is 10 seconds

+ + + + p(Procs,Flags) -> Return - Sets the given trace flags on the given processes. + Set the specified trace flags on the specified processes. Return = {ok,[{Procs,MatchDesc}]} Procs = Process | [Process] | all | new | existing @@ -219,95 +238,101 @@ ttb:p(all, call) Flags = Flag | [Flag] -

This function sets the given trace flags on the given - processes. The timestamp flag is always turned on. +

Sets the specified trace flags on the specified + processes. Flag timestamp is always turned on.

-

Please turn to the Reference manual for module dbg - for details about the possible trace flags. The parameter - MatchDesc is the same as returned from dbg:p/2

-

Processes can be given as registered names, globally - registered names or process identifiers. If a registered name - is given, the flags are set on processes with this name on all +

See the Reference Manual for module + dbg + and the possible trace flags. Parameter + MatchDesc is the same as returned from + dbg:p/2.

+

Processes can be specified as registered names, globally + registered names, or process identifiers. If a registered name + is specified, the flags are set on processes with this name on all active nodes.

-

Issuing this command starts the timer for this trace if - timer option was specified with tracer/2. +

Issuing this command starts the timer for this trace if option + timer is specified with tracer/2.

+ tp, tpl, ctp, ctpl, ctpg Set and clear trace patterns. -

These functions should be used in combination with the - call trace flag for setting and clearing trace - patterns. When the call trace flag is set on a process, - function calls will be traced on that process if a trace - pattern has been set for the called function. Trace patterns - specifies how to trace a function by using match +

These functions are to be used with + trace flag call for setting and clearing trace + patterns. When trace flag call is set on a process, + function calls are traced on that process if a trace + pattern is set for the called function. Trace patterns + specify how to trace a function by using match specifications. Match specifications are described in the - User's Guide for the erlang runtime system erts. + ERTS User's Guide.

These functions are equivalent to the corresponding - functions in dbg, but all calls are stored in the - history. The history buffer makes it easy to create config - files so that the same trace environment can be setup several - times, e.g. if you want to compare two test runs. It also + functions in module + dbg, + but all calls are stored in the + history. The history buffer makes it easy to create configuration + files; the same trace environment can be set up many + times, for example, to compare two test runs. It also reduces the amount of typing when using ttb from the - erlang shell. + Erlang shell.

tp - Set trace pattern on global function calls +

Sets trace patterns on global function calls.

 tpl - Set trace pattern on local and global function calls +

Sets trace patterns on local and global function calls.

 ctp - Clear trace pattern on local and global function - calls +

Clears trace patterns on local and global function + calls.

 ctpl - Clear trace pattern on local function calls +

Clears trace patterns on local function calls.

 ctpg - Clear trace pattern on global function calls +

Clears trace patterns on global function calls.

 -

With tp and tpl one of match specification shortcuts - may be used (example: ttb:tp(foo_module, caller)). The shortcuts are:

- - +

With tp and tpl, one of the match specification shortcuts + can be used (for example, ttb:tp(foo_module, caller)).

+

The shortcuts are as follows:

+ return - for [{'_',[],[{return_trace}]}] (report the return value) - caller - for [{'_',[],[{message,{caller}}]}] (report the calling function) - {codestr, Str} - for dbg:fun2ms/1 arguments passed as strings (example: "fun(_) -> return_trace() end") - + + list_history() -> History - Returns all calls stored in history + Return all calls stored in history. History = [{N,Func,Args}]

All calls to ttb is stored in the history. This function returns the current content of the history. Any entry - can be re-executed with run_history/1 or stored in a - config file with write_config/2/3.

+ can be reexecuted with run_history/1 or stored in a + configuration file with write_config/2,3.

 + run_history(N) -> ok | {error, Reason} - Executes one entry of the history + Execute one entry of the history. N = integer() | [integer()] -

Executes the given entry or entries from the history - list. History can be listed with list_history/0.

+

Executes the specified entry or entries from the history + list. To list history, use list_history/0.

 + write_config(ConfigFile,Config) Equivalent to write_config(ConfigFile,Config,[]). @@ -315,9 +340,10 @@ ttb:p(all, call)

Equivalent to write_config(ConfigFile,Config,[]).

+ write_config(ConfigFile,Config,Opts) -> ok | {error,Reason} - Creates a config file. + Create a configuration file. ConfigFile = string() Config = all | [integer()] | [{Mod,Func,Args}] @@ -328,92 +354,97 @@ ttb:p(all, call) Opt = append -

This function creates or extends a config file which can be +

Creates or extends a configuration file, which can be used for restoring a specific configuration later.

-

The content of the config file can either be fetched from - the history or given directly as a list of +

The contents of the configuration file can either be fetched from + the history or specified directly as a list of {Mod,Func,Args}.

-

If the complete history is to be stored in the config file - Config should be all. If only a selected number - of entries from the history should be stored, Config - should be a list of integers pointing out the entries to be +

If the complete history is to be stored in the configuration file, + Config must be all. If only a selected number + of entries from the history are to be stored, Config + must be a list of integers pointing out the entries to be stored.

-

If Opts is not given or if it is [], +

If Opts is not specified or if it is [], ConfigFile is deleted and a new file is created. If - Opts = [append], ConfigFile will not be deleted. - The new information will be appended at the end of the file.

+ Opts = [append], ConfigFile is not deleted. + The new information is appended at the end of the file.

 + run_config(ConfigFile) -> ok | {error,Reason} - Executes all entries in a config file. + Execute all entries in a configuration file. ConfigFile = string() -

Executes all entries in the given config file. Note that the history - of the last trace is always available in the file named - ttb_last_config.

+

Executes all entries in the specified configuration file. + Notice that the history of the last trace is always available + in file ttb_last_config.

 + run_config(ConfigFile,NumList) -> ok | {error,Reason} - Executes selected entries from a config file. + Execute selected entries from a configuration file. ConfigFile = string() NumList = [integer()] -

Executes selected entries from the given config +

Executes selected entries from the specified configuration file. NumList is a list of integers pointing out the entries to be executed.

-

The content of a config file can be listed with +

To list the contents of a configuration file, use list_config/1.

-

Note that the history - of the last trace is always available in the file named - ttb_last_config.

+

Notice that the history of the last trace is always available + in file ttb_last_config.

 + list_config(ConfigFile) -> Config | {error,Reason} - Lists all entries in a config file. + List all entries in a configuration file. ConfigFile = string() Config = [{N,Func,Args}] -

Lists all entries in the given config file.

+

Lists all entries in the specified configuration file.

 + write_trace_info(Key,Info) -> ok - Writes any information to the .tifile. + Write any information to file .ti. Key = term() Info = Data | fun() -> Data Data = term() -

The .ti file contains {Key,ValueList} - tuples. This function adds Data to the ValueList +

File .ti contains {Key,ValueList} + tuples. This function adds Data to the ValueList associated with Key. All information written with this - function will be included in the call to the format handler.

+ function is included in the call to the format handler.

 + seq_trigger_ms() -> MatchSpec - Equivalent to seq_trigger_ms(all) + Equivalent to seq_trigger_ms(all). -

Equivalent to seq_trigger_ms(all)

+

Equivalent to seq_trigger_ms(all).

 + seq_trigger_ms(Flags) -> MatchSpec - Returns a match_spec() which starts sequential tracing + Return a match_spec() which starts sequential tracing. MatchSpec = match_spec() Flags = all | SeqTraceFlag | [SeqTraceFlag] @@ -421,54 +452,55 @@ ttb:p(all, call)

A match specification can turn on or off sequential - tracing. This function returns a match specification which - turns on sequential tracing with the given Flags. + tracing. This function returns a match specification, which + turns on sequential tracing with the specified Flags.

-

This match specification can be given as the last argument - to tp or tpl. The activated Item will - then become a trigger for sequential tracing. This - means that if the item is called on a process with the - call trace flag set, the process will be "contaminated" - with the seq_trace token. +

This match specification can be specified as the last argument + to tp or tpl. The activated Item + then becomes a trigger for sequential tracing. This + means that if the item is called on a process with trace flag + call set, the process is "contaminated" + with token seq_trace.

If Flags = all, all possible flags are set.

-

Please turn to the reference manual for the - seq_trace module in the kernel - application to see the possible values for - SeqTraceFlag. For a description of the match_spec() - syntax, please turn to the User's guide for the - runtime system (erts). The chapter Match Specification in Erlang explains the general match - specification "language". +

The possible values for SeqTraceFlag are available in + seq_trace.

+

For a description of the match_spec() syntax, + see section + Match Specifications in Erlang + in ERTS, which explains the general match specification "language".

The system tracer for sequential tracing is automatically initiated by ttb when a trace port is - started with ttb:tracer/0/1/2.

+ started with ttb:tracer/0,1,2.

 -

Example of how to use the seq_trigger_ms/0/1 function:

- -(tiger@durin)5> ttb:tracer(). +

An example of how to use function seq_trigger_ms/0,1 follows:

+ 
+(tiger@durin)5> ttb:tracer().
 {ok,[tiger@durin]}
-(tiger@durin)6> ttb:p(all,call).
+(tiger@durin)6> ttb:p(all,call).
 {ok,{[all],[call]}}
-(tiger@durin)7> ttb:tp(mod,func,ttb:seq_trigger_ms()).
+(tiger@durin)7> ttb:tp(mod,func,ttb:seq_trigger_ms()).
 {ok,[{matched,1},{saved,1}]}
-(tiger@durin)8>         
-        
Whenever mod:func(...) is called after this, the
-          seq_trace token will be set on the executing process.

+(tiger@durin)8>
+

Whenever mod:func(...) is called after this, + token seq_trace is set on the executing process.

 + stop() - Equivalent to stop([]) + Equivalent to stop([]).

Equivalent to stop([]).

 + stop(Opts) -> stopped | {stopped, Dir} - Stop tracing and fetch/format logs from all nodes + Stop tracing and fetch/format logs from all nodes. Opts = Opt | [Opt] Opt = nofetch | {fetch_dir, Dir} | format | {format, FormatOpts} | return_fetch_dir @@ -485,88 +517,103 @@ ttb:p(all, call) form yyyymmdd-hhmmss. Even logs from nodes on the same machine as the trace control node are moved to this directory. The history list is saved to a file named ttb_last_config - for further reference (as it will be not longer accessible - through history and configuration management functions (like + for further reference (as it is no longer accessible + through history and configuration management functions, like ttb:list_history/0).

-

The nofetch option indicates that trace logs shall not be - collected after tracing is stopped. -

-

The {fetch, Dir} option allows to specify the directory +

Options:

+ + nofetch +

Indicates that trace logs are not to be + collected after tracing is stopped.

 + {fetch, Dir} +

Allows specification of the directory to fetch the data to. If the directory already exists, an - error is thrown. -

-

The format option indicates that the trace logs - shall be formatted after tracing is stopped. All logs in the fetch directory will be merged. - You may use {format, FormatOpts} to pass additional - arguments to format/2.

-

The return_fetch_dir option indicates that the return value - should be {stopped, Dir} and not just stopped. - This implies fetch. -

+ error is thrown.

 + format +

Indicates the trace logs to be formatted after tracing + is stopped. All logs in the fetch directory are merged.

 + return_fetch_dir +

Indicates the return value + to be {stopped, Dir} and not just stopped. + This implies fetch.

 + + + get_et_handler() - Returns et handler. + Return the et handler. -

The et handler returned by the function may be used with format/2 - or tracer/2. Example: ttb:format(Dir, [{handler, ttb:get_et_handler()}]).

+

Returns the et handler, which can be used with format/2 + or tracer/2.

+

Example: ttb:format(Dir, [{handler, ttb:get_et_handler()}]).

 + format(File) - Same as format(File,[]). + Equivalent to format(File,[]). -

Same as format(File,[]).

+

Equivalent to format(File,[]).

 + format(File,Options) -> ok | {error, Reason} - Format a binary trace log + Format a binary trace log. File = string() | [string()] - This can be the name of a binary log, a list of such logs or the name of a directory containing one or more binary logs. + This can be the name of a binary log, a list of such logs, + or the name of a directory containing one or more binary logs. Options = Opt | [Opt] Opt = {out,Out} | {handler,FormatHandler} | disable_sort Out = standard_io | string() FormatHandler = {Function, InitialState} Function = fun(Fd,Trace,TraceInfo,State) -> State Fd = standard_io | FileDescriptor - This is the file descriptor of the destination file Out + File descriptor of the destination file Out. Trace = tuple() - This is the trace message. Please turn to the Reference manual for the erlangmodule for details. + The trace message. For details, see the Reference Manual for + module erlang. TraceInfo = [{Key,ValueList}] - This includes the keys flags, client and node, and if handler is given as option to the tracer function, this is also included. In addition all information written with the write_trace_info/2function is included. + Includes the keys flags, client, and node. + If handler is specified as option to the tracer function, this + is also included. Also, all information written with function + write_trace_info/2 is included. -

Reads the given binary trace log(s). The logs are processed - in the order of their timestamp as long as disable_sort - option is not given. +

Reads the specified binary trace log(s). The logs are processed + in the order of their time stamps as long as option disable_sort + is not specified.

If FormatHandler = {Function,InitialState}, - Function will be called for each trace message. If - FormatHandler = get_et_handler(), et_viewer in - the Event Tracer application (et) is used for presenting + Function is called for each trace message.

+

If FormatHandler = get_et_handler(), et_viewer in + application ET is used for presenting the trace log graphically. ttb provides a few different - filters which can be selected from the Filter menu in the - et_viewer. If FormatHandler is not given, a - default handler is used which presents each trace message as a - line of text. + filters that can be selected from menu Filters and scaling + in the et_viewer.

+

If FormatHandler is not specified, a + default handler is used presenting each trace message as a + text line.

-

The state returned from each call of Function is passed to the next call, - even if next call is to format a message from another log file. +

The state returned from each call of Function is passed to + the next call, even if the next call is to format a message from another + log file.

-

If Out is given, FormatHandler gets the +

If Out is specified, FormatHandler gets the file descriptor to Out as the first parameter.

-

Out is ignored if et format handler is used. +

Out is ignored if the et format handler is used.

-

Wrap logs can be formatted one by one or all in one go. To - format one of the wrap logs in a set, give the exact name of - the file. To format the whole set of wrap logs, give the name - with '*' instead of the wrap count. See examples in the - ttb User's Guide.

+

Wrap logs can be formatted one by one or all at once. To + format one of the wrap logs in a set, specify the exact file name. + To format the whole set of wrap logs, specify the name + with * instead of the wrap count. For examples, see the + User's Guide. +

diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index e2a28d67d0..34591ae8de 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -4,7 +4,7 @@
- 20022013 + 20022016 Ericsson AB. All Rights Reserved. @@ -32,78 +32,85 @@
Introduction -

The Trace Tool Builder is a base for building trace tools for - single node or distributed erlang systems. It requires the - runtime_tools application to be available on the traced +

Trace Tool Builder is a base for building trace tools for + single node or distributed Erlang systems. It requires the + Runtime_Tools application to be available on the traced node.

-

The main features of the Trace Tool Builder are:

+

The following are the main features of Trace Tool Builder:

- Start tracing to file ports on several nodes with one + Start tracing to file ports on many nodes with one function call. - Write additional information to a trace information file, + Write more information to a trace information file, which is read during formatting. - Restoring of previous configuration by maintaining a + Restore previous configuration by maintaining a history buffer and handling configuration files. - Some simple support for sequential tracing. - Formatting of binary trace logs and merging of logs from + Provide some simple support for sequential tracing. + Format binary trace logs and merge logs from multiple nodes. -

The intention of the Trace Tool Builder is to serve - as a base for tailor made trace tools, but you may use it directly - from the erlang shell (it may mimic dbg behaviour while - still providing useful additions like match specification shortcuts). - The application only - allows the use of file port tracer, so if you would like - to use other types of trace clients you will be better off - using dbg directly instead.

+

The intention of Trace Tool Builder is to serve + as a base for tailor-made trace tools, but it can also be used directly + from the Erlang shell (it can mimic dbg behaviour while + still providing useful additions, such as match specification shortcuts). + Trace Tool Builder only allows the use of file port tracer, so to use + other types of trace clients it is better to use dbg directly.

Getting Started -

The ttb module is the interface to all functions in the - Trace Tool Builder. To get started the least you need to do is to - start a tracer with ttb:tracer/0/1/2, and set the required - trace flags on the processes you want to trace with - ttb:p/2. Then, when the tracing is completed, you must stop - the tracer with ttb:stop/0/1 and format the trace log with - ttb:format/1/2 (as long as there is anything to format, of - course). +

Module ttb is the interface to all functions in + Trace Tool Builder.

+

To get started, the least you need to do is to + start a tracer with + ttb:tracer/0,1,2, + and set the required + trace flags on the processes you want to trace with + ttb:p/2.

+

When the tracing is completed, stop the tracer with + ttb:stop/0,1 + and format the trace log with + ttb:format/1,2 + (if there is anything to format).

-

ttb:tracer/0/1/2 opens a trace port on each node - that shall be traced. By default, trace messages are written - to binary files on remote nodes(the binary trace log). -

-

ttb:p/2 specifies which processes shall be - traced. Trace flags given in this call specify what to trace on - each process. You can call this function several times if you like - different trace flags to be set on different processes. -

-

If you want to trace function calls (i.e. if you have the - call trace flag set on any of your processes), you must +

Useful functions:

+ + ttb:tracer/0,1,2 +

Opens a trace port on each node to be traced. By default, + trace messages are written to binary files on remote nodes (the + binary trace log).

 + ttb:p/2 +

Specifies the processes to be traced. Trace flags specified + in this call specify what to trace on each process. This function can be + called many times if you like different trace flags to be set on different + processes.

 + ttb:tp/2,3,4 or ttb:tpl/2,3,4 +

If you want to trace function calls (that is, if you have + trace flag call set on any process), you must also set trace patterns on the required function(s) with - ttb:tp or ttb:tpl. A function is only traced if it - has a trace pattern. The trace pattern specifies how to trace the + ttb:tp/2,3,4 or + ttb:tpl/2,3,4. + A function is only traced + if it has a trace pattern. The trace pattern specifies how to trace the function by using match specifications. Match specifications are - described in the User's Guide for the erlang runtime system - erts. -

-

ttb:stop/0/1 stops tracing on all nodes, deletes all - trace patterns and flushes the trace port buffer. -

-

ttb:format/1/2 translates the binary trace logs into - something readable. By default ttb presents each trace - message as a line of text, but you can also write your own handler - to make more complex interpretations of the trace information. A - trace log can even be presented graphically via the Event Tracer - application. Note that if you give the format option to - ttb:stop/1 the formatting is automatically done when - stopping ttb. -

- + described in the + ERTS User's Guide.

 + ttb:stop/0,1 +

Stops tracing on all nodes, deletes all trace patterns, and + flushes the trace port buffer.

 + ttb:format/1/2 +

Translates the binary trace logs into something readable. + By default, ttb presents each trace message as a line of text, + but you can also write your own handler to make more complex interpretations + of the trace information. A trace log can also be presented graphically + with application Event Tracer (ET).

+

If option format is specified to ttb:stop/1, the formatting + is automatically done when stopping ttb.

 + +
- Example: Tracing the local node from the erlang shell -

This small module is used in the example:

+ Tracing Local Node from Erlang Shell +

The following small module is used in the subsequent example:

-module(m). -export([f/0]). @@ -114,25 +121,25 @@ f() -> From ! {self(),Now} end.

The following example shows the basic use of ttb from - the erlang shell. Default options are used both for starting the - tracer and for formatting (the custom fetch dir is however provided). - This gives a trace log named Node-ttb in the newly-created - directory, where Node is the name of the node. The + the Erlang shell. Default options are used both for starting the + tracer and for formatting (the custom fetch directory is however provided). + This gives a trace log named Node-ttb in the newly created + directory, where Node is the node name. The default handler prints the formatted trace messages in the - shell.

- + 
 (tiger@durin)47> %% First I spawn a process running my test function
-(tiger@durin)47> Pid = spawn(m,f,[]).
-<0.125.0>
+(tiger@durin)47> Pid = spawn(m,f,[]).
+<0.125.0>
 (tiger@durin)48> 
 (tiger@durin)48> %% Then I start a tracer...
-(tiger@durin)48> ttb:tracer().
+(tiger@durin)48> ttb:tracer().
 {ok,[tiger@durin]}
 (tiger@durin)49> 
 (tiger@durin)49> %% and activate the new process for tracing
 (tiger@durin)49> %% function calls and sent messages.
-(tiger@durin)49> ttb:p(Pid,[call,send]).
-{ok,[{<0.125.0>,[{matched,tiger@durin,1}]}]}
+(tiger@durin)49> ttb:p(Pid,[call,send]).
+{ok,[{<0.125.0>,[{matched,tiger@durin,1}]}]}
 (tiger@durin)50> 
 (tiger@durin)50> %% Here I set a trace pattern on erlang:now/0
 (tiger@durin)50> %% The trace pattern is a simple match spec
@@ -140,33 +147,33 @@ f() ->
 (tiger@durin)50> %% traced. Refer to the reference_manual for
 (tiger@durin)50> %% the full list of match spec shortcuts
 (tiger@durin)50> %% available.
-(tiger@durin)51> ttb:tp(erlang,now,return).
+(tiger@durin)51> ttb:tp(erlang,now,return).
 {ok,[{matched,tiger@durin,1},{saved,1}]}
 (tiger@durin)52> 
 (tiger@durin)52> %% I run my test (i.e. send a message to
 (tiger@durin)52> %% my new process)
-(tiger@durin)52> Pid ! self().
-<0.72.0>
+(tiger@durin)52> Pid ! self().
+<0.72.0>
 (tiger@durin)53> 
 (tiger@durin)53> %% And then I have to stop ttb in order to flush
 (tiger@durin)53> %% the trace port buffer
-(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]).
+(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]).
 {stopped, "fetch"}
 (tiger@durin)54> 
 (tiger@durin)54> %% Finally I format my trace log
-(tiger@durin)54> ttb:format("fetch").
-({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now()
-({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 ->
+(tiger@durin)54> ttb:format("fetch").
+({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now()
+({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 ->
 {1031,133451,667611}
-({<0.125.0>,{m,f,0},tiger@durin}) <0.72.0> ! 
-{<0.125.0>,{1031,133451,667611}}
-ok      ]]>
+({<0.125.0>,{m,f,0},tiger@durin}) <0.72.0> !
+{<0.125.0>,{1031,133451,667611}}
+ok
- Example: Build your own tool -

This small example shows a simple tool for "debug tracing", - i.e. tracing of function calls with return values.

+ Build Your Own Tool +

The following example shows a simple tool for "debug tracing", + that is, tracing of function calls with return values:

"Return value :~p~n~n", [N,Ts,P,M,F,A,R]). ]]>

To distinguish trace logs produced with this tool from other - logs, the file option is used in tracer/2. The - logs will therefore be fetched to a directory named + logs, option file is used in + tracer/2. The + logs are therefore fetched to a directory named ttb_upload_debug_log-YYYYMMDD-HHMMSS

-

By using the handler option when starting the tracer, +

By using option handler when starting the tracer, the information about how to format the file is stored in the trace information file (.ti). This is not necessary, as - it might be given at the time of formatting instead. It can - however be useful if you e.g. want to automatically format your - trace logs by using the format option in - ttb:stop/1. It also means that you don't need any - knowledge of the content of a binary log to be able to format it - the way it was intended. If the handler option is given - both when starting the tracer and when formatting, the one given - when formatting is used. + it can be specified when formatting instead. However, It can + be useful if you, for example, want to format trace logs automatically + using option format in ttb:stop/1. Also, you do not need + any knowledge of the content of a binary log to format it the way it + is intended. If option handler is specified both when starting + the tracer and when formatting, the one specified when formatting is used.

-

The call trace flag is set on all processes. This - means that any function activated with the trc/1 command - will be traced on all existing and new processes. +

Trace flag call is set on all processes. This + means that any function activated with command trc/1 + is traced on all existing and new processes.

- Running the Trace Tool Builder against a remote node + Running Trace Tool Builder against Remote Node

The Observer application might not always be available on the - node that shall be traced (in the following called the "traced - node"). It is still possible to run the Trace Tool Builder from + node to be traced (in the following called the "traced + node"). However, Trace Tool Builder can still be run from another node (in the following called the "trace control node") as - long as + long as the following is fulfilled:

The Observer application is available on the trace control node. - The Runtime Tools application is available on both the + The Runtime_Tools application is available on both the trace control node and the traced node. -

If the Trace Tool Builder shall be used against a remote node, +

If Trace Tool Builder is to be used against a remote node, it is highly recommended to start the trace control node as hidden. This way it can connect to the traced node - without the traced node "seeing" it, i.e. if the nodes() - BIF is called on the traced node, the trace control node will not - show. To start a hidden node, add the -hidden option to the - erl command, e.g.

- -% erl -sname trace_control -hidden + without being "seen" by it, that is, if the nodes() + BIF is called on the traced node, the trace control node does not + show. To start a hidden node, add option -hidden to the + erl command, for example:

+ 
+% erl -sname trace_control -hidden
- Diskless node + Diskless Node

If the traced node is diskless, ttb must be started from - a trace control node with disk access, and the file option - must be given to the tracer/2 function with the value - {local, File}, e.g.

- -(trace_control@durin)1> ttb:tracer(mynode@diskless,{file,{local, -{wrap,"mytrace"}}}). -{ok,[mynode@diskless]} + a trace control node with disk access, and option file + must be specified to function tracer/2 with value + {local, File}, for example:

+ 
+(trace_control@durin)1> ttb:tracer(mynode@diskless,
+                                   {file,{local,{wrap,"mytrace"}}}).
+{ok,[mynode@diskless]}
- Additional tracing options -

When setting up a trace, several features may be turned on:

+ More Tracing Options +

When setting up a trace, the following features can also be activated:

- time-constrained tracing, - overload protection, - autoresuming. + Time-constrained tracing + Overload protection + Autoresume + dbg mode
- Time-constrained tracing -

Sometimes, it may be helpful to enable trace for a - given period of time (i.e. to monitor a system for 24 hours - or half of a second). This may be done by issuing additional - {timer, TimerSpec} option. If TimerSpec has the + Time-Constrained Tracing +

It can sometimes be helpful to enable trace for a + specified period of time (for example, to monitor a system for 24 hours + or half a second). This can be done with option + {timer, TimerSpec}. If TimerSpec has the form of MSec, the trace is stopped after MSec - milliseconds using ttb:stop/0. If any additional options - are provided (TimerSpec = {MSec, Opts}), ttb:stop/1 - is called instead with Opts as the arguments. The timer - is started with ttb:p/2, so any trace patterns should - be set up before. ttb:start_trace/4 - always sets up all pattern before invoking ttb:p/2. - Note that due to network and processing delays the the period - of tracing is approximate. - The example below shows how to set up a trace which will be - automatically stopped and formatted after 5 seconds -

-(tiger@durin)1>ttb:start_trace([node()], - [{erlang, now,[]}], - {all, call}, - [{timer, {5000, format}}]). - + milliseconds using + ttb:stop/0. If more + options are provided (TimerSpec = {MSec, Opts}), + ttb:stop/1 + is called instead with Opts as argument.

+

The timer is started with + ttb:p/2, so any trace patterns + must be set up in advance. + ttb:start_trace/4 + always sets up all patterns before invoking ttb:p/2.

+

The following example shows how to set up a trace that is + automatically stopped and formatted after 5 seconds: + 

+(tiger@durin)1> ttb:start_trace([node()],
+                                [{erlang, now,[]}],
+                                {all, call},
+                                [{timer, {5000, format}}]).
+

Because of network and processing delays, the period + of tracing is approximate.

 +
- Overload protection -

When tracing live systems, special care needs to be always taken - not to overload a node with too heavy tracing. ttb provides - the overload option to help to address the problem.

-

{overload, MSec, Module, Function} instructs the ttb backend - (called observer_backend, part of the runtime_tools - application) to perform overload check every MSec milliseconds. - If the check (namely Module:Function(check)) returns + Overload Protection +

When tracing live systems, always take special care to not + overload a node with too heavy tracing. ttb provides + option overload to address this problem.

+

{overload, MSec, Module, Function} instructs the ttb back end + (a part of the Runtime_Tools + application) to perform overload check every MSec millisecond. + If the check (named Module:Function(check)) returns true, tracing is disabled on the selected node.

Overload protection activated on one node does not affect other nodes, where the tracing continues as normal. - ttb:stop/0/1 fetches data from all clients, including everything - that has been collected before overload protection was activated. - Note that - changing trace details (with ttb:p and ttb:tp/tpl...) - once overload protection gets activated in one of the traced - nodes is not permitted in order not to allow trace setup - to be inconsistent between nodes. -

-

Module:Function provided with the overload option must - handle three calls: init, check and stop. init - and stop allows to perform some setup and teardown required by - the check. An overload check module could look like this (note that - check is always called by the same process, so put and - get are possible). -

+ ttb:stop/0,1 fetches data from all clients, including everything + collected before the activation of overload protection.

+ +

+ It is not allowed to change trace details + (with ttb:p and ttb:tp/tpl...) once overload + protection is activated in one of the traced nodes. This is to + avoid trace setup being inconsistent between nodes.

 + +

Module:Function provided with option overload must + handle three calls: init, check, and stop. init + and stop allow some setup and teardown required by + the check. An overload check module can look as follows: +

-module(overload). -export([check/1]). @@ -362,33 +372,37 @@ check(check) -> end; check(stop) -> get(pid) ! stop. +

+ check is always called by the same process, so put and + get are possible.
Autoresume -

It is possible that a node (probably a buggy one, hence traced) - crashes. In order to automatically resume tracing on the node - as soon as it gets back, resume has to be used. When - it is, the failing node tries to reconnect - to trace control node as soon as runtime tools is started. - This implies that runtime_tools must be included in - other node's startup chain (if it is not, one could still - resume tracing by starting runtime_tools manually, - i.e. by an RPC call).

-

In order not to loose the data that the failing node stored - up to the point of crash, the control node will try to fetch - it before restarting trace. This must happen within the allowed - time frame or is aborted (default is 10 seconds, can be customized with - {resume, MSec}). The data fetched this way is then - merged with all other traces.

-

Autostart feature requires additional data to be stored on +

A node can crash (probably a buggy one, hence traced). + Use resume to resume tracing on the node automatically + when it gets back. The failing node then tries to reconnect + to trace control node when Runtime_Tools is started. + This implies that Runtime_Tools must be included in + the startup chain of other nodes (if not, you can still + resume tracing by starting Runtime_Tools manually, + that is, by an RPC call).

+

To not lose the data that the failing node stored + up to the point of crash, the control node tries to fetch + it before restarting trace. This must occur within the allowed + time frame, otherwise it is aborted (default is 10 seconds, but it + can be changed with {resume, MSec}). The data fetched + this way is then merged with all other traces.

+

The autostart feature requires more data to be stored on traced nodes. By default, the data is stored automatically - to the file called "ttb_autostart.bin" in the traced node's cwd. - Users may decide to change this behaviour (i.e. on diskless + to the file named "ttb_autostart.bin" in the currect working directory + (cwd) of the traced node. + Users can change this behaviour (that is, on diskless nodes) by specifying their own module to handle autostart data storage and retrieval (ttb_autostart_module - environment variable of runtime_tools). Please see the - ttb's reference manual to see the module's API. This example - shows the default handler

+ environment variable of runtime_tools). For information + about the API, see module + ttb. + The following example shows the default handler:

-module(ttb_autostart). -export([read_config/0, @@ -407,54 +421,60 @@ read_config() -> end. write_config(Data) -> - file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). - -

Remember that file trace ports buffer the data + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + +

Remember that file trace ports buffer the data by default. If the node crashes, trace messages are not - flushed to the binary log. If the chance of failure is - high, it might be a good idea to automatically flush - the buffers every now and then. Passing {flush, MSec} - as one of ttb:tracer/2 option flushes all buffers - every MSec milliseconds.

+ flushed to the binary log. If the risk of failure is + high, it can be a good idea to flush the buffers every + now and then automatically. Passing {flush, MSec} + as an option of ttb:tracer/2 flushes all buffers + every MSec millisecond.

- dbg mode -

The {shell, ShellType} option allows to make ttb - operation similar to dbg. Using {shell, true} + dbg Mode +

Option {shell, ShellType} allows making ttb + operation similar to + dbg. + Using {shell, true} displays all trace messages in the shell before storing them. {shell, only} additionally disables message storage - (so that the tool behaves exactly like dbg). This is allowed - only with ip trace ports ({trace, {local, File}}). + (making the tool to behave exactly like dbg). This is + allowed only with IP trace ports ({trace, {local, File}}).

-

The command ttb:tracer(dbg) is a shortcut for the pure-dbg - mode ({shell, only}).

+

Command ttb:tracer(dbg) is a shortcut for the pure + dbg mode ({shell, only}).

- Trace Information and the .ti File -

In addition to the trace log file(s), a file with the extension - .ti is created when the Trace Tool Builder is started. This - is the trace information file. It is a binary file, and it + Trace Information and File .ti +

In addition to the trace log file(s), a file with extension + .ti is created when Trace Tool Builder is started. This + is the trace information file. It is a binary file, which contains the process information, trace flags used, the name of - the node to which it belongs and all information written with the - write_trace_info/2 function. .ti files are always fetched - with other logs when the trace is stopped. + the node to which it belongs, and all information written with + function + ttb:write_trace_info/2. + .ti files are always fetched with other logs when the trace is stopped.

Except for the process information, everything in the trace information file is passed on to the handler function when - formatting. The TI parameter is a list of + formatting. Parameter TI is a list of {Key,ValueList} tuples. The keys flags, - handler, file and node are used for + handler, file, and node are used for information written directly by ttb.

-

You can add information to the trace information file by - calling write_trace_info/2. Note that ValueList - always will be a list, and if you call write_trace_info/2 - several times with the same Key, the ValueList will - be extended with a new value each time. Example: +

Information to the trace information file by + can be added by calling + ttb:write_trace_info/2. + Notice that ValueList + always is a list, and if you call write_trace_info/2 + many times with the same Key, the ValueList is + extended with a new value each time.

+

Example:

ttb:write_trace_info(mykey,1) gives the entry {mykey,[1]} in TI. Another call, ttb:write_trace_info(mykey,2), changes this entry to @@ -467,15 +487,15 @@ write_config(Data) ->

If you want to limit the size of the trace logs, you can use wrap logs. This works almost like a circular buffer. You can specify the maximum number of binary logs and the maximum size of - each log. ttb will create a new binary log each time a log - reaches the maximum size. When the the maximum number of logs are + each log. ttb then creates a new binary log each time a log + reaches the maximum size. When the maximum number of logs are reached, the oldest log is deleted before a new one is created.

-

Note that the overall size of data generated by ttb may be greater - than the wrap specification would suggest - if a traced node restarts - and autoresume is enabled, old wrap log is always stored and +

The overall size of data generated by ttb can be greater + than the wrap specification suggests. If a traced node restarts + and autoresume is enabled, the old wrap log is always stored and a new one is created. -

+

Wrap logs can be formatted one by one or all at once. See Formatting.

@@ -485,52 +505,61 @@ write_config(Data) -> Formatting

Formatting can be done automatically when stopping ttb - (see Automatically collect and format logs from all nodes), or explicitly by calling - the ttb:format/1/2 function. + (see section + Automatically Collect and Format Logs from All Nodes), or explicitly by calling function + ttb:format/1,2.

Formatting means to read a binary log and present it in a readable format. You can use the default format handler in ttb to present each trace message as a line of text, or write your own handler to make more complex interpretations of the - trace information. You can even use the Event Tracer et to - present the trace log graphically (see Presenting trace logs with Event Tracer). + trace information. You can also use application ET to + present the trace log graphically (see section + Presenting Trace Logs with Event Tracer).

-

The first argument to ttb:format/1/2 specifies which +

The first argument to ttb:format/1,2 specifies which binary log(s) to format. This is usually the name of a directory - that ttb created during log fetch. Unless there is the disable_sort - option provided, the logs from different files are always sorted - according to timestamp in traces. + that ttb created during log fetch. Unless option + disable_sort is provided, the logs from different files + are always sorted according to time-stamp in traces.

The second argument to ttb:format/2 is a list of - options. The out option specifies the destination where the - formatted text shall be written. Default destination is - standard_io, but a filename can also be given. The - handler option specifies the format handler to use. If this - option is not given, the handler option given when starting - the tracer is used. If the handler option was not given - when starting the tracer either, a default handler is used, which - prints each trace message as a line of text. The disable_sort - option indicates that there logs should not be merged according to - timestamp, but processed one file after another (this might be - a bit faster). + options as follows:

-

A format handler is a fun taking four arguments. This fun will - be called for each trace message in the binary log(s). A simple - example which only prints each trace message could be like this:

+ + out +

Specifies the destination to write the formatted text. + Default destination is standard_io, but a filename can + also be specified.

 + handler +

Specifies the format handler to use. If this option is + not specified, option handler that is specified when starting + the tracer is used. If option handler is not specified + when starting the tracer either, a default handler is used, which + prints each trace message as a text line.

 + disable_sort +

Indicates that the logs are not to be merged according to + time-stamp, but processed one file after another (this can be + a bit faster).

 + +

A format handler is a fun taking four arguments. This fun is + called for each trace message in the binary log(s). A simple + example that only prints each trace message can be as follows:

fun(Fd, Trace, _TraceInfo, State) -> io:format(Fd, "Trace: ~p~n", [Trace]), State end. -

Fd is the file descriptor for the destination file, or +

Here, Fd is the file descriptor for the destination file, or the atom standard_io. _TraceInfo contains information - from the trace information file (see Trace Information and the .ti File). State is a state variable for the format - handler fun. The initial value of the State variable is - given with the handler option, e.g.

+ from the trace information file (see section + Trace Information and File .ti). State is a state variable for the format + handler fun. The initial value of variable State is + specified with the handler option, for example:

ttb:format("tiger@durin-ttb", [{handler, {{Mod,Fun}, initial_state}}]) ^^^^^^^^^^^^^ -

Another format handler could be used to calculate time spent by +

Another format handler can be used to calculate the time spent by the garbage collector:

fun(_Fd,{trace_ts,P,gc_start,_Info,StartTs},_TraceInfo,State) -> @@ -541,111 +570,118 @@ fun(_Fd,{trace_ts,P,gc_start,_Info,StartTs},_TraceInfo,State) -> io:format("GC in process ~w: ~w milliseconds~n", [P,Time]), State -- [{P,StartTs}] end -

A more refined version of this format handler is the function - handle_gc/4 in the module multitrace.erl which can - be found in the src directory of the Observer application. +

A more refined version of this format handler is function + handle_gc/4 in module multitrace.erl + included in directory src of the Observer application.

-

The actual trace message is passed as the second argument (Trace). - The possible values of Trace are:

+

The trace message is passed as the second argument (Trace). + The possible values of Trace are the following:

- all trace messages described in erlang:trace/3 documentation, + All trace messages described in + erlang:trace/3 - {drop, N} if ip tracer is used (see dbg:trace_port/2), + {drop, N} if IP tracer is used (see + dbg:trace_port/2) - end_of_trace received once when all trace messages have - been processed. + end_of_trace received once when all trace messages are + processed -

By giving the format handler ttb:get_et_handler(), you can have the trace - log presented graphically with et_viewer in the Event - Tracer application (see Presenting trace logs with Event Tracer). +

By giving the format handler + ttb:get_et_handler(), + you can have the trace + log presented graphically with et_viewer in the ET + application (see section + Presenting Trace Logs with Event Tracer).

-

You may always decide not to format the whole trace data contained - in the fetch directory, but analyze single files instead. In order - to do so, a single file (or list of files) have to be passed as - the first argument to format/1/2.

-

Wrap logs can be formatted one by one or all in one go. To - format one of the wrap logs in a set, give the exact name of the - file. To format the whole set of wrap logs, give the name with '*' - instead of the wrap count. An example: +

You can always decide not to format the whole trace data contained + in the fetch directory, but analyze single files instead. To do so, + a single file (or list of files) must be passed as the first argument + to format/1,2.

+

Wrap logs can be formatted one by one or all at once. To + format one of the wrap logs in a set, specify the exact file name. + To format the whole set of wrap logs, specify the name with * + instead of the wrap count.

+

Example:

Start tracing:

- -(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}). + 
+(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}).
 {ok,[tiger@durin]}
-(tiger@durin)2> ttb:p(...)
-...    
-    
This will give a set of binary logs, like:

+(tiger@durin)2> ttb:p(...)
+...
+

This gives a set of binary logs, for example:

tiger@durin-trace.0.wrp tiger@durin-trace.1.wrp tiger@durin-trace.2.wrp ...

Format the whole set of logs:

- -1> ttb:format("tiger@durin-trace.*.wrp"). + 
+1> ttb:format("tiger@durin-trace.*.wrp").
 ....
 ok
-2>    
+2>

Format only the first log:

- -1> ttb:format("tiger@durin-trace.0.wrp"). + 
+1> ttb:format("tiger@durin-trace.0.wrp").
 ....
 ok
-2>    
+2>

To merge all wrap logs from two nodes:

- -1> ttb:format(["tiger@durin-trace.*.wrp","lion@durin-trace.*.wrp"]). + 
+1> ttb:format(["tiger@durin-trace.*.wrp","lion@durin-trace.*.wrp"]).
 ....
 ok
-2>    
+2>
- Presenting trace logs with Event Tracer -

For detailed information about the Event Tracer, please turn - to the User's Guide and Reference Manuals for the et - application. + Presenting Trace Logs with Event Tracer +

For detailed information about the Event Tracer, see the + ET application.

-

By giving the format handler ttb:get_et_handler(), you can have the - trace log presented graphically with et_viewer in the - Event Tracer application. ttb provides a few different - filters which can be selected from the Filter menu in the - et_viewer window. The filters are names according to the - type of actors they present (i.e. what each vertical line in the - sequence diagram represent). Interaction between actors is shown - as red arrows between two vertical lines, and activities within - an actor are shown as blue text to the right of the actors line. +

By giving the format handler + ttb:get_et_handler(), + you can have the trace log presented graphically with + et_viewer in the ET application. + ttb provides filters that can be selected from the + menu Filter in the et_viewer window. The filters + are names according to the type of actors they present + (that is, what each vertical line in the sequence diagram represents). + Interaction between actors is shown as red arrows between two + vertical lines, and activities within an actor are shown as + blue text to the right of the actors line.

-

The processes filter is the only filter which will - show all trace messages from a trace log. Each vertical line in +

The processes filter is the only filter showing all + trace messages from a trace log. Each vertical line in the sequence diagram represents a process. Erlang messages, - spawn and link/unlink are typical interactions between - processes. Function calls, scheduling and garbage collection are - typical activities within a process. processes is the - default filter. + spawn, and link/unlink are typical interactions between + processes. Function calls, scheduling, and garbage collection, + are typical activities within a process. processes is + the default filter.

-

The rest of the filters will only show function calls and +

The remaining filters only show function calls and function returns. All other trace message are discarded. To get - the most out of these filters, et_viewer needs to known + the most out of these filters, et_viewer must know the caller of each function and the time of return. This can be - obtained by using both the call and return_to - flags when tracing. Note that the return_to flag only - works with local call trace, i.e. when trace patterns are set + obtained using both the call and return_to + flags when tracing. Notice that flag return_to only + works with local call trace, that is, when trace patterns are set with ttb:tpl.

-

The same result can be obtained by using the call flag - only and setting a match specification like this on local or - global function calls:

- -1> dbg:fun2ms(fun(_) -> return_trace(),message(caller()) end). -[{'_',[],[{return_trace},{message,{caller}}]}] -

This should however be done with care, since the - {return_trace} function in the match specification will - destroy tail recursiveness. +

The same result can be obtained by using the flag call + only and setting a match specification on local or + global function calls as follows:

+ 
+1> dbg:fun2ms(fun(_) -> return_trace(),message(caller()) end).
+[{'_',[],[{return_trace},{message,{caller}}]}]
+

This must however be done with care, as function + {return_trace} in the match specification + destroys tail recursiveness.

The modules filter shows each module as a vertical line in the sequence diagram. External function calls/returns - are shown as interactions between modules and internal function + are shown as interactions between modules, and internal function calls/returns are shown as activities within a module.

The functions filter shows each function as a vertical @@ -656,9 +692,9 @@ ok

The mods_and_procs and funcs_and_procs filters are equivalent to the modules and functions filters respectively, except that each module or function can - have several vertical lines, one for each process it resides on. + have many vertical lines, one for each process it resides on.

-

In the next example, modules foo and bar are used:

+

In the following example, modules foo and bar are used:

-module(foo). -export([start/0,go/0]). @@ -673,8 +709,9 @@ go() -> go -> bar:f1(), go() - end. - + end. + + -module(bar). -export([f1/0,f3/0]). f1() -> @@ -685,57 +722,56 @@ f2() -> f3() -> ok. -

Now let's set up the trace.

- -(tiger@durin)1>%%First we retrieve the Pid to limit traced processes set -(tiger@durin)1>Pid = foo:start(). -(tiger@durin)2>%%Now we set up tracing -(tiger@durin)2>ttb:tracer(). -(tiger@durin)3>ttb:p(Pid, [call, return_to, procs, set_on_spawn]). -(tiger@durin)4>ttb:tpl(bar, []). -(tiger@durin)5>%%Invoke our test function and see output with et viewer -(tiger@durin)5>Pid ! go. -(tiger@durin)6>ttb:stop({format, {handler, ttb:get_et_handler()}}). - - -

This should render a result similar to the - following: +

Setting up the trace:

+
+(tiger@durin)1> %%First we retrieve the Pid to limit traced processes set
+(tiger@durin)1> Pid = foo:start().
+(tiger@durin)2> %%Now we set up tracing
+(tiger@durin)2> ttb:tracer().
+(tiger@durin)3> ttb:p(Pid, [call, return_to, procs, set_on_spawn]).
+(tiger@durin)4> ttb:tpl(bar, []).
+(tiger@durin)5> %%Invoke our test function and see output with et viewer
+(tiger@durin)5> Pid ! go.
+(tiger@durin)6> ttb:stop({format, {handler, ttb:get_et_handler()}}).
+ +

This renders a result similar to the following:

-

Filter: "processes" +

Filter: "mods_and_procs" -

Note, that we can use ttb:start_trace/4 function to help - us here:

- -(tiger@durin)1>Pid = foo:start(). -(tiger@durin)2>ttb:start_trace([node()], - [{bar,[]}], - {Pid, [call, return_to, procs, set_on_spawn]} - {handler, ttb:get_et_handler()}). -(tiger@durin)3>Pid ! go. -(tiger@durin)4>ttb:stop(format). - +

Notice that function + ttb:start_trace/4 + can be used as help as follows:

+
+(tiger@durin)1> Pid = foo:start().
+(tiger@durin)2> ttb:start_trace([node()],
+                                [{bar,[]}],
+                                {Pid, [call, return_to, procs, set_on_spawn]}
+                                {handler, ttb:get_et_handler()}).
+(tiger@durin)3> Pid ! go.
+(tiger@durin)4> ttb:stop(format).
- Automatically collect and format logs from all nodes -

By default ttb:stop/1 fetches trace logs and - trace information files from all nodes. The logs are stored in a - new directory named ttb_upload-Filename-Timestamp under the working - directory of the trace control node. Fetching may be disabled by - providing the nofetch option to ttb:stop/1. User can - specify a fetch directory of his choice passing the - {fetch_dir, Dir} option. + Automatically Collect and Format Logs from All Nodes +

By default, + + ttb:stop/1 fetches trace logs + and trace information files from all nodes. The logs are stored in a + new directory named ttb_upload-Filename-Timestamp under the + working directory of the trace control node. Fetching can be disabled + by providing option nofetch to ttb:stop/1. The user can + specify a fetch directory by passing option {fetch_dir, Dir}.

-

If the option format is given to ttb:stop/1, the +

If option format is specified to ttb:stop/1, the trace logs are automatically formatted after tracing is stopped.

@@ -743,116 +779,122 @@ f3() ->
History and Configuration Files -

For the tracing functionality, dbg could be used instead - of the ttb for setting trace flags on processes and trace - patterns for call trace, i.e. the functions p, tp, - tpl, ctp, ctpl and ctpg. There are only - two things added by ttb for these functions:

+

For the tracing functionality, + dbg + can be used instead + of ttb for setting trace flags on processes and trace + patterns for call trace, that is, the functions + p, tp, tpl, ctp, ctpl, and ctpg. Only the + following two things are added by ttb for these functions:

- all calls are stored in the history buffer and can be + All calls are stored in the history buffer and can be recalled and stored in a configuration file. This makes it - easy to setup the same trace environment e.g. if you want to - compare two test runs. It also reduces the amount of - typing when using ttb from the erlang shell; - shortcuts are provided for the most common match - specifications (in order not to force the user to use - dbg:fun2ms continually). + easy to set up the same trace environment, for example, if you + want to compare two test runs. It also reduces the amount of + typing when using ttb from the Erlang shell. + Shortcuts are provided for the most common match + specifications (to not force you to use + dbg:fun2ms + continually). -

Use list_history/0 to see the content of the history - buffer, and run_history/1 to re-execute one of the entries. +

Use + ttb:list_history/0 + to see the content of the history buffer and + ttb:run_history/1 + to re-execute one of the entries.

The main purpose of the history buffer is the possibility to create configuration files. Any function stored in the history buffer can be written to a configuration file and used for - creating a specific configuration at any time with one single + creating a specific configuration at any time with a single function call.

A configuration file is created or extended with - write_config/2/3. Configuration files are binary files + ttb:write_config/2,3. + Configuration files are binary files and can therefore only be read and written with functions provided by ttb.

-

You can write the complete content of the history buffer to a - config file by calling - ttb:write_config(ConfigFile,all). And you can write - selected entries from the history by calling +

The complete content of the history buffer can be written to a + configuration file by calling + ttb:write_config(ConfigFile,all). Selected entries from + the history can be written by calling ttb:write_config(ConfigFile,NumList), where NumList is a list of integers pointing out the history entries to write. Moreover, the history buffer is always dumped - to ttb_last_config when ttb:stop/0/1 is called. + to ttb_last_config when ttb:stop/0,1 is called.

-

User defined entries can also be written to a config file by - calling the function - ttb:write_config(ConfigFile,ConfigList) where +

User-defined entries can also be written to a configuration file + by calling function + ttb:write_config(ConfigFile,ConfigList), where ConfigList is a list of {Module,Function,Args}.

Any existing file ConfigFile is deleted and a new file - is created when write_config/2 is called. The option - append can be used if you wish to add something at the end - of an existing config file, e.g. + is created when write_config/2 is called. Option + append can be used to add something at the end + of an existing configuration file, for example, ttb:write_config(ConfigFile,What,[append]).

-
- Example: History and configuration files -

See the content of the history buffer

- ttb:tracer(). +

Example:

+

See the content of the history buffer:

+ 
+(tiger@durin)191> ttb:tracer().
 {ok,[tiger@durin]}
-(tiger@durin)192> ttb:p(self(),[garbage_collection,call]).               
-{ok,{[<0.1244.0>],[garbage_collection,call]}}
-(tiger@durin)193> ttb:tp(ets,new,2,[]).                                  
+(tiger@durin)192> ttb:p(self(),[garbage_collection,call]).
+{ok,{[<0.1244.0>],[garbage_collection,call]}}
+(tiger@durin)193> ttb:tp(ets,new,2,[]).
 {ok,[{matched,1}]}
-(tiger@durin)194> ttb:list_history().
+(tiger@durin)194> ttb:list_history().
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
- {3,{ttb,tp,[ets,new,2,[]]}}]      ]]>
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {3,{ttb,tp,[ets,new,2,[]]}}]

Execute an entry from the history buffer:

- ttb:ctp(ets,new,2). + 
+(tiger@durin)195> ttb:ctp(ets,new,2).
 {ok,[{matched,1}]}
-(tiger@durin)196> ttb:list_history().
+(tiger@durin)196> ttb:list_history().
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
  {3,{ttb,tp,[ets,new,2,[]]}},
  {4,{ttb,ctp,[ets,new,2]}}]
-(tiger@durin)197> ttb:run_history(3).
+(tiger@durin)197> ttb:run_history(3).
 ttb:tp(ets,new,2,[]) ->
-{ok,[{matched,1}]}      ]]>
+{ok,[{matched,1}]}

Write the content of the history buffer to a configuration file:

- ttb:write_config("myconfig",all). + 
+(tiger@durin)198> ttb:write_config("myconfig",all).
 ok
-(tiger@durin)199> ttb:list_config("myconfig").
+(tiger@durin)199> ttb:list_config("myconfig").
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
  {3,{ttb,tp,[ets,new,2,[]]}},
  {4,{ttb,ctp,[ets,new,2]}},
- {5,{ttb,tp,[ets,new,2,[]]}}]      ]]>
+ {5,{ttb,tp,[ets,new,2,[]]}}]

Extend an existing configuration:

- ttb:write_config("myconfig",[{ttb,tp,[ets,delete,1,[]]}], -[append]). + 
+(tiger@durin)200> ttb:write_config("myconfig",[{ttb,tp,[ets,delete,1,[]]}],
+[append]).
 ok
-(tiger@durin)201> ttb:list_config("myconfig").
+(tiger@durin)201> ttb:list_config("myconfig").
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
  {3,{ttb,tp,[ets,new,2,[]]}},
  {4,{ttb,ctp,[ets,new,2]}},
  {5,{ttb,tp,[ets,new,2,[]]}},
- {6,{ttb,tp,[ets,delete,1,[]]}}]      ]]>
+ {6,{ttb,tp,[ets,delete,1,[]]}}]

Go back to a previous configuration after stopping Trace Tool Builder:

- ttb:stop(). + 
+(tiger@durin)202> ttb:stop().
 ok
-(tiger@durin)203> ttb:run_config("myconfig").
+(tiger@durin)203> ttb:run_config("myconfig").
 ttb:tracer(tiger@durin,[]) ->
 {ok,[tiger@durin]}
 
-ttb:p(<0.1244.0>,[garbage_collection,call]) ->
-{ok,{[<0.1244.0>],[garbage_collection,call]}}
+ttb:p(<0.1244.0>,[garbage_collection,call]) ->
+{ok,{[<0.1244.0>],[garbage_collection,call]}}
 
 ttb:tp(ets,new,2,[]) ->
 {ok,[{matched,1}]}
@@ -866,133 +908,135 @@ ttb:tp(ets,new,2,[]) ->
 ttb:tp(ets,delete,1,[]) ->
 {ok,[{matched,1}]}
 
-ok      ]]>
+ok

Write selected entries from the history buffer to a configuration file:

- ttb:list_history(). + 
+(tiger@durin)204> ttb:list_history().
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
  {3,{ttb,tp,[ets,new,2,[]]}},
  {4,{ttb,ctp,[ets,new,2]}},
  {5,{ttb,tp,[ets,new,2,[]]}},
  {6,{ttb,tp,[ets,delete,1,[]]}}]
-(tiger@durin)205> ttb:write_config("myconfig",[1,2,3,6]).
+(tiger@durin)205> ttb:write_config("myconfig",[1,2,3,6]).
 ok
-(tiger@durin)206> ttb:list_config("myconfig").
+(tiger@durin)206> ttb:list_config("myconfig").
 [{1,{ttb,tracer,[tiger@durin,[]]}},
- {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
+ {2,{ttb,p,[<0.1244.0>,[garbage_collection,call]]}},
  {3,{ttb,tp,[ets,new,2,[]]}},
  {4,{ttb,tp,[ets,delete,1,[]]}}]
-(tiger@durin)207>       ]]>
-
+(tiger@durin)207>
Sequential Tracing

To learn what sequential tracing is and how it can be used, - please turn to the reference manual for the - seq_trace module in the kernel - application. + see the Reference Manual for + seq_trace.

-

The support for sequential tracing provided by the Trace Tool - Builder includes

+

The support for sequential tracing provided by Trace Tool + Builder includes the following:

Initiation of the system tracer. This is automatically - done when a trace port is started with ttb:tracer/0/1/2 - Creation of match specifications which activates - sequential tracing + done when a trace port is started with + ttb:tracer/0,1,2. + Creation of match specifications that activates + sequential tracing. -

Starting sequential tracing requires that a tracer has been - started with the ttb:tracer/0/1/2 function. Sequential - tracing can then either be started via a trigger function with a - match specification created with ttb:seq_trigger_ms/0/1, - or directly by using the seq_trace module in the - kernel application. +

Starting sequential tracing requires that a tracer is + started with function ttb:tracer/0,1,2. Sequential + tracing can then be started in either of the following ways:

+ + Through a trigger function with a match specification + created with + ttb:seq_trigger_ms/0,1. + Directly by using module + seq_trace. + -
- Example: Sequential tracing -

In the following example, the function +

Example 1:

+

In the following example, function dbg:get_tracer/0 is used as trigger for sequential tracing:

- ttb:tracer(). + 
+(tiger@durin)110> ttb:tracer().
 {ok,[tiger@durin]}
-(tiger@durin)111> ttb:p(self(),call).                               
-{ok,{[<0.158.0>],[call]}}
-(tiger@durin)112> ttb:tp(dbg,get_tracer,0,ttb:seq_trigger_ms(send)).
+(tiger@durin)111> ttb:p(self(),call).
+{ok,{[<0.158.0>],[call]}}
+(tiger@durin)112> ttb:tp(dbg,get_tracer,0,ttb:seq_trigger_ms(send)).
 {ok,[{matched,1},{saved,1}]}
-(tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace().         
+(tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace().
 true
-(tiger@durin)114> ttb:stop(format).
-({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer()
-SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) 
-{<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} 
+(tiger@durin)114> ttb:stop(format).
+({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer()
+SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin})
+{<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}}
 [Serial: {0,1}]
-SeqTrace [0]: ({<0.237.0>,dbg,tiger@durin}) 
-{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.222>}} 
+SeqTrace [0]: ({<0.237.0>,dbg,tiger@durin})
+{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.222>}}
 [Serial: {1,2}]
 ok
-(tiger@durin)116>       ]]>
-      
Starting sequential tracing with a trigger is actually more
+(tiger@durin)116>
+

Example 2:

+

Starting sequential tracing with a trigger is more useful if the trigger function is not called directly from the shell, but rather implicitly within a larger system. When calling a function from the shell, it is simpler to start - sequential tracing directly, e.g.

- ttb:tracer(). + sequential tracing directly, for example, as follows:

+ 
+(tiger@durin)116> ttb:tracer().
 {ok,[tiger@durin]}
-(tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(), 
-seq_trace:reset_trace().
+(tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(),
+seq_trace:reset_trace().
 true
-(tiger@durin)118> ttb:stop(format).
-SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) 
-{<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} 
+(tiger@durin)118> ttb:stop(format).
+SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin})
+{<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}}
 [Serial: {0,1}]
-SeqTrace [0]: ({<0.246.0>,dbg,tiger@durin}) 
-{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.229>}} 
+SeqTrace [0]: ({<0.246.0>,dbg,tiger@durin})
+{<0.158.0>,{shell,evaluator,3},tiger@durin} ! {dbg,{ok,#Port<0.229>}}
 [Serial: {1,2}]
 ok
-(tiger@durin)120>       ]]>
-      
In both examples above, the seq_trace:reset_trace/0
-        resets the trace token immediately after the traced function in
-        order to avoid lots of trace messages due to the printouts in
-        the erlang shell.
+(tiger@durin)120>
+

In both previous examples, seq_trace:reset_trace/0 + resets the trace token immediately after the traced function + to avoid many trace messages because of the printouts in + the Erlang shell.

-

All functions in the seq_trace module, except - set_system_tracer/1, can be used after the trace port has - been started with ttb:tracer/0/1/2. +

All functions in module seq_trace, except + set_system_tracer/1, can be used after the trace port + is started with ttb:tracer/0,1,2.

-
- Example: Multipurpose trace tool -

The module multitrace.erl which can be found in the - src directory of the Observer application implements a + Multipurpose Trace Tool +

Module multitrace in + directory src of the Observer application provides a small tool with three possible trace settings. The trace messages - are written to binary files which can be formatted with the - function multitrace:format/1/2. + are written to binary files, which can be formatted with + function multitrace:format/1,2:

- multitrace:debug(What) - Start calltrace on all processes and trace the given + multitrace:debug(What) +

Start calltrace on all processes and trace the specified function(s). The format handler used is - multitrace:handle_debug/4 which prints each call and - return. What must be an item or a list of items to trace, - given on the format {Module,Function,Arity}, - {Module,Function} or just Module. - multitrace:gc(Procs) - Trace garbage collection on the given process(es). The - format handler used is multitrace:handle_gc/4 which - prints start and stop and the time spent for each GC. - multitrace:schedule(Procs) - Trace in- and out-scheduling on the given process(es). The - format handler used is multitrace:handle_schedule/4 which - prints each in and out scheduling with process, timestamp and + multitrace:handle_debug/4 that prints each call and + returns. What must be an item or a list of items to trace, + specified on the format {Module,Function,Arity}, + {Module,Function}, or only Module.

 + multitrace:gc(Procs) +

Trace garbage collection on the specified process(es). The + format handler used is multitrace:handle_gc/4 that + prints start, stop, and the time spent for each garbage collection.

 + multitrace:schedule(Procs) +

Trace in-scheduling and out-scheduling on the specified process(es). + The format handler used is multitrace:handle_schedule/4 that + prints each in-scheduling and out-scheduling with process, time-stamp, and current function. It also prints the total time each traced - process was scheduled in. + process was scheduled in.
-- cgit v1.2.3 From 2a43b90eadcbce8763c84d2692e89f5e7a1ec150 Mon Sep 17 00:00:00 2001 From: xsipewe Date: Mon, 14 Dec 2015 10:01:25 +0100 Subject: debugger: Editorial changes in documentation --- lib/debugger/doc/src/book.xml | 1 - lib/debugger/doc/src/debugger.xml | 26 +- lib/debugger/doc/src/debugger_chapter.xml | 858 +++++++++++++++--------------- lib/debugger/doc/src/i.xml | 138 +++-- lib/debugger/doc/src/int.xml | 334 ++++++------ lib/debugger/doc/src/introduction.xml | 63 +++ lib/debugger/doc/src/part.xml | 12 +- lib/debugger/doc/src/ref_man.xml | 7 +- 8 files changed, 743 insertions(+), 696 deletions(-) create mode 100644 lib/debugger/doc/src/introduction.xml diff --git a/lib/debugger/doc/src/book.xml b/lib/debugger/doc/src/book.xml index 071a04eb61..5424ef2c04 100644 --- a/lib/debugger/doc/src/book.xml +++ b/lib/debugger/doc/src/book.xml @@ -47,4 +47,3 @@ - diff --git a/lib/debugger/doc/src/debugger.xml b/lib/debugger/doc/src/debugger.xml index 15d498d5ae..1ecdbcd064 100644 --- a/lib/debugger/doc/src/debugger.xml +++ b/lib/debugger/doc/src/debugger.xml @@ -4,7 +4,7 @@
- 20022013 + 20022016 Ericsson AB. All Rights Reserved. @@ -29,7 +29,7 @@
debugger - Erlang Debugger + Erlang Debugger.

Erlang Debugger for debugging and testing of Erlang programs.

 @@ -48,14 +48,14 @@

Starts Debugger.

-

If given a file name as argument, Debugger will try to load - its settings from this file. Refer to Debugger User's Guide - for more information about settings.

+

If a filename is specified as argument, Debugger tries to load + its settings from this file. For details about settings, see + the User's Guide.

-

If given local as argument, Debugger will interpret - code only at the current node. If given global as - argument, Debugger will interpret code at all known nodes, - this is the default.

+

If local is specified as argument, Debugger interprets + code only at the current node. If global is specified as + argument, Debugger interprets code at all known nodes, this + is the default.

 @@ -67,11 +67,9 @@ Args = [term()] -

This function can be used to debug a single process. - The module Module is interpreted and - apply(Module,Name,Args) is called. This will open an - Attach Process window, refer to Debugger User's Guide for - more information.

+

Debugs a single process. The module Module is interpreted + and apply(Module,Name,Args) is called. This opens an + Attach Process window. For details, see the User's Guide.

 diff --git a/lib/debugger/doc/src/debugger_chapter.xml b/lib/debugger/doc/src/debugger_chapter.xml index 98fe4ae377..45dfdb3776 100644 --- a/lib/debugger/doc/src/debugger_chapter.xml +++ b/lib/debugger/doc/src/debugger_chapter.xml @@ -4,7 +4,7 @@
- 19972013 + 19972016 Ericsson AB. All Rights Reserved. @@ -31,97 +31,92 @@
- Introduction + Getting Started -

Debugger is a graphical user interface for the Erlang - interpreter, which can be used for debugging and testing of - Erlang programs. For example, breakpoints can be set, code can be - single stepped and variable values can be displayed and changed. -

+

To use Debugger, the basic steps are as follows:

-

The Erlang interpreter can also be accessed via the interface - module int, see int(3). -

+

Step 1. Start Debugger by calling + debugger:start().

-

Warning: Note that the Debugger at some point might - start tracing on the processes which execute the interpreted - code. This means that a conflict will occur if tracing by other - means is started on any of these processes.

-
+

The Monitor window is + displayed with information about all debugged processes, + interpreted modules, and selected options. Initially there are + normally no debugged processes. First, it must be specified which + modules that are to be debugged (also called + interpreted). Proceed as follows:

-
- Getting Started with Debugger +

Step 2. Select Module > Interpret... in the + Monitor window.

-

Start Debugger by calling debugger:start(). It will start - the Monitor window showing - information about all debugged processes, interpreted modules and - selected options.

+

The Interpret Modules window + is displayed.

-

Initially there are normally no debugged processes. First, it - must be specified which modules should be debugged, or - interpreted as it is also called. This is done by - choosing Module->Interpret... in the Monitor window and - then selecting the appropriate modules from the - Interpret Dialog window. -

+

Step 3. Select the appropriate modules from the Interpret + Dialog window.

-

Only modules compiled with the option debug_info set - can be interpreted. Non-interpretable modules are shown within - parenthesis in the Interpret Dialog window.

+

Only modules compiled with option debug_info set can be + interpreted. Non-interpretable modules are displayed within + parenthesis in the Interpret Modules window.

 -

When a module is interpreted, it can be viewed in a - View Module window. This is done - by selecting the module from the Module->module->View - menu. The contents of the source file is shown and it is possible - to set breakpoints.

- -

Now the program that should be debugged can be started. This is - done the normal way from the Erlang shell. All processes executing - code in interpreted modules will be displayed in the Monitor - window. It is possible to attach to one of these - processes, by double-clicking it, or by selecting the process and - then choosing Process->Attach.

- -

Attaching to a process will result in a - Attach Process window being - opened for this process. From the Attach Process window, it is - possible to control the process execution, inspect variable - values, set breakpoints etc.

+

Step 4. In the Monitor window, select + Module > the module to be interpreted > View.

+ +

The contents of the source file is displayed in the + View Module window.

+ +

Step 5. Set the + breakpoints, if any.

+ +

Step 6. Start the program to be debugged. This is done + the normal way from the Erlang shell.

+ +

All processes executing code in interpreted modules are displayed + in the Monitor window.

+ +

Step 7. To attach to one of these processes, + double-click it, or select the process and then choose + Process > Attach. Attaching to a process opens an + Attach Process window for this + process.

+ +

Step 8. From the Attach Process window, you can control + the process execution, inspect variable values, set breakpoints, + and so on.

- Breakpoints and Break Dialogue Windows + Breakpoints and Break Dialog Windows

Once the appropriate modules are interpreted, breakpoints can be set at relevant locations in the source code. Breakpoints are specified on a line basis. When a process reaches a breakpoint, - it stops and waits for commands (step, skip, continue,...) from - the user.

+ it stops and waits for commands (Step, Skip, + Continue ...) from the user.

When a process reaches a breakpoint, only that process is - stopped. Other processes are not affected.

+ stopped. Other processes are not affected.

 -

Breakpoints are created and deleted using the Break menu of - the Monitor window, View Module window and Attach Process window. -

+

Breakpoints are created and deleted using the Break menu of + either the Monitor window, View Module window, or Attach Process + window.

Executable Lines -

To have effect, a breakpoint must be set at an - executable line, which is a line of code containing an - executable expression such as a matching or a function call. - A blank line or a line containing a comment, function head or - pattern in a case- or receive statement is not - executable.

+

To have an effect, a breakpoint must be set at an + executable line, which is a line of code containing an + executable expression such as a matching or a function call. + A blank line or a line containing a comment, function head, or + pattern in a case statement or receive statement is not + executable.

-

In the example below, lines number 2, 4, 6, 8 and 11 are - executable lines:

+

In the following example, lines 2, 4, 6, 8, and 11 are + executable lines:

 1: is_loaded(Module,Compiled) ->
 2:   case get_file(Module,Compiled) of
@@ -141,17 +136,15 @@
       Status and Trigger Action
 
       
A breakpoint can be either active or
-	inactive. Inactive breakpoints are ignored.

-
-      
Each breakpoint has a trigger action which specifies
-	what should happen when a process has reached it (and stopped):
-      

-      
-	enable Breakpoint should remain active (default).
-	
-	disable Breakpoint should be made inactive.
-	
-	delete Breakpoint should be deleted.
+        inactive. Inactive breakpoints are ignored.

+
+      
Each breakpoint has a trigger action that specifies
+        what is to happen when a process has reached it (and stopped):

+      
+        Enable - Breakpoint is to remain active (default).
+        
+        Disable - Breakpoint is to be made inactive.
+        Delete - Breakpoint is to be deleted.
@@ -161,54 +154,56 @@

A line breakpoint is created at a certain line in a module.

- The Line Break Dialog Window. + Line Break Dialog Window -

Right-clicking the Module entry will open a popup menu from - which the appropriate module can be selected.

+

Right-click the Module entry to open a popup menu from + which the appropriate module can be selected.

-

A line breakpoint can also be created (and deleted) by - double-clicking the line when the module is displayed in - the View Module or Attach Process window.

+

A line breakpoint can also be created (and deleted) by + double-clicking the line when the module is displayed in + the View Module window or Attach Process window.

Conditional Breakpoints

A conditional breakpoint is created at a certain line in - the module, but a process reaching the breakpoint will stop - only if a given condition is true.

+ the module, but a process reaching the breakpoint stops + only if a specified condition is true.

The condition is specified by the user as a module name - CModule and a function name CFunction. When a - process reaches the breakpoint, - CModule:CFunction(Bindings) will be evaluated. If and - only if this function call returns true, the process - will stop. If the function call returns false, - the breakpoint will be silently ignored.

- -

Bindings is a list of variable bindings. Use - the function int:get_binding(Variable,Bindings) to - retrieve the value of Variable (given as an atom). - The function returns unbound or {value,Value}.

+ CModule and a function name CFunction. When a + process reaches the breakpoint, + CModule:CFunction(Bindings) is evaluated. If and + only if this function call returns true, the process + stops. If the function call returns false, + the breakpoint is silently ignored.

+ +

Bindings is a list of variable bindings. To retrieve the + value of Variable (given as an atom), use function + int:get_binding(Variable,Bindings). + The function returns unbound or {value,Value}.

- The Conditional Break Dialog Window. + Conditional Break Dialog Window -

Right-clicking the Module entry will open a popup menu from - which the appropriate module can be selected.

+

Right-click the Module entry to open a popup menu from + which the appropriate module can be selected.

-

Example: A conditional breakpoint calling - c_test:c_break/1 is added at line 6 in the module +

Example:

+ +

A conditional breakpoint calling + c_test:c_break/1 is added at line 6 in module fact. Each time the breakpoint is reached, the function is - called, and when N is equal to 3 it returns true, - and the process stops.

- + called. When N is equal to 3, the function returns + true and the process stops.

+

Extract from fact.erl:

-5.   fac(0) -> 1;
-6.   fac(N) when N > 0, is_integer(N) -> N * fac(N-1).
+5. fac(0) -> 1; +6. fac(N) when N > 0, is_integer(N) -> N * fac(N-1).

Definition of c_test:c_break/1:

@@ -228,18 +223,18 @@ c_break(Bindings) ->
       Function Breakpoints
 
       
A function breakpoint is a set of line breakpoints, one at
-	the first line of each clause in the given function.

+        the first line of each clause in the specified function.

 
       
-	The Function Break Dialog Window.
+        Function Break Dialog Window
       
 
-      
Right-clicking the Module entry will open a popup menu from
-	which the appropriate module can be selected.

+      
To open a popup menu from which the appropriate module can be
+        selected, right-click the Module entry.

 
-      
Clicking the Ok button (or 'Return' or 'Tab') when a module
-	name has been given, will bring up all functions of the module
-	in the listbox.

+      
To bring up all functions of the module in the listbox,
+        click the OK button (or press the Return
+        or Tab key) when a module name has been specified,.
@@ -249,7 +244,7 @@ c_break(Bindings) ->

The Erlang emulator keeps track of a stack trace, information about recent function calls. This information is - used, for example, if an error occurs:

+ used if an error occurs, for example:

 1> catch a+1.
 {'EXIT',{badarith,[{erlang,'+',[a,1],[]},
@@ -259,602 +254,597 @@ c_break(Bindings) ->
                    {shell,eval_exprs,7,[{file,"shell.erl"},{line,629}]},
                    {shell,eval_loop,3,[{file,"shell.erl"},{line,614}]}]}}
-

See the Erlang Reference Manual, - - Errors and Error Handling, - for more information about the stack trace.

+

For details about the stack trace, see section + Errors and Error Handling + in the Erlang Reference Manual.

-

The Debugger emulates the stack trace by keeping track of recently +

Debugger emulates the stack trace by keeping track of recently called interpreted functions. (The real stack trace cannot be - used, as it shows which functions of the Debugger have been - called, rather than which interpreted functions).

+ used, as it shows which functions of Debugger have been + called, rather than which interpreted functions.)

This information can be used to traverse the chain of function - calls, using the 'Up' and 'Down' buttons of - the Attach Process window. -

+ calls, using the Up and Down buttons in the + Attach Process window.

-

By default, the Debugger only saves information about recursive +

By default, Debugger only saves information about recursive function calls, that is, function calls that have not yet returned - a value (option 'Stack On, No Tail').

+ a value (option Stack On, No Tail).

Sometimes, however, it can be useful to save all calls, even - tail-recursive calls. That can be done with the 'Stack On, Tail' - option. Note that this option will consume more memory and slow - down execution of interpreted functions when there are many - tail-recursive calls. -

- -

It is also possible to turn off the Debugger stack trace - facility ('Stack Off'). Note: If an error occurs, in this - case the stack trace will be empty.

- -

See the section about the Monitor - Window for information about how to change the stack - trace option.

+ tail-recursive calls. This is done with option + Stack On, Tail. Notice that this option consumes more + memory and slows down execution of interpreted functions when there + are many tail-recursive calls.

+ +

To turn off the Debugger stack trace facility, select option + Stack Off.

+ + +

If an error occurs, the stack trace becomes empty in this + case.

+ + +

For information about how to change the stack trace option, see + section Monitor Window.

- The Monitor Window + Monitor Window + +

The Monitor window is the main window of Debugger and displays the + following:

-

The Monitor window is the main window of Debugger and shows a - listbox containing the names of all interpreted modules - (double-clicking a module brings up the View Module window), - which options are selected, and information about all debugged - processes, that is all processes which have been/are executing - code in interpreted modules.

+ +

A listbox containing the names of all interpreted + modules

+

Double-clicking a module brings up the View Module window.

+ +

Which options are selected

 +

Information about all debugged processes, that is, all + processes that have been or are executing code in interpreted + modules

 + - The Monitor Window. + Monitor Window -

The Auto Attach buttons, Stack Trace label, Back Trace Size - label, and Strings button show some options set, see - Options Menu for further - information about these options.

+

The Auto Attach boxes, Stack Trace label, + Back Trace Size label, and Strings box display + some options set. For details about these options, see section + Options Menu.

Process Grid - Pid

The process identifier.

 - + Initial Call

The first call to an interpreted function by this - process. (Module:Function/Arity)

 + process. (Module:Function/Arity)

Name -

The registered name, if any. If a registered name does - not show up, it may be that the Debugger received - information about the process before the name had been - registered. Try selecting Edit->Refresh.

 +

The registered name, if any. If a registered name is not + displayed, it can be that Debugger received information about + the process before the name was registered. Try selecting + Edit > Refresh.

 Status

The current status, one of the following:

idle -

The interpreted function call has returned a value, - and the process is no longer executing interpreted code. -

+

The interpreted function call has returned a value, and + the process is no longer executing interpreted code.

 running

The process is running.

 - + waiting

The process is waiting in a receive - statement.

 - + statement.

 + break

The process is stopped at a breakpoint.

 - + exit

The process has terminated.

 - + no_conn

There is no connection to the node where - the process is located.

 + the process is located.

 Information -

Additional information, if any. If the process is - stopped at a breakpoint, the field contains information - about the location {Module,Line}. If the process has - terminated, the field contains the exit reason.

 +

More information, if any. If the process is + stopped at a breakpoint, the field contains information + about the location {Module,Line}. If the process has + terminated, the field contains the exit reason.
- The File Menu - + File Menu + Load Settings... - -

Try to load and restore Debugger settings from a file - previously saved using Save Settings..., see below. - Any errors are silently ignored. - Note: Settings saved by Erlang R16B01 or later - cannot be read by Erlang R16B or earlier.

+

Tries to load and restore Debugger settings from a file + previously saved using Save Settings... (see below). + Any errors are silently ignored.

+

Notice that settings saved by Erlang/OTP R16B01 or later + cannot be read by Erlang/OTP R16B or earlier.

 - + Save Settings... -

Save Debugger settings to a file. The settings include - the set of interpreted files, breakpoints, and the selected - options. The settings can be restored in a later Debugger - session using Load Settings..., see above. - Any errors are silently ignored.

+

Saves Debugger settings to a file. The settings include + the set of interpreted files, breakpoints, and the selected + options. The settings can be restored in a later Debugger + session using Load Settings... (see above). + Any errors are silently ignored.

 - + Exit -

Stop Debugger.

 +

Stops Debugger.
- The Edit Menu + Edit Menu Refresh -

Update information about debugged processes. Removes - information about all terminated processes from the window, - and also closes all Attach Process windows for terminated - processes.

 +

Updates information about debugged processes. Information + about all terminated processes are removed from the window. All + Attach Process windows for terminated processes are closed.

 Kill All -

Terminate all processes listed in the window using - exit(Pid,kill).

 +

Terminates all processes listed in the window using + exit(Pid,kill).
- The Module Menu + Module Menu Interpret... -

Open the Interpret Dialog - window where new modules to be interpreted can - be specified.

 - +

Opens the + Interpret Modules window, + where new modules to be interpreted can be specified.

 + Delete All -

Stop interpreting all modules. Processes executing in - interpreted modules will terminate.

 +

Stops interpreting all modules. Processes executing in + interpreted modules terminate.

For each interpreted module, a corresponding entry is added to - the Module menu, with the following submenu:

+ the Module menu, with the following submenu:

Delete -

Stop interpreting the selected module. Processes - executing in this module will terminate.

 - +

Stops interpreting the selected module. Processes + executing in this module terminate.

 + View -

Open a View Module - window showing the contents of the selected - module.

 +

Opens a + View Module window, displaying the + contents of the selected module.
- The Process Menu + Process Menu

The following menu items apply to the currently selected - process, provided it is stopped at a breakpoint. See the chapter - about the Attach Process - window for more information.

+ process, provided it is stopped at a breakpoint (for details, see + section + Attach Process window):

Step Next Continue Finish +

The following menu items apply to the currently selected - process.

+ process:

Attach -

Attach to the process and open a - Attach Process window. -

- +

Attaches to the process and open an + Attach Process window.

 + Kill -

Terminate the process using exit(Pid,kill).

- +

Terminates the process using exit(Pid,kill).
-
- The Break Menu -

The items in this menu are used to create and delete - breakpoints. - See the Breakpoints - chapter for more information.

+
+ Break Menu +

The items in this menu are used to create and delete breakpoints. + For details, see section + Breakpoints.

+ Line Break... -

Set a line breakpoint.

 +

Sets a line breakpoint.

 Conditional Break... -

Set a conditional breakpoint.

 +

Sets a conditional breakpoint.

 Function Break... -

Set a function breakpoint.

 +

Sets a function breakpoint.

 Enable All -

Enable all breakpoints.

 +

Enables all breakpoints.

 Disable All -

Disable all breakpoints.

 +

Disables all breakpoints.

 - Delete All -

Remove all breakpoints.

 + Delete All +

Removes all breakpoints.

 -

For each breakpoint, a corresponding entry is added to - the Break - menu, from which it is possible to disable/enable or delete - the breakpoint, and to change its trigger action.

+

For each breakpoint, a corresponding entry is added to the + Break menu, from which it is possible to disable, enable, + or delete the breakpoint, and to change its trigger action.

- The Options Menu + Options Menu Trace Window -

Set which areas should be visible in - an Attach Process - window. Does not affect already existing - Attach Process windows.

+

Sets the areas to be visible in an + Attach Process window. + Does not affect existing Attach Process windows.

 Auto Attach -

Set at which events a debugged process should be - automatically attached to. Affects existing debugged - processes.

- - First Call - the first time a process calls a - function in an interpreted module. - On Exit - at process termination. - On Break - when a process reaches a - breakpoint. +

Sets the events a debugged process is to be attached + to automatically. Affects existing debugged processes.

+ +

First Call - The first time a process calls + a function in an interpreted module.

 +

On Exit - At process termination.

 +

On Break - When a process reaches a + breakpoint.

 Stack Trace -

Set stack trace option, see section +

Sets the stack trace option, see section Stack Trace. Does not - affect already existing debugged processes.

- - Stack On, Tail - save information about all - current calls. - Stack On, No Tail - save information about + affect existing debugged processes.

+ +

Stack On, Tail - Saves information about all + current calls.

 +

Stack On, No Tail - Saves information about current calls, discarding previous information when a tail - recursive call is made. - Stack Off - do not save any information about - current calls. + recursive call is made.

 +

Stack Off - Does not save any information about + current calls.

 Strings -

Set which integer lists should be printed as strings. - Does not affect already existing debugged processes.

- - - Use range of +pc flag - use the printable - character range set by the - - erl(1) flag +pc. - +

Sets the integer lists to be printed as strings. + Does not affect existing debugged processes.

+ +

Use range of +pc flag - Uses the printable + character range set by the erl(1) flag + +pc.

+ Back Trace Size... -

Set how many call frames should be fetched when - inspecting the call stack from the Attach Process window. - Does not affect already existing Attach Process windows.

+

Sets how many call frames to be fetched when + inspecting the call stack from the Attach Process window. + Does not affect existing Attach Process windows.
- The Windows Menu + Windows Menu

Contains a menu item for each open Debugger window. Selecting - one of the items will raise the corresponding window.

+ one of the items raises the corresponding window.

- The Help Menu + Help Menu Help -

View the Debugger documentation. Currently this - function requires a web browser to be up and running.

 +

Shows the Debugger documentation. This function requires a + web browser.
- +
- The Interpret Dialog Window + Interpret Modules Window -

The interpret dialog module is used for selecting which modules - to interpret. Initially, the window shows the modules (erl - files) and subdirectories of the current working directory.

+

The Interpret Modules window is used for selecting which modules + to interpret. Initially, the window displays the modules (erl + files) and subdirectories of the current working directory.

-

Interpretable modules are modules for which a BEAM file, compiled - with the option debug_info set, can be found in the same +

Interpretable modules are modules for which a .beam file, + compiled with option debug_info set, is located in the same directory as the source code, or in an ebin directory next to it.

-

Modules, for which the above requirements are not fulfilled, are - not interpretable and are therefore displayed within parentheses. -

+

Modules for which these requirements are not fulfilled are + not interpretable and are therefore displayed within parentheses.

-

The debug_info option causes debug information or - abstract code to be added to the BEAM file. This will - increase the size of the file, and also makes it possible to +

Option debug_info causes debug information or + abstract code to be added to the .beam file. + This increases the file size and makes it possible to reconstruct the source code. It is therefore recommended not to include debug information in code aimed for target systems.

An example of how to compile code with debug information using - erlc:
- % erlc +debug_info module.erl

- + erlc:

+ 
+% erlc +debug_info module.erl
+

An example of how to compile code with debug information from - the Erlang shell:
- 4> c(module, debug_info).

- + the Erlang shell:

+ 
+4> c(module, debug_info).
+ - The Interpret Dialog Window. + Interpret Modules Window -

Browse the file hierarchy and interpret the appropriate modules - by selecting a module name and pressing Choose (or - carriage return), or by double clicking the module name. - Interpreted modules have the type erl src. -

+

To browse the file hierarchy and interpret the appropriate modules, + either select a module name and click Choose (or + press carriage return), or double-click the module name. + Interpreted modules have the type erl src.

-

Pressing All will interpret all displayed modules in - the chosen directory.

+

To interpret all displayed modules in the chosen directory, click + All.

-

Pressing Done will close the window.

+

To close the window, click Done.

-

When the Debugger is started in global mode (which is - the default, see - debugger:start/0), - modules added (or deleted) for interpretation will be added (or - deleted) on all known Erlang nodes.

+

When Debugger is started in global mode (which is the default, see + debugger:start/0), + modules added (or deleted) for interpretation are added (or + deleted) on all known Erlang nodes.
- The Attach Process Window + Attach Process Window -

From an Attach Process window the user can interact with a +

From an Attach Process window, you can interact with a debugged process. One window is opened for each process that has - been attached to. Note that when attaching to a process, its - execution is automatically stopped. -

+ been attached to. Notice that when attaching to a process, its + execution is automatically stopped.

- The Attach Process Window. + Attach Process Window -

The window is divided into five parts:

- -

The Code area, showing the code being executed. The code - is indented and each line is prefixed with its line number. - If the process execution is stopped, the current line is - marked with -->. An existing break point at a line - is marked with a stop symbol. In the example above, - the execution has been stopped at line 6, before - the execution of fac/1.

-

Active breakpoints are shown in red, while inactive - breakpoints are shown in blue.

+

The window is divided into the following five parts:

+ +

The Code area, displaying the code being executed. The code + is indented and each line is prefixed with its line number. + If the process execution is stopped, the current line is + marked with -->. An existing break point at a line + is marked with a stop symbol. In the example shown in the + illustration, the execution stopped at line 6, before + the execution of fac/1.

+ +

Active breakpoints are displayed in red and inactive + breakpoints in blue.

 - The Button area, with buttons for quick access to frequently - used functions in the Process menu. - The Evaluator area, where the user can evaluate functions - within the context of the debugged process, provided that - process execution has been stopped. - The Bindings area, showing all variables bindings. - Clicking on a variable name will result in the value being - displayed in the Evaluator area. - Double-clicking on a variable name will open a window where - the variable value may be edited. Note however that pid, - reference, binary or port values can not be edited. + +

The Button area, with buttons for quick access to frequently + used functions in the Process menu.

 + +

The Evaluator area, where you can evaluate functions + within the context of the debugged process, if that + process execution is stopped.

 + +

The Bindings area, displaying all variables bindings. If you + click a variable name, the value is displayed in the Evaluator area. + Double-click a variable name to open a window where + the variable value can be edited. Notice however that pid, + reference, binary, or port values cannot be edited.

 -

The Trace area, showing a trace output for the process. -

+ +

The Trace area, which displays a trace output for the + process.

- ++ (N) <L> - Function call, where N is the call level and - L the line number. + ++ (N) <L> +

Function call, where N is the call level and + L the line number.

 - -- (N) - Function return value. + -- (N) +

Function return value

. - ==> Pid : Msg - The message Msg is sent to process Pid. - + ==> Pid : Msg +

The message Msg is sent to process + Pid.

 - - The message Msg is received. + +

The message Msg is received.

 - ++ (N) receive - Waiting in a receive. + ++ (N) receive +

Waiting in a receive.

 - ++ (N) receive with timeout - Waiting in a receive...after. - + ++ (N) receive with timeout +

Waiting in a receive...after.

 + -

Also the back trace, a summary of the current function calls - on the stack, is displayed in the Trace area.

+

The Trace area also displays Back Trace, a summary of the + current function calls on the stack.

 -

It is configurable using the Options menu which areas should - be shown or hidden. By default, all areas except the Trace area - are shown.

+

Using the Options menu, you can set which areas to be + displayed. By default, all areas except the Trace area are displayed.

- The File Menu + File Menu Close -

Close this window and detach from the process.

+

Closes this window and detach from the process.
- The Edit Menu + Edit Menu Go to line... -

Go to a specified line number.

 +

Goes to a specified line number.

 Search... -

Search for a specified string.

 +

Searches for a specified string.
- The Process Menu + Process Menu Step -

Execute the current line of code, stepping into any +

Executes the current code line, stepping into any (interpreted) function calls.

 Next -

Execute the current line of code and stop at the next +

Executes the current code line and stop at the next line.

 Continue -

Continue the execution.

 +

Continues the execution.

 Finish -

Continue the execution until the current function +

Continues the execution until the current function returns.

 Skip -

Skip the current line of code and stop at the next +

Skips the current code line and stop at the next line. If used on the last line in a function body, - the function will return skipped.

 + the function returns skipped.

Time Out -

Simulate a timeout when executing a +

Simulates a time-out when executing a receive...after statement.

 Stop -

Stop the execution of a running process, that is, make - the process stop as at a breakpoint. The command will take +

Stops the execution of a running process, that is, make + the process stop at a breakpoint. The command takes effect (visibly) the next time the process receives a message.

 Where -

Make sure the current location of the execution is +

Verifies that the current location of the execution is visible in the code area.

 Kill -

Terminate the process using exit(Pid,kill).

+

Terminates the process using exit(Pid,kill).

 Messages -

Inspect the message queue of the process. The queue is - printed in the evaluator area.

 +

Inspects the message queue of the process. The queue is + displayed in the Evaluator area.

 Back Trace -

Display the back trace of the process, a summary of - the current function calls on the stack, in the trace area. - Requires that the Trace area is visible and that the stack - trace option is 'Stack On, Tail' or 'Stack On, No Tail'.

+

Displays the back trace of the process, a summary of + the current function calls on the stack, in the Trace area. + Requires that the Trace area is visible and that the Stack + Trace option is Stack On, Tail or + Stack On, No Tail.

 Up -

Inspect the previous function call on the stack, +

Inspects the previous function call on the stack, showing the location and variable bindings.

 Down -

Inspect the next function call on the stack, showing +

Inspects the next function call on the stack, showing the location and variable bindings.
- The Options Menu + Options Menu Trace Window -

Set which areas should be visible. Does not affect - other Attach Process windows.

- +

Sets which areas are to be visible. Does not affect + other Attach Process windows.

 Stack Trace -

Same as in the Monitor - window, but only affects the debugged - process the window is attached to.

- +

Same as in the Monitor + window, but only affects the debugged + process the window is attached to.

 Strings -

Same as in the Monitor - window, but only affects the debugged - process the window is attached to.

- +

Same as in the Monitor + window, but only affects the debugged + process the window is attached to.

 Back Trace Size... -

Set how many call frames should be fetched when +

Sets how many call frames are to be fetched when inspecting the call stack. Does not affect other Attach - Process windows.

- + Process windows.
- Break, Windows and Help Menus + Break, Windows, and Help Menus -

The Break, Windows and Help menus look the same as in - the Monitor window, see the chapter - The Monitor Window, except - that the Breaks menu apply to the local breakpoints only.

+

The Break, Windows, and Help menus + are the same as in the + Monitor Window, except + that the Breaks menu applies only to local + breakpoints.

- The View Module Window + View Module Window -

The View Module window shows the contents of an interpreted +

The View Module window displays the contents of an interpreted module and makes it possible to set breakpoints.

- The View Module Window. + View Module Window

The source code is indented and each line is prefixed with its line number.

-

Clicking a line will highlight it and select it to be the target - of the breakpoint functions available from the Break menu. - Doubleclicking a line will set a line breakpoint on that line. - Doubleclicking a line with an existing breakpoint will remove - the breakpoint.

+

Clicking a line highlights it and selects it to be the target + of the breakpoint functions available from the Break menu. + To set a line breakpoint on a line, double-click it. + To remove the breakpoint, double-click the line with an existing + breakpoint.

Breakpoints are marked with a stop symbol.

File and Edit Menus -

The File and Edit menus look the same as in the Attach Process - window, see the chapter The Attach - Process Window.

+

The File and Edit menus are the same as in the + Attach Process Window.

- Break, Windows and Help Menus + Break, Windows, and Help Menus -

The Break, Windows and Help menus look the same as in - the Monitor window, see the chapter - The Monitor Window, except - that the Breaks menu apply to the local breakpoints only.

+

The Break, Windows, and Help menus + are the same as in the + Monitor Window, except + that the Break menu applies only to local breakpoints.

@@ -862,14 +852,14 @@ c_break(Bindings) -> Performance

Execution of interpreted code is naturally slower than for - regularly compiled modules. Using the Debugger also increases + regularly compiled modules. Using Debugger also increases the number of processes in the system, as for each debugged process another process (the meta process) is created.

-

It is also worth to keep in mind that programs with timers may +

It is also worth to keep in mind that programs with timers can behave differently when debugged. This is especially true when - stopping the execution of a process, for example at a - breakpoint. Timeouts can then occur in other processes that + stopping the execution of a process (for example, at a + breakpoint). Time-outs can then occur in other processes that continue execution as normal.

@@ -878,8 +868,8 @@ c_break(Bindings) ->

Code loading works almost as usual, except that interpreted modules are also stored in a database and debugged processes - uses only this stored code. Re-interpreting an interpreted - module will result in the new version being stored as well, but + use only this stored code. Reinterpreting an interpreted + module results in the new version being stored as well, but does not affect existing processes executing an older version of the code. This means that the code replacement mechanism of Erlang does not work for debugged processes.

@@ -888,22 +878,24 @@ c_break(Bindings) ->
Debugging Remote Nodes -

By using debugger:start/1, it can be specified if Debugger - should be started in local or global mode.

+

By using + debugger:start/1, + you can specify if Debugger is to be started in local or global + mode:

 debugger:start(local | global)
-

If no argument is provided, Debugger is started in global mode. -

+ +

If no argument is provided, Debugger starts in global mode.

In local mode, code is interpreted only at the current node. In global mode, code is interpreted at all known nodes. Processes - at other nodes executing interpreted code will automatically be - shown in the Monitor window and can be attached to like any other + at other nodes executing interpreted code are automatically + displayed in the Monitor window and can be attached to like any other debugged process.

-

It is possible, but definitely not recommended to start Debugger - in global mode on more than one node in a network, as they will - interfere with each other leading to inconsistent behaviour.

+

It is possible, but definitely not recommended, to start Debugger + in global mode on more than one node in a network, as the nodes + interfere with each other, leading to inconsistent behavior.

diff --git a/lib/debugger/doc/src/i.xml b/lib/debugger/doc/src/i.xml index 9ceba94b44..db89f23494 100644 --- a/lib/debugger/doc/src/i.xml +++ b/lib/debugger/doc/src/i.xml @@ -4,7 +4,7 @@
- 19982013 + 19982016 Ericsson AB. All Rights Reserved. @@ -29,35 +29,36 @@
i - Debugger/Interpreter Interface + Debugger/Interpreter Interface. -

The module i provides short forms for some of +

The i module provides short forms for some of the functions used by the graphical Debugger and some of - the functions in the int module, the Erlang interpreter. -

+ the functions in module + int, the Erlang interpreter.

This module also provides facilities for displaying status information about interpreted processes and break points.

It is possible to attach to interpreted processes by giving the corresponding process identity only. By default, an attachment - window pops up. Processes at other Erlang nodes can be + window is displayed. Processes at other Erlang nodes can be attached manually or automatically.

-

By preference, these functions can be included in the module - shell_default. By default, they are.

+

By preference, these functions can be included in module + stdlib:shell_default. + By default, they are included in that module.

 im() -> pid() - Start a graphical monitor + Start a graphical monitor.

Starts a new graphical monitor. This is the Monitor window, - the main window of the Debugger. All of the Debugger and + the main window of Debugger. All the Debugger and interpreter functionality is accessed from the Monitor window. - The Monitor window displays the status of all processes that - have been/are executing interpreted modules.

+ This window displays the status of all processes that + have been or are executing interpreted modules.

 @@ -66,7 +67,7 @@ ii(AbsModule) -> {module, Module} | error ini(AbsModules) -> ok ini(AbsModule) -> {module, Module} | error - Interpret a module + Interpret a module. AbsModules = [AbsModule] AbsModule = Module | File @@ -85,7 +86,7 @@ iq(AbsModule) -> ok inq(AbsModule) -> ok - Stop interpreting a module + Stop interpreting a module. AbsModule = Module | File  Module = atom() @@ -110,28 +111,27 @@ ip() -> ok - Make a printout of the current status of all interpreted - processes + Print the current status of all interpreted + processes. -

Makes a printout of the current status of all interpreted - processes.

+

Prints the current status of all interpreted processes.

 ic() -> ok Clear information about processes executing interpreted - code + code.

Clears information about processes executing interpreted code - byt removing all information about terminated processes.

+ by removing all information about terminated processes.

 iaa(Flags) -> true iaa(Flags, Function) -> true - Set when and how to attach to a process + Set when and how to attach to a process. Flags = [init | break | exit] Function = {Module,Name,Args} @@ -139,42 +139,41 @@  Args = [term()] -

Sets when and how to automatically attach to a debugged - process, see +

Sets when and how to attach to a debugged process + automatically, see int:auto_attach/2. Function defaults to the standard function used by - the Debugger.

+ Debugger.

 ist(Flag) -> true - Set how to save call frames + Set how to save call frames. Flag = all | no_tail | false

Sets how to save call frames in the stack, see - int:stack_trace/1. -

+ int:stack_trace/1.

 ia(Pid) -> ok | no_proc - Attach to a process + Attache to a process. Pid = pid() -

Attaches to the debugged process Pid. A Debugger +

Attaches to the debugged process Pid. An Attach Process window is opened for the process.

 ia(X,Y,Z) -> ok | no_proc - Attach to a process + Attache to a process. X = Y = Z = int() @@ -186,7 +185,7 @@ ia(Pid, Function) -> ok | no_proc - Attach to a process + Attache to a process. Pid = pid() Function = {Module,Name} @@ -194,14 +193,14 @@

Attaches to the debugged process Pid. The interpreter - will call spawn(Module, Name, [Pid]) (and ignore + calls spawn(Module, Name, [Pid]) (and ignores the result).

 ia(X,Y,Z, Function) -> ok | no_proc - Attach to a process + Attache to a process. X = Y = Z = int() Function = {Module,Name} @@ -211,15 +210,15 @@

Same as ia(Pid, Function), where Pid is the result of calling the shell function pid(X,Y,Z). An attached process is expected to call the unofficial - int:attached(Pid) function and to be able to handle - messages from the interpreter, see dbg_wx_trace.erl for - an example.

+ function int:attached(Pid) and to be able to handle + messages from the interpreter. For an example, see + dbg_wx_trace.erl.

 ib(Module, Line) -> ok | {error, break_exists} - Create a breakpoint + Create a breakpoint. Module = atom() Line = int() @@ -232,20 +231,20 @@ ib(Module, Name, Arity) -> ok | {error, function_not_found} - Create breakpoints in the specified function + Create breakpoints in the specified function. Module = Name = atom() Arity = int()

Creates breakpoints at the first line of every clause of - the Module:Name/Arity function.

+ function Module:Name/Arity.

 ir() -> ok - Delete all breakpoints + Delete all breakpoints.

Deletes all breakpoints.

 @@ -253,7 +252,7 @@ ir(Module) -> ok - Delete all breakpoints in a module + Delete all breakpoints in a module. Module = atom() @@ -264,61 +263,57 @@ ir(Module, Line) -> ok - Delete a breakpoint + Delete a breakpoint. Module = atom() Line = int() -

Deletes the breakpoint located at Line in - Module.

+

Deletes the breakpoint at Line in Module.

 ir(Module, Name, Arity) -> ok | {error, function_not_found} - Delete breakpoints from the specified function - + Delete breakpoints from the specified function. Module = Name = atom() Arity = int()

Deletes the breakpoints at the first line of every clause of - the Module:Name/Arity function.

+ function Module:Name/Arity.

 ibd(Module, Line) -> ok - Make a breakpoint inactive + Make a breakpoint inactive. Module = atom() Line = int() -

Makes the breakpoint at Line in Module - inactive.

+

Makes the breakpoint at Line in Module inactive.

 ibe(Module, Line) -> ok - Make a breakpoint active + Make a breakpoint active. Module = atom() Line = int() -

Makes the breakpoint at Line in Module active. -

+

Makes the breakpoint at Line in Module active.

 iba(Module, Line, Action) -> ok - Set the trigger action of a breakpoint + Set the trigger action of a breakpoint. Module = atom() Line = int() @@ -332,7 +327,7 @@ ibc(Module, Line, Function) -> ok - Set the conditional test of a breakpoint + Set the conditional test of a breakpoint. Module = atom() Line = int() @@ -346,62 +341,53 @@

The conditional test is performed by calling Module:Name(Bindings), where Bindings is the current variable bindings. The function must return - true (break) or false (do not break). Use - int:get_binding(Var, Bindings) to retrieve the value - of a variable Var.

+ true (break) or false (do not break). + To retrieve the value of a variable Var, use + int:get_binding(Var, Bindings).

 ipb() -> ok - Make a printout of all existing breakpoints + Print all existing breakpoints. -

Makes a printout of all existing breakpoints.

+

Prints all existing breakpoints.

 ipb(Module) -> ok - Make a printout of all breakpoints in a module - + Print all existing breakpoints in a module. Module = atom() -

Makes a printout of all existing breakpoints in - Module.

+

Prints all existing breakpoints in Module.

 iv() -> atom() - Current version number of the interpreter + Return the current version number of the interpreter. +

Returns the current version number of the interpreter. - The same as the version number of the Debugger application. -

+ Same as the version number of the Debugger application.

 help() -> ok - Print help text + Print help text.

Prints help text.

 -
- Usage - -

Refer to the Debugger User's Guide for information about - the Debugger.

-
-
See Also -

int(3)

+

int(3)

 diff --git a/lib/debugger/doc/src/int.xml b/lib/debugger/doc/src/int.xml index ea21d04a07..31e9dfe923 100644 --- a/lib/debugger/doc/src/int.xml +++ b/lib/debugger/doc/src/int.xml @@ -4,7 +4,7 @@
- 19982013 + 19982016 Ericsson AB. All Rights Reserved. @@ -29,16 +29,16 @@
int - Interpreter Interface + Interpreter Interface.

The Erlang interpreter provides mechanisms for breakpoints and - stepwise execution of code. It is mainly intended to be used by - the Debugger, see Debugger User's Guide and - debugger(3).

+ stepwise execution of code. It is primarily intended to be used by + Debugger, see the User's Guide and + debugger(3).

-

From the shell, it is possible to:

- - Specify which modules should be interpreted. +

The following can be done from the shell:

+ + Specify the modules to be interpreted. Specify breakpoints. Monitor the current status of all processes executing code in interpreted modules, also processes at other Erlang nodes. @@ -48,45 +48,48 @@

By attaching to a process executing interpreted code, it is possible to examine variable bindings and order stepwise execution. This is done by sending and receiving information - to/from the process via a third process, called the meta process. - It is possible to implement your own attached process. See + to/from the process through a third process, called the meta + process. You can implement your own attached process. See int.erl for available functions and dbg_wx_trace.erl for possible messages.

-

The interpreter depends on the Kernel, STDLIB and GS - applications, which means modules belonging to any of these - applications are not allowed to be interpreted as it could lead +

The interpreter depends on the Kernel, STDLIB, and + GS applications. This means that modules belonging to any of + these applications are not allowed to be interpreted, as it could lead to a deadlock or emulator crash. This also applies to modules - belonging to the Debugger application itself.

+ belonging to the Debugger application.
+ Breakpoints

Breakpoints are specified on a line basis. When a process executing code in an interpreted module reaches a breakpoint, it - will stop. This means that that a breakpoint must be set at an - executable line, that is, a line of code containing an executable + stops. This means that a breakpoint must be set at an + executable line, that is, a code line containing an executable expression.

-

A breakpoint have a status, a trigger action and may have a - condition associated with it. The status is either active - or inactive. An inactive breakpoint is ignored. When a - breakpoint is reached, the trigger action specifies if - the breakpoint should continue to be active (enable), if - it should become inactive (disable), or if it should be - removed (delete). A condition is a tuple - {Module,Name}. When the breakpoint is reached, - Module:Name(Bindings) is called. If this evaluates to - true, execution will stop. If this evaluates to - false, the breakpoint is ignored. Bindings contains - the current variable bindings, use get_binding to retrieve - the value for a given variable.

+

A breakpoint has the following:

+ + A status, which is active or inactive. An + inactive breakpoint is ignored. + A trigger action. When a breakpoint is reached, the trigger + action specifies if the breakpoint is to continue as active + (enable), or to become inactive (disable), or + to be removed (delete). + Optionally an associated condition. A condition is a tuple + {Module,Name}. When the breakpoint is reached, + Module:Name(Bindings) is called. If it evaluates to + true, execution stops. If it evaluates to false, + the breakpoint is ignored. Bindings contains the current + variable bindings. To retrieve the value for a specified variable, + use get_binding. +

By default, a breakpoint is active, has trigger action - enable and has no condition associated with it. For more - detailed information about breakpoints, refer to Debugger User's - Guide.

+ enable, and has no associated condition. For details + about breakpoints, see the User's Guide.

@@ -95,7 +98,7 @@ i(AbsModules) -> ok ni(AbsModule) -> {module,Module} | error ni(AbsModules) -> ok - Interpret a module + Interpret a module. AbsModules = [AbsModule] AbsModule = Module | File | [Module | File] @@ -107,41 +110,43 @@ the module only at the current node. ni/1 interprets the module at all known nodes.

-

A module may be given by its module name (atom) or by its - file name. If given by its module name, the object code +

A module can be specified by its module name (atom) or + filename.

+ +

If specified by its module name, the object code Module.beam is searched for in the current path. The source code Module.erl is searched for first in - the same directory as the object code, then in a src + the same directory as the object code, then in an src directory next to it.

-

If given by its file name, the file name may include a path - and the .erl extension may be omitted. The object code +

If specified by its filename, the filename can include a path + and the .erl extension can be omitted. The object code Module.beam is searched for first in the same directory as the source code, then in an ebin directory next to it, and then in the current path.

-

The interpreter needs both the source code and the object - code, and the object code must include debug - information. That is, only modules compiled with the option +

The interpreter requires both the source code and the object + code. The object code must include debug + information, that is, only modules compiled with option debug_info set can be interpreted.

The functions returns {module,Module} if the module - was interpreted, or error if it was not.

+ was interpreted, otherwise error is returned.

-

The argument may also be a list of modules/file names, in +

The argument can also be a list of modules or filenames, in which case the function tries to interpret each module as - specified above. The function then always returns ok, - but prints some information to stdout if a module could not be - interpreted.

+ specified earlier. The function then always returns ok, + but prints some information to stdout if a module + cannot be interpreted.

n(AbsModule) -> ok nn(AbsModule) -> ok - Stop interpreting a module + Stop interpreting a module. AbsModule = Module | File | [Module | File]  Module = atom() @@ -152,14 +157,14 @@ interpreting the module only at the current node. nn/1 stops interpreting the module at all known nodes.

-

As for i/1 and ni/1, a module may be given by - either its module name or its file name.

+

As for i/1 and ni/1, a module can be specified by + its module name or filename.

 interpreted() -> [Module] - Get all interpreted modules + Get all interpreted modules. Module = atom() @@ -170,20 +175,20 @@ file(Module) -> File | {error,not_loaded} - Get the file name for an interpreted module + Get the filename for an interpreted module. Module = atom() File = string() -

Returns the source code file name File for an +

Returns the source code filename File for an interpreted module Module.

 interpretable(AbsModule) -> true | {error,Reason} - Check if a module is possible to interpret + Check if a module can be interpreted. AbsModule = Module | File  Module = atom() @@ -193,45 +198,59 @@  App = atom() -

Checks if a module is possible to interpret. The module can - be given by its module name Module or its source file - name File. If given by a module name, the module is - searched for in the code path.

- -

The function returns true if both source code and - object code for the module is found, the module has been - compiled with the option debug_info set and does not - belong to any of the applications Kernel, STDLIB, GS or - Debugger itself.

- -

The function returns {error,Reason} if the module for - some reason is not possible to interpret.

- -

Reason is no_src if no source code is found or - no_beam if no object code is found. It is assumed that - the source- and object code are located either in the same - directory, or in src and ebin directories next - to each other.

- -

Reason is no_debug_info if the module has not - been compiled with the option debug_info set.

- -

Reason is badarg if AbsModule is not - found. This could be because the specified file does not - exist, or because code:which/1 does not return a - beam file name, which is the case not only for non-existing - modules but also for modules which are preloaded or cover - compiled.

- -

Reason is {app,App} where App is - kernel, stdlib, gs or debugger if - AbsModule belongs to one of these applications.

- -

Note that the function can return true for a module - which in fact is not interpretable in the case where +

Checks if a module can be interpreted. The module can be + specified by its module name Module or its source + filename File. If specified by a module name, the module + is searched for in the code path.

+ +

The function returns true if all of the following + apply:

+ + Both source code and object code for the module is + found. + The module has been compiled with option debug_info + set. + The module does not belong to any of the applications + Kernel, STDLIB, GS, or Debugger. + + +

The function returns {error,Reason} if the module cannot + be interpreted. Reason can have the following values:

+ + no_src +

No source code is found. + It is assumed that the source code and object code are located + either in the same directory, or in src and ebin + directories next to each other.

 + + no_beam +

No object code is found. + It is assumed that the source code and object code are located + either in the same directory, or in src and ebin + directories next to each other.

 + + no_debug_info +

The module has not been compiled with option + debug_info set.

 + + badarg +

AbsModule is not found. This could be because + the specified file does not exist, or because + code:which/1 does not return a BEAM filename, + which is the case not only for non-existing modules but also + for modules that are preloaded or cover-compiled.

 + + {app,App} +

App is kernel, stdlib, gs, + or debugger if AbsModule belongs to one of these + applications.

 + + +

Notice that the function can return true for a module + that in fact is not interpretable in the case where the module is marked as sticky or resides in a directory - marked as sticky, as this is not discovered until - the interpreter actually tries to load the module.

+ marked as sticky. The reason is that this is not discovered + until the interpreter tries to load the module.

 @@ -239,7 +258,7 @@ auto_attach() -> false | {Flags,Function} auto_attach(false) auto_attach(Flags, Function) - Get/set when and how to attach to a process + Get and set when and how to attach to a process. Flags = [init | break | exit] Function = {Module,Name,Args} @@ -247,24 +266,24 @@  Args = [term()] -

Gets and sets when and how to automatically attach to a +

Gets and sets when and how to attach automatically to a process executing code in interpreted modules. false - means never automatically attach, this is the default. + means never attach automatically, this is the default. Otherwise automatic attach is defined by a list of flags and - a function. The following flags may be specified:

- - init - attach when a process for the very first + a function. The following flags can be specified:

+ + init - Attach when a process for the first time calls an interpreted function. - break - attach whenever a process reaches a + break - Attach whenever a process reaches a breakpoint. - exit - attach when a process terminates. + exit - Attach when a process terminates.

When the specified event occurs, the function Function - will be called as:

+ is called as:

-spawn(Module, Name, [Pid | Args])
-
+spawn(Module, Name, [Pid | Args]) +

Pid is the pid of the process executing interpreted code.

 @@ -273,7 +292,7 @@ spawn(Module, Name, [Pid | Args]) stack_trace() -> Flag stack_trace(Flag) - Get/set if and how to save call frames + Get and set if and how to save call frames. Flag = all | no_tail | false @@ -281,25 +300,30 @@ spawn(Module, Name, [Pid | Args])

Gets and sets how to save call frames in the stack. Saving call frames makes it possible to inspect the call chain of a process, and is also used to emulate the stack trace if an - error (an exception of class error) occurs.

- - all - save information about all current calls, - that is, function calls that have not yet returned a value. - - no_tail - save information about current calls, + error (an exception of class error) occurs. The following + flags can be specified:

+ + all +

Save information about all current calls, + that is, function calls that have not yet returned a value.

+ + + no_tail +

Save information about current calls, but discard previous information when a tail recursive call - is made. This option consumes less memory and may be + is made. This option consumes less memory and can be necessary to use for processes with long lifetimes and many - tail recursive calls. This is the default. - false - do not save any information about current - calls. - + tail recursive calls. This is the default.

 + + false +

Save no information about currentcalls.

 + break(Module, Line) -> ok | {error,break_exists} - Create a breakpoint + Create a breakpoint. Module = atom() Line = int() @@ -311,86 +335,80 @@ spawn(Module, Name, [Pid | Args]) delete_break(Module, Line) -> ok - Delete a breakpoint + Delete a breakpoint. Module = atom() Line = int() -

Deletes the breakpoint located at Line in - Module.

+

Deletes the breakpoint at Line in Module.

 break_in(Module, Name, Arity) -> ok | {error,function_not_found} - Create breakpoints in the specified function + Create breakpoints in the specified function. Module = Name = atom() Arity = int()

Creates a breakpoint at the first line of every clause of - the Module:Name/Arity function.

+ function Module:Name/Arity.

 del_break_in(Module, Name, Arity) -> ok | {error,function_not_found} - Delete breakpoints from the specified function - + Delete breakpoints from the specified function. Module = Name = atom() Arity = int()

Deletes the breakpoints at the first line of every clause of - the Module:Name/Arity function. -

+ function Module:Name/Arity.

 no_break() -> ok no_break(Module) -> ok - Delete all breakpoints + Delete all breakpoints. -

Deletes all breakpoints, or all breakpoints in Module. -

+

Deletes all breakpoints, or all breakpoints in Module.

 disable_break(Module, Line) -> ok - Make a breakpoint inactive + Make a breakpoint inactive. Module = atom() Line = int() -

Makes the breakpoint at Line in Module - inactive.

+

Makes the breakpoint at Line in Module inactive.

 enable_break(Module, Line) -> ok - Make a breakpoint active + Make a breakpoint active. Module = atom() Line = int() -

Makes the breakpoint at Line in Module active. -

+

Makes the breakpoint at Line in Module active.

 action_at_break(Module, Line, Action) -> ok - Set the trigger action of a breakpoint + Set the trigger action of a breakpoint. Module = atom() Line = int() @@ -404,7 +422,7 @@ spawn(Module, Name, [Pid | Args]) test_at_break(Module, Line, Function) -> ok - Set the conditional test of a breakpoint + Set the conditional test of a breakpoint. Module = atom() Line = int() @@ -414,14 +432,14 @@ spawn(Module, Name, [Pid | Args])

Sets the conditional test of the breakpoint at Line in Module to Function. The function must - fulfill the requirements specified in the section - Breakpoints above.

+ fulfill the requirements specified in section + Breakpoints.

 get_binding(Var, Bindings) -> {value,Value} | unbound - Retrieve a variable binding + Retrieve a variable binding. Var = atom() Bindings = term() @@ -437,7 +455,7 @@ spawn(Module, Name, [Pid | Args]) all_breaks() -> [Break] all_breaks(Module) -> [Break] - Get all breakpoints + Get all breakpoints. Break = {Point,Options}  Point = {Module,Line} @@ -451,15 +469,14 @@ spawn(Module, Name, [Pid | Args])     Name = atom() -

Gets all breakpoints, or all breakpoints in Module. -

+

Gets all breakpoints, or all breakpoints in Module.

 snapshot() -> [Snapshot] Get information about all processes executing interpreted - code + code. Snapshot = {Pid, Function, Status, Info}  Pid = pid() @@ -475,26 +492,27 @@ spawn(Module, Name, [Pid | Args])

Gets information about all processes executing interpreted code.

- - Pid - process identifier. - Function - first interpreted function called by + + Pid - Process identifier. + Function - First interpreted function called by the process. - Status - current status of the process. - Info - additional information. + Status - Current status of the process. + Info - More information. -

Status is one of:

- - idle - the process is no longer executing + +

Status is one of the following:

+ + idle - The process is no longer executing interpreted code. Info={}. - running - the process is running. Info={}. + running - The process is running. Info={}. - waiting - the process is waiting at a + waiting - The process is waiting at a receive. Info={}. - break - process execution has been stopped, + break - Process execution is stopped, normally at a breakpoint. Info={Module,Line}. - exit - the process has terminated. + exit - The process is terminated. Info=ExitReason. - no_conn - the connection is down to the node + no_conn - The connection is down to the node where the process is running. Info={}. @@ -503,7 +521,7 @@ spawn(Module, Name, [Pid | Args]) clear() -> ok Clear information about processes executing interpreted - code + code.

Clears information about processes executing interpreted code by removing all information about terminated processes.

@@ -513,13 +531,13 @@ spawn(Module, Name, [Pid | Args]) continue(Pid) -> ok | {error,not_interpreted} continue(X,Y,Z) -> ok | {error,not_interpreted} - Resume process execution + Resume process execution. Pid = pid() X = Y = Z = int() -

Resume process execution for Pid, or for +

Resumes process execution for Pid or c:pid(X,Y,Z).

 diff --git a/lib/debugger/doc/src/introduction.xml b/lib/debugger/doc/src/introduction.xml new file mode 100644 index 0000000000..9f5f279bb0 --- /dev/null +++ b/lib/debugger/doc/src/introduction.xml @@ -0,0 +1,63 @@ + + + + +
+ + 19972013 + Ericsson AB. All Rights Reserved. + + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + + + Introduction + + + + + introduction.xml +
+ +
+ Scope +

Debugger is a graphical user interface for the Erlang + interpreter, which can be used for debugging and testing of + Erlang programs. For example, breakpoints can be set, code can be + single-stepped and variable values can be displayed and changed. +

+ +

The Erlang interpreter can also be accessed through the interface + module int(3). +

+ + +

Debugger might at some point + start tracing on the processes that execute the interpreted + code. This means that a conflict occurs if tracing by other + means is started on any of these processes.

+ +
+ +
+ Prerequisites +

It is assumed that the reader is familiar with the Erlang + programming language.

+

Modules to be debugged must include debug information, + for example, erlc +debug_info MODULE.erl.

+
+ + + + diff --git a/lib/debugger/doc/src/part.xml b/lib/debugger/doc/src/part.xml index 7515c0ad5b..ce1edbd978 100644 --- a/lib/debugger/doc/src/part.xml +++ b/lib/debugger/doc/src/part.xml @@ -4,7 +4,7 @@
- 19972013 + 19972016 Ericsson AB. All Rights Reserved. @@ -27,14 +27,10 @@ 1998-05-12 B - part.sgml + part.xml
- -

Debugger is a graphical tool which can be used for - debugging and testing of Erlang programs. For example, breakpoints - can be set, code can be single stepped and variable values can be - displayed and changed.

- + + diff --git a/lib/debugger/doc/src/ref_man.xml b/lib/debugger/doc/src/ref_man.xml index 6df9e90c2c..c44f07f912 100644 --- a/lib/debugger/doc/src/ref_man.xml +++ b/lib/debugger/doc/src/ref_man.xml @@ -28,12 +28,7 @@ - -

Debugger is a graphical tool which can be used for - debugging and testing of Erlang programs. For example, breakpoints - can be set, code can be single stepped and variable values can be - displayed and changed.

- + -- cgit v1.2.3 From d80e6353e7b827b9fb3d9a9505948dfaa2491cd4 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Mon, 7 Dec 2015 15:03:45 +0100 Subject: observer: Make it possible to change the graphs Xaxis and update freq --- lib/observer/src/observer_perf_wx.erl | 179 ++++++++++++++++++++++++---------- 1 file changed, 130 insertions(+), 49 deletions(-) diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index ace0b62c1d..fe8cae13d1 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -35,18 +35,27 @@ -include_lib("wx/include/wx.hrl"). -include("observer_defs.hrl"). +-define(ID_REFRESH_INTERVAL, 102). + +-define(DISP_FREQ, 10). +-define(FETCH_DATA, 20). %% per 10000ms +-define(DISP_SECONDS, 120). + +-record(ti, {tick=0, disp=10*?DISP_FREQ/?FETCH_DATA, fetch=?FETCH_DATA, secs=?DISP_SECONDS}). + -record(state, { - offset = 0.0, + time = #ti{}, active = false, parent, windows, - data = {0, queue:new()}, + data, panel, paint, appmon }). + -define(wxGC, wxGraphicsContext). -record(paint, {font, small, pen, pen2, pens, usegc = false}). @@ -83,7 +92,8 @@ init([Notebook, Parent]) -> {Panel, #state{parent=Parent, panel =Panel, windows = {CPU, MEM, IO}, - paint=PaintInfo + paint=PaintInfo, + data=reset_data() }} catch _:Err -> io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), @@ -129,7 +139,15 @@ setup_graph_drawing(Panels) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, + #state{panel=Panel, appmon=Old, time=#ti{fetch=F0} = Ti0} = State) -> + case interval_dialog(Panel, Ti0) of + Ti0 -> {noreply, State}; + #ti{fetch=F0} = Ti -> %% Same fetch interval + {noreply, State#state{time=Ti}}; + Ti -> %% Changed fetch interval + {noreply, restart_fetcher(node(Old), State#state{time=Ti})} + end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, State = #state{}) -> {noreply, State}; @@ -139,7 +157,7 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, - #state{active=Active, offset=Offset, paint=Paint, + #state{active=Active, time=Ti, paint=Paint, windows=Windows, data=Data}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) %% Panel = element(Id, Windows), @@ -147,11 +165,10 @@ handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, Panel =:= element(?MEM_W, Windows) -> memory; Panel =:= element(?IO_W, Windows) -> io end, - - refresh_panel(Panel, Id, Offset, Data, Active, Paint), + refresh_panel(Panel, Id, Ti, Data, Active, Paint), ok. -refresh_panel(Panel, Id, Offset, Data, Active, #paint{usegc=UseGC} = Paint) -> +refresh_panel(Panel, Id, Ti, Data, Active, #paint{usegc=UseGC} = Paint) -> %% PaintDC must be created in a callback to work on windows. IsWindows = element(1, os:type()) =:= win32, DC = if IsWindows -> @@ -167,7 +184,7 @@ refresh_panel(Panel, Id, Offset, Data, Active, #paint{usegc=UseGC} = Paint) -> end, %% Nothing is drawn until wxPaintDC is destroyed. try - draw(Offset, Id, {UseGC, GC}, Panel, Paint, Data, Active) + draw(Ti, Id, {UseGC, GC}, Panel, Paint, Data, Active) catch _:Err -> io:format("Internal error ~p ~p~n",[Err, erlang:get_stacktrace()]) end, @@ -183,40 +200,34 @@ handle_cast(Event, _State) -> error({unhandled_cast, Event}). %%%%%%%%%% handle_info(Stats = {stats, 1, _, _, _}, - State = #state{panel=Panel, data=Data, active=Active}) -> + State = #state{panel=Panel, data=Data, active=Active, + time=#ti{tick=Tick, disp=Disp0}=Ti}) -> + Disp = trunc(Disp0), + Next = max(Tick - Disp, 0), if Active -> wxWindow:refresh(Panel), - Freq = 6, - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq}); + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}); true -> ignore end, - {noreply, State#state{offset=0.0, data = add_data(Stats, Data)}}; + {noreply, State#state{time=Ti#ti{tick=Next}, data = add_data(Stats, Data, Ti)}}; -handle_info({refresh, Seq, Freq}, State = #state{panel=Panel, offset=Prev}) -> - wxWindow:refresh(Panel), +handle_info({refresh, Seq}, State = #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=Ti}) + when (Seq+1) < (DispF*1.5) -> Next = Seq+1, - if Seq > 1, Prev =:= 0.0 -> - %% We didn't have time to handle the refresh - {noreply, State}; - Next < Freq -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq}), - {noreply, State#state{offset=Seq/Freq}}; - true -> - {noreply, State#state{offset=Seq/Freq}} - end; + wxWindow:refresh(Panel), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + {noreply, State#state{time=Ti#ti{tick=Next}}}; +handle_info({refresh, _}, State) -> + {noreply, State}; -handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) -> +handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old} = State) -> create_menus(Parent, []), try Node = node(Old), wxWindow:refresh(Panel), {noreply, State#state{active=true}} catch _:_ -> - catch Old ! exit, - Me = self(), - Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, 1000]), - wxWindow:refresh(Panel), - {noreply, State#state{active=true, appmon=Pid, data={0, queue:new()}}} + {noreply,restart_fetcher(Node, State)} end; handle_info(not_active, State = #state{appmon=_Pid}) -> @@ -233,24 +244,80 @@ handle_info(_Event, State) -> %%%%%%%%%% terminate(_Event, #state{appmon=Pid}) -> catch Pid ! exit, + cprof:pause(), ok. code_change(_, _, State) -> State. -add_data(Stats, {N, Q}) when N > 60 -> +restart_fetcher(Node, #state{appmon=Old, panel=Panel, time=#ti{fetch=Freq}=Ti}=State) -> + catch Old ! exit, + Me = self(), + Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, 10000 div Freq]), + wxWindow:refresh(Panel), + cprof:start(?MODULE, '_'), + State#state{active=true, appmon=Pid, data=reset_data(), time=Ti#ti{tick=0}}. + +reset_data() -> + {0, queue:new()}. + +add_data(Stats, {N, Q}, #ti{fetch=Fetch, secs=Secs}) when N > Secs*Fetch div 10 -> {N, queue:drop(queue:in(Stats, Q))}; -add_data(Stats, {N, Q}) -> +add_data(Stats, {N, Q}, _) -> {N+1, queue:in(Stats, Q)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create_menus(Parent, _) -> - MenuEntries = - [{"File", - [ - ]} - ], - observer_wx:create_menus(Parent, MenuEntries). + View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]}, + observer_wx:create_menus(Parent, [{"File", []}, View]). + +interval_dialog(Parent0, #ti{fetch=Fetch0, secs=Secs0}=Ti) -> + Parent = observer_lib:get_wx_parent(Parent0), + Dialog = wxDialog:new(Parent, ?wxID_ANY, "Load Chart Settings", + [{style, ?wxDEFAULT_DIALOG_STYLE bor + ?wxRESIZE_BORDER}]), + {Sl1,FetchSl} = slider(Dialog, "Fetch (ms)", 10000 div Fetch0, 100, 10000), + {Sl2, SecsSl} = slider(Dialog, "Length (min)", Secs0 div 60, 1, 10), + TopSizer = wxBoxSizer:new(?wxVERTICAL), + Flags = [{flag, ?wxEXPAND bor ?wxTOP bor ?wxLEFT bor ?wxRIGHT}, + {border, 5}, {proportion, 1}], + wxSizer:add(TopSizer, Sl1, Flags), + wxSizer:add(TopSizer, Sl2, Flags), + wxSizer:add(TopSizer, wxDialog:createButtonSizer(Dialog, ?wxOK bor ?wxCANCEL), Flags), + wxWindow:setSizerAndFit(Dialog, TopSizer), + wxSizer:setSizeHints(TopSizer, Dialog), + Res = case wxDialog:showModal(Dialog) of + ?wxID_OK -> + Fetch = 10000 div wxSlider:getValue(FetchSl), + Secs = wxSlider:getValue(SecsSl) * 60, + Ti#ti{fetch=Fetch, secs=Secs, disp=10*?DISP_FREQ/Fetch}; + ?wxID_CANCEL -> + Ti + end, + wxDialog:destroy(Dialog), + Res. + +slider(Parent, Str, Value, Min, Max) -> + Sz = wxBoxSizer:new(?wxHORIZONTAL), + Center = [{flag, ?wxALIGN_CENTER_VERTICAL}], + wxSizer:add(Sz, wxStaticText:new(Parent, ?wxID_ANY, Str), [{proportion, 1}|Center]), + Opt = [{style, ?wxSL_HORIZONTAL bor ?wxSL_LABELS}], + Slider = wxSlider:new(Parent, ?wxID_ANY, Value, Min, Max, Opt), + wxSizer:add(Sz, Slider, [{proportion, 2}|Center]), + case Min > 1 of + false -> + {Sz, Slider}; + true -> + CB = fun(#wx{event=Ev},_) -> step(Ev, Slider, Min) end, + wxSlider:connect(Slider, scroll_thumbtrack, [{callback, CB}]), + wxSlider:connect(Slider, scroll_changed, [{callback, CB}]), + {Sz, Slider} + end. + +step(_Ev = #wxScroll{commandInt=Value}, Slider, Min) -> + Val = Min * round(Value / Min), + wxSlider:setValue(Slider, Val), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% collect_data(runq, {N, Q}) -> @@ -322,16 +389,23 @@ calc_delta([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> calc_delta([], []) -> []. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -draw(Offset, Id, DC, Panel, Paint=#paint{pens=Pens, small=Small}, Data, Active) -> +draw(#ti{tick=Tick, fetch=FetchFreq0, secs=Secs, disp=DispFreq}, + Id, DC, Panel, + Paint=#paint{pens=Pens, small=Small}, + Data, Active) -> %% This can be optimized a lot by collecting data once %% and draw to memory and then blit memory and only draw new entries in new memory %% area. Hmm now rewritten to use ?wxGC I don't now if it is feasable. {Len, Max0, Hs, Info} = collect_data(Id, Data), {Max,_,_} = MaxDisp = calc_max(Id, Max0), Size = wxWindow:getClientSize(Panel), - {X0,Y0,WS,HS, DrawBs} = draw_borders(Id, Info, DC, Size, MaxDisp, Paint), - Last = 60*WS+X0-1, - Start = max(61-Len, 0)*WS+X0 - Offset*WS, + {X0,Y0,WS0,HS,DrawBs} = draw_borders(Id, Info, DC, Size, Secs, MaxDisp, Paint), + FetchFreq = FetchFreq0/10, + WS = WS0/FetchFreq, + Last = Secs*FetchFreq*WS+X0-1, + Offset = Tick / DispFreq, + Start = max(Secs*FetchFreq+1-Len, 0)*WS+X0 - Offset*WS, + %% Id == io andalso io:format("~p ~p~n", [Tick, DispFreq]), Samples = length(Hs), NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, case Active andalso Samples > 1 andalso NoGraphs > 0 of @@ -426,7 +500,7 @@ spline_tan(Y0, Y1, Y2, Y3) -> -define(BW, 5). -define(BH, 5). -draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, +draw_borders(Type, Info, DC, {W,H}, Secs, {Max, Unit, MaxUnit}, #paint{pen=Pen, pen2=Pen2, font=Font, small=Small}) -> Str1 = observer_lib:to_str(MaxUnit), Str2 = observer_lib:to_str(MaxUnit div 2), @@ -449,7 +523,7 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, GraphY25 = GraphY0 + (GraphY1 - GraphY0) / 4, GraphY50 = GraphY0 + (GraphY1 - GraphY0) / 2, GraphY75 = GraphY0 + 3*(GraphY1 - GraphY0) / 4, - ScaleW = GraphW / 60, + ScaleW = GraphW / Secs, ScaleH = GraphH / Max, setFont(DC, Small, {0,0,0}), @@ -462,14 +536,21 @@ draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, Align(Str3, GraphY1 - (TH / 2) + 1), setPen(DC, Pen), - DrawSecs = fun(Secs, Pos) -> - Str = [observer_lib:to_str(Secs)|" s"], + DrawSecs = fun(Sec, {Pos, Prev}) -> + Str = observer_lib:to_str(Sec) ++ "s", X = GraphX0+Pos, - drawText(DC, Str, X-SpaceW, SecondsY), strokeLine(DC, X, GraphY0, X, GraphY1+5), - Pos + 10*ScaleW + TxtX = X-SpaceW, + case TxtX > Prev of + true -> + drawText(DC, Str, TxtX, SecondsY), + TxtW = SpaceW*length(Str), + {Pos + 10*ScaleW, TxtX+TxtW}; + false -> + {Pos + 10*ScaleW, Prev} + end end, - lists:foldl(DrawSecs, 0, lists:seq(60,0, -10)), + lists:foldl(DrawSecs, {0, 0}, lists:seq(Secs,0, -10)), strokeLine(DC, GraphX0-3, GraphY25, GraphX1, GraphY25), strokeLine(DC, GraphX0-3, GraphY50, GraphX1, GraphY50), -- cgit v1.2.3 From bde2d01506a6368b4d3667d0102c189832563654 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 10 Dec 2015 12:39:19 +0100 Subject: observer: Optimize drawing of graphs By allowing changes to the number of minutes displayed and update frequency, we need to optimize the drawing of the graphs as it can no longer recalculate everything in each frame drawn. Only recalculate the changed entries, takes more memory but far less cpu usage. While updating the gui, increase the frame-rate a bit so it updates smoother and decrease pen size for graphs to 1 pixel as it looks better according to an office voting. --- lib/observer/src/observer_alloc_wx.erl | 140 ++++--- lib/observer/src/observer_app_wx.erl | 47 +-- lib/observer/src/observer_defs.hrl | 11 + lib/observer/src/observer_perf_wx.erl | 649 +++++++++++++++++++-------------- 4 files changed, 481 insertions(+), 366 deletions(-) diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 8d5c8a9037..d37623d1cc 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -30,19 +30,23 @@ -record(state, { - offset = 0.0, + time = #ti{}, active = false, parent, - windows, - data = {0, queue:new()}, + wins, + mem, + samples, panel, paint, appmon, async }). --define(ALLOC_W, 1). --define(UTIL_W, 2). +-define(ID_REFRESH_INTERVAL, 102). + +-import(observer_perf_wx, + [make_win/4, setup_graph_drawing/1, refresh_panel/4, interval_dialog/2, + add_data/5, precalc/4]). start_link(Notebook, Parent) -> wx_object:start_link(?MODULE, [Notebook, Parent], []). @@ -51,34 +55,44 @@ init([Notebook, Parent]) -> try Panel = wxPanel:new(Notebook), Main = wxBoxSizer:new(?wxVERTICAL), - Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, - Carrier = wxPanel:new(Panel, [{winid, ?ALLOC_W}, {style,Style}]), - Utilz = wxPanel:new(Panel, [{winid, ?UTIL_W}, {style,Style}]), BorderFlags = ?wxLEFT bor ?wxRIGHT, - wxSizer:add(Main, Carrier, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, - {proportion, 1}, {border, 5}]), - - wxSizer:add(Main, Utilz, [{flag, ?wxEXPAND bor BorderFlags}, - {proportion, 1}, {border, 5}]), + Carrier = make_win(alloc, Panel, Main, BorderFlags bor ?wxTOP), + Utilz = make_win(utilz, Panel, Main, BorderFlags), MemWin = {MemPanel,_} = create_mem_info(Panel), wxSizer:add(Main, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Main), - - PaintInfo = observer_perf_wx:setup_graph_drawing([Carrier, Utilz]), - {Panel, #state{parent=Parent, - panel =Panel, - windows = {Carrier, Utilz, MemWin}, - paint=PaintInfo} + Windows = [Carrier, Utilz], + PaintInfo = setup_graph_drawing(Windows), + {Panel, #state{parent= Parent, + panel = Panel, + wins = Windows, + mem = MemWin, + paint = PaintInfo, + time = setup_time() + } } catch _:Err -> io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), {stop, Err} end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +setup_time() -> + Freq = 1, + #ti{fetch=Freq, disp=?DISP_FREQ/Freq}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, + #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> + case interval_dialog(Panel, Ti0) of + Ti0 -> {noreply, State}; + #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh + Wins = [W#win{max=undefined} || W <- Wins0], + {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti -> %% Changed fetch interval, drop all data + {noreply, restart_fetcher(Old, State#state{time=Ti})} + end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, State = #state{}) -> {noreply, State}; @@ -88,13 +102,11 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, - #state{active=Active, offset=Offset, paint=Paint, - windows=Windows, data=Data}) -> + #state{active=Active, time=Ti, paint=Paint, + wins = Windows}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) - Id = if Panel =:= element(?ALLOC_W, Windows) -> alloc; - Panel =:= element(?UTIL_W, Windows) -> utilz - end, - observer_perf_wx:refresh_panel(Panel, Id, Offset, Data, Active, Paint), + Win = lists:keyfind(Panel, #win.panel, Windows), + refresh_panel(Active, Win, Ti, Paint), ok. %%%%%%%%%% handle_call(Event, From, _State) -> @@ -107,24 +119,37 @@ handle_cast(Event, _State) -> handle_info({Key, {promise_reply, {badrpc, _}}}, #state{async=Key} = State) -> {noreply, State#state{active=false, appmon=undefined}}; -handle_info({Key, {promise_reply, SysInfo}}, #state{async=Key, data=Data} = State) -> +handle_info({Key, {promise_reply, SysInfo}}, + #state{async=Key, panel=Panel, samples=Data, active=Active, wins=Wins0, + time=#ti{tick=Tick, disp=Disp0}=Ti} = S0) -> + Disp = trunc(Disp0), + Next = max(Tick - Disp, 0), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), Info = alloc_info(SysInfo), - update_alloc(State, Info), - {noreply, State#state{offset=0.0, data = add_data(Info, Data), async=undefined}}; + {Wins, Samples} = add_data(Info, Data, Wins0, Ti, Active), + S1 = S0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples, async=undefined}, + if Active -> + update_alloc(S0, Info), + State = precalc(S1), + catch wxWindow:refresh(Panel), + {noreply, State}; + true -> + {noreply, S1} + end; -handle_info({refresh, Seq, Freq, Node}, #state{panel=Panel, appmon=Node, async=Key} = State) -> - wxWindow:refresh(Panel), +handle_info({refresh, Seq}, + State = #state{panel=Panel, appmon=Node, time=#ti{tick=Seq, disp=DispF}=Ti}) + when (Seq+1) < (DispF*1.5) -> Next = Seq+1, - if - Next > Freq, Key =:= undefined -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), + State#state.active andalso (catch wxWindow:refresh(Panel)), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + if Seq =:= (trunc(DispF)-1) -> Req = rpc:async_call(Node, observer_backend, sys_info, []), - {noreply, State#state{offset=Seq/Freq, async=Req}}; + {noreply, State#state{time=Ti#ti{tick=Next}, async=Req}}; true -> - erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq, Node}), - {noreply, State#state{offset=Seq/Freq}} + {noreply, State#state{time=Ti#ti{tick=Next}}} end; -handle_info({refresh, _Seq, _Freq, _Node}, State) -> +handle_info({refresh, _S}, #state{}=State) -> {noreply, State}; handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) -> @@ -132,15 +157,9 @@ handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Ol try Node = Old, wxWindow:refresh(Panel), - {noreply, State#state{active=true}} + {noreply, precalc(State#state{active=true})} catch _:_ -> - SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - Info = alloc_info(SysInfo), - Freq = 6, - erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), - wxWindow:refresh(Panel), - {noreply, State#state{active=true, appmon=Node, offset=0.0, - data = add_data(Info, {0, queue:new()})}} + {noreply, restart_fetcher(Node, State)} end; handle_info(not_active, State = #state{appmon=_Pid}) -> @@ -160,12 +179,21 @@ code_change(_, _, State) -> %%%%%%%%%% -add_data(Stats, {N, Q}) when N > 60 -> - {N, queue:drop(queue:in(Stats, Q))}; -add_data(Stats, {N, Q}) -> - {N+1, queue:in(Stats, Q)}. +restart_fetcher(Node, #state{panel=Panel, wins=Wins0, time=Ti} = State) -> + SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), + Info = alloc_info(SysInfo), + {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), + wxWindow:refresh(Panel), + precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, + wins=Wins, samples=Samples}). + +precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> + Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], + State#state{wins=Wins}. + -update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) -> +update_alloc(#state{mem={_, Grid}}, Fields) -> Max = wxListCtrl:getItemCount(Grid), Update = fun({Name, BS, CS}, Row) -> (Row >= Max) andalso wxListCtrl:insertItem(Grid, Row, ""), @@ -174,7 +202,7 @@ update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) -> wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)), Row + 1 end, - lists:foldl(Update, 0, Fields), + wx:foldl(Update, 0, Fields), Fields. alloc_info(SysInfo) -> @@ -247,11 +275,7 @@ create_mem_info(Parent) -> create_menus(Parent, _) -> - MenuEntries = - [{"File", - [ - ]} - ], - observer_wx:create_menus(Parent, MenuEntries). + View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]}, + observer_wx:create_menus(Parent, [{"File", []}, View]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index a2b7c21993..40e117357c 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -29,7 +29,7 @@ -include("observer_defs.hrl"). %% Import drawing wrappers --import(observer_perf_wx, [haveGC/0, +-import(observer_perf_wx, [haveGC/0, make_gc/2, destroy_gc/1, setPen/2, setFont/3, setBrush/2, strokeLine/5, strokeLines/2, drawRoundedRectangle/6, drawText/4, getTextExtent/2]). @@ -244,28 +244,18 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{event = #wxPaint{}},_, #state{app_w=DA, app=App, sel=Sel, paint=Paint, usegc=UseGC}) -> - %% PaintDC must be created in a callback to work on windows. - IsWindows = element(1, os:type()) =:= win32, - %% Avoid Windows flickering hack - DC = if IsWindows -> wx:typeCast(wxBufferedPaintDC:new(DA), wxPaintDC); - true -> wxPaintDC:new(DA) - end, - IsWindows andalso wxDC:clear(DC), - GC = case UseGC of - true -> - GC0 = ?wxGC:create(DC), - %% Argh must handle scrolling when using ?wxGC - {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}), - ?wxGC:translate(GC0, Sx,Sy), - GC0; - false -> - wxScrolledWindow:doPrepareDC(DA,DC), - DC - end, + GC = {GC0, DC} = make_gc(DA, UseGC), + case UseGC of + false -> + wxScrolledWindow:doPrepareDC(DA,DC); + true -> + %% Argh must handle scrolling when using ?wxGC + {Sx,Sy} = wxScrolledWindow:calcScrolledPosition(DA, {0,0}), + ?wxGC:translate(GC0, Sx,Sy) + end, %% Nothing is drawn until wxPaintDC is destroyed. - draw({UseGC, GC}, App, Sel, Paint), - UseGC andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC), + draw(GC, App, Sel, Paint), + destroy_gc(GC), ok. %%%%%%%%%% handle_call(Event, From, _State) -> @@ -312,15 +302,10 @@ handle_info({delivery, _Pid, app, _Curr, {[], [], [], []}}, handle_info({delivery, Pid, app, Curr, AppData}, State = #state{panel=Panel, appmon=Pid, current=Curr, usegc=UseGC, app_w=AppWin, paint=#paint{font=Font}}) -> - GC = if UseGC -> ?wxGC:create(AppWin); - true -> wxWindowDC:new(AppWin) - end, - FontW = {UseGC, GC}, - setFont(FontW, Font, {0,0,0}), - App = build_tree(AppData, FontW), - if UseGC -> ?wxGC:destroy(GC); - true -> wxWindowDC:destroy(GC) - end, + GC = make_gc(AppWin, UseGC), + setFont(GC, Font, {0,0,0}), + App = build_tree(AppData, GC), + destroy_gc(GC), setup_scrollbar(AppWin, App), wxWindow:refresh(Panel), wxWindow:layout(Panel), diff --git a/lib/observer/src/observer_defs.hrl b/lib/observer/src/observer_defs.hrl index 1c2fe520b7..c4ba84a8c4 100644 --- a/lib/observer/src/observer_defs.hrl +++ b/lib/observer/src/observer_defs.hrl @@ -49,3 +49,14 @@ -define(LCTRL_WDECR, 4). %% Remove some pixels in column width to avoid creating unnecessary scrollbar -define(SASH_STYLE, ?wxSP_LIVE_UPDATE bor ?wxSP_NOBORDER bor ?wxSP_3DSASH). + +-define(DISP_FREQ, 10). %% per second +-define(FETCH_DATA, 2). %% per second +-define(DISP_SECONDS, 60). + +-record(ti, {tick=0, disp=?DISP_FREQ/?FETCH_DATA, fetch=?FETCH_DATA, secs=?DISP_SECONDS}). + +-record(win, {name, panel, size, geom, + graphs=[], no_samples=0, + max, state, + info=[]}). diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index fe8cae13d1..56da5a862a 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -25,8 +25,9 @@ handle_event/2, handle_sync_event/3, handle_cast/2]). %% Drawing wrappers for DC and GC areas --export([setup_graph_drawing/1, refresh_panel/6, - haveGC/0, +-export([make_win/4, setup_graph_drawing/1, + refresh_panel/4, precalc/4, add_data/5, interval_dialog/2, + haveGC/0, make_gc/2, destroy_gc/1, setPen/2, setFont/3, setBrush/2, strokeLine/5, strokeLines/2, drawRoundedRectangle/6, drawText/4, getTextExtent/2]). @@ -37,73 +38,68 @@ -define(ID_REFRESH_INTERVAL, 102). --define(DISP_FREQ, 10). --define(FETCH_DATA, 20). %% per 10000ms --define(DISP_SECONDS, 120). - --record(ti, {tick=0, disp=10*?DISP_FREQ/?FETCH_DATA, fetch=?FETCH_DATA, secs=?DISP_SECONDS}). +-define(BW, 5). +-define(BH, 5). -record(state, { time = #ti{}, active = false, parent, - windows, - data, + samples, %% Orig data store + wins=[], %% per window content panel, paint, appmon }). - -define(wxGC, wxGraphicsContext). -record(paint, {font, small, pen, pen2, pens, usegc = false}). --define(RQ_W, 1). --define(MEM_W, 2). --define(IO_W, 3). - start_link(Notebook, Parent) -> wx_object:start_link(?MODULE, [Notebook, Parent], []). init([Notebook, Parent]) -> - try - Panel = wxPanel:new(Notebook), - Main = wxBoxSizer:new(?wxVERTICAL), + try + Panel = wxPanel:new(Notebook), + Main = wxBoxSizer:new(?wxVERTICAL), + MemIO = wxBoxSizer:new(?wxHORIZONTAL), + + CPU = make_win(runq, Panel, Main, ?wxALL), + MEM = make_win(memory, Panel, MemIO, ?wxLEFT), + IO = make_win(io, Panel, MemIO, ?wxLEFT bor ?wxRIGHT), + + wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN}, + {proportion, 1}, {border, 5}]), + wxWindow:setSizer(Panel, Main), + Windows = [CPU, MEM, IO], + PaintInfo = setup_graph_drawing(Windows), + + process_flag(trap_exit, true), + State0 = #state{parent=Parent, + panel =Panel, + wins = Windows, + paint=PaintInfo, + samples=reset_data() + }, + {Panel, State0} + catch _:Err -> + io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + {stop, Err} + end. + +make_win(Name, Parent, Sizer, Border) -> Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, - CPU = wxPanel:new(Panel, [{winid, ?RQ_W}, {style,Style}]), - wxSizer:add(Main, CPU, [{flag, ?wxEXPAND bor ?wxALL}, - {proportion, 1}, {border, 5}]), - MemIO = wxBoxSizer:new(?wxHORIZONTAL), - MEM = wxPanel:new(Panel, [{winid, ?MEM_W}, {style,Style}]), - IO = wxPanel:new(Panel, [{winid, ?IO_W}, {style,Style}]), - wxSizer:add(MemIO, MEM, [{flag, ?wxEXPAND bor ?wxLEFT}, - {proportion, 1}, {border, 5}]), - wxSizer:add(MemIO, IO, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT}, - {proportion, 1}, {border, 5}]), - wxSizer:add(Main, MemIO, [{flag, ?wxEXPAND bor ?wxDOWN}, - {proportion, 1}, {border, 5}]), - wxWindow:setSizer(Panel, Main), - - PaintInfo = setup_graph_drawing([CPU, MEM, IO]), - - process_flag(trap_exit, true), - {Panel, #state{parent=Parent, - panel =Panel, - windows = {CPU, MEM, IO}, - paint=PaintInfo, - data=reset_data() - }} - catch _:Err -> - io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), - {stop, Err} - end. + Panel = wxPanel:new(Parent, [{style,Style}]), + Opts = [{flag, ?wxEXPAND bor Border}, {proportion, 1}, {border, 5}], + wxSizer:add(Sizer, Panel, Opts), + #win{name=Name, panel=Panel}. setup_graph_drawing(Panels) -> IsWindows = element(1, os:type()) =:= win32, IgnoreCB = {callback, fun(_,_) -> ok end}, - Do = fun(Panel) -> + Do = fun(#win{panel=Panel}) -> wxWindow:setBackgroundColour(Panel, ?wxWHITE), wxPanel:connect(Panel, paint, [callback]), IsWindows andalso @@ -127,8 +123,8 @@ setup_graph_drawing(Panels) -> SF = wxFont:new(DefSize-2, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL), {F, SF} end, - BlackPen = wxPen:new({0,0,0}, [{width, 2}]), - Pens = [wxPen:new(Col, [{width, 3}]) || Col <- tuple_to_list(colors())], + BlackPen = wxPen:new({0,0,0}, [{width, 1}]), + Pens = [wxPen:new(Col, [{width, 1}]) || Col <- tuple_to_list(colors())], #paint{usegc = UseGC, font = Font, small = SmallFont, @@ -140,12 +136,13 @@ setup_graph_drawing(Panels) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, - #state{panel=Panel, appmon=Old, time=#ti{fetch=F0} = Ti0} = State) -> + #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> case interval_dialog(Panel, Ti0) of Ti0 -> {noreply, State}; - #ti{fetch=F0} = Ti -> %% Same fetch interval - {noreply, State#state{time=Ti}}; - Ti -> %% Changed fetch interval + #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh + Wins = [W#win{max=undefined} || W <- Wins0], + {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti -> %% Changed fetch interval, drop all data {noreply, restart_fetcher(node(Old), State#state{time=Ti})} end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, @@ -157,40 +154,21 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, - #state{active=Active, time=Ti, paint=Paint, - windows=Windows, data=Data}) -> + #state{active=Active, time=Ti, paint=Paint, wins=Windows}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) %% Panel = element(Id, Windows), - Id = if Panel =:= element(?RQ_W, Windows) -> runq; - Panel =:= element(?MEM_W, Windows) -> memory; - Panel =:= element(?IO_W, Windows) -> io - end, - refresh_panel(Panel, Id, Ti, Data, Active, Paint), + Win = lists:keyfind(Panel, #win.panel, Windows), + refresh_panel(Active, Win, Ti, Paint), ok. -refresh_panel(Panel, Id, Ti, Data, Active, #paint{usegc=UseGC} = Paint) -> +refresh_panel(Active, #win{name=_Id, panel=Panel}=Win, Ti, #paint{usegc=UseGC}=Paint) -> %% PaintDC must be created in a callback to work on windows. - IsWindows = element(1, os:type()) =:= win32, - DC = if IsWindows -> - %% Ugly hack to aviod flickering on windows, works on windows only - %% But the other platforms are doublebuffered by default - wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC); - true -> - wxPaintDC:new(Panel) - end, - IsWindows andalso wxDC:clear(DC), - GC = if UseGC -> ?wxGC:create(DC); - true -> DC - end, %% Nothing is drawn until wxPaintDC is destroyed. - try - draw(Ti, Id, {UseGC, GC}, Panel, Paint, Data, Active) - catch _:Err -> - io:format("Internal error ~p ~p~n",[Err, erlang:get_stacktrace()]) + GC = make_gc(Panel, UseGC), + if Active -> draw_win(GC, Win, Ti, Paint); + true -> ignore end, - UseGC andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC). - + destroy_gc(GC). %%%%%%%%%% handle_call(Event, From, _State) -> @@ -199,32 +177,39 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). %%%%%%%%%% -handle_info(Stats = {stats, 1, _, _, _}, - State = #state{panel=Panel, data=Data, active=Active, - time=#ti{tick=Tick, disp=Disp0}=Ti}) -> - Disp = trunc(Disp0), - Next = max(Tick - Disp, 0), +handle_info({stats, 1, _, _, _} = Stats, + #state{panel=Panel, samples=Data, active=Active, wins=Wins0, + time=#ti{tick=Tick, disp=Disp0}=Ti} = State0) -> if Active -> + Disp = trunc(Disp0), + Next = max(Tick - Disp, 0), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), + {Wins, Samples} = add_data(Stats, Data, Wins0, Ti, Active), + State = precalc(State0#state{time=Ti#ti{tick=Next}, wins=Wins, samples=Samples}), wxWindow:refresh(Panel), - erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}); - true -> ignore - end, - {noreply, State#state{time=Ti#ti{tick=Next}, data = add_data(Stats, Data, Ti)}}; + {noreply, State}; + true -> + {Wins1, Samples} = add_data(Stats, Data, Wins0, Ti, Active), + Wins = [W#win{max=undefined} || W <- Wins1], + {noreply, State0#state{samples=Samples, wins=Wins, time=Ti#ti{tick=0}}} + end; -handle_info({refresh, Seq}, State = #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=Ti}) +handle_info({refresh, Seq}, #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=Ti} = State0) when (Seq+1) < (DispF*1.5) -> Next = Seq+1, - wxWindow:refresh(Panel), erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, Next}), - {noreply, State#state{time=Ti#ti{tick=Next}}}; + State = precalc(State0#state{time=Ti#ti{tick=Next}}), + catch wxWindow:refresh(Panel), + {noreply, State}; handle_info({refresh, _}, State) -> {noreply, State}; -handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old} = State) -> +handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old, time=_Ti} = State) -> create_menus(Parent, []), try Node = node(Old), wxWindow:refresh(Panel), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), {noreply, State#state{active=true}} catch _:_ -> {noreply,restart_fetcher(Node, State)} @@ -244,7 +229,6 @@ handle_info(_Event, State) -> %%%%%%%%%% terminate(_Event, #state{appmon=Pid}) -> catch Pid ! exit, - cprof:pause(), ok. code_change(_, _, State) -> State. @@ -252,18 +236,68 @@ code_change(_, _, State) -> restart_fetcher(Node, #state{appmon=Old, panel=Panel, time=#ti{fetch=Freq}=Ti}=State) -> catch Old ! exit, Me = self(), - Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, 10000 div Freq]), + Pid = spawn_link(Node, observer_backend, fetch_stats, [Me, round(1000/Freq)]), wxWindow:refresh(Panel), - cprof:start(?MODULE, '_'), - State#state{active=true, appmon=Pid, data=reset_data(), time=Ti#ti{tick=0}}. + precalc(State#state{active=true, appmon=Pid, samples=reset_data(), time=Ti#ti{tick=0}}). reset_data() -> {0, queue:new()}. -add_data(Stats, {N, Q}, #ti{fetch=Fetch, secs=Secs}) when N > Secs*Fetch div 10 -> - {N, queue:drop(queue:in(Stats, Q))}; -add_data(Stats, {N, Q}, _) -> - {N+1, queue:in(Stats, Q)}. +add_data(Stats, {N, Q0}, Wins, #ti{fetch=Fetch, secs=Secs}, Active) when N > (Secs*Fetch+1) -> + {{value, Drop}, Q} = queue:out(Q0), + add_data_1(Wins, Stats, N, {Drop,Q}, Active); +add_data(Stats, {N, Q}, Wins, _, Active) -> + add_data_1(Wins, Stats, N+1, {empty, Q}, Active). + +add_data_1([#win{state={_,St}}|_]=Wins0, Last, N, {Drop, Q}, Active) + when St /= undefined -> + {Wins, Stat} = + lists:mapfoldl(fun(Win0, Entry) -> + {Win1,Stat} = add_data_2(Win0, Last, Entry), + case Active of + true -> + Win = add_data_3(Win1, N, Drop, Stat, Q), + {Win, Stat}; + false -> + {Win1, Stat} + end + end, #{}, Wins0), + {Wins, {N,queue:in(Stat#{}, Q)}}; +add_data_1(Wins, Stats, 1, {_, Q}, _) -> + {[Win#win{state=init_data(Id, Stats), + info = info(Id, Stats)} + || #win{name=Id}=Win <- Wins], {0,Q}}. + +add_data_2(#win{name=Id, state=S0}=Win, Stats, Map) -> + {V1, S1} = collect_data(Id, Stats, S0), + {Win#win{state=S1}, Map#{Id=>V1}}. + +add_data_3(#win{name=Id, max={{OldMax, OldEntry},_,_,_}, + geom=#{scale:={WS,HS}}, state={Max,_}, + graphs=Graphs}=Win, + N, Drop0, Last, Q1) + when N > 3 -> + Drop = case Drop0 of + #{Id:=D} -> D; + _ -> Drop0 + end, + case {max_value(Max), Drop =:= OldEntry} of + {OldMax, false} -> + #{Id:=V4} = Last, + {{value, #{Id:=V3}},Q2} = queue:out_r(Q1), + {{value, #{Id:=V2}},Q3} = queue:out_r(Q2), + {{value, #{Id:=V1}},_} = queue:out_r(Q3), + Vals = [V1,V2,V3,V4], + Gs = tuple_size(V1), + Info = lists:zip(lists:seq(Gs, 1, -1), Graphs), + Lines = [add_lines(Vals, Drop, Prev, I, WS, HS) || {I, Prev} <- Info], + Win#win{graphs=Lines, no_samples=N}; + _W -> %% Max changed Trigger complete recalc + Win#win{max=undefined} + end; +add_data_3(Win, _, _, _,_) -> + %% Trigger complete recalc + Win#win{max=undefined}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -276,7 +310,7 @@ interval_dialog(Parent0, #ti{fetch=Fetch0, secs=Secs0}=Ti) -> Dialog = wxDialog:new(Parent, ?wxID_ANY, "Load Chart Settings", [{style, ?wxDEFAULT_DIALOG_STYLE bor ?wxRESIZE_BORDER}]), - {Sl1,FetchSl} = slider(Dialog, "Fetch (ms)", 10000 div Fetch0, 100, 10000), + {Sl1,FetchSl} = slider(Dialog, "Sample (ms)", trunc(1000 / Fetch0), 100, 10000), {Sl2, SecsSl} = slider(Dialog, "Length (min)", Secs0 div 60, 1, 10), TopSizer = wxBoxSizer:new(?wxVERTICAL), Flags = [{flag, ?wxEXPAND bor ?wxTOP bor ?wxLEFT bor ?wxRIGHT}, @@ -288,9 +322,9 @@ interval_dialog(Parent0, #ti{fetch=Fetch0, secs=Secs0}=Ti) -> wxSizer:setSizeHints(TopSizer, Dialog), Res = case wxDialog:showModal(Dialog) of ?wxID_OK -> - Fetch = 10000 div wxSlider:getValue(FetchSl), + Fetch = 1000 / wxSlider:getValue(FetchSl), Secs = wxSlider:getValue(SecsSl) * 60, - Ti#ti{fetch=Fetch, secs=Secs, disp=10*?DISP_FREQ/Fetch}; + Ti#ti{fetch=Fetch, secs=Secs, disp=?DISP_FREQ/Fetch}; ?wxID_CANCEL -> Ti end, @@ -320,164 +354,216 @@ step(_Ev = #wxScroll{commandInt=Value}, Slider, Min) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -collect_data(runq, {N, Q}) -> - case queue:to_list(Q) of - [] -> {0, 0, [], []}; - [_] -> {0, 0, [], []}; - [{stats, _Ver, Init0, _IO, _Mem}|Data0] -> - Init = lists:sort(Init0), - [_|Data=[First|_]] = lists:foldl(fun({stats, _, T0, _, _}, [Prev|Acc]) -> - TN = lists:sort(T0), - Delta = calc_delta(TN, Prev), - [TN, list_to_tuple(Delta)|Acc] - end, [Init], Data0), - NoGraphs = tuple_size(First), - {N, lmax(Data), lists:reverse([First|Data]), lists:seq(1, NoGraphs)} - end; -collect_data(memory, {N, Q}) -> - MemT = mem_types(), - Data = [list_to_tuple([Value || {Type,Value} <- MemInfo, - lists:member(Type, MemT)]) - || {stats, _Ver, _RQ, _IO, MemInfo} <- queue:to_list(Q)], - {N, lmax(Data), Data, MemT}; -collect_data(io, {N, Q}) -> - case queue:to_list(Q) of - [] -> {0, 0, [], []}; - [_] -> {0, 0, [], []}; - [{stats, _Ver, _RQ, {{_,In0}, {_,Out0}}, _Mem}|Data0] -> - [_,_|Data=[First|_]] = - lists:foldl(fun({stats, _, _, {{_,In}, {_,Out}}, _}, [PIn,Pout|Acc]) -> - [In,Out,{In-PIn,Out-Pout}|Acc] - end, [In0,Out0], Data0), - {N, lmax(Data), lists:reverse([First|Data]), [input, output]} - end; -collect_data(alloc, {N, Q}) -> - List = queue:to_list(Q), - Data = [list_to_tuple([Carrier || {_Type,_Block,Carrier} <- MemInfo]) - || MemInfo <- List], - Info = case List of %% Varies depending on erlang build config/platform - [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; - _ -> [] - end, - {N, lmax(Data), Data, Info}; - -collect_data(utilz, {N, Q}) -> - List = queue:to_list(Q), - Data = [list_to_tuple([round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo]) - || MemInfo <- List], - Info = case List of %% Varies depending on erlang build config/platform - [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; - _ -> [] - end, - {N, lmax(Data), Data, Info}. - - -mem_types() -> - [total, processes, atom, binary, code, ets]. -lmax([]) -> 0; -lmax(List) -> - Max = [lists:max(tuple_to_list(T)) || T <- List, - tuple_size(T) > 0], - case Max of - [] -> 0; - _ -> lists:max(Max) +mk_max() -> {0, undefined}. +max_value({Max,_}) -> Max. +%% max_data({_,Data}) -> Data. matched in function head + +lmax(MState, Tuple, Tuple) when is_tuple(Tuple) -> + lmax(MState, tuple_to_list(Tuple), Tuple); +lmax(MState, Values, State) -> + Max = max_value(MState), + New = lists:max([Max|Values]), + case New >= Max of + false -> MState; + true -> {New, State} end. +init_data(runq, {stats, _, T0, _, _}) -> {mk_max(),lists:sort(T0)}; +init_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}) -> {mk_max(), {In0,Out0}}; +init_data(memory, _) -> {mk_max(), info(memory, undefined)}; +init_data(alloc, _) -> {mk_max(), ok}; +init_data(utilz, _) -> {mk_max(), ok}. + +info(runq, {stats, _, T0, _, _}) -> lists:seq(1, length(T0)); +info(memory, _) -> [total, processes, atom, binary, code, ets]; +info(io, _) -> [input, output]; +info(alloc, First) -> [Type || {Type, _, _} <- First]; +info(utilz, First) -> [Type || {Type, _, _} <- First]; +info(_, []) -> []. + +collect_data(runq, {stats, _, T0, _, _}, {Max,S0}) -> + S1 = lists:sort(T0), + Delta = calc_delta(S1, S0), + Sample = list_to_tuple(Delta), + {Sample, {lmax(Max,Delta,Sample), S1}}; +collect_data(io, {stats, _, _, {{_,In0}, {_,Out0}}, _}, {Max,{PIn,POut}}) -> + In = In0-PIn, + Out = Out0-POut, + Sample = {In, Out}, + {Sample, {lmax(Max, [In,Out], Sample), {In0, Out0}}}; +collect_data(memory, {stats, _, _, _, MemInfo}, {Max, MemTypes}) -> + Vs = [Value || {Type,Value} <- MemInfo, lists:member(Type, MemTypes)], + Sample = list_to_tuple(Vs), + {Sample, {lmax(Max, Vs, Sample),MemTypes}}; +collect_data(alloc, MemInfo, Max) -> + Vs = [Carrier || {_Type,_Block,Carrier} <- MemInfo], + Sample = list_to_tuple(Vs), + {Sample, lmax(Max, Vs, Sample)}; +collect_data(utilz, MemInfo, Max) -> + Vs = [round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo], + Sample = list_to_tuple(Vs), + {Sample, lmax(Max,Vs,Sample)}. + calc_delta([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|calc_delta(Ss, Ps)]; calc_delta([], []) -> []. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -draw(#ti{tick=Tick, fetch=FetchFreq0, secs=Secs, disp=DispFreq}, - Id, DC, Panel, - Paint=#paint{pens=Pens, small=Small}, - Data, Active) -> - %% This can be optimized a lot by collecting data once - %% and draw to memory and then blit memory and only draw new entries in new memory - %% area. Hmm now rewritten to use ?wxGC I don't now if it is feasable. - {Len, Max0, Hs, Info} = collect_data(Id, Data), - {Max,_,_} = MaxDisp = calc_max(Id, Max0), +precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> + Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], + State#state{wins=Wins}. + +precalc(Ti, {NoSamples,Q}, Paint, #win{name=Id, panel=Panel}=Win) -> Size = wxWindow:getClientSize(Panel), - {X0,Y0,WS0,HS,DrawBs} = draw_borders(Id, Info, DC, Size, Secs, MaxDisp, Paint), - FetchFreq = FetchFreq0/10, - WS = WS0/FetchFreq, - Last = Secs*FetchFreq*WS+X0-1, + case Win of + #win{max=Max, no_samples=NoSamples, size=Size} when is_tuple(Max) -> + Win; + _SomeThingChanged -> + Hs = [Vals || #{Id:=Vals} <- queue:to_list(Q)], + Max = lists:foldl(fun(Vals,Max) -> lmax(Max, Vals, Vals) end, + mk_max(), Hs), + MaxDisp = calc_max(Id, Max), + #{scale:={WS,HS}} = Props = window_geom(Size, MaxDisp, Ti, Panel, Paint), + NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, + Graphs = [make_lines(Hs, I, WS, HS) || I <- lists:seq(NoGraphs, 1, -1)], + State = case Win#win.state of + undefined -> {Max, undefined}; + {_, St} -> {Max, St} + end, + Win#win{geom=Props, size=Size, + max=MaxDisp, + graphs=Graphs, + no_samples=NoSamples, + state=State} + end. + +window_geom({W,H}, {_, Max, _Unit, MaxUnit}, + #ti{secs=Secs, fetch=FetchFreq}, + Panel, #paint{font=Font}) -> + Str1 = observer_lib:to_str(MaxUnit), + Str2 = observer_lib:to_str(MaxUnit div 2), + Str3 = observer_lib:to_str(0), + {TW,TH,_,_} = wxWindow:getTextExtent(Panel, Str1, [{theFont, Font}]), + {SpaceW, _,_,_} = wxWindow:getTextExtent(Panel, "W", [{theFont, Font}]), + X0 = ?BW+TW+?BW, + X1 = W-?BW*4, + MaxTextY = TH+?BH, + BottomTextY = H-?BH-TH, + Y0 = MaxTextY + (TH / 2), + Y1 = BottomTextY - TH - ?BH, + + ScaleW = (X1-X0-1)/(Secs*FetchFreq), + ScaleH = (Y1-Y0-1) / Max, + #{p0=>{X0,Y0}, p1=>{X1,Y1}, scale=>{ScaleW, ScaleH}, + txsz=>{TW,TH,SpaceW}, txt=>{BottomTextY, MaxTextY}, strs=>{Str1,Str2,Str3}}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +draw_win(DC, #win{no_samples=Samples, geom=#{scale:={WS,HS}}, graphs=Graphs, max={_,Max,_,_}}=Win, + #ti{tick=Tick, fetch=FetchFreq, secs=Secs, disp=DispFreq}=Ti, + Paint=#paint{pens=Pens}) when Samples >= 2, Graphs =/= [] -> + %% Draw graphs + {X0,Y0,DrawBs} = draw_borders(DC, Ti, Win, Paint), Offset = Tick / DispFreq, - Start = max(Secs*FetchFreq+1-Len, 0)*WS+X0 - Offset*WS, - %% Id == io andalso io:format("~p ~p~n", [Tick, DispFreq]), - Samples = length(Hs), - NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, - case Active andalso Samples > 1 andalso NoGraphs > 0 of - true -> - Draw = fun(N) -> - Lines = make_lines(Hs, Start, N, {X0,Max*HS,Last}, Y0, WS, HS), - setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)), - strokeLines(DC, Lines), - N+1 - end, - [Draw(I) || I <- lists:seq(NoGraphs, 1, -1)], - DrawBs(); - false -> - DrawBs(), - Text = case Active andalso Samples =< 1 of + Full = case Samples > (1+Secs*FetchFreq) of + true -> 1; + false -> 2 + end, + Start = X0 + (max(Secs*FetchFreq+Full-Samples, 0) - Offset)*WS, + Last = Secs*FetchFreq*WS+X0, + Draw = fun(Lines0, N) -> + setPen(DC, element(1+ ((N-1) rem tuple_size(Pens)), Pens)), + Order = lists:reverse(Lines0), + [{_,Y}|Lines] = translate(Order, {Start, Y0}, 0, WS, {X0,Max*HS,Last}, []), + strokeLines(DC, [{Last,Y}|Lines]), + N-1 + end, + lists:foldl(Draw, length(Graphs), Graphs), + DrawBs(), + ok; + +draw_win(DC, #win{no_samples=Samples} = Win,Ti, #paint{small=Small}=Paint) -> + %% Draw Error Msg + try draw_borders(DC, Ti, Win, Paint) of + {X0,_Y0,DrawBs} -> + Text = case Samples =< 1 of true -> "Waiting for data"; false -> "Information not available" end, setFont(DC, Small, {0,0,0}), - drawText(DC, Text, X0 + 100, element(2,Size) div 2) - end, - ok. + {_,WW} = getSize(DC), + drawText(DC, Text, X0 + 100, WW div 2), + DrawBs(), + ok + catch _:_ -> %% Early redraws fail + ok + end. -make_lines(Ds = [Data|_], PX, N, Clip, ZeroY, WS, HS) -> +translate([{X0,Y}|Rest], {Sx,Sy}=Start, N, WS, {Cx,Cy,Cw}=Clip, Acc) -> + X = min((N-X0)*WS+Sx,Cw), + Next = if X0 > 0 -> N; true -> N+1 end, + case X =< Cx of + true -> + translate(Rest, Start, Next, WS, Clip, [{Cx,Sy-min(Cy,Y)}]); + false -> + translate(Rest, Start, Next, WS, Clip, [{X,Sy-min(Cy,Y)}|Acc]) + end; +translate([], _, _, _, _, Acc) -> + Acc. + +add_lines(Vals, Drop, OldLines, I, WS, HS) -> + Lines = strip(OldLines, Drop, 2), + New = make_lines(Vals, I, WS, HS), + New ++ Lines. + +strip([{X,_}|Rest], Drop, N) when X > 0.0001, N > 0 -> + strip(Rest, Drop, N); +strip([_|Rest], Drop, N) when N > 0 -> + strip(Rest, Drop, N-1); +strip(List, empty, _) -> List; +strip(List, _, _) -> + lists:reverse(strip(lists:reverse(List), empty, 1)). + +make_lines(Ds = [Data|_], N, WS, HS) -> Y = element(N,Data), - make_lines(Ds, PX, N, Clip, ZeroY, WS, HS, Y, []). + make_lines(Ds, N, WS, HS, Y, []). -make_lines([D1 | Ds = [D2|Rest]], PX, N, Clip={Cx,Cy, _}, ZeroY, WS, HS, Y0, Acc0) -> +make_lines([D1 | Ds = [D2|Rest]], N, WS, HS, Y0, Acc0) -> Y1 = element(N,D1), Y2 = element(N,D2), Y3 = case Rest of [D3|_] -> element(N,D3); [] -> Y2 end, - This = {max(Cx, PX),ZeroY-min(Cy,Y1*HS)}, + This = {0, Y1*HS}, Acc = if (abs(Y1-Y2) * HS) < 3.0 -> [This|Acc0]; WS < 3.0 -> [This|Acc0]; - PX < Cx -> - make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,Acc0); - true -> - make_splines(Y0,Y1,Y2,Y3,PX,Clip,ZeroY,WS,HS,[This|Acc0]) + true -> make_splines(Y0,Y1,Y2,Y3,WS,HS,[This|Acc0]) end, - make_lines(Ds, PX+WS, N, Clip, ZeroY, WS, HS, Y1, Acc); -make_lines([D1], _PX, N, {_,Cy,Last}, ZeroY, _WS, HS, _Y0, Acc) -> - Y1 = element(N,D1), - [{Last,ZeroY-min(Cy, Y1*HS)}|Acc]. + make_lines(Ds, N, WS, HS, Y1, Acc); +make_lines([_D1], _N, _WS, _HS, _Y0, Acc) -> + Acc. -make_splines(Y00,Y10,Y20,Y30,PX,Clip,ZeroY,WS,HS,Acc) -> +make_splines(Y00,Y10,Y20,Y30,WS,HS,Acc) -> Y1 = Y10*HS, Y2 = Y20*HS, - Steps = min(abs(Y1-Y2), WS), + Steps = min(abs(Y1-Y2), WS/2), if Steps > 2 -> Y0 = Y00*HS, Y3 = Y30*HS, Tan = spline_tan(Y0,Y1,Y2,Y3), Delta = 1/Steps, - splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, PX, Clip,ZeroY, Delta*WS, Acc); + splines(Steps-1, 0.0, Delta, Tan, Y1,Y2, Acc); true -> Acc end. -splines(N, XD, XD0, Tan, Y1,Y2, PX0, Clip={Cx,Cy,_},ZeroY, WS, Acc) when N > 0 -> - PX = PX0+WS, +splines(N, XD, XD0, Tan, Y1,Y2, Acc) when N > 0 -> Delta = XD+XD0, - if PX < Cx -> - splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS, Acc); - true -> - Y = min(Cy, max(0,spline(Delta, Tan, Y1,Y2))), - splines(N-1, Delta, XD0, Tan, Y1, Y2, PX, Clip,ZeroY, WS, - [{PX, ZeroY-Y}|Acc]) - end; -splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, _PX, _Clip,_ZeroY, _WS, Acc) -> Acc. + Y = max(0, spline(Delta, Tan, Y1,Y2)), + splines(N-1, Delta, XD0, Tan, Y1, Y2, [{1.0-Delta, Y}|Acc]); +splines(_N, _XD, _XD0, _Tan, _Y1,_Y2, Acc) -> + Acc. spline(T, {M1, M2}, Y1, Y2) -> %% Hermite Basis Funcs @@ -497,34 +583,19 @@ spline_tan(Y0, Y1, Y2, Y3) -> M2 = S*C*(Y3-Y1), {M1,M2}. --define(BW, 5). --define(BH, 5). - -draw_borders(Type, Info, DC, {W,H}, Secs, {Max, Unit, MaxUnit}, +draw_borders(DC, #ti{secs=Secs, fetch=FetchFreq}, + #win{name=Type, geom=Geom, info=Info, max={_,_,Unit,_}}, #paint{pen=Pen, pen2=Pen2, font=Font, small=Small}) -> - Str1 = observer_lib:to_str(MaxUnit), - Str2 = observer_lib:to_str(MaxUnit div 2), - Str3 = observer_lib:to_str(0), + #{p0:={GraphX0, GraphY0}, p1:={GraphX1,GraphY1}, scale:={ScaleW0,_}, + txsz:={TW,TH,SpaceW}, txt:={BottomTextY, MaxTextY}, strs:={Str1,Str2,Str3}} = Geom, - setFont(DC, Font, {0,0,0}), - {TW,TH} = getTextExtent(DC, Str1), - {SpaceW, _} = getTextExtent(DC, "W"), - - GraphX0 = ?BW+TW+?BW, - GraphX1 = W-?BW*4, + ScaleW = ScaleW0*FetchFreq, TopTextX = ?BW*3+TW, - MaxTextY = TH+?BH, - BottomTextY = H-?BH-TH, SecondsY = BottomTextY - TH, - GraphY0 = MaxTextY + (TH / 2), - GraphY1 = SecondsY - ?BH, - GraphW = GraphX1-GraphX0-1, - GraphH = GraphY1-GraphY0-1, + GraphY25 = GraphY0 + (GraphY1 - GraphY0) / 4, GraphY50 = GraphY0 + (GraphY1 - GraphY0) / 2, GraphY75 = GraphY0 + 3*(GraphY1 - GraphY0) / 4, - ScaleW = GraphW / Secs, - ScaleH = GraphH / Max, setFont(DC, Small, {0,0,0}), Align = fun(Str, Y) -> @@ -607,7 +678,7 @@ draw_borders(Type, Info, DC, {W,H}, Secs, {Max, Unit, MaxUnit}, {GraphX1, GraphY1+1}, {GraphX1, GraphY0-1}, {GraphX0, GraphY0-1}]) end, - {GraphX0+1, GraphY1, ScaleW, ScaleH, DrawBorder}. + {GraphX0+1, GraphY1, DrawBorder}. to_string(Atom) -> Name = atom_to_list(Atom), @@ -624,43 +695,44 @@ uppercase([C|Rest]) -> calc_max(Type, Max) -> bytes(Type, Max). -calc_max1(Max) when Max < 10 -> - 10; -calc_max1(Max) -> - case Max div 10 of - X when X < 10 -> - case Max rem 10 of - 0 -> Max; - _ -> - (X+1)*10 - end; - X -> - 10*calc_max1(X) - end. - -bytes(runq, Val) -> - Upper = calc_max1(Val), - {Upper, "", Upper}; -bytes(utilz, Val) -> - Upper = calc_max1(Val), - {Upper, "", Upper}; -bytes(_, B) -> +bytes(runq, Max) -> + Upper = calc_max1(max_value(Max)), + {Max, Upper, "", Upper}; +bytes(utilz, Max) -> + Upper = calc_max1(max_value(Max)), + {Max, Upper, "", Upper}; +bytes(_, Max) -> + B = max_value(Max), KB = B div 1024, MB = KB div 1024, GB = MB div 1024, if GB > 10 -> Upper = calc_max1(GB), - {Upper*1024*1024*1024, "(GB)", Upper}; + {Max, Upper*1024*1024*1024, "(GB)", Upper}; MB > 10 -> Upper = calc_max1(MB), - {Upper*1024*1024, "(MB)", Upper}; + {Max, Upper*1024*1024, "(MB)", Upper}; KB > 0 -> Upper = calc_max1(KB), - {Upper*1024, "(KB)", Upper}; + {Max, Upper*1024, "(KB)", Upper}; true -> Upper = calc_max1(B), - {Upper, "(B)", Upper} + {Max, Upper, "(B)", Upper} + end. + +calc_max1(Max) when Max < 10 -> + 10; +calc_max1(Max) -> + case Max div 10 of + X when X < 10 -> + case Max rem 10 of + 0 -> Max; + _ -> + (X+1)*10 + end; + X -> + 10*calc_max1(X) end. colors() -> @@ -673,6 +745,25 @@ colors() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% wxDC and ?wxGC wrappers +make_gc(Panel,UseGC) -> + DC = case os:type() of + {win32, _} -> + %% Ugly hack to avoid flickering on windows, works on windows only + %% But the other platforms are doublebuffered by default + DC0 = wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC), + wxDC:clear(DC0), + DC0; + _ -> + wxPaintDC:new(Panel) + end, + if UseGC -> {?wxGC:create(DC), DC}; + true -> {false, DC} + end. + +destroy_gc({GC, DC}) -> + (GC =/= false) andalso ?wxGC:destroy(GC), + wxPaintDC:destroy(DC). + haveGC() -> try wxGraphicsRenderer:getDefaultRenderer(), @@ -680,44 +771,48 @@ haveGC() -> catch _:_ -> false end. +getSize({_, DC}) -> + wxDC:getSize(DC). + setPen({false, DC}, Pen) -> wxDC:setPen(DC, Pen); -setPen({true, GC}, Pen) -> +setPen({GC, _}, Pen) -> ?wxGC:setPen(GC, Pen). setFont({false, DC}, Font, Color) -> wxDC:setTextForeground(DC, Color), wxDC:setFont(DC, Font); -setFont({true, GC}, Font, Color) -> +setFont({GC, _}, Font, Color) -> ?wxGC:setFont(GC, Font, Color). setBrush({false, DC}, Brush) -> wxDC:setBrush(DC, Brush); -setBrush({true, GC}, Brush) -> +setBrush({GC, _}, Brush) -> ?wxGC:setBrush(GC, Brush). strokeLine({false, DC}, X0, Y0, X1, Y1) -> wxDC:drawLine(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)}); -strokeLine({true, GC}, X0, Y0, X1, Y1) -> +strokeLine({GC, _}, X0, Y0, X1, Y1) -> ?wxGC:strokeLine(GC, X0, Y0, X1, Y1). +strokeLines(_, [_]) -> ok; strokeLines({false, DC}, Lines) -> wxDC:drawLines(DC, [{round(X), round(Y)} || {X,Y} <- Lines]); -strokeLines({true, GC}, Lines) -> +strokeLines({GC, _}, Lines) -> ?wxGC:strokeLines(GC, Lines). drawRoundedRectangle({false, DC}, X0, Y0, X1, Y1, R) -> wxDC:drawRoundedRectangle(DC, {round(X0), round(Y0)}, {round(X1), round(Y1)}, round(R)); -drawRoundedRectangle({true, GC}, X0, Y0, X1, Y1, R) -> +drawRoundedRectangle({GC, _}, X0, Y0, X1, Y1, R) -> ?wxGC:drawRoundedRectangle(GC, X0, Y0, X1, Y1, R). drawText({false, DC}, Str, X, Y) -> wxDC:drawText(DC, Str, {round(X),round(Y)}); -drawText({true, GC}, Str, X, Y) -> +drawText({GC, _}, Str, X, Y) -> ?wxGC:drawText(GC, Str, X, Y). getTextExtent({false, DC}, Str) -> wxDC:getTextExtent(DC, Str); -getTextExtent({true, GC}, Str) -> +getTextExtent({GC, _}, Str) -> {W,H,_,_} = ?wxGC:getTextExtent(GC, Str), {W,H}. -- cgit v1.2.3 From b254f5a83145b348def5950d46628d3f4549585e Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Thu, 18 Feb 2016 11:09:32 +0100 Subject: ssl: Newer cipher suites now presented correctly Older SSL/TLS versions have cipher suites that look like {key_exchange(), cipher(), MAC::hash()} and the hash function used by the PRF (Pseudo Random function) is implicit and always the same for that protocol version. In TLS 1.2 a cipher suite is {key_exchange(), cipher(), MAC::hash(), PRF::hash()}. Internally a cipher suite is always a four tuple but for backwards compatibility older cipher suites will be presented as a three tuples, however new cipher suites should be presented as four tuples. --- lib/ssl/src/ssl_cipher.erl | 31 +++++++++++++++++-------------- lib/ssl/test/ssl_basic_SUITE.erl | 6 ++++++ 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 80c4e5fdcd..974a6ec6b5 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -49,8 +49,11 @@ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -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 erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 + %% TLS 1.2, internally PRE TLS 1.2 will use default_prf + | {key_algo(), cipher(), hash(), hash() | default_prf}. + + -type cipher_suite() :: binary(). -type cipher_enum() :: integer(). -type openssl_cipher_suite() :: string(). @@ -418,7 +421,7 @@ rc4_suites({3, N}) when N =< 3 -> ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> int_cipher_suite(). +-spec suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %% Note: Currently not supported suites are commented away. @@ -723,14 +726,18 @@ suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> {dhe_rsa, chacha20_poly1305, null, sha256}. %%-------------------------------------------------------------------- --spec erl_suite_definition(ssl_cipher:cipher_suite()) -> ssl_cipher:erl_cipher_suite(). +-spec erl_suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. Filters last value %% for now (compatibility reasons). %%-------------------------------------------------------------------- erl_suite_definition(S) -> - {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), - {KeyExchange, Cipher, Hash}. + case suite_definition(S) of + {KeyExchange, Cipher, Hash, default_prf} -> + {KeyExchange, Cipher, Hash}; + Suite -> + Suite + end. %%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). @@ -1395,18 +1402,14 @@ filter(DerCert, Ciphers) -> %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- -filter_suites(Suites = [{_,_,_}|_]) -> +filter_suites(Suites = [Value|_]) when is_tuple(Value) -> Algos = crypto:supports(), + Hashs = proplists:get_value(hashs, Algos), lists:filter(fun({KeyExchange, Cipher, Hash}) -> is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)) - end, Suites); - -filter_suites(Suites = [{_,_,_,_}|_]) -> - Algos = crypto:supports(), - Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun({KeyExchange, Cipher, Hash, Prf}) -> + is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)); + ({KeyExchange, Cipher, Hash, Prf}) -> is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso is_acceptable_hash(Hash, Hashs) andalso diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 9be99afe48..1a864edb8b 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -4197,6 +4197,12 @@ first_rsa_suite([{dhe_rsa, _, _} = Suite| _]) -> Suite; first_rsa_suite([{rsa, _, _} = Suite| _]) -> Suite; +first_rsa_suite([{ecdhe_rsa, _, _, _} = Suite | _]) -> + Suite; +first_rsa_suite([{dhe_rsa, _, _, _} = Suite| _]) -> + Suite; +first_rsa_suite([{rsa, _, _, _} = Suite| _]) -> + Suite; first_rsa_suite([_ | Rest]) -> first_rsa_suite(Rest). -- cgit v1.2.3 From 0ff06d3941ce4487f18f11dde66dd6c28068e833 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 9 Feb 2016 13:53:23 +0100 Subject: ssh: remove some spurions test printouts --- lib/ssh/test/ssh_algorithms_SUITE.erl | 9 +++++++-- lib/ssh/test/ssh_basic_SUITE.erl | 11 +++++++++-- lib/ssh/test/ssh_test_lib.erl | 9 ++++----- 3 files changed, 20 insertions(+), 9 deletions(-) diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index f0ac92fef6..a0f1edd5fb 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -231,8 +231,11 @@ sshc_simple_exec(Config) -> " ",Host," 1+1."]), ct:log("~p",[Cmd]), SshPort = open_port({spawn, Cmd}, [binary]), + Expect = <<"2\n">>, receive - {SshPort,{data, <<"2\n">>}} -> + {SshPort, {data,Expect}} -> + ct:log("Got expected ~p from ~p",[Expect,SshPort]), + port_close(SshPort), ok after ?TIMEOUT -> ct:fail("Did not receive answer") @@ -273,7 +276,9 @@ sshd_simple_exec(_Config) -> ConnectionRef, ChannelId1); Other1 -> ct:fail(Other1) - end. + end, + ssh:close(ConnectionRef). + %%%================================================================ %%% diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 4b53f6ec57..642e7a82a2 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -441,6 +441,7 @@ exec(Config) when is_list(Config) -> ct:fail(Other1) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1), + ssh:close(ConnectionRef), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- @@ -474,6 +475,7 @@ exec_compressed(Config) when is_list(Config) -> ct:fail(Other) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef), ssh:stop_daemon(Pid) end. @@ -979,7 +981,10 @@ shell_no_unicode(Config) -> new_do_shell(?config(io,Config), [new_prompt, {type,"io:format(\"hej ~p~n\",[42])."}, - {expect,"hej 42"} + {expect,"hej 42"}, + {expect,"ok"}, + new_prompt, + {type,"exit()."} ]). %%-------------------------------------------------------------------- @@ -988,7 +993,9 @@ shell_unicode_string(Config) -> [new_prompt, {type,"io:format(\"こにちわ~ts~n\",[\"四二\"])."}, {expect,"こにちわ四二"}, - {expect,"ok"} + {expect,"ok"}, + new_prompt, + {type,"exit()."} ]). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 2db55b97b4..5f91fb627a 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -120,7 +120,8 @@ std_simple_exec(Host, Port, Config, Opts) -> Other -> ct:fail(Other) end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId). + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), + ssh:close(ConnectionRef). start_shell(Port, IOServer, UserDir) -> @@ -154,14 +155,12 @@ loop_io_server(TestCase, Buff0) -> {input, TestCase, Line} -> loop_io_server(TestCase, Buff0 ++ [Line]); {io_request, From, ReplyAs, Request} -> -%%ct:log("~p",[{io_request, From, ReplyAs, Request}]), {ok, Reply, Buff} = io_request(Request, TestCase, From, ReplyAs, Buff0), -%%ct:log("io_request(~p)-->~p",[Request,{ok, Reply, Buff}]), io_reply(From, ReplyAs, Reply), loop_io_server(TestCase, Buff); - {'EXIT',_, _} -> - erlang:display('ssh_test_lib:loop_io_server/2 EXIT'), + {'EXIT',_, _} = _Exit -> +%% ct:log("ssh_test_lib:loop_io_server/2 got ~p",[_Exit]), ok after 30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE]) -- cgit v1.2.3 From 8626ba1bf825899ffad119aca5ae126176b0b6d3 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 16 Feb 2016 12:07:05 +0100 Subject: ssh: add timetrap to all test suites --- lib/ssh/test/ssh_algorithms_SUITE.erl | 3 ++- lib/ssh/test/ssh_basic_SUITE.erl | 3 ++- lib/ssh/test/ssh_connection_SUITE.erl | 3 +++ lib/ssh/test/ssh_options_SUITE.erl | 3 ++- lib/ssh/test/ssh_protocol_SUITE.erl | 3 ++- lib/ssh/test/ssh_renegotiate_SUITE.erl | 4 +++- lib/ssh/test/ssh_sftp_SUITE.erl | 4 +++- lib/ssh/test/ssh_sftpd_SUITE.erl | 3 +++ lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl | 4 +++- lib/ssh/test/ssh_to_openssh_SUITE.erl | 3 +++ lib/ssh/test/ssh_upgrade_SUITE.erl | 3 +++ 11 files changed, 29 insertions(+), 7 deletions(-) diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index a0f1edd5fb..beff561631 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -35,7 +35,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> %% [{group,kex},{group,cipher}... etc diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 642e7a82a2..eee0925dd0 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -78,7 +78,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [app_test, diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 1b93cc9c32..f761442e35 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -36,6 +36,9 @@ %% suite() -> %% [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [ {group, openssh}, diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 6a201d401f..dc0cae37e8 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -79,7 +79,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [connectfun_disconnectfun_server, diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index fe197f8672..41087d2693 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -42,7 +42,8 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> [{group,tool_tests}, diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index e5cfa58bad..4a6bcc102d 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -30,7 +30,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,15}}]. + all() -> [{group,default_algs}, {group,aes_gcm} diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 698af259c8..0d6eb19f0c 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -35,7 +35,9 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. + all() -> [{group, not_unicode}, diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 6b03a2b763..60fe34a152 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -44,6 +44,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [open_close_file, open_close_dir, diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 7a025a6518..91404e222f 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -36,7 +36,9 @@ %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. + all() -> [close_file, diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 67a61d3c11..2fc3cce516 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -33,6 +33,9 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{timetrap,{minutes,5}}]. + all() -> case os:find_executable("ssh") of false -> diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 85f4d36258..1a2a8de08c 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -38,6 +38,9 @@ %%% %%% CommonTest callbacks %%% +suite() -> + [{timetrap,{minutes,5}}]. + all() -> [ minor_upgrade, -- cgit v1.2.3 From 0f54fc85b91b5ad244534238aeab5c0bc5f93815 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Wed, 17 Feb 2016 13:40:42 +0100 Subject: ssh: remove calls to crypto:start|stop Conflicts: lib/ssh/test/ssh_upgrade_SUITE.erl --- lib/ssh/test/ssh_algorithms_SUITE.erl | 16 +++++----------- lib/ssh/test/ssh_basic_SUITE.erl | 13 ++++--------- lib/ssh/test/ssh_benchmark_SUITE.erl | 5 +---- lib/ssh/test/ssh_connection_SUITE.erl | 12 +++--------- lib/ssh/test/ssh_options_SUITE.erl | 13 ++++--------- lib/ssh/test/ssh_protocol_SUITE.erl | 20 ++++---------------- lib/ssh/test/ssh_renegotiate_SUITE.erl | 12 +++--------- lib/ssh/test/ssh_sftp_SUITE.erl | 20 ++++++-------------- lib/ssh/test/ssh_sftpd_SUITE.erl | 25 +++++++++---------------- lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl | 27 ++++++++++----------------- lib/ssh/test/ssh_to_openssh_SUITE.erl | 17 +++++------------ lib/ssh/test/ssh_upgrade_SUITE.erl | 22 ++++++---------------- 12 files changed, 60 insertions(+), 142 deletions(-) diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index beff561631..8ccde6c29c 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -91,18 +91,12 @@ init_per_suite(Config) -> ?MAX_NUM_ALGORITHMS ]), ct:log("all() ->~n ~p.~n~ngroups()->~n ~p.~n",[all(),groups()]), - catch crypto:stop(), - case catch crypto:start() of - ok -> - ssh:start(), - [{std_simple_sftp_size,25000} % Sftp transferred data size - | setup_pubkey(Config)]; - _Else -> - {skip, "Crypto could not be started!"} - end. + ssh:start(), + [{std_simple_sftp_size,25000} % Sftp transferred data size + | setup_pubkey(Config)]. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). init_per_group(Group, Config) -> diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index eee0925dd0..564fb66586 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -130,16 +130,11 @@ basic_tests() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). + %%-------------------------------------------------------------------- init_per_group(dsa_key, Config) -> DataDir = ?config(data_dir, Config), diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index e90bfa3d16..fe90da3028 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -44,9 +44,7 @@ groups() -> init_per_suite(Config) -> catch ssh:stop(), - catch crypto:stop(), try - ok = crypto:start(), report_client_algorithms(), ok = ssh:start(), {ok,TracerPid} = erlang_trace(), @@ -58,7 +56,6 @@ init_per_suite(Config) -> end_per_suite(_Config) -> catch ssh:stop(), - catch crypto:stop(), ok. @@ -406,7 +403,7 @@ function_algs_times_sizes(EncDecs, L) -> end || EncDec <- EncDecs, C = #call{mfa = ED, - args = Args, %%[S,Data], + % args = Args, %%[S,Data], t_call = T0, t_return = T1} <- L, ED == EncDec diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index f761442e35..67d870bea4 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -70,16 +70,10 @@ ptty() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. -end_per_suite(_Config) -> - crypto:stop(). +end_per_suite(Config) -> + Config. %%-------------------------------------------------------------------- init_per_group(openssh, Config) -> diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index dc0cae37e8..e0ef3a4b05 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -126,16 +126,11 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). + %%-------------------------------------------------------------------- init_per_group(hardening_tests, Config) -> DataDir = ?config(data_dir, Config), diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 41087d2693..b6603d29e5 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -580,23 +580,11 @@ client_handles_keyboard_interactive_0_pwds(Config) -> %%%---- init_suite and end_suite --------------------------------------- start_apps(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - catch ssh:stop(), - ok = ssh:start(), - [{stop_apps, - fun() -> - ssh:stop(), - crypto:stop() - end} | Config]; - _Else -> - {skip, "Crypto could not be started!"} - end. - + catch ssh:stop(), + ok = ssh:start(), + Config. -stop_apps(Config) -> - (?v(stop_apps, Config, fun()-> ok end))(), +stop_apps(_Config) -> ssh:stop(). diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index 4a6bcc102d..fabe9a5829 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -46,16 +46,10 @@ tests() -> [rekey, rekey_limit, renegotiate1, renegotiate2]. %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. + Config. + end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(). + ssh:stop(). %%-------------------------------------------------------------------- init_per_group(aes_gcm, Config) -> diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 0d6eb19f0c..6066221fc7 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -46,22 +46,14 @@ all() -> init_per_suite(Config) -> - catch crypto:stop(), - case (catch crypto:start()) of - ok -> - ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p", - [file:native_name_encoding(),io:getopts()]), - ssh:start(), - Config; - _ -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(Config) -> - ssh:stop(), - crypto:stop(), + ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p", + [file:native_name_encoding(),io:getopts()]), + ssh:start(), Config. +end_per_suite(_onfig) -> + ssh:stop(). + %%-------------------------------------------------------------------- groups() -> [{not_unicode, [], [{group,erlang_server}, diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 60fe34a152..687f327206 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -72,28 +72,21 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - catch crypto:stop(), - case (catch crypto:start()) of - ok -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - %% to make sure we don't use public-key-auth - %% this should be tested by other test suites - UserDir = filename:join(?config(priv_dir, Config), nopubkey), - file:make_dir(UserDir), - Config; - _ -> - {skip,"Could not start crypto!"} - end. + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + %% to make sure we don't use public-key-auth + %% this should be tested by other test suites + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + file:make_dir(UserDir), + Config. end_per_suite(Config) -> SysDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), - ssh:stop(), - crypto:stop(). + ssh:stop(). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 91404e222f..84410f60e6 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -55,29 +55,22 @@ groups() -> init_per_suite(Config) -> catch ssh:stop(), - catch crypto:stop(), - case catch crypto:start() of - ok -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), - c:c(FileAlt), - FileName = filename:join(DataDir, "test.txt"), - {ok, FileInfo} = file:read_file_info(FileName), - ok = file:write_file_info(FileName, - FileInfo#file_info{mode = 8#400}), - ssh_test_lib:setup_dsa(DataDir, PrivDir), - Config; - _Else -> - {skip,"Could not start ssh!"} - end. + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), + c:c(FileAlt), + FileName = filename:join(DataDir, "test.txt"), + {ok, FileInfo} = file:read_file_info(FileName), + ok = file:write_file_info(FileName, + FileInfo#file_info{mode = 8#400}), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + Config. end_per_suite(Config) -> UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), SysDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), - crypto:stop(), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 2fc3cce516..37885dfdef 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -60,21 +60,14 @@ groups() -> ]. init_per_suite(Config) -> - catch crypto:stop(), - case catch crypto:start() of - ok -> - case gen_tcp:connect("localhost", 22, []) of - {error,econnrefused} -> - {skip,"No openssh deamon"}; - _ -> - ssh_test_lib:openssh_sanity_check(Config) - end; - _Else -> - {skip,"Could not start crypto!"} + case gen_tcp:connect("localhost", 22, []) of + {error,econnrefused} -> + {skip,"No openssh deamon"}; + _ -> + ssh_test_lib:openssh_sanity_check(Config) end. end_per_suite(_Config) -> - crypto:stop(), ok. init_per_group(erlang_server, Config) -> diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 1a2a8de08c..006483d3ee 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -48,27 +48,17 @@ all() -> ]. init_per_suite(Config0) -> - catch crypto:stop(), - try {crypto:start(), erlang:system_info({wordsize, internal}) == - erlang:system_info({wordsize, external})} of - {ok, true} -> - case ct_release_test:init(Config0) of - {skip, Reason} -> - {skip, Reason}; - Config -> - ssh:start(), - Config - end; - {ok, false} -> - {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} - catch _:_ -> - {skip, "Crypto did not start"} + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + ssh:start(), + Config end. end_per_suite(Config) -> ct_release_test:cleanup(Config), ssh:stop(), - crypto:stop(), UserDir = ?config(priv_dir, Config), ssh_test_lib:clean_rsa(UserDir). -- cgit v1.2.3 From faa11910e0214ba05747ca8579e14efa421e3d02 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Mon, 22 Feb 2016 10:58:45 +0100 Subject: ssh: catch port_close in test --- lib/ssh/test/ssh_algorithms_SUITE.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 8ccde6c29c..a03a9ee0f2 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -230,7 +230,7 @@ sshc_simple_exec(Config) -> receive {SshPort, {data,Expect}} -> ct:log("Got expected ~p from ~p",[Expect,SshPort]), - port_close(SshPort), + catch port_close(SshPort), ok after ?TIMEOUT -> ct:fail("Did not receive answer") -- cgit v1.2.3 From f10621e0cd4321834d072d2c495fc84066f04cd3 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 18 Feb 2016 15:01:15 +0100 Subject: Fix a few dialyzer warnings --- erts/preloaded/src/prim_file.erl | 3 +- lib/asn1/src/asn1ct_check.erl | 5 ++- lib/common_test/src/ct_run.erl | 16 +++++++-- lib/common_test/src/ct_slave.erl | 4 +-- .../src/CosNotifyFilter_Filter_impl.erl | 3 +- .../src/CosNotifyFilter_MappingFilter_impl.erl | 3 +- lib/cosTime/src/CosTime_TimeService_impl.erl | 3 +- .../CosTransactions_TransactionFactory_impl.erl | 3 +- lib/cosTransactions/src/ETraP_Server_impl.erl | 6 +++- lib/eunit/src/eunit_listener.erl | 2 +- lib/mnesia/src/mnesia_bup.erl | 8 +++-- lib/mnesia/src/mnesia_lib.erl | 3 +- lib/mnesia/src/mnesia_log.erl | 8 +++-- lib/observer/src/observer_traceoptions_wx.erl | 4 +-- lib/orber/src/orber_ifr.erl | 4 ++- lib/orber/src/orber_ifr_orb.erl | 3 +- lib/orber/src/orber_ifr_repository.erl | 3 +- lib/orber/src/orber_iiop.erl | 4 +-- lib/orber/src/orber_iiop_inrequest.erl | 4 ++- lib/orber/src/orber_pi.erl | 4 ++- lib/test_server/src/test_server.erl | 41 ++++++++++++++-------- lib/test_server/src/test_server_node.erl | 21 +++++++---- 22 files changed, 106 insertions(+), 49 deletions(-) diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index c87b2645ec..ab5359ebbc 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1276,6 +1276,7 @@ lseek_position(_) -> %% Translates the response from the driver into %% {ok, Result} or {error, Reason}. +-dialyzer({no_improper_lists, translate_response/2}). translate_response(?FILE_RESP_OK, []) -> ok; translate_response(?FILE_RESP_ERROR, List) when is_list(List) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 4d17cfb966..f2c895bfaa 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1552,9 +1552,11 @@ match_syntax_objset_1(_, {object,_,_}=Object, ClassDef) -> make_objset(ClassDef, Set) -> #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. +-spec syntax_match_error(_) -> no_return(). syntax_match_error(S) -> asn1_error(S, syntax_nomatch). +-spec syntax_match_error(_, _) -> no_return(). syntax_match_error(S, What0) -> What = printable_string(What0), asn1_error(S, {syntax_nomatch,What}). @@ -5745,6 +5747,7 @@ return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), {structured_error,{Where,Pos},?MODULE,Error}. +-spec asn1_error(_, _) -> no_return(). asn1_error(S, Error) -> throw({error,return_asn1_error(S, Error)}). diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 0b646ffd07..b4364b87ff 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -909,7 +909,7 @@ run_test(StartOpt) when is_tuple(StartOpt) -> run_test([StartOpt]); run_test(StartOpts) when is_list(StartOpts) -> - CTPid = spawn(fun() -> run_test1(StartOpts) end), + CTPid = spawn(run_test1_fun(StartOpts)), Ref = monitor(process, CTPid), receive {'DOWN',Ref,process,CTPid,{user_error,Error}} -> @@ -918,6 +918,11 @@ run_test(StartOpts) when is_list(StartOpts) -> Other end. +-spec run_test1_fun(_) -> fun(() -> no_return()). + +run_test1_fun(StartOpts) -> + fun() -> run_test1(StartOpts) end. + run_test1(StartOpts) when is_list(StartOpts) -> case proplists:get_value(refresh_logs, StartOpts) of undefined -> @@ -1369,7 +1374,7 @@ run_dir(Opts = #opts{logdir = LogDir, %%% @equiv ct:run_testspec/1 %%%----------------------------------------------------------------- run_testspec(TestSpec) -> - CTPid = spawn(fun() -> run_testspec1(TestSpec) end), + CTPid = spawn(run_testspec1_fun(TestSpec)), Ref = monitor(process, CTPid), receive {'DOWN',Ref,process,CTPid,{user_error,Error}} -> @@ -1378,6 +1383,11 @@ run_testspec(TestSpec) -> Other end. +-spec run_testspec1_fun(_) -> fun(() -> no_return()). + +run_testspec1_fun(TestSpec) -> + fun() -> run_testspec1(TestSpec) end. + run_testspec1(TestSpec) -> {ok,Cwd} = file:get_cwd(), io:format("~nCommon Test starting (cwd is ~ts)~n~n", [Cwd]), diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 0cd83b9f04..3ad3937548 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2015. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -315,7 +315,7 @@ enodename(Host, Node) -> do_start(Host, Node, Options) -> ENode = enodename(Host, Node), Functions = - lists:concat([[{ct_slave, slave_started, [ENode, self()]}], + lists:append([[{ct_slave, slave_started, [ENode, self()]}], Options#options.startup_functions, [{ct_slave, slave_ready, [ENode, self()]}]]), Functions2 = if diff --git a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl index 75510ebeca..0f997049e0 100644 --- a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl +++ b/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -336,6 +336,7 @@ match_structured(_,_,What) -> %% Returns : boolean() | %% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData} %%----------------------------------------------------------- +-spec match_typed(_, _, _) -> no_return(). match_typed(_OE_THIS, _State, _Data) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}). diff --git a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl index 3718664674..03c0e03be6 100644 --- a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl +++ b/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -298,6 +298,7 @@ match_structured(_,_,_) -> %% Returns : boolean() , #any{} (out-type) | %% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData} %%----------------------------------------------------------- +-spec match_typed(_, _, _) -> no_return(). match_typed(_OE_THIS, _State, _Data) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}). diff --git a/lib/cosTime/src/CosTime_TimeService_impl.erl b/lib/cosTime/src/CosTime_TimeService_impl.erl index f139998f42..72c65757ad 100644 --- a/lib/cosTime/src/CosTime_TimeService_impl.erl +++ b/lib/cosTime/src/CosTime_TimeService_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -107,6 +107,7 @@ universal_time(OE_THIS, State) -> %% Arguments: %% Returns : {'EXCEPTION", #'CosTime_TimeUnavailable'{}} %%----------------------------------------------------------- +-spec secure_universal_time(_, _) -> no_return(). secure_universal_time(_OE_THIS, _State) -> corba:raise(#'CosTime_TimeUnavailable'{}). diff --git a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl index e0d14299a3..e24bcb9a04 100644 --- a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl +++ b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -169,6 +169,7 @@ create(_Self, _State, _TimeOut) -> %% Effect : %%------------------------------------------------------------ +-spec recreate(_, _, _) -> no_return(). recreate(_Self, _State, #'CosTransactions_PropagationContext'{current = _C}) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). %recreate(Self, State, #'CosTransactions_PropagationContext'{current = C}) -> diff --git a/lib/cosTransactions/src/ETraP_Server_impl.erl b/lib/cosTransactions/src/ETraP_Server_impl.erl index 7b451e1762..5c7b5f6350 100644 --- a/lib/cosTransactions/src/ETraP_Server_impl.erl +++ b/lib/cosTransactions/src/ETraP_Server_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -675,6 +675,7 @@ is_same_transaction(Self, {Env, Local}, Coordinator) -> %% Effect : %%------------------------------------------------------------ +-spec is_related_transaction(_, _, _) -> no_return(). is_related_transaction(_Self, {_Env, _Local}, _Coordinator) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). % type_check(?tr_get_typeCheck(Env), ?tr_Coordinator, @@ -689,6 +690,7 @@ is_related_transaction(_Self, {_Env, _Local}, _Coordinator) -> %% Effect : %%------------------------------------------------------------ +-spec is_ancestor_transaction(_, _, _) -> no_return(). is_ancestor_transaction(_Self, {_Env, _Local}, _Coordinator) -> corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}). % type_check(?tr_get_typeCheck(Env), ?tr_Coordinator, @@ -826,6 +828,7 @@ register_subtran_aware(Self, {Env, Local}, SubTrAwareResource) -> %% Effect : %%------------------------------------------------------------ +-spec register_synchronization(_, _, _) -> no_return(). register_synchronization(_Self, {_Env, _Local}, _Synchronization) -> corba:raise(#'CosTransactions_SynchronizationUnavailable'{}). @@ -950,6 +953,7 @@ create_subtransaction(Self, {Env, Local}) -> %% Effect : %%------------------------------------------------------------ +-spec get_txcontext(_, _) -> no_return(). get_txcontext(_Self, {_Env, _Local}) -> corba:raise(#'CosTransactions_Unavailable'{}). diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index d9b836863b..c34eacb1d6 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -50,7 +50,7 @@ start(Callback, Options) -> spawn_opt(init_fun(St, Options), proplists:get_all_values(spawn, Options)). --spec init_fun(_, _) -> no_return(). +-spec init_fun(_, _) -> fun(() -> no_return()). init_fun(St0, Options) -> fun () -> diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 1f150ae38b..8b1143a352 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -112,7 +112,7 @@ iter(R, Header, Schema, Fun, Acc, BupItems) -> safe_apply(R, write, [_, Items]) when Items =:= [] -> R; safe_apply(R, What, Args) -> - Abort = fun(Re) -> abort_restore(R, What, Args, Re) end, + Abort = abort_restore_fun(R, What, Args), Mod = R#restore.bup_module, try apply(Mod, What, Args) of {ok, Opaque, Items} when What =:= read -> @@ -127,6 +127,10 @@ safe_apply(R, What, Args) -> Abort(Re) end. +-spec abort_restore_fun(_, _, _) -> fun((_) -> no_return()). +abort_restore_fun(R, What, Args) -> + fun(Re) -> abort_restore(R, What, Args, Re) end. + abort_restore(R = #restore{bup_module=Mod}, What, Args, Reason) -> dbg_out("Restore aborted. ~p:~p~p -> ~p~n", [Mod, What, Args, Reason]), diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 77c7a7638d..0f1354f43e 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -403,6 +403,7 @@ other_val_1(Var) -> _ -> error end. +-spec pr_other(_) -> no_return(). pr_other(Var) -> Why = case is_running() of diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 8b19e13ff6..36135418c8 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -734,7 +734,7 @@ backup_schema(B, Tabs) -> safe_apply(B, write, [_, Items]) when Items == [] -> B; safe_apply(B, What, Args) -> - Abort = fun(R) -> abort_write(B, What, Args, R) end, + Abort = abort_write_fun(B, What, Args), receive {'EXIT', Pid, R} -> Abort({'EXIT', Pid, R}) after 0 -> @@ -746,6 +746,10 @@ safe_apply(B, What, Args) -> end end. +-spec abort_write_fun(_, _, _) -> fun((_) -> no_return()). +abort_write_fun(B, What, Args) -> + fun(R) -> abort_write(B, What, Args, R) end. + abort_write(B, What, Args, Reason) -> Mod = B#backup_args.module, Opaque = B#backup_args.opaque, diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index 56ac96a91f..9ba9b72b6f 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -665,7 +665,7 @@ get_file(Text) -> Str = wxTextCtrl:getValue(Text), Dialog = wxFileDialog:new(Text, [{message, "Select a file"}, - {default_file, Str}]), + {defaultFile, Str}]), case wxDialog:showModal(Dialog) of ?wxID_OK -> Dir = wxFileDialog:getDirectory(Dialog), diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl index cc23d9e242..70e0cb3fca 100644 --- a/lib/orber/src/orber_ifr.erl +++ b/lib/orber/src/orber_ifr.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -780,6 +780,7 @@ find_repository() -> 'Repository__get_def_kind'(Objref) -> orber_ifr_repository:'_get_def_kind'(Objref). +-spec 'Repository_destroy'(_) -> no_return(). 'Repository_destroy'(Objref) -> orber_ifr_repository:destroy(Objref). 'Repository_lookup'(Objref,Search_name) -> @@ -1405,6 +1406,7 @@ find_repository() -> orber_ifr_orb:create_wstring_tc(Bound). 'ORB_create_sequence_tc'(Bound,Element_type) -> orber_ifr_orb:create_sequence_tc(Bound,Element_type). +-spec 'ORB_create_recursive_sequence_tc'(_,_) -> no_return(). 'ORB_create_recursive_sequence_tc'(Bound,Offset) -> orber_ifr_orb:create_recursive_sequence_tc(Bound,Offset). 'ORB_create_array_tc'(Length,Element_type) -> diff --git a/lib/orber/src/orber_ifr_orb.erl b/lib/orber/src/orber_ifr_orb.erl index a408a9a749..3969bbf37a 100644 --- a/lib/orber/src/orber_ifr_orb.erl +++ b/lib/orber/src/orber_ifr_orb.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -89,6 +89,7 @@ create_wstring_tc(Bound) -> create_sequence_tc(Bound, Element_type) -> {tk_sequence,Element_type,Bound}. +-spec create_recursive_sequence_tc(_, _) -> no_return(). create_recursive_sequence_tc(Bound, Offset) -> orber:dbg("[~p] ~p:create_recursive_sequence_tc(~p, ~p);~n" "Create_recursive_sequence is not implemented.~n", diff --git a/lib/orber/src/orber_ifr_repository.erl b/lib/orber/src/orber_ifr_repository.erl index 898fba99f3..8d52573e53 100644 --- a/lib/orber/src/orber_ifr_repository.erl +++ b/lib/orber/src/orber_ifr_repository.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -66,6 +66,7 @@ '_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) -> orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}). +-spec destroy(_) -> no_return(). destroy({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) -> orber:dbg("[~p] ~p:destroy(~p, ~p);~n" "Destroying a repository is an error.~n", diff --git a/lib/orber/src/orber_iiop.erl b/lib/orber/src/orber_iiop.erl index d23cd74146..8cb39c7365 100644 --- a/lib/orber/src/orber_iiop.erl +++ b/lib/orber/src/orber_iiop.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -176,7 +176,7 @@ request({Host, Port, InitObjkey, Index, TaggedProfile, HostData}, corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}) end. - +-dialyzer({no_improper_lists, encode_request/1}). encode_request(#giop_env{interceptors = false} = Env) -> case catch cdr_encode:enc_request(Env) of {'EXCEPTION', Exc} -> diff --git a/lib/orber/src/orber_iiop_inrequest.erl b/lib/orber/src/orber_iiop_inrequest.erl index 625bfd3e86..9d84b63398 100644 --- a/lib/orber/src/orber_iiop_inrequest.erl +++ b/lib/orber/src/orber_iiop_inrequest.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -240,6 +240,7 @@ check_context([_|Rest], Acc, Env) -> %%----------------------------------------------------------------- %% Func: call_interceptors %%----------------------------------------------------------------- +-dialyzer({no_improper_lists, call_interceptors/7}). call_interceptors(SocketType, #giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env, ReqHdr, Rest, Len, ByteOrder, Msg) -> @@ -276,6 +277,7 @@ call_interceptors(SocketType, #giop_env{interceptors = {portable, _PIs}} = Env, %%----------------------------------------------------------------- %% Func: call_interceptors_out %%----------------------------------------------------------------- +-dialyzer({no_improper_lists, call_interceptors_out/7}). call_interceptors_out(#giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env, ReqId, Result, Obj, Type, Operation, TypeCodes) -> ReqHdr = #request_header{object_key = Obj, diff --git a/lib/orber/src/orber_pi.erl b/lib/orber/src/orber_pi.erl index 11c489bb17..19bb7af6c0 100644 --- a/lib/orber/src/orber_pi.erl +++ b/lib/orber/src/orber_pi.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1030,6 +1030,7 @@ receive_exception(CRI, Mod) -> %% SlotId - ulong() %% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}} %%------------------------------------------------------------ +-spec get_slot(_, _) -> no_return(). get_slot(_XRI, _SlotId) -> corba:raise(#'PortableInterceptor_InvalidSlot'{}). @@ -1185,6 +1186,7 @@ get_server_policy(#'ServerRequestInfo'{contexts = Ctxs}, _PolicyType) -> %% Data - #any{} %% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}} %%------------------------------------------------------------ +-spec set_slot(_, _, _) -> no_return(). set_slot(_SRI, _SlotId, _Data) -> corba:raise(#'PortableInterceptor_InvalidSlot'{}). diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index da6bf491ac..73803030a3 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-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -411,11 +411,9 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> Ref = make_ref(), Pid = spawn_link( - fun() -> - run_test_case_eval(Mod, Func, Args, Name, Ref, - RunInit, TimetrapData, - LogOpts, TCCallback) - end), + run_test_case_eval_fun(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, + LogOpts, TCCallback)), put(test_server_detected_fail, []), St = #st{ref=Ref,pid=Pid,mf={Mod,Func},last_known_loc=unknown, status=starting,ret_val=[],comment="",timeout=infinity, @@ -907,6 +905,16 @@ job_proxy_msgloop() -> end, job_proxy_msgloop(). +-spec run_test_case_eval_fun(_, _, _, _, _, _, _, _, _) -> + fun(() -> no_return()). +run_test_case_eval_fun(Mod, Func, Args, Name, Ref, RunInit, + TimetrapData, LogOpts, TCCallback) -> + fun () -> + run_test_case_eval(Mod, Func, Args, Name, Ref, + RunInit, TimetrapData, + LogOpts, TCCallback) + end. + %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader @@ -2408,15 +2416,7 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> end, Master = self(), Ref = make_ref(), - Slave = spawn(Node, - fun () -> - start_job_proxy(), - receive - Ref -> - Master ! {Ref, Fun()} - end, - receive after infinity -> infinity end - end), + Slave = spawn(Node, start_job_proxy_fun(Master, Fun)), MRef = erlang:monitor(process, Slave), Slave ! Ref, receive @@ -2431,6 +2431,17 @@ run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> end end. +-spec start_job_proxy_fun(_, _) -> fun(() -> no_return()). +start_job_proxy_fun(Master, Fun) -> + fun () -> + start_job_proxy(), + receive + Ref -> + Master ! {Ref, Fun()} + end, + receive after infinity -> infinity end + end. + %% Return true if Name or node() is a shielded node is_shielded(Name) -> case {cast_to_list(Name),atom_to_list(node())} of diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index e870a55398..70cc2625d4 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -354,15 +354,18 @@ start_node_peer(SlaveName, OptList, From, TI) -> I = "=== Not waiting for node", gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}), Self = self(), - spawn_link( - fun() -> - wait_for_node_started(LSock,Tmo,undefined, - Cleanup,TI,Self), - receive after infinity -> ok end - end), + spawn_link(wait_for_node_started_fun(LSock,Tmo,Cleanup,TI,Self)), ok end. +-spec wait_for_node_started_fun(_, _, _, _, _) -> fun(() -> no_return()). +wait_for_node_started_fun(LSock, Tmo, Cleanup, TI, Self) -> + fun() -> + wait_for_node_started(LSock,Tmo,undefined, + Cleanup,TI,Self), + receive after infinity -> ok end + end. + %% %% Slave nodes are started on a remote host if %% - the option remote is given when calling test_server:start_node/3 @@ -468,7 +471,11 @@ handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) -> node_started([Host,PortAtom]) -> %% Must spawn a new process because the boot process should not %% hang forever!! - spawn(fun() -> node_started(Host,PortAtom) end). + spawn(node_started_fun(Host,PortAtom)). + +-spec node_started_fun(_, _) -> fun(() -> no_return()). +node_started_fun(Host,PortAtom) -> + fun() -> node_started(Host,PortAtom) end. %% This process hangs forever, just waiting for the socket to be %% closed and terminating the node -- cgit v1.2.3 From d166333d3c0d0584841f90654d63934edd076c5c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 23 Feb 2016 17:22:56 +0100 Subject: typos --- HOWTO/INSTALL.md | 2 +- configure.in | 2 +- erts/configure.in | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 0b78f4ca56..a823d5abbc 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -381,7 +381,7 @@ Some of the available `configure` options are: if different than specified by `--with-ssl=PATH` * `--with-ssl-rpath=yes|no|PATHS` - Runtime library path for OpenSSL. Default is `yes`, which equates to a number of standard locations. If - `no`, then no runtime library paths wil be used. Anything else should be + `no`, then no runtime library paths will be used. Anything else should be a comma separated list of paths. * `--with-libatomic_ops=PATH` - Use the `libatomic_ops` library for atomic memory accesses. If `configure` should inform you about no native atomic diff --git a/configure.in b/configure.in index 64b0bdac6d..40498f2ff9 100644 --- a/configure.in +++ b/configure.in @@ -271,7 +271,7 @@ AC_ARG_WITH(ssl-rpath, AS_HELP_STRING([--with-ssl-rpath=yes|no|PATHS], [runtime library path for OpenSSL. Default is 'yes', which equates to a number of standard locations. If 'no', then no runtime - library paths wil be used. Anything else should be a + library paths will be used. Anything else should be a comma separated list of paths.])) AC_ARG_ENABLE(dynamic-ssl-lib, diff --git a/erts/configure.in b/erts/configure.in index 4fb725ff00..c7b095d47a 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -4111,7 +4111,7 @@ AC_ARG_WITH(ssl-rpath, AS_HELP_STRING([--with-ssl-rpath=yes|no|PATHS], [runtime library path for OpenSSL. Default is "yes", which equates to a number of standard locations. If "no", then no runtime - library paths wil be used. Anything else should be a + library paths will be used. Anything else should be a comma separated list of paths.]), [ case X$with_ssl in -- cgit v1.2.3 From a5e66520d92d283d14f1352dcfd0ce889c27a0c5 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 23 Feb 2016 18:31:52 +0100 Subject: Do not wait for main lock when looking up process not running --- erts/emulator/beam/erl_process.c | 102 +++++++++++++++++++++++++++------------ 1 file changed, 71 insertions(+), 31 deletions(-) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b24f26138c..adea745471 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -6462,9 +6462,6 @@ suspend_process(Process *c_p, Process *p) if (suspended) { - ASSERT(!(ERTS_PSFLG_RUNNING & state) - || p == erts_get_current_process()); - if (suspended > 0 && erts_system_profile_flags.runnable_procs) { /* 'state' is before our change... */ @@ -8411,9 +8408,8 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, resume_process(rp, rp_locks); } else { - rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, - pid, pid_locks|ERTS_PROC_LOCK_STATUS); + pid, ERTS_PROC_LOCK_STATUS); if (!rp) { c_p->flags &= ~F_P2PNR_RESCHED; @@ -8422,40 +8418,84 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, ASSERT(!(c_p->flags & F_P2PNR_RESCHED)); - if (suspend) { - if (suspend_process(c_p, rp)) - goto done; - } - else { - if (!((ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS) - & erts_smp_atomic32_read_acqb(&rp->state))) - goto done; + /* + * Suspend the other process in order to prevent + * it from being selected for normal execution. + * This will however not prevent it from being + * selected for execution of a system task. If + * it is selected for execution of a system task + * we might be blocked for quite a while if the + * try-lock below fails. That is, there is room + * for improvement here... + */ - } + if (!suspend_process(c_p, rp)) { + /* Other process running */ - /* Other process running */ + ASSERT(ERTS_PSFLG_RUNNING + & erts_smp_atomic32_read_nob(&rp->state)); - /* - * If we got pending suspenders and suspend ourselves waiting - * to suspend another process we might deadlock. - * In this case we have to yield, be suspended by - * someone else and then do it all over again. - */ - if (!c_p->pending_suspenders) { - /* Mark rp pending for suspend by c_p */ - add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend); - ASSERT(is_nil(c_p->suspendee)); + running: - /* Suspend c_p; when rp is suspended c_p will be resumed. */ - suspend_process(c_p, c_p); - c_p->flags |= F_P2PNR_RESCHED; + /* + * If we got pending suspenders and suspend ourselves waiting + * to suspend another process we might deadlock. + * In this case we have to yield, be suspended by + * someone else and then do it all over again. + */ + if (!c_p->pending_suspenders) { + /* Mark rp pending for suspend by c_p */ + add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend); + ASSERT(is_nil(c_p->suspendee)); + + /* Suspend c_p; when rp is suspended c_p will be resumed. */ + suspend_process(c_p, c_p); + c_p->flags |= F_P2PNR_RESCHED; + } + /* Yield (caller is assumed to yield immediately in bif). */ + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + rp = ERTS_PROC_LOCK_BUSY; + } + else { + ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS; + if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) { + if (ERTS_PSFLG_RUNNING_SYS + & erts_smp_atomic32_read_nob(&rp->state)) { + /* Executing system task... */ + resume_process(rp, ERTS_PROC_LOCK_STATUS); + goto running; + } + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + /* + * If we are unlucky, the process just got selected for + * execution of a system task. In this case we may be + * blocked here for quite a while... Execution of system + * tasks are fortunately quite rare events. We try to + * avoid this by checking if it is in a state executing + * system tasks (above), but it will not prevent all + * scenarios for a long block here... + */ + rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, + pid, pid_locks|ERTS_PROC_LOCK_STATUS); + if (!rp) + goto done; + } + + /* + * The previous suspend has prevented the process + * from being selected for normal execution regardless + * of locks held or not held on it... + */ + ASSERT(!(ERTS_PSFLG_RUNNING + & erts_smp_atomic32_read_nob(&rp->state))); + + if (!suspend) + resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS); } - /* Yield (caller is assumed to yield immediately in bif). */ - erts_smp_proc_unlock(rp, pid_locks|ERTS_PROC_LOCK_STATUS); - rp = ERTS_PROC_LOCK_BUSY; } done: + if (rp && rp != ERTS_PROC_LOCK_BUSY && !(pid_locks & ERTS_PROC_LOCK_STATUS)) erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); if (unlock_c_p_status) -- cgit v1.2.3 From 6bd691c8e528c2e8cf3aded8f3877b18ecff4c58 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Wed, 24 Feb 2016 10:10:35 +0100 Subject: Update preloaded module --- erts/preloaded/ebin/prim_file.beam | Bin 44892 -> 44980 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index 97170551bf..9256e35553 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ -- cgit v1.2.3 From 97ff595e4e0303f597e671b17045940ba8da0330 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Tue, 13 Oct 2015 14:03:03 +0200 Subject: [erl_interface] Correct documentation Fix mistakes found by 'xmllint'. --- lib/erl_interface/doc/src/ei.xml | 8 ++++---- lib/erl_interface/doc/src/erl_call.xml | 4 ++-- lib/erl_interface/doc/src/erl_eterm.xml | 4 ++++ 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 6044ac8ef7..8ef433d10f 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -264,9 +264,9 @@ typedef enum { Encode an atom

Encodes an atom in the binary format with character encoding - to_enc (latin1 or utf8). + to_enc (latin1 or utf8). The p parameter is the name of the atom with character encoding - from_enc (ascii, latin1 or utf8). + from_enc (ascii, latin1 or utf8). The name must either be zero-terminated or a function variant with a len parameter must be used. If to_enc is set to the bitwise-or'd combination (ERLANG_LATIN1|ERLANG_UTF8), utf8 encoding is only used if the atom string @@ -569,8 +569,8 @@ ei_x_encode_string(&x, "Banana");

This function decodes an atom from the binary format. The null terminated name of the atom is placed in buffer at p of length plen bytes.

-

The wanted string encoding is specified by - want. The original encoding used in the +

The wanted string encoding is specified by + want. The original encoding used in the binary format (latin1 or utf8) can be obtained from *was. The actual encoding of the resulting string (7-bit ascii, latin1 or utf8) can be obtained from *result. Both was and result can be NULL. diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call.xml index aed1ba0ac9..e982bf89e1 100644 --- a/lib/erl_interface/doc/src/erl_call.xml +++ b/lib/erl_interface/doc/src/erl_call.xml @@ -178,7 +178,7 @@ erl_call -s -a 'erlang halt' -n madonna -

Evaluates a couple of expressions. The input ends with EOF (Control-D).

+

Evaluates a couple of expressions. The input ends with EOF (Control-D).

-

Compiles a module and runs it. Again, the input ends with EOF (Control-D). (In the example shown, the output has been formatted afterwards).

+

Compiles a module and runs it. Again, the input ends with EOF (Control-D). (In the example shown, the output has been formatted afterwards).

+ A string representing atom . + The length (in bytes) of atom t. @@ -95,6 +97,7 @@ The floating point value of . + The Node in pid . @@ -108,6 +111,7 @@ The creation number in port . + The node in port . -- cgit v1.2.3