/erts/emulator/beam/erl_bif_info.c

Large files files are truncated, but you can click here to view the full file

/*
 * %CopyrightBegin%
 *
 * Copyright Ericsson AB 1999-2011. All Rights Reserved.
 *
 * The contents of this file are subject to the Erlang Public License,
 * Version 1.1, (the "License"); you may not use this file except in
 * compliance with the License. You should have received a copy of the
 * Erlang Public License along with this software. If not, it can be
 * retrieved online at http://www.erlang.org/.
 *
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 *
 * %CopyrightEnd%
 */

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "erl_nmgc.h"
#include "error.h"
#include "erl_driver.h"
#include "bif.h"
#include "big.h"
#include "erl_version.h"
#include "erl_db_util.h"
#include "erl_message.h"
#include "erl_binary.h"
#include "erl_db.h"
#include "erl_instrument.h"
#include "dist.h"
#include "erl_gc.h"
#include "erl_cpu_topology.h"
#include "erl_async.h"
#include "erl_thr_progress.h"
#ifdef HIPE
#include "hipe_arch.h"
#endif

#ifdef ERTS_ENABLE_LOCK_COUNT
#include "erl_lock_count.h"
#endif

#ifdef VALGRIND
#include <valgrind/valgrind.h>
#include <valgrind/memcheck.h>
#endif

static Export* alloc_info_trap = NULL;
static Export* alloc_sizes_trap = NULL;

static Export *gather_sched_wall_time_res_trap;

#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)

/* Keep erts_system_version as a global variable for easy access from a core */
static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
				     " (erts-" ERLANG_VERSION ")"
#if !HEAP_ON_C_STACK && !HALFWORD_HEAP
				     " [no-c-stack-objects]"
#endif
#ifndef OTP_RELEASE
				     " [source]"
#endif	
#ifdef ARCH_64
#if HALFWORD_HEAP
				     " [64-bit halfword]"
#else
				     " [64-bit]"
#endif
#endif
#ifdef ERTS_SMP
				     " [smp:%beu:%beu]"
#endif
#ifdef USE_THREADS
				     " [async-threads:%d]"
#endif
#ifdef HIPE
				     " [hipe]"
#endif	
#ifdef ERTS_ENABLE_KERNEL_POLL
				     " [kernel-poll:%s]"
#endif	
#ifdef HYBRID
				     " [hybrid heap]"
#endif
#ifdef INCREMENTAL
				     " [incremental GC]"
#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 PURIFY
				     " [purify-compiled]"
#endif	
#ifdef VALGRIND
				     " [valgrind-compiled]"
#endif
				     "\n");

#define ASIZE(a) (sizeof(a)/sizeof(a[0]))

#if defined(HAVE_SOLARIS_SPARC_PERFMON)
# include <sys/ioccom.h>
# 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 BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item);

static Eterm
current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);

static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
{
    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_smp_atomic_read_nob(&pb->val->refc);
		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, % MON_ORIGIN or MON_TARGET (1 or 3)
	    ref,
	    pid, % Process or nodename
	    name % registered name or []
          }).
*/

static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
{
    Uint *psz = vpsz;
    *psz += IS_CONST(mon->ref) ? 0 : NC_HEAP_SIZE(mon->ref);
    *psz += IS_CONST(mon->pid) ? 0 : NC_HEAP_SIZE(mon->pid);
    *psz += 8; /* CONS + 5-tuple */ 
}

typedef struct {
    Process *p;
    Eterm *hp;
    Eterm res;
    Eterm tag;
} MonListContext;

static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
{
    MonListContext *pmlc = vpmlc;
    Eterm tup;
    Eterm r = (IS_CONST(mon->ref)
	       ? mon->ref
	       : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref));
    Eterm p = (IS_CONST(mon->pid)
	       ? mon->pid
	       : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->pid));
    tup = TUPLE5(pmlc->hp, pmlc->tag, make_small(mon->type), r, p, mon->name);
    pmlc->hp += 6;
    pmlc->res = CONS(pmlc->hp, tup, pmlc->res);
    pmlc->hp += 2;
}

static Eterm 
make_monitor_list(Process *p, ErtsMonitor *root)
{
    DECL_AM(erl_monitor);
    Uint sz = 0;
    MonListContext mlc;

    erts_doforall_monitors(root, &do_calc_mon_size, &sz);
    if (sz == 0) {
	return NIL;
    }
    mlc.p = p;
    mlc.hp = HAlloc(p,sz);
    mlc.res = NIL;
    mlc.tag = AM_erl_monitor;
    erts_doforall_monitors(root, &do_make_one_mon_element, &mlc);
    return mlc.res;
}

/*
  make_link_list:
  returns a list of records..
  -record(erl_link, {
            type, % LINK_NODE or LINK_PID (1 or 3)
	    pid, % Process or nodename
	    targets % List of erl_link's or nil
          }).
*/

static void do_calc_lnk_size(ErtsLink *lnk, void *vpsz)
{
    Uint *psz = vpsz;
    *psz += IS_CONST(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
    if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) { 
	/* Node links use this pointer as ref counter... */
	erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_calc_lnk_size,vpsz);
    }
    *psz += 7; /* CONS + 4-tuple */ 
}

typedef struct {
    Process *p;
    Eterm *hp;
    Eterm res;
    Eterm tag;
} LnkListContext;

static void do_make_one_lnk_element(ErtsLink *lnk, void * vpllc)
{
    LnkListContext *pllc = vpllc;
    Eterm tup;
    Eterm old_res, targets = NIL;
    Eterm p = (IS_CONST(lnk->pid)
	       ? lnk->pid
	       : STORE_NC(&(pllc->hp), &MSO(pllc->p), lnk->pid));
    if (lnk->type == LINK_NODE) {
	targets = make_small(ERTS_LINK_REFC(lnk));
    } else if (ERTS_LINK_ROOT(lnk) != NULL) {
	old_res = pllc->res;
	pllc->res = NIL;
	erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_make_one_lnk_element, vpllc);
	targets = pllc->res;
	pllc->res = old_res;
    }
    tup = TUPLE4(pllc->hp, pllc->tag, make_small(lnk->type), p, targets);
    pllc->hp += 5;
    pllc->res = CONS(pllc->hp, tup, pllc->res);
    pllc->hp += 2;
}

static Eterm 
make_link_list(Process *p, ErtsLink *root, Eterm tail)
{
    DECL_AM(erl_link);
    Uint sz = 0;
    LnkListContext llc;

    erts_doforall_links(root, &do_calc_lnk_size, &sz);
    if (sz == 0) {
	return tail;
    }
    llc.p = p;
    llc.hp = HAlloc(p,sz);
    llc.res = tail;
    llc.tag = AM_erl_link;
    erts_doforall_links(root, &do_make_one_lnk_element, &llc);
    return llc.res;
}

int
erts_print_system_version(int to, void *arg, Process *c_p)
{
#ifdef ERTS_SMP
    Uint total, online, active;
    (void) erts_schedulers_state(&total, &online, &active, 0);
#endif
    return erts_print(to, arg, erts_system_version
#ifdef ERTS_SMP
		      , total, online
#endif
#ifdef USE_THREADS
		      , erts_async_max_threads
#endif
#ifdef ERTS_ENABLE_KERNEL_POLL
		      , erts_use_kernel_poll ? "true" : "false"
#endif
	);
}

typedef struct {
    Eterm entity;
    Eterm node;
} 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 void collect_one_link(ErtsLink *lnk, void *vmicp)
{
    MonitorInfoCollection *micp = vmicp;
    EXTEND_MONITOR_INFOS(micp);
    if (!(lnk->type == LINK_PID)) {
	return;
    }
    micp->mi[micp->mi_i].entity = lnk->pid;
    micp->sz += 2 + NC_HEAP_SIZE(lnk->pid);
    micp->mi_i++;
} 

static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
{
    MonitorInfoCollection *micp = vmicp;
 
    if (mon->type != MON_ORIGIN) {
	return;
    }
    EXTEND_MONITOR_INFOS(micp);
    if (is_atom(mon->pid)) { /* external by name */
	micp->mi[micp->mi_i].entity = mon->name;
	micp->mi[micp->mi_i].node = mon->pid;
	micp->sz += 3; /* need one 2-tuple */
    } else if (is_external_pid(mon->pid)) { /* external by pid */
	micp->mi[micp->mi_i].entity = mon->pid;
	micp->mi[micp->mi_i].node = NIL;
	micp->sz += NC_HEAP_SIZE(mon->pid);
    } else if (!is_nil(mon->name)) { /* internal by name */
	micp->mi[micp->mi_i].entity = mon->name;
	micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
	micp->sz += 3; /* need one 2-tuple */
    } else { /* internal by pid */
	micp->mi[micp->mi_i].entity = mon->pid;
	micp->mi[micp->mi_i].node = NIL;
	/* no additional heap space needed */
    }
    micp->mi_i++;
    micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */
}

static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
{
    MonitorInfoCollection *micp = vmicp;
 
    if (mon->type != MON_TARGET) {
	return;
    }

    EXTEND_MONITOR_INFOS(micp);
  
    micp->mi[micp->mi_i].node = NIL;
    micp->mi[micp->mi_i].entity = mon->pid;
    micp->sz += (NC_HEAP_SIZE(mon->pid) + 2 /* cons */);
    micp->mi_i++;
}

typedef struct {
    Process *c_p;
    ErtsProcLocks c_p_locks;
    ErtsSuspendMonitor **smi;
    Uint smi_i;
    Uint smi_max;
    int sz;
} ErtsSuspendMonitorInfoCollection;

#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC, CP, CPL) do {		\
    (SMIC).c_p = (CP);							\
    (SMIC).c_p_locks = (CPL);						\
    (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(ErtsSuspendMonitor *))	\
			: erts_alloc(ERTS_ALC_T_TMP,			\
				     ERTS_SMI_INC			\
				     * sizeof(ErtsSuspendMonitor *)));	\
	(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 void
collect_one_suspend_monitor(ErtsSuspendMonitor *smon, void *vsmicp)
{
    ErtsSuspendMonitorInfoCollection *smicp = vsmicp;
    Process *suspendee = erts_pid2proc(smicp->c_p,
				       smicp->c_p_locks,
				       smon->pid,
				       0);
    if (suspendee) { /* suspendee is alive */
	Sint a, p;
	if (smon->active) {
	    smon->active += smon->pending;
	    smon->pending = 0;
	}

	ASSERT((smon->active && !smon->pending)
	       || (smon->pending && !smon->active));

	ERTS_EXTEND_SUSPEND_MONITOR_INFOS(smicp);

	smicp->smi[smicp->smi_i] = smon;
	smicp->sz += 2 /* cons */ + 4 /* 3-tuple */;

	a = (Sint) smon->active;	/* quiet compiler warnings */
	p = (Sint) smon->pending;	/* on 64-bit machines      */

	if (!IS_SSMALL(a))
	    smicp->sz += BIG_UINT_HEAP_SIZE;
	if (!IS_SSMALL(p))
	    smicp->sz += BIG_UINT_HEAP_SIZE;
	smicp->smi_i++;
    }
}


static void one_link_size(ErtsLink *lnk, void *vpu)
{
    Uint *pu = vpu;
    *pu += ERTS_LINK_SIZE*sizeof(Uint);
    if(!IS_CONST(lnk->pid))
	*pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint);
    if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
	erts_doforall_links(ERTS_LINK_ROOT(lnk),&one_link_size,vpu);
    }
}
static void one_mon_size(ErtsMonitor *mon, void *vpu)
{
    Uint *pu = vpu;
    *pu += ERTS_MONITOR_SIZE*sizeof(Uint);
    if(!IS_CONST(mon->pid))
	*pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint);
    if(!IS_CONST(mon->ref))
	*pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint);
}

/*
 * process_info/[1,2]
 */

#define ERTS_PI_FAIL_TYPE_BADARG		0
#define ERTS_PI_FAIL_TYPE_YIELD			1
#define ERTS_PI_FAIL_TYPE_AWAIT_EXIT		2

static ERTS_INLINE ErtsProcLocks
pi_locks(Eterm info)
{
    switch (info) {
    case am_status:
    case am_priority:
	return ERTS_PROC_LOCK_STATUS;
    case am_links:
    case am_monitors:
    case am_monitored_by:
    case am_suspending:
	return ERTS_PROC_LOCK_LINK;
    case am_messages:
    case am_message_queue_len:
    case am_total_heap_size:
	return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ;
    case am_memory:
	return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_MSGQ;
    default:
	return ERTS_PROC_LOCK_MAIN;
    }
}

/*
 * All valid process_info arguments.
 */
static Eterm pi_args[] = {
    am_registered_name,
    am_current_function,
    am_initial_call,
    am_status,
    am_messages,
    am_message_queue_len,
    am_links,
    am_monitors,
    am_monitored_by,
    am_dictionary,
    am_trap_exit,
    am_error_handler,
    am_heap_size,
    am_stack_size,
    am_memory,
    am_garbage_collection,
    am_group_leader,
    am_reductions,
    am_priority,
    am_trace,
    am_binary,
    am_sequential_trace_token,
    am_catchlevel,
    am_backtrace,
    am_last_calls,
    am_total_heap_size,
    am_suspending,
    am_min_heap_size,
    am_min_bin_vheap_size,
    am_current_location,
    am_current_stacktrace,
#ifdef HYBRID
    am_message_binary
#endif
};    

#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))

static ERTS_INLINE Eterm
pi_ix2arg(int ix)
{
    if (ix < 0 || ERTS_PI_ARGS <= ix)
	return am_undefined;
    return pi_args[ix];
}

static ERTS_INLINE int
pi_arg2ix(Eterm arg)
{
    switch (arg) {
    case am_registered_name:			return 0;
    case am_current_function:			return 1;
    case am_initial_call:			return 2;
    case am_status:				return 3;
    case am_messages:				return 4;
    case am_message_queue_len:			return 5;
    case am_links:				return 6;
    case am_monitors:				return 7;
    case am_monitored_by:			return 8;
    case am_dictionary:				return 9;
    case am_trap_exit:				return 10;
    case am_error_handler:			return 11;
    case am_heap_size:				return 12;
    case am_stack_size:				return 13;
    case am_memory:				return 14;
    case am_garbage_collection:			return 15;
    case am_group_leader:			return 16;
    case am_reductions:				return 17;
    case am_priority:				return 18;
    case am_trace:				return 19;
    case am_binary:				return 20;
    case am_sequential_trace_token:		return 21;
    case am_catchlevel:				return 22;
    case am_backtrace:				return 23;
    case am_last_calls:				return 24;
    case am_total_heap_size:			return 25;
    case am_suspending:				return 26;
    case am_min_heap_size:			return 27;
    case am_min_bin_vheap_size:			return 28;
    case am_current_location:			return 29;
    case am_current_stacktrace:			return 30;
#ifdef HYBRID
    case am_message_binary:			return 31;
#endif
    default:					return -1;
    }
}

static Eterm pi_1_keys[] = {
    am_registered_name,
    am_current_function,
    am_initial_call,
    am_status,
    am_message_queue_len,
    am_messages,
    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;
#if HEAP_ON_C_STACK
static Eterm pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS];
#endif

static void
process_info_init(void)
{
#if HEAP_ON_C_STACK
    Eterm *hp = &pi_1_keys_list_heap[0];
#else
    Eterm *hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM,sizeof(Eterm)*2*ERTS_PI_1_NO_OF_KEYS);
#endif
    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 ERTS_INLINE Process *
pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks)
{
#ifdef ERTS_SMP
    /*
     * If the main lock is needed, we use erts_pid2proc_not_running()
     * instead of erts_pid2proc() for two reasons:
     * * Current function of pid and possibly other information will
     *   have been updated so that process_info() is consistent with an
     *   info-request/info-response signal model.
     * * We avoid blocking the whole scheduler executing the
     *   process that is calling process_info() for a long time
     *   which will happen if pid is currently running.
     * The caller of process_info() may have to yield if pid
     * is currently running.
     */

    if (info_locks & ERTS_PROC_LOCK_MAIN)
	return erts_pid2proc_not_running(c_p, ERTS_PROC_LOCK_MAIN,
					 pid, info_locks);
    else
#endif
	return erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN,
			     pid, info_locks);
}



BIF_RETTYPE
process_info_aux(Process *BIF_P,
		 Process *rp,
		 Eterm rpid,
		 Eterm item,
		 int always_wrap);

#define ERTS_PI_RES_ELEM_IX_BUF_INC 1024
#define ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ ERTS_PI_ARGS

static Eterm
process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
		  int *fail_type)
{
    int want_messages = 0;
    int def_res_elem_ix_buf[ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ];
    int *res_elem_ix = &def_res_elem_ix_buf[0];
    int res_elem_ix_ix = -1;
    int res_elem_ix_sz = ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ;
    Eterm part_res[ERTS_PI_ARGS];
    Eterm res, arg;
    Uint *hp, *hp_end;
    ErtsProcLocks locks = (ErtsProcLocks) 0;
    int res_len, ix;
    Process *rp = NULL;

    *fail_type = ERTS_PI_FAIL_TYPE_BADARG;

    for (ix = 0; ix < ERTS_PI_ARGS; ix++)
	part_res[ix] = THE_NON_VALUE;

    ASSERT(is_list(list));

    while (is_list(list)) {
	Eterm* consp = list_val(list);

	arg = CAR(consp);
	ix = pi_arg2ix(arg);
	if (ix < 0) {
	    res = THE_NON_VALUE;
	    goto done;
	}
	if (arg == am_messages)
	    want_messages = 1;
	locks |= pi_locks(arg);
	res_elem_ix_ix++;
	if (res_elem_ix_ix >= res_elem_ix_sz) {
	    if (res_elem_ix != &def_res_elem_ix_buf[0])
		res_elem_ix =
		    erts_realloc(ERTS_ALC_T_TMP,
				 res_elem_ix,
				 sizeof(int)*(res_elem_ix_sz
					      += ERTS_PI_RES_ELEM_IX_BUF_INC));
	    else {
		int new_res_elem_ix_sz = ERTS_PI_RES_ELEM_IX_BUF_INC;
		int *new_res_elem_ix = erts_alloc(ERTS_ALC_T_TMP,
						  sizeof(int)*new_res_elem_ix_sz);
		sys_memcpy((void *) new_res_elem_ix,
			   (void *) res_elem_ix,
			   sizeof(int)*res_elem_ix_sz);
		res_elem_ix = new_res_elem_ix;
		res_elem_ix_sz = new_res_elem_ix_sz;
	    }
	}
	res_elem_ix[res_elem_ix_ix] = ix;
	list = CDR(consp);
    }
    if (is_not_nil(list)) {
	res = THE_NON_VALUE;
	goto done;
    }

    res_len = res_elem_ix_ix+1;

    ASSERT(res_len > 0);

    rp = pi_pid2proc(c_p, pid, locks|ERTS_PROC_LOCK_STATUS);
    if (!rp) {
	res = am_undefined;
	goto done;
    }
    else if (rp == ERTS_PROC_LOCK_BUSY) {
	rp = NULL;
	res = THE_NON_VALUE;
	*fail_type = ERTS_PI_FAIL_TYPE_YIELD;
	goto done;
    }
    else if (c_p != rp && ERTS_PROC_PENDING_EXIT(rp)) {
	locks |= ERTS_PROC_LOCK_STATUS;
	res = THE_NON_VALUE;
	*fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT;
	goto done;
    }
    else if (!(locks & ERTS_PROC_LOCK_STATUS)) {
	erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
    }
	

    /*
     * 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 (want_messages) {
	ix = pi_arg2ix(am_messages);
	ASSERT(part_res[ix] == THE_NON_VALUE);
	part_res[ix] = process_info_aux(c_p, rp, pid, am_messages, always_wrap);
	ASSERT(part_res[ix] != THE_NON_VALUE);
    }

    for (; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
	ix = res_elem_ix[res_elem_ix_ix];
	if (part_res[ix] == THE_NON_VALUE) {
	    arg = pi_ix2arg(ix);
	    part_res[ix] = process_info_aux(c_p, rp, pid, arg, always_wrap);
	    ASSERT(part_res[ix] != THE_NON_VALUE);
	}
    }

    hp = HAlloc(c_p, res_len*2);
    hp_end = hp + res_len*2;
    res = NIL;

    for (res_elem_ix_ix = res_len - 1; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
	ix = res_elem_ix[res_elem_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(!always_wrap);
	    ASSERT(pi_ix2arg(ix) == am_registered_name);
	}
	else {
	    res = CONS(hp, part_res[ix], res);
	    hp += 2;
	}
    }

    if (!always_wrap) {
	HRelease(c_p, hp_end, hp);
    }

 done:

    if (c_p == rp)
	locks &= ~ERTS_PROC_LOCK_MAIN;
    if (locks && rp)
	erts_smp_proc_unlock(rp, locks);

    if (res_elem_ix != &def_res_elem_ix_buf[0])
	erts_free(ERTS_ALC_T_TMP, res_elem_ix);

    return res;
}

BIF_RETTYPE process_info_1(BIF_ALIST_1)
{
    Eterm res;
    int fail_type;

    if (is_external_pid(BIF_ARG_1)
	&& external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
	BIF_RET(am_undefined);
	
    if (is_not_internal_pid(BIF_ARG_1)
	|| internal_pid_index(BIF_ARG_1) >= erts_max_processes) {
	BIF_ERROR(BIF_P, BADARG);
    }

    res = process_info_list(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, &fail_type);
    if (is_non_value(res)) {
	switch (fail_type) {
	case ERTS_PI_FAIL_TYPE_BADARG:
	    BIF_ERROR(BIF_P, BADARG);
	case ERTS_PI_FAIL_TYPE_YIELD:
	    ERTS_BIF_YIELD1(bif_export[BIF_process_info_1], BIF_P, BIF_ARG_1);
	case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
	    ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
	default:
	    erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__);
	}
    }

    ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
    BIF_RET(res);
}


BIF_RETTYPE process_info_2(BIF_ALIST_2) 
{
    Eterm res;
    Process *rp;
    Eterm pid = BIF_ARG_1;
    ErtsProcLocks info_locks;
    int fail_type;

    if (is_external_pid(pid)
	&& external_pid_dist_entry(pid) == erts_this_dist_entry)
	BIF_RET(am_undefined);
	
    if (is_not_internal_pid(pid)
	|| internal_pid_index(BIF_ARG_1) >= erts_max_processes) {
	BIF_ERROR(BIF_P, BADARG);
    }

    if (is_nil(BIF_ARG_2))
	BIF_RET(NIL);

    if (is_list(BIF_ARG_2)) {
	res = process_info_list(BIF_P, BIF_ARG_1, BIF_ARG_2, 1, &fail_type);
	if (is_non_value(res)) {
	    switch (fail_type) {
	    case ERTS_PI_FAIL_TYPE_BADARG:
		BIF_ERROR(BIF_P, BADARG);
	    case ERTS_PI_FAIL_TYPE_YIELD:
		ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
				BIF_ARG_1, BIF_ARG_2);
	    case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
		ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
	    default:
		erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error",
			 __FILE__, __LINE__);
	    }
	}
	ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
	BIF_RET(res);
    }

    if (pi_arg2ix(BIF_ARG_2) < 0)
	BIF_ERROR(BIF_P, BADARG);

    info_locks = pi_locks(BIF_ARG_2); 

    rp = pi_pid2proc(BIF_P, pid, info_locks|ERTS_PROC_LOCK_STATUS);
    if (!rp)
	res = am_undefined;
    else if (rp == ERTS_PROC_LOCK_BUSY)
	ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
			BIF_ARG_1, BIF_ARG_2);
    else if (rp != BIF_P && ERTS_PROC_PENDING_EXIT(rp)) {
	erts_smp_proc_unlock(rp, info_locks|ERTS_PROC_LOCK_STATUS);
	ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
    }
    else {
	if (!(info_locks & ERTS_PROC_LOCK_STATUS))
	    erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
	res = process_info_aux(BIF_P, rp, pid, BIF_ARG_2, 0);
    }
    ASSERT(is_value(res));

#ifdef ERTS_SMP
    if (BIF_P == rp)
	info_locks &= ~ERTS_PROC_LOCK_MAIN;
    if (rp && info_locks)
	erts_smp_proc_unlock(rp, info_locks);
#endif

    ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
    BIF_RET(res);
}

Eterm
process_info_aux(Process *BIF_P,
		 Process *rp,
		 Eterm rpid,
		 Eterm item,
		 int always_wrap)
{
    Eterm *hp;
    Eterm res = NIL;

    ASSERT(rp);

    /*
     * Q: Why this always_wrap argument?
     *
     * 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 always_wrap != 0, process_info_aux() always wrap the result
     *    in a key two tuple. 
     */

    switch (item) {

    case am_registered_name:
	if (rp->reg != NULL) {
	    hp = HAlloc(BIF_P, 3);
	    res = rp->reg->name;
	} else {
	    if (always_wrap) {
		hp = HAlloc(BIF_P, 3);
		res = NIL;
	    }
	    else {
		return NIL;
	    }
	}
	break;

    case am_current_function:
	res = current_function(BIF_P, rp, &hp, 0);
	break;

    case am_current_location:
	res = current_function(BIF_P, rp, &hp, 1);
	break;

    case am_current_stacktrace:
	res = current_stacktrace(BIF_P, rp, &hp);
	break;

    case am_initial_call:
	hp = HAlloc(BIF_P, 3+4);
	res = TUPLE3(hp,
		     rp->initial[INITIAL_MOD],
		     rp->initial[INITIAL_FUN],
		     make_small(rp->initial[INITIAL_ARI]));
	hp += 4;
	break;

    case am_status:
	res = erts_process_status(BIF_P, ERTS_PROC_LOCK_MAIN, rp, rpid);
	ASSERT(res != am_undefined);
	hp = HAlloc(BIF_P, 3);
	break;

    case am_messages: {
	ErlMessage* mp;
	int n;

	ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
	n = rp->msg.len;

	if (n == 0 || rp->trace_flags & F_SENSITIVE) {
	    hp = HAlloc(BIF_P, 3);
	} else {
	    int remove_bad_messages = 0;
	    struct {
		Uint copy_struct_size;
		ErlMessage* msgp;
	    } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq));
	    Sint i = 0;
	    Uint heap_need = 3;
	    Eterm *hp_end;

	    for (mp = rp->msg.first; mp; mp = mp->next) {
		heap_need += 2;
		mq[i].msgp = mp;
		if (rp != BIF_P) {
		    Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
		    if (is_value(msg)) {
			mq[i].copy_struct_size = (is_immed(msg)
#ifdef HYBRID
						  || NO_COPY(msg)
#endif
						  ? 0
						  : size_object(msg));
		    }
		    else if (mq[i].msgp->data.attached) {
			mq[i].copy_struct_size
			    = erts_msg_attached_data_size(mq[i].msgp);
		    }
		    else {
			/* Bad distribution message; ignore */
			remove_bad_messages = 1;
			mq[i].copy_struct_size = 0;
		    }
		    heap_need += mq[i].copy_struct_size;
		}
		else {
		    mq[i].copy_struct_size = 0;
		    if (mp->data.attached)
			heap_need += erts_msg_attached_data_size(mp);
		}
		i++;
	    }

	    hp = HAlloc(BIF_P, heap_need);
	    hp_end = hp + heap_need;
	    ASSERT(i == n);
	    for (i--; i >= 0; i--) {
		Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
		if (rp != BIF_P) {
		    if (is_value(msg)) {
			if (mq[i].copy_struct_size)
			    msg = copy_struct(msg,
					      mq[i].copy_struct_size,
					      &hp,
					      &MSO(BIF_P));
		    }
		    else if (mq[i].msgp->data.attached) {
			ErlHeapFragment *hfp;
			/*
			 * Decode it into a message buffer and attach it
			 * to the message instead of the attached external
			 * term.
			 *
			 * Note that we may not pass a process pointer
			 * to erts_msg_distext2heap(), since it would then
			 * try to alter locks on that process.
			 */
			msg = erts_msg_distext2heap(
			    NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp),
			    mq[i].msgp->data.dist_ext);

			ERL_MESSAGE_TERM(mq[i].msgp) = msg;
			mq[i].msgp->data.heap_frag = hfp;

			if (is_non_value(msg)) {
			    ASSERT(!mq[i].msgp->data.heap_frag);
			    /* Bad distribution message; ignore */
			    remove_bad_messages = 1;
			    continue;
			}
			else {
			    /* Make our copy of the message */
			    ASSERT(size_object(msg) == hfp->used_size);
			    msg = copy_struct(msg,
					      hfp->used_size,
					      &hp,
					      &MSO(BIF_P));
			}
		    }
		    else {
			/* Bad distribution message; ignore */
			remove_bad_messages = 1;
			continue;
		    }
		}
		else {
		    if (mq[i].msgp->data.attached) {
			/* Decode it on the heap */
			erts_move_msg_attached_data_to_heap(&hp,
							    &MSO(BIF_P),
							    mq[i].msgp);
			msg = ERL_MESSAGE_TERM(mq[i].msgp);
			ASSERT(!mq[i].msgp->data.attached);
			if (is_non_value(msg)) {
			    /* Bad distribution message; ignore */
			    remove_bad_messages = 1;
			    continue;
			}
		    }
		}
		    
		res = CONS(hp, msg, res);
		hp += 2;
	    }
	    HRelease(BIF_P, hp_end, hp+3);
	    erts_free(ERTS_ALC_T_TMP, mq);
	    if (remove_bad_messages) {
		ErlMessage **mpp;
		/*
		 * We need to remove bad distribution messages from
		 * the queue, so that the value returned for
		 * 'message_queue_len' is consistent with the value
		 * returned for 'messages'.
		 */
		mpp = &rp->msg.first;
		mp = rp->msg.first;
		while (mp) {
		    if (is_value(ERL_MESSAGE_TERM(mp))) {
			mpp = &mp->next;
			mp = mp->next;
		    }
		    else {
			ErlMessage* bad_mp = mp;
			ASSERT(!mp->data.attached);
			if (rp->msg.save == &mp->next)
			    rp->msg.save = mpp;
			if (rp->msg.last == &mp->next)
			    rp->msg.last = mpp;
			*mpp = mp->next;
			mp = mp->next;
			rp->msg.len--;
			free_message(bad_mp);
		    }
		}
	    }
	}
	break;
    }

    case am_message_queue_len:
	hp = HAlloc(BIF_P, 3);
	ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
	res = make_small(rp->msg.len);
	break;

    case am_links: {
	MonitorInfoCollection mic;
	int i;
	Eterm item;

	INIT_MONITOR_INFOS(mic);

	erts_doforall_links(rp->nlinks,&collect_one_link,&mic);

	hp = HAlloc(BIF_P, 3 + mic.sz);
	res = NIL;
	for (i = 0; i < mic.mi_i; i++) {
	    item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); 
	    res = CONS(hp, item, res);
	    hp += 2;
	}
	DESTROY_MONITOR_INFOS(mic);
	break;
    }

    case am_monitors: {
	MonitorInfoCollection mic;
	int i;

	INIT_MONITOR_INFOS(mic);
	erts_doforall_monitors(rp->monitors,&collect_one_origin_monitor,&mic);
	hp = HAlloc(BIF_P, 3 + mic.sz);
	res = NIL;
	for (i = 0; i < mic.mi_i; i++) {
	    if (is_atom(mic.mi[i].entity)) {
		/* Monitor by name. 
		 * Build {process, {Name, Node}} and cons it. 
		 */
		Eterm t1, t2;

		t1 = TUPLE2(hp, mic.mi[i].entity, mic.mi[i].node);
		hp += 3;
		t2 = TUPLE2(hp, am_process, t1);
		hp += 3;
		res = CONS(hp, t2, res);
		hp += 2;
	    }
	    else {
		/* Monitor by pid. Build {process, Pid} and cons it. */
		Eterm t;
		Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
		t = TUPLE2(hp, am_process, pid);
		hp += 3;
		res = CONS(hp, t, res);
		hp += 2;
	    }
	}
	DESTROY_MONITOR_INFOS(mic);
	break;
    }

    case am_monitored_by: {
	MonitorInfoCollection mic;
	int i;
	Eterm item;

	INIT_MONITOR_INFOS(mic);
	erts_doforall_monitors(rp->monitors,&collect_one_target_monitor,&mic);
	hp = HAlloc(BIF_P, 3 + mic.sz);

	res = NIL;
	for (i = 0; i < mic.mi_i; ++i) {
	    item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity); 
	    res = CONS(hp, item, res);
	    hp += 2;
	}
	DESTROY_MONITOR_INFOS(mic);
	break;
    }

    case am_suspending: {
	ErtsSuspendMonitorInfoCollection smic;
	int i;
	Eterm item;
#ifdef DEBUG
	Eterm *hp_end;
#endif

	ERTS_INIT_SUSPEND_MONITOR_INFOS(smic,
					BIF_P,
					(BIF_P == rp
					 ? ERTS_PROC_LOCK_MAIN
					 : 0) | ERTS_PROC_LOCK_LINK);

	erts_doforall_suspend_monitors(rp->suspend_monitors,
				       &collect_one_suspend_monitor,
				       &smic);
	hp = HAlloc(BIF_P, 3 + smic.sz);
#ifdef DEBUG
	hp_end = hp + smic.sz;
#endif
	
	res = NIL;
	for (i = 0; i < smic.smi_i; i++) {
	    Sint a = (Sint) smic.smi[i]->active;  /* quiet compiler warnings */
	    Sint p = (Sint) smic.smi[i]->pending; /* on 64-bit machines...   */
	    Eterm active;
	    Eterm pending;
	    if (IS_SSMALL(a))
		active = make_small(a);
	    else {
		active = small_to_big(a, hp);
		hp += BIG_UINT_HEAP_SIZE;
	    }
	    if (IS_SSMALL(p))
		pending = make_small(p);
	    else {
		pending = small_to_big(p, hp);
		hp += BIG_UINT_HEAP_SIZE;
	    }
	    item = TUPLE3(hp, smic.smi[i]->pid, active, pending);
	    hp += 4;
	    res = CONS(hp, item, res);
	    hp += 2;
	}

	ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic);
	ASSERT(hp == hp_end);

	break;
    }

    case am_dictionary:
	if (rp->trace_flags & F_SENSITIVE) {
	    res = NIL;
	} else {
	    res = erts_dictionary_copy(BIF_P, rp->dictionary);
	}
	hp = HAlloc(BIF_P, 3);
	break;

    case am_trap_exit:
	hp = HAlloc(BIF_P, 3);
	if (rp->flags  & F_TRAPEXIT)
	    res = am_true;
	else
	    res = am_false;
	break;

    case am_error_handler:
	hp = HAlloc(BIF_P, 3);
	res = erts_proc_get_error_handler(BIF_P);
	break;

    case am_heap_size: {
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, HEAP_SIZE(rp));
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, HEAP_SIZE(rp));
	break;
    }

    case am_fullsweep_after: {
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, MAX_GEN_GCS(rp));
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, MAX_GEN_GCS(rp));
	break;
    }

    case am_min_heap_size: {
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, MIN_HEAP_SIZE(rp));
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, MIN_HEAP_SIZE(rp));
	break;
    }

    case am_min_bin_vheap_size: {
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, MIN_VHEAP_SIZE(rp));
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, MIN_VHEAP_SIZE(rp));
	break;
    }

    case am_total_heap_size: {
	ErlMessage *mp;
	Uint total_heap_size;
	Uint hsz = 3;

	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;

	ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);

	for (mp = rp->msg.first; mp; mp = mp->next)
	    if (mp->data.attached)
		total_heap_size += erts_msg_attached_data_size(mp);

	(void) erts_bld_uint(NULL, &hsz, total_heap_size);
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, total_heap_size);
	break;
    }

    case am_stack_size: {
	Uint stack_size = STACK_START(rp) - rp->stop;
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, stack_size);
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, stack_size);
	break;
    }

    case am_memory: { /* Memory consumed in bytes */
	ErlMessage *mp;
	Uint size = 0;
	Uint hsz = 3;
	struct saved_calls *scb;
	size += sizeof(Process);

	ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);

	erts_doforall_links(rp->nlinks, &one_link_size, &size);
	erts_doforall_monitors(rp->monitors, &one_mon_size, &size);
	size += (rp->heap_sz + rp->mbuf_sz) * sizeof(Eterm);
	if (rp->old_hend && rp->old_heap)
	    size += (rp->old_hend - rp->old_heap) * sizeof(Eterm);

	size += rp->msg.len * sizeof(ErlMessage);

	for (mp = rp->msg.first; mp; mp = mp->next)
	    if (mp->data.attached)
		size += erts_msg_attached_data_size(mp)*sizeof(Eterm);

	if (rp->arg_reg != rp->def_arg_reg) {
	    size += rp->arity * sizeof(rp->arg_reg[0]);
	}

	if (rp->psd)
	    size += sizeof(ErtsPSD);

	scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp);
	if (scb) {
	    size += (sizeof(struct saved_calls)
		     + (scb->len-1) * sizeof(scb->ct[0]));
	}

	size += erts_dicts_mem_size(rp);

	(void) erts_bld_uint(NULL, &hsz, size);
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, size);
	break;
    }

    case am_garbage_collection: {
        DECL_AM(minor_gcs);
        Eterm t;

	hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2 + 3); /* last "3" is for outside tuple */

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

    case am_group_leader: {
	int sz = NC_HEAP_SIZE(rp->group_leader);
	hp = HAlloc(BIF_P, 3 + sz);
	res = STORE_NC(&hp, &MSO(BIF_P), rp->group_leader);
	break;
    }

    case am_reductions: {
	Uint reds = rp->reds + erts_current_reductions(BIF_P, rp);
	Uint hsz = 3;
	(void) erts_bld_uint(NULL, &hsz, reds);
	hp = HAlloc(BIF_P, hsz);
	res = erts_bld_uint(&hp, NULL, reds);
	break;
    }

    case am_priority:
	hp = HAlloc(BIF_P, 3);
	res = erts_get_process_priority(rp);
	break;

    case am_trace:
	hp = HAlloc(BIF_P, 3);
	res = make_small(rp->trace_flags & TRACEE_FLAGS);
	break;

    case am_binary: {
	Uint sz = 3;
	(void) bld_bin_list(NULL, &sz, &MSO(rp));
	hp = HAlloc(BIF_P, sz);
	res = bld_bin_list(&hp, NULL, &MSO(rp));
	break;
    }

#ifdef HYBRID
    case am_message_binary: {
	Uint sz = 3;
	(void) bld_bin_list(NULL, &sz, erts_global_offheap.mso);
	hp = HAlloc(BIF_P, sz);
	res = bld_bin_list(&hp, NULL, erts_global_offheap.mso);
	break;
    }
#endif

    case am_sequential_trace_token:
	res = copy_object(rp->seq_trace_token, BIF_P);
	hp = HAlloc(BIF_P, 3);
	break;

    case am_catchlevel:
	hp = HAlloc(BIF_P, 3);
	res = make_small(catchlevel(BIF_P));
	break;

    case am_backtrace: {
	erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
	erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp);
	res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len);
	erts_destroy_tmp_dsbuf(dsbufp);
	hp = HAlloc(BIF_P, 3);
	break;
    }

    case am_last_calls: {
	struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P);
	if (!scb) {
	    hp = HAlloc(BIF_P, 3);
	    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.
	     */
	    Uint needed = scb->n*(2+4) + 3;
	    Eterm* limit;
	    Eterm term, list;
	    int i, j;

	    hp = HAlloc(BIF_P, needed);
	    limit = hp + needed;
	    list = NIL;
	    for (i = 0; i < scb->n; i++) {
		j = scb->cur - i - 1;
		if (j < 0)
		    j += scb->len;
		if (scb->ct[j] == &exp_send)
		    term = am_send;
		else if (scb->ct[j] == &exp_receive)
		    term = am_receive;
		else if (scb->ct[j] == &exp_timeout)
		    term = am_timeout;
		else {
		    term = TUPLE3(hp,
				  scb->ct[j]->code[0],
				  scb->ct[j]->code[1],
				  make_small(scb->ct[j]->code[2]));
		    hp += 4;
		}
		list = CONS(hp, term, list);
		hp += 2;
	    }
	    res = list;
	    res = TUPLE2(hp, item, res);
	    hp += 3;
	    HRelease(BIF_P,limit,hp);
	    return res;
	}
	break;
    }

    default:
	return THE_NON_VALUE; /* will produce badarg */

    }

    return TUPLE2(hp, item, res);
}
#undef MI_INC

static Eterm
current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
{
    Eterm* hp;
    Eterm res;
    FunctionInfo fi;

    if (rp->current == NULL) {
	erts_lookup_function_info(&fi, rp->i, full_info);
	rp->current = fi.current;
    } else if (full_info) {
	erts_lookup_function_info(&fi, rp->i, full_info);
	if (fi.current == NULL) {
	    /* Use the current function without location info */
	    erts_set_current_function(&fi, rp->current);
	}
    }

    if (BIF_P->id == rp->id) {
	FunctionInfo fi2;

	/*
	 * The current function is erlang:process_info/{1,2},
	 * which is not the answer that the application want.
	 * We will use the function pointed into by rp->cp
	 * instead if it can be looked up.
	 */
	erts_lookup_function_info(&fi2, rp->cp, full_info);
	if (fi2.current) {
	    fi = fi2;
	    rp->current = fi2.current;
	}
    }

    /*
     * Return the result.
     */
    if (rp->current == NULL) {
	hp = HAlloc(BIF_P, 3);
	res = am_undefined;
    } else if (full_info) {
	hp = HAlloc(BIF_P, 3+fi.needed);
	hp = erts_build_mfa_item(&fi, hp, am_true, &res);
    } else {
	hp = HAlloc(BIF_P, 3+4);
	res = TUPLE3(hp, rp->current[0],
		     rp->current[1], make_small(rp->current[2]));
	hp += 4;
    }
    *hpp = hp;
    return res;
}

static Eterm
current_stacktrace(Process* p, Process* rp, Eterm** hpp)
{
    Uint sz;
    struct StackTrace* s;
    int depth;
    FunctionInfo* stk;
    FunctionInfo* stkp;
    Uint heap_size;
    int i;
    Eterm* hp = *hpp;
    Eterm mfa;
    Eterm res = NIL;

    depth = 8;
    sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
    s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
    s->depth = 0;
    if (rp->i) {
	s->trace[s->depth++] = rp->i;
	depth--;
    }
    if (depth > 0 && rp->cp != 0) {
	s->trace[s->depth++] = rp->cp - 1;
	depth--;
    }
    erts_save_stacktrace(rp, s, depth);

    depth = s->depth;
    stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
					     depth*sizeof(FunctionInfo));
    heap_size = 3;
    for (i = 0; i < depth; i++) {
	erts_lookup_function_info(stkp, s->trace[i], 1);
	if (stkp->current) {
	    heap_size += stkp->needed + 2;
	    stkp++;
	}
    }

    hp = HAlloc(p, heap_size);
    while (stkp > stk) {
	stkp--;
	hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
	res = CONS(hp, mfa, res);
	hp += 2;
    }

    erts_free(ERTS_ALC_T_TMP, stk);
    erts_free(ERTS_ALC_T_TMP, s);
    *hpp = hp;
    return res;
}

#if defined(VALGRIND)
static int check_if_xml(void)
{
    char buf[1];
    size_t bufsz = sizeof(buf);
    return erts_sys_getenv("VALGRIND_LOG_XML", buf, &bufsz) >= 0;
}
#else
#define check_if_xml() 0
#endif

/*
 * 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_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))
		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_allocated) {
	if (arity == 2) {
	    Eterm res = THE_NON_VALUE;
	    char *buf;
	    int len = is_string(*tp);
	    if (len <= 0)
		return res;
	    buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
	    if (intlist_to_buf(*tp, buf, len) != len)
		erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
	    buf[len] = '\0';
	    res = erts_instr_dump_memory_map(buf) ? am_true : am_false;
	    erts_free(ERTS_ALC_T_TMP, (void *) buf);
	    if (is_non_value(res))
		goto badarg;
	    return res;
	}
	else if (arity == 3 && tp[0] == am_status) {
	    if (is_atom(tp[1]))
		return erts_instr_get_stat(BIF_P, tp[1], 1);
	    else {
		Eterm res = THE_NON_VALUE;
		char *buf;
		int len = is_string(tp[1]);
		if (len <= 0)
		    return res;
		buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
		if (intlist_to_buf(tp[1], buf, len) != len)
		    erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
		buf[len] = '\0';
		res = erts_instr_dump_stat(buf, 1) ? am_true : am_false;
		erts_free(ERTS_ALC_T_TMP, (void *) buf);
		if (is_non_value(res))
		    goto badarg;
		return res;
	    }
	}
	else
	    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))
		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)
	    VALGRIND_DO_LEAK_CHECK;
	    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
#define ERTS_ERROR_CHECKER_PRINTF_XML purify_printf
#elif defined(VALGRIND)
#define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF
#  ifndef HAVE_VALGRIND_PRINTF_XML
#    define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF
#  else
#    define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF_XML
#  endif
#endif
	    Uint buf_size = 8*1024; /* Try with 8KB first */
	    char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size);
	    int r = io_list_to_buf(*tp, (char*) buf, buf_size - 1);
	    if (r < 0) {
		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 = io_list_to_buf(*tp, (char*) buf, buf_size - 1);
		ASSERT(r == buf_size - 1);
	    }
	    buf[buf_size - 1 - r] = '\0';
	    if (check_if_xml()) {
		ERTS_ERROR_CHECKER_PRINTF_XML("<erlang_info_log>"
					      "%s</erlang_info_log>\n", buf);
	    } else {
		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,…