in erts/emulator/beam/erl_bif_info.c [4485:4869]
BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
{
/*
* NOTE: Only supposed to be used for testing, and debugging.
*/
if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)
&& (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false)) {
erts_aint_t on = (erts_aint_t) (BIF_ARG_2 == am_true);
erts_aint_t prev_on = erts_atomic_xchg_nob(&available_internal_state, on);
if (on) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp, "Process %T ", BIF_P->common.id);
if (erts_is_alive)
erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname);
erts_dsprintf(dsbufp,
"enabled access to the emulator internal state.\n");
erts_dsprintf(dsbufp,
"NOTE: This is an erts internal test feature and "
"should *only* be used by OTP test-suites.\n");
erts_send_warning_to_logger(BIF_P->group_leader, dsbufp);
}
BIF_RET(prev_on ? am_true : am_false);
}
if (!erts_atomic_read_nob(&available_internal_state)) {
BIF_ERROR(BIF_P, EXC_UNDEF);
}
if (is_atom(BIF_ARG_1)) {
if (ERTS_IS_ATOM_STR("reds_left", BIF_ARG_1)) {
Sint reds;
if (term_to_Sint(BIF_ARG_2, &reds) != 0) {
if (0 <= reds && reds <= CONTEXT_REDS) {
if (!ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P))
BIF_P->fcalls = reds;
else
BIF_P->fcalls = reds - CONTEXT_REDS;
BIF_P->scheduler_data->virtual_reds = 0;
}
BIF_RET(am_true);
}
}
else if (ERTS_IS_ATOM_STR("block", BIF_ARG_1)
|| ERTS_IS_ATOM_STR("sleep", BIF_ARG_1)) {
int block = ERTS_IS_ATOM_STR("block", BIF_ARG_1);
Sint ms;
if (term_to_Sint(BIF_ARG_2, &ms) != 0) {
if (ms > 0) {
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (block)
erts_thr_progress_block();
while (erts_milli_sleep((long) ms) != 0);
if (block)
erts_thr_progress_unblock();
erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
}
else if (ERTS_IS_ATOM_STR("block_scheduler", BIF_ARG_1)) {
Sint ms;
if (term_to_Sint(BIF_ARG_2, &ms) != 0) {
if (ms > 0) {
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
while (erts_milli_sleep((long) ms) != 0);
erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
}
else if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1)
|| ERTS_IS_ATOM_STR("next_port", BIF_ARG_1)) {
/* Used by node_container_SUITE (emulator) */
Uint next;
if (term_to_Uint(BIF_ARG_2, &next) != 0) {
Sint res;
if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1))
res = erts_ptab_test_next_id(&erts_proc, 1, next);
else
res = erts_ptab_test_next_id(&erts_port, 1, next);
if (res < 0)
BIF_RET(am_false);
BIF_RET(erts_make_integer(res, BIF_P));
}
}
else if (ERTS_IS_ATOM_STR("force_gc", BIF_ARG_1)) {
/* Used by signal_SUITE (emulator) */
Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
BIF_ARG_2, ERTS_PROC_LOCK_MAIN);
if (!rp) {
BIF_RET(am_false);
}
else {
ERTS_FORCE_GC(BIF_P);
BIF_RET(am_true);
}
}
else if (ERTS_IS_ATOM_STR("gc_state", BIF_ARG_1)) {
/* Used by process_SUITE (emulator) */
int res, enable;
switch (BIF_ARG_2) {
case am_true: enable = 1; break;
case am_false: enable = 0; break;
default: BIF_ERROR(BIF_P, BADARG); break;
}
res = (BIF_P->flags & F_DISABLE_GC) ? am_false : am_true;
erts_set_gc_state(BIF_P, enable);
BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("inconsistent_heap", BIF_ARG_1)) {
/* Used by code_SUITE (emulator) */
if (am_start == BIF_ARG_2) {
Eterm broken_term;
Eterm *hp;
ERTS_ASSERT(!(BIF_P->flags & F_DISABLE_GC));
erts_set_gc_state(BIF_P, 0);
hp = HAlloc(BIF_P, 2);
hp[0] = make_arityval(1234);
hp[1] = THE_NON_VALUE;
broken_term = make_tuple(hp);
BIF_RET(broken_term);
} else {
Eterm broken_term;
Eterm *hp;
broken_term = BIF_ARG_2;
hp = tuple_val(broken_term);
ERTS_ASSERT(hp[0] == make_arityval(1234));
ERTS_ASSERT(hp[1] == THE_NON_VALUE);
hp[0] = make_arityval(1);
hp[1] = am_ok;
ERTS_ASSERT(BIF_P->flags & F_DISABLE_GC);
erts_set_gc_state(BIF_P, 1);
BIF_RET(am_ok);
}
}
else if (ERTS_IS_ATOM_STR("colliding_names", BIF_ARG_1)) {
/* Used by ets_SUITE (stdlib) */
if (is_tuple(BIF_ARG_2)) {
Eterm* tpl = tuple_val(BIF_ARG_2);
Uint cnt;
if (arityval(tpl[0]) == 2 && is_atom(tpl[1]) &&
term_to_Uint(tpl[2], &cnt)) {
BIF_RET(erts_ets_colliding_names(BIF_P,tpl[1],cnt));
}
}
}
else if (ERTS_IS_ATOM_STR("binary_loop_limit", BIF_ARG_1)) {
/* Used by binary_module_SUITE (stdlib) */
Uint max_loops;
if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) {
max_loops = erts_binary_set_loop_limit(-1);
BIF_RET(make_small(max_loops));
} else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) {
max_loops = erts_binary_set_loop_limit(max_loops);
BIF_RET(make_small(max_loops));
}
}
else if (ERTS_IS_ATOM_STR("re_loop_limit", BIF_ARG_1)) {
/* Used by re_SUITE (stdlib) */
Uint max_loops;
if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) {
max_loops = erts_re_set_loop_limit(-1);
BIF_RET(make_small(max_loops));
} else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) {
max_loops = erts_re_set_loop_limit(max_loops);
BIF_RET(make_small(max_loops));
}
}
else if (ERTS_IS_ATOM_STR("unicode_loop_limit", BIF_ARG_1)) {
/* Used by unicode_SUITE (stdlib) */
Uint max_loops;
if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) {
max_loops = erts_unicode_set_loop_limit(-1);
BIF_RET(make_small(max_loops));
} else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) {
max_loops = erts_unicode_set_loop_limit(max_loops);
BIF_RET(make_small(max_loops));
}
}
else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_suspend", BIF_ARG_1)) {
/* Used by hipe test suites */
erts_aint_t flag = erts_atomic_read_nob(&hipe_test_reschedule_flag);
if (!flag && BIF_ARG_2 != am_false) {
erts_atomic_set_nob(&hipe_test_reschedule_flag, 1);
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD2(BIF_TRAP_EXPORT(BIF_erts_debug_set_internal_state_2),
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
erts_atomic_set_nob(&hipe_test_reschedule_flag, !flag);
BIF_RET(NIL);
}
else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_resume", BIF_ARG_1)) {
/* Used by hipe test suites */
Eterm res = am_false;
Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
BIF_ARG_2, ERTS_PROC_LOCK_STATUS);
if (rp) {
erts_resume(rp, ERTS_PROC_LOCK_STATUS);
res = am_true;
erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
}
BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("test_long_gc_sleep", BIF_ARG_1)) {
if (term_to_Uint(BIF_ARG_2, &erts_test_long_gc_sleep) > 0)
BIF_RET(am_true);
}
else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
erts_exit(ERTS_ABORT_EXIT, "%T\n", BIF_ARG_2);
}
else if (ERTS_IS_ATOM_STR("kill_dist_connection", BIF_ARG_1)) {
DistEntry *dep = erts_sysname_to_connected_dist_entry(BIF_ARG_2);
if (!dep)
BIF_RET(am_false);
else {
Uint32 con_id;
erts_de_rlock(dep);
con_id = dep->connection_id;
erts_de_runlock(dep);
erts_kill_dist_connection(dep, con_id);
BIF_RET(am_true);
}
}
else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) {
int flag = 0;
if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2))
flag = ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS;
else if (ERTS_IS_ATOM_STR("timer_cancellations", BIF_ARG_2))
flag = ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS;
else if (ERTS_IS_ATOM_STR("aux_work", BIF_ARG_2))
flag = ERTS_DEBUG_WAIT_COMPLETED_AUX_WORK;
else if (ERTS_IS_ATOM_STR("thread_progress", BIF_ARG_2))
flag = ERTS_DEBUG_WAIT_COMPLETED_THREAD_PROGRESS;
if (flag) {
if (erts_debug_wait_completed(BIF_P, flag))
ERTS_BIF_YIELD_RETURN(BIF_P, am_ok);
else
BIF_ERROR(BIF_P, SYSTEM_LIMIT);
}
}
else if (ERTS_IS_ATOM_STR("broken_halt", BIF_ARG_1)) {
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
broken_halt_test(BIF_ARG_2);
}
else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
int res = erts_debug_set_unique_monotonic_integer_state(BIF_ARG_2);
BIF_RET(res ? am_true : am_false);
}
else if (ERTS_IS_ATOM_STR("node_tab_delayed_delete", BIF_ARG_1)) {
/* node_container_SUITE */
Sint64 msecs;
if (term_to_Sint64(BIF_ARG_2, &msecs)) {
/* Negative value restore original value... */
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_debug_test_node_tab_delayed_delete(msecs);
erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_ok);
}
}
else if (ERTS_IS_ATOM_STR("fill_heap", BIF_ARG_1)) {
UWord left = HeapWordsLeft(BIF_P);
if (left > 1) {
Eterm* hp = HAlloc(BIF_P, left);
*hp = make_pos_bignum_header(left - 1);
}
if (BIF_ARG_2 == am_true) {
FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
}
BIF_RET(am_ok);
}
else if (ERTS_IS_ATOM_STR("make", BIF_ARG_1)) {
if (ERTS_IS_ATOM_STR("magic_ref", BIF_ARG_2)) {
Binary *bin = erts_create_magic_binary(0, empty_magic_ref_destructor);
UWord bin_addr = (UWord) bin;
Eterm bin_addr_term, magic_ref, res;
Eterm *hp;
Uint sz = ERTS_MAGIC_REF_THING_SIZE + 3;
erts_bld_uword(NULL, &sz, bin_addr);
hp = HAlloc(BIF_P, sz);
bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr);
magic_ref = erts_mk_magic_ref(&hp, &BIF_P->off_heap, bin);
res = TUPLE2(hp, magic_ref, bin_addr_term);
BIF_RET(res);
}
}
else if (ERTS_IS_ATOM_STR("binary", BIF_ARG_1)) {
Sint64 size;
if (term_to_Sint64(BIF_ARG_2, &size)) {
Binary* refbin = erts_bin_drv_alloc_fnf(size);
if (!refbin)
BIF_RET(am_false);
sys_memset(refbin->orig_bytes, 0, size);
BIF_RET(erts_build_proc_bin(&MSO(BIF_P),
HAlloc(BIF_P, PROC_BIN_SIZE),
refbin));
}
}
else if (ERTS_IS_ATOM_STR("ets_force_trap", BIF_ARG_1)) {
#ifdef ETS_DBG_FORCE_TRAP
erts_ets_dbg_force_trap = (BIF_ARG_2 == am_true) ? 1 : 0;
BIF_RET(am_ok);
#else
BIF_RET(am_notsup);
#endif
}
else if (ERTS_IS_ATOM_STR("ets_force_split", BIF_ARG_1)) {
if (is_tuple(BIF_ARG_2)) {
Eterm* tpl = tuple_val(BIF_ARG_2);
if (erts_ets_force_split(tpl[1], tpl[2] == am_true))
BIF_RET(am_ok);
}
}
else if (ERTS_IS_ATOM_STR("ets_debug_random_split_join", BIF_ARG_1)) {
if (is_tuple(BIF_ARG_2)) {
Eterm* tpl = tuple_val(BIF_ARG_2);
if (erts_ets_debug_random_split_join(tpl[1], tpl[2] == am_true))
BIF_RET(am_ok);
}
}
else if (ERTS_IS_ATOM_STR("mbuf", BIF_ARG_1)) {
Uint sz = size_object(BIF_ARG_2);
ErlHeapFragment* frag = new_message_buffer(sz);
Eterm *hp = frag->mem;
Eterm copy = copy_struct(BIF_ARG_2, sz, &hp, &frag->off_heap);
frag->next = BIF_P->mbuf;
BIF_P->mbuf = frag;
BIF_P->mbuf_sz += sz;
BIF_RET(copy);
}
else if (ERTS_IS_ATOM_STR("remove_hopefull_dflags", BIF_ARG_1)) {
int old_val, new_val;
switch (BIF_ARG_2) {
case am_true: new_val = !0; break;
case am_false: new_val = 0; break;
default: BIF_ERROR(BIF_P, BADARG); break;
}
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_thr_progress_block();
old_val = erts_dflags_test_remove_hopefull_flags;
erts_dflags_test_remove_hopefull_flags = new_val;
erts_thr_progress_unblock();
erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(old_val ? am_true : am_false);
}
else if (ERTS_IS_ATOM_STR("code_write_permission", BIF_ARG_1)) {
/*
* Warning: This is a unsafe way of seizing the "lock"
* as there is no automatic unlock if caller terminates.
*/
switch(BIF_ARG_2) {
case am_true:
if (!erts_try_seize_code_write_permission(BIF_P)) {
ERTS_BIF_YIELD2(BIF_TRAP_EXPORT(BIF_erts_debug_set_internal_state_2),
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
BIF_RET(am_true);
case am_false:
erts_release_code_write_permission();
BIF_RET(am_true);
}
}
}
BIF_ERROR(BIF_P, BADARG);
}