BIF_RETTYPE erts_debug_get_internal_state_1()

in erts/emulator/beam/erl_bif_info.c [3903:4437]


BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
{
    /*
     * NOTE: Only supposed to be used for testing, and debugging.
     */

    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)) {
	    /* Used by (emulator) */
	    BIF_RET(make_small((Uint) ERTS_BIF_REDS_LEFT(BIF_P)));
	}
	else if (ERTS_IS_ATOM_STR("node_and_dist_references", BIF_ARG_1)) {
	    /* Used by node_container_SUITE (emulator) */
            BIF_TRAP1(get_internal_state_blocked, BIF_P, BIF_ARG_1);
	}
	else if (ERTS_IS_ATOM_STR("monitoring_nodes", BIF_ARG_1)) {
	    BIF_RET(erts_processes_monitoring_nodes(BIF_P));
	}
	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) */
	    Sint res;
	    if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1))
		res = erts_ptab_test_next_id(&erts_proc, 0, 0);
	    else
		res = erts_ptab_test_next_id(&erts_port, 0, 0);
	    if (res < 0)
		BIF_RET(am_false);
	    BIF_RET(erts_make_integer(res, BIF_P));
	}
	else if (ERTS_IS_ATOM_STR("DbTable_words", BIF_ARG_1)) {
	    /* Used by ets_SUITE (stdlib) */
	    size_t words = (sizeof(DbTable) + sizeof(Uint) - 1)/sizeof(Uint);
            Eterm* hp = HAlloc(BIF_P ,3);
	    BIF_RET(TUPLE2(hp, make_small((Uint) words),
                           erts_ets_hash_sizeof_ext_segtab()));
	}
	else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) {
	    /* Used by driver_SUITE (emulator) */
	    Uint sz, *szp;
	    Eterm res, *hp, **hpp;
	    int no_errors;
	    ErtsCheckIoDebugInfo ciodi = {0};
#ifdef HAVE_ERTS_CHECK_IO_DEBUG
	    erts_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN);
	    no_errors = erts_check_io_debug(&ciodi);
	    erts_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN);
#else
	    no_errors = 0;
#endif
	    sz = 0;
	    szp = &sz;
	    hpp = NULL;
	    while (1) {
		res = erts_bld_tuple(hpp, szp, 4,
				     erts_bld_uint(hpp, szp,
						   (Uint) no_errors),
				     erts_bld_uint(hpp, szp,
						   (Uint) ciodi.no_used_fds),
				     erts_bld_uint(hpp, szp,
						   (Uint) ciodi.no_driver_select_structs),
                                     erts_bld_uint(hpp, szp,
                                                   (Uint) ciodi.no_enif_select_structs));
		if (hpp)
		    break;
		hp = HAlloc(BIF_P, sz);
		szp = NULL;
		hpp = &hp;
	    }
	    BIF_RET(res);
	}
	else if (ERTS_IS_ATOM_STR("process_info_args", BIF_ARG_1)) {
	    /* Used by process_SUITE (emulator) */
	    int i;
	    Eterm res = NIL;
	    Uint *hp = HAlloc(BIF_P, 2*ERTS_PI_ARGS);
	    for (i = ERTS_PI_ARGS-1; i >= 0; i--) {
		res = CONS(hp, pi_args[i].name, res);
		hp += 2;
	    }
	    BIF_RET(res);
	}
	else if (ERTS_IS_ATOM_STR("processes", BIF_ARG_1)) {
	    /* Used by process_SUITE (emulator) */
	    BIF_RET(erts_debug_ptab_list(BIF_P, &erts_proc));
	}
	else if (ERTS_IS_ATOM_STR("processes_bif_info", BIF_ARG_1)) {
	    /* Used by process_SUITE (emulator) */
	    BIF_RET(erts_debug_ptab_list_bif_info(BIF_P, &erts_proc));
	}
	else if (ERTS_IS_ATOM_STR("max_atom_out_cache_index", BIF_ARG_1)) {
	    /* Used by distribution_SUITE (emulator) */
	    BIF_RET(make_small((Uint) erts_debug_max_atom_out_cache_index()));
	}
	else if (ERTS_IS_ATOM_STR("nbalance", BIF_ARG_1)) {
	    Uint n;
	    erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
	    n = erts_debug_nbalance();
	    erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
	    BIF_RET(erts_make_integer(n, BIF_P));
	}
	else if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)) {
	    BIF_RET(am_true);
	}
	else if (ERTS_IS_ATOM_STR("force_heap_frags", BIF_ARG_1)) {
#ifdef FORCE_HEAP_FRAGS
	    BIF_RET(am_true);
#else
	    BIF_RET(am_false);
#endif
	}
	else if (ERTS_IS_ATOM_STR("memory", BIF_ARG_1)) {
	    Eterm res;
	    erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
	    erts_thr_progress_block();
	    erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
	    res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE);
	    erts_thr_progress_unblock();
	    BIF_RET(res);
	}
        else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
            BIF_RET(erts_mmap_debug_info(BIF_P));
        }
	else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
	    BIF_RET(erts_debug_get_unique_monotonic_integer_state(BIF_P));
	}
	else if (ERTS_IS_ATOM_STR("min_unique_monotonic_integer", BIF_ARG_1)) {
	    Sint64 value = erts_get_min_unique_monotonic_integer();
	    if (IS_SSMALL(value))
		BIF_RET(make_small(value));
	    else {
		Uint hsz = ERTS_SINT64_HEAP_SIZE(value);
		Eterm *hp = HAlloc(BIF_P, hsz);
		BIF_RET(erts_sint64_to_big(value, &hp));
	    }
	}
	else if (ERTS_IS_ATOM_STR("min_unique_integer", BIF_ARG_1)) {
	    Sint64 value = erts_get_min_unique_integer();
	    if (IS_SSMALL(value))
		BIF_RET(make_small(value));
	    else {
		Uint hsz = ERTS_SINT64_HEAP_SIZE(value);
		Eterm *hp = HAlloc(BIF_P, hsz);
		BIF_RET(erts_sint64_to_big(value, &hp));
	    }
	}
        else if (ERTS_IS_ATOM_STR("stack_check", BIF_ARG_1)) {
            UWord size;
            char c;
            if (erts_is_above_stack_limit(&c))
                size = erts_check_stack_recursion_downwards(&c);
            else
                size = erts_check_stack_recursion_upwards(&c);
	    if (IS_SSMALL(size))
		BIF_RET(make_small(size));
	    else {
		Uint hsz = BIG_UWORD_HEAP_SIZE(size);
		Eterm *hp = HAlloc(BIF_P, hsz);
		BIF_RET(uword_to_big(size, hp));
	    }
        } else if (ERTS_IS_ATOM_STR("scheduler_dump", BIF_ARG_1)) {
#if defined(ERTS_HAVE_TRY_CATCH) && defined(ERTS_SYS_SUSPEND_SIGNAL)
            BIF_RET(am_true);
#else
            BIF_RET(am_false);
#endif
        }
        else if (ERTS_IS_ATOM_STR("lc_graph", BIF_ARG_1)) {
#ifdef ERTS_ENABLE_LOCK_CHECK
            Eterm res = erts_lc_dump_graph();
            BIF_RET(res);
#else
            BIF_RET(am_notsup);
#endif
        }
        else if (ERTS_IS_ATOM_STR("flxctr_memory_usage", BIF_ARG_1)) {
            Sint mem = erts_flxctr_debug_memory_usage();
            if (mem == -1) {
                BIF_RET(am_notsup);
            } else {
		Uint hsz = BIG_UWORD_HEAP_SIZE((UWord)mem);
		Eterm *hp = HAlloc(BIF_P, hsz);
		BIF_RET(uword_to_big((UWord)mem, hp));
            }
        }
        else if (ERTS_IS_ATOM_STR("persistent_term", BIF_ARG_1)) {
            BIF_RET(erts_debug_persistent_term_xtra_info(BIF_P));
        }
    }
    else if (is_tuple(BIF_ARG_1)) {
	Eterm* tp = tuple_val(BIF_ARG_1);
	switch (arityval(tp[0])) {
	case 2: {
	    if (ERTS_IS_ATOM_STR("node_and_dist_references", tp[1])) {
                if (tp[2] == am_blocked
                    && erts_is_multi_scheduling_blocked() > 0) {
                    Eterm res = erts_get_node_and_dist_references(BIF_P);
                    BIF_RET(res);
                }
            }
	    else if (ERTS_IS_ATOM_STR("process_status", tp[1])) {
		/* Used by timer process_SUITE, timer_bif_SUITE, and
		   node_container_SUITE (emulator) */
		if (is_internal_pid(tp[2])) {
		    BIF_RET(erts_process_status(NULL, tp[2]));
		}
	    }
            else if (ERTS_IS_ATOM_STR("connection_id", tp[1])) {
                DistEntry *dep;
                Eterm *hp, res;
                Uint con_id, hsz = 0;
                if (!is_atom(tp[2]))
                    BIF_ERROR(BIF_P, BADARG);
                dep = erts_sysname_to_connected_dist_entry(tp[2]);
                if (!dep)
                    BIF_ERROR(BIF_P, BADARG);
                erts_de_rlock(dep);
                con_id = (Uint) dep->connection_id;
                erts_de_runlock(dep);
                (void) erts_bld_uint(NULL, &hsz, con_id);
                hp = hsz ? HAlloc(BIF_P, hsz) : NULL;
                res = erts_bld_uint(&hp, NULL, con_id);
                BIF_RET(res);
            }
	    else if (ERTS_IS_ATOM_STR("link_list", tp[1])) {
		/* Used by erl_link_SUITE (emulator) */
		if(is_internal_pid(tp[2])) {
                    erts_aint32_t state;
		    Eterm res;
		    Process *p;
                    int sigs_done;

		    p = erts_pid2proc(BIF_P,
				      ERTS_PROC_LOCK_MAIN,
				      tp[2],
				      ERTS_PROC_LOCK_MAIN);
		    if (!p) {
			ERTS_ASSERT_IS_NOT_EXITING(BIF_P);
			BIF_RET(am_undefined);
		    }
                    
                    erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
                    erts_proc_sig_fetch(p);
                    erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
                    do {
                        int reds = CONTEXT_REDS;
                        sigs_done = erts_proc_sig_handle_incoming(p,
                                                                  &state,
                                                                  &reds,
                                                                  CONTEXT_REDS,
                                                                  !0);
                    } while (!sigs_done && !(state & ERTS_PSFLG_EXITING));

                    if (!(state & ERTS_PSFLG_EXITING))
                        res = make_link_list(BIF_P, 1, ERTS_P_LINKS(p), NIL);
                    else if (BIF_P == p)
                        ERTS_BIF_EXITED(BIF_P);
                    else
                        res = am_undefined;
                    if (BIF_P != p)
                        erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
		    BIF_RET(res);
		}
		else if(is_internal_port(tp[2])) {
		    Eterm res;
		    Port *p = erts_id2port_sflgs(tp[2],
						 BIF_P,
						 ERTS_PROC_LOCK_MAIN,
						 ERTS_PORT_SFLGS_INVALID_LOOKUP);
		    if(!p)
			BIF_RET(am_undefined);
		    res = make_link_list(BIF_P, 1, ERTS_P_LINKS(p), NIL);
		    erts_port_release(p);
		    BIF_RET(res);
		}
		else if(is_node_name_atom(tp[2])) {
		    DistEntry *dep = erts_find_dist_entry(tp[2]);
		    if(dep) {
			Eterm res = NIL;
                        if (dep->mld) {
                            erts_mtx_lock(&dep->mld->mtx);
                            res = make_link_list(BIF_P, 0, dep->mld->links, NIL);
                            erts_mtx_unlock(&dep->mld->mtx);
                        }
			BIF_RET(res);
		    } else {
			BIF_RET(am_undefined);
		    }
		}
	    }
	    else if (ERTS_IS_ATOM_STR("monitor_list", tp[1])) {
		/* Used by erl_link_SUITE (emulator) */
		if(is_internal_pid(tp[2])) {
                    erts_aint32_t state;
		    Process *p;
		    Eterm res;
                    int sigs_done;

		    p = erts_pid2proc(BIF_P,
				      ERTS_PROC_LOCK_MAIN,
				      tp[2],
				      ERTS_PROC_LOCK_MAIN);
		    if (!p) {
			ERTS_ASSERT_IS_NOT_EXITING(BIF_P);
			BIF_RET(am_undefined);
		    }
                    
                    erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
                    erts_proc_sig_fetch(p);
                    erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
                    do {
                        int reds = CONTEXT_REDS;
                        sigs_done = erts_proc_sig_handle_incoming(p,
                                                                  &state,
                                                                  &reds,
                                                                  CONTEXT_REDS,
                                                                  !0);
                    } while (!sigs_done && !(state & ERTS_PSFLG_EXITING));

                    if (!(state & ERTS_PSFLG_EXITING)) {
                        res = make_monitor_list(BIF_P, 1, ERTS_P_MONITORS(p), NIL);
                        res = make_monitor_list(BIF_P, 0, ERTS_P_LT_MONITORS(p), res);
                    }
                    else {
                        if (BIF_P == p)
                            ERTS_BIF_EXITED(BIF_P);
                        else
                            res = am_undefined;
                    }
                    if (BIF_P != p)
                        erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
		    BIF_RET(res);
		} else if(is_node_name_atom(tp[2])) {
		    DistEntry *dep = erts_find_dist_entry(tp[2]);
		    if(dep) {
			Eterm ml = NIL;
                        if (dep->mld) {
                            erts_mtx_lock(&dep->mld->mtx);
                            ml = make_monitor_list(BIF_P, 1, dep->mld->orig_name_monitors, NIL);
                            ml = make_monitor_list(BIF_P, 0, dep->mld->monitors, ml);
                            erts_mtx_unlock(&dep->mld->mtx);
                        }
			BIF_RET(ml);
		    } else {
			BIF_RET(am_undefined);
		    }
		}
	    }
	    else if (ERTS_IS_ATOM_STR("channel_number", tp[1])) {
		Eterm res;
		DistEntry *dep = erts_find_dist_entry(tp[2]);
		if (!dep)
		    res = am_undefined;
		else {
		    Uint cno = dist_entry_channel_no(dep);
		    res = make_small(cno);
		}
		BIF_RET(res);
	    }
	    else if (ERTS_IS_ATOM_STR("binary_info", tp[1])) {
		Eterm bin = tp[2];
		if (is_binary(bin)) {
		    Eterm real_bin = bin;
		    Eterm res = am_true;
		    ErlSubBin* sb = (ErlSubBin *) binary_val(real_bin);

		    if (sb->thing_word == HEADER_SUB_BIN) {
			real_bin = sb->orig;
		    }
		    if (*binary_val(real_bin) == HEADER_PROC_BIN) {
			ProcBin* pb;
			Binary* val;
			Eterm SzTerm;
			Uint hsz = 3 + 5;
			Eterm* hp;
			DECL_AM(refc_binary);

			pb = (ProcBin *) binary_val(real_bin);
			val = pb->val;
			(void) erts_bld_uint(NULL, &hsz, pb->size);
			(void) erts_bld_uint(NULL, &hsz, val->orig_size);
			hp = HAlloc(BIF_P, hsz);

			/* Info about the Binary* object */
			SzTerm = erts_bld_uint(&hp, NULL, val->orig_size);
			res = TUPLE2(hp, am_binary, SzTerm);
			hp += 3;

			/* Info about the ProcBin* object */
			SzTerm = erts_bld_uint(&hp, NULL, pb->size);
			res = TUPLE4(hp, AM_refc_binary, SzTerm,
				     res, make_small(pb->flags));
		    } else {	/* heap binary */
			DECL_AM(heap_binary);
			res = AM_heap_binary;
		    }
		    BIF_RET(res);
		}
	    }
	    else if (ERTS_IS_ATOM_STR("term_to_binary_tuple_fallbacks", tp[1])) {
		Uint64 dflags = (TERM_TO_BINARY_DFLAGS
                                 & ~DFLAG_EXPORT_PTR_TAG
                                 & ~DFLAG_BIT_BINARIES);
		Eterm res = erts_term_to_binary(BIF_P, tp[2], 0, dflags);
                if (is_value(res))
                    BIF_RET(res);
                BIF_ERROR(BIF_P, SYSTEM_LIMIT);
	    }
	    else if (ERTS_IS_ATOM_STR("dist_ctrl", tp[1])) {
		Eterm res = am_undefined;
		DistEntry *dep = erts_sysname_to_connected_dist_entry(tp[2]);
		if (dep) {
		    erts_de_rlock(dep);
		    if (is_internal_port(dep->cid) || is_internal_pid(dep->cid))
			res = dep->cid;
		    erts_de_runlock(dep);
		}
		BIF_RET(res);
	    }
	    else if (ERTS_IS_ATOM_STR("atom_out_cache_index", tp[1])) {
		/* Used by distribution_SUITE (emulator) */
		if (is_atom(tp[2])) {
		    BIF_RET(make_small(
				(Uint)
				erts_debug_atom_to_out_cache_index(tp[2])));
		}
	    }
	    else if (ERTS_IS_ATOM_STR("fake_scheduler_bindings", tp[1])) {
		return erts_fake_scheduler_bindings(BIF_P, tp[2]);
	    }
	    else if (ERTS_IS_ATOM_STR("reader_groups_map", tp[1])) {
		Sint groups;
		if (is_not_small(tp[2]))
		    BIF_ERROR(BIF_P, BADARG);
		groups = signed_val(tp[2]);
		if (groups < (Sint) 1 || groups > (Sint) INT_MAX)
		    BIF_ERROR(BIF_P, BADARG);

		BIF_RET(erts_debug_reader_groups_map(BIF_P, (int) groups));
	    }
	    else if (ERTS_IS_ATOM_STR("internal_hash", tp[1])) {
		Uint hash = (Uint) make_internal_hash(tp[2], 0);
		Uint hsz = 0;
		Eterm* hp;
		erts_bld_uint(NULL, &hsz, hash);
		hp = HAlloc(BIF_P,hsz);
		return erts_bld_uint(&hp, NULL, hash);
	    }
	    else if (ERTS_IS_ATOM_STR("atom", tp[1])) {
		Uint ix;
		if (!term_to_Uint(tp[2], &ix))
		    BIF_ERROR(BIF_P, BADARG);
		while (ix >= atom_table_size()) {
		    char tmp[20];
		    erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size());
		    erts_atom_put((byte *) tmp, sys_strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
		}
		return make_atom(ix);
	    }
	    else if (ERTS_IS_ATOM_STR("magic_ref", tp[1])) {
                Binary *bin;
                UWord bin_addr, refc;
                Eterm bin_addr_term, refc_term, test_type;
                Uint sz;
                Eterm *hp;
                if (!is_internal_magic_ref(tp[2])) {
                    if (is_internal_ordinary_ref(tp[2])) {
                        ErtsORefThing *rtp;
                        rtp = (ErtsORefThing *) internal_ref_val(tp[2]);
                        if (erts_is_ref_numbers_magic(rtp->num))
                            BIF_RET(am_true);
                    }
                    BIF_RET(am_false);
                }
                bin = erts_magic_ref2bin(tp[2]);
                refc = erts_refc_read(&bin->intern.refc, 1);
                bin_addr = (UWord) bin;
                sz = 4;
                erts_bld_uword(NULL, &sz, bin_addr);
                erts_bld_uword(NULL, &sz, refc);
                hp = HAlloc(BIF_P, sz);
                bin_addr_term = erts_bld_uword(&hp, NULL, bin_addr);
                refc_term = erts_bld_uword(&hp, NULL, refc);
                test_type = (ERTS_MAGIC_BIN_DESTRUCTOR(bin) == empty_magic_ref_destructor
                             ? am_true : am_false);
                BIF_RET(TUPLE3(hp, bin_addr_term, refc_term, test_type));
	    }

	    break;
	}
	case 3: {
	    if (ERTS_IS_ATOM_STR("check_time_config", tp[1])) {
		int res, time_correction;
		ErtsTimeWarpMode time_warp_mode;
		if (tp[2] == am_true)
		    time_correction = !0;
		else if (tp[2] == am_false)
		    time_correction = 0;
		else
		    break;
		if (ERTS_IS_ATOM_STR("no_time_warp", tp[3]))
		    time_warp_mode = ERTS_NO_TIME_WARP_MODE;
		else if (ERTS_IS_ATOM_STR("single_time_warp", tp[3]))
		    time_warp_mode = ERTS_SINGLE_TIME_WARP_MODE;
		else if (ERTS_IS_ATOM_STR("multi_time_warp", tp[3]))
		    time_warp_mode = ERTS_MULTI_TIME_WARP_MODE;
		else
		    break;
		res = erts_check_time_adj_support(time_correction,
						  time_warp_mode);
		BIF_RET(res ? am_true : am_false);
	    }
	    else if (ERTS_IS_ATOM_STR("make_unique_integer", tp[1])) {
	      Eterm res = erts_debug_make_unique_integer(BIF_P,
							 tp[2],
							 tp[3]);
	      if (is_non_value(res))
		  break;
	      BIF_RET(res);
	    }
            else if (ERTS_IS_ATOM_STR("term_to_binary", tp[1])) {
                return erts_debug_term_to_binary(BIF_P, tp[2], tp[3]);
            }
	    break;
	}
	default:
	    break;
	}
    }
    BIF_ERROR(BIF_P, BADARG);
}