diff options
Diffstat (limited to 'erts/emulator/beam/beam_bif_load.c')
| -rw-r--r-- | erts/emulator/beam/beam_bif_load.c | 812 |
1 files changed, 553 insertions, 259 deletions
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 649594a334..15e878ba65 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1,18 +1,19 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. + * 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 * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. + * 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% */ @@ -33,18 +34,16 @@ #include "beam_catches.h" #include "erl_binary.h" #include "erl_nif.h" +#include "erl_bits.h" #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp); +static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls); static void delete_code(Module* modp); -static void decrement_refc(BeamInstr* code); -static int is_native(BeamInstr* code); +static void decrement_refc(BeamCodeHeader*); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); - - BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) { Module* modp; @@ -59,8 +58,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) return am_undefined; } erts_rlock_old_code(code_ix); - res = ((modp->curr.code && is_native(modp->curr.code)) || - (modp->old.code != 0 && is_native(modp->old.code))) ? + res = (erts_is_module_native(modp->curr.code_hdr) || + erts_is_module_native(modp->old.code_hdr)) ? am_true : am_false; erts_runlock_old_code(code_ix); return res; @@ -82,12 +81,12 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) modp = erts_get_module(BIF_ARG_1, erts_active_code_ix()); if (modp && modp->curr.num_breakpoints > 0) { - ASSERT(modp->curr.code != NULL); + ASSERT(modp->curr.code_hdr != NULL); erts_clear_module_break(modp); ASSERT(modp->curr.num_breakpoints == 0); } - erts_start_staging_code_ix(); + erts_start_staging_code_ix(1); res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); @@ -140,6 +139,25 @@ prepare_loading_2(BIF_ALIST_2) BIF_RET(res); } +BIF_RETTYPE +has_prepared_code_on_load_1(BIF_ALIST_1) +{ + Eterm res; + ProcBin* pb; + + if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + + pb = (ProcBin*) binary_val(BIF_ARG_1); + res = erts_has_code_on_load(pb->val); + if (res == NIL) { + goto error; + } + BIF_RET(res); +} + struct m { Binary* code; Eterm module; @@ -155,7 +173,7 @@ static struct /* Protected by code_write_permission */ { Process* stager; ErtsThrPrgrLaterOp lop; -}commiter_state; +} committer_state; #endif static Eterm @@ -164,14 +182,13 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) Eterm* hp = HAlloc(p, 3 + 2*exceptions); Eterm res = NIL; - mp += exceptions - 1; while (exceptions > 0) { if (mp->exception) { res = CONS(hp, mp->module, res); hp += 2; exceptions--; } - mp--; + mp++; } return TUPLE2(hp, tag, res); } @@ -180,8 +197,8 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) BIF_RETTYPE finish_loading_1(BIF_ALIST_1) { - int i; - int n; + Sint i; + Sint n; struct m* p = NULL; Uint exceptions; Eterm res; @@ -201,10 +218,14 @@ finish_loading_1(BIF_ALIST_1) * to keep the elements in. */ - n = list_length(BIF_ARG_1); - if (n == -1) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + n = erts_list_length(BIF_ARG_1); + if (n < 0) { + badarg: + if (p) { + erts_free(ERTS_ALC_T_LOADER_TMP, p); + } + erts_release_code_write_permission(); + BIF_ERROR(BIF_P, BADARG); } p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m)); @@ -219,29 +240,32 @@ finish_loading_1(BIF_ALIST_1) ProcBin* pb; if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + goto badarg; } pb = (ProcBin*) binary_val(term); p[i].code = pb->val; p[i].module = erts_module_for_prepared_code(p[i].code); if (p[i].module == NIL) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + goto badarg; } BIF_ARG_1 = CDR(cons); } /* * Since we cannot handle atomic loading of a group of modules - * if one or more of them uses on_load, we will only allow one - * element in the list. This limitation is intended to be - * lifted in the future. + * if one or more of them uses on_load, we will only allow + * more than one element in the list if none of the modules + * have an on_load function. */ if (n > 1) { - ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT); - goto done; + for (i = 0; i < n; i++) { + if (erts_has_code_on_load(p[i].code) == am_true) { + erts_free(ERTS_ALC_T_LOADER_TMP, p); + erts_release_code_write_permission(); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + } } /* @@ -253,11 +277,27 @@ finish_loading_1(BIF_ALIST_1) */ res = am_ok; - erts_start_staging_code_ix(); + erts_start_staging_code_ix(n); for (i = 0; i < n; i++) { p[i].modp = erts_put_module(p[i].module); + p[i].modp->seen = 0; + } + + exceptions = 0; + for (i = 0; i < n; i++) { + p[i].exception = 0; + if (p[i].modp->seen) { + p[i].exception = 1; + exceptions++; + } + p[i].modp->seen = 1; } + if (exceptions) { + res = exception_list(BIF_P, am_duplicated, p, exceptions); + goto done; + } + for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints > 0 || p[i].modp->curr.num_traced_exports > 0 || @@ -282,7 +322,7 @@ finish_loading_1(BIF_ALIST_1) exceptions = 0; for (i = 0; i < n; i++) { p[i].exception = 0; - if (p[i].modp->curr.code && p[i].modp->old.code) { + if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) { p[i].exception = 1; exceptions++; } @@ -368,10 +408,10 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, * schedulers to read active code_ix in a safe way while executing * without any memory barriers at all. */ - ASSERT(commiter_state.stager == NULL); - commiter_state.stager = c_p; - erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); - erts_smp_proc_inc_refc(c_p); + ASSERT(committer_state.stager == NULL); + committer_state.stager = c_p; + erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop); + erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* * smp_code_ix_commiter() will do the rest "later" @@ -386,11 +426,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, #ifdef ERTS_SMP static void smp_code_ix_commiter(void* null) { - Process* p = commiter_state.stager; + Process* p = committer_state.stager; erts_commit_staging_code_ix(); #ifdef DEBUG - commiter_state.stager = NULL; + committer_state.stager = NULL; #endif erts_release_code_write_permission(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); @@ -398,7 +438,7 @@ static void smp_code_ix_commiter(void* null) erts_resume(p, ERTS_PROC_LOCK_STATUS); } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_proc_dec_refc(p); + erts_proc_dec_refc(p); } #endif /* ERTS_SMP */ @@ -418,7 +458,7 @@ check_old_code_1(BIF_ALIST_1) modp = erts_get_module(BIF_ARG_1, code_ix); if (modp != NULL) { erts_rlock_old_code(code_ix); - if (modp->old.code != NULL) { + if (modp->old.code_hdr) { res = am_true; } erts_runlock_old_code(code_ix); @@ -427,69 +467,55 @@ check_old_code_1(BIF_ALIST_1) } Eterm -check_process_code_2(BIF_ALIST_2) +erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls) { - Process* rp; Module* modp; + Eterm res; + ErtsCodeIndex code_ix; - if (is_not_atom(BIF_ARG_2)) { - goto error; - } - if (is_internal_pid(BIF_ARG_1)) { - Eterm res; - ErtsCodeIndex code_ix; + (*redsp)++; - code_ix = erts_active_code_ix(); - modp = erts_get_module(BIF_ARG_2, code_ix); - if (modp == NULL) { /* Doesn't exist. */ - return am_false; - } - erts_rlock_old_code(code_ix); - if (modp->old.code == NULL) { /* No old code. */ - erts_runlock_old_code(code_ix); - return am_false; - } - erts_runlock_old_code(code_ix); - -#ifdef ERTS_SMP - rp = erts_pid2proc_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCK_MAIN); -#else - rp = erts_pid2proc(BIF_P, 0, BIF_ARG_1, 0); -#endif - if (!rp) { - BIF_RET(am_false); - } - if (rp == ERTS_PROC_LOCK_BUSY) { - ERTS_BIF_YIELD2(bif_export[BIF_check_process_code_2], BIF_P, - BIF_ARG_1, BIF_ARG_2); - } - erts_rlock_old_code(code_ix); - if (modp->old.code != NULL) { /* must check again */ - res = check_process_code(rp, modp); - } - else { - res = am_false; - } - erts_runlock_old_code(code_ix); -#ifdef ERTS_SMP - if (BIF_P != rp) { - erts_resume(rp, ERTS_PROC_LOCK_MAIN); - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); - } -#endif - BIF_RET(res); - } - else if (is_external_pid(BIF_ARG_1) - && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { - BIF_RET(am_false); + ASSERT(is_atom(module)); + + code_ix = erts_active_code_ix(); + modp = erts_get_module(module, code_ix); + if (!modp) + return am_false; + erts_rlock_old_code(code_ix); + res = (!modp->old.code_hdr ? am_false : + check_process_code(c_p, modp, flags, redsp, fcalls)); + erts_runlock_old_code(code_ix); + + return res; +} + +BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) +{ + int reds = 0; + Uint flags; + Eterm res; + + if (is_not_atom(BIF_ARG_1)) + goto badarg; + + if (is_not_small(BIF_ARG_2)) + goto badarg; + + flags = unsigned_val(BIF_ARG_2); + if (flags & ~ERTS_CPC_ALL) { + goto badarg; } - error: + res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds, BIF_P->fcalls); + + ASSERT(is_value(res)); + + BIF_RET2(res, reds); + +badarg: BIF_ERROR(BIF_P, BADARG); } - BIF_RETTYPE delete_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; @@ -507,13 +533,13 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } { - erts_start_staging_code_ix(); + erts_start_staging_code_ix(0); code_ix = erts_staging_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); if (!modp) { res = am_undefined; } - else if (modp->old.code != 0) { + else if (modp->old.code_hdr) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", BIF_ARG_1); @@ -551,8 +577,8 @@ BIF_RETTYPE module_loaded_1(BIF_ALIST_1) } code_ix = erts_active_code_ix(); if ((modp = erts_get_module(BIF_ARG_1, code_ix)) != NULL) { - if (modp->curr.code != NULL - && modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] == 0) { + if (modp->curr.code_hdr + && modp->curr.code_hdr->on_load_function_ptr == NULL) { res = am_true; } } @@ -599,8 +625,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1) { Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix()); - if (modp && modp->curr.code) { - BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]); + if (modp && modp->old.code_hdr) { + BIF_TRAP_CODE_PTR_0(BIF_P, modp->old.code_hdr->on_load_function_ptr); } else { BIF_ERROR(BIF_P, BADARG); @@ -611,7 +637,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) { ErtsCodeIndex code_ix; Module* modp; - Eterm on_load; if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2], @@ -626,14 +651,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) code_ix = erts_active_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); - if (!modp || modp->curr.code == 0) { + if (!modp || !modp->old.code_hdr) { error: erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } - if ((on_load = modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]) == 0) { + if (modp->old.code_hdr->on_load_function_ptr == NULL) { goto error; } if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { @@ -642,41 +667,55 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) if (BIF_ARG_2 == am_true) { int i; + struct erl_module_instance t; + + /* + * Swap old and new code. + */ + t = modp->curr; + modp->curr = modp->old; + modp->old = t; /* * The on_load function succeded. Fix up export entries. */ for (i = 0; i < export_list_size(code_ix); i++) { Export *ep = export_list(i,code_ix); - if (ep != NULL && - ep->code[0] == BIF_ARG_1 && - ep->code[4] != 0) { + if (ep == NULL || ep->code[0] != BIF_ARG_1) { + continue; + } + if (ep->code[4] != 0) { ep->addressv[code_ix] = (void *) ep->code[4]; ep->code[4] = 0; + } else { + if (ep->addressv[code_ix] == ep->code+3 && + ep->code[3] == (BeamInstr) em_apply_bif) { + continue; + } + ep->addressv[code_ix] = ep->code+3; + ep->code[3] = (BeamInstr) em_call_error_handler; } } - modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] = 0; + modp->curr.code_hdr->on_load_function_ptr = NULL; set_default_trace_pattern(BIF_ARG_1); } else if (BIF_ARG_2 == am_false) { - BeamInstr* code; - BeamInstr* end; + int i; /* - * The on_load function failed. Remove the loaded code. - * This is an combination of delete and purge. We purge - * the current code; the old code is not touched. + * The on_load function failed. Remove references to the + * code that is about to be purged from the export entries. */ - erts_total_code_size -= modp->curr.code_length; - code = modp->curr.code; - end = (BeamInstr *)((char *)code + modp->curr.code_length); - erts_cleanup_funs_on_purge(code, end); - beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length, - erts_active_code_ix()); - erts_free(ERTS_ALC_T_CODE, (void *) code); - modp->curr.code = NULL; - modp->curr.code_length = 0; - modp->curr.catches = BEAM_CATCHES_NIL; - erts_remove_from_ranges(code); + + for (i = 0; i < export_list_size(code_ix); i++) { + Export *ep = export_list(i,code_ix); + if (ep == NULL || ep->code[0] != BIF_ARG_1) { + continue; + } + if (ep->code[3] == (BeamInstr) em_apply_bif) { + continue; + } + ep->code[4] = 0; + } } erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); @@ -691,13 +730,13 @@ set_default_trace_pattern(Eterm module) Binary *match_spec; Binary *meta_match_spec; struct trace_pattern_flags trace_pattern_flags; - Eterm meta_tracer_pid; + ErtsTracer meta_tracer; erts_get_default_trace_pattern(&trace_pattern_is_on, &match_spec, &meta_match_spec, &trace_pattern_flags, - &meta_tracer_pid); + &meta_tracer); if (trace_pattern_is_on) { Eterm mfa[1]; mfa[0] = module; @@ -705,35 +744,59 @@ set_default_trace_pattern(Eterm module) match_spec, meta_match_spec, 1, trace_pattern_flags, - meta_tracer_pid, 1); + meta_tracer, 1); } } +static ERTS_INLINE int +check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) +{ + struct erl_off_heap_header* oh; + for (oh = off_heap->first; oh; oh = oh->next) { + if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { + ErlFunThing* funp = (ErlFunThing*) oh; + if (ErtsInArea(funp->fe->address, area, area_size)) + return !0; + } + } + return 0; +} + +static Uint hfrag_literal_size(Eterm* start, Eterm* end, + char* lit_start, Uint lit_size); +static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp, + Eterm *start, Eterm *end, + char *lit_start, Uint lit_size); + static Eterm -check_process_code(Process* rp, Module* modp) +check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) { BeamInstr* start; + char* literals; + Uint lit_bsize; char* mod_start; Uint mod_size; - BeamInstr* end; Eterm* sp; - struct erl_off_heap_header* oh; int done_gc = 0; + int need_gc = 0; + ErtsMessage *msgp; + ErlHeapFragment *hfrag; -#define INSIDE(a) (start <= (a) && (a) < end) +#define ERTS_ORDINARY_GC__ (1 << 0) +#define ERTS_LITERAL_GC__ (1 << 1) /* * Pick up limits for the module. */ - start = modp->old.code; - end = (BeamInstr *)((char *)start + modp->old.code_length); + start = (BeamInstr*) modp->old.code_hdr; mod_start = (char *) start; mod_size = modp->old.code_length; /* * Check if current instruction or continuation pointer points into module. */ - if (INSIDE(rp->i) || INSIDE(rp->cp)) { + if (ErtsInArea(rp->i, mod_start, mod_size) + || ErtsInArea(rp->cp, mod_start, mod_size)) { return am_true; } @@ -741,7 +804,7 @@ check_process_code(Process* rp, Module* modp) * Check all continuation pointers stored on the stack. */ for (sp = rp->stop; sp < STACK_START(rp); sp++) { - if (is_CP(*sp) && INSIDE(cp_val(*sp))) { + if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) { return am_true; } } @@ -755,15 +818,15 @@ check_process_code(Process* rp, Module* modp) struct StackTrace *s; ASSERT(is_list(rp->ftrace)); s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); - if ((s->pc && INSIDE(s->pc)) || - (s->current && INSIDE(s->current))) { + if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) || + (s->current && ErtsInArea(s->current, mod_start, mod_size))) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } else { int i; for (i = 0; i < s->depth; i++) { - if (INSIDE(s->trace[i])) { + if (ErtsInArea(s->trace[i], mod_start, mod_size)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; @@ -773,106 +836,176 @@ check_process_code(Process* rp, Module* modp) } } - /* - * See if there are funs that refer to the old version of the module. - */ - - rescan: - for (oh = MSO(rp).first; oh; oh = oh->next) { - if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { - ErlFunThing* funp = (ErlFunThing*) oh; - - if (INSIDE((BeamInstr *) funp->fe->address)) { - if (done_gc) { - return am_true; - } else { - /* - * Try to get rid of this fun by garbage collecting. - * Clear both fvalue and ftrace to make sure they - * don't hold any funs. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; - FLAGS(rp) |= F_NEED_FULLSWEEP; - (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); - goto rescan; - } - } - } + if (rp->flags & F_DISABLE_GC) { + /* + * Cannot proceed. Process has disabled gc in order to + * safely leave inconsistent data on the heap and/or + * off heap lists. Need to wait for gc to be enabled + * again. + */ + return THE_NON_VALUE; } /* - * See if there are constants inside the module referenced by the process. + * Message queue can contains funs, and may contain + * literals. If we got references to this module from the message + * queue. + * + * If a literal is in the message queue we maka an explicit copy of + * and attach it to the heap fragment. Each message needs to be + * self contained, we cannot save the literal in the old_heap or + * any other heap than the message it self. */ - done_gc = 0; - for (;;) { - ErlMessage* mp; - if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) { + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); + + literals = (char*) modp->old.code_hdr->literals_start; + lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; + + for (msgp = rp->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfrag = &msgp->hfrag; + else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag) + hfrag = msgp->data.heap_frag; + else + continue; + { + ErlHeapFragment *hf; + Uint lit_sz; + for (hf=hfrag; hf; hf = hf->next) { + if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) + return am_true; + lit_sz = hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size], + literals, lit_bsize); + } + if (lit_sz > 0) { + ErlHeapFragment *bp = new_message_buffer(lit_sz); + Eterm *hp = bp->mem; + + for (hf=hfrag; hf; hf = hf->next) { + hfrag_literal_copy(&hp, &bp->off_heap, + &hf->mem[0], &hf->mem[hf->used_size], + literals, lit_bsize); + hfrag=hf; + } + /* link new hfrag last */ + ASSERT(hfrag->next == NULL); + hfrag->next = bp; + bp->next = NULL; + } + } + } + + while (1) { + + /* Check heap, stack etc... */ + if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) + goto try_gc; + if (!(flags & ERTS_CPC_COPY_LITERALS)) { + /* Process ok. May contain old literals but we will be called + * again before module is purged. + */ + return am_false; + } + if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } - if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) { - goto need_gc; - } - if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) { - goto need_gc; + if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) + goto try_literal_gc; + + /* Check dictionary */ + if (rp->dictionary) { + Eterm* start = ERTS_PD_START(rp->dictionary); + Eterm* end = start + ERTS_PD_SIZE(rp->dictionary); + + if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) + goto try_literal_gc; } - if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) { - goto need_gc; + /* Check heap fragments */ + for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + /* Off heap lists should already have been moved into process */ + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); + + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; + if (any_heap_refs(hp, hp_end, literals, lit_bsize)) + goto try_literal_gc; } - if (rp->dictionary != NULL) { - Eterm* start = rp->dictionary->data; - Eterm* end = start + rp->dictionary->used; + /* + * Message buffer fragments (matched messages) + * - off heap lists should already have been moved into + * process off heap structure. + * - Check for literals + */ + for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { + hfrag = erts_message_to_heap_frag(msgp); + for (; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); - if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) { - goto need_gc; - } - } + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; - for (mp = rp->msg.first; mp != NULL; mp = mp->next) { - if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) { - goto need_gc; + if (any_heap_refs(hp, hp_end, literals, lit_bsize)) + goto try_literal_gc; } } - break; - need_gc: - if (done_gc) { + return am_false; + + try_literal_gc: + need_gc |= ERTS_LITERAL_GC__; + + try_gc: + need_gc |= ERTS_ORDINARY_GC__; + + if ((done_gc & need_gc) == need_gc) return am_true; - } else { - Eterm* literals; - Uint lit_size; - struct erl_off_heap_header* oh; - /* - * Try to get rid of constants by by garbage collecting. - * Clear both fvalue and ftrace. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; + if (!(flags & ERTS_CPC_ALLOW_GC)) + return am_aborted; + + need_gc &= ~done_gc; + + /* + * Try to get rid of literals by by garbage collecting. + * Clear both fvalue and ftrace. + */ + + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + + if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; - (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); - literals = (Eterm *) modp->old.code[MI_LITERALS_START]; - lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals; - oh = (struct erl_off_heap_header *) - modp->old.code[MI_LITERALS_OFF_HEAP]; - erts_garbage_collect_literals(rp, literals, lit_size, oh); + *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls); + done_gc |= ERTS_ORDINARY_GC__; } + if (need_gc & ERTS_LITERAL_GC__) { + struct erl_off_heap_header* oh; + oh = modp->old.code_hdr->literals_off_heap; + *redsp += lit_bsize / 64; /* Need, better value... */ + erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh); + done_gc |= ERTS_LITERAL_GC__; + } + need_gc = 0; } - return am_false; -#undef INSIDE -} -#define in_area(ptr,start,nbytes) \ - ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) +#undef ERTS_ORDINARY_GC__ +#undef ERTS_LITERAL_GC__ + +} static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) @@ -885,7 +1018,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; @@ -905,13 +1038,21 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; case TAG_PRIMARY_HEADER: if (!header_is_transparent(val)) { - Eterm* new_p = p + thing_arityval(val); + Eterm* new_p; + if (header_is_bin_matchstate(val)) { + ErlBinMatchState *ms = (ErlBinMatchState*) p; + ErlBinMatchBuffer *mb = &(ms->mb); + if (ErtsInArea(mb->orig, mod_start, mod_size)) { + return 1; + } + } + new_p = p + thing_arityval(val); ASSERT(start <= new_p && new_p < end); p = new_p; } @@ -920,9 +1061,180 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) return 0; } +static Uint +hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size) +{ + Eterm* p; + Eterm val; + Uint sz = 0; + + for (p = start; p < end; p++) { + val = *p; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + case TAG_PRIMARY_LIST: + if (ErtsInArea(val, lit_start, lit_size)) { + sz += size_object(val); + } + break; + case TAG_PRIMARY_HEADER: + if (!header_is_transparent(val)) { + Eterm* new_p; + if (header_is_bin_matchstate(val)) { + ErlBinMatchState *ms = (ErlBinMatchState*) p; + ErlBinMatchBuffer *mb = &(ms->mb); + if (ErtsInArea(mb->orig, lit_start, lit_size)) { + sz += size_object(mb->orig); + } + } + new_p = p + thing_arityval(val); + ASSERT(start <= new_p && new_p < end); + p = new_p; + } + } + } + return sz; +} + +static void +hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp, + Eterm *start, Eterm *end, + char *lit_start, Uint lit_size) { + Eterm* p; + Eterm val; + Uint sz; + + for (p = start; p < end; p++) { + val = *p; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + case TAG_PRIMARY_LIST: + if (ErtsInArea(val, lit_start, lit_size)) { + sz = size_object(val); + val = copy_struct(val, sz, hpp, ohp); + *p = val; + } + break; + case TAG_PRIMARY_HEADER: + if (!header_is_transparent(val)) { + Eterm* new_p; + /* matchstate in message, not possible. */ + if (header_is_bin_matchstate(val)) { + ErlBinMatchState *ms = (ErlBinMatchState*) p; + ErlBinMatchBuffer *mb = &(ms->mb); + if (ErtsInArea(mb->orig, lit_start, lit_size)) { + sz = size_object(mb->orig); + mb->orig = copy_struct(mb->orig, sz, hpp, ohp); + } + } + new_p = p + thing_arityval(val); + ASSERT(start <= new_p && new_p < end); + p = new_p; + } + } + } +} + #undef in_area -BIF_RETTYPE purge_module_1(BIF_ALIST_1) +#ifdef ERTS_SMP +static void copy_literals_commit(void*); +#endif + +copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE}; + +/* copy literals + * + * copy_literals.ptr = LitPtr + * copy_literals.sz = LitSz + * ------ THR PROG COMMIT ----- + * + * - check process code + * - check process code + * ... + * copy_literals.ptr = NULL + * copy_literals.sz = 0 + * ------ THR PROG COMMIT ----- + * ... + */ + + +BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2) +{ + ErtsCodeIndex code_ix; + Eterm res = am_true; + + if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!erts_try_seize_code_write_permission(BIF_P)) { + ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + } + + code_ix = erts_active_code_ix(); + + if (BIF_ARG_2 == am_true) { + Module* modp = erts_get_module(BIF_ARG_1, code_ix); + if (!modp || !modp->old.code_hdr) { + res = am_false; + goto done; + } + if (erts_clrange.ptr != NULL + && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) { + res = am_aborted; + goto done; + } + erts_clrange.ptr = modp->old.code_hdr->literals_start; + erts_clrange.sz = modp->old.code_hdr->literals_end - erts_clrange.ptr; + erts_clrange.pid = BIF_P->common.id; + } else if (BIF_ARG_2 == am_false) { + if (erts_clrange.pid != BIF_P->common.id) { + res = am_false; + goto done; + } + erts_clrange.ptr = NULL; + erts_clrange.sz = 0; + erts_clrange.pid = THE_NON_VALUE; + } + +#ifdef ERTS_SMP + ASSERT(committer_state.stager == NULL); + committer_state.stager = BIF_P; + erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop); + erts_proc_inc_refc(BIF_P); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); +#endif +done: + erts_release_code_write_permission(); + BIF_RET(res); +} + +#ifdef ERTS_SMP +static void copy_literals_commit(void* null) { + Process* p = committer_state.stager; +#ifdef DEBUG + committer_state.stager = NULL; +#endif + erts_release_code_write_permission(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); +} +#endif /* ERTS_SMP */ + + +/* Do the actualy module purging and return: + * true for success + * false if no such old module + * BADARG if not an atom + */ +BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; BeamInstr* code; @@ -936,7 +1248,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1); + ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1], + BIF_P, BIF_ARG_1); } code_ix = erts_active_code_ix(); @@ -946,7 +1259,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) */ if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_RET(ret, am_false); } else { erts_rwlock_old_code(code_ix); @@ -954,8 +1267,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) /* * Any code to purge? */ - if (modp->old.code == 0) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + if (!modp->old.code_hdr) { + ERTS_BIF_PREP_RET(ret, am_false); } else { /* @@ -977,14 +1290,17 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) */ ASSERT(erts_total_code_size >= modp->old.code_length); erts_total_code_size -= modp->old.code_length; - code = modp->old.code; + code = (BeamInstr*) modp->old.code_hdr; end = (BeamInstr *)((char *)code + modp->old.code_length); erts_cleanup_funs_on_purge(code, end); beam_catches_delmod(modp->old.catches, code, modp->old.code_length, code_ix); - decrement_refc(code); + decrement_refc(modp->old.code_hdr); + if (modp->old.code_hdr->literals_start) { + erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start); + } erts_free(ERTS_ALC_T_CODE, (void *) code); - modp->old.code = NULL; + modp->old.code_hdr = NULL; modp->old.code_length = 0; modp->old.catches = BEAM_CATCHES_NIL; erts_remove_from_ranges(code); @@ -1001,10 +1317,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } static void -decrement_refc(BeamInstr* code) +decrement_refc(BeamCodeHeader* code_hdr) { - struct erl_off_heap_header* oh = - (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP]; + struct erl_off_heap_header* oh = code_hdr->literals_off_heap; while (oh) { Binary* bptr; @@ -1053,10 +1368,11 @@ delete_code(Module* modp) ASSERT(modp->curr.num_breakpoints == 0); ASSERT(modp->curr.num_traced_exports == 0); modp->old = modp->curr; - modp->curr.code = NULL; + modp->curr.code_hdr = NULL; modp->curr.code_length = 0; modp->curr.catches = BEAM_CATCHES_NIL; modp->curr.nif = NULL; + } @@ -1070,32 +1386,10 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) * if not, delete old code; error if old code already exists. */ - if (modp->curr.code != NULL && modp->old.code != NULL) { + if (modp->curr.code_hdr && modp->old.code_hdr) { return am_not_purged; - } else if (modp->old.code == NULL) { /* Make the current version old. */ + } else if (!modp->old.code_hdr) { /* Make the current version old. */ delete_code(modp); } return NIL; } - -static int -is_native(BeamInstr* code) -{ - Uint i, num_functions = code[MI_NUM_FUNCTIONS]; - - /* Check NativeAdress of first real function in module - */ - for (i=0; i<num_functions; i++) { - BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; - Eterm name = (Eterm) func_info[3]; - - if (is_atom(name)) { - return func_info[1] != 0; - } - else ASSERT(is_nil(name)); /* ignore BIF stubs */ - } - /* Not a single non-BIF function? */ - return 0; -} - - |