diff --git a/erts/emulator/beam/beam_common.c b/erts/emulator/beam/beam_common.c index bc25fb280c9c..be305fb65828 100644 --- a/erts/emulator/beam/beam_common.c +++ b/erts/emulator/beam/beam_common.c @@ -1612,54 +1612,19 @@ fixed_apply(Process* p, Eterm* reg, Uint arity, return ep; } -int -erts_hibernate(Process* c_p, Eterm* reg) -{ - int arity; - Eterm tmp; - Eterm module = reg[0]; - Eterm function = reg[1]; - Eterm args = reg[2]; - - if (is_not_atom(module) || is_not_atom(function)) { - /* - * No need to test args here -- done below. - */ - error: - c_p->freason = BADARG; - - error2: - reg[0] = module; - reg[1] = function; - reg[2] = args; - return 0; - } +void erts_hibernate(Process *c_p, Eterm *regs, int arity) { + const Uint max_default_arg_reg = + sizeof(c_p->def_arg_reg) / sizeof(c_p->def_arg_reg[0]); - arity = 0; - tmp = args; - while (is_list(tmp)) { - if (arity < MAX_REG) { - tmp = CDR(list_val(tmp)); - arity++; - } else { - c_p->freason = SYSTEM_LIMIT; - goto error2; - } - } - if (is_not_nil(tmp)) { /* Must be well-formed list */ - goto error; + /* Save some memory if possible. */ + if (arity <= max_default_arg_reg && c_p->arg_reg != c_p->def_arg_reg) { + erts_free(ERTS_ALC_T_ARG_REG, c_p->arg_reg); + c_p->max_arg_reg = max_default_arg_reg; + c_p->arg_reg = c_p->def_arg_reg; } - /* - * At this point, arguments are known to be good. - */ - - if (c_p->arg_reg != c_p->def_arg_reg) { - /* Save some memory */ - erts_free(ERTS_ALC_T_ARG_REG, c_p->arg_reg); - c_p->arg_reg = c_p->def_arg_reg; - c_p->max_arg_reg = sizeof(c_p->def_arg_reg)/sizeof(c_p->def_arg_reg[0]); - } + sys_memcpy(c_p->arg_reg, regs, arity * sizeof(Eterm)); + c_p->arity = arity; #ifdef USE_VM_PROBES if (DTRACE_ENABLED(process_hibernate)) { @@ -1670,30 +1635,6 @@ erts_hibernate(Process* c_p, Eterm* reg) DTRACE2(process_hibernate, process_name, mfa_buf); } #endif - /* - * Arrange for the process to be resumed at the given MFA with - * the stack cleared. - */ - c_p->arity = 3; - c_p->arg_reg[0] = module; - c_p->arg_reg[1] = function; - c_p->arg_reg[2] = args; - c_p->stop = c_p->hend - CP_SIZE; /* Keep first continuation pointer */ - - switch(erts_frame_layout) { - case ERTS_FRAME_LAYOUT_RA: - ASSERT(c_p->stop[0] == make_cp(beam_normal_exit)); - break; - case ERTS_FRAME_LAYOUT_FP_RA: - FRAME_POINTER(c_p) = &c_p->stop[0]; - ASSERT(c_p->stop[0] == make_cp(NULL)); - ASSERT(c_p->stop[1] == make_cp(beam_normal_exit)); - break; - } - - c_p->catches = 0; - c_p->return_trace_frames = 0; - c_p->i = beam_run_process; /* * If there are no waiting messages, garbage collect and @@ -1712,10 +1653,9 @@ erts_hibernate(Process* c_p, Eterm* reg) erts_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); } + erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); - c_p->current = &BIF_TRAP_EXPORT(BIF_hibernate_3)->info.mfa; c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */ - return 1; } ErtsCodePtr diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5709df04b2eb..74356f5d6074 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -54,6 +54,7 @@ #include "jit/beam_asm.h" #include "erl_global_literals.h" #include "beam_load.h" +#include "beam_common.h" Export *erts_await_result; static Export await_exit_trap; @@ -1189,26 +1190,56 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) BIF_RETTYPE hibernate_3(BIF_ALIST_3) { - /* - * hibernate/3 is usually translated to an instruction; therefore - * this function is only called when the call could not be translated. - */ - Eterm reg[3]; + Eterm module = BIF_ARG_1, function = BIF_ARG_2, args = BIF_ARG_3; + Uint arity = 0; + + /* Check for obvious errors as a courtesy to the user; while apply/3 will + * fail later on if there's anything wrong with the arguments (e.g. the + * callee does not exist), we have more helpful context now than after + * discarding the stack. */ + if (is_not_atom(module) || is_not_atom(function)) { + BIF_ERROR(BIF_P, BADARG); + } - reg[0] = BIF_ARG_1; - reg[1] = BIF_ARG_2; - reg[2] = BIF_ARG_3; + while (is_list(args) && arity <= MAX_ARG) { + args = CDR(list_val(args)); + arity++; + } - if (erts_hibernate(BIF_P, reg)) { - /* - * If hibernate succeeded, TRAP. The process will be wait in a - * hibernated state if its state is inactive (!ERTS_PSFLG_ACTIVE); - * otherwise, continue executing (if any message was in the queue). - */ - BIF_TRAP_CODE_PTR(BIF_P, BIF_P->i, 3); + if (is_not_nil(args)) { + if (arity > MAX_ARG) { + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + + BIF_ERROR(BIF_P, BADARG); } - return THE_NON_VALUE; + /* Discard our execution state and prepare to resume with apply/3 after + * waking up from hibernation. + * + * Note that BIF_P->current has already been set to hibernate/3 as this is + * a heavy BIF. */ + BIF_P->stop = BIF_P->hend - CP_SIZE; + BIF_P->return_trace_frames = 0; + BIF_P->catches = 0; + + switch(erts_frame_layout) { + case ERTS_FRAME_LAYOUT_RA: + ASSERT(BIF_P->stop[0] == make_cp(beam_normal_exit)); + break; + case ERTS_FRAME_LAYOUT_FP_RA: + FRAME_POINTER(BIF_P) = &BIF_P->stop[0]; + ASSERT(BIF_P->stop[0] == make_cp(NULL)); + ASSERT(BIF_P->stop[1] == make_cp(beam_normal_exit)); + break; + } + + /* Normally, the X register array is filled when trapping out. We do NOT do + * this here as there is special magic involved when trapping out after + * hibernation; `erts_hibernate` populates the process' argument registers + * and then the BIF epilogue jumps straight into do_schedule. */ + erts_hibernate(BIF_P, BIF__ARGS, 3); + BIF_TRAP_CODE_PTR(BIF_P, beam_run_process, 3); } /**********************************************************************/ diff --git a/erts/emulator/beam/emu/ops.tab b/erts/emulator/beam/emu/ops.tab index 0a5606d82948..b0f5cea82acc 100644 --- a/erts/emulator/beam/emu/ops.tab +++ b/erts/emulator/beam/emu/ops.tab @@ -877,12 +877,13 @@ call_ext u==0 u$func:erlang:yield/0 => i_yield call_ext_last u==0 u$func:erlang:yield/0 D => i_yield | deallocate_return D call_ext_only u==0 u$func:erlang:yield/0 => i_yield | return + +# The hibernate/0 BIF is an instruction # -# The hibernate/3 BIF is an instruction. -# -call_ext u==3 u$func:erlang:hibernate/3 => i_hibernate -call_ext_last u==3 u$func:erlang:hibernate/3 _D => i_hibernate -call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate + +call_ext u==0 u$func:erlang:hibernate/0 => i_hibernate +call_ext_last u==0 u$func:erlang:hibernate/0 D => i_hibernate | deallocate_return D +call_ext_only u==0 u$func:erlang:hibernate/0 => i_hibernate | return call_ext u==0 u$func:os:perf_counter/0 => i_perf_counter diff --git a/erts/emulator/beam/emu/trace_instrs.tab b/erts/emulator/beam/emu/trace_instrs.tab index 4f109bde602f..3a4b21898e0c 100644 --- a/erts/emulator/beam/emu/trace_instrs.tab +++ b/erts/emulator/beam/emu/trace_instrs.tab @@ -120,16 +120,15 @@ i_yield() { i_hibernate() { HEAVY_SWAPOUT; - if (erts_hibernate(c_p, reg)) { - FCALLS = c_p->fcalls; - c_p->flags &= ~F_HIBERNATE_SCHED; - goto do_schedule; - } else { - HEAVY_SWAPIN; - I = handle_error(c_p, I, reg, &BIF_TRAP_EXPORT(BIF_hibernate_3)->info.mfa); - goto post_error_handling; - } - //| -no_next + + erts_hibernate(c_p, reg, 0); + + c_p->arg_reg[0] = am_ok; + c_p->arity = 1; + + $SET_CP_I_ABS($NEXT_INSTRUCTION); + c_p->current = NULL; + goto do_schedule; } // This is optimised as an instruction because diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 20585d75f78a..b464efaa721d 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -968,22 +968,18 @@ erts_garbage_collect(Process* p, Uint need, Eterm* objv, int nobj) static int garbage_collect_hibernate(Process* p, int check_long_gc) { - Uint heap_size; - Eterm* heap; - Eterm* htop; - Uint actual_size; - char* area; + Eterm *collection_heap, *collection_htop, *final_heap; + Uint final_size, heap_size, stack_size; + Sint stack_offset, heap_offset; + char *area; Uint area_sz; - Sint offs; - int reds; - if (p->flags & F_DISABLE_GC) - ERTS_INTERNAL_ERROR("GC disabled"); + ERTS_ASSERT(!(p->flags & F_DISABLE_GC)); if (p->sig_qs.flags & FS_ON_HEAP_MSGQ) { erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ); erts_proc_sig_fetch(p); - erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); + erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); } if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) { @@ -1004,131 +1000,85 @@ garbage_collect_hibernate(Process* p, int check_long_gc) p->flags = flags; } - /* - * Preliminaries. - */ erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); ErtsGcQuickSanityCheck(p); - /* Only allow one continuation pointer. */ - ASSERT(p->stop == p->hend - CP_SIZE); - - switch (erts_frame_layout) { - case ERTS_FRAME_LAYOUT_RA: - ASSERT(p->stop[0] == make_cp(beam_normal_exit)); - break; - case ERTS_FRAME_LAYOUT_FP_RA: - ASSERT(p->stop[0] == make_cp(NULL)); - ASSERT(p->stop[1] == make_cp(beam_normal_exit)); - ASSERT(FRAME_POINTER(p) == &p->stop[0]); - break; - } - - /* - * Do it. - */ heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; - - /* Reserve place for continuation pointer and redzone */ - heap_size += S_RESERVED; - - heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, - sizeof(Eterm)*heap_size); - htop = heap; - - htop = full_sweep_heaps(p, - ERTS_INVALID_HFRAG_PTR, - 1, - heap, - htop, - (char *) p->old_heap, - (char *) p->old_htop - (char *) p->old_heap, - p->arg_reg, - p->arity); + stack_size = STACK_START(p) - STACK_TOP(p); + + /* Allocate a new heap and move all living terms to it. Note that this + * temporary heap does not need to include space for the stack. */ + collection_heap = (Eterm*)ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, + heap_size * sizeof(Eterm)); + collection_htop = full_sweep_heaps(p, + ERTS_INVALID_HFRAG_PTR, + 1, + collection_heap, + collection_heap, + (char*)p->old_heap, + (char*)p->old_htop - (char*)p->old_heap, + p->arg_reg, + p->arity); #ifdef HARDDEBUG disallow_heap_frag_ref_in_heap(p, heap, htop); #endif - erts_deallocate_young_generation(p); - - p->heap = heap; - p->high_water = htop; - p->htop = htop; - p->hend = p->heap + heap_size; - p->stop = p->hend - CP_SIZE; - p->heap_sz = heap_size; - - heap_size = actual_size = p->htop - p->heap; + heap_size = collection_htop - collection_heap; + final_size = heap_size + S_RESERVED + stack_size; - /* Reserve place for continuation pointer and redzone */ - heap_size += S_RESERVED; + /* Move the heap to its final destination, compacting it together with the + * stack. + * + * IMPORTANT: We have garbage collected to a temporary heap and then copy + * the result to a newly allocated heap of exact size. + * + * !! This is intentional !! Garbage collecting as usual and then shrinking + * the heap by reallocating it caused serious fragmentation problems when + * large amounts of processes were hibernated. */ + final_heap = ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm) * final_size); + sys_memcpy(final_heap, collection_heap, heap_size * sizeof(Eterm)); + sys_memcpy(&final_heap[final_size - stack_size], + p->stop, + stack_size * sizeof(Eterm)); - FLAGS(p) &= ~F_FORCE_GC; - p->live_hf_end = ERTS_INVALID_HFRAG_PTR; + stack_offset = final_heap - p->stop; + heap_offset = final_heap - collection_heap; - /* - * Move the heap to its final destination. - * - * IMPORTANT: We have garbage collected to a temporary heap and - * then copy the result to a newly allocated heap of exact size. - * This is intentional and important! Garbage collecting as usual - * and then shrinking the heap by reallocating it caused serious - * fragmentation problems when large amounts of processes were - * hibernated. - */ + area = (char *) collection_heap; + area_sz = heap_size * sizeof(Eterm); - ASSERT(actual_size < p->heap_sz); + erts_deallocate_young_generation(p); + erts_free(ERTS_ALC_T_TMP_HEAP, collection_heap); - heap = ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*heap_size); - sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); - ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); + p->heap = final_heap; + p->heap_sz = final_size; + p->high_water = &final_heap[heap_size]; + p->htop = &final_heap[heap_size]; + p->hend = &final_heap[final_size]; + p->stop = &p->heap[final_size - stack_size]; - p->hend = heap + heap_size; - p->stop = p->hend - CP_SIZE; - - switch (erts_frame_layout) { - case ERTS_FRAME_LAYOUT_RA: - p->stop[0] = make_cp(beam_normal_exit); - break; - case ERTS_FRAME_LAYOUT_FP_RA: - p->stop[0] = make_cp(NULL); - p->stop[1] = make_cp(beam_normal_exit); - FRAME_POINTER(p) = &p->stop[0]; - break; - } - - offs = heap - p->heap; - area = (char *) p->heap; - area_sz = ((char *) p->htop) - area; - offset_heap(heap, actual_size, offs, area, area_sz); - p->high_water = heap + (p->high_water - p->heap); - offset_rootset(p, offs, 0, area, area_sz, p->arg_reg, p->arity); - p->htop = heap + actual_size; - p->heap = heap; - p->heap_sz = heap_size; + FLAGS(p) &= ~F_FORCE_GC; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; + offset_heap(final_heap, heap_size, heap_offset, area, area_sz); + offset_rootset(p, heap_offset, stack_offset, area, area_sz, + p->arg_reg, p->arity); #ifdef CHECK_FOR_HOLES p->last_htop = p->htop; - p->last_mbuf = 0; -#endif + p->last_mbuf = NULL; +#endif #ifdef DEBUG p->last_old_htop = NULL; #endif - /* - * Finishing. - */ - ErtsGcQuickSanityCheck(p); p->flags |= F_HIBERNATED; - erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); - reds = gc_cost(actual_size, actual_size); - return reds; + return gc_cost(final_size, final_size); } void diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index d7bb35378d1c..921bc112442b 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1552,7 +1552,7 @@ Uint erts_current_reductions(Process* current, Process *p); int erts_print_system_version(fmtfn_t to, void *arg, Process *c_p); -int erts_hibernate(Process* c_p, Eterm* reg); +void erts_hibernate(Process *c_p, Eterm *regs, int arity); ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr); diff --git a/erts/emulator/beam/jit/arm/instr_trace.cpp b/erts/emulator/beam/jit/arm/instr_trace.cpp index f60dda7619a4..9c78432b3547 100644 --- a/erts/emulator/beam/jit/arm/instr_trace.cpp +++ b/erts/emulator/beam/jit/arm/instr_trace.cpp @@ -201,26 +201,19 @@ void BeamModuleAssembler::emit_i_return_to_trace() { } void BeamModuleAssembler::emit_i_hibernate() { - Label error = a.newLabel(); - - emit_enter_runtime(3); + emit_enter_runtime(0); a.mov(ARG1, c_p); load_x_reg_array(ARG2); - runtime_call<2>(erts_hibernate); + mov_imm(ARG3, 0); + runtime_call<3>(erts_hibernate); - emit_leave_runtime(3); - - a.cbz(ARG1, error); + emit_leave_runtime(0); a.ldr(TMP1.w(), arm::Mem(c_p, offsetof(Process, flags))); a.and_(TMP1, TMP1, imm(~F_HIBERNATE_SCHED)); a.str(TMP1.w(), arm::Mem(c_p, offsetof(Process, flags))); - a.b(resolve_fragment(ga->get_do_schedule(), disp128MB)); - a.bind(error); - emit_raise_exception(&BIF_TRAP_EXPORT(BIF_hibernate_3)->info.mfa); - mark_unreachable(); + mov_imm(XREG0, am_ok); + fragment_call(ga->get_dispatch_return()); } diff --git a/erts/emulator/beam/jit/arm/ops.tab b/erts/emulator/beam/jit/arm/ops.tab index bfd23151c99e..fb75fc3ccb04 100644 --- a/erts/emulator/beam/jit/arm/ops.tab +++ b/erts/emulator/beam/jit/arm/ops.tab @@ -656,11 +656,11 @@ call_ext_last u==0 u$func:erlang:yield/0 D => i_yield | deallocate D | return call_ext_only u==0 u$func:erlang:yield/0 => i_yield | return # -# The hibernate/3 BIF is an instruction. +# The hibernate/0 BIF is an instruction. # -call_ext u==3 u$func:erlang:hibernate/3 => i_hibernate -call_ext_last u==3 u$func:erlang:hibernate/3 _D => i_hibernate -call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate +call_ext u==0 u$func:erlang:hibernate/0 => i_hibernate +call_ext_last u==0 u$func:erlang:hibernate/0 D => i_hibernate | deallocate D | return +call_ext_only u==0 u$func:erlang:hibernate/0 => i_hibernate | return call_ext u==0 u$func:os:perf_counter/0 => i_perf_counter diff --git a/erts/emulator/beam/jit/x86/instr_trace.cpp b/erts/emulator/beam/jit/x86/instr_trace.cpp index 7a867679b3fa..8c0e652ba435 100644 --- a/erts/emulator/beam/jit/x86/instr_trace.cpp +++ b/erts/emulator/beam/jit/x86/instr_trace.cpp @@ -234,23 +234,28 @@ void BeamModuleAssembler::emit_i_return_to_trace() { } void BeamModuleAssembler::emit_i_hibernate() { - Label error = a.newLabel(); - - emit_enter_runtime(); + emit_enter_runtime(); a.mov(ARG1, c_p); load_x_reg_array(ARG2); - runtime_call<2>(erts_hibernate); + mov_imm(ARG3, 0); + runtime_call<3>(erts_hibernate); - emit_leave_runtime(); - - a.test(RET, RET); - a.je(error); + emit_leave_runtime(); a.and_(x86::dword_ptr(c_p, offsetof(Process, flags)), imm(~F_HIBERNATE_SCHED)); - a.jmp(resolve_fragment(ga->get_do_schedule())); - a.bind(error); - emit_raise_exception(&BIF_TRAP_EXPORT(BIF_hibernate_3)->info.mfa); + a.mov(getXRef(0), imm(am_ok)); +#ifdef NATIVE_ERLANG_STACK + fragment_call(resolve_fragment(ga->get_dispatch_return())); +#else + Label next = a.newLabel(); + + a.lea(ARG3, x86::qword_ptr(next)); + a.jmp(resolve_fragment(ga->get_dispatch_return())); + + a.align(AlignMode::kCode, 8); + a.bind(next); +#endif } diff --git a/erts/emulator/beam/jit/x86/ops.tab b/erts/emulator/beam/jit/x86/ops.tab index 1d6e0b726de0..48f4a0b29d79 100644 --- a/erts/emulator/beam/jit/x86/ops.tab +++ b/erts/emulator/beam/jit/x86/ops.tab @@ -602,11 +602,11 @@ call_ext_last u==0 u$func:erlang:yield/0 D => i_yield | deallocate D | return call_ext_only u==0 u$func:erlang:yield/0 => i_yield | return # -# The hibernate/3 BIF is an instruction. +# The hibernate/0 BIF is an instruction. # -call_ext u==3 u$func:erlang:hibernate/3 => i_hibernate -call_ext_last u==3 u$func:erlang:hibernate/3 _D => i_hibernate -call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate +call_ext u==0 u$func:erlang:hibernate/0 => i_hibernate +call_ext_last u==0 u$func:erlang:hibernate/0 D => i_hibernate | deallocate D | return +call_ext_only u==0 u$func:erlang:hibernate/0 => i_hibernate | return call_ext u==0 u$func:os:perf_counter/0 => i_perf_counter diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 81b56ba7f84b..6155408cb947 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -25,7 +25,7 @@ -export([all/0, suite/0, basic/1,dynamic_call/1,min_heap_size/1,bad_args/1, messages_in_queue/1,undefined_mfa/1,no_heap/1, - wake_up_and_bif_trap/1]). + wake_up_and_bif_trap/1,in_place/1]). %% Used by test cases. -export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, @@ -37,7 +37,7 @@ suite() -> all() -> [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue, - undefined_mfa, no_heap, wake_up_and_bif_trap]. + undefined_mfa, no_heap, wake_up_and_bif_trap, in_place]. %%% %%% Testing the basic functionality of erlang:hibernate/3. @@ -372,6 +372,89 @@ characters_to_list_trap(Parent) -> unicode:characters_to_list(Bin), Parent ! {ok, self()}. +%% Tests the in-place variant, hibernate/0 +in_place(_Config) -> + in_place_helper("Minimal test", + fun(F) -> F() end, 16), + + in_place_helper("Deep stack test", + fun(F) -> + (fun S(0) -> F(); S(N) -> S(N - 1), ok end)(512) + end, 530), + + in_place_helper("Heavy data test", + fun(F) -> + Data = lists:seq(1, 1024), + F(), + lists:foreach(fun(_) -> ok end, Data) + end, 2100), + + in_place_helper("Heavy data and stack test", + fun(F) -> + Data = lists:seq(1, 1024), + (fun S(0) -> F(); S(N) -> S(N - 1), ok end)(512), + lists:foreach(fun(_) -> ok end, Data) + end, 2600), + + ok. + +in_place_helper(Description, Fun, Limit) -> + Parent = self(), + Token = make_ref(), + + {Reference, RefMon} = + spawn_opt(fun() -> + Fun(fun() -> + Parent ! {ready, Token}, + receive {done, Token} -> ok end + end) + end, [link, monitor]), + {Hibernator, HibMon} = + spawn_opt(fun() -> + Fun(fun() -> + Parent ! {ready, Token}, + erlang:hibernate(), + Parent ! {awoken, Token}, + receive {done, Token} -> ok end + end) + end, [link, monitor]), + + receive {ready, Token} -> ok end, + [{status, waiting}, {_, RefSize}] = + process_info(Reference, [status, total_heap_size]), + Reference ! {done, Token}, + receive {'DOWN', RefMon, _, _, _} -> ok end, + + receive {ready, Token} -> ok end, + [{status, waiting}, {_, HiberSize}] = + process_info(Hibernator, [status, total_heap_size]), + + %% Sleep a while, we have a small race between the ready message and + %% hibernation. + ct:sleep(1000), + + %% If we did not succeed in hibernating, the hibernator will have sent a + %% message saying it has awoken before we poke it with a done message. + receive + {awoken, Token} -> + ct:fail("Failed to sleep on hibernate/0") + after + 0 -> ok + end, + + Hibernator ! {done, Token}, + receive {awoken, Token} -> ok end, + + receive {'DOWN', HibMon, _, _, _} -> ok end, + + ct:log("~ts~n\tReference size ~p~n\tHibernated size ~p~n", + [Description, RefSize, HiberSize]), + + true = HiberSize < Limit, %Assertion, whitebox. + true = HiberSize =< RefSize, %Assertion. + + ok. + %% %% Misc %% diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index 2315ec378407..3e5a61d6d4a9 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 304f6bdcc7db..508c7660cd4e 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -441,7 +441,7 @@ A list of binaries. This datatype is useful to use together with -export([get_module_info/1, group_leader/0]). -export([group_leader/2]). -export([halt/0, halt/1, halt/2, - has_prepared_code_on_load/1, hibernate/3]). + has_prepared_code_on_load/1, hibernate/0, hibernate/3]). -export([insert_element/3]). -export([integer_to_binary/1, integer_to_list/1]). -export([iolist_size/1, iolist_to_binary/1, iolist_to_iovec/1]). @@ -3304,6 +3304,23 @@ halt(_, _) -> has_prepared_code_on_load(_PreparedCode) -> erlang:nif_error(undefined). +%% hibernate/0 +-doc """ +Puts the calling process into a wait state where its memory allocation has been +reduced as much as possible. This is useful if the process does not expect to +receive any messages soon. + +The process is awakened when a message is sent to it, and control resumes +normally to the caller. It does not discard the call stack like +`erlang:hibernate/3`. +""". +-doc #{ group => processes }. +-spec hibernate() -> ok. +hibernate() -> + %% This function is a fallback used on apply/3; the loader turns this + %% remote call of ourselves into a special instruction. + erlang:hibernate(). + %% hibernate/3 -doc """ Puts the calling process into a wait state where its memory allocation has been