BIF_RETTYPE delete_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; Module* modp; int is_blocking = 0; int success = 0; Eterm res = NIL; if (is_not_atom(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD1(bif_export[BIF_delete_module_1], BIF_P, BIF_ARG_1); } { 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_hdr) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", BIF_ARG_1); erts_send_error_to_logger(BIF_P->group_leader, dsbufp); ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); } else { if (modp->curr.num_breakpoints > 0 || modp->curr.num_traced_exports > 0 || IF_HIPE(hipe_need_blocking(modp))) { /* tracing or hipe need to go single threaded */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); is_blocking = 1; if (modp->curr.num_breakpoints) { erts_clear_module_break(modp); ASSERT(modp->curr.num_breakpoints == 0); } } delete_code(modp); res = am_true; success = 1; } } { struct m mod; Eterm retval; mod.module = BIF_ARG_1; mod.modp = modp; retval = staging_epilogue(BIF_P, success, res, is_blocking, &mod, 1, 0); return retval; } }
/* Return value as a bif, called by erlang:monitor */ Eterm erts_ddll_monitor_driver(Process *p, Eterm description, ErtsProcLocks plocks) { Eterm *tp; Eterm ret; char *name; if (is_not_tuple(description)) { BIF_ERROR(p,BADARG); } tp = tuple_val(description); if (*tp != make_arityval(2)) { BIF_ERROR(p,BADARG); } if ((name = pick_list_or_atom(tp[1])) == NULL) { BIF_ERROR(p,BADARG); } switch (tp[2]) { case am_loaded: ERTS_BIF_PREP_RET(ret, notify_when_loaded(p,tp[1],name,plocks)); break; case am_unloaded: ERTS_BIF_PREP_RET(ret, notify_when_unloaded(p,tp[1],name,plocks, ERL_DE_PROC_AWAIT_UNLOAD)); break; case am_unloaded_only: ERTS_BIF_PREP_RET(ret, notify_when_unloaded(p,tp[1],name,plocks, ERL_DE_PROC_AWAIT_UNLOAD_ONLY)); break; default: ERTS_BIF_PREP_ERROR(ret,p,BADARG); break; } erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); return ret; }
static BIF_RETTYPE dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I) { BIF_RETTYPE ret; if (am_scheduler == arg1) { ErtsSchedulerData *esdp; if (arg2 != am_type) goto badarg; esdp = erts_proc_sched_data(c_p); if (!esdp) goto scheduler_type_error; switch (esdp->type) { case ERTS_SCHED_NORMAL: ERTS_BIF_PREP_RET(ret, am_normal); break; case ERTS_SCHED_DIRTY_CPU: ERTS_BIF_PREP_RET(ret, am_dirty_cpu); break; case ERTS_SCHED_DIRTY_IO: ERTS_BIF_PREP_RET(ret, am_dirty_io); break; default: scheduler_type_error: ERTS_BIF_PREP_RET(ret, am_error); break; } } else if (am_error == arg1) { switch (arg2) { case am_notsup: ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOTSUP); break; case am_undef: ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF); break; case am_badarith: ERTS_BIF_PREP_ERROR(ret, c_p, EXC_BADARITH); break; case am_noproc: ERTS_BIF_PREP_ERROR(ret, c_p, EXC_NOPROC); break; case am_system_limit: ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT); break; case am_badarg: default: goto badarg; } } else if (am_copy == arg1) { int i; Eterm res; for (res = NIL, i = 0; i < 1000; i++) { Eterm *hp, sz; Eterm cpy; /* We do not want this to be optimized, but rather the oposite... */ sz = size_object(arg2); hp = HAlloc(c_p, sz); cpy = copy_struct(arg2, sz, &hp, &c_p->off_heap); hp = HAlloc(c_p, 2); res = CONS(hp, cpy, res); } ERTS_BIF_PREP_RET(ret, res); } else if (am_send == arg1) { dirty_send_message(c_p, arg2, am_ok); ERTS_BIF_PREP_RET(ret, am_ok); } else if (ERTS_IS_ATOM_STR("wait", arg1)) { if (!ms_wait(c_p, arg2, type == am_dirty_cpu)) goto badarg; ERTS_BIF_PREP_RET(ret, am_ok); } else if (ERTS_IS_ATOM_STR("reschedule", arg1)) { /* * Reschedule operation after decrement of two until we reach * zero. Switch between dirty scheduler types when 'n' is * evenly divided by 4. If the initial value wasn't evenly * dividable by 2, throw badarg exception. */ Eterm next_type; Sint n; if (!term_to_Sint(arg2, &n) || n < 0) goto badarg; if (n == 0) ERTS_BIF_PREP_RET(ret, am_ok); else { Eterm argv[3]; Eterm eint = erts_make_integer((Uint) (n - 2), c_p); if (n % 4 != 0) next_type = type; else { switch (type) { case am_dirty_cpu: next_type = am_dirty_io; break; case am_dirty_io: next_type = am_normal; break; case am_normal: next_type = am_dirty_cpu; break; default: goto badarg; } } switch (next_type) { case am_dirty_io: argv[0] = arg1; argv[1] = eint; ret = erts_schedule_bif(c_p, argv, I, erts_debug_dirty_io_2, ERTS_SCHED_DIRTY_IO, am_erts_debug, am_dirty_io, 2); break; case am_dirty_cpu: argv[0] = arg1; argv[1] = eint; ret = erts_schedule_bif(c_p, argv, I, erts_debug_dirty_cpu_2, ERTS_SCHED_DIRTY_CPU, am_erts_debug, am_dirty_cpu, 2); break; case am_normal: argv[0] = am_normal; argv[1] = arg1; argv[2] = eint; ret = erts_schedule_bif(c_p, argv, I, erts_debug_dirty_3, ERTS_SCHED_NORMAL, am_erts_debug, am_dirty, 3); break; default: goto badarg; } } } else if (ERTS_IS_ATOM_STR("ready_wait6_done", arg1)) { ERTS_DECL_AM(ready); ERTS_DECL_AM(done); dirty_send_message(c_p, arg2, AM_ready); ms_wait(c_p, make_small(6000), 0); dirty_send_message(c_p, arg2, AM_done); ERTS_BIF_PREP_RET(ret, am_ok); } else if (ERTS_IS_ATOM_STR("alive_waitexiting", arg1)) { Process *real_c_p = erts_proc_shadow2real(c_p); Eterm *hp, *hp2; Uint sz; int i; ErtsSchedulerData *esdp = erts_proc_sched_data(c_p); int dirty_io = esdp->type == ERTS_SCHED_DIRTY_IO; if (ERTS_PROC_IS_EXITING(real_c_p)) goto badarg; dirty_send_message(c_p, arg2, am_alive); /* Wait until dead */ while (!ERTS_PROC_IS_EXITING(real_c_p)) { if (dirty_io) ms_wait(c_p, make_small(100), 0); else erts_thr_yield(); } ms_wait(c_p, make_small(1000), 0); /* Should still be able to allocate memory */ hp = HAlloc(c_p, 3); /* Likely on heap */ sz = 10000; hp2 = HAlloc(c_p, sz); /* Likely in heap fragment */ *hp2 = make_pos_bignum_header(sz); for (i = 1; i < sz; i++) hp2[i] = (Eterm) 4711; ERTS_BIF_PREP_RET(ret, TUPLE2(hp, am_ok, make_big(hp2))); } else { badarg: ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); } return ret; }
BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3) { BIF_RETTYPE res; Port *prt; int flags = 0; Eterm ref; if (is_not_nil(BIF_ARG_3)) { Eterm l = BIF_ARG_3; while (is_list(l)) { Eterm* cons = list_val(l); Eterm car = CAR(cons); if (car == am_force) flags |= ERTS_PORT_SIG_FLG_FORCE; else if (car == am_nosuspend) flags |= ERTS_PORT_SIG_FLG_NOSUSPEND; else BIF_RET(am_badarg); l = CDR(cons); } if (!is_nil(l)) BIF_RET(am_badarg); } prt = sig_lookup_port(BIF_P, BIF_ARG_1); if (!prt) BIF_RET(am_badarg); if (flags & ERTS_PORT_SIG_FLG_FORCE) { if (!(prt->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY)) BIF_RET(am_notsup); } #ifdef DEBUG ref = NIL; #endif switch (erts_port_output(BIF_P, flags, prt, prt->common.id, BIF_ARG_2, &ref)) { case ERTS_PORT_OP_CALLER_EXIT: case ERTS_PORT_OP_BADARG: case ERTS_PORT_OP_DROPPED: ERTS_BIF_PREP_RET(res, am_badarg); break; case ERTS_PORT_OP_BUSY: ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE)); if (flags & ERTS_PORT_SIG_FLG_NOSUSPEND) ERTS_BIF_PREP_RET(res, am_false); else { erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, prt); ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_erts_internal_port_command_3], BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } break; case ERTS_PORT_OP_BUSY_SCHEDULED: ASSERT(!(flags & ERTS_PORT_SIG_FLG_FORCE)); /* Fall through... */ case ERTS_PORT_OP_SCHEDULED: ASSERT(is_internal_ordinary_ref(ref)); ERTS_BIF_PREP_RET(res, ref); break; case ERTS_PORT_OP_DONE: ERTS_BIF_PREP_RET(res, am_true); break; default: ERTS_INTERNAL_ERROR("Unexpected erts_port_output() result"); break; } if (ERTS_PROC_IS_EXITING(BIF_P)) { KILL_CATCHES(BIF_P); /* Must exit */ ERTS_BIF_PREP_ERROR(res, BIF_P, EXC_ERROR); } return res; }
BIF_RETTYPE purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; BeamInstr* code; BeamInstr* end; Module* modp; int is_blocking = 0; Eterm ret; if (is_not_atom(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1); } code_ix = erts_active_code_ix(); /* * Correct module? */ if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) { ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); } else { erts_rwlock_old_code(code_ix); /* * Any code to purge? */ if (modp->old.code == 0) { ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); } else { /* * Unload any NIF library */ if (modp->old.nif != NULL) { /* ToDo: Do unload nif without blocking */ erts_rwunlock_old_code(code_ix); erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); is_blocking = 1; erts_rwlock_old_code(code_ix); erts_unload_nif(modp->old.nif); modp->old.nif = NULL; } /* * Remove the old code. */ ASSERT(erts_total_code_size >= modp->old.code_length); erts_total_code_size -= modp->old.code_length; code = modp->old.code; 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); erts_free(ERTS_ALC_T_CODE, (void *) code); modp->old.code = NULL; modp->old.code_length = 0; modp->old.catches = BEAM_CATCHES_NIL; erts_remove_from_ranges(code); ERTS_BIF_PREP_RET(ret, am_true); } erts_rwunlock_old_code(code_ix); } if (is_blocking) { erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); } erts_release_code_write_permission(); return ret; }
BIF_RETTYPE finish_loading_1(BIF_ALIST_1) { int i; int n; struct m* p = NULL; Uint exceptions; Eterm res; int is_blocking = 0; int do_commit = 0; if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD1(bif_export[BIF_finish_loading_1], BIF_P, BIF_ARG_1); } /* * Validate the argument before we start loading; it must be a * proper list where each element is a magic binary containing * prepared (not previously loaded) code. * * First count the number of elements and allocate an array * to keep the elements in. */ n = list_length(BIF_ARG_1); if (n == -1) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); goto done; } p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m)); /* * We now know that the argument is a proper list. Validate * and collect the binaries into the array. */ for (i = 0; i < n; i++) { Eterm* cons = list_val(BIF_ARG_1); Eterm term = CAR(cons); ProcBin* pb; if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); goto done; } 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; } 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 (n > 1) { ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT); goto done; } /* * All types are correct. There cannot be a BADARG from now on. * Before we can start loading, we must check whether any of * the modules already has old code. To avoid a race, we must * not allow other process to initiate a code loading operation * from now on. */ res = am_ok; erts_start_staging_code_ix(); for (i = 0; i < n; i++) { p[i].modp = erts_put_module(p[i].module); } for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints > 0 || p[i].modp->curr.num_traced_exports > 0 || erts_is_default_trace_enabled()) { /* tracing involved, fallback with thread blocking */ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); is_blocking = 1; break; } } if (is_blocking) { for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints) { erts_clear_module_break(p[i].modp); ASSERT(p[i].modp->curr.num_breakpoints == 0); } } } exceptions = 0; for (i = 0; i < n; i++) { p[i].exception = 0; if (p[i].modp->curr.code && p[i].modp->old.code) { p[i].exception = 1; exceptions++; } } if (exceptions) { res = exception_list(BIF_P, am_not_purged, p, exceptions); } else { /* * Now we can load all code. This can't fail. */ exceptions = 0; for (i = 0; i < n; i++) { Eterm mod; Eterm retval; erts_refc_inc(&p[i].code->refc, 1); retval = erts_finish_loading(p[i].code, BIF_P, 0, &mod); ASSERT(retval == NIL || retval == am_on_load); if (retval == am_on_load) { p[i].exception = 1; exceptions++; } } /* * Check whether any module has an on_load_handler. */ if (exceptions) { res = exception_list(BIF_P, am_on_load, p, exceptions); } do_commit = 1; } done: return staging_epilogue(BIF_P, do_commit, res, is_blocking, p, n); }
static BIF_RETTYPE do_port_command(Process *BIF_P, Eterm arg1, Eterm arg2, Eterm arg3, Uint32 flags) { BIF_RETTYPE res; Port *p; /* Trace sched out before lock check wait */ if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { trace_virtual_sched(BIF_P, am_out); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { profile_runnable_proc(BIF_P, am_inactive); } p = id_or_name2port(BIF_P, arg1); if (!p) { if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { trace_virtual_sched(BIF_P, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { profile_runnable_proc(BIF_P, am_active); } BIF_ERROR(BIF_P, BADARG); } /* Trace port in, id_or_name2port causes wait */ if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_command); } if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { profile_runnable_port(p, am_active); } ERTS_BIF_PREP_RET(res, am_true); if ((flags & ERTS_PORT_COMMAND_FLAG_FORCE) && !(p->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY)) { ERTS_BIF_PREP_ERROR(res, BIF_P, EXC_NOTSUP); } else if (!(flags & ERTS_PORT_COMMAND_FLAG_FORCE) && p->status & ERTS_PORT_SFLG_PORT_BUSY) { if (flags & ERTS_PORT_COMMAND_FLAG_NOSUSPEND) { ERTS_BIF_PREP_RET(res, am_false); } else { erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, p); if (erts_system_monitor_flags.busy_port) { monitor_generic(BIF_P, am_busy_port, p->id); } ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P, arg1, arg2, arg3); } } else { int wres; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); ERTS_SMP_CHK_NO_PROC_LOCKS; wres = erts_write_to_port(BIF_P->id, p, arg2); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); if (wres != 0) { ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); } } if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_out, am_command); } if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { profile_runnable_port(p, am_inactive); } erts_port_release(p); /* Trace sched in after port release */ if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { trace_virtual_sched(BIF_P, am_in); } if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { profile_runnable_proc(BIF_P, am_active); } if (ERTS_PROC_IS_EXITING(BIF_P)) { KILL_CATCHES(BIF_P); /* Must exit */ ERTS_BIF_PREP_ERROR(res, BIF_P, EXC_ERROR); } return res; }