diff options
86 files changed, 2081 insertions, 1419 deletions
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 906c1be17b..185ecd9ed9 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -123,7 +123,7 @@ ok "Hello world!"</code> <p>A better solution for a real module is to take advantage of the new - directive <c>on load</c> (see section + directive <c>on_load</c> (see section <seealso marker="doc/reference_manual:code_loading#on_load">Running a Function When a Module is Loaded</seealso> in the Erlang Reference Manual) to load the NIF library automatically when the module is @@ -135,27 +135,14 @@ ok away by the compiler, causing loading of the NIF library to fail.</p> </note> - <p>A loaded NIF library is tied to the Erlang module code version - that loaded it. If the module is upgraded with a new version, the - new Erlang code need to load its own NIF library (or maybe choose not - to). The new code version can, however, choose to load the - same NIF library as the old code if it wants to. Sharing the - dynamic library means that static data defined by the library - is shared as well. To avoid unintentionally shared static - data, each Erlang module code can keep its own private data. This - private data can be set when the NIF library is loaded and - then retrieved by calling <seealso marker="#enif_priv_data"> - <c>enif_priv_data</c></seealso>.</p> - - <p>A NIF library cannot be loaded explicitly. A library is - automatically unloaded when the module code that it belongs to is purged - by the code server.</p> + <p>Once loaded, a NIF library is persistent. It will not be unloaded + until the module code version that it belongs to is purged.</p> </description> <section> <title>Functionality</title> - <p>All functions that a NIF library needs to do with Erlang are - performed through the NIF API functions. Functions exist + <p>All interaction between NIF code and the Erlang runtime system is + performed by calling NIF API functions. Functions exist for the following functionality:</p> <taglist> @@ -286,6 +273,19 @@ return term;</code> library is postponed as long as there exist resource objects with a destructor function in the library.</p> </item> + <tag>Module upgrade and static data</tag> + <item> + <p>A loaded NIF library is tied to the Erlang module instance + that loaded it. If the module is upgraded, the new module instance + needs to load its own NIF library (or maybe choose not to). The new + module instance can, however, choose to load the exact same NIF library + as the old code if it wants to. Sharing the dynamic library means that + static data defined by the library is shared as well. To avoid + unintentionally shared static data between module instances, each Erlang + module version can keep its own private data. This private data can be + set when the NIF library is loaded and later retrieved by calling + <seealso marker="#enif_priv_data"><c>enif_priv_data</c></seealso>.</p> + </item> <tag>Threads and concurrency</tag> <item> <p>A NIF is thread-safe without any explicit synchronization as @@ -525,7 +525,7 @@ return term;</code> <p><c>load</c> is called when the NIF library is loaded and no previously loaded library exists for this module.</p> <p><c>*priv_data</c> can be set to point to some private data - that the library needs to keep a state between NIF + if the library needs to keep a state between NIF calls. <c>enif_priv_data</c> returns this pointer. <c>*priv_data</c> is initialized to <c>NULL</c> when <c>load</c> is called.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 3dad09365e..b3fab3874b 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4933,7 +4933,9 @@ RealSystem = system + MissedSystem</code> <p>Returns the current call stack back-trace (<em>stacktrace</em>) of the process. The stack has the same format as returned by <seealso marker="#get_stacktrace/0"> - <c>erlang:get_stacktrace/0</c></seealso>.</p> + <c>erlang:get_stacktrace/0</c></seealso>. The depth of the + stacktrace is truncated according to the <c>backtrace_depth</c> + system flag setting.</p> </item> <tag><c>{dictionary, <anno>Dictionary</anno>}</c></tag> <item> @@ -6645,7 +6647,9 @@ ok <fsummary>Set system flag <c>backtrace_depth</c>.</fsummary> <desc> <p>Sets the maximum depth of call stack back-traces in the - exit reason element of <c>'EXIT'</c> tuples.</p> + exit reason element of <c>'EXIT'</c> tuples. The flag + also limits the stacktrace depth returned by <c>process_info</c> + item <c>current_stacktrace.</c></p> <p>Returns the old value of the flag.</p> </desc> </func> @@ -7224,8 +7228,8 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="12"/> + <name name="system_info" arity="1" clause_i="13"/> <fsummary>Information about the CPU topology of the system.</fsummary> <type name="cpu_topology"/> <type name="level_entry"/> @@ -7325,12 +7329,12 @@ ok </func> <func> - <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="29"/> - <name name="system_info" arity="1" clause_i="37"/> + <name name="system_info" arity="1" clause_i="30"/> <name name="system_info" arity="1" clause_i="38"/> <name name="system_info" arity="1" clause_i="39"/> <name name="system_info" arity="1" clause_i="40"/> + <name name="system_info" arity="1" clause_i="41"/> <fsummary>Information about the default process heap settings.</fsummary> <type name="message_queue_data"/> <type name="max_heap_size"/> @@ -7408,7 +7412,7 @@ ok <name name="system_info" arity="1" clause_i="8"/> <name name="system_info" arity="1" clause_i="9"/> <name name="system_info" arity="1" clause_i="10"/> - <name name="system_info" arity="1" clause_i="13"/> + <name name="system_info" arity="1" clause_i="11"/> <name name="system_info" arity="1" clause_i="14"/> <name name="system_info" arity="1" clause_i="15"/> <name name="system_info" arity="1" clause_i="16"/> @@ -7423,14 +7427,14 @@ ok <name name="system_info" arity="1" clause_i="25"/> <name name="system_info" arity="1" clause_i="26"/> <name name="system_info" arity="1" clause_i="27"/> - <name name="system_info" arity="1" clause_i="30"/> + <name name="system_info" arity="1" clause_i="28"/> <name name="system_info" arity="1" clause_i="31"/> <name name="system_info" arity="1" clause_i="32"/> <name name="system_info" arity="1" clause_i="33"/> <name name="system_info" arity="1" clause_i="34"/> <name name="system_info" arity="1" clause_i="35"/> <name name="system_info" arity="1" clause_i="36"/> - <name name="system_info" arity="1" clause_i="41"/> + <name name="system_info" arity="1" clause_i="37"/> <name name="system_info" arity="1" clause_i="42"/> <name name="system_info" arity="1" clause_i="43"/> <name name="system_info" arity="1" clause_i="44"/> @@ -7460,11 +7464,18 @@ ok <name name="system_info" arity="1" clause_i="68"/> <name name="system_info" arity="1" clause_i="69"/> <name name="system_info" arity="1" clause_i="70"/> + <name name="system_info" arity="1" clause_i="71"/> <fsummary>Information about the system.</fsummary> <desc> <p>Returns various information about the current system (emulator) as specified by <c><anno>Item</anno></c>:</p> <taglist> + <tag><c>atom_count</c></tag> + <item> + <marker id="system_info_atom_count"></marker> + <p>Returns the number of atoms currently existing at the + local node. The value is given as an integer.</p> + </item> <tag><c>atom_limit</c></tag> <item> <marker id="system_info_atom_limit"></marker> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index da6190b685..11777f0014 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -145,13 +145,6 @@ <p> Own Id: OTP-14051</p> </item> - <item> - <p> - Fixed a number of bugs that caused faulty stack-traces to - be created on exception when a process was traced.</p> - <p> - Own Id: OTP-14055</p> - </item> </list> </section> diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 5c3565f498..0d725988f0 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -670,7 +670,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } 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", + erts_dsprintf(dsbufp, "Module %T must be purged before deleting\n", BIF_ARG_1); erts_send_error_to_logger(BIF_P->group_leader, dsbufp); ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 613bd5c14e..f64d2df8a8 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1047,9 +1047,11 @@ static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf) NOINLINE; static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa, Eterm* reg, Eterm func) NOINLINE; -static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE; +static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* apply(Process* p, Eterm module, Eterm function, - Eterm args, Eterm* reg) NOINLINE; + Eterm args, Eterm* reg, + BeamInstr *I, Uint offs) NOINLINE; static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args) NOINLINE; static BeamInstr* apply_fun(Process* p, Eterm fun, @@ -3186,7 +3188,7 @@ do { \ OpCase(i_apply): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+1); @@ -3200,7 +3202,7 @@ do { \ OpCase(i_apply_last_P): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -3215,7 +3217,7 @@ do { \ OpCase(i_apply_only): { BeamInstr *next; HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg); + next = apply(c_p, r(0), x(1), x(2), reg, I, 0); HEAVY_SWAPIN; if (next != NULL) { SET_I(next); @@ -3229,7 +3231,7 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), NULL, 0); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, I+2); @@ -3244,7 +3246,7 @@ do { \ BeamInstr *next; HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0)); + next = fixed_apply(c_p, reg, Arg(0), I, Arg(1)); HEAVY_SWAPIN; if (next != NULL) { SET_CP(c_p, (BeamInstr *) E[0]); @@ -5841,12 +5843,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, s->depth = 0; /* - * If the failure was in a BIF other than 'error', 'exit' or - * 'throw', find the bif-table index and save the argument - * registers by consing up an arglist. + * If the failure was in a BIF other than 'error/1', 'error/2', + * 'exit/1' or 'throw/1', find the bif-table index and save the + * argument registers by consing up an arglist. */ - if (bf != NULL && bf != error_1 && bf != error_2 && - bf != exit_1 && bf != throw_1) { + if (bf != NULL && bf != error_1 && bf != error_2 && bf != exit_1 + && bf != throw_1 && bf != wrap_error_1 && bf != wrap_error_2 + && bf != wrap_exit_1 && bf != wrap_throw_1) { int i; int a = 0; for (i = 0; i < BIF_SIZE; i++) { @@ -5942,12 +5945,30 @@ erts_save_stacktrace(Process* p, struct StackTrace* s, int depth) p->cp) { /* Cannot follow cp here - code may be unloaded */ BeamInstr *cpp = p->cp; + int trace_cp; if (cpp == beam_exception_trace || cpp == beam_return_trace) { /* Skip return_trace parameters */ ptr += 2; + trace_cp = 1; } else if (cpp == beam_return_to_trace) { /* Skip return_to_trace parameters */ ptr += 1; + trace_cp = 1; + } + else { + trace_cp = 0; + } + if (trace_cp && s->pc == cpp) { + /* + * If process 'cp' points to a return/exception trace + * instruction and 'cp' has been saved as 'pc' in + * stacktrace, we need to update 'pc' in stacktrace + * with the actual 'cp' located on the top of the + * stack; otherwise, we will lose the top stackframe + * when building the stack trace. + */ + ASSERT(is_CP(p->stop[0])); + s->pc = cp_val(p->stop[0]); } } while (ptr < STACK_START(p) && depth > 0) { @@ -6067,12 +6088,15 @@ build_stacktrace(Process* c_p, Eterm exc) { erts_set_current_function(&fi, s->current); } + depth = s->depth; /* - * If fi.current is still NULL, default to the initial function + * If fi.current is still NULL, and we have no + * stack at all, default to the initial function * (e.g. spawn_link(erlang, abs, [1])). */ if (fi.mfa == NULL) { - erts_set_current_function(&fi, &c_p->u.initial); + if (depth <= 0) + erts_set_current_function(&fi, &c_p->u.initial); args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -6082,10 +6106,9 @@ build_stacktrace(Process* c_p, Eterm exc) { * Look up all saved continuation pointers and calculate * needed heap space. */ - depth = s->depth; stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP, depth*sizeof(FunctionInfo)); - heap_size = fi.needed + 2; + heap_size = fi.mfa ? fi.needed + 2 : 0; for (i = 0; i < depth; i++) { erts_lookup_function_info(stkp, s->trace[i], 1); if (stkp->mfa) { @@ -6104,8 +6127,10 @@ build_stacktrace(Process* c_p, Eterm exc) { res = CONS(hp, mfa, res); hp += 2; } - hp = erts_build_mfa_item(&fi, hp, args, &mfa); - res = CONS(hp, mfa, res); + if (fi.mfa) { + hp = erts_build_mfa_item(&fi, hp, args, &mfa); + res = CONS(hp, mfa, res); + } erts_free(ERTS_ALC_T_TMP, (void *) stk); return res; @@ -6203,8 +6228,107 @@ apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, return ep; } +static ERTS_INLINE void +apply_bif_error_adjustment(Process *p, Export *ep, + Eterm *reg, Uint arity, + BeamInstr *I, Uint stack_offset) +{ + /* + * I is only set when the apply is a tail call, i.e., + * from the instructions i_apply_only, i_apply_last_P, + * and apply_last_IP. + */ + if (I + && ep->beam[0] == (BeamInstr) em_apply_bif + && (ep == bif_export[BIF_error_1] + || ep == bif_export[BIF_error_2] + || ep == bif_export[BIF_exit_1] + || ep == bif_export[BIF_throw_1])) { + /* + * We are about to tail apply one of the BIFs + * erlang:error/1, erlang:error/2, erlang:exit/1, + * or erlang:throw/1. Error handling of these BIFs is + * special! + * + * We need 'p->cp' to point into the calling + * function when handling the error after the BIF has + * been applied. This in order to get the topmost + * stackframe correct. Without the following adjustment, + * 'p->cp' will point into the function that called + * current function when handling the error. We add a + * dummy stackframe in order to achive this. + * + * Note that these BIFs unconditionally will cause + * an exception to be raised. That is, our modifications + * of 'p->cp' as well as the stack will be corrected by + * the error handling code. + * + * If we find an exception/return-to trace continuation + * pointer as the topmost continuation pointer, we do not + * need to do anything since the information already will + * be available for generation of the stacktrace. + */ + int apply_only = stack_offset == 0; + BeamInstr *cpp; + + if (apply_only) { + ASSERT(p->cp != NULL); + cpp = p->cp; + } + else { + ASSERT(is_CP(p->stop[0])); + cpp = cp_val(p->stop[0]); + } + + if (cpp != beam_exception_trace + && cpp != beam_return_trace + && cpp != beam_return_to_trace) { + Uint need = stack_offset /* bytes */ / sizeof(Eterm); + if (need == 0) + need = 1; /* i_apply_only */ + if (p->stop - p->htop < need) + erts_garbage_collect(p, (int) need, reg, arity+1); + p->stop -= need; + + if (apply_only) { + /* + * Called from the i_apply_only instruction. + * + * 'p->cp' contains continuation pointer pointing + * into the function that called current function. + * We push that continuation pointer onto the stack, + * and set 'p->cp' to point into current function. + */ + + p->stop[0] = make_cp(p->cp); + p->cp = I; + } + else { + /* + * Called from an i_apply_last_p, or apply_last_IP, + * instruction. + * + * Calling instruction will after we return read + * a continuation pointer from the stack and write + * it to 'p->cp', and then remove the topmost + * stackframe of size 'stack_offset'. + * + * We have sized the dummy-stackframe so that it + * will be removed by the instruction we currently + * are executing, and leave the stackframe that + * normally would have been removed intact. + * + */ + p->stop[0] = make_cp(I); + } + } + } +} + static BeamInstr* -apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) +apply( +Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg, +BeamInstr *I, Uint stack_offset) { int arity; Export* ep; @@ -6229,21 +6353,54 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) return 0; } - /* The module argument may be either an atom or an abstract module - * (currently implemented using tuples, but this might change). - */ - this = THE_NON_VALUE; - if (is_not_atom(module)) { - Eterm* tp; + while (1) { + Eterm m, f, a; + /* The module argument may be either an atom or an abstract module + * (currently implemented using tuples, but this might change). + */ + this = THE_NON_VALUE; + if (is_not_atom(module)) { + Eterm* tp; + + if (is_not_tuple(module)) goto error; + tp = tuple_val(module); + if (arityval(tp[0]) < 1) goto error; + this = module; + module = tp[1]; + if (is_not_atom(module)) goto error; + } - if (is_not_tuple(module)) goto error; - tp = tuple_val(module); - if (arityval(tp[0]) < 1) goto error; - this = module; - module = tp[1]; - if (is_not_atom(module)) goto error; + if (module != am_erlang || function != am_apply) + break; + + /* Adjust for multiple apply of apply/3... */ + + a = args; + if (is_list(a)) { + Eterm *consp = list_val(a); + m = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + f = CAR(consp); + a = CDR(consp); + if (is_list(a)) { + consp = list_val(a); + a = CAR(consp); + if (is_nil(CDR(consp))) { + /* erlang:apply/3 */ + module = m; + function = f; + args = a; + if (is_not_atom(f)) + goto error; + continue; + } + } + } + } + break; /* != erlang:apply/3 */ } - /* * Walk down the 3rd parameter of apply (the argument list) and copy * the parameters to the x registers (reg[]). If the module argument @@ -6281,12 +6438,14 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } static BeamInstr* -fixed_apply(Process* p, Eterm* reg, Uint arity) +fixed_apply(Process* p, Eterm* reg, Uint arity, + BeamInstr *I, Uint stack_offset) { Export* ep; Eterm module; @@ -6316,6 +6475,10 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) if (is_not_atom(module)) goto error; ++arity; } + + /* Handle apply of apply/3... */ + if (module == am_erlang && function == am_apply && arity == 3) + return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset); /* * Get the index into the export table, or failing that the export @@ -6330,6 +6493,7 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { save_calls(p, ep); } + apply_bif_error_adjustment(p, ep, reg, arity, I, stack_offset); DTRACE_GLOBAL_CALL_FROM_EXPORT(p, ep); return ep->addressv[erts_active_code_ix()]; } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 0e0842e139..009d2b72d3 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1673,11 +1673,11 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp) Eterm mfa; Eterm res = NIL; - depth = 8; + depth = erts_backtrace_depth; sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth; s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz); s->depth = 0; - if (rp->i) { + if (depth > 0 && rp->i) { s->trace[s->depth++] = rp->i; depth--; } @@ -2863,6 +2863,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("atom_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_get_atom_limit())); } + else if (ERTS_IS_ATOM_STR("atom_count",BIF_ARG_1)) { + BIF_RET(make_small(atom_table_size())); + } else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { if (erts_has_time_correction() && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) { diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 28b2b02914..818f89f0e3 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -176,6 +176,13 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; +#ifdef ERTS_DIRTY_SCHEDULERS +static struct { + erts_mtx_t mtx; + ErtsGCInfo info; +} dirty_gc; +#endif + static ERTS_INLINE int gc_cost(Uint gc_moved_live_words, Uint resize_moved_words) { @@ -259,6 +266,11 @@ erts_init_gc(void) init_gc_info(&esdp->gc_info); } +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info"); + init_gc_info(&dirty_gc.info); +#endif + init_gcireq_alloc(); } @@ -735,8 +747,19 @@ do_major_collection: monitor_large_heap(p); } - esdp->gc_info.garbage_cols++; - esdp->gc_info.reclaimed += reclaimed_now; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + erts_mtx_lock(&dirty_gc.mtx); + dirty_gc.info.garbage_cols++; + dirty_gc.info.reclaimed += reclaimed_now; + erts_mtx_unlock(&dirty_gc.mtx); + } + else +#endif + { + esdp->gc_info.garbage_cols++; + esdp->gc_info.reclaimed += reclaimed_now; + } FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -3009,6 +3032,18 @@ reply_gc_info(void *vgcirp) reclaimed = esdp->gc_info.reclaimed; garbage_cols = esdp->gc_info.garbage_cols; +#ifdef ERTS_DIRTY_SCHEDULERS + /* + * Add dirty schedulers info on requesting + * schedulers info + */ + if (gcirp->req_sched == esdp->no) { + erts_mtx_lock(&dirty_gc.mtx); + reclaimed += dirty_gc.info.reclaimed; + garbage_cols += dirty_gc.info.garbage_cols; + erts_mtx_unlock(&dirty_gc.mtx); + } +#endif sz = 0; hpp = NULL; diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index d29d079fc5..38bebc7576 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -2666,7 +2666,7 @@ erts_start_timer_callback(ErtsMonotonicTime tmo, tmo); twt = tmo < ERTS_TIMER_WHEEL_MSEC; - if (esdp) + if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) start_callback_timer(esdp, twt, timeout_pos, diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 356f5ca71e..5f2a687f74 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -127,6 +127,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "run_queue", "address" }, #ifdef ERTS_DIRTY_SCHEDULERS { "dirty_run_queue_sleep_list", "address" }, + { "dirty_gc_info", NULL }, #endif { "process_table", NULL }, { "cpu_info", NULL }, diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 4fb0f9e975..a6fdd67088 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2059,6 +2059,7 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait #endif for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) { ErtsThrPrgrLaterOp *lop = awdp->later_op.first; + if (!erts_thr_progress_has_reached_this(current, lop->later)) return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; awdp->later_op.first = lop->next; @@ -6233,6 +6234,12 @@ check_dirty_enqueue_in_prio_queue(Process *c_p, int queue; erts_aint32_t dact, max_qbit; + /* Do not enqueue free process... */ + if (actual & ERTS_PSFLG_FREE) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NOT; + } + /* Termination should be done on an ordinary scheduler */ if ((*newp) & ERTS_PSFLG_EXITING) { *newp &= ~ERTS_PSFLGS_DIRTY_WORK; @@ -6425,6 +6432,9 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st /* * schedule_out_process() return with c_rq locked. + * + * Return non-zero value if caller should decrease + * reference count on the process when done with it... */ static ERTS_INLINE int schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, @@ -6479,12 +6489,18 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 0; - +#if !defined(ERTS_SMP) + /* Decrement refc if process struct is free... */ + return !!(n & ERTS_PSFLG_FREE); +#else + /* Decrement refc if scheduled out from dirty scheduler... */ + return !is_normal_sched; +#endif } else { Process* sched_p; + ASSERT(!(n & ERTS_PSFLG_FREE)); ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); @@ -6500,11 +6516,14 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(runq); + if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */ + /* Enqueue the process */ enqueue_process(runq, (int) enq_prio, sched_p); if (runq == c_rq) - return 1; + return 0; erts_smp_runq_unlock(runq); @@ -6512,9 +6531,15 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, erts_smp_runq_lock(c_rq); - return 1; + /* + * Decrement refc if process is scheduled out by a + * dirty scheduler, and we have not just scheduled + * the process using the ordinary process struct + * on a dirty run-queue again... + */ + return !is_normal_sched && (sched_p != p + || !ERTS_RUNQ_IX_IS_DIRTY(runq->ix)); } - } static ERTS_INLINE void @@ -6529,8 +6554,17 @@ add2runq(int enqueue, erts_aint32_t prio, if (runq) { Process *sched_p; - if (enqueue > 0) + if (enqueue > 0) { sched_p = proc; + /* + * Refc on process struct (i.e. true struct, + * not proxy-struct) increased while in a + * dirty run-queue or executing on a dirty + * scheduler. + */ + if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) + erts_proc_inc_refc(proc); + } else { Process *pxy; @@ -7054,12 +7088,18 @@ typedef struct { } ErtsSchdlrSspndResume; static void -schdlr_sspnd_resume_proc(Eterm pid) +schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid) { - Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS); + Process *p; + p = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_STATUS, + (sched_type != ERTS_SCHED_NORMAL + ? ERTS_P2P_FLG_INC_REFC + : 0)); if (p) { resume_process(p, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (sched_type != ERTS_SCHED_NORMAL) + erts_proc_dec_refc(p); } } @@ -7068,17 +7108,20 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type, ErtsSchdlrSspndResume *resume) { if (is_internal_pid(resume->onln.chngr)) { - schdlr_sspnd_resume_proc(resume->onln.chngr); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.chngr); resume->onln.chngr = NIL; } if (is_internal_pid(resume->onln.nxt)) { - schdlr_sspnd_resume_proc(resume->onln.nxt); + schdlr_sspnd_resume_proc(sched_type, + resume->onln.nxt); resume->onln.nxt = NIL; } while (resume->msb.chngrs) { ErtsProcList *plp = resume->msb.chngrs; resume->msb.chngrs = plp->next; - schdlr_sspnd_resume_proc(plp->pid); + schdlr_sspnd_resume_proc(sched_type, + plp->pid); proclist_destroy(plp); } } @@ -7130,16 +7173,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1); - if (sched_type != ERTS_SCHED_NORMAL) { - if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) { - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - } - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); + if (sched_type != ERTS_SCHED_NORMAL) erts_smp_runq_unlock(esdp->run_queue); - } else { evacuate_run_queue(esdp->run_queue, &sbp); @@ -7152,8 +7187,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) sched_wall_time_change(esdp, 0); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); } + erts_smp_mtx_lock(&schdlr_sspnd.mtx); flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); if (flgs & ERTS_SSI_FLG_SUSPENDED) { @@ -7197,15 +7232,18 @@ suspend_scheduler(ErtsSchedulerData *esdp) (void) erts_proclist_fetch(&msb[i]->chngq, &end_plp); /* resume processes that initiated the multi scheduling block... */ plp = msb[i]->chngq; - while (plp) { - erts_proclist_store_last(&msb[i]->blckrs, - proclist_copy(plp)); - plp = plp->next; - } - if (end_plp) + if (plp) { + ASSERT(end_plp); + ASSERT(msb[i]->ongoing); + do { + erts_proclist_store_last(&msb[i]->blckrs, + proclist_copy(plp)); + plp = plp->next; + } while (plp); end_plp->next = resume.msb.chngrs; - resume.msb.chngrs = msb[i]->chngq; - msb[i]->chngq = NULL; + resume.msb.chngrs = msb[i]->chngq; + msb[i]->chngq = NULL; + } } } } @@ -7269,24 +7307,14 @@ suspend_scheduler(ErtsSchedulerData *esdp) while (1) { ErtsMonotonicTime current_time; - erts_aint32_t qmask; erts_aint32_t flgs; - qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) - & ERTS_RUNQ_FLGS_QMASK); - - if (sched_type != ERTS_SCHED_NORMAL) { - if (qmask) { - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - if (schdlr_sspnd.msb.ongoing) - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - } + if (sched_type != ERTS_SCHED_NORMAL) aux_work = 0; - } else { + erts_aint32_t qmask; + qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) + & ERTS_RUNQ_FLGS_QMASK); aux_work = erts_atomic32_read_acqb(&ssi->aux_work); @@ -7414,12 +7442,23 @@ suspend_scheduler(ErtsSchedulerData *esdp) schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) - && schdlr_sspnd.online == schdlr_sspnd.active) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - } - + if (changing) { + if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) + && !schdlr_sspnd.msb.ongoing + && schdlr_sspnd.online == schdlr_sspnd.active) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_MSB); + } + if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB) + && !schdlr_sspnd.nmsb.ongoing + && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL) + == schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL))) { + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~ERTS_SCHDLR_SSPND_CHNG_NMSB); + } + } ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type)); ASSERT((sched_type == ERTS_SCHED_NORMAL ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) @@ -7552,7 +7591,7 @@ abort_sched_onln_chng_waitq(Process *p) erts_smp_mtx_unlock(&schdlr_sspnd.mtx); if (is_internal_pid(resume)) - schdlr_sspnd_resume_proc(resume); + schdlr_sspnd_resume_proc(ERTS_SCHED_NORMAL, resume); } ErtsSchedSuspendResult @@ -7950,21 +7989,20 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal } else { /* ------ UNBLOCK ------ */ if (p->flags & have_blckd_flg) { - ErtsProcList *plps[2]; + ErtsProcList **plpps[3] = {0}; ErtsProcList *plp; - int limit = 0; - plps[limit++] = erts_proclist_peek_first(msbp->blckrs); - if (all) - plps[limit++] = erts_proclist_peek_first(msbp->chngq); + plpps[0] = &msbp->blckrs; + if (all) + plpps[1] = &msbp->chngq; - for (ix = 0; ix < limit; ix++) { - plp = plps[ix]; + for (ix = 0; plpps[ix]; ix++) { + plp = erts_proclist_peek_first(*plpps[ix]); while (plp) { ErtsProcList *tmp_plp = plp; - plp = erts_proclist_peek_next(msbp->blckrs, plp); + plp = erts_proclist_peek_next(*plpps[ix], plp); if (erts_proclist_same(tmp_plp, p)) { - erts_proclist_remove(&msbp->blckrs, tmp_plp); + erts_proclist_remove(plpps[ix], tmp_plp); proclist_destroy(tmp_plp); if (!all) break; @@ -9587,40 +9625,45 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) esdp->reductions += reds; - /* schedule_out_process() returns with rq locked! */ - schedule_out_process(rq, state, p, proxy_p, is_normal_sched); - proxy_p = NULL; + { + int dec_refc; - ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, - (int) ERTS_PSFLGS_GET_USR_PRIO(state), - reds, - actual_reds); + /* schedule_out_process() returns with rq locked! */ + dec_refc = schedule_out_process(rq, state, p, + proxy_p, is_normal_sched); + proxy_p = NULL; - esdp->current_process = NULL; + ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, + (int) ERTS_PSFLGS_GET_USR_PRIO(state), + reds, + actual_reds); + + esdp->current_process = NULL; #ifdef ERTS_SMP - p->scheduler_data = NULL; + p->scheduler_data = NULL; #endif - erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_STATUS - | ERTS_PROC_LOCK_TRACE)); + erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_STATUS + | ERTS_PROC_LOCK_TRACE)); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); - if (state & ERTS_PSFLG_FREE) { - if (!is_normal_sched) { - ASSERT(p->flags & F_DELAYED_DEL_PROC); - erts_proc_dec_refc(p); - } - else { #ifdef ERTS_SMP - ASSERT(esdp->free_process == p); - esdp->free_process = NULL; -#else - erts_proc_dec_refc(p); + if (state & ERTS_PSFLG_FREE) { + if (!is_normal_sched) { + ASSERT(p->flags & F_DELAYED_DEL_PROC); + } + else { + ASSERT(esdp->free_process == p); + esdp->free_process = NULL; + } + } #endif - } - } + + if (dec_refc) + erts_proc_dec_refc(p); + } #ifdef ERTS_SMP ASSERT(!esdp->free_process); @@ -9896,8 +9939,12 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; else { + Eterm pid = p->common.id; proxy_p = p; - p = erts_proc_lookup_raw(proxy_p->common.id); + p = (is_normal_sched + ? erts_proc_lookup_raw(pid) + : erts_pid2proc_opt(NULL, 0, pid, 0, + ERTS_P2P_FLG_INC_REFC)); if (!p) { free_proxy_proc(proxy_p); proxy_p = NULL; @@ -9929,6 +9976,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) | ERTS_PSFLG_FREE))) #ifdef ERTS_DIRTY_SCHEDULERS | (((state & (ERTS_PSFLG_RUNNING + | ERTS_PSFLG_FREE | ERTS_PSFLG_RUNNING_SYS | ERTS_PSFLG_EXITING)) @@ -9961,6 +10009,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) /* free and not queued by proxy */ erts_proc_dec_refc(p); } + if (!is_normal_sched) + erts_proc_dec_refc(p); goto pick_next_process; } state = new; @@ -13094,15 +13144,14 @@ erts_continue_exit_process(Process *p) } #ifdef ERTS_DIRTY_SCHEDULERS - if (a & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + if (a & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { p->flags |= F_DELAYED_DEL_PROC; delay_del_proc = 1; /* - * The dirty scheduler will also decrease - * refc when done... + * The dirty scheduler decrease refc + * when done with the process... */ - erts_proc_inc_refc(p); } #endif diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 1c4b9f149d..7193b7d1db 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1681,7 +1681,7 @@ ERTS_GLB_INLINE ErtsProcList *erts_proclist_fetch_first(ErtsProcList **list) return NULL; else { ErtsProcList *res = *list; - if (res == *list) + if (res->next == *list) *list = NULL; else *list = res->next; diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3adb8db661..d64f015a6a 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1937,7 +1937,8 @@ static void free_sendfile(void *data) { MUTEX_LOCK(d->c.sendfile.q_mtx); driver_deq(d->c.sendfile.port,1); MUTEX_UNLOCK(d->c.sendfile.q_mtx); - driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); + driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, + ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0); } EF_FREE(data); } @@ -2555,7 +2556,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) desc->sendfile_state = sending; desc->d = d; driver_select(desc->port, (ErlDrvEvent)(long)d->c.sendfile.out_fd, - ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 1); + ERL_DRV_USE|ERL_DRV_WRITE, 1); } break; #endif diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index b8d89126fe..f70fb0e501 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -32,7 +32,8 @@ binary_to_atom/1,binary_to_existing_atom/1, atom_to_binary/1,min_max/1, erlang_halt/1, erl_crash_dump_bytes/1, - is_builtin/1]). + is_builtin/1, error_stacktrace/1, + error_stacktrace_during_call_trace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,8 +45,8 @@ all() -> t_list_to_existing_atom, os_env, otp_7526, display, atom_to_binary, binary_to_atom, binary_to_existing_atom, - erl_crash_dump_bytes, - min_max, erlang_halt, is_builtin]. + erl_crash_dump_bytes, min_max, erlang_halt, is_builtin, + error_stacktrace, error_stacktrace_during_call_trace]. %% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> @@ -727,6 +728,172 @@ is_builtin(_Config) -> ok. +error_stacktrace(Config) when is_list(Config) -> + error_stacktrace_test(). + +error_stacktrace_during_call_trace(Config) when is_list(Config) -> + Tracer = spawn_link(fun () -> + receive after infinity -> ok end + end), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,2}, Mprog, [local]), + 1 = erlang:trace_pattern({erlang,error,1}, Mprog, [local]), + erlang:trace(all, true, [call,return_to,timestamp,{tracer, Tracer}]), + try + error_stacktrace_test() + after + erlang:trace(all, false, [call,return_to,timestamp,{tracer, Tracer}]), + erlang:trace_pattern({erlang,error,2}, false, [local]), + erlang:trace_pattern({erlang,error,1}, false, [local]), + erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + unlink(Tracer), + exit(Tracer, kill), + Mon = erlang:monitor(process, Tracer), + receive + {'DOWN', Mon, process, Tracer, _} -> ok + end + end, + ok. + + +error_stacktrace_test() -> + Types = [apply_const_last, apply_const, apply_last, + apply, double_apply_const_last, double_apply_const, + double_apply_last, double_apply, multi_apply_const_last, + multi_apply_const, multi_apply_last, multi_apply, + call_const_last, call_last, call_const, call], + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_2) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_2, [Type], _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + lists:foreach(fun (Type) -> + {Pid, Mon} = spawn_monitor( + fun () -> + stk([a,b,c,d], Type, error_1) + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + {oops, Stack} = Reason, +%% io:format("Type: ~p Stack: ~p~n", +%% [Type, Stack]), + [{?MODULE, do_error_1, 1, _}, + {?MODULE, stk, 3, _}, + {?MODULE, stk, 3, _}] = Stack + end + end, + Types), + ok. + +stk([], Type, Func) -> + tail(Type, Func, jump), + ok; +stk([_|L], Type, Func) -> + stk(L, Type, Func), + ok. + +tail(Type, Func, jump) -> + tail(Type, Func, do); +tail(Type, error_1, do) -> + do_error_1(Type); +tail(Type, error_2, do) -> + do_error_2(Type). + +do_error_2(apply_const_last) -> + erlang:apply(erlang, error, [oops, [apply_const_last]]); +do_error_2(apply_const) -> + erlang:apply(erlang, error, [oops, [apply_const]]), + ok; +do_error_2(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops, [apply_last]])); +do_error_2(apply) -> + erlang:apply(id(erlang), id(error), id([oops, [apply]])), + ok; +do_error_2(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const_last]]]); +do_error_2(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops, [double_apply_const]]]), + ok; +do_error_2(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply_last]])]); +do_error_2(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops, [double_apply]])]), + ok; +do_error_2(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const_last]]]]]); +do_error_2(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops, [multi_apply_const]]]]]), + ok; +do_error_2(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply_last]])]]]); +do_error_2(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops, [multi_apply]])]]]), + ok; +do_error_2(call_const_last) -> + erlang:error(oops, [call_const_last]); +do_error_2(call_last) -> + erlang:error(id(oops), id([call_last])); +do_error_2(call_const) -> + erlang:error(oops, [call_const]), + ok; +do_error_2(call) -> + erlang:error(id(oops), id([call])). + + +do_error_1(apply_const_last) -> + erlang:apply(erlang, error, [oops]); +do_error_1(apply_const) -> + erlang:apply(erlang, error, [oops]), + ok; +do_error_1(apply_last) -> + erlang:apply(id(erlang), id(error), id([oops])); +do_error_1(apply) -> + erlang:apply(id(erlang), id(error), id([oops])), + ok; +do_error_1(double_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]); +do_error_1(double_apply_const) -> + erlang:apply(erlang, apply, [erlang, error, [oops]]), + ok; +do_error_1(double_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]); +do_error_1(double_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(error), id([oops])]), + ok; +do_error_1(multi_apply_const_last) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]); +do_error_1(multi_apply_const) -> + erlang:apply(erlang, apply, [erlang, apply, [erlang, apply, [erlang, error, [oops]]]]), + ok; +do_error_1(multi_apply_last) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]); +do_error_1(multi_apply) -> + erlang:apply(id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(apply), [id(erlang), id(error), id([oops])]]]), + ok; +do_error_1(call_const_last) -> + erlang:error(oops); +do_error_1(call_last) -> + erlang:error(id(oops)); +do_error_1(call_const) -> + erlang:error(oops), + ok; +do_error_1(call) -> + erlang:error(id(oops)). + + + %% Helpers diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 6ba6301c7c..f7ff04430a 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1090,8 +1090,7 @@ exception_nocatch() -> {trace,t2,exception_from,{erlang,throw,1}, {error,{nocatch,Q2}}}], exception_from, {error,{nocatch,Q2}}), - expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, + expect({trace,T2,exit,{{nocatch,Q2},[{?MODULE,deep_4,1, Deep4LocThrow}]}}), Q3 = {dump,[dump,{dump}]}, T3 = @@ -1100,8 +1099,7 @@ exception_nocatch() -> {trace,t3,exception_from,{erlang,error,1}, {error,Q3}}], exception_from, {error,Q3}), - expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), + expect({trace,T3,exit,{Q3,[{?MODULE,deep_4,1,Deep4LocError}]}}), T4 = exception_nocatch(?LINE, '=', [17,4711], 5, [], exception_from, {error,{badmatch,4711}}), diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index 614b68e865..8e5e81665c 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -1397,10 +1397,18 @@ static void assert_print(char* str, int line) static void assert_failed(ErlDrvPort port, char* str, int line) { char buf[30]; + size_t bufsz = sizeof(buf); + assert_print(str,line); - snprintf(buf,sizeof(buf),"failed_at_line_%d",line); - driver_failure_atom(port,buf); - /*abort();*/ + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && (strcmp("true", buf) == 0 || strcmp("yes", buf) == 0)) { + abort(); + } + else { + snprintf(buf,sizeof(buf),"failed_at_line_%d",line); + driver_failure_atom(port,buf); + } } #define my_driver_select(PORT,FD,MODE,ON) \ diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index d4e77d634a..23594aa8c4 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -2292,7 +2292,7 @@ maybe_to_list(List) -> List. format({Eol,List}) -> - io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); + io_lib:format("tuple<~w,~w>",[Eol, maybe_to_list(List)]); format(List) when is_list(List) -> case list_at_least(50, List) of true -> diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src index fb7685c4b6..3a343e6d17 100644 --- a/erts/emulator/test/port_SUITE_data/Makefile.src +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -20,6 +20,12 @@ echo_args@exe@: echo_args@obj@ echo_args@obj@: echo_args.c $(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c +dead_port@exe@: dead_port@obj@ + $(LD) $(CROSSLDFLAGS) -o dead_port dead_port@obj@ @LIBS@ + +dead_port@obj@: dead_port.c + $(CC) -c -o dead_port@obj@ $(CFLAGS) dead_port.c + port_test.@EMULATOR@: port_test.erl @erl_name@ -compile port_test diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index cc3ebdf0f8..e199a0fc13 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -10,6 +10,7 @@ #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> +#include <ctype.h> #ifndef __WIN32__ #include <unistd.h> @@ -33,7 +34,7 @@ exit(1); \ } -#define MAIN(argc, argv) main(argc, argv) +#define ASSERT(e) ((void) ((e) ? 1 : abort())) extern int errno; @@ -105,9 +106,7 @@ int err; #endif -MAIN(argc, argv) -int argc; -char *argv[]; +int main(int argc, char *argv[]) { int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { @@ -377,9 +376,11 @@ write_reply(buf, size) int size; /* Size of buffer to send. */ { int n; /* Temporary to hold size. */ + int rv; if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ - write(port_data->fd_to_erl, buf, size); + rv = write(port_data->fd_to_erl, buf, size); + ASSERT(rv == size); } else { /* * Write chunks with delays in between. @@ -387,7 +388,8 @@ write_reply(buf, size) while (size > 0) { n = size > port_data->slow_writes ? port_data->slow_writes : size; - write(port_data->fd_to_erl, buf, n); + rv = write(port_data->fd_to_erl, buf, n); + ASSERT(rv == n); size -= n; buf += n; if (size) @@ -558,7 +560,7 @@ char* spec; /* Specification for reply. */ buf = (char *) malloc(total_size); if (buf == NULL) { fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", - port_data->progname, total_size); + port_data->progname, (int)total_size); exit(1); } diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index e035fc64fe..3b8f0072f2 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -437,11 +437,22 @@ t_process_info(Config) when is_list(Config) -> verify_loc(Line2, Res2), pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), + verify_stacktrace_depth(), + Gleader = group_leader(), {group_leader, Gleader} = process_info(self(), group_leader), {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. +verify_stacktrace_depth() -> + CS = current_stacktrace, + OldDepth = erlang:system_flag(backtrace_depth, 0), + {CS,[]} = erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, 8), + {CS,[{?MODULE,verify_stacktrace_depth,0,_},_|_]} = + erlang:process_info(self(), CS), + _ = erlang:system_flag(backtrace_depth, OldDepth). + pi_stacktrace(Expected0) -> {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)}, {current_stacktrace,Stack} = Res, diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 3d9e74472b..6a772bf7c9 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -36,7 +36,8 @@ -export([all/0, suite/0]). -export([process_count/1, system_version/1, misc_smoke_tests/1, - heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1]). + heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, + atom_count/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -44,7 +45,7 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, - heap_size, wordsize, memory, ets_limit, atom_limit]. + heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. %%% %%% The test cases ------------------------------------------------------------- @@ -550,3 +551,13 @@ get_atom_limit(Config, AtomsMax) -> end, stop_node(Node), Res. + +%% Verify that system_info(atom_count) works. +atom_count(Config) when is_list(Config) -> + Limit = erlang:system_info(atom_limit), + Count1 = erlang:system_info(atom_count), + list_to_atom(integer_to_list(erlang:unique_integer())), + Count2 = erlang:system_info(atom_count), + true = Limit >= Count2, + true = Count2 > Count1, + ok. diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index d67b997d6d..bc353e384e 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -48,13 +48,10 @@ * * HEART_BEATING * - * This program expects a heart beat messages. If it does not receive a - * heart beat message from Erlang within heart_beat_timeout seconds, it - * reboots the system. The variable heart_beat_timeout is exported (so - * that it can be set from the shell in VxWorks, as is the variable - * heart_beat_report_delay). When using Solaris, the system is rebooted - * by executing the command stored in the environment variable - * HEART_COMMAND. + * This program expects a heart beat message. If it does not receive a + * heart beat message from Erlang within heart_beat_timeout seconds, it + * reboots the system. The system is rebooted by executing the command + * stored in the environment variable HEART_COMMAND. * * BLOCKING DESCRIPTORS * @@ -149,27 +146,17 @@ struct msg { /* Maybe interesting to change */ /* Times in seconds */ -#define HEART_BEAT_BOOT_DELAY 60 /* 1 minute */ #define SELECT_TIMEOUT 5 /* Every 5 seconds we reset the watchdog timer */ /* heart_beat_timeout is the maximum gap in seconds between two - consecutive heart beat messages from Erlang, and HEART_BEAT_BOOT_DELAY - is the the extra delay that wd_keeper allows for, to give heart a - chance to reboot in the "normal" way before the hardware watchdog - enters the scene. heart_beat_report_delay is the time allowed for reporting - before rebooting under VxWorks. */ + consecutive heart beat messages from Erlang. */ int heart_beat_timeout = 60; -int heart_beat_report_delay = 30; -int heart_beat_boot_delay = HEART_BEAT_BOOT_DELAY; /* All current platforms have a process identifier that fits in an unsigned long and where 0 is an impossible or invalid value */ unsigned long heart_beat_kill_pid = 0; -#define VW_WD_TIMEOUT (heart_beat_timeout+heart_beat_report_delay+heart_beat_boot_delay) -#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay) - /* reasons for reboot */ #define R_TIMEOUT (1) #define R_CLOSED (2) @@ -297,7 +284,6 @@ free_env_val(char *value) static void get_arguments(int argc, char** argv) { int i = 1; int h; - int w; unsigned long p; while (i < argc) { @@ -313,15 +299,6 @@ static void get_arguments(int argc, char** argv) { i++; } break; - case 'w': - if (strcmp(argv[i], "-wt") == 0) - if (sscanf(argv[i+1],"%i",&w) ==1) - if ((w > 10) && (w <= 65535)) { - heart_beat_boot_delay = w; - fprintf(stderr,"heart_beat_boot_delay = %d\n",w); - i++; - } - break; case 'p': if (strcmp(argv[i], "-pid") == 0) if (sscanf(argv[i+1],"%lu",&p) ==1){ @@ -347,7 +324,7 @@ static void get_arguments(int argc, char** argv) { } i++; } - debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p); + debugf("arguments -ht %d -pid %lu\n",h,p); } int main(int argc, char **argv) { @@ -674,11 +651,6 @@ void win_system(char *command) */ static void do_terminate(int erlin_fd, int reason) { - /* - When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish - (plus heart_beat_report_delay if under VxWorks), so we don't need - to call wd_reset(). - */ int ret = 0, tmo=0; char *tmo_env; diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 64d1a70e61..4f4027c74e 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex 4406a82a36..c05bc813f0 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 8247c399a4..970ad7b023 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 0161151785..1b28a929ce 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam Binary files differindex df3bc9526b..e5381d3574 100644 --- a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam +++ b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex aae3976298..57b3023ea6 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam Binary files differindex 71f3c2ec8c..2fab34318e 100644 --- a/erts/preloaded/ebin/erts_literal_area_collector.beam +++ b/erts/preloaded/ebin/erts_literal_area_collector.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 74a0184818..ffddf2d54d 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex b601c048b3..3c6a6d4f41 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 77909b01f0..133fda4b13 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 5bbbaf14d5..99ad863b8b 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 1a573ce297..e52e442f8e 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 6afeb454d6..122406c834 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 6a7ad9164f..c683d395f3 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 15c3e01653..6ca0a4c160 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2532,6 +2532,7 @@ tuple_to_list(_Tuple) -> Alloc :: atom(); ({allocator_sizes, Alloc}) -> [_] when %% More or less anything Alloc :: atom(); + (atom_count) -> pos_integer(); (atom_limit) -> pos_integer(); (build_type) -> opt | debug | purify | quantify | purecov | gcov | valgrind | gprof | lcnt | frmptr; diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 77588af59b..dfa321c901 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -22,6 +22,7 @@ {vsn, "%VSN%"}, {modules, [ct_cover, ct, + ct_default_gl, ct_event, ct_framework, ct_ftp, diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index b1eddfedd7..2f0fc2e05a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -70,7 +70,8 @@ MODULES= \ test_server_SUITE \ test_server_test_lib \ ct_release_test_SUITE \ - ct_log_SUITE + ct_log_SUITE \ + ct_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_SUITE.erl b/lib/common_test/test/ct_SUITE.erl new file mode 100644 index 0000000000..eb98c2544f --- /dev/null +++ b/lib/common_test/test/ct_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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(ct_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{timetrap,{seconds,30}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [app_file, appup_file]. + +%%%----------------------------------------------------------------- +%%% Test cases + +app_file(_Config) -> + ok = test_server:app_test(common_test), + ok. + +appup_file(_Config) -> + ok = test_server:appup_test(common_test). + diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 8608d2daac..1df6c1d316 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -147,8 +147,8 @@ env_compiler_options() -> env_default_opts(). %% Local functions %% --define(pass(P), {P,fun P/1}). --define(pass(P,T), {P,fun T/1,fun P/1}). +-define(pass(P), {P,fun P/2}). +-define(pass(P,T), {P,fun T/1,fun P/2}). env_default_opts() -> Key = "ERL_COMPILER_OPTIONS", @@ -287,7 +287,6 @@ format_error_reason(Reason) -> ifile="" :: file:filename(), ofile="" :: file:filename(), module=[], - code=[], core_code=[], abstract_code=[], %Abstract code for debugger. options=[] :: [option()], %Options for compilation @@ -300,14 +299,14 @@ internal({forms,Forms}, Opts0) -> {_,Ps} = passes(forms, Opts0), Source = proplists:get_value(source, Opts0, ""), Opts1 = proplists:delete(source, Opts0), - Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1}, - internal_comp(Ps, Source, "", Compile); + Compile = #compile{options=Opts1,mod_options=Opts1}, + internal_comp(Ps, Forms, Source, "", Compile); internal({file,File}, Opts) -> {Ext,Ps} = passes(file, Opts), Compile = #compile{options=Opts,mod_options=Opts}, - internal_comp(Ps, File, Ext, Compile). + internal_comp(Ps, none, File, Ext, Compile). -internal_comp(Passes, File, Suffix, St0) -> +internal_comp(Passes, Code0, File, Suffix, St0) -> Dir = filename:dirname(File), Base = filename:basename(File, Suffix), St1 = St0#compile{filename=File, dir=Dir, base=Base, @@ -317,36 +316,41 @@ internal_comp(Passes, File, Suffix, St0) -> Run0 = case member(time, Opts) of true -> io:format("Compiling ~tp\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end + fun run_tc/3; + false -> + fun({_Name,Fun}, Code, St) -> + catch Fun(Code, St) + end end, Run = case keyfind(eprof, 1, Opts) of {eprof,EprofPass} -> - fun(P, St) -> - run_eprof(P, EprofPass, St) + fun(P, Code, St) -> + run_eprof(P, Code, EprofPass, St) end; false -> Run0 end, - case fold_comp(Passes, Run, St1) of - {ok,St2} -> comp_ret_ok(St2); + case fold_comp(Passes, Run, Code0, St1) of + {ok,Code,St2} -> comp_ret_ok(Code, St2); {error,St2} -> comp_ret_err(St2) end. -fold_comp([{delay,Ps0}|Passes], Run, #compile{options=Opts}=St) -> +fold_comp([{delay,Ps0}|Passes], Run, Code, #compile{options=Opts}=St) -> Ps = select_passes(Ps0, Opts) ++ Passes, - fold_comp(Ps, Run, St); -fold_comp([{Name,Test,Pass}|Ps], Run, St) -> + fold_comp(Ps, Run, Code, St); +fold_comp([{Name,Test,Pass}|Ps], Run, Code, St) -> case Test(St) of false -> %Pass is not needed. - fold_comp(Ps, Run, St); + fold_comp(Ps, Run, Code, St); true -> %Run pass in the usual way. - fold_comp([{Name,Pass}|Ps], Run, St) + fold_comp([{Name,Pass}|Ps], Run, Code, St) end; -fold_comp([{Name,Pass}|Ps], Run, St0) -> - case Run({Name,Pass}, St0) of - {ok,St1} -> fold_comp(Ps, Run, St1); - {error,_St1} = Error -> Error; +fold_comp([{Name,Pass}|Ps], Run, Code0, St0) -> + case Run({Name,Pass}, Code0, St0) of + {ok,Code,St1} -> + fold_comp(Ps, Run, Code, St1); + {error,_St1}=Error -> + Error; {'EXIT',Reason} -> Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}}; @@ -354,11 +358,11 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}], {error,St0#compile{errors=St0#compile.errors ++ Es}} end; -fold_comp([], _Run, St) -> {ok,St}. +fold_comp([], _Run, Code, St) -> {ok,Code,St}. -run_tc({Name,Fun}, St) -> +run_tc({Name,Fun}, Code, St) -> T1 = erlang:monotonic_time(), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), T2 = erlang:monotonic_time(), Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), @@ -367,17 +371,17 @@ run_tc({Name,Fun}, St) -> [Name,Elapsed/1000,Mem]), Val. -run_eprof({Name,Fun}, Name, St) -> +run_eprof({Name,Fun}, Code, Name, St) -> io:format("~p: Running eprof\n", [Name]), c:appcall(tools, eprof, start_profiling, [[self()]]), - Val = (catch Fun(St)), + Val = (catch Fun(Code, St)), c:appcall(tools, eprof, stop_profiling, []), c:appcall(tools, eprof, analyze, []), Val; -run_eprof({_,Fun}, _, St) -> - catch Fun(St). +run_eprof({_,Fun}, Code, _, St) -> + catch Fun(Code, St). -comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> +comp_ret_ok(Code, #compile{warnings=Warn0,module=Mod,options=Opts}=St) -> case werror(St) of true -> case member(report_warnings, Opts) of @@ -532,21 +536,21 @@ pass(_) -> none. %% select_passes([{pass,Mod}|Ps], Opts) -> - F = fun(St) -> - case catch Mod:module(St#compile.code, St#compile.options) of + F = fun(Code0, St) -> + case catch Mod:module(Code0, St#compile.options) of {ok,Code} -> - {ok,St#compile{code=Code}}; + {ok,Code,St}; {ok,Code,Ws} -> - {ok,St#compile{code=Code,warnings=St#compile.warnings++Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings++Ws}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ Es}} end end, [{Mod,F}|select_passes(Ps, Opts)]; select_passes([{src_listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> src_listing(Ext, St) end}]; + [{listing,fun (Code, St) -> src_listing(Ext, Code, St) end}]; select_passes([{listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> listing(Ext, St) end}]; + [{listing,fun (Code, St) -> listing(Ext, Code, St) end}]; select_passes([done|_], _Opts) -> []; select_passes([{done,Ext}|_], Opts) -> @@ -662,14 +666,14 @@ core_passes() -> [{iff,clint0,?pass(core_lint_module)}, {delay, [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, + [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, {iff,doldinline,{listing,"oldinline"}}, {pass,sys_core_fold}, {iff,dcorefold,{listing,"corefold"}}, - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, + {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, {iff,dinline,{listing,"inline"}}, {core_fold_after_inlining,fun test_any_inliner/1, - fun core_fold_module_after_inlining/1}, + fun core_fold_module_after_inlining/2}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -741,7 +745,7 @@ asm_passes() -> | binary_passes()]. binary_passes() -> - [{native_compile,fun test_native/1,fun native_compile/1}, + [{native_compile,fun test_native/1,fun native_compile/2}, {unless,binary,?pass(save_binary,not_werror)}]. %%% @@ -749,9 +753,9 @@ binary_passes() -> %%% %% Remove the target file so we don't have an old one if the compilation fail. -remove_file(St) -> +remove_file(Code, St) -> _ = file:delete(St#compile.ofile), - {ok,St}. + {ok,Code,St}. -record(asm_module, {module, exports, @@ -799,28 +803,28 @@ collect_asm([{attributes, Attr} | Rest], R) -> collect_asm([X | Rest], R) -> collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). -beam_consult_asm(St) -> +beam_consult_asm(_Code, St) -> case file:consult(St#compile.ifile) of - {ok, Forms0} -> + {ok,Forms0} -> Encoding = epp:read_encoding(St#compile.ifile), - {Module, Forms} = preprocess_asm_forms(Forms0), - {ok,St#compile{module=Module, code=Forms, encoding=Encoding}}; + {Module,Forms} = preprocess_asm_forms(Forms0), + {ok,Forms,St#compile{module=Module,encoding=Encoding}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. -read_beam_file(St) -> +read_beam_file(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Beam} -> Infile = St#compile.ifile, case no_native_compilation(Infile, St) of true -> - {ok,St#compile{module=none,code=none}}; + {ok,none,St#compile{module=none}}; false -> Mod0 = filename:rootname(filename:basename(Infile)), Mod = list_to_atom(Mod0), - {ok,St#compile{module=Mod,code=Beam,ofile=Infile}} + {ok,Beam,St#compile{module=Mod,ofile=Infile}} end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], @@ -839,17 +843,17 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St0) -> +parse_module(_Code, St0) -> case do_parse_module(utf8, St0) of - {ok,_}=Ret -> + {ok,_,_}=Ret -> Ret; {error,_}=Ret -> Ret; {invalid_unicode,File,Line} -> case do_parse_module(latin1, St0) of - {ok,St} -> + {ok,Code,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], - {ok,St#compile{warnings=Es++St#compile.warnings}}; + {ok,Code,St#compile{warnings=Es++St#compile.warnings}}; {error,St} -> Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], {error,St#compile{errors=Es++St#compile.errors}} @@ -867,13 +871,13 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> Encoding = proplists:get_value(encoding, Extra), case find_invalid_unicode(Forms, File) of none -> - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,St#compile{encoding=Encoding}}; {invalid_unicode,_,_}=Ret -> case Encoding of none -> Ret; _ -> - {ok,St#compile{code=Forms,encoding=Encoding}} + {ok,Forms,St#compile{encoding=Encoding}} end end; {error,E} -> @@ -892,7 +896,7 @@ find_invalid_unicode([H|T], File0) -> end; find_invalid_unicode([], _) -> none. -parse_core(St) -> +parse_core(_Code, St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> case core_scan:string(binary_to_list(Bin)) of @@ -900,7 +904,7 @@ parse_core(St) -> case core_parse:parse(Toks) of {ok,Mod} -> Name = (Mod#c_module.name)#c_literal.val, - {ok,St#compile{module=Name,code=Mod}}; + {ok,Mod,St#compile{module=Name}}; {error,E} -> Es = [{St#compile.ifile,[E]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -937,31 +941,36 @@ clean_parse_transforms_1([], Acc) -> reverse(Acc). transforms(Os) -> [ M || {parse_transform,M} <- Os ]. -transform_module(#compile{options=Opt,code=Code0}=St0) -> +transform_module(Code0, #compile{options=Opt}=St) -> %% Extract compile options from code into options field. case transforms(Opt ++ compile_options(Code0)) of - [] -> {ok,St0}; %No parse transforms. + [] -> + %% No parse transforms. + {ok,Code0,St}; Ts -> %% Remove parse_transform attributes from the abstract code to %% prevent parse transforms to be run more than once. Code = clean_parse_transforms(Code0), - St = St0#compile{code=Code}, - foldl_transform(St, Ts) + foldl_transform(Ts, Code, St) end. -foldl_transform(St, [T|Ts]) -> +foldl_transform([T|Ts], Code0, St) -> Name = "transform " ++ atom_to_list(T), case code:ensure_loaded(T) =:= {module,T} andalso - erlang:function_exported(T, parse_transform, 2) of + erlang:function_exported(T, parse_transform, 2) of true -> - Fun = fun(S) -> - T:parse_transform(S#compile.code, S#compile.options) + Fun = fun(Code, S) -> + T:parse_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}}; @@ -970,41 +979,44 @@ foldl_transform(St, [T|Ts]) -> {parse_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); + foldl_transform(Ts, Forms, + St#compile{warnings=St#compile.warnings ++ Ws}); Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + foldl_transform(Ts, Forms, St) end; false -> Es = [{St#compile.ifile,[{none,compile, {undef_parse_transform,T}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end; -foldl_transform(St, []) -> {ok,St}. +foldl_transform([], Code, St) -> {ok,Code,St}. get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. -core_transforms(St) -> +core_transforms(Code, St) -> %% The options field holds the complete list of options at this Ts = get_core_transforms(St#compile.options), - foldl_core_transforms(St, Ts). + foldl_core_transforms(Ts, Code, St). -foldl_core_transforms(St, [T|Ts]) -> +foldl_core_transforms([T|Ts], Code0, St) -> Name = "core transform " ++ atom_to_list(T), - Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end, + Fun = fun(Code, S) -> T:core_transform(Code, S#compile.options) end, Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end + true -> + fun run_tc/3; + false -> + fun({_Name,F}, Code, S) -> + catch F(Code, S) + end end, - case Run({Name, Fun}, St) of + case Run({Name, Fun}, Code0, St) of {'EXIT',R} -> Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; Forms -> - foldl_core_transforms(St#compile{code=Forms}, Ts) + foldl_core_transforms(Ts, Forms, St) end; -foldl_core_transforms(St, []) -> {ok,St}. +foldl_core_transforms([], Code, St) -> {ok,Code,St}. %%% Fetches the module name from a list of forms. The module attribute must %%% be present. @@ -1025,31 +1037,28 @@ add_default_base(St, Forms) -> St end. -lint_module(St) -> - case erl_lint:module(St#compile.code, - St#compile.ifile, St#compile.options) of +lint_module(Code, St) -> + case erl_lint:module(Code, St#compile.ifile, St#compile.options) of {ok,Ws} -> %% Insert name of module as base name, if needed. This is %% for compile:forms to work with listing files. - St1 = add_default_base(St, St#compile.code), - {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}}; + St1 = add_default_base(St, Code), + {ok,Code,St1#compile{warnings=St1#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -core_lint_module(St) -> - case core_lint:module(St#compile.code, St#compile.options) of +core_lint_module(Code, St) -> + case core_lint:module(Code, St#compile.options) of {ok,Ws} -> - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}} end. -makedep(#compile{code=Code,options=Opts}=St) -> - Ifile = St#compile.ifile, - Ofile = St#compile.ofile, +makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) -> %% Get the target of the Makefile rule. Target0 = @@ -1081,7 +1090,7 @@ makedep(#compile{code=Code,options=Opts}=St) -> %% List the dependencies (includes) for this target. {MainRule,PhonyRules} = makedep_add_headers( Ifile, % The input file name. - Code, % The parsed source. + Code0, % The parsed source. [], % The list of dependencies already added. length(Target), % The current line length. Target, % The target. @@ -1101,7 +1110,8 @@ makedep(#compile{code=Code,options=Opts}=St) -> true -> MainRule ++ PhonyRules; _ -> MainRule end, - {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}. + Code = iolist_to_binary([Makefile,"\n"]), + {ok,Code,St}. makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest], Included, LineLen, MainTarget, Phony, Opts) -> @@ -1166,7 +1176,7 @@ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) -> end end. -makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> +makedep_output(Code, #compile{options=Opts,ofile=Ofile}=St) -> %% Write this Makefile (Code) to the selected output. %% If no output is specified, the default is to write to a file named after %% the output file. @@ -1208,7 +1218,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> CloseOutput -> ok = file:close(Output1); true -> ok end, - {ok,St} + {ok,Code,St} catch error:_ -> %% Couldn't write to output Makefile. @@ -1225,33 +1235,33 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> {error,St#compile{errors=St#compile.errors++[Err]}} end. -expand_records(#compile{code=Code0,options=Opts}=St0) -> +expand_records(Code0, #compile{options=Opts}=St) -> Code = erl_expand_records:module(Code0, Opts), - {ok,St0#compile{code=Code}}. + {ok,Code,St}. -core(#compile{code=Forms,options=Opts0}=St) -> +core(Forms, #compile{options=Opts0}=St) -> Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0), Opts = expand_opts(Opts1), {ok,Core,Ws} = v3_core:module(Forms, Opts), Mod = cerl:concrete(cerl:module_name(Core)), - {ok,St#compile{module=Mod,code=Core,options=Opts, - warnings=St#compile.warnings++Ws}}. + {ok,Core,St#compile{module=Mod,options=Opts, + warnings=St#compile.warnings++Ws}}. -core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> +core_fold_module_after_inlining(Code0, #compile{options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. %% Ignore all warnings. {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -v3_kernel(#compile{code=Code0,options=Opts,warnings=Ws0}=St) -> +v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,Ws} = v3_kernel:module(Code0, Opts), case Ws =:= [] orelse test_core_inliner(St) of false -> - {ok,St#compile{code=Code,warnings=Ws0++Ws}}; + {ok,Code,St#compile{warnings=Ws0++Ws}}; true -> %% cerl_inline may produce code that generates spurious %% warnings. Ignore any such warnings. - {ok,St#compile{code=Code}} + {ok,Code,St} end. test_old_inliner(#compile{options=Opts}) -> @@ -1275,23 +1285,23 @@ test_core_inliner(#compile{options=Opts}) -> test_any_inliner(St) -> test_old_inliner(St) orelse test_core_inliner(St). -core_old_inliner(#compile{code=Code0,options=Opts}=St) -> +core_old_inliner(Code0, #compile{options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -core_inline_module(#compile{code=Code0,options=Opts}=St) -> +core_inline_module(Code0, #compile{options=Opts}=St) -> Code = cerl_inline:core_transform(Code0, Opts), - {ok,St#compile{code=Code}}. + {ok,Code,St}. -save_abstract_code(#compile{ifile=File}=St) -> - case abstract_code(St) of - {ok,Code} -> - {ok,St#compile{abstract_code=Code}}; +save_abstract_code(Code, #compile{ifile=File}=St) -> + case abstract_code(Code, St) of + {ok,Abstr} -> + {ok,Code,St#compile{abstract_code=Abstr}}; {error,Es} -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> +abstract_code(Code0, #compile{options=Opts,ofile=OFile}) -> Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of @@ -1313,7 +1323,7 @@ abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> end end; false -> - {ok, Abstr} + {ok,Abstr} end. encrypt_abs_code(Abstr, Key0) -> @@ -1351,18 +1361,17 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> TypeString = atom_to_list(Type), list_to_binary([0,length(TypeString),TypeString,Bin]). -save_core_code(St) -> - {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. +save_core_code(Code, St) -> + {ok,Code,St#compile{core_code=cerl:from_records(Code)}}. -beam_asm(#compile{ifile=File,code=Code0, - abstract_code=Abst,mod_options=Opts0}=St) -> +beam_asm(Code0, #compile{ifile=File,abstract_code=Abst,mod_options=Opts0}=St) -> Source = paranoid_absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), Opts2 = [O || O <- Opts1, effects_code_generation(O)], case beam_asm:module(Code0, Abst, Source, Opts2) of - {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}} + {ok,Code} -> {ok,Code,St#compile{abstract_code=[]}} end. paranoid_absname(""=File) -> @@ -1386,17 +1395,17 @@ is_native_enabled([no_native|_]) -> false; is_native_enabled([_|Opts]) -> is_native_enabled(Opts); is_native_enabled([]) -> false. -native_compile(#compile{code=none}=St) -> {ok,St}; -native_compile(St) -> +native_compile(none, St) -> {ok,none,St}; +native_compile(Code, St) -> case erlang:system_info(hipe_architecture) of undefined -> Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; _ -> - native_compile_1(St) + native_compile_1(Code, St) end. -native_compile_1(St) -> +native_compile_1(Code, St) -> Opts0 = St#compile.options, IgnoreErrors = member(ignore_native_errors, Opts0), Opts = case keyfind(hipe, 1, Opts0) of @@ -1406,10 +1415,10 @@ native_compile_1(St) -> end, try hipe:compile(St#compile.module, St#compile.core_code, - St#compile.code, + Code, Opts) of {ok,{_Type,Bin}=T} when is_binary(Bin) -> - {ok,embed_native_code(St, T)}; + {ok,embed_native_code(Code, T),St}; {error,R} -> case IgnoreErrors of true -> @@ -1432,13 +1441,13 @@ native_compile_1(St) -> end end. -embed_native_code(St, {Architecture,NativeCode}) -> - {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code), +embed_native_code(Code, {Architecture,NativeCode}) -> + {ok, _, Chunks0} = beam_lib:all_chunks(Code), ChunkName = hipe_unified_loader:chunk_name(Architecture), Chunks1 = lists:keydelete(ChunkName, 1, Chunks0), Chunks = Chunks1 ++ [{ChunkName,NativeCode}], - {ok, BeamPlusNative} = beam_lib:build_module(Chunks), - St#compile{code=BeamPlusNative}. + {ok,BeamPlusNative} = beam_lib:build_module(Chunks), + BeamPlusNative. %% effects_code_generation(Option) -> true|false. %% Determine whether the option could have any effect on the @@ -1458,18 +1467,17 @@ effects_code_generation(Option) -> _ -> true end. -save_binary(#compile{code=none}=St) -> {ok,St}; -save_binary(#compile{module=Mod,ofile=Outfile, - options=Opts}=St) -> +save_binary(none, St) -> {ok,none,St}; +save_binary(Code, #compile{module=Mod,ofile=Outfile,options=Opts}=St) -> %% Test that the module name and output file name match. case member(no_error_module_mismatch, Opts) of true -> - save_binary_1(St); + save_binary_1(Code, St); false -> Base = filename:rootname(filename:basename(Outfile)), case atom_to_list(Mod) of Base -> - save_binary_1(St); + save_binary_1(Code, St); _ -> Es = [{St#compile.ofile, [{none,?MODULE,{module_name,Mod,Base}}]}], @@ -1477,14 +1485,14 @@ save_binary(#compile{module=Mod,ofile=Outfile, end end. -save_binary_1(St) -> +save_binary_1(Code, St) -> Ofile = St#compile.ofile, Tfile = tmpfile(Ofile), %Temp working file - case write_binary(Tfile, St#compile.code, St) of + case write_binary(Tfile, Code, St) of ok -> case file:rename(Tfile, Ofile) of ok -> - {ok,St}; + {ok,none,St}; {error,RenameError} -> Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile, RenameError}}]}], @@ -1624,29 +1632,29 @@ pre_defs([]) -> []. inc_paths(Opts) -> [ P || {i,P} <- Opts, is_list(P) ]. -src_listing(Ext, St) -> +src_listing(Ext, Code, St) -> listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs); (Lf, Fs) -> do_src_listing(Lf, Fs) end, - Ext, St). + Ext, Code, St). do_src_listing(Lf, Fs) -> Opts = [lists:keyfind(encoding, 1, io:getopts(Lf))], foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F, Opts),"\n"]) end, Fs). -listing(Ext, St0) -> +listing(Ext, Code, St0) -> St = St0#compile{encoding = none}, - listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St). + listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, Code, St). -listing(LFun, Ext, St) -> +listing(LFun, Ext, Code, St) -> Lfile = outfile(St#compile.base, Ext, St#compile.options), case file:open(Lfile, [write,delayed_write]) of {ok,Lf} -> - Code = restore_expanded_types(Ext, St#compile.code), + Code = restore_expanded_types(Ext, Code), output_encoding(Lf, St), LFun(Lf, Code), ok = file:close(Lf), - {ok,St}; + {ok,Code,St}; {error,Error} -> Es = [{Lfile,[{none,compile,{write_error,Error}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 0031f9b962..38b49c7a76 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -120,7 +120,7 @@ # endif #endif -#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # define HAVE_CHACHA20_POLY1305 #endif @@ -138,27 +138,6 @@ #include <openssl/ecdsa.h> #endif -/* - * FIXME: The support for ChaCha and Poly1305 is based on pre-releases - * of OpenSSL 1.1.0. It is seriously broken when used with the released - * OpenSSL 1.1.0 or later. - */ -#undef HAVE_CHACHA20_POLY1305 - -#if defined(HAVE_CHACHA20_POLY1305) -#include <openssl/chacha.h> -#include <openssl/poly1305.h> - -#if !defined(CHACHA20_NONCE_LEN) -# define CHACHA20_NONCE_LEN 8 -#endif -#if !defined(POLY1305_TAG_LEN) -# define POLY1305_TAG_LEN 16 -#endif - -#endif - - #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -941,7 +920,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt, algo_pubkey_fips_cnt; static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */ static int algo_cipher_cnt, algo_cipher_fips_cnt; -static ERL_NIF_TERM algo_cipher[23]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { @@ -2093,71 +2072,61 @@ out_err: } #endif /* HAVE_GCM_EVP_DECRYPT_BUG */ -#if defined(HAVE_CHACHA20_POLY1305) -static void -poly1305_update_with_length(poly1305_state *poly1305, - const unsigned char *data, size_t data_len) -{ - size_t j = data_len; - unsigned char length_bytes[8]; - unsigned i; - - for (i = 0; i < sizeof(length_bytes); i++) { - length_bytes[i] = j; - j >>= 8; - } - - CRYPTO_poly1305_update(poly1305, data, data_len); - CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes)); -} -#endif static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; - unsigned char *outp; + unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - poly1305_state poly1305; + int len; 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_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); + cipher = EVP_chacha20_poly1305(); + + ctx = EVP_CIPHER_CTX_new(); + + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + EVP_CIPHER_CTX_set_padding(ctx, 0); + + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_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); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); - poly1305_update_with_length(&poly1305, outp, in.size); + 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, 16, &out_tag); - CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag)); + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_GET_TAG, 16, tagp) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return enif_make_tuple2(env, out, out_tag); +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif @@ -2166,53 +2135,52 @@ static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ER static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key,Iv,AAD,In,Tag) */ #if defined(HAVE_CHACHA20_POLY1305) + EVP_CIPHER_CTX *ctx; + const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; ERL_NIF_TERM out; - ErlNifUInt64 in_len_64; - unsigned char poly1305_key[32]; - unsigned char mac[POLY1305_TAG_LEN]; - poly1305_state poly1305; + int len; 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_binary(env, argv[1], &iv) || iv.size == 0 || iv.size > 16 || !enif_inspect_iolist_as_binary(env, argv[2], &aad) || !enif_inspect_iolist_as_binary(env, argv[3], &in) - || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) { + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != 16) { return enif_make_badarg(env); } - /* Take from OpenSSL patch set/LibreSSL: - * - * The underlying ChaCha implementation may not overflow the block - * counter into the second counter word. Therefore we disallow - * individual operations that work on more than 2TB at a time. - * in_len_64 is needed because, on 32-bit platforms, size_t is only - * 32-bits and this produces a warning because it's always false. - * Casting to uint64_t inside the conditional is not sufficient to stop - * the warning. */ - in_len_64 = in.size; - if (in_len_64 >= (1ULL << 32) * 64 - 64) - return enif_make_badarg(env); - - memset(poly1305_key, 0, sizeof(poly1305_key)); - CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + cipher = EVP_chacha20_poly1305(); - CRYPTO_poly1305_init(&poly1305, poly1305_key); - poly1305_update_with_length(&poly1305, aad.data, aad.size); - poly1305_update_with_length(&poly1305, in.data, in.size); - CRYPTO_poly1305_finish(&poly1305, mac); + ctx = EVP_CIPHER_CTX_new(); - if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0) - return atom_error; + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_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); - CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) + goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_TAG, tag.size, tag.data) != 1) + goto out_err; + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + goto out_err; + + EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); return out; + +out_err: + EVP_CIPHER_CTX_free(ctx); + return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0c3b7a0445..31f4e89ffe 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -2249,16 +2249,49 @@ aes_gcm() -> 1} %% TagLength ]. -%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 +%% https://tools.ietf.org/html/rfc7539#appendix-A.5 chacha20_poly1305() -> [ - {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key - "6da371ece272afa1b5dbdd1100a1007"), - hexstr2bin("86d09974840bded2a5ca"), %% PlainText - hexstr2bin("cd7cf67be39c794a"), %% Nonce - hexstr2bin("87e229d4500845a079c0"), %% AAD - hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText - hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag + {chacha20_poly1305, + hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" %% Key + "473917c1402b80099dca5cbc207075c0"), + hexstr2bin("496e7465726e65742d44726166747320" %% PlainText + "61726520647261667420646f63756d65" + "6e74732076616c696420666f72206120" + "6d6178696d756d206f6620736978206d" + "6f6e74687320616e64206d6179206265" + "20757064617465642c207265706c6163" + "65642c206f72206f62736f6c65746564" + "206279206f7468657220646f63756d65" + "6e747320617420616e792074696d652e" + "20497420697320696e617070726f7072" + "6961746520746f2075736520496e7465" + "726e65742d4472616674732061732072" + "65666572656e6365206d617465726961" + "6c206f7220746f206369746520746865" + "6d206f74686572207468616e20617320" + "2fe2809c776f726b20696e2070726f67" + "726573732e2fe2809d"), + hexstr2bin("000000000102030405060708"), %% Nonce + hexstr2bin("f33388860000000000004e91"), %% AAD + hexstr2bin("64a0861575861af460f062c79be643bd" %% CipherText + "5e805cfd345cf389f108670ac76c8cb2" + "4c6cfc18755d43eea09ee94e382d26b0" + "bdb7b73c321b0100d4f03b7f355894cf" + "332f830e710b97ce98c8a84abd0b9481" + "14ad176e008d33bd60f982b1ff37c855" + "9797a06ef4f0ef61c186324e2b350638" + "3606907b6a7c02b0f9f6157b53c867e4" + "b9166c767b804d46a59b5216cde7a4e9" + "9040c5a40433225ee282a1b0a06c523e" + "af4534d7f83fa1155b0047718cbc546a" + "0d072b04b3564eea1b422273f548271a" + "0bb2316053fa76991955ebd63159434e" + "cebb4e466dae5a1073a6727627097a10" + "49e617d91d361094fa68f0ff77987130" + "305beaba2eda04df997b714d6c6f2c29" + "a6ad5cb4022b02709b"), + hexstr2bin("eead9d67890cbb22392336fea1851f38")} %% CipherTag ]. rsa_plain() -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars new file mode 100644 index 0000000000..2c1f8f8d17 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -0,0 +1,4 @@ + +chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' +chars.erl:32: Function t1/0 has no local return +chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl new file mode 100644 index 0000000000..1e9c8ab6b9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl @@ -0,0 +1,32 @@ +-module(chars). + +%% ERL-313 + +-export([t/0]). +-export([t1/0]). + +-record(r, {f :: $A .. $Z}). + +-type cs() :: $A..$Z | $a .. $z | $/. + +-spec t() -> $0-$0..$9-$0| $?. + +t() -> + c(#r{f = $z - 3}), + c($z - 3), + c($B). + +-spec c(cs()) -> $3-$0..$9-$0. + +c($A + 1) -> 2; +c(C) -> + case C of + $z - 3 -> 3; + #r{f = $z - 3} -> 7 + end. + +%% Display contract with character in warning: +-spec f(#{a := $1, b => $2, c => $3}) -> ok. % invalid type spec +f(_) -> ok. + +t1() -> f(#{b => $2}). % breaks the contract diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 5a4cf77b81..ff62cf7499 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -3059,88 +3059,91 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A1, A2) -> - is_specialization(A1, A2) orelse is_specialization(A2, A1). - --spec is_specialization(erl_type(), erl_type()) -> boolean(). - -%% Returns true if the first argument is a specialization of the -%% second argument in the sense that every type is a specialization of -%% 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)) -> - (is_specialization(Domain1, Domain2) andalso - is_specialization(Range1, Range2)); -is_specialization(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2)) -> +-spec is_compat_arg(erl_type(), erl_type()) -> boolean(). + +%% The intention is that 'true' is to be returned iff one of the +%% arguments is a specialization of the other argument in the sense +%% that every type is a specialization of any(). For example, {_,_} is +%% a specialization of any(), but not of tuple(). Does not handle +%% variables, but any() and unions (sort of). However, the +%% implementation is more relaxed as any() is compatible to anything. + +is_compat_arg(T, T) -> true; +is_compat_arg(_, ?any) -> true; +is_compat_arg(?any, _) -> true; +is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + (is_compat_arg(Domain1, Domain2) andalso + is_compat_arg(Range1, Range2)); +is_compat_arg(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> (Size1 =:= Size2 andalso - is_specialization(Contents1, Contents2) andalso - is_specialization(Termination1, Termination2)); -is_specialization(?product(Types1), ?product(Types2)) -> - specialization_list(Types1, Types2); -is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; -is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; -is_specialization(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(Elements1, Elements2); -is_specialization(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> - specialization_list(sup_tuple_elements(List), Elements2); -is_specialization(?tuple(Elements1, Arity, _), - ?tuple_set([{Arity, List}])) when Arity =/= ?any -> - specialization_list(Elements1, sup_tuple_elements(List)); -is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> + is_compat_arg(Contents1, Contents2) andalso + is_compat_arg(Termination1, Termination2)); +is_compat_arg(?product(Types1), ?product(Types2)) -> + is_compat_list(Types1, Types2); +is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) -> + (is_compat_list(Pairs1, Pairs2) andalso + is_compat_arg(DefK1, DefK2) andalso + is_compat_arg(DefV1, DefV2)); +is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; +is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(Elements1, Elements2); +is_compat_arg(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + is_compat_list(sup_tuple_elements(List), Elements2); +is_compat_arg(?tuple(Elements1, Arity, _), + ?tuple_set([{Arity, List}])) when Arity =/= ?any -> + is_compat_list(Elements1, sup_tuple_elements(List)); +is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], - [sup_tuple_elements(T) || {_Arity, T} <- List2]) + is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; -is_specialization(?opaque(_) = T1, T2) -> - is_specialization(t_opaque_structure(T1), T2); -is_specialization(T1, ?opaque(_) = T2) -> - is_specialization(T1, t_opaque_structure(T2)); -is_specialization(?union(List1)=T1, ?union(List2)=T2) -> - case specialization_union2(T1, T2) of - {yes, Type1, Type2} -> is_specialization(Type1, Type2); - no -> specialization_list(List1, List2) +is_compat_arg(?opaque(_) = T1, T2) -> + is_compat_arg(t_opaque_structure(T1), T2); +is_compat_arg(T1, ?opaque(_) = T2) -> + is_compat_arg(T1, t_opaque_structure(T2)); +is_compat_arg(?union(List1)=T1, ?union(List2)=T2) -> + case is_compat_union2(T1, T2) of + {yes, Type1, Type2} -> is_compat_arg(Type1, Type2); + no -> is_compat_list(List1, List2) end; -is_specialization(?union(List), T2) -> +is_compat_arg(?union(List), T2) -> case unify_union(List) of - {yes, Type} -> is_specialization(Type, T2); + {yes, Type} -> is_compat_arg(Type, T2); no -> false end; -is_specialization(T1, ?union(List)) -> +is_compat_arg(T1, ?union(List)) -> case unify_union(List) of - {yes, Type} -> is_specialization(T1, Type); + {yes, Type} -> is_compat_arg(T1, Type); no -> false end; -is_specialization(?var(_), _) -> exit(error); -is_specialization(_, ?var(_)) -> exit(error); -is_specialization(?none, _) -> false; -is_specialization(_, ?none) -> false; -is_specialization(?unit, _) -> false; -is_specialization(_, ?unit) -> false; -is_specialization(#c{}, #c{}) -> false. +is_compat_arg(?var(_), _) -> exit(error); +is_compat_arg(_, ?var(_)) -> exit(error); +is_compat_arg(?none, _) -> false; +is_compat_arg(_, ?none) -> false; +is_compat_arg(?unit, _) -> false; +is_compat_arg(_, ?unit) -> false; +is_compat_arg(#c{}, #c{}) -> false. -specialization_list_list(LL1, LL2) -> - length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). +is_compat_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso is_compat_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). +is_compat_list_list1([], []) -> true; +is_compat_list_list1([L1|LL1], [L2|LL2]) -> + is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2). -specialization_list(L1, L2) -> - length(L1) =:= length(L2) andalso specialization_list1(L1, L2). +is_compat_list(L1, L2) -> + length(L1) =:= length(L2) andalso is_compat_list1(L1, L2). -specialization_list1([], []) -> true; -specialization_list1([T1|L1], [T2|L2]) -> - is_specialization(T1, T2) andalso specialization_list1(L1, L2). +is_compat_list1([], []) -> true; +is_compat_list1([T1|L1], [T2|L2]) -> + is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2). -specialization_union2(?union(List1)=T1, ?union(List2)=T2) -> +is_compat_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; {{yes, Type1}, no} -> {yes, Type1, T2}; @@ -4534,6 +4537,8 @@ from_form({atom, _L, Atom}, _S, _D, L, C) -> {t_atom(Atom), L, C}; from_form({integer, _L, Int}, _S, _D, L, C) -> {t_integer(Int), L, C}; +from_form({char, _L, Char}, _S, _D, L, C) -> + {t_integer(Char), L, C}; from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> @@ -5048,6 +5053,7 @@ check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, list_check_record_fields(Args, S, C); check_record_fields({atom, _L, _}, _S, C) -> C; check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({char, _L, _}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; check_record_fields({type, _L, tuple, any}, _S, C) -> C; @@ -5149,6 +5155,7 @@ t_form_to_string({var, _L, Name}) -> atom_to_list(Name); t_form_to_string({atom, _L, Atom}) -> io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... ' t_form_to_string({integer, _L, Int}) -> integer_to_list(Int); +t_form_to_string({char, _L, Char}) -> integer_to_list(Char); t_form_to_string({op, _L, _Op, _Arg} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 91d87289a2..bd5f6df39e 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -147,6 +147,26 @@ request(Method, Request, HttpOptions, Options) -> request(Method, Request, HttpOptions, Options, default_profile()). request(Method, + {Url, Headers, ContentType, TupleBody}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso is_tuple(TupleBody)-> + case check_body_gen(TupleBody) of + ok -> + do_request(Method, {Url, Headers, ContentType, TupleBody}, HTTPOptions, Options, Profile); + Error -> + Error + end; +request(Method, + {Url, Headers, ContentType, Body}, + HTTPOptions, Options, Profile) + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse (Method =:= delete)) + andalso (is_atom(Profile) orelse is_pid(Profile)) andalso + is_list(ContentType) andalso (is_list(Body) orelse is_binary(Body)) -> + do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile); + +request(Method, {Url, Headers}, HTTPOptions, Options, Profile) when (Method =:= options) orelse @@ -155,12 +175,6 @@ request(Method, (Method =:= delete) orelse (Method =:= trace) andalso (is_atom(Profile) orelse is_pid(Profile)) -> - ?hcrt("request", [{method, Method}, - {url, Url}, - {headers, Headers}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -172,21 +186,9 @@ request(Method, handle_request(Method, Url, ParsedUrl, Headers, [], [], HTTPOptions, Options, Profile) end - end; - -request(Method, - {Url, Headers, ContentType, Body}, - HTTPOptions, Options, 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}, - {content_type, ContentType}, - {body, Body}, - {http_options, HTTPOptions}, - {options, Options}, - {profile, Profile}]), + end. + +do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) -> case uri_parse(Url, Options) of {error, Reason} -> {error, Reason}; @@ -196,7 +198,6 @@ request(Method, HTTPOptions, Options, Profile) end. - %%-------------------------------------------------------------------------- %% cancel_request(RequestId) -> ok %% cancel_request(RequestId, Profile) -> ok @@ -209,7 +210,6 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), httpc_manager:cancel_request(RequestId, profile_name(Profile)). @@ -232,7 +232,6 @@ cancel_request(RequestId, Profile) set_options(Options) -> set_options(Options, default_profile()). set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> httpc_manager:set_options(Opts, profile_name(Profile)); @@ -272,7 +271,6 @@ get_options(all = _Options, Profile) -> get_options(Options, Profile) when (is_list(Options) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("get options", [{options, Options}, {profile, Profile}]), case Options -- get_options() of [] -> try @@ -314,9 +312,6 @@ store_cookies(SetCookieHeaders, Url) -> store_cookies(SetCookieHeaders, Url, Profile) when is_atom(Profile) orelse is_pid(Profile) -> - ?hcrt("store cookies", [{set_cookie_headers, SetCookieHeaders}, - {url, Url}, - {profile, Profile}]), try begin %% Since the Address part is not actually used @@ -353,9 +348,6 @@ cookie_header(Url, Opts) when is_list(Opts) -> cookie_header(Url, Opts, Profile) when (is_list(Opts) andalso (is_atom(Profile) orelse is_pid(Profile))) -> - ?hcrt("cookie header", [{url, Url}, - {opts, Opts}, - {profile, Profile}]), try begin httpc_manager:which_cookies(Url, Opts, profile_name(Profile)) @@ -398,7 +390,6 @@ which_sessions() -> which_sessions(default_profile()). which_sessions(Profile) -> - ?hcrt("which sessions", [{profile, Profile}]), try begin httpc_manager:which_sessions(profile_name(Profile)) @@ -419,7 +410,6 @@ info() -> info(default_profile()). info(Profile) -> - ?hcrt("info", [{profile, Profile}]), try begin httpc_manager:info(profile_name(Profile)) @@ -440,7 +430,6 @@ reset_cookies() -> reset_cookies(default_profile()). reset_cookies(Profile) -> - ?hcrt("reset cookies", [{profile, Profile}]), try begin httpc_manager:reset_cookies(profile_name(Profile)) @@ -458,7 +447,6 @@ reset_cookies(Profile) -> %% same behavior as active once for sockets. %%------------------------------------------------------------------------- stream_next(Pid) -> - ?hcrt("stream next", [{handler, Pid}]), httpc_handler:stream_next(Pid). @@ -466,7 +454,6 @@ stream_next(Pid) -> %%% Behaviour callbacks %%%======================================================================== start_standalone(PropList) -> - ?hcrt("start standalone", [{proplist, PropList}]), case proplists:get_value(profile, PropList) of undefined -> {error, no_profile}; @@ -477,14 +464,11 @@ start_standalone(PropList) -> end. start_service(Config) -> - ?hcrt("start service", [{config, Config}]), httpc_profile_sup:start_child(Config). stop_service(Profile) when is_atom(Profile) -> - ?hcrt("stop service", [{profile, Profile}]), httpc_profile_sup:stop_child(Profile); stop_service(Pid) when is_pid(Pid) -> - ?hcrt("stop service", [{pid, Pid}]), case service_info(Pid) of {ok, [{profile, Profile}]} -> stop_service(Profile); @@ -510,7 +494,6 @@ service_info(Pid) -> %%%======================================================================== %%% Internal functions %%%======================================================================== - handle_request(Method, Url, {Scheme, UserInfo, Host, Port, Path, Query}, Headers0, ContentType, Body0, @@ -521,9 +504,6 @@ handle_request(Method, Url, try begin - ?hcrt("begin processing", [{started, Started}, - {new_headers, NewHeaders0}]), - {NewHeaders, Body} = case Body0 of {chunkify, ProcessBody, Acc} @@ -575,16 +555,13 @@ handle_request(Method, Url, {ok, RequestId} -> handle_answer(RequestId, Sync, Options); {error, Reason} -> - ?hcrd("request failed", [{reason, Reason}]), {error, Reason} end end catch error:{noproc, _} -> - ?hcrv("noproc", [{profile, Profile}]), {error, {not_started, Profile}}; throw:Error -> - ?hcrv("throw", [{error, Error}]), Error end. @@ -620,15 +597,10 @@ handle_answer(RequestId, false, _) -> handle_answer(RequestId, true, Options) -> receive {http, {RequestId, saved_to_file}} -> - ?hcrt("received saved-to-file", [{request_id, RequestId}]), {ok, saved_to_file}; {http, {RequestId, {_,_,_} = Result}} -> - ?hcrt("received answer", [{request_id, RequestId}, - {result, Result}]), return_answer(Options, Result); {http, {RequestId, {error, Reason}}} -> - ?hcrt("received error", [{request_id, RequestId}, - {reason, Reason}]), {error, Reason} end. @@ -1257,18 +1229,14 @@ child_name(Pid, [{Name, Pid} | _]) -> child_name(Pid, [_ | Children]) -> child_name(Pid, Children). -%% d(F) -> -%% d(F, []). - -%% d(F, A) -> -%% d(get(dbg), F, A). - -%% d(true, F, A) -> -%% io:format(user, "~w:~w:" ++ F ++ "~n", [self(), ?MODULE | A]); -%% d(_, _, _) -> -%% ok. - host_address(Host, false) -> Host; host_address(Host, true) -> string:strip(string:strip(Host, right, $]), left, $[). + +check_body_gen({Fun, _}) when is_function(Fun) -> + ok; +check_body_gen({chunkify, Fun, _}) when is_function(Fun) -> + ok; +check_body_gen(Gen) -> + {error, {bad_body_generator, Gen}}. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 2e7df8e424..c99200777b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,6 @@ %% Internal Application API -export([ start_link/4, - %% connect_and_send/2, send/2, cancel/2, stream_next/1, @@ -165,14 +164,12 @@ info(Pid) -> %%-------------------------------------------------------------------- %% Request should not be streamed stream(BodyPart, #request{stream = none} = Request, _) -> - ?hcrt("stream - none", []), {false, BodyPart, Request}; %% Stream to caller stream(BodyPart, #request{stream = Self} = Request, Code) when ?IS_STREAMED(Code) andalso ((Self =:= self) orelse (Self =:= {self, once})) -> - ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, {Request#request.id, stream, BodyPart}), {true, <<>>, Request}; @@ -182,10 +179,8 @@ stream(BodyPart, #request{stream = Self} = Request, Code) %% We keep this for backward compatibillity... stream(BodyPart, #request{stream = Filename} = Request, Code) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), stream(BodyPart, Request#request{stream = Fd}, 200); {error, Reason} -> exit({stream_to_file_failed, Reason}) @@ -194,7 +189,6 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) %% Stream to file stream(BodyPart, #request{stream = Fd} = Request, Code) when ?IS_STREAMED(Code) -> - ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of ok -> {true, <<>>, Request}; @@ -203,7 +197,6 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed - ?hcrt("stream - ignore", [{request, Request}]), {false, BodyPart, Request}. @@ -257,22 +250,148 @@ init([Parent, Request, Options, ProfileName]) -> %% {stop, Reason, State} (terminate/2 is called) %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call(#request{address = Addr} = Request, _, +handle_call(Request, From, State) -> + try do_handle_call(Request, From, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + + +%%-------------------------------------------------------------------- +%% Function: handle_cast(Msg, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(Msg, State) -> + try do_handle_cast(Msg, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: handle_info(Info, State) -> {noreply, State} | +%% {noreply, State, Timeout} | +%% {stop, Reason, State} (terminate/2 is called) +%% Description: Handling all non call/cast messages +%%-------------------------------------------------------------------- +handle_info(Info, State) -> + try do_handle_info(Info, State) of + Result -> + Result + catch + _:Reason -> + {stop, {shutdown, Reason} , State} + end. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> _ (ignored by gen_server) +%% Description: Shutdown the httpc_handler +%%-------------------------------------------------------------------- + +%% Init error there is no socket to be closed. +terminate(normal, + #state{request = Request, + session = {send_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, + #state{request = Request, + session = {connect_failed, _} = Reason} = State) -> + maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + ok; + +terminate(normal, #state{session = undefined}) -> + ok; + +%% Init error sending, no session information has been setup but +%% there is a socket that needs closing. +terminate(normal, + #state{session = #session{id = undefined} = Session}) -> + close_socket(Session); + +%% Socket closed remotely +terminate(normal, + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + %% Cancel timers + cancel_timers(Timers), + + %% Maybe deliver answers to requests + deliver_answer(Request), + + %% And, just in case, close our side (**really** overkill) + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> + + %% Clobber session + (catch httpc_manager:delete_session(Id, ProfileName)), + + maybe_retry_queue(Pipeline, State), + maybe_retry_queue(KeepAlive, State), + + cancel_timer(Timers#timers.queue_timer, timeout_queue), + http_transport:close(SocketType, Socket); + +terminate(_Reason, #state{request = undefined}) -> + ok; + +terminate(Reason, #state{request = Request} = State) -> + NewState = maybe_send_answer(Request, + httpc_response:error(Request, Reason), + State), + terminate(Reason, NewState#state{request = undefined}). + +%%-------------------------------------------------------------------- +%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} +%% Purpose: Convert process state when code is changed +%%-------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%%%-------------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State0) when Status =/= undefined -> - - ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of ok -> @@ -287,9 +406,8 @@ handle_call(#request{address = Addr} = Request, _, case State0#state.request of #request{} = OldRequest -> %% Old request not yet finished - ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = State1#state.timers, + NewTimers = State1#state.timers, NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = @@ -297,7 +415,6 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewPipeline) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State1#state{ request = OldRequest, pipeline = NewPipeline, @@ -306,7 +423,6 @@ handle_call(#request{address = Addr} = Request, _, undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = @@ -314,18 +430,16 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), State = init_wait_for_response_state(Request, State1#state{session = NewSession, timers = NewTimers}), {reply, ok, State} end; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), NewPipeline = queue:in(Request, State0#state.pipeline), - {stop, shutdown, {pipeline_failed, Reason}, State0#state{pipeline = NewPipeline}} + {stop, {shutdown, {pipeline_failed, Reason}}, State0#state{pipeline = NewPipeline}} end; -handle_call(#request{address = Addr} = Request, _, +do_handle_call(#request{address = Addr} = Request, _, #state{status = Status, session = #session{type = keep_alive} = Session, timers = Timers, @@ -333,17 +447,11 @@ handle_call(#request{address = Addr} = Request, _, profile_name = ProfileName} = State0) when Status =/= undefined -> - ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), - ClientClose = httpc_request:is_client_closing(Request#request.headers), case State0#state.request of #request{} -> %% Old request not yet finished %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), NewKeepAlive = queue:in(Request, State0#state.keep_alive), NewSession = Session#session{queue_length = @@ -351,13 +459,11 @@ handle_call(#request{address = Addr} = Request, _, queue:len(NewKeepAlive) + 1, client_close = ClientClose}, insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), {reply, ok, State0#state{keep_alive = NewKeepAlive, session = NewSession}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. - ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, timeout_queue), NewTimers = Timers#timers{queue_timer = undefined}, @@ -365,8 +471,6 @@ handle_call(#request{address = Addr} = Request, _, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), - %% Activate the request time out for the new request State2 = activate_request_timeout(State1#state{request = Request}), @@ -377,22 +481,13 @@ handle_call(#request{address = Addr} = Request, _, State = init_wait_for_response_state(Request, State2#state{session = NewSession}), {reply, ok, State}; {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {stop, shutdown, {keepalive_failed, Reason}, State1} + {stop, {shutdown, {keepalive_failed, Reason}}, State1} end end; - -handle_call(info, _, State) -> +do_handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. -%%-------------------------------------------------------------------- -%% Function: handle_cast(Msg, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling cast messages -%%-------------------------------------------------------------------- - %% When the request in process has been canceled the handler process is %% stopped and the pipelined requests will be reissued or remaining %% requests will be sent on a new connection. This is is @@ -405,145 +500,102 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId}, +do_handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, canceled = Canceled} = State) -> - ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, RequestId}, + #state{request = #request{}, + canceled = Canceled} = State) -> {noreply, State#state{canceled = [RequestId | Canceled]}}; -handle_cast({cancel, RequestId}, - #state{profile_name = ProfileName, - request = undefined, - canceled = Canceled} = State) -> - ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, undefined}, - {profile, ProfileName}, - {canceled, Canceled}]), +do_handle_cast({cancel, _}, + #state{request = undefined} = State) -> {noreply, State}; - -handle_cast(stream_next, #state{session = Session} = State) -> +do_handle_cast(stream_next, #state{session = Session} = State) -> activate_once(Session), %% Inactivate the #state.once here because we don't want %% next_body_chunk/1 to activate the socket twice. {noreply, State#state{once = inactive}}. - -%%-------------------------------------------------------------------- -%% Function: handle_info(Info, State) -> {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%% Description: Handling all non call/cast messages -%%-------------------------------------------------------------------- -handle_info({Proto, _Socket, Data}, +do_handle_info({Proto, _Socket, Data}, #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, + request = #request{method = Method} = Request, session = Session, status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> - ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), - - FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Streamed of - false -> - Length; - true -> - Length - size(Body) - end, - - NewState = next_body_chunk(State, Code), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - {Module, decode_size, - [TotalChunk, HexList, + try Module:Function([Data | Args]) of + {ok, Result} -> + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + {_, Code, _} = StatusLine, + {Streamed, NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Streamed of + false -> + Length; + true -> + Length - size(Body) + end, + + NewState = next_body_chunk(State, Code), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_size", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - {_, Code, _} = StatusLine, - {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_size, - [TotalChunk, HexList, + when BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + {_, Code, _} = StatusLine, + {_, NewBody, NewRequest} = stream(BodySoFar, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_size, + [TotalChunk, HexList, AccHeaderSize, {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_data, + [ChunkSize, TotalChunk, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), + <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, + StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, + NewChunkSize = ChunkSize - ChunkSizeToSteal, + {_, Code, _} = StatusLine, + + {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), + NewState = next_body_chunk(State, Code), + NewMFA = {Module, decode_data, + [NewChunkSize, NewTotalChunk, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, {noreply, NewState#state{mfa = NewMFA, request = NewRequest}}; - {Module, decode_data, - [ChunkSize, TotalChunk, - {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} - when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> - ?hcrd("data processed - decode_data", []), - %% The response body is chunk-encoded. Steal decoded - %% chunks as much as possible to stream. - ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), - <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, - StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, - NewChunkSize = ChunkSize - ChunkSizeToSteal, - {_, Code, _} = StatusLine, - - {_, NewBody, NewRequest} = stream(StolenBody, Request, Code), - NewState = next_body_chunk(State, Code), - NewMFA = {Module, decode_data, - [NewChunkSize, NewTotalChunk, - {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - _:_Reason -> - ?hcrd("data processing exit", [{exit, _Reason}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - end, - ?hcri("data processed", [{final_result, FinalResult}]), - FinalResult; - + NewMFA -> + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + _:Reason -> + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, {shutdown, Reason}, NewState} + end; -handle_info({Proto, Socket, Data}, +do_handle_info({Proto, Socket, Data}, #state{mfa = MFA, request = Request, session = Session, @@ -568,200 +620,107 @@ handle_info({Proto, Socket, Data}, {noreply, State}; - %% The Server may close the connection to indicate that the %% whole body is now sent instead of sending an length %% indicator. -handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({tcp_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); -handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> +do_handle_info({ssl_closed, _}, State = #state{mfa = {_, whole_body, Args}}) -> handle_response(State#state{body = hd(Args)}); %%% Server closes idle pipeline -handle_info({tcp_closed, _}, State = #state{request = undefined}) -> +do_handle_info({tcp_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; -handle_info({ssl_closed, _}, State = #state{request = undefined}) -> +do_handle_info({ssl_closed, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%% Error cases -handle_info({tcp_closed, _}, #state{session = Session0} = State) -> +do_handle_info({tcp_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({ssl_closed, _}, #state{session = Session0} = State) -> +do_handle_info({ssl_closed, _}, #state{session = Session0} = State) -> Socket = Session0#session.socket, Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; -handle_info({tcp_error, _, _} = Reason, State) -> +do_handle_info({tcp_error, _, _} = Reason, State) -> {stop, Reason, State}; -handle_info({ssl_error, _, _} = Reason, State) -> +do_handle_info({ssl_error, _, _} = Reason, State) -> {stop, Reason, State}; %% Timeouts %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{request = #request{id = RequestId} = Request, canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, canceled = [RequestId | Canceled]}}; -handle_info({timeout, RequestId}, +do_handle_info({timeout, RequestId}, #state{canceled = Canceled, profile_name = ProfileName} = State) -> - ?hcri("timeout", [{id, RequestId}]), Filter = fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), %% Notify the owner httpc_response:send(From, httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), [Request#request{from = answer_sent}]; (_) -> true end, case State#state.status of pipeline -> - ?hcrd("pipeline", []), Pipeline = queue:filter(Filter, State#state.pipeline), {noreply, State#state{canceled = [RequestId | Canceled], pipeline = Pipeline}}; keep_alive -> - ?hcrd("keep_alive", []), KeepAlive = queue:filter(Filter, State#state.keep_alive), {noreply, State#state{canceled = [RequestId | Canceled], keep_alive = KeepAlive}} end; -handle_info(timeout_queue, State = #state{request = undefined}) -> +do_handle_info(timeout_queue, State = #state{request = undefined}) -> {stop, normal, State}; %% Timing was such as the queue_timeout was not canceled! -handle_info(timeout_queue, #state{timers = Timers} = State) -> +do_handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. -handle_info({init_error, Tag, ClientErrMsg}, +do_handle_info({init_error, Reason, ClientErrMsg}, State = #state{request = Request}) -> - ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - + {stop, {shutdown, Reason}, NewState}; %%% httpc_manager process dies. -handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> +do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> {stop, normal, State}; %%Try to finish the current request anyway, %% there is a fairly high probability that it can be done successfully. %% Then close the connection, hopefully a new manager is started that %% can retry requests in the pipeline. -handle_info({'EXIT', _, _}, State) -> +do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. -%%-------------------------------------------------------------------- -%% Function: terminate(Reason, State) -> _ (ignored by gen_server) -%% Description: Shutdown the httpc_handler -%%-------------------------------------------------------------------- - -%% Init error there is no socket to be closed. -terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> - ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), - maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - ok; - -terminate(normal, #state{session = undefined}) -> - ok; - -%% Init error sending, no session information has been setup but -%% there is a socket that needs closing. -terminate(normal, - #state{session = #session{id = undefined} = Session}) -> - close_socket(Session); - -%% Socket closed remotely -terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - %% Cancel timers - cancel_timers(Timers), - - %% Maybe deliver answers to requests - deliver_answer(Request), - - %% And, just in case, close our side (**really** overkill) - http_transport:close(SocketType, Socket); - -terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> - ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), - - %% Clobber session - (catch httpc_manager:delete_session(Id, ProfileName)), - - maybe_retry_queue(Pipeline, State), - maybe_retry_queue(KeepAlive, State), - - cancel_timer(Timers#timers.queue_timer, timeout_queue), - http_transport:close(SocketType, Socket); +call(Msg, Pid) -> + call(Msg, Pid, infinity). -terminate(Reason, #state{request = undefined}) -> - ?hcrt("terminate", [{reason, Reason}]), - ok; +call(Msg, Pid, Timeout) -> + gen_server:call(Pid, Msg, Timeout). -terminate(Reason, #state{request = Request} = State) -> - ?hcrd("terminate", [{reason, Reason}, {request, Request}]), - NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), - terminate(Reason, NewState#state{request = undefined}). +cast(Msg, Pid) -> + gen_server:cast(Pid, Msg). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of @@ -776,45 +735,13 @@ maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> maybe_send_answer(Request, Answer, State) -> answer_request(Request, Answer, State). -deliver_answer(#request{id = Id, from = From} = Request) +deliver_answer(#request{from = From} = Request) when is_pid(From) -> Response = httpc_response:error(Request, socket_closed_remotely), - ?hcrd("deliver answer", [{id, Id}, {from, From}, {response, Response}]), httpc_response:send(From, Response); -deliver_answer(Request) -> - ?hcrd("skip deliver answer", [{request, Request}]), +deliver_answer(_Request) -> ok. - -%%-------------------------------------------------------------------- -%% Func: code_change(_OldVsn, State, Extra) -> {ok, NewState} -%% Purpose: Convert process state when code is changed -%%-------------------------------------------------------------------- - -code_change(_, State, _) -> - {ok, State}. - - -%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> -%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}. - -%% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> -%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. - -%% new_queue(Queue, Fun) -> -%% List = queue:to_list(Queue), -%% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), -%% queue:from_list(NewList). - - %%%-------------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -872,26 +799,21 @@ connect(SocketType, ToAddress, connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, - ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + httpc_request:is_client_closing( + Request#request.headers), SessionType = httpc_manager:session_type(Options), SocketType = socket_type(Request), Session = #session{id = {Request#request.address, self()}, scheme = Request#request.scheme, socket = Socket, - socket_type = SocketType, - client_close = ClientClose, - type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, case httpc_request:send(Address, Session, Request) of ok -> - ?hcri("first request sent", []), TmpState = State#state{request = Request, session = Session, mfa = init_mfa(Request, State), @@ -949,12 +871,6 @@ handler_info(#state{request = Request, options = _Options, timers = _Timers} = _State) -> - ?hcrt("handler info", [{request, Request}, - {session, Session}, - {pipeline, Pipeline}, - {keep_alive, KeepAlive}, - {status, Status}]), - %% Info about the current request RequestInfo = case Request of @@ -965,8 +881,6 @@ handler_info(#state{request = Request, [{id, Id}, {started, ReqStarted}] end, - ?hcrt("handler info", [{request_info, RequestInfo}]), - %% Info about the current session/socket SessionType = Session#session.type, QueueLen = case SessionType of @@ -979,22 +893,12 @@ handler_info(#state{request = Request, Socket = Session#session.socket, SocketType = Session#session.socket_type, - ?hcrt("handler info", [{session_type, SessionType}, - {queue_length, QueueLen}, - {scheme, Scheme}, - {socket, Socket}]), - SocketOpts = http_transport:getopts(SocketType, Socket), SocketStats = http_transport:getstat(SocketType, Socket), Remote = http_transport:peername(SocketType, Socket), Local = http_transport:sockname(SocketType, Socket), - ?hcrt("handler info", [{remote, Remote}, - {local, Local}, - {socket_opts, SocketOpts}, - {socket_stats, SocketStats}]), - SocketInfo = [{remote, Remote}, {local, Local}, {socket_opts, SocketOpts}, @@ -1014,7 +918,6 @@ handler_info(#state{request = Request, handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, State = #state{request = Request}) -> - ?hcrt("handle_http_msg", [{headers, Headers}]), case Headers#http_response_h.'content-type' of "multipart/byteranges" ++ _Param -> exit({not_yet_implemented, multypart_byteranges}); @@ -1028,15 +931,12 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, end; handle_http_msg({ChunkedHeaders, Body}, #state{status_line = {_, Code, _}, headers = Headers} = State) -> - ?hcrt("handle_http_msg", - [{chunked_headers, ChunkedHeaders}, {headers, Headers}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody, request = NewRequest}); handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> - ?hcrt("handle_http_msg", [{code, Code}]), {_, NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). @@ -1051,41 +951,28 @@ handle_http_body(_, #state{status = {ssl_tunnel, Request}, {stop, normal, NewState}; handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> - ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> - ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> - ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); handle_http_body(Body, #state{headers = Headers, max_body_size = MaxBodySize, status_line = {_,Code, _}, request = Request} = State) -> - ?hcrt("handle_http_body", - [{max_body_size, MaxBodySize}, {headers, Headers}, {code, Code}]), TransferEnc = Headers#http_response_h.'transfer-encoding', case case_insensitive_header(TransferEnc) of "chunked" -> - ?hcrt("handle_http_body - chunked", []), try http_chunk:decode(Body, State#state.max_body_size, State#state.max_header_size) of {Module, Function, Args} -> - ?hcrt("handle_http_body - new mfa", - [{module, Module}, - {function, Function}, - {args, Args}]), NewState = next_body_chunk(State, Code), {noreply, NewState#state{mfa = {Module, Function, Args}}}; {ok, {ChunkedHeaders, NewBody}} -> - ?hcrt("handle_http_body - new body", - [{chunked_headers, ChunkedHeaders}, - {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), case Body of @@ -1107,7 +994,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Enc when Enc =:= "identity"; Enc =:= undefined -> - ?hcrt("handle_http_body - identity", []), Length = list_to_integer(Headers#http_response_h.'content-length'), case ((Length =< MaxBodySize) orelse (MaxBodySize =:= nolimit)) of @@ -1131,7 +1017,6 @@ handle_http_body(Body, #state{headers = Headers, {stop, normal, NewState} end; Encoding when is_list(Encoding) -> - ?hcrt("handle_http_body - other", [{encoding, Encoding}]), NewState = answer_request(Request, httpc_response:error(Request, unknown_encoding), @@ -1152,18 +1037,10 @@ handle_response(#state{request = Request, options = Options, profile_name = ProfileName} = State) when Status =/= new -> - - ?hcrd("handle response", [{profile, ProfileName}, - {status, Status}, - {request, Request}, - {session, Session}, - {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> - ?hcrd("handle response - continue", []), %% Send request body {_, RequestBody} = Request#request.content, send_raw(Session, RequestBody), @@ -1180,7 +1057,6 @@ handle_response(#state{request = Request, %% Ignore unexpected 100-continue response and receive the %% actual response that the server will send right away. {ignore, Data} -> - ?hcrd("handle response - ignore", [{data, Data}]), Relaxed = (Request#request.settings)#http_options.relaxed, MFA = {httpc_response, parse, [State#state.max_header_size, Relaxed]}, @@ -1194,23 +1070,17 @@ handle_response(#state{request = Request, %% obsolete and the manager will create a new request %% with the same id as the current. {redirect, NewRequest, Data} -> - ?hcrt("handle response - redirect", - [{new_request, NewRequest}, {data, Data}]), ok = httpc_manager:redirect_request(NewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {retry, TimeNewRequest, Data} -> - ?hcrt("handle response - retry", - [{time_new_request, TimeNewRequest}, {data, Data}]), ok = httpc_manager:retry_request(TimeNewRequest, ProfileName), handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> - ?hcrd("handle response - ok", []), stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); {stop, Msg} -> - ?hcrd("handle response - stop", [{msg, Msg}]), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), {stop, normal, NewState} @@ -1245,28 +1115,19 @@ handle_pipeline(#state{status = pipeline, profile_name = ProfileName, options = #options{pipeline_timeout = TimeOut}} = State, Data) -> - - ?hcrd("handle pipeline", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.pipeline) of {empty, _} -> - ?hcrd("pipeline queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> - ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request had been cancelled", []), %% See comment for handle_cast({cancel, RequestId}) {stop, normal, State#state{request = NextRequest#request{from = answer_sent}, pipeline = Pipeline}}; false -> - ?hcrv("next request", [{request, NextRequest}]), NewSession = Session#session{queue_length = %% Queue + current @@ -1283,25 +1144,16 @@ handle_keep_alive_queue(#state{status = keep_alive, options = #options{keep_alive_timeout = TimeOut, proxy = Proxy}} = State, Data) -> - - ?hcrd("handle keep_alive", [{profile, ProfileName}, - {session, Session}, - {timeout, TimeOut}]), - case queue:out(State#state.keep_alive) of {empty, _} -> - ?hcrd("keep_alive queue empty", []), handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> - ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, State#state.canceled) of true -> - ?hcrv("next request has already been canceled", []), handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> - ?hcrv("next request", [{request, NextRequest}]), #request{address = Addr} = NextRequest, Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, NextRequest) of @@ -1314,7 +1166,6 @@ handle_keep_alive_queue(#state{status = keep_alive, end end end. - handle_empty_queue(Session, ProfileName, TimeOut, State) -> %% The server may choose too terminate an idle pipline| keep_alive session %% in this case we want to receive the close message @@ -1350,7 +1201,6 @@ init_wait_for_response_state(Request, State) -> status_line = undefined, headers = undefined, body = undefined}. - gather_data(<<>>, Session, State) -> activate_once(Session), {noreply, State}; @@ -1381,10 +1231,6 @@ activate_request_timeout( State; _ -> ReqId = Request#request.id, - ?hcrt("activate request timer", - [{request_id, ReqId}, - {time_consumed, t() - Request#request.started}, - {timeout, Timeout}]), Msg = {timeout, ReqId}, Ref = erlang:send_after(Timeout, self(), Msg), Request2 = Request#request{timer = Ref}, @@ -1427,10 +1273,6 @@ try_to_enable_pipeline_or_keep_alive( status_line = {Version, _, _}, headers = Headers, profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), case is_keep_alive_enabled_server(Version, Headers) andalso is_keep_alive_connection(Headers, Session) of true -> @@ -1455,7 +1297,6 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, #state{session = Session, timers = Timers, profile_name = ProfileName} = State) -> - ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), RequestTimers = Timers#timers.request_timers, TimerRef = @@ -1602,42 +1443,32 @@ socket_type(#request{scheme = http}) -> ip_comm; socket_type(#request{scheme = https, settings = Settings}) -> Settings#http_options.ssl. -%% socket_type(http) -> -%% ip_comm; -%% socket_type(https) -> -%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> - ?hcrt("start stream - none", []), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = self} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, ignore), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, Headers, #request{stream = {self, once}} = Request) when ?IS_STREAMED(Code) -> - ?hcrt("start stream - self:once", [{code, Code}]), Msg = httpc_response:stream_start(Headers, Request, self()), httpc_response:send(Request#request.from, Msg), {ok, Request}; start_stream({_Version, Code, _ReasonPhrase}, _Headers, #request{stream = Filename} = Request) when ?IS_STREAMED(Code) andalso is_list(Filename) -> - ?hcrt("start stream", [{code, Code}, {filename, Filename}]), case file:open(Filename, [write, raw, append, delayed_write]) of {ok, Fd} -> - ?hcri("start stream - file open ok", [{fd, Fd}]), {ok, Request#request{stream = Fd}}; {error, Reason} -> exit({stream_to_file_failed, Reason}) end; start_stream(_StatusLine, _Headers, Request) -> - ?hcrt("start stream - no op", []), {ok, Request}. stream_remaining_body(<<>>, _, _) -> @@ -1648,16 +1479,12 @@ stream_remaining_body(Body, Request, {_, Code, _}) -> %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request end_stream(_, #request{stream = none}) -> - ?hcrt("end stream - none", []), ok; end_stream(_, #request{stream = self}) -> - ?hcrt("end stream - self", []), ok; end_stream(_, #request{stream = {self, once}}) -> - ?hcrt("end stream - self:once", []), ok; end_stream({_,200,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 200", [{stream, Fd}]), case file:close(Fd) of ok -> ok; @@ -1665,15 +1492,13 @@ end_stream({_,200,_}, #request{stream = Fd}) -> file:close(Fd) end; end_stream({_,206,_}, #request{stream = Fd}) -> - ?hcrt("end stream - 206", [{stream, Fd}]), case file:close(Fd) of ok -> ok; {error, enospc} -> % Could be due to delayed_write file:close(Fd) end; -end_stream(SL, R) -> - ?hcrt("end stream", [{status_line, SL}, {request, R}]), +end_stream(_, _) -> ok. @@ -1702,11 +1527,8 @@ handle_verbose(trace) -> handle_verbose(_) -> ok. - - send_raw(#session{socket = Socket, socket_type = SocketType}, {ProcessBody, Acc}) when is_function(ProcessBody, 1) -> - ?hcrt("send raw", [{acc, Acc}]), send_raw(SocketType, Socket, ProcessBody, Acc); send_raw(#session{socket = Socket, socket_type = SocketType}, Body) -> http_transport:send(SocketType, Socket, Body). @@ -1717,7 +1539,6 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> ok; {ok, Data, NewAcc} -> DataBin = iolist_to_binary(Data), - ?hcrd("send", [{data, DataBin}]), case http_transport:send(SocketType, Socket, DataBin) of ok -> send_raw(SocketType, Socket, ProcessBody, NewAcc); @@ -1883,16 +1704,3 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> end. -%% --------------------------------------------------------------------- - -call(Msg, Pid) -> - call(Msg, Pid, infinity). - -call(Msg, Pid, Timeout) -> - gen_server:call(Pid, Msg, Timeout). - -cast(Msg, Pid) -> - gen_server:cast(Pid, Msg). - -t() -> - http_util:timestamp(). diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index b2d0ce7631..8aea38037d 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -88,7 +88,8 @@ real_requests()-> stream_through_mfa, streaming_error, inet_opts, - invalid_headers + invalid_headers, + invalid_body ]. only_simulated() -> @@ -126,7 +127,8 @@ only_simulated() -> redirect_temporary_redirect, port_in_host_header, redirect_port_in_host_header, - relaxed + relaxed, + multipart_chunks ]. misc() -> @@ -1001,10 +1003,25 @@ invalid_headers(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), [{"cookie", undefined}]}, {error, _} = httpc:request(get, Request, [], []). +%%------------------------------------------------------------------------- + +invalid_body(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + try + httpc:request(post, {URL, [], <<"text/plain">>, "foobar"}, + [], []), + ct:fail(accepted_invalid_input) + catch + error:function_clause -> + ok + end. + +%%------------------------------------------------------------------------- remote_socket_close(Config) when is_list(Config) -> URL = url(group_name(Config), "/just_close.html", Config), {error, socket_closed_remotely} = httpc:request(URL). + %%------------------------------------------------------------------------- remote_socket_close_async(Config) when is_list(Config) -> @@ -1111,6 +1128,13 @@ redirect_port_in_host_header(Config) when is_list(Config) -> inets_test_lib:check_body(Body). %%------------------------------------------------------------------------- +multipart_chunks(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/multipart_chunks.html", Config), []}, + {ok, Ref} = httpc:request(get, Request, [], [{sync, false}, {stream, self}]), + ok = receive_stream_n(Ref, 10), + httpc:cancel_request(Ref). + +%%------------------------------------------------------------------------- timeout_memory_leak() -> [{doc, "Check OTP-8739"}]. timeout_memory_leak(Config) when is_list(Config) -> @@ -1405,7 +1429,7 @@ dummy_server(Caller, SocketType, Inet, Extra) -> end. dummy_server_init(Caller, ip_comm, Inet, _) -> - BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}], {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, @@ -1981,6 +2005,16 @@ handle_uri(_,"/missing_CR.html",_,_,_,_) -> "Content-Length:32\r\n\n" ++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/multipart_chunks.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Date: " ++ httpd_util:rfc1123_date() ++ "\r\n" + "Connection: Keep-Alive\r\n" ++ + "Content-Type: multipart/x-mixed-replace; boundary=chunk_boundary\r\n" ++ + "\r\n", + send(Socket, Head), + send_multipart_chunks(Socket), + http_chunk:encode_last(); handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; @@ -2277,3 +2311,21 @@ otp_8739_dummy_server_main(_Parent, ListenSocket) -> Error -> exit(Error) end. + +send_multipart_chunks(Socket) -> + send(Socket, http_chunk:encode("--chunk_boundary\r\n")), + send(Socket, http_chunk:encode("Content-Type: text/plain\r\nContent-Length: 4\r\n\r\n")), + send(Socket, http_chunk:encode("test\r\n")), + ct:sleep(500), + send_multipart_chunks(Socket). + +receive_stream_n(_, 0) -> + ok; +receive_stream_n(Ref, N) -> + receive + {http, {Ref, stream_start, _}} -> + receive_stream_n(Ref, N); + {http, {Ref,stream, Data}} -> + ct:pal("Data: ~p", [Data]), + receive_stream_n(Ref, N-1) + end. diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 59a046bf4d..5b5b71e521 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -37,10 +37,7 @@ the <c>heart</c> port program is to check that the Erlang runtime system it is supervising is still running. If the port program has not received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds - (defaults to 60 seconds), the system can be rebooted. Also, if - the system is equipped with a hardware watchdog timer and is - running Solaris, the watchdog can be used to supervise the entire - system.</p> + (defaults to 60 seconds), the system can be rebooted.</p> <p>An Erlang runtime system to be monitored by a heart program is to be started with command-line flag <c>-heart</c> (see also <seealso marker="erts:erl"><c>erl(1)</c></seealso>). @@ -51,17 +48,13 @@ or a terminated Erlang runtime system, environment variable <c>HEART_COMMAND</c> must be set before the system is started. If this variable is not set, a warning text is printed but - the system does not reboot. However, if the hardware watchdog is - used, it still triggers a reboot <c>HEART_BEAT_BOOT_DELAY</c> - seconds later (defaults to 60 seconds).</p> + the system does not reboot.</p> <p>To reboot on Windows, <c>HEART_COMMAND</c> can be set to <c>heart -shutdown</c> (included in the Erlang delivery) or to any other suitable program that can activate a reboot.</p> - <p>The hardware watchdog is not started under Solaris if - environment variable <c>HW_WD_DISABLE</c> is set.</p> - <p>The environment variables <c>HEART_BEAT_TIMEOUT</c> and - <c>HEART_BEAT_BOOT_DELAY</c> can be used to configure the heart - time-outs; they can be set in the operating system shell before Erlang + <p>The environment variable <c>HEART_BEAT_TIMEOUT</c> + can be used to configure the heart + time-outs; it can be set in the operating system shell before Erlang is started or be specified at the command line:</p> <pre> % <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre> diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index eea78aabdf..8fa48d56fb 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -198,16 +198,11 @@ start_portprogram() -> end. get_heart_timeouts() -> - HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of - false -> ""; - H when is_list(H) -> - "-ht " ++ H - end, - HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of - false -> ""; - W when is_list(W) -> - " -wt " ++ W - end. + case os:getenv("HEART_BEAT_TIMEOUT") of + false -> ""; + H when is_list(H) -> + "-ht " ++ H + end. check_start_heart() -> case init:get_argument(heart) of diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 2f9f81104a..13e73f027d 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -928,7 +928,10 @@ general_info(File) -> WholeLine -> WholeLine end, - GI = get_general_info(Fd,#general_info{created=Created}), + {Slogan,SysVsn} = get_slogan_and_sysvsn(Fd,[]), + GI = get_general_info(Fd,#general_info{created=Created, + slogan=Slogan, + system_vsn=SysVsn}), {MemTot,MemMax} = case lookup_index(?memory) of @@ -982,12 +985,20 @@ general_info(File) -> mem_max=MemMax, instr_info=InstrInfo}. +get_slogan_and_sysvsn(Fd,Acc) -> + case val(Fd,eof) of + "Slogan: " ++ SloganPart when Acc==[] -> + get_slogan_and_sysvsn(Fd,[SloganPart]); + "System version: " ++ SystemVsn -> + {lists:append(lists:reverse(Acc)),SystemVsn}; + eof -> + {lists:append(lists:reverse(Acc)),"-1"}; + SloganPart -> + get_slogan_and_sysvsn(Fd,[[$\n|SloganPart]|Acc]) + end. + get_general_info(Fd,GenInfo) -> case line_head(Fd) of - "Slogan" -> - get_general_info(Fd,GenInfo#general_info{slogan=val(Fd)}); - "System version" -> - get_general_info(Fd,GenInfo#general_info{system_vsn=val(Fd)}); "Compiled" -> get_general_info(Fd,GenInfo#general_info{compile_time=val(Fd)}); "Taints" -> diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl index fcb900960b..925f4456bb 100644 --- a/lib/observer/src/etop.erl +++ b/lib/observer/src/etop.erl @@ -23,7 +23,7 @@ -export([start/0, start/1, config/2, stop/0, dump/1, help/0]). %% Internal -export([update/1]). --export([loadinfo/1, meminfo/2, getopt/2]). +-export([loadinfo/2, meminfo/2, getopt/2]). -include("etop.hrl"). -include("etop_defs.hrl"). @@ -319,18 +319,18 @@ output(graphical) -> exit({deprecated, "Use observer instead"}); output(text) -> etop_txt. -loadinfo(SysI) -> +loadinfo(SysI,Prev) -> #etop_info{n_procs = Procs, run_queue = RQ, now = Now, wall_clock = WC, runtime = RT} = SysI, - Cpu = calculate_cpu_utilization(WC,RT), + Cpu = calculate_cpu_utilization(WC,RT,Prev#etop_info.runtime), Clock = io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", tuple_to_list(element(2,calendar:now_to_datetime(Now)))), {Cpu,Procs,RQ,Clock}. -calculate_cpu_utilization({_,WC},{_,RT}) -> +calculate_cpu_utilization({_,WC},{_,RT},_) -> %% Old version of observer_backend, using statistics(wall_clock) %% and statistics(runtime) case {WC,RT} of @@ -341,15 +341,23 @@ calculate_cpu_utilization({_,WC},{_,RT}) -> _ -> round(100*RT/WC) end; -calculate_cpu_utilization(_,undefined) -> +calculate_cpu_utilization(_,undefined,_) -> %% First time collecting - no cpu utilization has been measured %% since scheduler_wall_time flag is not yet on 0; -calculate_cpu_utilization(_,RTInfo) -> +calculate_cpu_utilization(WC,RTInfo,undefined) -> + %% Second time collecting - RTInfo shows scheduler_wall_time since + %% flag was set to true. Faking previous values by setting + %% everything to zero. + ZeroRT = [{Id,0,0} || {Id,_,_} <- RTInfo], + calculate_cpu_utilization(WC,RTInfo,ZeroRT); +calculate_cpu_utilization(_,RTInfo,PrevRTInfo) -> %% New version of observer_backend, using statistics(scheduler_wall_time) - Sum = lists:foldl(fun({_,A,T},{AAcc,TAcc}) -> {A+AAcc,T+TAcc} end, + Sum = lists:foldl(fun({{_, A0, T0}, {_, A1, T1}},{AAcc,TAcc}) -> + {(A1 - A0)+AAcc,(T1 - T0)+TAcc} + end, {0,0}, - RTInfo), + lists:zip(PrevRTInfo,RTInfo)), case Sum of {0,0} -> 0; diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl index 3b4c176478..6b8f9df24f 100644 --- a/lib/observer/src/etop_txt.erl +++ b/lib/observer/src/etop_txt.erl @@ -22,35 +22,35 @@ %%-compile(export_all). -export([init/1,stop/1]). --export([do_update/3]). +-export([do_update/4]). -include("etop.hrl"). -include("etop_defs.hrl"). --import(etop,[loadinfo/1,meminfo/2]). +-import(etop,[loadinfo/2,meminfo/2]). -define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n"). stop(Pid) -> Pid ! stop. init(Config) -> - loop(Config). + loop(#etop_info{},Config). -loop(Config) -> - Info = do_update(Config), +loop(Prev,Config) -> + Info = do_update(Prev,Config), receive stop -> stopped; - {dump,Fd} -> do_update(Fd,Info,Config), loop(Config); - {config,_,Config1} -> loop(Config1) - after Config#opts.intv -> loop(Config) + {dump,Fd} -> do_update(Fd,Info,Prev,Config), loop(Info,Config); + {config,_,Config1} -> loop(Info,Config1) + after Config#opts.intv -> loop(Info,Config) end. -do_update(Config) -> +do_update(Prev,Config) -> Info = etop:update(Config), - do_update(standard_io,Info,Config). + do_update(standard_io,Info,Prev,Config). -do_update(Fd,Info,Config) -> - {Cpu,NProcs,RQ,Clock} = loadinfo(Info), +do_update(Fd,Info,Prev,Config) -> + {Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev), io:nl(Fd), writedoubleline(Fd), case Info#etop_info.memi of diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 59a2f9f205..1eaba31a3a 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -461,14 +461,16 @@ create_box(Parent, Data) -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - case length(Value) > 100 of - true -> - Shown = lists:sublist(Value, 80), + case string:sub_word(lists:sublist(Value, 80),1,$\n) of + Value -> + %% Short string, no newlines - show all + wxStaticText:new(Panel, ?wxID_ANY, Value); + Shown -> + %% Long or with newlines, + %% use tooltip to show all TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]), wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), - TCtrl; - false -> - wxStaticText:new(Panel, ?wxID_ANY, Value) + TCtrl end end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ee6829b847..f07b9e295a 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -511,7 +511,13 @@ table_holder(#holder{info=Info, attrs=Attrs, table_holder(S0); {dump, Fd} -> EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - etop_txt:do_update(Fd, EtopInfo, #opts{node=Node}), + %% The empty #etop_info{} below is a dummy previous info + %% value. It is used by etop to calculate the scheduler + %% utilization since last update. When dumping to file, + %% there is no previous measurement to use, so we just add + %% a dummy here, and the value shown will be since the + %% tool was started. + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), file:close(Fd), table_holder(S0); stop -> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 05c09f8996..3d6238d998 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1029,19 +1029,16 @@ do_pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, Revo end. sort_dp_crls(DpsAndCrls, FreshCB) -> - Sorted = do_sort_dp_crls(DpsAndCrls, dict:new()), - sort_crls(Sorted, FreshCB, []). - -do_sort_dp_crls([], Dict) -> - dict:to_list(Dict); -do_sort_dp_crls([{DP, CRL} | Rest], Dict0) -> - Dict = try dict:fetch(DP, Dict0) of - _ -> - dict:append(DP, CRL, Dict0) - catch _:_ -> - dict:store(DP, [CRL], Dict0) - end, - do_sort_dp_crls(Rest, Dict). + sort_crls(maps:to_list(lists:foldl(fun group_dp_crls/2, + #{}, + DpsAndCrls)), + FreshCB, []). + +group_dp_crls({DP,CRL}, M) -> + case M of + #{DP := CRLs} -> M#{DP := [CRL|CRLs]}; + _ -> M#{DP => [CRL]} + end. sort_crls([], _, Acc) -> Acc; diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index e943fb4a3e..b27bc63d15 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -314,13 +314,12 @@ etop_collect(Collector) -> case SchedulerWallTime of undefined -> - spawn(fun() -> flag_holder_proc(Collector) end), + erlang:system_flag(scheduler_wall_time,true), + spawn(fun() -> flag_holder_proc(Collector) end), ok; _ -> ok - end, - - erlang:system_flag(scheduler_wall_time,true). + end. flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), diff --git a/lib/sasl/test/release_handler_SUITE_data/start b/lib/sasl/test/release_handler_SUITE_data/start index 87275045b1..eab2b77aed 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start +++ b/lib/sasl/test/release_handler_SUITE_data/start @@ -21,8 +21,7 @@ then fi HEART_COMMAND=$ROOTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/sasl/test/release_handler_SUITE_data/start_client b/lib/sasl/test/release_handler_SUITE_data/start_client index 5ea94d6f7c..05d744f06e 100755 --- a/lib/sasl/test/release_handler_SUITE_data/start_client +++ b/lib/sasl/test/release_handler_SUITE_data/start_client @@ -24,8 +24,7 @@ RELDIR=$CLIENTDIR/releases # Note that this scripts is modified an copied to $CLIENTDIR/bin/start # in release_handler_SUITE:copy_client - therefore HEART_COMMAND is as follows: HEART_COMMAND=$CLIENTDIR/bin/start -HW_WD_DISABLE=true -export HW_WD_DISABLE HEART_COMMAND +export HEART_COMMAND START_ERL_DATA=${1:-$RELDIR/start_erl.data} diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index afc2fb88ff..b937f0412d 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -37,7 +37,7 @@ -export([open/3, open_tar/3, opendir/2, close/2, readdir/2, pread/4, read/3, open/4, open_tar/4, opendir/3, close/3, readdir/3, pread/5, read/4, apread/4, aread/3, pwrite/4, write/3, apwrite/4, awrite/3, - pwrite/5, write/4, + pwrite/5, write/4, position/3, real_path/2, read_file_info/2, get_file_info/2, position/4, real_path/3, read_file_info/3, get_file_info/3, write_file_info/3, read_link_info/2, read_link/2, make_symlink/3, @@ -52,7 +52,7 @@ %% TODO: Should be placed elsewhere ssh_sftpd should not call functions in ssh_sftp! -export([info_to_attr/1, attr_to_info/1]). --record(state, +-record(state, { xf, rep_buf = <<>>, @@ -64,7 +64,7 @@ -record(fileinf, { - handle, + handle, offset, size, mode @@ -81,7 +81,7 @@ enc_text_buf = <<>>, % Encrypted text plain_text_buf = <<>> % Decrypted text }). - + -define(FILEOP_TIMEOUT, infinity). -define(NEXT_REQID(S), @@ -98,7 +98,7 @@ start_channel(Cm) when is_pid(Cm) -> start_channel(Socket) when is_port(Socket) -> start_channel(Socket, []); start_channel(Host) when is_list(Host) -> - start_channel(Host, []). + start_channel(Host, []). start_channel(Socket, Options) when is_port(Socket) -> Timeout = @@ -110,7 +110,7 @@ start_channel(Socket, Options) when is_port(Socket) -> TO end, case ssh:connect(Socket, Options, Timeout) of - {ok,Cm} -> + {ok,Cm} -> case start_channel(Cm, Options) of {ok, Pid} -> {ok, Pid, Cm}; @@ -124,13 +124,13 @@ start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), case ssh_xfer:attach(Cm, [], ChanOpts) of - {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, + {ok, ChannelId, Cm} -> + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> - {ok, Pid}; + {ok, Pid}; TimeOut -> TimeOut end; @@ -150,7 +150,7 @@ start_channel(Host, Port, Opts) -> Timeout = proplists:get_value(timeout, SftpOpts, infinity), case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of @@ -165,7 +165,7 @@ start_channel(Host, Port, Opts) -> {error, ignore} end; Error -> - Error + Error end. stop_channel(Pid) -> @@ -174,12 +174,12 @@ stop_channel(Pid) -> OldValue = process_flag(trap_exit, true), link(Pid), exit(Pid, ssh_sftp_stop_channel), - receive + receive {'EXIT', Pid, normal} -> ok after 5000 -> exit(Pid, kill), - receive + receive {'EXIT', Pid, killed} -> ok end @@ -209,9 +209,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, write, fun(write, {_,Data}) -> write_to_remote_tar(Pid, Handle, to_bin(Data), FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {true,false,[{crypto,{CryptoInitFun,CryptoEncryptFun,CryptoEndFun}}]} -> @@ -245,9 +245,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_repeat(Pid, Handle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position(Pid, Handle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> close(Pid, Handle, FileOpTimeout) end); {false,true,[{crypto,{CryptoInitFun,CryptoDecryptFun}}]} -> @@ -258,9 +258,9 @@ open_tar(Pid, File, Mode, FileOpTimeout) -> erl_tar:init(Pid, read, fun(read2, {_,Len}) -> read_buf(Pid, SftpHandle, BufHandle, Len, FileOpTimeout); - (position, {_,Pos}) -> + (position, {_,Pos}) -> position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout); - (close, _) -> + (close, _) -> call(Pid, {erase_bufinf,BufHandle}, FileOpTimeout), close(Pid, SftpHandle, FileOpTimeout) end); @@ -292,7 +292,7 @@ pread(Pid, Handle, Offset, Len, FileOpTimeout) -> read(Pid, Handle, Len) -> read(Pid, Handle, Len, ?FILEOP_TIMEOUT). read(Pid, Handle, Len, FileOpTimeout) -> - call(Pid, {read,false,Handle, Len}, FileOpTimeout). + call(Pid, {read,false,Handle, Len}, FileOpTimeout). %% TODO this ought to be a cast! Is so in all practial meaning %% even if it is obscure! @@ -301,7 +301,7 @@ apread(Pid, Handle, Offset, Len) -> %% TODO this ought to be a cast! aread(Pid, Handle, Len) -> - call(Pid, {read,true,Handle, Len}, infinity). + call(Pid, {read,true,Handle, Len}, infinity). pwrite(Pid, Handle, Offset, Data) -> pwrite(Pid, Handle, Offset, Data, ?FILEOP_TIMEOUT). @@ -367,7 +367,7 @@ make_symlink(Pid, Name, Target) -> make_symlink(Pid, Name, Target, ?FILEOP_TIMEOUT). make_symlink(Pid, Name, Target, FileOpTimeout) -> call(Pid, {make_symlink,false, Name, Target}, FileOpTimeout). - + rename(Pid, FromFile, ToFile) -> rename(Pid, FromFile, ToFile, ?FILEOP_TIMEOUT). rename(Pid, FromFile, ToFile, FileOpTimeout) -> @@ -411,8 +411,8 @@ list_dir(Pid, Name, FileOpTimeout) -> close(Pid, Handle, FileOpTimeout), case Res of {ok, List} -> - NList = lists:foldl(fun({Nm, _Info},Acc) -> - [Nm|Acc] end, + NList = lists:foldl(fun({Nm, _Info},Acc) -> + [Nm|Acc] end, [], List), {ok,NList}; Error -> Error @@ -482,7 +482,7 @@ write_file_loop(Pid, Handle, Pos, Bin, Remain, PacketSz, FileOpTimeout) -> <<_:Pos/binary, Data:PacketSz/binary, _/binary>> = Bin, case write(Pid, Handle, Data, FileOpTimeout) of ok -> - write_file_loop(Pid, Handle, + write_file_loop(Pid, Handle, Pos+PacketSz, Bin, Remain-PacketSz, PacketSz, FileOpTimeout); Error -> @@ -510,7 +510,7 @@ init([Cm, ChannelId, Options]) -> Xf = #ssh_xfer{cm = Cm, channel = ChannelId}, {ok, #state{xf = Xf, - req_id = 0, + req_id = 0, rep_buf = <<>>, inf = new_inf(), opts = Options}}; @@ -519,7 +519,7 @@ init([Cm, ChannelId, Options]) -> Error -> {stop, {shutdown, Error}} end. - + %%-------------------------------------------------------------------- %% Function: handle_call/3 %% Description: Handling call messages @@ -541,7 +541,7 @@ handle_call({{timeout, Timeout}, wait_for_version_negotiation}, From, handle_call({_, wait_for_version_negotiation}, _, State) -> {reply, ok, State}; - + handle_call({{timeout, infinity}, Msg}, From, State) -> do_handle_call(Msg, From, State); handle_call({{timeout, Timeout}, Msg}, From, #state{req_id = Id} = State) -> @@ -555,13 +555,13 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. do_handle_call({get_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, dict:find(BufHandle,I0), S}; + {reply, maps:find(BufHandle,I0), S}; do_handle_call({put_bufinf,BufHandle,B}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:store(BufHandle,B,I0)}}; + {reply, ok, S#state{inf=maps:put(BufHandle,B,I0)}}; do_handle_call({erase_bufinf,BufHandle}, _From, S=#state{inf=I0}) -> - {reply, ok, S#state{inf=dict:erase(BufHandle,I0)}}; + {reply, ok, S#state{inf=maps:remove(BufHandle,I0)}}; do_handle_call({open, Async,FileName,Mode}, From, #state{xf = XF} = State) -> {Access,Flags,Attrs} = open_mode(XF#ssh_xfer.vsn, Mode), @@ -636,7 +636,7 @@ do_handle_call({pread,Async,Handle,At,Length}, From, State) -> binary -> {{ok,Data}, State2}; text -> {{ok,binary_to_list(Data)}, State2} end; - (Rep, State2) -> + (Rep, State2) -> {Rep, State2} end); Error -> @@ -777,7 +777,7 @@ do_handle_call(recv_window, _From, State) -> do_handle_call(stop, _From, State) -> {stop, shutdown, ok, State}; -do_handle_call(Call, _From, State) -> +do_handle_call(Call, _From, State) -> {reply, {error, bad_call, Call, State}, State}. %%-------------------------------------------------------------------- @@ -785,13 +785,13 @@ do_handle_call(Call, _From, State) -> %% %% Description: Handles channel messages %%-------------------------------------------------------------------- -handle_ssh_msg({ssh_cm, _ConnectionManager, - {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = +handle_ssh_msg({ssh_cm, _ConnectionManager, + {data, _ChannelId, 0, Data}}, #state{rep_buf = Data0} = State0) -> State = handle_reply(State0, <<Data0/binary,Data/binary>>), {ok, State}; -handle_ssh_msg({ssh_cm, _ConnectionManager, +handle_ssh_msg({ssh_cm, _ConnectionManager, {data, _ChannelId, 1, Data}}, State) -> error_logger:format("ssh: STDERR: ~s\n", [binary_to_list(Data)]), {ok, State}; @@ -803,7 +803,7 @@ handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> %% Ignore signals according to RFC 4254 section 6.9. {ok, State}; -handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, Error, _}}, State0) -> State = reply_all(State0, {error, Error}), {stop, ChannelId, State}; @@ -823,7 +823,7 @@ handle_msg({ssh_channel_up, _, _}, #state{opts = Options, xf = Xf} = State) -> {ok, State}; %% Version negotiation timed out -handle_msg({timeout, undefined, From}, +handle_msg({timeout, undefined, From}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> ssh_channel:reply(From, {error, timeout}), {stop, ChannelId, State}; @@ -839,12 +839,12 @@ handle_msg({timeout, Id, From}, #state{req_list = ReqList0} = State) -> end; %% Connection manager goes down -handle_msg({'DOWN', _Ref, _Type, _Process, _}, +handle_msg({'DOWN', _Ref, _Type, _Process, _}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; - + %% Stopped by user -handle_msg({'EXIT', _, ssh_sftp_stop_channel}, +handle_msg({'EXIT', _, ssh_sftp_stop_channel}, #state{xf = #ssh_xfer{channel = ChannelId}} = State) -> {stop, ChannelId, State}; @@ -883,10 +883,10 @@ call(Pid, Msg, TimeOut) -> handle_reply(State, <<?UINT32(Len),Reply:Len/binary,Rest/binary>>) -> do_handle_reply(State, Reply, Rest); -handle_reply(State, Data) -> +handle_reply(State, Data) -> State#state{rep_buf = Data}. -do_handle_reply(#state{xf = Xf} = State, +do_handle_reply(#state{xf = Xf} = State, <<?SSH_FXP_VERSION, ?UINT32(Version), BinExt/binary>>, Rest) -> Ext = ssh_xfer:decode_ext(BinExt), case Xf#ssh_xfer.vsn of @@ -899,7 +899,7 @@ do_handle_reply(#state{xf = Xf} = State, ok end, ssh_channel:reply(From, ok) - end, + end, State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest}; do_handle_reply(State0, Data, Rest) -> @@ -919,9 +919,9 @@ handle_req_reply(State0, {_, ReqID, _} = XfReply) -> List = lists:keydelete(ReqID, 1, State0#state.req_list), State1 = State0#state { req_list = List }, case catch Fun(xreply(XfReply),State1) of - {'EXIT', _} -> + {'EXIT', _} -> State1; - State -> + State -> State end end. @@ -998,15 +998,15 @@ reply_all(State, Reply) -> make_reply(ReqID, true, From, State) -> {reply, {async, ReqID}, update_request_info(ReqID, State, - fun(Reply,State1) -> + fun(Reply,State1) -> async_reply(ReqID,Reply,From,State1) end)}; make_reply(ReqID, false, From, State) -> {noreply, update_request_info(ReqID, State, - fun(Reply,State1) -> - sync_reply(Reply, From, State1) + fun(Reply,State1) -> + sync_reply(Reply, From, State1) end)}. make_reply_post(ReqID, true, From, State, PostFun) -> @@ -1074,13 +1074,13 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> unix_to_datetime(undefined) -> undefined; unix_to_datetime(UTCSecs) -> - UTCDateTime = + UTCDateTime = calendar:gregorian_seconds_to_datetime(UTCSecs + 62167219200), erlang:universaltime_to_localtime(UTCDateTime). datetime_to_unix(undefined) -> undefined; -datetime_to_unix(LocalDateTime) -> +datetime_to_unix(LocalDateTime) -> UTCDateTime = erlang:localtime_to_universaltime(LocalDateTime), calendar:datetime_to_gregorian_seconds(UTCDateTime) - 62167219200. @@ -1128,11 +1128,11 @@ open_mode3(Modes) -> end, {[], Fl, A}. -%% accessors for inf dict -new_inf() -> dict:new(). +%% accessors for inf map +new_inf() -> #{}. add_new_handle(Handle, FileMode, Inf) -> - dict:store(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). + maps:put(Handle, #fileinf{offset=0, size=0, mode=FileMode}, Inf). update_size(Handle, NewSize, State) -> OldSize = get_size(Handle, State), @@ -1152,27 +1152,24 @@ update_offset(Handle, NewOffset, State0) -> %% access size and offset for handle put_size(Handle, Size, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{size=Size}, Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{size=Size}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Size,offset=0}, - Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Size,offset=0}, Inf0)} end. put_offset(Handle, Offset, State) -> Inf0 = State#state.inf, - case dict:find(Handle, Inf0) of + case maps:find(Handle, Inf0) of {ok, FI} -> - State#state{inf=dict:store(Handle, FI#fileinf{offset=Offset}, - Inf0)}; + State#state{inf=maps:put(Handle, FI#fileinf{offset=Offset}, Inf0)}; _ -> - State#state{inf=dict:store(Handle, #fileinf{size=Offset, - offset=Offset}, Inf0)} + State#state{inf=maps:put(Handle, #fileinf{size=Offset, offset=Offset}, Inf0)} end. get_size(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.size; _ -> @@ -1180,11 +1177,11 @@ get_size(Handle, State) -> end. %% get_offset(Handle, State) -> -%% {ok, FI} = dict:find(Handle, State#state.inf), +%% {ok, FI} = maps:find(Handle, State#state.inf), %% FI#fileinf.offset. get_mode(Handle, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, FI} -> FI#fileinf.mode; _ -> @@ -1192,14 +1189,14 @@ get_mode(Handle, State) -> end. erase_handle(Handle, State) -> - FI = dict:erase(Handle, State#state.inf), + FI = maps:remove(Handle, State#state.inf), State#state{inf = FI}. %% %% Caluclate a integer offset %% lseek_position(Handle, Pos, State) -> - case dict:find(Handle, State#state.inf) of + case maps:find(Handle, State#state.inf) of {ok, #fileinf{offset=O, size=S}} -> lseek_pos(Pos, O, S); _ -> @@ -1229,7 +1226,7 @@ lseek_pos({cur, Offset}, CurOffset, _CurSize) true -> {ok, NewOffset} end; -lseek_pos({eof, Offset}, _CurOffset, CurSize) +lseek_pos({eof, Offset}, _CurOffset, CurSize) when is_integer(Offset) andalso -(?SSH_FILEXFER_LARGEFILESIZE) =< Offset andalso Offset < ?SSH_FILEXFER_LARGEFILESIZE -> NewOffset = CurSize + Offset, @@ -1239,7 +1236,7 @@ lseek_pos({eof, Offset}, _CurOffset, CurSize) {ok, NewOffset} end; lseek_pos(_, _, _) -> - {error, einval}. + {error, einval}. %%%================================================================ %%% @@ -1277,13 +1274,13 @@ position_buf(Pid, SftpHandle, BufHandle, Pos, FileOpTimeout) -> case Pos of {cur,0} when Mode==write -> {ok,Size+size(Buf0)}; - + {cur,0} when Mode==read -> {ok,Size}; - + _ when Mode==read, is_integer(Pos) -> Skip = Pos-Size, - if + if Skip < 0 -> {error, cannot_rewind}; Skip == 0 -> @@ -1318,7 +1315,7 @@ read_buf(Pid, SftpHandle, BufHandle, WantedLen, FileOpTimeout) -> eof end. -do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, +do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, B=#bufinf{plain_text_buf=PlainBuf0, size = Size}) when size(PlainBuf0) >= WantedLen -> @@ -1327,7 +1324,7 @@ do_the_read_buf(_Pid, _SftpHandle, WantedLen, _Packet, _FileOpTimeout, {ok,ResultBin,B#bufinf{plain_text_buf=PlainBuf, size = Size + WantedLen}}; -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = undefined @@ -1335,12 +1332,12 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, when size(EncBuf0) > 0 -> %% We have (at least) one decodable byte waiting for decodeing. {ok,DecodedBin,B} = apply_crypto(EncBuf0, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = <<>> }); - -do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + +do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B0=#bufinf{plain_text_buf = PlainBuf0, enc_text_buf = EncBuf0, chunksize = ChunkSize0 @@ -1349,11 +1346,11 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, %% We have (at least) one chunk of decodable bytes waiting for decodeing. <<ToDecode:ChunkSize0/binary, EncBuf/binary>> = EncBuf0, {ok,DecodedBin,B} = apply_crypto(ToDecode, B0), - do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B#bufinf{plain_text_buf = <<PlainBuf0/binary, DecodedBin/binary>>, enc_text_buf = EncBuf }); - + do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0}) -> %% We must read more bytes and append to the buffer of encoded bytes. case read(Pid, SftpHandle, Packet, FileOpTimeout) of @@ -1370,7 +1367,7 @@ do_the_read_buf(Pid, SftpHandle, WantedLen, Packet, FileOpTimeout, B=#bufinf{enc write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {ok,{_Window,Packet}} = send_window(Pid, FileOpTimeout), {ok,B0=#bufinf{plain_text_buf=PTB}} = call(Pid, {get_bufinf,BufHandle}, FileOpTimeout), - case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, + case do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B0#bufinf{plain_text_buf = <<PTB/binary,PlainBin/binary>>}) of {ok, B} -> call(Pid, {put_bufinf,BufHandle,B}, FileOpTimeout), @@ -1379,7 +1376,7 @@ write_buf(Pid, SftpHandle, BufHandle, PlainBin, FileOpTimeout) -> {error,Error} end. -do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, +do_the_write_buf(Pid, SftpHandle, Packet, FileOpTimeout, B=#bufinf{enc_text_buf = EncBuf0, size = Size}) when size(EncBuf0) >= Packet -> @@ -1421,9 +1418,9 @@ do_the_write_buf(_Pid, _SftpHandle, _Packet, _FileOpTimeout, B) -> apply_crypto(In, B=#bufinf{crypto_state = CState0, crypto_fun = F}) -> case F(In,CState0) of - {ok,EncodedBin,CState} -> + {ok,EncodedBin,CState} -> {ok, EncodedBin, B#bufinf{crypto_state=CState}}; - {ok,EncodedBin,CState,ChunkSize} -> + {ok,EncodedBin,CState,ChunkSize} -> {ok, EncodedBin, B#bufinf{crypto_state=CState, chunksize=ChunkSize}} end. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6e7c8c5ddd..6ed2fc83da 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -864,11 +864,11 @@ handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when i %% When downgrading an TLS connection to a transport connection %% we must recive the close alert from the peer before releasing the %% transport socket. - {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; + {next_state, downgrade, State#state{terminated = true}, [{timeout, Timeout, downgrade}]}; handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option - Result = Connection:terminate(Close, StateName, State), + %% inet-option works properly + Result = Connection:terminate(Close, StateName, State#state{terminated = true}), {stop_and_reply, {shutdown, normal}, {reply, From, Result}, State}; handle_call({shutdown, How0}, From, _, @@ -1010,7 +1010,10 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called - %% when ssl:close/1 returns. + %% when ssl:close/1 returns unless it is a downgrade where + %% we want to guarantee that close alert is recived before + %% returning. In both cases terminate has been run manually + %% before run by gen_statem which will end up here ok; terminate({shutdown, transport_closed} = Reason, diff --git a/lib/stdlib/doc/src/dict.xml b/lib/stdlib/doc/src/dict.xml index c926ff1b5b..c229a18721 100644 --- a/lib/stdlib/doc/src/dict.xml +++ b/lib/stdlib/doc/src/dict.xml @@ -106,6 +106,16 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and a + new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 790d4b8bf1..5cfff021c1 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -109,6 +109,28 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Assumes that the node with key is present in the tree, + crashes otherwise.</p> + </desc> + </func> + + <func> + <name name="take_any" arity="2"/> + <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary> + <desc> + <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c> + and new <c><anno>Tree2</anno></c> without the node with this value. + Returns <c>error</c> if the node with the key is not present in + the tree.</p> + </desc> + </func> + + <func> <name name="empty" arity="0"/> <fsummary>Return an empty tree.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index c24542002a..42e952fd46 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -350,13 +350,18 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start() -> Result</name> - <name>start(EventMgrName) -> Result</name> + <name>start(EventMgrName | Options) -> Result</name> + <name>start(EventMgrName, Options) -> Result</name> <fsummary>Create a stand-alone event manager process.</fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> @@ -371,14 +376,19 @@ gen_event:stop -----> Module:terminate/2 <func> <name>start_link() -> Result</name> - <name>start_link(EventMgrName) -> Result</name> + <name>start_link(EventMgrName | Options) -> Result</name> + <name>start_link(EventMgrName, Options) -> Result</name> <fsummary>Create a generic event manager process in a supervision tree. </fsummary> <type> - <v>EventMgrName = {local,Name} | {global,GlobalName} - | {via,Module,ViaName}</v> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> <v>Result = {ok,Pid} | {error,{already_started,Pid}}</v> <v> Pid = pid()</v> </type> diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index 109b038cb5..26bbf499c6 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -113,6 +113,15 @@ </func> <func> + <name name="take" arity="2"/> + <fsummary>Return value and new dictionary without element with this value.</fsummary> + <desc> + <p>This function returns value from dictionary and new dictionary without this value. + Returns <c>error</c> if the key is not present in the dictionary.</p> + </desc> + </func> + + <func> <name name="filter" arity="2"/> <fsummary>Select elements that satisfy a predicate.</fsummary> <desc> diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index f921e28ef6..9449ba3dc2 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -38,7 +38,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -172,6 +172,27 @@ erase_key(Key, [E|Bkt0]) -> {[E|Bkt1],Dc}; erase_key(_, []) -> {[],0}. +-spec take(Key, Dict) -> {Value, Dict1} | error when + Dict :: dict(Key, Value), + Dict1 :: dict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, D0) -> + Slot = get_slot(D0, Key), + case on_bucket(fun (B0) -> take_key(Key, B0) end, D0, Slot) of + {D1,{Value,Dc}} -> + {Value, maybe_contract(D1, Dc)}; + {_,error} -> error + end. + +take_key(Key, [?kv(Key,Val)|Bkt]) -> + {Bkt,{Val,1}}; +take_key(Key, [E|Bkt0]) -> + {Bkt1,Res} = take_key(Key, Bkt0), + {[E|Bkt1],Res}; +take_key(_, []) -> {[],error}. + -spec store(Key, Value, Dict1) -> Dict2 when Dict1 :: dict(Key, Value), Dict2 :: dict(Key, Value). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 40a34aa30f..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1306,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 9cd95705af..fb5d05ec8e 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -156,6 +156,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. +type -> char : '$1'. type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 457287fa52..c0cdde012e 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -52,6 +52,13 @@ %% - delete_any(X, T): removes key X from tree T if the key is present %% in the tree, otherwise does nothing; returns new tree. %% +%% - take(X, T): removes element with key X from tree T; returns new tree +%% without removed element. Assumes that the key is present in the tree. +%% +%% - take_any(X, T): removes element with key X from tree T and returns +%% a new tree if the key is present; otherwise does nothing and returns +%% 'error'. +%% %% - balance(T): rebalances tree T. Note that this is rarely necessary, %% but may be motivated when a large number of entries have been %% deleted from the tree without further insertions. Rebalancing could @@ -114,7 +121,8 @@ -export([empty/0, is_empty/1, size/1, lookup/2, get/2, insert/3, update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, - smallest/1, largest/1, take_smallest/1, take_largest/1, + smallest/1, largest/1, take/2, take_any/2, + take_smallest/1, take_largest/1, iterator/1, iterator_from/2, next/1, map/2]). @@ -416,6 +424,41 @@ merge(Smaller, Larger) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec take_any(Key, Tree1) -> {Value, Tree2} | 'error' when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take_any(Key, Tree) -> + case is_defined(Key, Tree) of + true -> take(Key, Tree); + false -> error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-spec take(Key, Tree1) -> {Value, Tree2} when + Tree1 :: tree(Key, _), + Tree2 :: tree(Key, _), + Key :: term(), + Value :: term(). + +take(Key, {S, T}) when is_integer(S), S >= 0 -> + {Value, Res} = take_1(Key, T), + {Value, {S - 1, Res}}. + +take_1(Key, {Key1, Value, Smaller, Larger}) when Key < Key1 -> + {Value2, Smaller1} = take_1(Key, Smaller), + {Value2, {Key1, Value, Smaller1, Larger}}; +take_1(Key, {Key1, Value, Smaller, Bigger}) when Key > Key1 -> + {Value2, Bigger1} = take_1(Key, Bigger), + {Value2, {Key1, Value, Smaller, Bigger1}}; +take_1(_, {_Key, Value, Smaller, Larger}) -> + {Value, merge(Smaller, Larger)}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + -spec take_smallest(Tree1) -> {Key, Value, Tree2} when Tree1 :: tree(Key, Value), Tree2 :: tree(Key, Value). diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index ccacf658e9..4839fe4f2c 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -32,7 +32,9 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, +-export([start/0, start/1, start/2, + start_link/0, start_link/1, start_link/2, + stop/1, stop/3, notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -117,30 +119,64 @@ -type del_handler_ret() :: ok | term() | {'EXIT',term()}. -type emgr_name() :: {'local', atom()} | {'global', atom()} - | {'via', atom(), term()}. + | {'via', atom(), term()}. +-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}. +-type option() :: {'timeout', timeout()} + | {'debug', [debug_flag()]} + | {'spawn_opt', [proc_lib:spawn_option()]}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} - | {'via', atom(), term()} | pid(). + | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. %%--------------------------------------------------------------------------- -define(NO_CALLBACK, 'no callback module'). +%% ----------------------------------------------------------------- +%% Starts a generic event handler. +%% start() +%% start(MgrName | Options) +%% start(MgrName, Options) +%% start_link() +%% start_link(MgrName | Options) +%% start_link(MgrName, Options) +%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}] +%% Flag ::= trace | log | {logfile, File} | statistics | debug +%% (debug == log && statistics) +%% Returns: {ok, Pid} | +%% {error, {already_started, Pid}} | +%% {error, Reason} +%% ----------------------------------------------------------------- + -spec start() -> start_ret(). start() -> gen:start(?MODULE, nolink, ?NO_CALLBACK, [], []). --spec start(emgr_name()) -> start_ret(). -start(Name) -> - gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []). +-spec start(emgr_name() | [option()]) -> start_ret(). +start(Name) when is_tuple(Name) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []); +start(Options) when is_list(Options) -> + gen:start(?MODULE, nolink, ?NO_CALLBACK, [], Options). + +-spec start(emgr_name(), [option()]) -> start_ret(). +start(Name, Options) -> + gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], Options). -spec start_link() -> start_ret(). start_link() -> gen:start(?MODULE, link, ?NO_CALLBACK, [], []). --spec start_link(emgr_name()) -> start_ret(). -start_link(Name) -> - gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []). +-spec start_link(emgr_name() | [option()]) -> start_ret(). +start_link(Name) when is_tuple(Name) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []); +start_link(Options) when is_list(Options) -> + gen:start(?MODULE, link, ?NO_CALLBACK, [], Options). + +-spec start_link(emgr_name(), [option()]) -> start_ret(). +start_link(Name, Options) -> + gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options). %% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) -> init_it(Starter, self, Name, Mod, Args, Options) -> @@ -160,7 +196,7 @@ add_sup_handler(M, Handler, Args) -> rpc(M, {add_sup_handler, Handler, Args, self()}). -spec notify(emgr_ref(), term()) -> 'ok'. -notify(M, Event) -> send(M, {notify, Event}). +notify(M, Event) -> send(M, {notify, Event}). -spec sync_notify(emgr_ref(), term()) -> 'ok'. sync_notify(M, Event) -> rpc(M, {sync_notify, Event}). @@ -193,7 +229,7 @@ stop(M) -> stop(M, Reason, Timeout) -> gen:stop(M, Reason, Timeout). -rpc(M, Cmd) -> +rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), Reply. @@ -421,7 +457,7 @@ server_add_handler({Mod,Id}, Args, MSL) -> Handler = #handler{module = Mod, id = Id}, server_add_handler(Mod, Handler, Args, MSL); -server_add_handler(Mod, Args, MSL) -> +server_add_handler(Mod, Args, MSL) -> Handler = #handler{module = Mod}, server_add_handler(Mod, Handler, Args, MSL). @@ -446,7 +482,7 @@ server_add_sup_handler({Mod,Id}, Args, MSL, Parent) -> id = Id, supervised = Parent}, server_add_handler(Mod, Handler, Args, MSL); -server_add_sup_handler(Mod, Args, MSL, Parent) -> +server_add_sup_handler(Mod, Args, MSL, Parent) -> link(Parent), Handler = #handler{module = Mod, supervised = Parent}, @@ -454,7 +490,7 @@ server_add_sup_handler(Mod, Args, MSL, Parent) -> %% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'} -server_delete_handler(HandlerId, Args, MSL, SName) -> +server_delete_handler(HandlerId, Args, MSL, SName) -> case split(HandlerId, MSL) of {Mod, Handler, MSL1} -> {do_terminate(Mod, Handler, Args, @@ -511,7 +547,7 @@ split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) -> %% server_notify(Event, Func, MSL, SName) -> MSL' -server_notify(Event, Func, [Handler|T], SName) -> +server_notify(Event, Func, [Handler|T], SName) -> case server_update(Handler, Func, Event, SName) of {ok, Handler1} -> {Hib, NewHandlers} = server_notify(Event, Func, T, SName), @@ -531,9 +567,9 @@ server_update(Handler1, Func, Event, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:Func(Event, State) of - {ok, State1} -> + {ok, State1} -> {ok, Handler1#handler{state = State1}}; - {ok, State1, hibernate} -> + {ok, State1, hibernate} -> {hibernate, Handler1#handler{state = State1}}; {swap_handler, Args1, State1, Handler2, Args2} -> do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName); @@ -644,14 +680,14 @@ server_call_update(Handler1, Query, SName) -> Mod1 = Handler1#handler.module, State = Handler1#handler.state, case catch Mod1:handle_call(Query, State) of - {ok, Reply, State1} -> + {ok, Reply, State1} -> {{ok, Handler1#handler{state = State1}}, Reply}; - {ok, Reply, State1, hibernate} -> - {{hibernate, Handler1#handler{state = State1}}, + {ok, Reply, State1, hibernate} -> + {{hibernate, Handler1#handler{state = State1}}, Reply}; {swap_handler, Reply, Args1, State1, Handler2, Args2} -> {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply}; - {remove_handler, Reply} -> + {remove_handler, Reply} -> do_terminate(Mod1, Handler1, remove_handler, State, remove, SName, normal), {no, Reply}; @@ -686,7 +722,7 @@ report_error(_Handler, normal, _, _, _) -> ok; report_error(_Handler, shutdown, _, _, _) -> ok; report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> - Reason1 = + Reason1 = case Reason of {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index 37cf0084f0..caa59099af 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -22,7 +22,7 @@ %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]). --export([fetch/2,find/2,fetch_keys/1,erase/2]). +-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). @@ -106,6 +106,23 @@ erase(Key, [{K,_}=E|Dict]) when Key > K -> erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K erase(_, []) -> []. +-spec take(Key, Orddict) -> {Value, Orddict1} | error when + Orddict :: orddict(Key, Value), + Orddict1 :: orddict(Key, Value), + Key :: term(), + Value :: term(). + +take(Key, Dict) -> + take_1(Key, Dict, []). + +take_1(Key, [{K,_}|_], _Acc) when Key < K -> + error; +take_1(Key, [{K,_}=P|D], Acc) when Key > K -> + take_1(Key, D, [P|Acc]); +take_1(_Key, [{_K,Value}|D], Acc) -> + {Value,lists:reverse(Acc, D)}; +take_1(_, [], _) -> error. + -spec store(Key, Value, Orddict1) -> Orddict2 when Orddict1 :: orddict(Key, Value), Orddict2 :: orddict(Key, Value). diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl index 47358d729f..e99af9ad42 100644 --- a/lib/stdlib/test/dict_SUITE.erl +++ b/lib/stdlib/test/dict_SUITE.erl @@ -23,10 +23,10 @@ -module(dict_SUITE). --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, init_per_testcase/2,end_per_testcase/2, - create/1,store/1,iterate/1]). + create/1,store/1,iterate/1,remove/1]). -include_lib("common_test/include/ct.hrl"). @@ -37,7 +37,7 @@ suite() -> {timetrap,{minutes,5}}]. all() -> - [create, store, iterate]. + [create, store, remove, iterate]. groups() -> []. @@ -92,6 +92,27 @@ store_1(List, M) -> end, D0. +remove(_Config) -> + test_all([{0,87}], fun remove_1/2). + +remove_1(List0, M) -> + %% Make sure that keys are unique. Randomize key order. + List1 = orddict:from_list(List0), + List2 = lists:sort([{rand:uniform(),E} || E <- List1]), + List = [E || {_,E} <- List2], + D0 = M(from_list, List), + remove_2(List, D0, M). + +remove_2([{Key,Val}|T], D0, M) -> + {Val,D1} = M(take, {Key,D0}), + error = M(take, {Key,D1}), + D2 = M(erase, {Key,D0}), + true = M(equal, {D1,D2}), + remove_2(T, D1, M); +remove_2([], D, M) -> + true = M(is_empty, D), + D. + %%% %%% Test specifics for gb_trees. %%% diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl index 7c4c3572ae..f6fef7bdf4 100644 --- a/lib/stdlib/test/dict_test_lib.erl +++ b/lib/stdlib/test/dict_test_lib.erl @@ -33,7 +33,9 @@ new(Mod, Eq) -> (iterator, S) -> Mod:iterator(S); (iterator_from, {Start, S}) -> Mod:iterator_from(Start, S); (next, I) -> Mod:next(I); - (to_list, D) -> to_list(Mod, D) + (to_list, D) -> to_list(Mod, D); + (erase, {K,D}) -> erase(Mod, K, D); + (take, {K,D}) -> take(Mod, K, D) end. empty(Mod) -> @@ -67,3 +69,19 @@ enter(Mod, Key, Val, Dict) -> true -> Mod:store(Key, Val, Dict) end. + +erase(Mod, Key, Val) when Mod =:= dict; Mod =:= orddict -> + Mod:erase(Key, Val); +erase(gb_trees, Key, Val) -> + gb_trees:delete_any(Key, Val). + +take(gb_trees, Key, Val) -> + Res = try + gb_trees:take(Key, Val) + catch + error:_ -> + error + end, + Res = gb_trees:take_any(Key, Val); +take(Mod, Key, Val) -> + Mod:take(Key, Val). diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 4415c2d09d..9a7400c84e 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -21,22 +21,24 @@ -include_lib("common_test/include/ct.hrl"). --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]). -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, call_format_status/1, call_format_status_anon/1, - error_format_status/1, get_state/1, replace_state/1]). + error_format_status/1, get_state/1, replace_state/1, + start_opt/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [start, {group, test_all}, hibernate, call_format_status, call_format_status_anon, error_format_status, - get_state, replace_state]. + get_state, replace_state, + start_opt]. -groups() -> +groups() -> [{test_all, [], [add_handler, add_sup_handler, delete_handler, swap_handler, swap_sup_handler, notify, sync_notify, @@ -59,6 +61,9 @@ end_per_group(_GroupName, Config) -> %% Start an event manager. %% -------------------------------------- +-define(LMGR, {local, my_dummy_name}). +-define(GMGR, {global, my_dummy_name}). + start(Config) when is_list(Config) -> OldFl = process_flag(trap_exit, true), @@ -72,40 +77,36 @@ start(Config) when is_list(Config) -> [] = gen_event:which_handlers(Pid1), ok = gen_event:stop(Pid1), - {ok, Pid2} = gen_event:start({local, my_dummy_name}), + {ok, Pid2} = gen_event:start(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid2), ok = gen_event:stop(my_dummy_name), - {ok, Pid3} = gen_event:start_link({local, my_dummy_name}), + {ok, Pid3} = gen_event:start_link(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid3), ok = gen_event:stop(my_dummy_name), - {ok, Pid4} = gen_event:start_link({global, my_dummy_name}), - [] = gen_event:which_handlers({global, my_dummy_name}), + {ok, Pid4} = gen_event:start_link(?GMGR), + [] = gen_event:which_handlers(?GMGR), [] = gen_event:which_handlers(Pid4), - ok = gen_event:stop({global, my_dummy_name}), + ok = gen_event:stop(?GMGR), {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers(Pid5), ok = gen_event:stop({via, dummy_via, my_dummy_name}), - {ok, _} = gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({local, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({local, my_dummy_name}), + {ok, _} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start_link(?LMGR), + {error, {already_started, _}} = gen_event:start(?LMGR), ok = gen_event:stop(my_dummy_name), - {ok, Pid6} = gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({global, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({global, my_dummy_name}), + {ok, Pid6} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start(?GMGR), - ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000), + ok = gen_event:stop(?GMGR, shutdown, 10000), receive {'EXIT', Pid6, shutdown} -> ok after 10000 -> @@ -113,10 +114,8 @@ start(Config) when is_list(Config) -> end, {ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start_link({via, dummy_via, my_dummy_name}), - {error, {already_started, _}} = - gen_event:start({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}), exit(Pid7, shutdown), receive @@ -128,6 +127,83 @@ start(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +start_opt(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + dummy_via:reset(), + + {ok, Pid0} = gen_event:start([]), %anonymous + [] = gen_event:which_handlers(Pid0), + ok = gen_event:stop(Pid0), + + {ok, Pid1} = gen_event:start_link([]), %anonymous + [] = gen_event:which_handlers(Pid1), + ok = gen_event:stop(Pid1), + + {ok, Pid2} = gen_event:start(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid2), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid3} = gen_event:start_link(?LMGR, []), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid3), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid4} = gen_event:start_link(?GMGR, []), + [] = gen_event:which_handlers(?GMGR), + [] = gen_event:which_handlers(Pid4), + ok = gen_event:stop(?GMGR), + + {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), + [] = gen_event:which_handlers(Pid5), + ok = gen_event:stop({via, dummy_via, my_dummy_name}), + + {ok, _} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + {ok, Pid7} = gen_event:start_link(?GMGR), + {error, {already_started, _}} = gen_event:start_link(?GMGR, []), + {error, {already_started, _}} = gen_event:start(?GMGR, []), + + ok = gen_event:stop(?GMGR, shutdown, 10000), + receive + {'EXIT', Pid7, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + {ok, Pid8} = gen_event:start_link({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}, []), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}, []), + + exit(Pid8, shutdown), + receive + {'EXIT', Pid8, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + + %% test spawn_opt + MinHeapSz = 10000, + {ok, Pid9} = gen_event:start_link(?LMGR, [{spawn_opt, [{min_heap_size, MinHeapSz}]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + {heap_size, HeapSz} = erlang:process_info(Pid9, heap_size), + true = HeapSz > MinHeapSz, + ok = gen_event:stop(my_dummy_name), + + %% test debug opt + {ok, _} = gen_event:start_link(?LMGR, [{debug,[debug]}]), + {error, {already_started, _}} = gen_event:start_link(?LMGR, []), + {error, {already_started, _}} = gen_event:start(?LMGR, []), + ok = gen_event:stop(my_dummy_name), + + process_flag(trap_exit, OldFl), + ok. hibernate(Config) when is_list(Config) -> {ok,Pid} = gen_event:start({local, my_dummy_handler}), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 56d81eb1f2..15ccdea284 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2326,7 +2326,7 @@ otp_6554(Config) when is_list(Config) -> "[unproper | list]).">>), %% Cheating: "exception error: no function clause matching " - "erl_eval:do_apply(4)" ++ _ = + "shell:apply_fun(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), "exception error: no function clause matching " "lists:reverse(" ++ _ = diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml index eee2648f34..e1760d0ded 100644 --- a/system/doc/efficiency_guide/advanced.xml +++ b/system/doc/efficiency_guide/advanced.xml @@ -87,15 +87,15 @@ </row> <row> <cell>Small Map</cell> - <cell>4 words + 2 words per entry (key and value) + the size of each key and value pair.</cell> + <cell>5 words + the size of all keys and values.</cell> </row> <row> - <cell>Large Map</cell> + <cell>Large Map (> 32 keys)</cell> <cell> - At least, 2 words + 2 x <c>N</c> words + 2 x log16(<c>N</c>) words + - the size of each key and value pair, where <c>N</c> is the number of pairs in the Map. - A large Map is represented as a tree internally where each node in the tree is a - "sparse tuple" of arity 16. + <c>N</c> x <c>F</c> words + the size of all keys and values.<br></br> + <c>N</c> is the number of keys in the Map.<br></br> + <c>F</c> is a sparsity factor that can vary between 1.6 and 1.8 + due to the probabilistic nature of the internal HAMT data structure. </cell> </row> <row> diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 0295d18644..91fd9a7cd9 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -32,12 +32,9 @@ <file>binaryhandling.xml</file> </header> - <p>In R12B, the most natural way to construct and match binaries is - significantly faster than in earlier releases.</p> + <p>Binaries can be efficiently built in the following way:</p> - <p>To construct a binary, you can simply write as follows:</p> - - <p><em>DO</em> (in R12B) / <em>REALLY DO NOT</em> (in earlier releases)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_list_to_binary(List) -> my_list_to_binary(List, <<>>). @@ -47,21 +44,13 @@ my_list_to_binary([H|T], Acc) -> my_list_to_binary([], Acc) -> Acc.]]></code> - <p>In releases before R12B, <c>Acc</c> is copied in every iteration. - In R12B, <c>Acc</c> is copied only in the first iteration and extra - space is allocated at the end of the copied binary. In the next iteration, - <c>H</c> is written into the extra space. When the extra space runs out, - the binary is reallocated with more extra space. The extra space allocated - (or reallocated) is twice the size of the - existing binary data, or 256, whichever is larger.</p> - - <p>The most natural way to match binaries is now the fastest:</p> + <p>Binaries can be efficiently matched like this:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; -my_binary_to_list(<<>>) -> [].]]></code> +my_binary_to_list(<<>>) -> [].]]></code> <section> <title>How Binaries are Implemented</title> @@ -138,10 +127,7 @@ my_binary_to_list(<<>>) -> [].]]></code> pointer to the binary data. For each field that is matched out of a binary, the position in the match context is incremented.</p> - <p>In R11B, a match context was only used during a binary matching - operation.</p> - - <p>In R12B, the compiler tries to avoid generating code that + <p>The compiler tries to avoid generating code that creates a sub binary, only to shortly afterwards create a new match context and discard the sub binary. Instead of creating a sub binary, the match context is kept.</p> @@ -155,7 +141,7 @@ my_binary_to_list(<<>>) -> [].]]></code> <section> <title>Constructing Binaries</title> - <p>In R12B, appending to a binary or bitstring + <p>Appending to a binary or bitstring is specially optimized by the <em>runtime system</em>:</p> <code type="erl"><![CDATA[ @@ -292,7 +278,7 @@ Bin = <<Bin1,...>> %% Bin1 will be COPIED <p>Let us revisit the example in the beginning of the previous section:</p> - <p><em>DO</em> (in R12B)</p> + <p><em>DO</em></p> <code type="erl"><![CDATA[ my_binary_to_list(<<H,T/binary>>) -> [H|my_binary_to_list(T)]; @@ -304,15 +290,14 @@ my_binary_to_list(<<>>) -> [].]]></code> byte of the binary. 1 byte is matched out and the match context is updated to point to the second byte in the binary.</p> - <p>In R11B, at this point a - <seealso marker="#sub_binary">sub binary</seealso> - would be created. In R12B, - the compiler sees that there is no point in creating a sub binary, - because there will soon be a call to a function (in this case, + <p>At this point it would make sense to create a + <seealso marker="#sub_binary">sub binary</seealso>, + but in this particular example the compiler sees that + there will soon be a call to a function (in this case, to <c>my_binary_to_list/1</c> itself) that immediately will create a new match context and discard the sub binary.</p> - <p>Therefore, in R12B, <c>my_binary_to_list/1</c> calls itself + <p>Therefore <c>my_binary_to_list/1</c> calls itself with the match context instead of with a sub binary. The instruction that initializes the matching operation basically does nothing when it sees that it was passed a match context instead of a binary.</p> @@ -321,34 +306,10 @@ my_binary_to_list(<<>>) -> [].]]></code> the match context will simply be discarded (removed in the next garbage collection, as there is no longer any reference to it).</p> - <p>To summarize, <c>my_binary_to_list/1</c> in R12B only needs to create - <em>one</em> match context and no sub binaries. In R11B, if the binary - contains <em>N</em> bytes, <em>N+1</em> match contexts and <em>N</em> - sub binaries are created.</p> - - <p>In R11B, the fastest way to match binaries is as follows:</p> + <p>To summarize, <c>my_binary_to_list/1</c> only needs to create + <em>one</em> match context and no sub binaries.</p> - <p><em>DO NOT</em> (in R12B)</p> - <code type="erl"><![CDATA[ -my_complicated_binary_to_list(Bin) -> - my_complicated_binary_to_list(Bin, 0). - -my_complicated_binary_to_list(Bin, Skip) -> - case Bin of - <<_:Skip/binary,Byte,_/binary>> -> - [Byte|my_complicated_binary_to_list(Bin, Skip+1)]; - <<_:Skip/binary>> -> - [] - end.]]></code> - - <p>This function cleverly avoids building sub binaries, but it cannot - avoid building a match context in each recursion step. - Therefore, in both R11B and R12B, - <c>my_complicated_binary_to_list/1</c> builds <em>N+1</em> match - contexts. (In a future Erlang/OTP release, the compiler might be able - to generate code that reuses the match context.)</p> - - <p>Returning to <c>my_binary_to_list/1</c>, notice that the match context + <p>Notice that the match context in <c>my_binary_to_list/1</c> was discarded when the entire binary had been traversed. What happens if the iteration stops before it has reached the end of the binary? Will the optimization still work?</p> @@ -544,5 +505,15 @@ count3(<<>>, Count) -> Count.]]></code> not matched out.</p> </section> </section> + + <section> + <title>Historical Note</title> + + <p>Binary handling was significantly improved in R12B. Because + code that was efficient in R11B might not be efficient in R12B, + and vice versa, earlier revisions of this Efficiency Guide contained + some information about binary handling in R11B.</p> + </section> + </chapter> diff --git a/system/doc/efficiency_guide/commoncaveats.xml b/system/doc/efficiency_guide/commoncaveats.xml index ecfeff0349..94b1c0b222 100644 --- a/system/doc/efficiency_guide/commoncaveats.xml +++ b/system/doc/efficiency_guide/commoncaveats.xml @@ -148,10 +148,10 @@ multiple_setelement(T0) -> <p><c>size/1</c> returns the size for both tuples and binaries.</p> - <p>Using the new BIFs <c>tuple_size/1</c> and <c>byte_size/1</c>, introduced - in R12B, gives the compiler and the runtime system more opportunities for - optimization. Another advantage is that the new BIFs can help Dialyzer to - find more bugs in your program.</p> + <p>Using the BIFs <c>tuple_size/1</c> and <c>byte_size/1</c> + gives the compiler and the runtime system more opportunities for + optimization. Another advantage is that the BIFs give Dialyzer more + type information.</p> </section> <section> diff --git a/system/doc/efficiency_guide/functions.xml b/system/doc/efficiency_guide/functions.xml index 4a8248e65c..1d0f1f68b7 100644 --- a/system/doc/efficiency_guide/functions.xml +++ b/system/doc/efficiency_guide/functions.xml @@ -65,7 +65,7 @@ atom_map1(six) -> 6.</code> thus, quite efficient even if there are many values) to select which one of the first three clauses to execute (if any).</item> - <item>>If none of the first three clauses match, the fourth clause + <item>If none of the first three clauses match, the fourth clause match as a variable always matches.</item> <item>If the guard test <c>is_integer(Int)</c> succeeds, the fourth @@ -183,15 +183,6 @@ explicit_map_pairs(Map, Xs0, Ys0) -> A fun contains an (indirect) pointer to the function that implements the fun.</p> - <warning><p><em>Tuples are not fun(s)</em>. - A "tuple fun", <c>{Module,Function}</c>, is not a fun. - The cost for calling a "tuple fun" is similar to that - of <c>apply/3</c> or worse. - Using "tuple funs" is <em>strongly discouraged</em>, - as they might not be supported in a future Erlang/OTP release, - and because there exists a superior alternative from R10B, - namely the <c>fun Module:Function/Arity</c> syntax.</p></warning> - <p><c>apply/3</c> must look up the code for the function to execute in a hash table. It is therefore always slower than a direct call or a fun call.</p> diff --git a/system/doc/efficiency_guide/introduction.xml b/system/doc/efficiency_guide/introduction.xml index ca4a41c798..b650008ae8 100644 --- a/system/doc/efficiency_guide/introduction.xml +++ b/system/doc/efficiency_guide/introduction.xml @@ -46,14 +46,6 @@ to find out where the performance bottlenecks are and optimize only the bottlenecks. Let other code stay as clean as possible.</p> - <p>Fortunately, compiler and runtime optimizations introduced in - Erlang/OTP R12B makes it easier to write code that is both clean and - efficient. For example, the ugly workarounds needed in R11B and earlier - releases to get the most speed out of binary pattern matching are - no longer necessary. In fact, the ugly code is slower - than the clean code (because the clean code has become faster, not - because the uglier code has become slower).</p> - <p>This Efficiency Guide cannot really teach you how to write efficient code. It can give you a few pointers about what to avoid and what to use, and some understanding of how certain language features are implemented. diff --git a/system/doc/efficiency_guide/listhandling.xml b/system/doc/efficiency_guide/listhandling.xml index 2ebc877820..ec258d7c2a 100644 --- a/system/doc/efficiency_guide/listhandling.xml +++ b/system/doc/efficiency_guide/listhandling.xml @@ -90,7 +90,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> <p>Lists comprehensions still have a reputation for being slow. They used to be implemented using funs, which used to be slow.</p> - <p>In recent Erlang/OTP releases (including R12B), a list comprehension:</p> + <p>A list comprehension:</p> <code type="erl"><![CDATA[ [Expr(E) || E <- List]]]></code> @@ -102,7 +102,7 @@ tail_recursive_fib(N, Current, Next, Fibs) -> [Expr(E)|'lc^0'(Tail, Expr)]; 'lc^0'([], _Expr) -> [].</code> - <p>In R12B, if the result of the list comprehension will <em>obviously</em> + <p>If the result of the list comprehension will <em>obviously</em> not be used, a list will not be constructed. For example, in this code:</p> <code type="erl"><![CDATA[ @@ -131,6 +131,14 @@ some_function(...), 'lc^0'(Tail, Expr); 'lc^0'([], _Expr) -> [].</code> + <p>The compiler also understands that assigning to '_' means that + the value will not used. Therefore, the code in the following example + will also be optimized:</p> + + <code type="erl"><![CDATA[ +_ = [io:put_chars(E) || E <- List], +ok.]]></code> + </section> <section> @@ -209,11 +217,11 @@ some_function(...), <section> <title>Recursive List Functions</title> - <p>In Section 7.2, the following myth was exposed: + <p>In section about myths, the following myth was exposed: <seealso marker="myths#tail_recursive">Tail-Recursive Functions are Much Faster Than Recursive Functions</seealso>.</p> - <p>To summarize, in R12B there is usually not much difference between + <p>There is usually not much difference between a body-recursive list function and tail-recursive function that reverses the list at the end. Therefore, concentrate on writing beautiful code and forget about the performance of your list functions. In the diff --git a/system/doc/efficiency_guide/myths.xml b/system/doc/efficiency_guide/myths.xml index 5d3ad78b23..778cd06c09 100644 --- a/system/doc/efficiency_guide/myths.xml +++ b/system/doc/efficiency_guide/myths.xml @@ -24,7 +24,7 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>The Eight Myths of Erlang Performance</title> + <title>The Seven Myths of Erlang Performance</title> <prepared>Bjorn Gustavsson</prepared> <docno></docno> <date>2007-11-10</date> @@ -35,80 +35,33 @@ <marker id="myths"></marker> <p>Some truths seem to live on well beyond their best-before date, perhaps because "information" spreads faster from person-to-person - than a single release note that says, for example, that funs - have become faster.</p> + than a single release note that says, for example, that body-recursive + calls have become faster.</p> <p>This section tries to kill the old truths (or semi-truths) that have become myths.</p> <section> - <title>Myth: Funs are Slow</title> - <p>Funs used to be very slow, slower than <c>apply/3</c>. - Originally, funs were implemented using nothing more than - compiler trickery, ordinary tuples, <c>apply/3</c>, and a great - deal of ingenuity.</p> - - <p>But that is history. Funs was given its own data type - in R6B and was further optimized in R7B. - Now the cost for a fun call falls roughly between the cost for a call - to a local function and <c>apply/3</c>.</p> - </section> - - <section> - <title>Myth: List Comprehensions are Slow</title> - - <p>List comprehensions used to be implemented using funs, and in the - old days funs were indeed slow.</p> - - <p>Nowadays, the compiler rewrites list comprehensions into an ordinary - recursive function. Using a tail-recursive function with - a reverse at the end would be still faster. Or would it? - That leads us to the next myth.</p> - </section> - - <section> <title>Myth: Tail-Recursive Functions are Much Faster Than Recursive Functions</title> <p><marker id="tail_recursive"></marker>According to the myth, - recursive functions leave references - to dead terms on the stack and the garbage collector has to copy - all those dead terms, while tail-recursive functions immediately - discard those terms.</p> - - <p>That used to be true before R7B. In R7B, the compiler started - to generate code that overwrites references to terms that will never - be used with an empty list, so that the garbage collector would not - keep dead values any longer than necessary.</p> - - <p>Even after that optimization, a tail-recursive function is - still most of the times faster than a body-recursive function. Why?</p> - - <p>It has to do with how many words of stack that are used in each - recursive call. In most cases, a recursive function uses more words - on the stack for each recursion than the number of words a tail-recursive - would allocate on the heap. As more memory is used, the garbage - collector is invoked more frequently, and it has more work traversing - the stack.</p> - - <p>In R12B and later releases, there is an optimization that - in many cases reduces the number of words used on the stack in - body-recursive calls. A body-recursive list function and a - tail-recursive function that calls <seealso - marker="stdlib:lists#reverse/1">lists:reverse/1</seealso> at - the end will use the same amount of memory. - <c>lists:map/2</c>, <c>lists:filter/2</c>, list comprehensions, - and many other recursive functions now use the same amount of space - as their tail-recursive equivalents.</p> - - <p>So, which is faster? - It depends. On Solaris/Sparc, the body-recursive function seems to - be slightly faster, even for lists with a lot of elements. On the x86 - architecture, tail-recursion was up to about 30% faster.</p> - - <p>So, the choice is now mostly a matter of taste. If you really do need - the utmost speed, you must <em>measure</em>. You can no longer be - sure that the tail-recursive list function always is the fastest.</p> + using a tail-recursive function that builds a list in reverse + followed by a call to <c>lists:reverse/1</c> is faster than + a body-recursive function that builds the list in correct order; + the reason being that body-recursive functions use more memory than + tail-recursive functions.</p> + + <p>That was true to some extent before R12B. It was even more true + before R7B. Today, not so much. A body-recursive function + generally uses the same amount of memory as a tail-recursive + function. It is generally not possible to predict whether the + tail-recursive or the body-recursive version will be + faster. Therefore, use the version that makes your code cleaner + (hint: it is usually the body-recursive version).</p> + + <p>For a more thorough discussion about tail and body recursion, + see <url href="http://ferd.ca/erlang-s-tail-recursion-is-not-a-silver-bullet.html">Erlang's Tail Recursion is Not a Silver Bullet</url>.</p> <note><p>A tail-recursive function that does not need to reverse the list at the end is faster than a body-recursive function, @@ -199,6 +152,29 @@ vanilla_reverse([], Acc) -> <p>That was once true, but from R6B the BEAM compiler can see that a variable is not used.</p> + + <p>Similarly, trivial transformations on the source-code level + such as converting a <c>case</c> statement to clauses at the + top-level of the function seldom makes any difference to the + generated code.</p> + </section> + + <section> + <title>Myth: A NIF Always Speeds Up Your Program</title> + + <p>Rewriting Erlang code to a NIF to make it faster should be + seen as a last resort. It is only guaranteed to be dangerous, + but not guaranteed to speed up the program.</p> + + <p>Doing too much work in each NIF call will + <seealso marker="erts:erl_nif#WARNING">degrade responsiveness + of the VM</seealso>. Doing too little work may mean that + the gain of the faster processing in the NIF is eaten up by + the overhead of calling the NIF and checking the arguments.</p> + + <p>Be sure to read about + <seealso marker="erts:erl_nif#lengthy_work">Long-running NIFs</seealso> + before writing a NIF.</p> </section> </chapter> diff --git a/system/doc/efficiency_guide/part.xml b/system/doc/efficiency_guide/part.xml index 6e10a0c031..5673ddd320 100644 --- a/system/doc/efficiency_guide/part.xml +++ b/system/doc/efficiency_guide/part.xml @@ -39,5 +39,6 @@ <xi:include href="drivers.xml"/> <xi:include href="advanced.xml"/> <xi:include href="profiling.xml"/> + <xi:include href="retired_myths.xml"/> </part> diff --git a/system/doc/efficiency_guide/processes.xml b/system/doc/efficiency_guide/processes.xml index f2d9712f51..bc9daa6666 100644 --- a/system/doc/efficiency_guide/processes.xml +++ b/system/doc/efficiency_guide/processes.xml @@ -146,14 +146,14 @@ loop() -> <section> <title>Constant Pool</title> - <p>Constant Erlang terms (also called <em>literals</em>) are now + <p>Constant Erlang terms (also called <em>literals</em>) are kept in constant pools; each loaded module has its own pool. - The following function does no longer build the tuple every time + The following function does not build the tuple every time it is called (only to have it discarded the next time the garbage collector was run), but the tuple is located in the module's constant pool:</p> - <p><em>DO</em> (in R12B and later)</p> + <p><em>DO</em></p> <code type="erl"> days_in_month(M) -> element(M, {31,28,31,30,31,30,31,31,30,31,30,31}).</code> @@ -235,9 +235,7 @@ true return the same value. Sharing has been lost.</p> <p>In a future Erlang/OTP release, it might be implemented a - way to (optionally) preserve sharing. There are no plans to make - preserving of sharing the default behaviour, as that would - penalize the vast majority of Erlang applications.</p> + way to (optionally) preserve sharing.</p> </section> </section> diff --git a/system/doc/efficiency_guide/retired_myths.xml b/system/doc/efficiency_guide/retired_myths.xml new file mode 100644 index 0000000000..37f46566cd --- /dev/null +++ b/system/doc/efficiency_guide/retired_myths.xml @@ -0,0 +1,63 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2016</year> + <year>2016</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + <marker id="retired_myths"/> + <title>Retired Myths</title> + <prepared>Bjorn Gustavsson</prepared> + <docno></docno> + <date>2016-06-07</date> + <rev></rev> + <file>retired_myths.xml</file> + </header> + + <p>We belive that the truth finally has caught with the following, + retired myths.</p> + + <section> + <title>Myth: Funs are Slow</title> + <p>Funs used to be very slow, slower than <c>apply/3</c>. + Originally, funs were implemented using nothing more than + compiler trickery, ordinary tuples, <c>apply/3</c>, and a great + deal of ingenuity.</p> + + <p>But that is history. Funs was given its own data type + in R6B and was further optimized in R7B. + Now the cost for a fun call falls roughly between the cost for a call + to a local function and <c>apply/3</c>.</p> + </section> + + <section> + <title>Myth: List Comprehensions are Slow</title> + + <p>List comprehensions used to be implemented using funs, and in the + old days funs were indeed slow.</p> + + <p>Nowadays, the compiler rewrites list comprehensions into an ordinary + recursive function. Using a tail-recursive function with + a reverse at the end would be still faster. Or would it? + That leads us to the myth that tail-recursive functions are faster + than body-recursive functions.</p> + </section> +</chapter> diff --git a/system/doc/tutorial/c_portdriver.xmlsrc b/system/doc/tutorial/c_portdriver.xmlsrc index 933e2395a3..da680642b6 100644 --- a/system/doc/tutorial/c_portdriver.xmlsrc +++ b/system/doc/tutorial/c_portdriver.xmlsrc @@ -161,8 +161,8 @@ decode([Int]) -> Int.</pre> <title>Running the Example</title> <p><em>Step 1.</em> Compile the C code:</p> <pre> -unix> <input>gcc -o exampledrv -fpic -shared complex.c port_driver.c</input> -windows> <input>cl -LD -MD -Fe exampledrv.dll complex.c port_driver.c</input></pre> +unix> <input>gcc -o example_drv.so -fpic -shared complex.c port_driver.c</input> +windows> <input>cl -LD -MD -Fe example_drv.dll complex.c port_driver.c</input></pre> <p><em>Step 2.</em> Start Erlang and compile the Erlang code:</p> <pre> > <input>erl</input> |