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