aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam/erl_bif_info.c
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam/erl_bif_info.c')
-rw-r--r--erts/emulator/beam/erl_bif_info.c263
1 files changed, 188 insertions, 75 deletions
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 70d728340a..729a7c7648 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -122,6 +122,16 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
# define PERFMON_GETPCR _IOR('P', 2, unsigned long long)
#endif
+/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */
+static Eterm os_type_tuple;
+static Eterm os_version_tuple;
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item);
+
+static Eterm
+current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
+static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);
+
static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
{
@@ -557,6 +567,8 @@ static Eterm pi_args[] = {
am_suspending,
am_min_heap_size,
am_min_bin_vheap_size,
+ am_current_location,
+ am_current_stacktrace,
#ifdef HYBRID
am_message_binary
#endif
@@ -605,8 +617,10 @@ pi_arg2ix(Eterm arg)
case am_suspending: return 26;
case am_min_heap_size: return 27;
case am_min_bin_vheap_size: return 28;
+ case am_current_location: return 29;
+ case am_current_stacktrace: return 30;
#ifdef HYBRID
- case am_message_binary: return 29;
+ case am_message_binary: return 31;
#endif
default: return -1;
}
@@ -1009,35 +1023,15 @@ process_info_aux(Process *BIF_P,
break;
case am_current_function:
- if (rp->current == NULL) {
- rp->current = find_function_from_pc(rp->i);
- }
- if (rp->current == NULL) {
- hp = HAlloc(BIF_P, 3);
- res = am_undefined;
- } else {
- BeamInstr* current;
-
- if (rp->current[0] == am_erlang &&
- rp->current[1] == am_process_info &&
- (rp->current[2] == 1 || rp->current[2] == 2) &&
- (current = find_function_from_pc(rp->cp)) != NULL) {
-
- /*
- * The current function is erlang:process_info/2,
- * which is not the answer that the application want.
- * We will use the function pointed into by rp->cp
- * instead.
- */
+ res = current_function(BIF_P, rp, &hp, 0);
+ break;
- rp->current = current;
- }
+ case am_current_location:
+ res = current_function(BIF_P, rp, &hp, 1);
+ break;
- hp = HAlloc(BIF_P, 3+4);
- res = TUPLE3(hp, rp->current[0],
- rp->current[1], make_small(rp->current[2]));
- hp += 4;
- }
+ case am_current_stacktrace:
+ res = current_stacktrace(BIF_P, rp, &hp);
break;
case am_initial_call:
@@ -1611,6 +1605,113 @@ process_info_aux(Process *BIF_P,
}
#undef MI_INC
+static Eterm
+current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
+{
+ Eterm* hp;
+ Eterm res;
+ FunctionInfo fi;
+
+ if (rp->current == NULL) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ rp->current = fi.current;
+ } else if (full_info) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ if (fi.current == NULL) {
+ /* Use the current function without location info */
+ erts_set_current_function(&fi, rp->current);
+ }
+ }
+
+ if (BIF_P->id == rp->id) {
+ FunctionInfo fi2;
+
+ /*
+ * The current function is erlang:process_info/{1,2},
+ * which is not the answer that the application want.
+ * We will use the function pointed into by rp->cp
+ * instead if it can be looked up.
+ */
+ erts_lookup_function_info(&fi2, rp->cp, full_info);
+ if (fi2.current) {
+ fi = fi2;
+ rp->current = fi2.current;
+ }
+ }
+
+ /*
+ * Return the result.
+ */
+ if (rp->current == NULL) {
+ hp = HAlloc(BIF_P, 3);
+ res = am_undefined;
+ } else if (full_info) {
+ hp = HAlloc(BIF_P, 3+fi.needed);
+ hp = erts_build_mfa_item(&fi, hp, am_true, &res);
+ } else {
+ hp = HAlloc(BIF_P, 3+4);
+ res = TUPLE3(hp, rp->current[0],
+ rp->current[1], make_small(rp->current[2]));
+ hp += 4;
+ }
+ *hpp = hp;
+ return res;
+}
+
+static Eterm
+current_stacktrace(Process* p, Process* rp, Eterm** hpp)
+{
+ Uint sz;
+ struct StackTrace* s;
+ int depth;
+ FunctionInfo* stk;
+ FunctionInfo* stkp;
+ Uint heap_size;
+ int i;
+ Eterm* hp = *hpp;
+ Eterm mfa;
+ Eterm res = NIL;
+
+ depth = 8;
+ sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
+ s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
+ s->depth = 0;
+ if (rp->i) {
+ s->trace[s->depth++] = rp->i;
+ depth--;
+ }
+ if (depth > 0 && rp->cp != 0) {
+ s->trace[s->depth++] = rp->cp - 1;
+ depth--;
+ }
+ erts_save_stacktrace(rp, s, depth);
+
+ depth = s->depth;
+ stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
+ depth*sizeof(FunctionInfo));
+ heap_size = 3;
+ for (i = 0; i < depth; i++) {
+ erts_lookup_function_info(stkp, s->trace[i], 1);
+ if (stkp->current) {
+ heap_size += stkp->needed + 2;
+ stkp++;
+ }
+ }
+
+ hp = HAlloc(p, heap_size);
+ while (stkp > stk) {
+ stkp--;
+ hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
+ res = CONS(hp, mfa, res);
+ hp += 2;
+ }
+
+ erts_free(ERTS_ALC_T_TMP, stk);
+ erts_free(ERTS_ALC_T_TMP, s);
+ *hpp = hp;
+ return res;
+}
+
#if defined(VALGRIND)
static int check_if_xml(void)
{
@@ -2027,7 +2128,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_undefined);
#endif
} else if (BIF_ARG_1 == am_trace_control_word) {
- BIF_RET(db_get_trace_control_word_0(BIF_P));
+ BIF_RET(db_get_trace_control_word(BIF_P));
} else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) {
BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false);
} else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) {
@@ -2154,16 +2255,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
return erts_instr_get_type_info(BIF_P);
}
else if (BIF_ARG_1 == am_os_type) {
- Eterm type = am_atom_put(os_type, strlen(os_type));
- Eterm flav, tup;
- char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
-
- os_flavor(buf, 1024);
- flav = am_atom_put(buf, strlen(buf));
- hp = HAlloc(BIF_P, 3);
- tup = TUPLE2(hp, type, flav);
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- BIF_RET(tup);
+ BIF_RET(os_type_tuple);
}
else if (BIF_ARG_1 == am_allocator) {
BIF_RET(erts_allocator_options((void *) BIF_P));
@@ -2189,16 +2281,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_false);
}
else if (BIF_ARG_1 == am_os_version) {
- int major, minor, build;
- Eterm tup;
-
- os_version(&major, &minor, &build);
- hp = HAlloc(BIF_P, 4);
- tup = TUPLE3(hp,
- make_small(major),
- make_small(minor),
- make_small(build));
- BIF_RET(tup);
+ BIF_RET(os_version_tuple);
}
else if (BIF_ARG_1 == am_version) {
int n = strlen(ERLANG_VERSION);
@@ -2646,9 +2729,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-Eterm
-port_info_1(Process* p, Eterm pid)
+BIF_RETTYPE
+port_info_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm pid = BIF_ARG_1;
static Eterm keys[] = {
am_name,
am_links,
@@ -2671,7 +2756,7 @@ port_info_1(Process* p, Eterm pid)
for (i = 0; i < ASIZE(keys); i++) {
Eterm item;
- item = port_info_2(p, pid, keys[i]);
+ item = port_info(p, pid, keys[i]);
if (is_non_value(item)) {
return THE_NON_VALUE;
}
@@ -2680,7 +2765,7 @@ port_info_1(Process* p, Eterm pid)
}
items[i] = item;
}
- reg_name = port_info_2(p, pid, am_registered_name);
+ reg_name = port_info(p, pid, am_registered_name);
/*
* Build the resulting list.
@@ -2716,24 +2801,27 @@ port_info_1(Process* p, Eterm pid)
BIF_RETTYPE port_info_2(BIF_ALIST_2)
{
+ return port_info(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item)
+{
BIF_RETTYPE ret;
- Eterm portid = BIF_ARG_1;
Port *prt;
- Eterm item = BIF_ARG_2;
Eterm res;
Eterm* hp;
int count;
if (is_internal_port(portid))
- prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN);
+ prt = erts_id2port(portid, p, ERTS_PROC_LOCK_MAIN);
else if (is_atom(portid))
- erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN,
+ erts_whereis_name(p, ERTS_PROC_LOCK_MAIN,
portid, NULL, 0, 0, &prt);
else if (is_external_port(portid)
&& external_port_dist_entry(portid) == erts_this_dist_entry)
BIF_RET(am_undefined);
else {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
if (!prt) {
@@ -2741,7 +2829,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
if (item == am_id) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = make_small(internal_port_number(portid));
}
else if (item == am_links) {
@@ -2753,10 +2841,10 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_links(prt->nlinks, &collect_one_link, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
res = CONS(hp, item, res);
hp += 2;
}
@@ -2772,11 +2860,11 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
Eterm t;
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
t = TUPLE2(hp, am_process, item);
hp += 3;
res = CONS(hp, t, res);
@@ -2788,25 +2876,25 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
else if (item == am_name) {
count = sys_strlen(prt->name);
- hp = HAlloc(BIF_P, 3 + 2*count);
+ hp = HAlloc(p, 3 + 2*count);
res = buf_to_intlist(&hp, prt->name, count, NIL);
}
else if (item == am_connected) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = prt->connected; /* internal pid */
}
else if (item == am_input) {
Uint hsz = 3;
Uint n = prt->bytes_in;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_output) {
Uint hsz = 3;
Uint n = prt->bytes_out;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_registered_name) {
@@ -2816,7 +2904,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
ERTS_BIF_PREP_RET(ret, NIL);
goto done;
} else {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = reg->name;
}
}
@@ -2828,7 +2916,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
Uint size = 0;
ErlHeapFragment* bp;
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
erts_doforall_links(prt->nlinks, &one_link_size, &size);
@@ -2845,18 +2933,18 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
hard to retrieve... */
(void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, size);
}
else if (item == am_queue_size) {
Uint ioq_size = erts_port_ioq_size(prt);
Uint hsz = 3;
(void) erts_bld_uint(NULL, &hsz, ioq_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, ioq_size);
}
else if (ERTS_IS_ATOM_STR("locking", item)) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
#ifndef ERTS_SMP
res = am_false;
#else
@@ -2875,7 +2963,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
#endif
}
else {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(ret, p, BADARG);
goto done;
}
@@ -2889,9 +2977,12 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
-Eterm
-fun_info_2(Process* p, Eterm fun, Eterm what)
+BIF_RETTYPE
+fun_info_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+ Eterm what = BIF_ARG_2;
Eterm* hp;
Eterm val;
@@ -4041,6 +4132,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+static void os_info_init(void)
+{
+ Eterm type = am_atom_put(os_type, strlen(os_type));
+ Eterm flav;
+ int major, minor, build;
+ char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
+ Eterm* hp;
+
+ os_flavor(buf, 1024);
+ flav = am_atom_put(buf, strlen(buf));
+ erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm));
+ os_type_tuple = TUPLE2(hp, type, flav);
+ hp += 3;
+ os_version(&major, &minor, &build);
+ os_version_tuple = TUPLE3(hp,
+ make_small(major),
+ make_small(minor),
+ make_small(build));
+}
+
void
erts_bif_info_init(void)
{
@@ -4050,4 +4162,5 @@ erts_bif_info_init(void)
alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1);
alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1);
process_info_init();
+ os_info_init();
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 03:08:58 +0000