/* * %CopyrightBegin% * * Copyright Ericsson AB 1999-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, software * distributed under the License is distributed on an "AS IS" BASIS, * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. * * %CopyrightEnd% */ #ifdef HAVE_CONFIG_H # include "config.h" #endif #define ERTS_WANT_MEM_MAPPERS #include "sys.h" #include "erl_vm.h" #include "global.h" #include "erl_process.h" #include "error.h" #include "erl_driver.h" #include "erl_nif.h" #include "bif.h" #include "big.h" #include "erl_version.h" #include "erl_compile_flags.h" #include "erl_db_util.h" #include "erl_message.h" #include "erl_binary.h" #include "erl_db.h" #include "erl_mtrace.h" #include "dist.h" #include "erl_gc.h" #include "erl_cpu_topology.h" #include "erl_async.h" #include "erl_thr_progress.h" #include "erl_bif_unique.h" #include "erl_map.h" #include "erl_check_io.h" #define ERTS_PTAB_WANT_DEBUG_FUNCS__ #include "erl_ptab.h" #include "erl_time.h" #include "erl_proc_sig_queue.h" #include "erl_alloc_util.h" #ifdef HIPE #include "hipe_arch.h" #endif #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" #endif #ifdef VALGRIND #include #include #endif static Export* alloc_info_trap = NULL; static Export* alloc_sizes_trap = NULL; static Export* gather_io_bytes_trap = NULL; static Export *gather_sched_wall_time_res_trap; static Export *gather_msacc_res_trap; static Export *gather_gc_info_res_trap; static Export *gather_system_check_res_trap; static Export *is_process_alive_trap; #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) static char otp_version[] = ERLANG_OTP_VERSION; /* Keep erts_system_version as a global variable for easy access from a core */ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE "%s" " [erts-" ERLANG_VERSION "]" #ifndef OTP_RELEASE #ifdef ERLANG_GIT_VERSION " [source-" ERLANG_GIT_VERSION "]" #else " [source]" #endif #endif #ifdef ARCH_64 " [64-bit]" #endif " [smp:%beu:%beu]" " [ds:%beu:%beu:%beu]" #if defined(ERTS_DIRTY_SCHEDULERS_TEST) " [dirty-schedulers-TEST]" #endif " [async-threads:%d]" #ifdef HIPE " [hipe]" #endif #ifdef ET_DEBUG #if ET_DEBUG " [type-assertions]" #endif #endif #ifdef DEBUG " [debug-compiled]" #endif #ifdef ERTS_ENABLE_LOCK_CHECK " [lock-checking]" #endif #ifdef ERTS_ENABLE_LOCK_COUNT " [lock-counting]" #endif #ifdef ERTS_OPCODE_COUNTER_SUPPORT " [instruction-counting]" #endif #ifdef PURIFY " [purify-compiled]" #endif #ifdef VALGRIND " [valgrind-compiled]" #endif #ifdef ERTS_FRMPTR " [frame-pointer]" #endif #ifdef USE_LTTNG " [lttng]" #endif #ifdef USE_DTRACE " [dtrace]" #endif #ifdef USE_SYSTEMTAP " [systemtap]" #endif #ifdef SHCOPY " [sharing-preserving]" #endif "\n"); #define ASIZE(a) (sizeof(a)/sizeof(a[0])) #if defined(HAVE_SOLARIS_SPARC_PERFMON) # include # define PERFMON_SETPCR _IOW('P', 1, unsigned long long) # 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 Eterm current_function(Process* p, ErtsHeapFactory *hfact, Process* rp, int full_info, Uint reserve_size, int flags); static Eterm current_stacktrace(ErtsHeapFactory *hfact, Process* rp, Uint reserve_size); static Eterm bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) { struct erl_off_heap_header* ohh; Eterm res = NIL; Eterm tuple; for (ohh = oh->first; ohh; ohh = ohh->next) { if (ohh->thing_word == HEADER_PROC_BIN) { ProcBin* pb = (ProcBin*) ohh; Eterm val = erts_bld_uword(hpp, szp, (UWord) pb->val); Eterm orig_size = erts_bld_uint(hpp, szp, pb->val->orig_size); if (szp) *szp += 4+2; if (hpp) { Uint refc = (Uint) erts_refc_read(&pb->val->intern.refc, 1); tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); res = CONS(*hpp + 4, tuple, res); *hpp += 4+2; } } } return res; } static Eterm bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh) { struct erl_off_heap_header* ohh; Eterm res = NIL; Eterm tuple; for (ohh = oh->first; ohh; ohh = ohh->next) { if (is_ref_thing_header((*((Eterm *) ohh)))) { ErtsMRefThing *mrtp = (ErtsMRefThing *) ohh; Eterm val = erts_bld_uword(hpp, szp, (UWord) mrtp->mb); Eterm orig_size = erts_bld_uint(hpp, szp, mrtp->mb->orig_size); if (szp) *szp += 4+2; if (hpp) { Uint refc = (Uint) erts_refc_read(&mrtp->mb->intern.refc, 1); tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); res = CONS(*hpp + 4, tuple, res); *hpp += 4+2; } } } return res; } /* make_monitor_list: returns a list of records.. -record(erl_monitor, { type, % process | port | time_offset | dist_process | resource % | node | nodes | suspend dir, % origin | target ref, % reference or [] pid, % Process or nodename extra % registered name, integer or [] }). */ static int do_calc_mon_size(ErtsMonitor *mon, void *vpsz, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); Uint *psz = vpsz; *psz += is_immed(mdp->ref) ? 0 : NC_HEAP_SIZE(mdp->ref); if (mon->type == ERTS_MON_TYPE_RESOURCE && erts_monitor_is_target(mon)) *psz += erts_resource_ref_size(mon->other.ptr); else *psz += is_immed(mon->other.item) ? 0 : NC_HEAP_SIZE(mon->other.item); *psz += 9; /* CONS + 6-tuple */ return 1; } typedef struct { Process *p; Eterm *hp; Eterm res; Eterm tag; } MonListContext; static int do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc, Sint reds) { ErtsMonitorData *mdp = erts_monitor_to_data(mon); MonListContext *pmlc = vpmlc; Eterm tup, t, d, r, p, x; r = is_immed(mdp->ref) ? mdp->ref : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mdp->ref); if (mon->type == ERTS_MON_TYPE_RESOURCE && erts_monitor_is_target(mon)) p = erts_bld_resource_ref(&(pmlc->hp), &MSO(pmlc->p), mon->other.ptr); else p = (is_immed(mon->other.item) ? mon->other.item : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->other.item)); if (mon->flags & ERTS_ML_FLG_NAME) x = ((ErtsMonitorDataExtended *) mdp)->u.name; else if (erts_monitor_is_target(mon)) x = NIL; else if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES) x = make_small(((ErtsMonitorDataExtended *) mdp)->u.refc); else x = NIL; switch (mon->type) { case ERTS_MON_TYPE_PROC: t = am_process; break; case ERTS_MON_TYPE_PORT: t = am_port; break; case ERTS_MON_TYPE_TIME_OFFSET: t = am_time_offset; break; case ERTS_MON_TYPE_DIST_PROC: { ERTS_DECL_AM(dist_process); t = AM_dist_process; break; } case ERTS_MON_TYPE_RESOURCE: { ERTS_DECL_AM(resource); t = AM_resource; break; } case ERTS_MON_TYPE_NODE: t = am_node; break; case ERTS_MON_TYPE_NODES: { ERTS_DECL_AM(nodes); t = AM_nodes; break; } case ERTS_MON_TYPE_SUSPEND: t = am_suspend; break; default: ERTS_INTERNAL_ERROR("Unknown monitor type"); t = am_error; break; } if (erts_monitor_is_target(mon)) { ERTS_DECL_AM(target); d = AM_target; } else { ERTS_DECL_AM(origin); d = AM_origin; } tup = TUPLE6(pmlc->hp, pmlc->tag, t, d, r, p, x); pmlc->hp += 7; pmlc->res = CONS(pmlc->hp, tup, pmlc->res); pmlc->hp += 2; return 1; } static Eterm make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail) { DECL_AM(erl_monitor); Uint sz = 0; MonListContext mlc; void (*foreach)(ErtsMonitor *, ErtsMonitorFunc, void *); foreach = tree ? erts_monitor_tree_foreach : erts_monitor_list_foreach; (*foreach)(root, do_calc_mon_size, &sz); if (sz == 0) return tail; mlc.p = p; mlc.hp = HAlloc(p,sz); mlc.res = tail; mlc.tag = AM_erl_monitor; (*foreach)(root, do_make_one_mon_element, &mlc); return mlc.res; } /* make_link_list: returns a list of records.. -record(erl_link, { type, % process | port | dist_process pid, % Process or port id % (address) }). */ static int calc_lnk_size(ErtsLink *lnk, void *vpsz, Sint reds) { Uint *psz = vpsz; Uint sz = 0; ErtsLinkData *ldp = erts_link_to_data(lnk); (void) erts_bld_uword(NULL, &sz, (UWord) ldp); *psz += sz; *psz += is_immed(lnk->other.item) ? 0 : size_object(lnk->other.item); *psz += 7; /* CONS + 4-tuple */ return 1; } typedef struct { Process *p; Eterm *hp; Eterm res; Eterm tag; } LnkListContext; static int make_one_lnk_element(ErtsLink *lnk, void * vpllc, Sint reds) { LnkListContext *pllc = vpllc; Eterm tup, t, pid, id; ErtsLinkData *ldp = erts_link_to_data(lnk); id = erts_bld_uword(&pllc->hp, NULL, (UWord) ldp); if (is_immed(lnk->other.item)) pid = lnk->other.item; else { Uint sz = size_object(lnk->other.item); pid = copy_struct(lnk->other.item, sz, &(pllc->hp), &MSO(pllc->p)); } switch (lnk->type) { case ERTS_LNK_TYPE_PROC: t = am_process; break; case ERTS_LNK_TYPE_PORT: t = am_port; break; case ERTS_LNK_TYPE_DIST_PROC: { ERTS_DECL_AM(dist_process); t = AM_dist_process; break; } default: ERTS_INTERNAL_ERROR("Unkown link type"); t = am_undefined; break; } tup = TUPLE4(pllc->hp, pllc->tag, t, pid, id); pllc->hp += 5; pllc->res = CONS(pllc->hp, tup, pllc->res); pllc->hp += 2; return 1; } static Eterm make_link_list(Process *p, int tree, ErtsLink *root, Eterm tail) { DECL_AM(erl_link); Uint sz = 0; LnkListContext llc; void (*foreach)(ErtsLink *, ErtsLinkFunc, void *); foreach = tree ? erts_link_tree_foreach : erts_link_list_foreach; (*foreach)(root, calc_lnk_size, (void *) &sz); if (sz == 0) { return tail; } llc.p = p; llc.hp = HAlloc(p,sz); llc.res = tail; llc.tag = AM_erl_link; (*foreach)(root, make_one_lnk_element, (void *) &llc); return llc.res; } int erts_print_system_version(fmtfn_t to, void *arg, Process *c_p) { int i, rc = -1; char *rc_str = ""; char rc_buf[100]; char *ov = otp_version; Uint total, online, active; Uint dirty_cpu, dirty_cpu_onln, dirty_io; erts_schedulers_state(&total, &online, &active, &dirty_cpu, &dirty_cpu_onln, NULL, &dirty_io, NULL); for (i = 0; i < sizeof(otp_version)-4; i++) { if (ov[i] == '-' && ov[i+1] == 'r' && ov[i+2] == 'c') rc = atoi(&ov[i+3]); } if (rc >= 0) { if (rc == 0) rc_str = " [DEVELOPMENT]"; else { erts_snprintf(rc_buf, sizeof(rc_buf), " [RELEASE CANDIDATE %d]", rc); rc_str = rc_buf; } } return erts_print(to, arg, erts_system_version, rc_str , total, online , dirty_cpu, dirty_cpu_onln, dirty_io , erts_async_max_threads ); } typedef struct { /* {Entity,Node} = {monitor.Name,monitor.Pid} for external by name * {Entity,Node} = {monitor.Pid,NIL} for external/external by pid * {Entity,Node} = {monitor.Name,erlang:node()} for internal by name * {Entity,Node} = {monitor.resource,MON_NIF_TARGET}*/ union { Eterm term; ErtsResource* resource; }entity; int named; Uint16 type; Eterm node; /* pid is actual target being monitored, no matter pid/port or name */ Eterm pid; } MonitorInfo; typedef struct { MonitorInfo *mi; Uint mi_i; Uint mi_max; int sz; } MonitorInfoCollection; #define INIT_MONITOR_INFOS(MIC) do { \ (MIC).mi = NULL; \ (MIC).mi_i = (MIC).mi_max = 0; \ (MIC).sz = 0; \ } while(0) #define MI_INC 50 #define EXTEND_MONITOR_INFOS(MICP) \ do { \ if ((MICP)->mi_i >= (MICP)->mi_max) { \ (MICP)->mi = ((MICP)->mi ? erts_realloc(ERTS_ALC_T_TMP, \ (MICP)->mi, \ ((MICP)->mi_max+MI_INC) \ * sizeof(MonitorInfo)) \ : erts_alloc(ERTS_ALC_T_TMP, \ MI_INC*sizeof(MonitorInfo))); \ (MICP)->mi_max += MI_INC; \ } \ } while (0) #define DESTROY_MONITOR_INFOS(MIC) \ do { \ if ((MIC).mi != NULL) { \ erts_free(ERTS_ALC_T_TMP, (void *) (MIC).mi); \ } \ } while (0) static int collect_one_link(ErtsLink *lnk, void *vmicp, Sint reds) { MonitorInfoCollection *micp = vmicp; EXTEND_MONITOR_INFOS(micp); micp->mi[micp->mi_i].entity.term = lnk->other.item; micp->sz += 2 + NC_HEAP_SIZE(lnk->other.item); micp->mi_i++; return 1; } static int collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp, Sint reds) { if (erts_monitor_is_origin(mon)) { MonitorInfoCollection *micp = vmicp; EXTEND_MONITOR_INFOS(micp); micp->mi[micp->mi_i].type = mon->type; switch (mon->type) { case ERTS_MON_TYPE_PROC: case ERTS_MON_TYPE_PORT: case ERTS_MON_TYPE_DIST_PROC: case ERTS_MON_TYPE_TIME_OFFSET: if (!(mon->flags & ERTS_ML_FLG_NAME)) { micp->mi[micp->mi_i].named = 0; micp->mi[micp->mi_i].entity.term = mon->other.item; micp->mi[micp->mi_i].node = NIL; if (is_not_atom(mon->other.item)) micp->sz += NC_HEAP_SIZE(mon->other.item); } else { ErtsMonitorDataExtended *mdep; micp->mi[micp->mi_i].named = !0; mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon); micp->mi[micp->mi_i].entity.term = mdep->u.name; if (mdep->dist) micp->mi[micp->mi_i].node = mdep->dist->nodename; else micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname; micp->sz += 3; /* need one 2-tuple */ } /* have always pid at hand, to assist with figuring out if its a port or * a process, when we monitored by name and process_info is requested. * See: erl_bif_info.c:process_info_aux section for am_monitors */ micp->mi[micp->mi_i].pid = mon->other.item; micp->mi_i++; micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */ break; default: break; } } return 1; } static int collect_one_target_monitor(ErtsMonitor *mon, void *vmicp, Sint reds) { MonitorInfoCollection *micp = vmicp; if (erts_monitor_is_target(mon)) { EXTEND_MONITOR_INFOS(micp); micp->mi[micp->mi_i].type = mon->type; micp->mi[micp->mi_i].named = !!(mon->flags & ERTS_ML_FLG_NAME); switch (mon->type) { case ERTS_MON_TYPE_PROC: case ERTS_MON_TYPE_PORT: case ERTS_MON_TYPE_DIST_PROC: micp->mi[micp->mi_i].entity.term = mon->other.item; micp->mi[micp->mi_i].node = NIL; micp->sz += NC_HEAP_SIZE(mon->other.item); micp->sz += 2; /* cons */; micp->mi_i++; break; case ERTS_MON_TYPE_RESOURCE: micp->mi[micp->mi_i].entity.resource = mon->other.ptr; micp->mi[micp->mi_i].node = NIL; micp->sz += erts_resource_ref_size(mon->other.ptr); micp->sz += 2; /* cons */; micp->mi_i++; break; default: break; } } return 1; } typedef struct { ErtsMonitorSuspend **smi; Uint smi_i; Uint smi_max; Uint sz; } ErtsSuspendMonitorInfoCollection; #define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC) do { \ (SMIC).smi = NULL; \ (SMIC).smi_i = (SMIC).smi_max = 0; \ (SMIC).sz = 0; \ } while(0) #define ERTS_SMI_INC 50 #define ERTS_EXTEND_SUSPEND_MONITOR_INFOS(SMICP) \ do { \ if ((SMICP)->smi_i >= (SMICP)->smi_max) { \ (SMICP)->smi = ((SMICP)->smi \ ? erts_realloc(ERTS_ALC_T_TMP, \ (SMICP)->smi, \ ((SMICP)->smi_max \ + ERTS_SMI_INC) \ * sizeof(ErtsMonitorSuspend *)) \ : erts_alloc(ERTS_ALC_T_TMP, \ ERTS_SMI_INC \ * sizeof(ErtsMonitorSuspend *))); \ (SMICP)->smi_max += ERTS_SMI_INC; \ } \ } while (0) #define ERTS_DESTROY_SUSPEND_MONITOR_INFOS(SMIC) \ do { \ if ((SMIC).smi != NULL) { \ erts_free(ERTS_ALC_T_TMP, (void *) (SMIC).smi); \ } \ } while (0) static int collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp, Sint reds) { if (mon->type == ERTS_MON_TYPE_SUSPEND) { Sint count; erts_aint_t mstate; ErtsMonitorSuspend *msp; ErtsSuspendMonitorInfoCollection *smicp; msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon); smicp = vsmicp; ERTS_EXTEND_SUSPEND_MONITOR_INFOS(smicp); smicp->smi[smicp->smi_i] = msp; smicp->sz += 2 /* cons */ + 4 /* 3-tuple */; mstate = erts_atomic_read_nob(&msp->state); count = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK); if (!IS_SSMALL(count)) smicp->sz += BIG_UINT_HEAP_SIZE; smicp->smi_i++; } return 1; } /* * process_info/[1,2] */ /* * All valid process_info arguments. */ #define ERTS_PI_IX_REGISTERED_NAME 0 #define ERTS_PI_IX_CURRENT_FUNCTION 1 #define ERTS_PI_IX_INITIAL_CALL 2 #define ERTS_PI_IX_STATUS 3 #define ERTS_PI_IX_MESSAGES 4 #define ERTS_PI_IX_MESSAGE_QUEUE_LEN 5 #define ERTS_PI_IX_LINKS 6 #define ERTS_PI_IX_MONITORS 7 #define ERTS_PI_IX_MONITORED_BY 8 #define ERTS_PI_IX_DICTIONARY 9 #define ERTS_PI_IX_TRAP_EXIT 10 #define ERTS_PI_IX_ERROR_HANDLER 11 #define ERTS_PI_IX_HEAP_SIZE 12 #define ERTS_PI_IX_STACK_SIZE 13 #define ERTS_PI_IX_MEMORY 14 #define ERTS_PI_IX_GARBAGE_COLLECTION 15 #define ERTS_PI_IX_GROUP_LEADER 16 #define ERTS_PI_IX_REDUCTIONS 17 #define ERTS_PI_IX_PRIORITY 18 #define ERTS_PI_IX_TRACE 19 #define ERTS_PI_IX_BINARY 20 #define ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN 21 #define ERTS_PI_IX_CATCHLEVEL 22 #define ERTS_PI_IX_BACKTRACE 23 #define ERTS_PI_IX_LAST_CALLS 24 #define ERTS_PI_IX_TOTAL_HEAP_SIZE 25 #define ERTS_PI_IX_SUSPENDING 26 #define ERTS_PI_IX_MIN_HEAP_SIZE 27 #define ERTS_PI_IX_MIN_BIN_VHEAP_SIZE 28 #define ERTS_PI_IX_MAX_HEAP_SIZE 29 #define ERTS_PI_IX_CURRENT_LOCATION 30 #define ERTS_PI_IX_CURRENT_STACKTRACE 31 #define ERTS_PI_IX_MESSAGE_QUEUE_DATA 32 #define ERTS_PI_IX_GARBAGE_COLLECTION_INFO 33 #define ERTS_PI_IX_MAGIC_REF 34 #define ERTS_PI_IX_FULLSWEEP_AFTER 35 #define ERTS_PI_FLAG_SINGELTON (1 << 0) #define ERTS_PI_FLAG_ALWAYS_WRAP (1 << 1) #define ERTS_PI_FLAG_WANT_MSGS (1 << 2) #define ERTS_PI_FLAG_NEED_MSGQ_LEN (1 << 3) #define ERTS_PI_FLAG_FORCE_SIG_SEND (1 << 4) #define ERTS_PI_FLAG_REQUEST_FOR_OTHER (1 << 5) #define ERTS_PI_UNRESERVE(RS, SZ) \ (ASSERT((RS) >= (SZ)), (RS) -= (SZ)) typedef struct { Eterm name; Uint reserve_size; int flags; ErtsProcLocks locks; } ErtsProcessInfoArgs; static ErtsProcessInfoArgs pi_args[] = { {am_registered_name, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_current_function, 4, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_initial_call, 4, 0, ERTS_PROC_LOCK_MAIN}, {am_status, 0, 0, 0}, {am_messages, 0, ERTS_PI_FLAG_WANT_MSGS|ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_message_queue_len, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN, ERTS_PROC_LOCK_MAIN}, {am_links, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_monitors, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_monitored_by, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_dictionary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_trap_exit, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_error_handler, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_stack_size, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_memory, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_garbage_collection, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + ERTS_MAX_HEAP_SIZE_MAP_SZ, 0, ERTS_PROC_LOCK_MAIN}, {am_group_leader, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_reductions, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_priority, 0, 0, 0}, {am_trace, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_binary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_sequential_trace_token, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_catchlevel, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_backtrace, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_last_calls, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_total_heap_size, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_suspending, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, 0}, {am_min_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_min_bin_vheap_size, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_max_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_current_location, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_current_stacktrace, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_message_queue_data, 0, 0, ERTS_PROC_LOCK_MAIN}, {am_garbage_collection_info, ERTS_PROCESS_GC_INFO_MAX_SIZE, 0, ERTS_PROC_LOCK_MAIN}, {am_magic_ref, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}, {am_fullsweep_after, 0, 0, ERTS_PROC_LOCK_MAIN} }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(pi_args[0]))) #ifdef DEBUG # define ERTS_PI_DEF_ARR_SZ 2 #else # define ERTS_PI_DEF_ARR_SZ ERTS_PI_ARGS #endif static ERTS_INLINE Eterm pi_ix2arg(int ix) { if (ix < 0 || ERTS_PI_ARGS <= ix) return am_undefined; return pi_args[ix].name; } static ERTS_INLINE int pi_ix2flags(int ix) { if (ix < 0 || ERTS_PI_ARGS <= ix) return 0; return pi_args[ix].flags; } static ERTS_INLINE Uint pi_ix2rsz(int ix) { if (ix < 0 || ERTS_PI_ARGS <= ix) return 0; return pi_args[ix].reserve_size; } static ERTS_INLINE ErtsProcLocks pi_ix2locks(int ix) { if (ix < 0 || ERTS_PI_ARGS <= ix) return 0; return pi_args[ix].locks; } static ERTS_INLINE int pi_arg2ix(Eterm arg) { switch (arg) { case am_registered_name: return ERTS_PI_IX_REGISTERED_NAME; case am_current_function: return ERTS_PI_IX_CURRENT_FUNCTION; case am_initial_call: return ERTS_PI_IX_INITIAL_CALL; case am_status: return ERTS_PI_IX_STATUS; case am_messages: return ERTS_PI_IX_MESSAGES; case am_message_queue_len: return ERTS_PI_IX_MESSAGE_QUEUE_LEN; case am_links: return ERTS_PI_IX_LINKS; case am_monitors: return ERTS_PI_IX_MONITORS; case am_monitored_by: return ERTS_PI_IX_MONITORED_BY; case am_dictionary: return ERTS_PI_IX_DICTIONARY; case am_trap_exit: return ERTS_PI_IX_TRAP_EXIT; case am_error_handler: return ERTS_PI_IX_ERROR_HANDLER; case am_heap_size: return ERTS_PI_IX_HEAP_SIZE; case am_stack_size: return ERTS_PI_IX_STACK_SIZE; case am_memory: return ERTS_PI_IX_MEMORY; case am_garbage_collection: return ERTS_PI_IX_GARBAGE_COLLECTION; case am_group_leader: return ERTS_PI_IX_GROUP_LEADER; case am_reductions: return ERTS_PI_IX_REDUCTIONS; case am_priority: return ERTS_PI_IX_PRIORITY; case am_trace: return ERTS_PI_IX_TRACE; case am_binary: return ERTS_PI_IX_BINARY; case am_sequential_trace_token: return ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN; case am_catchlevel: return ERTS_PI_IX_CATCHLEVEL; case am_backtrace: return ERTS_PI_IX_BACKTRACE; case am_last_calls: return ERTS_PI_IX_LAST_CALLS; case am_total_heap_size: return ERTS_PI_IX_TOTAL_HEAP_SIZE; case am_suspending: return ERTS_PI_IX_SUSPENDING; case am_min_heap_size: return ERTS_PI_IX_MIN_HEAP_SIZE; case am_min_bin_vheap_size: return ERTS_PI_IX_MIN_BIN_VHEAP_SIZE; case am_max_heap_size: return ERTS_PI_IX_MAX_HEAP_SIZE; case am_current_location: return ERTS_PI_IX_CURRENT_LOCATION; case am_current_stacktrace: return ERTS_PI_IX_CURRENT_STACKTRACE; case am_message_queue_data: return ERTS_PI_IX_MESSAGE_QUEUE_DATA; case am_garbage_collection_info: return ERTS_PI_IX_GARBAGE_COLLECTION_INFO; case am_magic_ref: return ERTS_PI_IX_MAGIC_REF; case am_fullsweep_after: return ERTS_PI_IX_FULLSWEEP_AFTER; default: return -1; } } static Eterm pi_1_keys[] = { am_registered_name, am_current_function, am_initial_call, am_status, am_message_queue_len, am_links, am_dictionary, am_trap_exit, am_error_handler, am_priority, am_group_leader, am_total_heap_size, am_heap_size, am_stack_size, am_reductions, am_garbage_collection, am_suspending }; #define ERTS_PI_1_NO_OF_KEYS (sizeof(pi_1_keys)/sizeof(Eterm)) static Eterm pi_1_keys_list; static Eterm pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS]; static void process_info_init(void) { Eterm *hp = &pi_1_keys_list_heap[0]; int i; pi_1_keys_list = NIL; for (i = ERTS_PI_1_NO_OF_KEYS-1; i >= 0; i--) { pi_1_keys_list = CONS(hp, pi_1_keys[i], pi_1_keys_list); hp += 2; } #ifdef DEBUG { /* Make sure the process_info argument mappings are consistent */ int ix; for (ix = 0; ix < ERTS_PI_ARGS; ix++) { ASSERT(pi_arg2ix(pi_ix2arg(ix)) == ix); } } #endif } static BIF_RETTYPE process_info_aux(Process *c_p, ErtsHeapFactory *hfact, Process *rp, ErtsProcLocks rp_locks, int item_ix, int flags, Uint *reserve_sizep, Uint *reds); Eterm erts_process_info(Process *c_p, ErtsHeapFactory *hfact, Process *rp, ErtsProcLocks rp_locks, int *item_ix, int item_ix_len, int flags, Uint reserve_size, Uint *reds) { Eterm res; Eterm part_res[ERTS_PI_ARGS]; int item_ix_ix, ix; if (ERTS_PI_FLAG_SINGELTON & flags) { ASSERT(item_ix_len == 1); res = process_info_aux(c_p, hfact, rp, rp_locks, item_ix[0], flags, &reserve_size, reds); return res; } for (ix = 0; ix < ERTS_PI_ARGS; ix++) part_res[ix] = THE_NON_VALUE; /* * We always handle 'messages' first if it should be part * of the result. This since if both 'messages' and * 'message_queue_len' are wanted, 'messages' may * change the result of 'message_queue_len' (in case * the queue contain bad distribution messages). */ if (flags & ERTS_PI_FLAG_WANT_MSGS) { ix = pi_arg2ix(am_messages); ASSERT(part_res[ix] == THE_NON_VALUE); res = process_info_aux(c_p, hfact, rp, rp_locks, ix, flags, &reserve_size, reds); ASSERT(res != am_undefined); ASSERT(res != THE_NON_VALUE); part_res[ix] = res; } for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) { ix = item_ix[item_ix_ix]; if (part_res[ix] == THE_NON_VALUE) { res = process_info_aux(c_p, hfact, rp, rp_locks, ix, flags, &reserve_size, reds); ASSERT(res != am_undefined); ASSERT(res != THE_NON_VALUE); part_res[ix] = res; } } res = NIL; for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) { ix = item_ix[item_ix_ix]; ASSERT(part_res[ix] != THE_NON_VALUE); /* * If we should ignore the value of registered_name, * its value is nil. For more info, see comment in the * beginning of process_info_aux(). */ if (is_nil(part_res[ix])) { ASSERT(!(flags & ERTS_PI_FLAG_ALWAYS_WRAP)); ASSERT(pi_ix2arg(ix) == am_registered_name); } else { Eterm *hp; ERTS_PI_UNRESERVE(reserve_size, 2); hp = erts_produce_heap(hfact, 2, reserve_size); res = CONS(hp, part_res[ix], res); } } return res; } static void pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix); static BIF_RETTYPE process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2) { ErtsHeapFactory hfact; int def_arr[ERTS_PI_DEF_ARR_SZ]; int *item_ix = &def_arr[0]; Process *rp = NULL; erts_aint32_t state; BIF_RETTYPE ret; Uint reds = 0; ErtsProcLocks locks = 0; int flags; Uint reserve_size; int len; Eterm res; ERTS_CT_ASSERT(ERTS_PI_DEF_ARR_SZ > 0); if (c_p->common.id == pid) { int local_only = c_p->flags & F_LOCAL_SIGS_ONLY; int sres, sreds, reds_left; reds_left = ERTS_BIF_REDS_LEFT(c_p); sreds = reds_left; if (!local_only) { erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); erts_proc_sig_fetch(c_p); erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); } sres = erts_proc_sig_handle_incoming(c_p, &state, &sreds, sreds, !0); BUMP_REDS(c_p, (int) sreds); reds_left -= sreds; if (state & ERTS_PSFLG_EXITING) { c_p->flags &= ~F_LOCAL_SIGS_ONLY; goto exited; } if (!sres | (reds_left <= 0)) { /* * More signals to handle or out of reds; need * to yield and continue. Prevent fetching of * more signals by setting local-sigs-only flag. */ c_p->flags |= F_LOCAL_SIGS_ONLY; goto yield; } c_p->flags &= ~F_LOCAL_SIGS_ONLY; } if (is_atom(opt)) { int ix = pi_arg2ix(opt); item_ix[0] = ix; len = 1; locks = pi_ix2locks(ix); reserve_size = 3 + pi_ix2rsz(ix); flags = ERTS_PI_FLAG_SINGELTON; flags |= pi_ix2flags(ix); if (ix < 0) goto badarg; } else { Eterm list = opt; Uint size = ERTS_PI_DEF_ARR_SZ; len = 0; reserve_size = 0; locks = 0; flags = 0; while (is_list(list)) { Eterm *consp = list_val(list); Eterm arg = CAR(consp); int ix = pi_arg2ix(arg); if (ix < 0) goto badarg; if (len >= size) pi_setup_grow(&item_ix, def_arr, &size, len); item_ix[len++] = ix; locks |= pi_ix2locks(ix); flags |= pi_ix2flags(ix); reserve_size += pi_ix2rsz(ix); reserve_size += 3; /* 2-tuple */ reserve_size += 2; /* cons */ list = CDR(consp); } if (is_not_nil(list)) goto badarg; } if (is_not_internal_pid(pid)) { if (is_external_pid(pid) && external_pid_dist_entry(pid) == erts_this_dist_entry) goto undefined; goto badarg; } if (always_wrap) flags |= ERTS_PI_FLAG_ALWAYS_WRAP; if (c_p->common.id == pid) { rp = c_p; if (locks & ~ERTS_PROC_LOCK_MAIN) erts_proc_lock(c_p, locks & ~ERTS_PROC_LOCK_MAIN); locks |= ERTS_PROC_LOCK_MAIN; } else { if (flags & ERTS_PI_FLAG_FORCE_SIG_SEND) goto send_signal; state = ERTS_PSFLG_RUNNING; /* fail state... */ rp = erts_try_lock_sig_free_proc(pid, locks, &state); if (!rp) goto undefined; if (rp == ERTS_PROC_LOCK_BUSY) { rp = NULL; goto send_signal; } if (state & ERTS_PSFLG_EXITING) { if (locks) erts_proc_unlock(rp, locks); locks = 0; /* wait for it to terminate properly... */ goto send_signal; } if (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN) { ASSERT(locks & ERTS_PROC_LOCK_MAIN); erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); erts_proc_sig_fetch(rp); if (c_p->sig_qs.cont) { erts_proc_unlock(rp, locks|ERTS_PROC_LOCK_MSGQ); locks = 0; goto send_signal; } erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); } } erts_factory_proc_init(&hfact, c_p); res = erts_process_info(c_p, &hfact, rp, locks, item_ix, len, flags, reserve_size, &reds); erts_factory_close(&hfact); if (reds > INT_MAX/2) reds = INT_MAX/2; BUMP_REDS(c_p, (int) reds); state = erts_atomic32_read_acqb(&rp->state); if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE)) { if (state & ERTS_PSFLG_FREE) { ASSERT(!locks); goto undefined; } if (locks) erts_proc_unlock(rp, locks); locks = 0; /* wait for it to terminate properly... */ goto send_signal; } ERTS_BIF_PREP_RET(ret, res); done: if (c_p == rp) locks &= ~ERTS_PROC_LOCK_MAIN; if (locks && rp) erts_proc_unlock(rp, locks); if (item_ix != def_arr) erts_free(ERTS_ALC_T_TMP, item_ix); return ret; badarg: ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); goto done; undefined: ERTS_BIF_PREP_RET(ret, am_undefined); goto done; exited: ERTS_BIF_PREP_EXITED(ret, c_p); goto done; yield: if (pi2) ERTS_BIF_PREP_YIELD2(ret, bif_export[BIF_process_info_2], c_p, pid, opt); else ERTS_BIF_PREP_YIELD1(ret, bif_export[BIF_process_info_1], c_p, pid); goto done; send_signal: { Eterm ref = erts_make_ref(c_p); int enqueued, need_msgq_len; flags |= ERTS_PI_FLAG_REQUEST_FOR_OTHER; need_msgq_len = (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN); /* * Set receive mark so we wont have to scan the whole * message queue for the result. Note caller unconditionally * has to enter a receive only matching messages containing * 'ref', or restore save pointer. */ ERTS_RECV_MARK_SAVE(c_p); ERTS_RECV_MARK_SET(c_p); enqueued = erts_proc_sig_send_process_info_request(c_p, pid, item_ix, len, need_msgq_len, flags, reserve_size, ref); if (!enqueued) { /* Restore save pointer... */ JOIN_MESSAGE(c_p); goto undefined; } ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, ref); goto done; } } static void pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix) { *sz = (ix+1) + ERTS_PI_DEF_ARR_SZ; if (*arr != def_arr) *arr = erts_realloc(ERTS_ALC_T_TMP, *arr, (*sz)*sizeof(int)); else { int *new_arr = erts_alloc(ERTS_ALC_T_TMP, (*sz)*sizeof(int)); sys_memcpy((void *) new_arr, (void *) def_arr, sizeof(int)*ERTS_PI_DEF_ARR_SZ); *arr = new_arr; } } BIF_RETTYPE process_info_2(BIF_ALIST_2) { return process_info_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, !is_atom(BIF_ARG_2), !0); } BIF_RETTYPE process_info_1(BIF_ALIST_1) { return process_info_bif(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, 0); } Eterm process_info_aux(Process *c_p, ErtsHeapFactory *hfact, Process *rp, ErtsProcLocks rp_locks, int item_ix, int flags, Uint *reserve_sizep, Uint *reds) { Eterm *hp; Eterm res = NIL; Uint reserved; Uint reserve_size = *reserve_sizep; #ifdef ERTS_ENABLE_LOCK_CHECK ErtsProcLocks locks = erts_proc_lc_my_proc_locks(rp); switch (item_ix) { case ERTS_PI_IX_STATUS: case ERTS_PI_IX_PRIORITY: case ERTS_PI_IX_SUSPENDING: ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCK_MAIN) == 0); break; default: ERTS_LC_ASSERT(locks == ERTS_PROC_LOCK_MAIN); break; } #endif reserved = pi_ix2rsz(item_ix); ERTS_PI_UNRESERVE(reserve_size, reserved); (*reds)++; ASSERT(rp); /* * Q: Why this ERTS_PI_FLAG_ALWAYS_WRAP flag? * * A: registered_name is strange. If process has no registered name, * process_info(Pid, registered_name) returns [], and * the result of process_info(Pid) has no {registered_name, Name} * tuple in the resulting list. This is inconsistent with all other * options, but we do not dare to change it. * * When process_info/2 is called with a list as second argument, * registered_name behaves as it should, i.e. a * {registered_name, []} will appear in the resulting list. * * If ERTS_PI_FLAG_ALWAYS_WRAP is set, process_info_aux() always * wrap the result in a key two tuple. */ switch (item_ix) { case ERTS_PI_IX_REGISTERED_NAME: if (rp->common.u.alive.reg) res = rp->common.u.alive.reg->name; else { if (flags & ERTS_PI_FLAG_ALWAYS_WRAP) res = NIL; else return NIL; } break; case ERTS_PI_IX_CURRENT_FUNCTION: res = current_function(c_p, hfact, rp, 0, reserve_size, flags); break; case ERTS_PI_IX_CURRENT_LOCATION: res = current_function(c_p, hfact, rp, 1, reserve_size, flags); break; case ERTS_PI_IX_CURRENT_STACKTRACE: res = current_stacktrace(hfact, rp, reserve_size); break; case ERTS_PI_IX_INITIAL_CALL: hp = erts_produce_heap(hfact, 4, reserve_size); res = TUPLE3(hp, rp->u.initial.module, rp->u.initial.function, make_small(rp->u.initial.arity)); hp += 4; break; case ERTS_PI_IX_STATUS: { erts_aint32_t state = erts_atomic32_read_nob(&rp->state); res = erts_process_state2status(state); if (res == am_running && (state & ERTS_PSFLG_RUNNING_SYS)) { ASSERT(c_p == rp); ASSERT(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER); if (!(state & (ERTS_PSFLG_SYS_TASKS | ERTS_PSFLG_ACTIVE | ERTS_PSFLG_SIG_Q | ERTS_PSFLG_SIG_IN_Q))) { /* * We are servicing a process-info request from * another process. If that other process could * have inspected our state itself, we would have * been in the 'waiting' state. */ res = am_waiting; } } break; } case ERTS_PI_IX_MESSAGES: { ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN); if (rp->sig_qs.len == 0 || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE)) res = NIL; else { int info_on_self = !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER); ErtsMessageInfo *mip; Sint i, len; Uint heap_need; mip = erts_alloc(ERTS_ALC_T_TMP, rp->sig_qs.len*sizeof(ErtsMessageInfo)); /* * Note that message queue may shrink when calling * erts_proc_sig_prep_msgq_for_inspection() since it removes * corrupt distribution messages. */ heap_need = erts_proc_sig_prep_msgq_for_inspection(c_p, rp, rp_locks, info_on_self, mip); len = rp->sig_qs.len; heap_need += len*2; /* Cons cells */ reserve_size += heap_need; /* Build list of messages... */ for (i = len - 1, res = NIL; i >= 0; i--) { Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp); Uint sz = mip[i].size; ERTS_PI_UNRESERVE(reserve_size, sz+2); hp = erts_produce_heap(hfact, sz+2, reserve_size); if (sz != 0) msg = copy_struct(msg, sz, &hp, hfact->off_heap); res = CONS(hp, msg, res); hp += 2; } *reds += (Uint) len / 4; erts_free(ERTS_ALC_T_TMP, mip); } break; } case ERTS_PI_IX_MESSAGE_QUEUE_LEN: { Sint len = rp->sig_qs.len; ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN); ASSERT(len >= 0); if (len <= MAX_SMALL) res = make_small(len); else { hp = erts_produce_heap(hfact, BIG_UINT_HEAP_SIZE, reserve_size); res = uint_to_big((Uint) len, hp); } break; } case ERTS_PI_IX_LINKS: { MonitorInfoCollection mic; int i; Eterm item; INIT_MONITOR_INFOS(mic); erts_link_tree_foreach(ERTS_P_LINKS(rp), collect_one_link, (void *) &mic); reserve_size += mic.sz; res = NIL; for (i = 0; i < mic.mi_i; i++) { Eterm item_src = mic.mi[i].entity.term; Uint sz = NC_HEAP_SIZE(item_src) + 2; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); item = STORE_NC(&hp, hfact->off_heap, item_src); res = CONS(hp, item, res); } *reds += (Uint) mic.mi_i / 4; DESTROY_MONITOR_INFOS(mic); break; } case ERTS_PI_IX_MONITORS: { MonitorInfoCollection mic; int i; INIT_MONITOR_INFOS(mic); erts_monitor_tree_foreach(ERTS_P_MONITORS(rp), collect_one_origin_monitor, (void *) &mic); reserve_size += mic.sz; res = NIL; for (i = 0; i < mic.mi_i; i++) { if (mic.mi[i].named) { /* Monitor by name. * Build {process|port, {Name, Node}} and cons it. */ Eterm t1, t2; /* If pid is an atom, then it is a remote named monitor, which has to be a process */ Eterm m_type = is_port(mic.mi[i].pid) ? am_port : am_process; ASSERT(is_pid(mic.mi[i].pid) || is_port(mic.mi[i].pid) || is_atom(mic.mi[i].pid)); ERTS_PI_UNRESERVE(reserve_size, 3+3+2); hp = erts_produce_heap(hfact, 3+3+2, reserve_size); t1 = TUPLE2(hp, mic.mi[i].entity.term, mic.mi[i].node); hp += 3; t2 = TUPLE2(hp, m_type, t1); hp += 3; res = CONS(hp, t2, res); } else { /* Build {process|port|time_offset, Pid|clock_service} and cons it. */ Eterm t; Eterm pid; Eterm m_type; Eterm pid_src = mic.mi[i].entity.term; Uint sz = is_atom(pid_src) ? 0 : NC_HEAP_SIZE(pid_src); sz += 3 + 2; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); pid = (is_atom(pid_src) ? pid_src : STORE_NC(&hp, hfact->off_heap, pid_src)); switch (mic.mi[i].type) { case ERTS_MON_TYPE_PORT: m_type = am_port; break; case ERTS_MON_TYPE_TIME_OFFSET: m_type = am_time_offset; break; default: m_type = am_process; break; } ASSERT(is_pid(mic.mi[i].pid) || is_port(mic.mi[i].pid)); t = TUPLE2(hp, m_type, pid); hp += 3; res = CONS(hp, t, res); } } *reds += (Uint) mic.mi_i / 4; DESTROY_MONITOR_INFOS(mic); break; } case ERTS_PI_IX_MONITORED_BY: { MonitorInfoCollection mic; int i; Eterm item; INIT_MONITOR_INFOS(mic); erts_monitor_list_foreach(ERTS_P_LT_MONITORS(rp), collect_one_target_monitor, (void *) &mic); erts_monitor_tree_foreach(ERTS_P_MONITORS(rp), collect_one_target_monitor, (void *) &mic); reserve_size += mic.sz; res = NIL; for (i = 0; i < mic.mi_i; ++i) { Uint sz = 2; if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE) sz += erts_resource_ref_size(mic.mi[i].entity.resource); else sz += NC_HEAP_SIZE(mic.mi[i].entity.term); ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE) item = erts_bld_resource_ref(&hp, hfact->off_heap, mic.mi[i].entity.resource); else item = STORE_NC(&hp, hfact->off_heap, mic.mi[i].entity.term); res = CONS(hp, item, res); } *reds += (Uint) mic.mi_i / 4; DESTROY_MONITOR_INFOS(mic); break; } case ERTS_PI_IX_SUSPENDING: { ErtsSuspendMonitorInfoCollection smic; int i; ERTS_INIT_SUSPEND_MONITOR_INFOS(smic); erts_monitor_tree_foreach(ERTS_P_MONITORS(rp), collect_one_suspend_monitor, (void *) &smic); reserve_size += smic.sz; res = NIL; for (i = 0; i < smic.smi_i; i++) { ErtsMonitorSuspend *msp; erts_aint_t mstate; Sint ci; Eterm ct, active, pending, item; Uint sz = 4 + 2; msp = smic.smi[i]; mstate = erts_atomic_read_nob(&msp->state); ci = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK); if (!IS_SSMALL(ci)) sz += BIG_UINT_HEAP_SIZE; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); if (IS_SSMALL(ci)) ct = make_small(ci); else { ct = small_to_big(ci, hp); hp += BIG_UINT_HEAP_SIZE; } if (mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE) { active = ct; pending = make_small(0); } else { active = make_small(0); pending = ct; } ASSERT(is_internal_pid(msp->md.origin.other.item)); item = TUPLE3(hp, msp->md.origin.other.item, active, pending); hp += 4; res = CONS(hp, item, res); } *reds += (Uint) smic.smi_i / 4; ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic); break; } case ERTS_PI_IX_DICTIONARY: if (!rp->dictionary || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE)) { res = NIL; } else { Uint num = rp->dictionary->numElements; res = erts_dictionary_copy(hfact, rp->dictionary, reserve_size); *reds += (Uint) num / 4; } break; case ERTS_PI_IX_TRAP_EXIT: res = (rp->flags & F_TRAP_EXIT) ? am_true : am_false; break; case ERTS_PI_IX_ERROR_HANDLER: res = erts_proc_get_error_handler(rp); break; case ERTS_PI_IX_HEAP_SIZE: { Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, HEAP_SIZE(rp)); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, HEAP_SIZE(rp)); break; } case ERTS_PI_IX_FULLSWEEP_AFTER: { Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, MAX_GEN_GCS(rp)); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, MAX_GEN_GCS(rp)); break; } case ERTS_PI_IX_MIN_HEAP_SIZE: { Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, MIN_HEAP_SIZE(rp)); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, MIN_HEAP_SIZE(rp)); break; } case ERTS_PI_IX_MIN_BIN_VHEAP_SIZE: { Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, MIN_VHEAP_SIZE(rp)); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, MIN_VHEAP_SIZE(rp)); break; } case ERTS_PI_IX_MAX_HEAP_SIZE: { Uint hsz = 0; (void) erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), NULL, &hsz); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), &hp, NULL); break; } case ERTS_PI_IX_TOTAL_HEAP_SIZE: { Uint total_heap_size; Uint hsz = 0; total_heap_size = rp->heap_sz; if (rp->old_hend && rp->old_heap) total_heap_size += rp->old_hend - rp->old_heap; total_heap_size += rp->mbuf_sz; if (rp->flags & F_ON_HEAP_MSGQ) { ErtsMessage *mp; ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN); for (mp = rp->sig_qs.first; mp; mp = mp->next) { ASSERT(ERTS_SIG_IS_MSG(mp)); if (mp->data.attached) total_heap_size += erts_msg_attached_data_size(mp); } *reds += (Uint) rp->sig_qs.len / 4; } (void) erts_bld_uint(NULL, &hsz, total_heap_size); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, total_heap_size); break; } case ERTS_PI_IX_STACK_SIZE: { Uint stack_size = STACK_START(rp) - rp->stop; Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, stack_size); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, stack_size); break; } case ERTS_PI_IX_MEMORY: { /* Memory consumed in bytes */ Uint hsz = 0; Uint size = erts_process_memory(rp, 0); (void) erts_bld_uint(NULL, &hsz, size); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, size); ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN); *reds += (Uint) rp->sig_qs.len / 4; break; } case ERTS_PI_IX_GARBAGE_COLLECTION: { DECL_AM(minor_gcs); Eterm t; Uint map_sz = 0; erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), NULL, &map_sz); hp = erts_produce_heap(hfact, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz, reserve_size); t = TUPLE2(hp, AM_minor_gcs, make_small(GEN_GCS(rp))); hp += 3; res = CONS(hp, t, NIL); hp += 2; t = TUPLE2(hp, am_fullsweep_after, make_small(MAX_GEN_GCS(rp))); hp += 3; res = CONS(hp, t, res); hp += 2; t = TUPLE2(hp, am_min_heap_size, make_small(MIN_HEAP_SIZE(rp))); hp += 3; res = CONS(hp, t, res); hp += 2; t = TUPLE2(hp, am_min_bin_vheap_size, make_small(MIN_VHEAP_SIZE(rp))); hp += 3; res = CONS(hp, t, res); hp += 2; t = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), &hp, NULL); t = TUPLE2(hp, am_max_heap_size, t); hp += 3; res = CONS(hp, t, res); hp += 2; break; } case ERTS_PI_IX_GARBAGE_COLLECTION_INFO: { Uint sz = 0, actual_sz = 0; erts_process_gc_info(rp, &sz, NULL, 0, 0); hp = erts_produce_heap(hfact, sz, reserve_size); res = erts_process_gc_info(rp, &actual_sz, &hp, 0, 0); break; } case ERTS_PI_IX_GROUP_LEADER: { int sz = NC_HEAP_SIZE(rp->group_leader); hp = erts_produce_heap(hfact, sz, reserve_size); res = STORE_NC(&hp, hfact->off_heap, rp->group_leader); break; } case ERTS_PI_IX_REDUCTIONS: { Uint reds = rp->reds + erts_current_reductions(c_p, rp); Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, reds); hp = erts_produce_heap(hfact, hsz, reserve_size); res = erts_bld_uint(&hp, NULL, reds); break; } case ERTS_PI_IX_PRIORITY: { erts_aint32_t state = erts_atomic32_read_nob(&rp->state); if (ERTS_PSFLG_EXITING & state) return am_undefined; res = erts_get_process_priority(state); break; } case ERTS_PI_IX_TRACE: res = make_small(ERTS_TRACE_FLAGS(rp) & TRACEE_FLAGS); break; case ERTS_PI_IX_BINARY: { Uint sz = 0; (void) bld_bin_list(NULL, &sz, &MSO(rp)); hp = erts_produce_heap(hfact, sz, reserve_size); res = bld_bin_list(&hp, NULL, &MSO(rp)); break; } case ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN: { Uint sz = size_object(rp->seq_trace_token); hp = erts_produce_heap(hfact, sz, reserve_size); res = copy_struct(rp->seq_trace_token, sz, &hp, hfact->off_heap); break; } case ERTS_PI_IX_CATCHLEVEL: res = make_small(catchlevel(rp)); break; case ERTS_PI_IX_BACKTRACE: { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp); res = erts_heap_factory_new_binary(hfact, (byte *) dsbufp->str, dsbufp->str_len, reserve_size); erts_destroy_tmp_dsbuf(dsbufp); break; } case ERTS_PI_IX_LAST_CALLS: { struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp); if (!scb) { res = am_false; } else { /* * One cons cell and a 3-struct, and a 2-tuple. * Might be less than that, if there are sends, receives or timeouts, * so we must do a HRelease() to avoid creating holes. */ Sint needed = scb->n*(2+4); Eterm term, list; int i, j; Export *exp; reserve_size += needed; list = NIL; for (i = 0; i < scb->n; i++) { Uint sz; j = scb->cur - i - 1; if (j < 0) j += scb->len; sz = 2; exp = scb->ct[j]; if (exp != &exp_send && exp != &exp_receive && exp != &exp_timeout) sz += 4; needed -= sz; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); if (exp == &exp_send) term = am_send; else if (exp == &exp_receive) term = am_receive; else if (exp == &exp_timeout) term = am_timeout; else { term = TUPLE3(hp, scb->ct[j]->info.mfa.module, scb->ct[j]->info.mfa.function, make_small(scb->ct[j]->info.mfa.arity)); hp += 4; } list = CONS(hp, term, list); } ASSERT(needed >= 0); if (needed > 0) reserve_size -= needed; res = list; } break; } case ERTS_PI_IX_MESSAGE_QUEUE_DATA: switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) { case F_OFF_HEAP_MSGQ: res = am_off_heap; break; case F_ON_HEAP_MSGQ: res = am_on_heap; break; default: res = am_error; ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); break; } break; case ERTS_PI_IX_MAGIC_REF: { Uint sz = 0; (void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp)); hp = erts_produce_heap(hfact, sz, 0); res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp)); *reds += (Uint) 10; break; } default: return THE_NON_VALUE; /* will produce badarg */ } ERTS_PI_UNRESERVE(reserve_size, 3); *reserve_sizep = reserve_size; hp = erts_produce_heap(hfact, 3, reserve_size); return TUPLE2(hp, pi_ix2arg(item_ix), res); } #undef MI_INC static Eterm current_function(Process *c_p, ErtsHeapFactory *hfact, Process* rp, int full_info, Uint reserve_size, int flags) { Eterm* hp; Eterm res; FunctionInfo fi; if (rp->current == NULL) { erts_lookup_function_info(&fi, rp->i, full_info); rp->current = fi.mfa; } else if (full_info) { erts_lookup_function_info(&fi, rp->i, full_info); if (fi.mfa == NULL) { /* Use the current function without location info */ erts_set_current_function(&fi, rp->current); } } if (c_p == rp && !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER)) { 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.mfa) { fi = fi2; rp->current = fi2.mfa; } } /* * Return the result. */ if (rp->current == NULL) { res = am_undefined; } else if (full_info) { hp = erts_produce_heap(hfact, fi.needed, reserve_size); erts_build_mfa_item(&fi, hp, am_true, &res); } else { hp = erts_produce_heap(hfact, 4, reserve_size); res = TUPLE3(hp, rp->current->module, rp->current->function, make_small(rp->current->arity)); } return res; } static Eterm current_stacktrace(ErtsHeapFactory *hfact, Process* rp, Uint reserve_size) { Uint sz; struct StackTrace* s; int depth; FunctionInfo* stk; FunctionInfo* stkp; Uint heap_size; int i; Eterm* hp; Eterm mfa; Eterm res = NIL; depth = erts_backtrace_depth; sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth; s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz); s->depth = 0; if (depth > 0 && 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->mfa) { heap_size += stkp->needed + 2; stkp++; } } reserve_size += heap_size; /* * We intentionally produce heap in small chunks * (for more info see process_info_aux()). */ while (stkp > stk) { stkp--; sz = stkp->needed + 2; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); hp = erts_build_mfa_item(stkp, hp, am_true, &mfa); res = CONS(hp, mfa, res); } erts_free(ERTS_ALC_T_TMP, stk); erts_free(ERTS_ALC_T_TMP, s); return res; } /* * This function takes care of calls to erlang:system_info/1 when the argument * is a tuple. */ static BIF_RETTYPE info_1_tuple(Process* BIF_P, /* Pointer to current process. */ Eterm* tp, /* Pointer to first element in tuple */ int arity) /* Arity of tuple (untagged). */ { Eterm ret; Eterm sel; sel = *tp++; if (sel == am_memory_internal) { switch (arity) { case 3: if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 1)) return am_true; default: goto badarg; } } else if (sel == am_allocator_sizes) { switch (arity) { case 2: ERTS_BIF_PREP_TRAP1(ret, alloc_sizes_trap, BIF_P, *tp); return ret; case 3: if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 0)) return am_true; default: goto badarg; } } else if (sel == am_wordsize && arity == 2) { if (tp[0] == am_internal) { return make_small(sizeof(Eterm)); } if (tp[0] == am_external) { return make_small(sizeof(UWord)); } goto badarg; } else if (sel == am_allocator) { switch (arity) { case 2: ERTS_BIF_PREP_TRAP1(ret, alloc_info_trap, BIF_P, *tp); return ret; case 3: if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0, 0)) return am_true; default: goto badarg; } } else if (ERTS_IS_ATOM_STR("internal_cpu_topology", sel) && arity == 2) { return erts_get_cpu_topology_term(BIF_P, *tp); } else if (ERTS_IS_ATOM_STR("cpu_topology", sel) && arity == 2) { Eterm res = erts_get_cpu_topology_term(BIF_P, *tp); if (res == THE_NON_VALUE) goto badarg; ERTS_BIF_PREP_TRAP1(ret, erts_format_cpu_topology_trap, BIF_P, res); return ret; #if defined(PURIFY) || defined(VALGRIND) } else if (ERTS_IS_ATOM_STR("error_checker", sel) #if defined(PURIFY) || sel == am_purify #elif defined(VALGRIND) || ERTS_IS_ATOM_STR("valgrind", sel) #endif ) { if (*tp == am_memory) { #if defined(PURIFY) BIF_RET(erts_make_integer(purify_new_leaks(), BIF_P)); #elif defined(VALGRIND) # ifdef VALGRIND_DO_ADDED_LEAK_CHECK VALGRIND_DO_ADDED_LEAK_CHECK; # else VALGRIND_DO_LEAK_CHECK; # endif BIF_RET(make_small(0)); #endif } else if (*tp == am_fd) { #if defined(PURIFY) BIF_RET(erts_make_integer(purify_new_fds_inuse(), BIF_P)); #elif defined(VALGRIND) /* Not present in valgrind... */ BIF_RET(make_small(0)); #endif } else if (*tp == am_running) { #if defined(PURIFY) BIF_RET(purify_is_running() ? am_true : am_false); #elif defined(VALGRIND) BIF_RET(RUNNING_ON_VALGRIND ? am_true : am_false); #endif } else if (is_list(*tp)) { #if defined(PURIFY) # define ERTS_ERROR_CHECKER_PRINTF purify_printf #elif defined(VALGRIND) # define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF #endif ErlDrvSizeT buf_size = 8*1024; /* Try with 8KB first */ char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); ErlDrvSizeT r = erts_iolist_to_buf(*tp, (char*) buf, buf_size - 1); if (ERTS_IOLIST_TO_BUF_FAILED(r)) { erts_free(ERTS_ALC_T_TMP, (void *) buf); if (erts_iolist_size(*tp, &buf_size)) { goto badarg; } buf_size++; buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); r = erts_iolist_to_buf(*tp, (char*) buf, buf_size - 1); ASSERT(r == buf_size - 1); } buf[buf_size - 1 - r] = '\0'; ERTS_ERROR_CHECKER_PRINTF("%s\n", buf); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(am_true); #undef ERTS_ERROR_CHECKER_PRINTF } #endif #ifdef QUANTIFY } else if (sel == am_quantify) { if (*tp == am_clear) { quantify_clear_data(); BIF_RET(am_true); } else if (*tp == am_start) { quantify_start_recording_data(); BIF_RET(am_true); } else if (*tp == am_stop) { quantify_stop_recording_data(); BIF_RET(am_true); } else if (*tp == am_running) { BIF_RET(quantify_is_running() ? am_true : am_false); } #endif #if defined(__GNUC__) && defined(HAVE_SOLARIS_SPARC_PERFMON) } else if (ERTS_IS_ATOM_STR("ultrasparc_set_pcr", sel)) { unsigned long long tmp; int fd; int rc; if (arity != 2 || !is_small(*tp)) { goto badarg; } tmp = signed_val(*tp); if ((fd = open("/dev/perfmon", O_RDONLY)) == -1) { BIF_RET(am_false); } rc = ioctl(fd, PERFMON_SETPCR, &tmp); close(fd); if (rc < 0) { BIF_RET(am_false); } BIF_RET(am_true); #endif } badarg: ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); return ret; } #define INFO_DSBUF_INC_SZ 256 static erts_dsprintf_buf_t * grow_info_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need) { size_t size; size_t free_size = dsbufp->size - dsbufp->str_len; ASSERT(dsbufp); if (need <= free_size) return dsbufp; size = need - free_size + INFO_DSBUF_INC_SZ; size = ((size + INFO_DSBUF_INC_SZ - 1)/INFO_DSBUF_INC_SZ)*INFO_DSBUF_INC_SZ; size += dsbufp->size; ASSERT(dsbufp->str_len + need <= size); dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_INFO_DSBUF, (void *) dsbufp->str, size); dsbufp->size = size; return dsbufp; } static erts_dsprintf_buf_t * erts_create_info_dsbuf(Uint size) { Uint init_size = size ? size : INFO_DSBUF_INC_SZ; erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_info_dsbuf); erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_INFO_DSBUF, sizeof(erts_dsprintf_buf_t)); sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t)); dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_INFO_DSBUF, init_size); dsbufp->str[0] = '\0'; dsbufp->size = init_size; return dsbufp; } static void erts_destroy_info_dsbuf(erts_dsprintf_buf_t *dsbufp) { if (dsbufp->str) erts_free(ERTS_ALC_T_INFO_DSBUF, (void *) dsbufp->str); erts_free(ERTS_ALC_T_INFO_DSBUF, (void *) dsbufp); } static Eterm c_compiler_used(Eterm **hpp, Uint *szp) { #if defined(__GNUC__) # if defined(__GNUC_MINOR__) && defined(__GNUC_PATCHLEVEL__) # define ERTS_GNUC_VSN_NUMS 3 # elif defined(__GNUC_MINOR__) # define ERTS_GNUC_VSN_NUMS 2 # else # define ERTS_GNUC_VSN_NUMS 1 # endif return erts_bld_tuple(hpp, szp, 2, erts_bld_atom(hpp, szp, "gnuc"), #if ERTS_GNUC_VSN_NUMS > 1 erts_bld_tuple(hpp, szp, ERTS_GNUC_VSN_NUMS, #endif erts_bld_uint(hpp, szp, (Uint) __GNUC__) #ifdef __GNUC_MINOR__ , erts_bld_uint(hpp, szp, (Uint) __GNUC_MINOR__) #ifdef __GNUC_PATCHLEVEL__ , erts_bld_uint(hpp, szp, (Uint) __GNUC_PATCHLEVEL__) #endif #endif #if ERTS_GNUC_VSN_NUMS > 1 ) #endif ); #elif defined(_MSC_VER) return erts_bld_tuple(hpp, szp, 2, erts_bld_atom(hpp, szp, "msc"), erts_bld_uint(hpp, szp, (Uint) _MSC_VER)); #else return erts_bld_tuple(hpp, szp, 2, am_undefined, am_undefined); #endif } static int is_snif_term(Eterm module_atom) { int i; Atom *a = atom_tab(atom_val(module_atom)); char *aname = (char *) a->name; /* if a->name has a '.' then the bif (snif) is bogus i.e a package */ for (i = 0; i < a->len; i++) { if (aname[i] == '.') return 0; } return 1; } static Eterm build_snif_term(Eterm **hpp, Uint *szp, int ix, Eterm res) { Eterm tup; tup = erts_bld_tuple(hpp, szp, 3, bif_table[ix].module, bif_table[ix].name, make_small(bif_table[ix].arity)); res = erts_bld_cons( hpp, szp, tup, res); return res; } static Eterm build_snifs_term(Eterm **hpp, Uint *szp, Eterm res) { int i; for (i = 0; i < BIF_SIZE; i++) { if (is_snif_term(bif_table[i].module)) { res = build_snif_term(hpp, szp, i, res); } } return res; } BIF_RETTYPE system_info_1(BIF_ALIST_1) { Eterm res; Eterm* hp; Eterm val; int i; if (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); Uint arity = *tp++; return info_1_tuple(BIF_P, tp, arityval(arity)); } else if (BIF_ARG_1 == am_scheduler_id) { ErtsSchedulerData *esdp = erts_proc_sched_data(BIF_P); BIF_RET(make_small(esdp->no)); } else if (BIF_ARG_1 == am_compat_rel) { ASSERT(erts_compat_rel > 0); BIF_RET(make_small(erts_compat_rel)); } else if (BIF_ARG_1 == am_multi_scheduling) { { int msb = erts_is_multi_scheduling_blocked(); BIF_RET(!msb ? am_enabled : (msb > 0 ? am_blocked : am_blocked_normal)); } } else if (BIF_ARG_1 == am_build_type) { #if defined(DEBUG) ERTS_DECL_AM(debug); BIF_RET(AM_debug); #elif defined(PURIFY) ERTS_DECL_AM(purify); BIF_RET(AM_purify); #elif defined(QUANTIFY) ERTS_DECL_AM(quantify); BIF_RET(AM_quantify); #elif defined(PURECOV) ERTS_DECL_AM(purecov); BIF_RET(AM_purecov); #elif defined(ERTS_GCOV) ERTS_DECL_AM(gcov); BIF_RET(AM_gcov); #elif defined(VALGRIND) ERTS_DECL_AM(valgrind); BIF_RET(AM_valgrind); #elif defined(GPROF) ERTS_DECL_AM(gprof); BIF_RET(AM_gprof); #elif defined(ERTS_ENABLE_LOCK_COUNT) ERTS_DECL_AM(lcnt); BIF_RET(AM_lcnt); #elif defined(ERTS_FRMPTR) ERTS_DECL_AM(frmptr); BIF_RET(AM_frmptr); #else BIF_RET(am_opt); #endif BIF_RET(res); } else if (BIF_ARG_1 == am_time_offset) { switch (erts_time_offset_state()) { case ERTS_TIME_OFFSET_PRELIMINARY: { ERTS_DECL_AM(preliminary); BIF_RET(AM_preliminary); } case ERTS_TIME_OFFSET_FINAL: { ERTS_DECL_AM(final); BIF_RET(AM_final); } case ERTS_TIME_OFFSET_VOLATILE: { ERTS_DECL_AM(volatile); BIF_RET(AM_volatile); } default: ERTS_INTERNAL_ERROR("Invalid time offset state"); } } else if (ERTS_IS_ATOM_STR("os_monotonic_time_source", BIF_ARG_1)) { BIF_RET(erts_monotonic_time_source(BIF_P)); } else if (ERTS_IS_ATOM_STR("os_system_time_source", BIF_ARG_1)) { BIF_RET(erts_system_time_source(BIF_P)); } else if (ERTS_IS_ATOM_STR("time_correction", BIF_ARG_1)) { BIF_RET(erts_has_time_correction() ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("start_time", BIF_ARG_1)) { BIF_RET(erts_get_monotonic_start_time(BIF_P)); } else if (ERTS_IS_ATOM_STR("end_time", BIF_ARG_1)) { BIF_RET(erts_get_monotonic_end_time(BIF_P)); } else if (ERTS_IS_ATOM_STR("time_warp_mode", BIF_ARG_1)) { switch (erts_time_warp_mode()) { case ERTS_NO_TIME_WARP_MODE: { ERTS_DECL_AM(no_time_warp); BIF_RET(AM_no_time_warp); } case ERTS_SINGLE_TIME_WARP_MODE: { ERTS_DECL_AM(single_time_warp); BIF_RET(AM_single_time_warp); } case ERTS_MULTI_TIME_WARP_MODE: { ERTS_DECL_AM(multi_time_warp); BIF_RET(AM_multi_time_warp); } default: ERTS_INTERNAL_ERROR("Invalid time warp mode"); } } else if (BIF_ARG_1 == am_allocated_areas) { res = erts_allocated_areas(NULL, NULL, BIF_P); BIF_RET(res); } else if (BIF_ARG_1 == am_hipe_architecture) { #if defined(HIPE) BIF_RET(hipe_arch_name); #else BIF_RET(am_undefined); #endif } else if (BIF_ARG_1 == am_trace_control_word) { 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)) { BIF_RET((erts_ets_always_compress) ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("snifs", BIF_ARG_1)) { Uint size = 0; Uint *szp; szp = &size; build_snifs_term(NULL, szp, NIL); hp = HAlloc(BIF_P, size); res = build_snifs_term(&hp, NULL, NIL); BIF_RET(res); } else if (BIF_ARG_1 == am_sequential_tracer) { ErtsTracer seq_tracer = erts_get_system_seq_tracer(); val = erts_tracer_to_term(BIF_P, seq_tracer); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_sequential_tracer, val); BIF_RET(res); } else if (BIF_ARG_1 == am_garbage_collection){ Uint val = (Uint) erts_atomic32_read_nob(&erts_max_gen_gcs); Eterm tup; hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2); tup = TUPLE2(hp, am_fullsweep_after, make_small(val)); hp += 3; res = CONS(hp, tup, NIL); hp += 2; tup = TUPLE2(hp, am_min_heap_size, make_small(H_MIN_SIZE)); hp += 3; res = CONS(hp, tup, res); hp += 2; tup = TUPLE2(hp, am_min_bin_vheap_size, make_small(BIN_VH_MIN_SIZE)); hp += 3; res = CONS(hp, tup, res); hp += 2; tup = TUPLE2(hp, am_max_heap_size, make_small(H_MAX_SIZE)); hp += 3; res = CONS(hp, tup, res); hp += 2; BIF_RET(res); } else if (BIF_ARG_1 == am_fullsweep_after){ Uint val = (Uint) erts_atomic32_read_nob(&erts_max_gen_gcs); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_fullsweep_after, make_small(val)); BIF_RET(res); } else if (BIF_ARG_1 == am_min_heap_size) { hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_min_heap_size,make_small(H_MIN_SIZE)); BIF_RET(res); } else if (BIF_ARG_1 == am_max_heap_size) { Uint sz = 0; erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, NULL, &sz); hp = HAlloc(BIF_P, sz); res = erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, &hp, NULL); BIF_RET(res); } else if (BIF_ARG_1 == am_min_bin_vheap_size) { hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_min_bin_vheap_size,make_small(BIN_VH_MIN_SIZE)); BIF_RET(res); } else if (BIF_ARG_1 == am_process_count) { BIF_RET(make_small(erts_ptab_count(&erts_proc))); } else if (BIF_ARG_1 == am_process_limit) { BIF_RET(make_small(erts_ptab_max(&erts_proc))); } else if (BIF_ARG_1 == am_port_count) { BIF_RET(make_small(erts_ptab_count(&erts_port))); } else if (BIF_ARG_1 == am_port_limit) { BIF_RET(make_small(erts_ptab_max(&erts_port))); } else if (BIF_ARG_1 == am_info || BIF_ARG_1 == am_procs || BIF_ARG_1 == am_loaded || BIF_ARG_1 == am_dist) { erts_dsprintf_buf_t *dsbufp = erts_create_info_dsbuf(0); /* Need to be the only thread running... */ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_thr_progress_block(); if (BIF_ARG_1 == am_info) info(ERTS_PRINT_DSBUF, (void *) dsbufp); else if (BIF_ARG_1 == am_procs) process_info(ERTS_PRINT_DSBUF, (void *) dsbufp); else if (BIF_ARG_1 == am_loaded) loaded(ERTS_PRINT_DSBUF, (void *) dsbufp); else distribution_info(ERTS_PRINT_DSBUF, (void *) dsbufp); erts_thr_progress_unblock(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); ASSERT(dsbufp && dsbufp->str); res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len); erts_destroy_info_dsbuf(dsbufp); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("dist_ctrl", BIF_ARG_1)) { DistEntry *dep; i = 0; erts_rwmtx_rlock(&erts_dist_table_rwmtx); for (dep = erts_visible_dist_entries; dep; dep = dep->next) ++i; for (dep = erts_hidden_dist_entries; dep; dep = dep->next) ++i; hp = HAlloc(BIF_P,i*(3+2)); res = NIL; for (dep = erts_hidden_dist_entries; dep; dep = dep->next) { Eterm tpl; ASSERT(is_immed(dep->cid)); tpl = TUPLE2(hp, dep->sysname, dep->cid); hp +=3; res = CONS(hp, tpl, res); hp += 2; } for (dep = erts_visible_dist_entries; dep; dep = dep->next) { Eterm tpl; ASSERT(is_immed(dep->cid)); tpl = TUPLE2(hp, dep->sysname, dep->cid); hp +=3; res = CONS(hp, tpl, res); hp += 2; } erts_rwmtx_runlock(&erts_dist_table_rwmtx); BIF_RET(res); } else if (BIF_ARG_1 == am_system_version) { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); erts_print_system_version(ERTS_PRINT_DSBUF, (void *) dsbufp, BIF_P); hp = HAlloc(BIF_P, dsbufp->str_len*2); res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL); erts_destroy_tmp_dsbuf(dsbufp); BIF_RET(res); } else if (BIF_ARG_1 == am_system_architecture) { hp = HAlloc(BIF_P, 2*(sizeof(ERLANG_ARCHITECTURE)-1)); BIF_RET(buf_to_intlist(&hp, ERLANG_ARCHITECTURE, sizeof(ERLANG_ARCHITECTURE)-1, NIL)); } else if (BIF_ARG_1 == am_os_type) { BIF_RET(os_type_tuple); } else if (BIF_ARG_1 == am_allocator) { BIF_RET(erts_allocator_options((void *) BIF_P)); } else if (BIF_ARG_1 == am_thread_pool_size) { extern int erts_async_max_threads; int n; n = erts_async_max_threads; BIF_RET(make_small(n)); } else if (BIF_ARG_1 == am_alloc_util_allocators) { BIF_RET(erts_alloc_util_allocators((void *) BIF_P)); } else if (BIF_ARG_1 == am_elib_malloc) { /* To be removed in R15 */ BIF_RET(am_false); } else if (BIF_ARG_1 == am_os_version) { BIF_RET(os_version_tuple); } else if (BIF_ARG_1 == am_version) { int n = sys_strlen(ERLANG_VERSION); hp = HAlloc(BIF_P, ((sizeof ERLANG_VERSION)-1) * 2); BIF_RET(buf_to_intlist(&hp, ERLANG_VERSION, n, NIL)); } else if (BIF_ARG_1 == am_machine) { int n = sys_strlen(EMULATOR); hp = HAlloc(BIF_P, n*2); BIF_RET(buf_to_intlist(&hp, EMULATOR, n, NIL)); } else if (BIF_ARG_1 == am_garbage_collection) { BIF_RET(am_generational); #ifdef ERTS_OPCODE_COUNTER_SUPPORT } else if (BIF_ARG_1 == am_instruction_counts) { #ifdef DEBUG Eterm *endp; #endif Eterm *hp, **hpp; Uint hsz, *hszp; int i; hpp = NULL; hsz = 0; hszp = &hsz; bld_instruction_counts: res = NIL; for (i = num_instructions-1; i >= 0; i--) { res = erts_bld_cons(hpp, hszp, erts_bld_tuple(hpp, hszp, 2, erts_atom_put((byte *)opc[i].name, sys_strlen(opc[i].name), ERTS_ATOM_ENC_LATIN1, 1), erts_bld_uint(hpp, hszp, erts_instr_count[i])), res); } if (!hpp) { hp = HAlloc(BIF_P, hsz); hpp = &hp; #ifdef DEBUG endp = hp + hsz; #endif hszp = NULL; goto bld_instruction_counts; } ASSERT(endp == hp); BIF_RET(res); #endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ } else if (BIF_ARG_1 == am_wordsize) { return make_small(sizeof(Eterm)); } else if (BIF_ARG_1 == am_endian) { #if defined(WORDS_BIGENDIAN) return am_big; #else return am_little; #endif } else if (BIF_ARG_1 == am_heap_sizes) { return erts_heap_sizes(BIF_P); } else if (BIF_ARG_1 == am_heap_type) { return am_private; } else if (ERTS_IS_ATOM_STR("cpu_topology", BIF_ARG_1)) { res = erts_get_cpu_topology_term(BIF_P, am_used); BIF_TRAP1(erts_format_cpu_topology_trap, BIF_P, res); } else if (ERTS_IS_ATOM_STR("update_cpu_info", BIF_ARG_1)) { if (erts_update_cpu_info()) { ERTS_DECL_AM(changed); BIF_RET(AM_changed); } else { ERTS_DECL_AM(unchanged); BIF_RET(AM_unchanged); } #if defined(__GNUC__) && defined(HAVE_SOLARIS_SPARC_PERFMON) } else if (ERTS_IS_ATOM_STR("ultrasparc_read_tick1", BIF_ARG_1)) { register unsigned high asm("%l0"); register unsigned low asm("%l1"); hp = HAlloc(BIF_P, 5); asm volatile (".word 0xa3410000;" /* rd %tick, %l1 */ ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ : "=r" (high), "=r" (low)); res = TUPLE4(hp, make_small(high >> 16), make_small(high & 0xFFFF), make_small(low >> 16), make_small(low & 0xFFFF)); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ultrasparc_read_tick2", BIF_ARG_1)) { register unsigned high asm("%l0"); register unsigned low asm("%l1"); asm volatile (".word 0xa3410000;" /* rd %tick, %l1 */ ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ : "=r" (high), "=r" (low)); hp = HAlloc(BIF_P, 5); res = TUPLE4(hp, make_small(high >> 16), make_small(high & 0xFFFF), make_small(low >> 16), make_small(low & 0xFFFF)); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ultrasparc_read_pic1", BIF_ARG_1)) { register unsigned high asm("%l0"); register unsigned low asm("%l1"); hp = HAlloc(BIF_P, 5); asm volatile (".word 0xa3444000;" /* rd %asr17, %l1 */ ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ : "=r" (high), "=r" (low)); res = TUPLE4(hp, make_small(high >> 16), make_small(high & 0xFFFF), make_small(low >> 16), make_small(low & 0xFFFF)); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ultrasparc_read_pic2", BIF_ARG_1)) { register unsigned high asm("%l0"); register unsigned low asm("%l1"); asm volatile (".word 0xa3444000;" /* rd %asr17, %l1 */ ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ : "=r" (high), "=r" (low)); hp = HAlloc(BIF_P, 5); res = TUPLE4(hp, make_small(high >> 16), make_small(high & 0xFFFF), make_small(low >> 16), make_small(low & 0xFFFF)); BIF_RET(res); #endif } else if (BIF_ARG_1 == am_threads) { return am_true; } else if (BIF_ARG_1 == am_creation) { return make_small(erts_this_node->creation); } else if (BIF_ARG_1 == am_break_ignored) { extern int ignore_break; if (ignore_break) return am_true; else return am_false; } /* Arguments that are unusual follow ... */ else if (ERTS_IS_ATOM_STR("logical_processors", BIF_ARG_1)) { int no; erts_get_logical_processors(&no, NULL, NULL); if (no > 0) BIF_RET(make_small((Uint) no)); else { DECL_AM(unknown); BIF_RET(AM_unknown); } } else if (ERTS_IS_ATOM_STR("logical_processors_online", BIF_ARG_1)) { int no; erts_get_logical_processors(NULL, &no, NULL); if (no > 0) BIF_RET(make_small((Uint) no)); else { DECL_AM(unknown); BIF_RET(AM_unknown); } } else if (ERTS_IS_ATOM_STR("logical_processors_available", BIF_ARG_1)) { int no; erts_get_logical_processors(NULL, NULL, &no); if (no > 0) BIF_RET(make_small((Uint) no)); else { DECL_AM(unknown); BIF_RET(AM_unknown); } } else if (ERTS_IS_ATOM_STR("otp_release", BIF_ARG_1)) { int n = sizeof(ERLANG_OTP_RELEASE)-1; hp = HAlloc(BIF_P, 2*n); BIF_RET(buf_to_intlist(&hp, ERLANG_OTP_RELEASE, n, NIL)); } else if (ERTS_IS_ATOM_STR("driver_version", BIF_ARG_1)) { char buf[42]; int n = erts_snprintf(buf, 42, "%d.%d", ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION); hp = HAlloc(BIF_P, 2*n); BIF_RET(buf_to_intlist(&hp, buf, n, NIL)); } else if (ERTS_IS_ATOM_STR("nif_version", BIF_ARG_1)) { char buf[42]; int n = erts_snprintf(buf, 42, "%d.%d", ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION); hp = HAlloc(BIF_P, 2*n); BIF_RET(buf_to_intlist(&hp, buf, n, NIL)); } else if (ERTS_IS_ATOM_STR("smp_support", BIF_ARG_1)) { BIF_RET(am_true); } else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) { BIF_RET(erts_bound_schedulers_term(BIF_P)); } else if (ERTS_IS_ATOM_STR("scheduler_bindings", BIF_ARG_1)) { BIF_RET(erts_get_schedulers_binds(BIF_P)); } else if (ERTS_IS_ATOM_STR("constant_pool_support", BIF_ARG_1)) { BIF_RET(am_true); } else if (ERTS_IS_ATOM_STR("schedulers", BIF_ARG_1) || ERTS_IS_ATOM_STR("schedulers_total", BIF_ARG_1)) { res = make_small(erts_no_schedulers); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) { Eterm *hp; Uint total, online, active; erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, NULL, NULL); hp = HAlloc(BIF_P, 4); res = TUPLE3(hp, make_small(total), make_small(online), make_small(active)); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) { Eterm *hp; Uint total, online, active; erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, NULL, NULL); hp = HAlloc(BIF_P, 4); res = TUPLE3(hp, make_small(total), make_small(online), make_small(active)); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("all_schedulers_state", BIF_ARG_1)) { Eterm *hp, tpl; Uint sz, total, online, active, dirty_cpu_total, dirty_cpu_online, dirty_cpu_active, dirty_io_total, dirty_io_active; erts_schedulers_state(&total, &online, &active, &dirty_cpu_total, &dirty_cpu_online, &dirty_cpu_active, &dirty_io_total, &dirty_io_active); sz = 2+5; if (dirty_cpu_total) sz += 2+5; if (dirty_io_total) sz += 2+5; hp = HAlloc(BIF_P, sz); res = NIL; if (dirty_io_total) { tpl = TUPLE4(hp, am_dirty_io, make_small(dirty_io_total), make_small(dirty_io_total), make_small(dirty_io_active)); hp += 5; res = CONS(hp, tpl, res); hp += 2; } if (dirty_cpu_total) { tpl = TUPLE4(hp, am_dirty_cpu, make_small(dirty_cpu_total), make_small(dirty_cpu_online), make_small(dirty_cpu_active)); hp += 5; res = CONS(hp, tpl, res); hp += 2; } tpl = TUPLE4(hp, am_normal, make_small(total), make_small(online), make_small(active)); hp += 5; res = CONS(hp, tpl, res); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("schedulers_online", BIF_ARG_1)) { Uint online; erts_schedulers_state(NULL, &online, NULL, NULL, NULL, NULL, NULL, NULL); BIF_RET(make_small(online)); } else if (ERTS_IS_ATOM_STR("schedulers_active", BIF_ARG_1)) { Uint active; erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL); BIF_RET(make_small(active)); } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) { Uint dirty_cpu; erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL); BIF_RET(make_small(dirty_cpu)); } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) { Uint dirty_cpu_onln; erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL); BIF_RET(make_small(dirty_cpu_onln)); } else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) { Uint dirty_io; erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL); BIF_RET(make_small(dirty_io)); } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { res = make_small(erts_no_run_queues); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("port_parallelism", BIF_ARG_1)) { res = erts_port_parallelism ? am_true : am_false; BIF_RET(res); } else if (ERTS_IS_ATOM_STR("c_compiler_used", BIF_ARG_1)) { Eterm *hp = NULL; Uint sz = 0; (void) c_compiler_used(NULL, &sz); if (sz) hp = HAlloc(BIF_P, sz); BIF_RET(c_compiler_used(&hp, NULL)); } else if (ERTS_IS_ATOM_STR("stop_memory_trace", BIF_ARG_1)) { erts_mtrace_stop(); BIF_RET(am_true); } else if (ERTS_IS_ATOM_STR("context_reductions", BIF_ARG_1)) { BIF_RET(make_small(CONTEXT_REDS)); } else if (ERTS_IS_ATOM_STR("kernel_poll", BIF_ARG_1)) { #if ERTS_ENABLE_KERNEL_POLL BIF_RET(am_true); #else BIF_RET(am_false); #endif } else if (ERTS_IS_ATOM_STR("lock_checking", BIF_ARG_1)) { #ifdef ERTS_ENABLE_LOCK_CHECK BIF_RET(am_true); #else BIF_RET(am_false); #endif } else if (ERTS_IS_ATOM_STR("lock_counting", BIF_ARG_1)) { #ifdef ERTS_ENABLE_LOCK_COUNT BIF_RET(am_true); #else BIF_RET(am_false); #endif } else if (ERTS_IS_ATOM_STR("debug_compiled", BIF_ARG_1)) { #ifdef DEBUG BIF_RET(am_true); #else BIF_RET(am_false); #endif } else if (ERTS_IS_ATOM_STR("check_io", BIF_ARG_1)) { BIF_RET(erts_check_io_info(BIF_P)); } else if (ERTS_IS_ATOM_STR("multi_scheduling_blockers", BIF_ARG_1)) { if (erts_no_schedulers == 1) BIF_RET(NIL); else BIF_RET(erts_multi_scheduling_blockers(BIF_P, 0)); } else if (ERTS_IS_ATOM_STR("normal_multi_scheduling_blockers", BIF_ARG_1)) { if (erts_no_schedulers == 1) BIF_RET(NIL); else BIF_RET(erts_multi_scheduling_blockers(BIF_P, 1)); } else if (ERTS_IS_ATOM_STR("modified_timing_level", BIF_ARG_1)) { BIF_RET(ERTS_USE_MODIFIED_TIMING() ? make_small(erts_modified_timing_level) : am_undefined); } else if (ERTS_IS_ATOM_STR("port_tasks", BIF_ARG_1)) { BIF_RET(am_true); } else if (ERTS_IS_ATOM_STR("io_thread", BIF_ARG_1)) { BIF_RET(am_false); } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { BIF_RET(erts_sched_stat_term(BIF_P, 0)); } else if (ERTS_IS_ATOM_STR("total_scheduling_statistics", BIF_ARG_1)) { BIF_RET(erts_sched_stat_term(BIF_P, 1)); } else if (ERTS_IS_ATOM_STR("taints", BIF_ARG_1)) { BIF_RET(erts_nif_taints(BIF_P)); } else if (ERTS_IS_ATOM_STR("reader_groups_map", BIF_ARG_1)) { BIF_RET(erts_get_reader_groups_map(BIF_P)); } else if (ERTS_IS_ATOM_STR("dist_buf_busy_limit", BIF_ARG_1)) { Uint hsz = 0; (void) erts_bld_uint(NULL, &hsz, erts_dist_buf_busy_limit); hp = hsz ? HAlloc(BIF_P, hsz) : NULL; res = erts_bld_uint(&hp, NULL, erts_dist_buf_busy_limit); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("delayed_node_table_gc", BIF_ARG_1)) { Uint hsz = 0; Uint dntgc = erts_delayed_node_table_gc(); if (dntgc == ERTS_NODE_TAB_DELAY_GC_INFINITY) BIF_RET(am_infinity); (void) erts_bld_uint(NULL, &hsz, dntgc); hp = hsz ? HAlloc(BIF_P, hsz) : NULL; res = erts_bld_uint(&hp, NULL, dntgc); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ethread_info", BIF_ARG_1)) { BIF_RET(erts_get_ethread_info(BIF_P)); } else if (ERTS_IS_ATOM_STR("emu_args", BIF_ARG_1)) { BIF_RET(erts_get_emu_args(BIF_P)); } else if (ERTS_IS_ATOM_STR("beam_jump_table", BIF_ARG_1)) { BIF_RET(erts_beam_jump_table() ? am_true : am_false); } else if (ERTS_IS_ATOM_STR("dynamic_trace", BIF_ARG_1)) { #if defined(USE_DTRACE) DECL_AM(dtrace); BIF_RET(AM_dtrace); #elif defined(USE_SYSTEMTAP) DECL_AM(systemtap); BIF_RET(AM_systemtap); #elif defined(USE_LTTNG) DECL_AM(lttng); BIF_RET(AM_lttng); #else BIF_RET(am_none); #endif } else if (ERTS_IS_ATOM_STR("dynamic_trace_probes", BIF_ARG_1)) { #if defined(USE_VM_PROBES) BIF_RET(am_true); #else BIF_RET(am_false); #endif } else if (ERTS_IS_ATOM_STR("thread_progress", BIF_ARG_1)) { erts_thr_progress_dbg_print_state(); BIF_RET(am_true); } else if (BIF_ARG_1 == am_message_queue_data) { switch (erts_default_spo_flags & (SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ)) { case SPO_OFF_HEAP_MSGQ: BIF_RET(am_off_heap); case SPO_ON_HEAP_MSGQ: BIF_RET(am_on_heap); default: ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); BIF_RET(am_error); } } else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) { Uint sz; Eterm res = NIL, tup, text; Eterm *hp = HAlloc(BIF_P, 3*(2 + 3) + /* three 2-tuples and three cons */ 2*(sys_strlen(erts_build_flags_CONFIG_H) + sys_strlen(erts_build_flags_CFLAGS) + sys_strlen(erts_build_flags_LDFLAGS))); sz = sys_strlen(erts_build_flags_CONFIG_H); text = buf_to_intlist(&hp, erts_build_flags_CONFIG_H, sz, NIL); tup = TUPLE2(hp, am_config_h, text); hp += 3; res = CONS(hp, tup, res); hp += 2; sz = sys_strlen(erts_build_flags_CFLAGS); text = buf_to_intlist(&hp, erts_build_flags_CFLAGS, sz, NIL); tup = TUPLE2(hp, am_cflags, text); hp += 3; res = CONS(hp, tup, res); hp += 2; sz = sys_strlen(erts_build_flags_LDFLAGS); text = buf_to_intlist(&hp, erts_build_flags_LDFLAGS, sz, NIL); tup = TUPLE2(hp, am_ldflags, text); hp += 3; res = CONS(hp, tup, res); hp += 2; BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ets_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_db_get_max_tabs())); } else if (ERTS_IS_ATOM_STR("ets_count",BIF_ARG_1)) { BIF_RET(make_small(erts_ets_table_count())); } else if (ERTS_IS_ATOM_STR("atom_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_get_atom_limit())); } else if (ERTS_IS_ATOM_STR("atom_count",BIF_ARG_1)) { BIF_RET(make_small(atom_table_size())); } else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { if (erts_has_time_correction() && erts_time_offset_state() == ERTS_TIME_OFFSET_FINAL) { BIF_RET(am_enabled); } BIF_RET(am_disabled); } else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) { BIF_RET(am_true); } else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) { #ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE #ifdef ARCH_64 DECL_AM(range); BIF_RET(AM_range); #else /* ARCH_32 */ DECL_AM(range_bitmask); BIF_RET(AM_range_bitmask); #endif /* ARCH_32 */ #else /* ! ERTS_HAVE_IS_IN_LITERAL_RANGE */ DECL_AM(tag); BIF_RET(AM_tag); #endif } else if (ERTS_IS_ATOM_STR("system_logger", BIF_ARG_1)) { BIF_RET(erts_get_system_logger()); } BIF_ERROR(BIF_P, BADARG); } static int monitor_size(ErtsMonitor *mon, void *vsz, Sint reds) { *((Uint *) vsz) = erts_monitor_size(mon); return 1; } static int link_size(ErtsMonitor *lnk, void *vsz, Sint reds) { *((Uint *) vsz) = erts_link_size(lnk); return 1; } /**********************************************************************/ /* Return information on ports */ /* Info: ** id Port index ** connected (Pid) ** links List of pids ** name String ** input Number of bytes input from port program ** output Number of bytes output to the port program ** os_pid The child's process ID */ Eterm erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm item) { Eterm res = THE_NON_VALUE; ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)); if (item == am_id) { if (hpp) res = make_small(internal_port_index(prt->common.id)); if (szp) { res = am_true; goto done; } } else if (item == am_links) { MonitorInfoCollection mic; int i; Eterm item; INIT_MONITOR_INFOS(mic); erts_link_tree_foreach(ERTS_P_LINKS(prt), collect_one_link, (void *) &mic); if (szp) *szp += mic.sz; if (hpp) { res = NIL; for (i = 0; i < mic.mi_i; i++) { item = STORE_NC(hpp, ohp, mic.mi[i].entity.term); res = CONS(*hpp, item, res); *hpp += 2; } } DESTROY_MONITOR_INFOS(mic); if (szp) { res = am_true; goto done; } } else if (item == am_monitors) { MonitorInfoCollection mic; int i; INIT_MONITOR_INFOS(mic); erts_monitor_tree_foreach(ERTS_P_MONITORS(prt), collect_one_origin_monitor, (void *) &mic); if (szp) *szp += mic.sz; if (hpp) { res = NIL; for (i = 0; i < mic.mi_i; i++) { Eterm t; ASSERT(mic.mi[i].type == ERTS_MON_TYPE_PORT); ASSERT(is_internal_pid(mic.mi[i].entity.term)); t = TUPLE2(*hpp, am_process, mic.mi[i].entity.term); *hpp += 3; res = CONS(*hpp, t, res); *hpp += 2; } } // hpp DESTROY_MONITOR_INFOS(mic); if (szp) { res = am_true; goto done; } } else if (item == am_monitored_by) { MonitorInfoCollection mic; int i; Eterm item; INIT_MONITOR_INFOS(mic); erts_monitor_list_foreach(ERTS_P_LT_MONITORS(prt), collect_one_target_monitor, (void *) &mic); erts_monitor_tree_foreach(ERTS_P_MONITORS(prt), collect_one_target_monitor, (void *) &mic); if (szp) *szp += mic.sz; if (hpp) { res = NIL; for (i = 0; i < mic.mi_i; ++i) { ASSERT(mic.mi[i].type != ERTS_MON_TYPE_RESOURCE); item = STORE_NC(hpp, ohp, mic.mi[i].entity.term); res = CONS(*hpp, item, res); *hpp += 2; } } // hpp DESTROY_MONITOR_INFOS(mic); if (szp) { res = am_true; goto done; } } else if (item == am_name) { int count = sys_strlen(prt->name); if (hpp) res = buf_to_intlist(hpp, prt->name, count, NIL); if (szp) { *szp += 2*count; res = am_true; goto done; } } else if (item == am_connected) { if (hpp) res = ERTS_PORT_GET_CONNECTED(prt); /* internal pid */ if (szp) { res = am_true; goto done; } } else if (item == am_input) { res = erts_bld_uint(hpp, szp, prt->bytes_in); if (szp) { res = am_true; goto done; } } else if (item == am_output) { res = erts_bld_uint(hpp, szp, prt->bytes_out); if (szp) { res = am_true; goto done; } } else if (item == am_os_pid) { res = (prt->os_pid < 0 ? am_undefined : erts_bld_uword(hpp, szp, (UWord) prt->os_pid)); if (szp) { res = am_true; goto done; } } else if (item == am_registered_name) { RegProc *reg = prt->common.u.alive.reg; if (reg) { res = reg->name; if (szp) { res = am_true; goto done; } } else { if (szp) return am_undefined; return NIL; } } else if (item == am_memory) { /* All memory consumed in bytes (the Port struct should not be included though). */ Uint size = 0; erts_link_tree_foreach(ERTS_P_LINKS(prt), link_size, (void *) &size); erts_monitor_tree_foreach(ERTS_P_MONITORS(prt), monitor_size, (void *) &size); erts_monitor_list_foreach(ERTS_P_LT_MONITORS(prt), monitor_size, (void *) &size); size += erts_port_data_size(prt); if (prt->linebuf) size += sizeof(LineBuf) + prt->linebuf->ovsiz; /* ... */ /* All memory allocated by the driver should be included, but it is hard to retrieve... */ res = erts_bld_uint(hpp, szp, size); if (szp) { res = am_true; goto done; } } else if (item == am_queue_size) { Uint ioq_size = erts_port_ioq_size(prt); res = erts_bld_uint(hpp, szp, ioq_size); if (szp) { res = am_true; goto done; } } else if (ERTS_IS_ATOM_STR("locking", item)) { if (hpp) { if (erts_atomic32_read_nob(&prt->state) & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) { DECL_AM(port_level); ASSERT(prt->drv_ptr->flags & ERL_DRV_FLAG_USE_PORT_LOCKING); res = AM_port_level; } else { DECL_AM(driver_level); ASSERT(!(prt->drv_ptr->flags & ERL_DRV_FLAG_USE_PORT_LOCKING)); res = AM_driver_level; } } if (szp) { res = am_true; goto done; } } else if (item == am_parallelism) { if (szp) { res = am_true; goto done; } res = ((ERTS_PTS_FLG_PARALLELISM & erts_atomic32_read_nob(&prt->sched.flags)) ? am_true : am_false); } else { if (szp) return am_false; return THE_NON_VALUE; } done: if (szp) *szp += 3; if (hpp) { res = TUPLE2(*hpp, item, res); *hpp += 3; } return res; } 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; if (is_fun(fun)) { ErlFunThing* funp = (ErlFunThing *) fun_val(fun); switch (what) { case am_type: hp = HAlloc(p, 3); val = am_local; break; case am_pid: hp = HAlloc(p, 3); val = funp->creator; break; case am_module: hp = HAlloc(p, 3); val = funp->fe->module; break; case am_new_index: hp = HAlloc(p, 3); val = make_small(funp->fe->index); break; case am_new_uniq: val = new_binary(p, funp->fe->uniq, 16); hp = HAlloc(p, 3); break; case am_index: hp = HAlloc(p, 3); val = make_small(funp->fe->old_index); break; case am_uniq: hp = HAlloc(p, 3); val = make_small(funp->fe->old_uniq); break; case am_env: { Uint num_free = funp->num_free; int i; hp = HAlloc(p, 3 + 2*num_free); val = NIL; for (i = num_free-1; i >= 0; i--) { val = CONS(hp, funp->env[i], val); hp += 2; } } break; case am_refc: val = erts_make_integer(erts_atomic_read_nob(&funp->fe->refc), p); hp = HAlloc(p, 3); break; case am_arity: hp = HAlloc(p, 3); val = make_small(funp->arity); break; case am_name: hp = HAlloc(p, 3); val = funp->fe->address[-2]; break; default: goto error; } } else if (is_export(fun)) { Export* exp = (Export *) ((UWord) (export_val(fun))[1]); switch (what) { case am_type: hp = HAlloc(p, 3); val = am_external; break; case am_pid: hp = HAlloc(p, 3); val = am_undefined; break; case am_module: hp = HAlloc(p, 3); val = exp->info.mfa.module; break; case am_new_index: hp = HAlloc(p, 3); val = am_undefined; break; case am_new_uniq: hp = HAlloc(p, 3); val = am_undefined; break; case am_index: hp = HAlloc(p, 3); val = am_undefined; break; case am_uniq: hp = HAlloc(p, 3); val = am_undefined; break; case am_env: hp = HAlloc(p, 3); val = NIL; break; case am_refc: hp = HAlloc(p, 3); val = am_undefined; break; case am_arity: hp = HAlloc(p, 3); val = make_small(exp->info.mfa.arity); break; case am_name: hp = HAlloc(p, 3); val = exp->info.mfa.function; break; default: goto error; } } else { error: BIF_ERROR(p, BADARG); } return TUPLE2(hp, what, val); } BIF_RETTYPE fun_info_mfa_1(BIF_ALIST_1) { Process* p = BIF_P; Eterm fun = BIF_ARG_1; Eterm* hp; if (is_fun(fun)) { ErlFunThing* funp = (ErlFunThing *) fun_val(fun); hp = HAlloc(p, 4); BIF_RET(TUPLE3(hp,funp->fe->module,funp->fe->address[-2],make_small(funp->arity))); } else if (is_export(fun)) { Export* exp = (Export *) ((UWord) (export_val(fun))[1]); hp = HAlloc(p, 4); BIF_RET(TUPLE3(hp,exp->info.mfa.module, exp->info.mfa.function, make_small(exp->info.mfa.arity))); } BIF_ERROR(p, BADARG); } BIF_RETTYPE erts_internal_is_process_alive_2(BIF_ALIST_2) { if (!is_internal_pid(BIF_ARG_1) || !is_internal_ordinary_ref(BIF_ARG_2)) BIF_ERROR(BIF_P, BADARG); erts_proc_sig_send_is_alive_request(BIF_P, BIF_ARG_1, BIF_ARG_2); BIF_RET(am_ok); } BIF_RETTYPE is_process_alive_1(BIF_ALIST_1) { if (is_internal_pid(BIF_ARG_1)) { erts_aint32_t state; Process *rp; if (BIF_ARG_1 == BIF_P->common.id) BIF_RET(am_true); rp = erts_proc_lookup_raw(BIF_ARG_1); if (!rp) BIF_RET(am_false); state = erts_atomic32_read_acqb(&rp->state); if (state & (ERTS_PSFLG_EXITING | ERTS_PSFLG_SIG_Q | ERTS_PSFLG_SIG_IN_Q)) { /* * If in exiting state, trap out and send 'is alive' * request and wait for it to complete termination. * * If process has signals enqueued, we need to * send it an 'is alive' request via its signal * queue in order to ensure that signal order is * preserved (we may earlier have sent it an * exit signal that has not been processed yet). */ BIF_TRAP1(is_process_alive_trap, BIF_P, BIF_ARG_1); } BIF_RET(am_true); } if (is_external_pid(BIF_ARG_1)) { if (external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) BIF_RET(am_false); /* A pid from an old incarnation of this node */ } BIF_ERROR(BIF_P, BADARG); } static Eterm process_display(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp) { if (redsp) *redsp = 1; if (ERTS_PROC_IS_EXITING(c_p)) return am_badarg; erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); erts_stack_dump(ERTS_PRINT_STDERR, NULL, c_p); erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); return am_true; } BIF_RETTYPE erts_internal_process_display_2(BIF_ALIST_2) { Eterm res; if (BIF_ARG_2 != am_backtrace) BIF_RET(am_badarg); if (BIF_P->common.id == BIF_ARG_1) { res = process_display(BIF_P, NULL, NULL, NULL); BIF_RET(res); } if (is_not_internal_pid(BIF_ARG_1)) BIF_RET(am_badarg); res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1, !0, process_display, NULL); if (is_non_value(res)) BIF_RET(am_badarg); BIF_RET(res); } /* this is a general call which return some possibly useful information */ BIF_RETTYPE statistics_1(BIF_ALIST_1) { Eterm res; Eterm* hp; if (BIF_ARG_1 == am_scheduler_wall_time) { res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 0); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); } else if (BIF_ARG_1 == am_scheduler_wall_time_all) { res = erts_sched_wall_time_request(BIF_P, 0, 0, 1, 1); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); } else if ((BIF_ARG_1 == am_total_active_tasks) | (BIF_ARG_1 == am_total_run_queue_lengths) | (BIF_ARG_1 == am_total_active_tasks_all) | (BIF_ARG_1 == am_total_run_queue_lengths_all)) { Uint no = erts_run_queues_len(NULL, 0, ((BIF_ARG_1 == am_total_active_tasks) | (BIF_ARG_1 == am_total_active_tasks_all)), ((BIF_ARG_1 == am_total_active_tasks_all) | (BIF_ARG_1 == am_total_run_queue_lengths_all))); if (IS_USMALL(0, no)) res = make_small(no); else { Eterm *hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); res = uint_to_big(no, hp); } BIF_RET(res); } else if ((BIF_ARG_1 == am_active_tasks) | (BIF_ARG_1 == am_run_queue_lengths) | (BIF_ARG_1 == am_active_tasks_all) | (BIF_ARG_1 == am_run_queue_lengths_all)) { Eterm res, *hp, **hpp; Uint sz, *szp; int incl_dirty_io = ((BIF_ARG_1 == am_active_tasks_all) | (BIF_ARG_1 == am_run_queue_lengths_all)); int no_qs = (erts_no_run_queues + ERTS_NUM_DIRTY_CPU_RUNQS + (incl_dirty_io ? ERTS_NUM_DIRTY_IO_RUNQS : 0)); Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2); (void) erts_run_queues_len(qszs, 0, ((BIF_ARG_1 == am_active_tasks) | (BIF_ARG_1 == am_active_tasks_all)), incl_dirty_io); sz = 0; szp = &sz; hpp = NULL; while (1) { int i; for (i = 0; i < no_qs; i++) qszs[no_qs+i] = erts_bld_uint(hpp, szp, qszs[i]); res = erts_bld_list(hpp, szp, no_qs, &qszs[no_qs]); if (hpp) { erts_free(ERTS_ALC_T_TMP, qszs); BIF_RET(res); } hp = HAlloc(BIF_P, sz); szp = NULL; hpp = &hp; } #ifdef ERTS_ENABLE_MSACC } else if (BIF_ARG_1 == am_microstate_accounting) { Eterm threads; res = erts_msacc_request(BIF_P, ERTS_MSACC_GATHER, &threads); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP2(gather_msacc_res_trap, BIF_P, res, threads); #endif } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, cs, SMALL_ZERO); BIF_RET(res); } else if (BIF_ARG_1 == am_garbage_collection) { res = erts_gc_info_request(BIF_P); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_gc_info_res_trap, BIF_P, res); } else if (BIF_ARG_1 == am_reductions) { Uint reds; Uint diff; Uint hsz = 3; Eterm b1, b2; erts_get_total_reductions(&reds, &diff); (void) erts_bld_uint(NULL, &hsz, reds); (void) erts_bld_uint(NULL, &hsz, diff); hp = HAlloc(BIF_P, hsz); b1 = erts_bld_uint(&hp, NULL, reds); b2 = erts_bld_uint(&hp, NULL, diff); res = TUPLE2(hp, b1, b2); BIF_RET(res); } else if (BIF_ARG_1 == am_exact_reductions) { Uint reds; Uint diff; Uint hsz = 3; Eterm b1, b2; erts_get_exact_total_reductions(BIF_P, &reds, &diff); (void) erts_bld_uint(NULL, &hsz, reds); (void) erts_bld_uint(NULL, &hsz, diff); hp = HAlloc(BIF_P, hsz); b1 = erts_bld_uint(&hp, NULL, reds); b2 = erts_bld_uint(&hp, NULL, diff); res = TUPLE2(hp, b1, b2); BIF_RET(res); } else if (BIF_ARG_1 == am_runtime) { ErtsMonotonicTime u1, u2; Eterm b1, b2; Uint hsz; erts_runtime_elapsed_both(&u1, NULL, &u2, NULL); hsz = 3; /* 2-tuple */ (void) erts_bld_monotonic_time(NULL, &hsz, u1); (void) erts_bld_monotonic_time(NULL, &hsz, u2); hp = HAlloc(BIF_P, hsz); b1 = erts_bld_monotonic_time(&hp, NULL, u1); b2 = erts_bld_monotonic_time(&hp, NULL, u2); res = TUPLE2(hp, b1, b2); BIF_RET(res); } else if (BIF_ARG_1 == am_run_queue) { res = erts_run_queues_len(NULL, 1, 0, 0); BIF_RET(make_small(res)); } else if (BIF_ARG_1 == am_wall_clock) { ErtsMonotonicTime w1, w2; Eterm b1, b2; Uint hsz; erts_wall_clock_elapsed_both(&w1, &w2); hsz = 3; /* 2-tuple */ (void) erts_bld_monotonic_time(NULL, &hsz, w1); (void) erts_bld_monotonic_time(NULL, &hsz, w2); hp = HAlloc(BIF_P, hsz); b1 = erts_bld_monotonic_time(&hp, NULL, w1); b2 = erts_bld_monotonic_time(&hp, NULL, w2); res = TUPLE2(hp, b1, b2); BIF_RET(res); } else if (BIF_ARG_1 == am_io) { Eterm ref = erts_request_io_bytes(BIF_P); BIF_TRAP2(gather_io_bytes_trap, BIF_P, ref, make_small(erts_no_schedulers)); } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { Eterm res, *hp, **hpp; Uint sz, *szp; int no_qs = erts_no_run_queues + ERTS_NUM_DIRTY_RUNQS; Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2); (void) erts_run_queues_len(qszs, 0, 0, 1); sz = 0; szp = &sz; hpp = NULL; while (1) { int i; for (i = 0; i < no_qs; i++) qszs[no_qs+i] = erts_bld_uint(hpp, szp, qszs[i]); res = erts_bld_tuplev(hpp, szp, no_qs, &qszs[no_qs]); if (hpp) { erts_free(ERTS_ALC_T_TMP, qszs); BIF_RET(res); } hp = HAlloc(BIF_P, sz); szp = NULL; hpp = &hp; } } BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0) { BIF_RET(erts_error_logger_warnings); } static erts_atomic_t available_internal_state; static int empty_magic_ref_destructor(Binary *bin) { return 1; } 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) */ Eterm res = erts_get_node_and_dist_references(BIF_P); BIF_RET(res); } 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 (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); switch (arityval(tp[0])) { case 2: { 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, local_only; 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); } local_only = 0; do { int reds = CONTEXT_REDS; sigs_done = erts_proc_sig_handle_incoming(p, &state, &reds, CONTEXT_REDS, local_only); local_only = !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, local_only; 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); } local_only = 0; do { int reds = CONTEXT_REDS; sigs_done = erts_proc_sig_handle_incoming(p, &state, &reds, CONTEXT_REDS, local_only); local_only = !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])) { Uint dflags = (TERM_TO_BINARY_DFLAGS & ~DFLAG_EXPORT_PTR_TAG & ~DFLAG_BIT_BINARIES); BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags)); } 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); } break; } default: break; } } BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE erts_internal_is_system_process_1(BIF_ALIST_1) { if (is_internal_pid(BIF_ARG_1)) { Process *rp = erts_proc_lookup(BIF_ARG_1); if (rp && (rp->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) BIF_RET(am_true); BIF_RET(am_false); } if (is_external_pid(BIF_ARG_1) && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { BIF_RET(am_false); } BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE erts_internal_system_check_1(BIF_ALIST_1) { Eterm res; if (ERTS_IS_ATOM_STR("schedulers", BIF_ARG_1)) { res = erts_system_check_request(BIF_P); if (is_non_value(res)) BIF_RET(am_undefined); BIF_TRAP1(gather_system_check_res_trap, BIF_P, res); } BIF_ERROR(BIF_P, BADARG); } static erts_atomic_t hipe_test_reschedule_flag; #if defined(VALGRIND) && defined(__GNUC__) /* Force noinline for valgrind suppression */ static void broken_halt_test(Eterm bif_arg_2) __attribute__((noinline)); #endif static void broken_halt_test(Eterm bif_arg_2) { /* Ugly ugly code used by bif_SUITE:erlang_halt/1 */ #if defined(ERTS_HAVE_TRY_CATCH) erts_get_scheduler_data()->run_queue = NULL; #endif erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2); } 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("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_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; if (flag && erts_debug_wait_completed(BIF_P, flag)) { ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); } } 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("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); } } BIF_ERROR(BIF_P, BADARG); } static BIF_RETTYPE gather_histograms_helper(Process * c_p, Eterm arg_tuple, int gather(Process *, int, int, int, UWord, Eterm)) { SWord hist_start, hist_width, sched_id; int msg_count, alloc_num; Eterm *args; /* This is an internal BIF, so the error checking is mostly left to erlang * code. */ ASSERT(is_tuple_arity(arg_tuple, 5)); args = tuple_val(arg_tuple); for (alloc_num = ERTS_ALC_A_MIN; alloc_num <= ERTS_ALC_A_MAX; alloc_num++) { if(erts_is_atom_str(ERTS_ALC_A2AD(alloc_num), args[1], 0)) { break; } } if (alloc_num > ERTS_ALC_A_MAX) { BIF_ERROR(c_p, BADARG); } sched_id = signed_val(args[2]); hist_width = signed_val(args[3]); hist_start = signed_val(args[4]); if (sched_id < 0 || sched_id > erts_no_schedulers) { BIF_ERROR(c_p, BADARG); } msg_count = gather(c_p, alloc_num, sched_id, hist_width, hist_start, args[5]); BIF_RET(make_small(msg_count)); } BIF_RETTYPE erts_internal_gather_alloc_histograms_1(BIF_ALIST_1) { return gather_histograms_helper(BIF_P, BIF_ARG_1, erts_alcu_gather_alloc_histograms); } BIF_RETTYPE erts_internal_gather_carrier_info_1(BIF_ALIST_1) { return gather_histograms_helper(BIF_P, BIF_ARG_1, erts_alcu_gather_carrier_info); } #ifdef ERTS_ENABLE_LOCK_COUNT typedef struct { /* info->location_count may increase between size calculation and term * building, so we cap it at the value sampled in lcnt_build_result_vector. * * Shrinking is safe though. */ int max_location_count; erts_lcnt_lock_info_t *info; } lcnt_sample_t; typedef struct lcnt_sample_vector_ { lcnt_sample_t *elements; size_t size; } lcnt_sample_vector_t; static lcnt_sample_vector_t lcnt_build_sample_vector(erts_lcnt_lock_info_list_t *list) { erts_lcnt_lock_info_t *iterator; lcnt_sample_vector_t result; size_t allocated_entries; allocated_entries = 64; result.size = 0; result.elements = erts_alloc(ERTS_ALC_T_LCNT_VECTOR, allocated_entries * sizeof(lcnt_sample_t)); iterator = NULL; while(erts_lcnt_iterate_list(list, &iterator)) { erts_lcnt_retain_lock_info(iterator); result.elements[result.size].max_location_count = iterator->location_count; result.elements[result.size].info = iterator; result.size++; if(result.size >= allocated_entries) { allocated_entries *= 2; result.elements = erts_realloc(ERTS_ALC_T_LCNT_VECTOR, result.elements, allocated_entries * sizeof(lcnt_sample_t)); } } return result; } static void lcnt_destroy_sample_vector(lcnt_sample_vector_t *vector) { size_t i; for(i = 0; i < vector->size; i++) { erts_lcnt_release_lock_info(vector->elements[i].info); } erts_free(ERTS_ALC_T_LCNT_VECTOR, vector->elements); } /* The size of an integer is not guaranteed to be constant since we're walking * over live data, and may cross over into bignum territory between size calc * and the actual build. This takes care of that through always assuming the * worst, but needs to be fixed up with HRelease once the final term has been * built. */ static ERTS_INLINE Eterm bld_unstable_uint64(Uint **hpp, Uint *szp, Uint64 ui) { Eterm res = THE_NON_VALUE; if(szp) { *szp += ERTS_UINT64_HEAP_SIZE(~((Uint64) 0)); } if(hpp) { if (IS_USMALL(0, ui)) { res = make_small(ui); } else { res = erts_uint64_to_big(ui, hpp); } } return res; } static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_stats_t *stats, Eterm res) { unsigned int i; const char *file; Eterm af, uil; Eterm uit, uic; Eterm uits, uitns, uitn; Eterm tt, tstat, tloc, t; Eterm thist, vhist[ERTS_LCNT_HISTOGRAM_SLOT_SIZE]; /* term: * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}}, * { .. histogram .. }] */ file = stats->file ? stats->file : "undefined"; af = erts_atom_put((byte *)file, sys_strlen(file), ERTS_ATOM_ENC_LATIN1, 1); uil = erts_bld_uint( hpp, szp, stats->line); tloc = erts_bld_tuple(hpp, szp, 2, af, uil); uit = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->attempts)); uic = bld_unstable_uint64(hpp, szp, (Uint)ethr_atomic_read(&stats->collisions)); uits = bld_unstable_uint64(hpp, szp, stats->total_time_waited.s); uitns = bld_unstable_uint64(hpp, szp, stats->total_time_waited.ns); uitn = bld_unstable_uint64(hpp, szp, stats->times_waited); tt = erts_bld_tuple(hpp, szp, 3, uits, uitns, uitn); tstat = erts_bld_tuple(hpp, szp, 3, uit, uic, tt); for(i = 0; i < ERTS_LCNT_HISTOGRAM_SLOT_SIZE; i++) { vhist[i] = bld_unstable_uint64(hpp, szp, stats->wait_time_histogram.ns[i]); } thist = erts_bld_tuplev(hpp, szp, ERTS_LCNT_HISTOGRAM_SLOT_SIZE, vhist); t = erts_bld_tuple(hpp, szp, 3, tloc, tstat, thist); res = erts_bld_cons( hpp, szp, t, res); return res; } static Eterm lcnt_pretty_print_lock_id(erts_lcnt_lock_info_t *info) { Eterm id = info->id; if((info->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == ERTS_LOCK_FLAGS_TYPE_PROCLOCK) { /* Use registered names as id's for process locks if available. Thread * progress is delayed since we may be running on a dirty scheduler. */ ErtsThrPrgrDelayHandle delay_handle; Process *process; delay_handle = erts_thr_progress_unmanaged_delay(); process = erts_proc_lookup(info->id); if (process && process->common.u.alive.reg) { id = process->common.u.alive.reg->name; } erts_thr_progress_unmanaged_continue(delay_handle); } else if(info->flags & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) { if(is_small(id) && !sys_strcmp(info->name, "alcu_allocator")) { const char *name = (const char*)ERTS_ALC_A2AD(signed_val(id)); id = erts_atom_put((byte*)name, sys_strlen(name), ERTS_ATOM_ENC_LATIN1, 1); } } return id; } static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, lcnt_sample_t *sample, Eterm res) { erts_lcnt_lock_info_t *info = sample->info; Eterm name, type, id, stats = NIL, t; const char *lock_desc; int i; /* term: [{name, id, type, stats()}] */ ASSERT(info->name); lock_desc = erts_lock_flags_get_type_name(info->flags); type = erts_atom_put((byte*)lock_desc, sys_strlen(lock_desc), ERTS_ATOM_ENC_LATIN1, 1); name = erts_atom_put((byte*)info->name, sys_strlen(info->name), ERTS_ATOM_ENC_LATIN1, 1); /* Only attempt to resolve ids when actually emitting the term. This ought * to be safe since all immediates are the same size. */ if(hpp != NULL) { id = lcnt_pretty_print_lock_id(info); } else { id = NIL; } for(i = 0; i < MIN(info->location_count, sample->max_location_count); i++) { stats = lcnt_build_lock_stats_term(hpp, szp, &(info->location_stats[i]), stats); } t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats); res = erts_bld_cons(hpp, szp, t, res); return res; } static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_time_t *duration, lcnt_sample_vector_t *current_locks, lcnt_sample_vector_t *deleted_locks, Eterm res) { const char *str_duration = "duration"; const char *str_locks = "locks"; Eterm dts, dtns, tdt, adur, tdur, aloc, lloc = NIL, tloc; size_t i; /* term: [{'duration', {seconds, nanoseconds}}, {'locks', locks()}] */ /* duration tuple */ dts = bld_unstable_uint64(hpp, szp, duration->s); dtns = bld_unstable_uint64(hpp, szp, duration->ns); tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns); adur = erts_atom_put((byte *)str_duration, sys_strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1); tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt); /* lock tuple */ aloc = erts_atom_put((byte *)str_locks, sys_strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1); for(i = 0; i < current_locks->size; i++) { lloc = lcnt_build_lock_term(hpp, szp, ¤t_locks->elements[i], lloc); } for(i = 0; i < deleted_locks->size; i++) { lloc = lcnt_build_lock_term(hpp, szp, &deleted_locks->elements[i], lloc); } tloc = erts_bld_tuple(hpp, szp, 2, aloc, lloc); res = erts_bld_cons(hpp, szp, tloc, res); res = erts_bld_cons(hpp, szp, tdur, res); return res; } static struct { const char *name; erts_lock_flags_t flag; } lcnt_category_map[] = { {"allocator", ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR}, {"db", ERTS_LOCK_FLAGS_CATEGORY_DB}, {"debug", ERTS_LOCK_FLAGS_CATEGORY_DEBUG}, {"distribution", ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION}, {"generic", ERTS_LOCK_FLAGS_CATEGORY_GENERIC}, {"io", ERTS_LOCK_FLAGS_CATEGORY_IO}, {"process", ERTS_LOCK_FLAGS_CATEGORY_PROCESS}, {"scheduler", ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER}, {NULL, 0} }; static erts_lock_flags_t lcnt_atom_to_lock_category(Eterm atom) { int i = 0; for(i = 0; lcnt_category_map[i].name != NULL; i++) { if(erts_is_atom_str(lcnt_category_map[i].name, atom, 0)) { return lcnt_category_map[i].flag; } } return 0; } static Eterm lcnt_build_category_list(Eterm **hpp, Uint *szp, erts_lock_flags_t mask) { Eterm res; int i; res = NIL; for(i = 0; lcnt_category_map[i].name != NULL; i++) { if(mask & lcnt_category_map[i].flag) { Eterm category = erts_atom_put((byte*)lcnt_category_map[i].name, sys_strlen(lcnt_category_map[i].name), ERTS_ATOM_ENC_UTF8, 0); res = erts_bld_cons(hpp, szp, category, res); } } return res; } #endif BIF_RETTYPE erts_debug_lcnt_clear_0(BIF_ALIST_0) { #ifndef ERTS_ENABLE_LOCK_COUNT BIF_RET(am_error); #else erts_lcnt_clear_counters(); BIF_RET(am_ok); #endif } BIF_RETTYPE erts_debug_lcnt_collect_0(BIF_ALIST_0) { #ifndef ERTS_ENABLE_LOCK_COUNT BIF_RET(am_error); #else lcnt_sample_vector_t current_locks, deleted_locks; erts_lcnt_data_t data; Eterm *term_heap_start, *term_heap_end; Uint term_heap_size = 0; Eterm result; data = erts_lcnt_get_data(); current_locks = lcnt_build_sample_vector(data.current_locks); deleted_locks = lcnt_build_sample_vector(data.deleted_locks); lcnt_build_result_term(NULL, &term_heap_size, &data.duration, ¤t_locks, &deleted_locks, NIL); term_heap_start = HAlloc(BIF_P, term_heap_size); term_heap_end = term_heap_start; result = lcnt_build_result_term(&term_heap_end, NULL, &data.duration, ¤t_locks, &deleted_locks, NIL); HRelease(BIF_P, term_heap_start + term_heap_size, term_heap_end); lcnt_destroy_sample_vector(¤t_locks); lcnt_destroy_sample_vector(&deleted_locks); BIF_RET(result); #endif } BIF_RETTYPE erts_debug_lcnt_control_1(BIF_ALIST_1) { #ifdef ERTS_ENABLE_LOCK_COUNT if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) { erts_lock_flags_t mask; Eterm *term_heap_block; Uint term_heap_size; mask = erts_lcnt_get_category_mask(); term_heap_size = 0; lcnt_build_category_list(NULL, &term_heap_size, mask); term_heap_block = HAlloc(BIF_P, term_heap_size); BIF_RET(lcnt_build_category_list(&term_heap_block, NULL, mask)); } else if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) { if(erts_lcnt_get_preserve_info()) { BIF_RET(am_true); } BIF_RET(am_false); } #endif BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE erts_debug_lcnt_control_2(BIF_ALIST_2) { #ifdef ERTS_ENABLE_LOCK_COUNT if(ERTS_IS_ATOM_STR("mask", BIF_ARG_1)) { erts_lock_flags_t category_mask = 0; Eterm categories = BIF_ARG_2; if(!(is_list(categories) || is_nil(categories))) { BIF_ERROR(BIF_P, BADARG); } while(is_list(categories)) { Eterm *cell = list_val(categories); erts_lock_flags_t category; category = lcnt_atom_to_lock_category(CAR(cell)); if(!category) { Eterm *hp = HAlloc(BIF_P, 4); BIF_RET(TUPLE3(hp, am_error, am_badarg, CAR(cell))); } category_mask |= category; categories = CDR(cell); } erts_lcnt_set_category_mask(category_mask); BIF_RET(am_ok); } else if(BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { int enabled = (BIF_ARG_2 == am_true); if(ERTS_IS_ATOM_STR("copy_save", BIF_ARG_1)) { erts_lcnt_set_preserve_info(enabled); BIF_RET(am_ok); } } #endif BIF_ERROR(BIF_P, BADARG); } static void os_info_init(void) { Eterm type = erts_atom_put((byte *) os_type, sys_strlen(os_type), ERTS_ATOM_ENC_LATIN1, 1); 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 = erts_atom_put((byte *) buf, sys_strlen(buf), ERTS_ATOM_ENC_LATIN1, 1); erts_free(ERTS_ALC_T_TMP, (void *) buf); hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm)); os_type_tuple = TUPLE2(hp, type, flav); erts_set_literal_tag(&os_type_tuple, hp, 3); hp += 3; os_version(&major, &minor, &build); os_version_tuple = TUPLE3(hp, make_small(major), make_small(minor), make_small(build)); erts_set_literal_tag(&os_version_tuple, hp, 4); } void erts_bif_info_init(void) { erts_atomic_init_nob(&available_internal_state, 0); erts_atomic_init_nob(&hipe_test_reschedule_flag, 0); alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1); alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1); gather_sched_wall_time_res_trap = erts_export_put(am_erts_internal, am_gather_sched_wall_time_result, 1); gather_gc_info_res_trap = erts_export_put(am_erlang, am_gather_gc_info_result, 1); gather_io_bytes_trap = erts_export_put(am_erts_internal, am_gather_io_bytes, 2); gather_msacc_res_trap = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2); gather_system_check_res_trap = erts_export_put(am_erts_internal, am_gather_system_check_result, 1); is_process_alive_trap = erts_export_put(am_erts_internal, am_is_process_alive, 1); process_info_init(); os_info_init(); }