aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam/bif.c
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam/bif.c')
-rw-r--r--erts/emulator/beam/bif.c323
1 files changed, 304 insertions, 19 deletions
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index f8305944a4..39d4582435 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2012. 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
@@ -563,7 +563,11 @@ erts_queue_monitor_message(Process *p,
ref_copy = copy_struct(ref, ref_size, &hp, ohp);
tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy);
- erts_queue_message(p, p_locksp, bp, tup, NIL);
+ erts_queue_message(p, p_locksp, bp, tup, NIL
+#ifdef USE_VM_PROBES
+ , NIL
+#endif
+ );
}
static BIF_RETTYPE
@@ -1944,7 +1948,11 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) {
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
- if (SEQ_TRACE_TOKEN(p) != NIL) {
+ if (SEQ_TRACE_TOKEN(p) != NIL
+#ifdef USE_VM_PROBES
+ && SEQ_TRACE_TOKEN(p) != am_have_dt_utag
+#endif
+ ) {
seq_trace_update_send(p);
seq_trace_output(SEQ_TRACE_TOKEN(p), msg,
SEQ_TRACE_SEND, portid, p);
@@ -3665,43 +3673,122 @@ BIF_RETTYPE display_nl_0(BIF_ALIST_0)
/* ARGSUSED */
BIF_RETTYPE halt_0(BIF_ALIST_0)
{
- VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt/0\n"));
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(0, "");
- return NIL; /* Pedantic (lint does not know about erl_exit) */
+ VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt()\n"));
+ erl_halt(0);
+ ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
}
/**********************************************************************/
-#define MSG_SIZE 200
+#define HALT_MSG_SIZE 200
+static char halt_msg[HALT_MSG_SIZE];
/* stop the system with exit code */
/* ARGSUSED */
BIF_RETTYPE halt_1(BIF_ALIST_1)
{
Sint code;
- static char msg[MSG_SIZE];
- int i;
if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) {
- VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%d)\n", code));
+ VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
+ erl_halt((int)(- code));
+ ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
+ }
+ else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
+ VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(-code, "");
- } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- if ((i = intlist_to_buf(BIF_ARG_1, msg, MSG_SIZE-1)) < 0) {
+ erl_exit(ERTS_ABORT_EXIT, "");
+ }
+ else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
+ int i;
+
+ if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
goto error;
}
- msg[i] = '\0';
- VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%s)\n", msg));
+ halt_msg[i] = '\0';
+ VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(ERTS_DUMP_EXIT, "%s\n", msg);
- } else {
- error:
+ erl_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
+ }
+ else
+ goto error;
+ return NIL; /* Pedantic (lint does not know about erl_exit) */
+ error:
BIF_ERROR(BIF_P, BADARG);
+}
+
+/**********************************************************************/
+
+/* stop the system with exit code and flags */
+/* ARGSUSED */
+BIF_RETTYPE halt_2(BIF_ALIST_2)
+{
+ Sint code;
+ Eterm optlist = BIF_ARG_2;
+ int flush = 0;
+
+ for (optlist = BIF_ARG_2;
+ is_list(optlist);
+ optlist = CDR(list_val(optlist))) {
+ Eterm *tp, opt = CAR(list_val(optlist));
+ if (is_not_tuple(opt))
+ goto error;
+ tp = tuple_val(opt);
+ if (tp[0] != make_arityval(2))
+ goto error;
+ if (tp[1] == am_flush) {
+ if (tp[2] == am_true)
+ flush = 1;
+ else if (tp[2] == am_false)
+ flush = 0;
+ else
+ goto error;
+ }
+ else
+ goto error;
}
+ if (is_not_nil(optlist))
+ goto error;
+
+ if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) {
+ VERBOSE(DEBUG_SYSTEM,
+ ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
+ if (flush) {
+ erl_halt((int)(- code));
+ ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
+ }
+ else {
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erl_exit((int)(- code), "");
+ }
+ }
+ else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
+ VERBOSE(DEBUG_SYSTEM,
+ ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erl_exit(ERTS_ABORT_EXIT, "");
+ }
+ else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
+ int i;
+
+ if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
+ goto error;
+ }
+ halt_msg[i] = '\0';
+ VERBOSE(DEBUG_SYSTEM,
+ ("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erl_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
+ }
+ else
+ goto error;
return NIL; /* Pedantic (lint does not know about erl_exit) */
+ error:
+ BIF_ERROR(BIF_P, BADARG);
}
+/**********************************************************************/
+
BIF_RETTYPE function_exported_3(BIF_ALIST_3)
{
if (is_not_atom(BIF_ARG_1) ||
@@ -4147,13 +4234,21 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
for (i = 0; i < erts_max_processes; i++) {
if (process_tab[i] != (Process*) 0) {
Process* p = process_tab[i];
+#ifdef USE_VM_PROBES
+ p->seq_trace_token = (p->dt_utag != NIL) ? am_have_dt_utag : NIL;
+#else
p->seq_trace_token = NIL;
+#endif
p->seq_trace_clock = 0;
p->seq_trace_lastcnt = 0;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
mp = p->msg.first;
while(mp != NULL) {
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_TOKEN(mp) = (ERL_MESSAGE_DT_UTAG(mp) != NIL) ? am_have_dt_utag : NIL;
+#else
ERL_MESSAGE_TOKEN(mp) = NIL;
+#endif
mp = mp->next;
}
}
@@ -4551,3 +4646,193 @@ BIF_RETTYPE get_module_info_2(BIF_ALIST_2)
}
BIF_RET(ret);
}
+
+BIF_RETTYPE dt_put_tag_1(BIF_ALIST_1)
+{
+#ifdef USE_VM_PROBES
+ Eterm otag;
+ if (BIF_ARG_1 == am_undefined) {
+ otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
+ DT_UTAG(BIF_P) = NIL;
+ DT_UTAG_FLAGS(BIF_P) = 0;
+ if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
+ SEQ_TRACE_TOKEN(BIF_P) = NIL;
+ }
+ BIF_RET(otag);
+ }
+ if (!is_binary(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+ otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
+ DT_UTAG(BIF_P) = BIF_ARG_1;
+ DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_PERMANENT;
+ if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+ SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
+ }
+ BIF_RET(otag);
+#else
+ BIF_RET(am_undefined);
+#endif
+}
+
+BIF_RETTYPE dt_get_tag_0(BIF_ALIST_0)
+{
+#ifdef USE_VM_PROBES
+ BIF_RET((DT_UTAG(BIF_P) == NIL || !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_PERMANENT)) ? am_undefined : DT_UTAG(BIF_P));
+#else
+ BIF_RET(am_undefined);
+#endif
+}
+BIF_RETTYPE dt_get_tag_data_0(BIF_ALIST_0)
+{
+#ifdef USE_VM_PROBES
+ BIF_RET((DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P));
+#else
+ BIF_RET(am_undefined);
+#endif
+}
+BIF_RETTYPE dt_prepend_vm_tag_data_1(BIF_ALIST_1)
+{
+#ifdef USE_VM_PROBES
+ Eterm b;
+ Eterm *hp;
+ hp = HAlloc(BIF_P,2);
+ if (is_binary((DT_UTAG(BIF_P)))) {
+ Uint sz = binary_size(DT_UTAG(BIF_P));
+ int i;
+ unsigned char *p,*q;
+ byte *temp_alloc = NULL;
+ b = new_binary(BIF_P,NULL,sz+1);
+ q = binary_bytes(b);
+ p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
+ for(i=0;i<sz;++i) {
+ q[i] = p[i];
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ q[sz] = '\0';
+ } else {
+ b = new_binary(BIF_P,(byte *)"\0",1);
+ }
+ BIF_RET(CONS(hp,b,BIF_ARG_1));
+#else
+ BIF_RET(BIF_ARG_1);
+#endif
+}
+BIF_RETTYPE dt_append_vm_tag_data_1(BIF_ALIST_1)
+{
+#ifdef USE_VM_PROBES
+ Eterm b;
+ Eterm *hp;
+ hp = HAlloc(BIF_P,2);
+ if (is_binary((DT_UTAG(BIF_P)))) {
+ Uint sz = binary_size(DT_UTAG(BIF_P));
+ int i;
+ unsigned char *p,*q;
+ byte *temp_alloc = NULL;
+ b = new_binary(BIF_P,NULL,sz+1);
+ q = binary_bytes(b);
+ p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
+ for(i=0;i<sz;++i) {
+ q[i] = p[i];
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ q[sz] = '\0';
+ } else {
+ b = new_binary(BIF_P,(byte *)"\0",1);
+ }
+ BIF_RET(CONS(hp,BIF_ARG_1,b));
+#else
+ BIF_RET(BIF_ARG_1);
+#endif
+}
+BIF_RETTYPE dt_spread_tag_1(BIF_ALIST_1)
+{
+#ifdef USE_VM_PROBES
+ Eterm ret;
+ Eterm *hp;
+#endif
+ if (BIF_ARG_1 != am_true && BIF_ARG_1 != am_false) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+#ifdef USE_VM_PROBES
+ hp = HAlloc(BIF_P,3);
+ ret = TUPLE2(hp,make_small(DT_UTAG_FLAGS(BIF_P)),DT_UTAG(BIF_P));
+ if (DT_UTAG(BIF_P) != NIL) {
+ if (BIF_ARG_1 == am_true) {
+ DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_SPREADING;
+#ifdef DTRACE_TAG_HARDDEBUG
+ erts_fprintf(stderr,
+ "Dtrace -> (%T) start spreading tag %T\r\n",
+ BIF_P->id,DT_UTAG(BIF_P));
+#endif
+ } else {
+ DT_UTAG_FLAGS(BIF_P) &= ~DT_UTAG_SPREADING;
+#ifdef DTRACE_TAG_HARDDEBUG
+ erts_fprintf(stderr,
+ "Dtrace -> (%T) stop spreading tag %T\r\n",
+ BIF_P->id,DT_UTAG(BIF_P));
+#endif
+ }
+ }
+ BIF_RET(ret);
+#else
+ BIF_RET(am_true);
+#endif
+}
+BIF_RETTYPE dt_restore_tag_1(BIF_ALIST_1)
+{
+#ifdef USE_VM_PROBES
+ Eterm *tpl;
+ Uint x;
+ if (is_not_tuple(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+ tpl = tuple_val(BIF_ARG_1);
+ if(arityval(*tpl) != 2 || is_not_small(tpl[1]) || (is_not_binary(tpl[2]) && tpl[2] != NIL)) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+ if (tpl[2] == NIL) {
+ if (DT_UTAG(BIF_P) != NIL) {
+#ifdef DTRACE_TAG_HARDDEBUG
+ erts_fprintf(stderr,
+ "Dtrace -> (%T) restore Killing tag!\r\n",
+ BIF_P->id);
+#endif
+ }
+ DT_UTAG(BIF_P) = NIL;
+ if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
+ SEQ_TRACE_TOKEN(BIF_P) = NIL;
+ }
+ DT_UTAG_FLAGS(BIF_P) = 0;
+ } else {
+ x = unsigned_val(tpl[1]) & (DT_UTAG_SPREADING | DT_UTAG_PERMANENT);
+#ifdef DTRACE_TAG_HARDDEBUG
+
+ if (!(x & DT_UTAG_SPREADING) && (DT_UTAG_FLAGS(BIF_P) &
+ DT_UTAG_SPREADING)) {
+ erts_fprintf(stderr,
+ "Dtrace -> (%T) restore stop spreading "
+ "tag %T\r\n",
+ BIF_P->id, tpl[2]);
+ } else if ((x & DT_UTAG_SPREADING) &&
+ !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_SPREADING)) {
+ erts_fprintf(stderr,
+ "Dtrace -> (%T) restore start spreading "
+ "tag %T\r\n",BIF_P->id,tpl[2]);
+ }
+#endif
+ DT_UTAG_FLAGS(BIF_P) = x;
+ DT_UTAG(BIF_P) = tpl[2];
+ if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+ SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
+ }
+ }
+#else
+ if (BIF_ARG_1 != am_true) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+#endif
+ BIF_RET(am_true);
+}
+
+