diff options
Diffstat (limited to 'erts/emulator/beam/bif.c')
| -rw-r--r-- | erts/emulator/beam/bif.c | 632 |
1 files changed, 538 insertions, 94 deletions
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 68b3350d7f..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 @@ -36,12 +36,16 @@ #include "beam_bp.h" #include "erl_db_util.h" #include "register.h" +#include "erl_thr_progress.h" static Export* flush_monitor_message_trap = NULL; static Export* set_cpu_topology_trap = NULL; static Export* await_proc_exit_trap = NULL; Export* erts_format_cpu_topology_trap = NULL; +static Export *await_sched_wall_time_mod_trap; +static erts_smp_atomic32_t sched_wall_time; + #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) /* @@ -559,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 @@ -811,7 +819,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) so.min_heap_size = H_MIN_SIZE; so.min_vheap_size = BIN_VH_MIN_SIZE; so.priority = PRIORITY_NORMAL; - so.max_gen_gcs = (Uint16) erts_smp_atomic32_read(&erts_max_gen_gcs); + so.max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs); so.scheduler = 0; /* @@ -869,8 +877,6 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) } } else if (arg == am_scheduler && is_small(val)) { Sint scheduler = signed_val(val); - if (erts_common_run_queue && erts_no_schedulers > 1) - goto error; if (scheduler < 0 || erts_no_schedulers < scheduler) goto error; so.scheduler = (int) scheduler; @@ -1107,9 +1113,9 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE get_stacktrace_0(Process* p) +BIF_RETTYPE get_stacktrace_0(BIF_ALIST_0) { - Eterm t = build_stacktrace(p, p->ftrace); + Eterm t = build_stacktrace(BIF_P, BIF_P->ftrace); BIF_RET(t); } @@ -1119,10 +1125,10 @@ BIF_RETTYPE get_stacktrace_0(Process* p) * the process, and the final error value will be {Term,StackTrace}. */ -BIF_RETTYPE error_1(Process* p, Eterm term) +BIF_RETTYPE error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1131,12 +1137,12 @@ BIF_RETTYPE error_1(Process* p, Eterm term) * in the stacktrace. */ -BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1146,10 +1152,10 @@ BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_1(Process* p, Eterm term) +BIF_RETTYPE nif_error_1(BIF_ALIST_1) { - p->fvalue = term; - BIF_ERROR(p, EXC_ERROR); + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_ERROR); } /**********************************************************************/ @@ -1159,12 +1165,12 @@ BIF_RETTYPE nif_error_1(Process* p, Eterm term) * It is useful in stub functions for NIFs. */ -BIF_RETTYPE nif_error_2(Process* p, Eterm value, Eterm args) +BIF_RETTYPE nif_error_2(BIF_ALIST_2) { - Eterm* hp = HAlloc(p, 3); + Eterm* hp = HAlloc(BIF_P, 3); - p->fvalue = TUPLE2(hp, value, args); - BIF_ERROR(p, EXC_ERROR_2); + BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2); + BIF_ERROR(BIF_P, EXC_ERROR_2); } /**********************************************************************/ @@ -1183,14 +1189,19 @@ BIF_RETTYPE exit_1(BIF_ALIST_1) * If there is an error in the argument format, * return the atom 'badarg' instead. */ -Eterm -raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { +BIF_RETTYPE raise_3(BIF_ALIST_3) +{ + Process *c_p = BIF_P; + Eterm class = BIF_ARG_1; + Eterm value = BIF_ARG_2; + Eterm stacktrace = BIF_ARG_3; Eterm reason; Eterm l, *hp, *hp_end, *tp; int depth, cnt; size_t sz; + int must_copy = 0; struct StackTrace *s; - + if (class == am_error) { c_p->fvalue = value; reason = EXC_ERROR; @@ -1206,35 +1217,74 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { /* Check syntax of stacktrace, and count depth. * Accept anything that can be returned from erlang:get_stacktrace/0, * as well as a 2-tuple with a fun as first element that the - * error_handler may need to give us. + * error_handler may need to give us. Also allow old-style + * MFA three-tuples. */ for (l = stacktrace, depth = 0; is_list(l); l = CDR(list_val(l)), depth++) { Eterm t = CAR(list_val(l)); - int arity; + Eterm location = NIL; + if (is_not_tuple(t)) goto error; tp = tuple_val(t); - arity = arityval(tp[0]); - if ((arity == 3) && is_atom(tp[1]) && is_atom(tp[2])) continue; - if ((arity == 2) && is_fun(tp[1])) continue; - goto error; + switch (arityval(tp[0])) { + case 2: + /* {Fun,Args} */ + if (is_fun(tp[1])) { + must_copy = 1; + } else { + goto error; + } + break; + case 3: + /* + * One of: + * {Fun,Args,Location} + * {M,F,A} + */ + if (is_fun(tp[1])) { + location = tp[3]; + } else if (is_atom(tp[1]) && is_atom(tp[2])) { + must_copy = 1; + } else { + goto error; + } + break; + case 4: + if (!(is_atom(tp[1]) && is_atom(tp[2]))) { + goto error; + } + location = tp[4]; + break; + default: + goto error; + } + if (is_not_list(location) && is_not_nil(location)) { + goto error; + } } if (is_not_nil(l)) goto error; /* Create stacktrace and store */ - if (depth <= erts_backtrace_depth) { + if (erts_backtrace_depth < depth) { + depth = erts_backtrace_depth; + must_copy = 1; + } + if (must_copy) { + cnt = depth; + c_p->ftrace = NIL; + } else { + /* No need to copy the stacktrace */ cnt = 0; c_p->ftrace = stacktrace; - } else { - cnt = depth = erts_backtrace_depth; - c_p->ftrace = NIL; } + tp = &c_p->ftrace; sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1) / sizeof(Eterm); - hp = HAlloc(c_p, sz + 2*(cnt + 1)); - hp_end = hp + sz + 2*(cnt + 1); + hp = HAlloc(c_p, sz + (2+6)*(cnt + 1)); + hp_end = hp + sz + (2+6)*(cnt + 1); s = (struct StackTrace *) hp; s->header = make_neg_bignum_header(sz - 1); s->freason = reason; @@ -1242,13 +1292,29 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { s->current = NULL; s->depth = 0; hp += sz; - if (cnt > 0) { + if (must_copy) { + int cnt; + /* Copy list up to depth */ for (cnt = 0, l = stacktrace; cnt < depth; cnt++, l = CDR(list_val(l))) { + Eterm t; + Eterm *tpp; + int arity; + ASSERT(*tp == NIL); - *tp = CONS(hp, CAR(list_val(l)), *tp); + t = CAR(list_val(l)); + tpp = tuple_val(t); + arity = arityval(tpp[0]); + if (arity == 2) { + t = TUPLE3(hp, tpp[1], tpp[2], NIL); + hp += 4; + } else if (arity == 3 && is_atom(tpp[1])) { + t = TUPLE4(hp, tpp[1], tpp[2], tpp[3], NIL); + hp += 5; + } + *tp = CONS(hp, t, *tp); tp = &CDR(list_val(*tp)); hp += 2; } @@ -1256,7 +1322,7 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { c_p->ftrace = CONS(hp, c_p->ftrace, make_big((Eterm *) s)); hp += 2; ASSERT(hp <= hp_end); - + HRelease(c_p, hp_end, hp); BIF_ERROR(c_p, reason); error: @@ -1474,8 +1540,6 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) ErtsRunQueue *old; ErtsRunQueue *new; Sint sched; - if (erts_common_run_queue && erts_no_schedulers > 1) - goto error; if (!is_small(BIF_ARG_2)) goto error; sched = signed_val(BIF_ARG_2); @@ -1674,10 +1738,10 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1) * erlang:'!'/2 */ -Eterm -ebif_bang_2(Process* p, Eterm To, Eterm Message) +BIF_RETTYPE +ebif_bang_2(BIF_ALIST_2) { - return send_2(p, To, Message); + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); } @@ -1884,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); @@ -2014,8 +2082,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) { } -Eterm -send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { +BIF_RETTYPE send_3(BIF_ALIST_3) +{ + Process *p = BIF_P; + Eterm to = BIF_ARG_1; + Eterm msg = BIF_ARG_2; + Eterm opts = BIF_ARG_3; + int connect = !0; int suspend = !0; Eterm l = opts; @@ -2079,8 +2152,13 @@ send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { BIF_ERROR(p, BADARG); } -Eterm -send_2(Process *p, Eterm to, Eterm msg) { +BIF_RETTYPE send_2(BIF_ALIST_2) +{ + return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); +} + +Eterm erl_send(Process *p, Eterm to, Eterm msg) +{ Sint result = do_send(p, to, msg, !0); if (result > 0) { @@ -3256,8 +3334,11 @@ time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day, /* return the universal time */ BIF_RETTYPE -localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst) +localtime_to_universaltime_2(BIF_ALIST_2) { + Process *p = BIF_P; + Eterm localtime = BIF_ARG_1; + Eterm dst = BIF_ARG_2; Sint year, month, day; Sint hour, minute, second; int isdst; @@ -3315,6 +3396,61 @@ BIF_RETTYPE universaltime_to_localtime_1(BIF_ALIST_1) BIF_RET(TUPLE2(hp, res1, res2)); } +/* convert calendar:universaltime_to_seconds/1 */ + +BIF_RETTYPE universaltime_to_posixtime_1(BIF_ALIST_1) +{ + Sint year, month, day; + Sint hour, minute, second; + + Sint64 seconds = 0; + Eterm *hp; + Uint hsz = 0; + + if (!time_to_parts(BIF_ARG_1, &year, &month, &day, + &hour, &minute, &second)) + BIF_ERROR(BIF_P, BADARG); + + if (!univ_to_seconds(year, month, day, hour, minute, second, &seconds)) { + BIF_ERROR(BIF_P, BADARG); + } + + erts_bld_sint64(NULL, &hsz, seconds); + hp = HAlloc(BIF_P, hsz); + BIF_RET(erts_bld_sint64(&hp, NULL, seconds)); +} + +/* convert calendar:seconds_to_universaltime/1 */ + +BIF_RETTYPE posixtime_to_universaltime_1(BIF_ALIST_1) +{ + Sint year, month, day; + Sint hour, minute, second; + Eterm res1, res2; + Eterm* hp; + + Sint64 time = 0; + + if (!term_to_Sint64(BIF_ARG_1, &time)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!seconds_to_univ(time, &year, &month, &day, + &hour, &minute, &second)) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, 4+4+3); + res1 = TUPLE3(hp,make_small(year),make_small(month), + make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute), + make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); +} + + /**********************************************************************/ @@ -3417,10 +3553,10 @@ BIF_RETTYPE ports_0(BIF_ALIST_0) erts_smp_mtx_lock(&ports_snapshot_mtx); /* One snapshot at a time */ - erts_smp_atomic_set(&erts_dead_ports_ptr, - (erts_aint_t) (port_buf + erts_max_ports)); + erts_smp_atomic_set_nob(&erts_dead_ports_ptr, + (erts_aint_t) (port_buf + erts_max_ports)); - next_ss = erts_smp_atomic32_inctest(&erts_ports_snapshot); + next_ss = erts_smp_atomic32_inc_read_relb(&erts_ports_snapshot); for (i = erts_max_ports-1; i >= 0; i--) { Port* prt = &erts_port[i]; @@ -3434,8 +3570,8 @@ BIF_RETTYPE ports_0(BIF_ALIST_0) erts_smp_port_state_unlock(prt); } - dead_ports = (Eterm*)erts_smp_atomic_xchg(&erts_dead_ports_ptr, - (erts_aint_t) NULL); + dead_ports = (Eterm*)erts_smp_atomic_xchg_nob(&erts_dead_ports_ptr, + (erts_aint_t) NULL); erts_smp_mtx_unlock(&ports_snapshot_mtx); ASSERT(pp <= dead_ports); @@ -3506,9 +3642,10 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1) } -Eterm -display_string_1(Process* p, Eterm string) +BIF_RETTYPE display_string_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm string = BIF_ARG_1; int len = is_string(string); char *str; @@ -3524,8 +3661,7 @@ display_string_1(Process* p, Eterm string) BIF_RET(am_true); } -Eterm -display_nl_0(Process* p) +BIF_RETTYPE display_nl_0(BIF_ALIST_0) { erts_fprintf(stderr, "\n"); BIF_RET(am_true); @@ -3537,43 +3673,122 @@ display_nl_0(Process* p) /* 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) || @@ -3589,8 +3804,13 @@ BIF_RETTYPE function_exported_3(BIF_ALIST_3) /**********************************************************************/ -BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity) +BIF_RETTYPE is_builtin_3(BIF_ALIST_3) { + Process* p = BIF_P; + Eterm Mod = BIF_ARG_1; + Eterm Name = BIF_ARG_2; + Eterm Arity = BIF_ARG_3; + if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) { BIF_ERROR(p, BADARG); } @@ -3655,9 +3875,11 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3) BIF_RET(make_export(hp)); } -Eterm -fun_to_list_1(Process* p, Eterm fun) +BIF_RETTYPE fun_to_list_1(BIF_ALIST_1) { + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + if (is_not_any_fun(fun)) BIF_ERROR(p, BADARG); BIF_RET(term2list_dsprintf(p, fun)); @@ -3942,8 +4164,8 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) goto error; } nval = (n > (Sint) ((Uint16) -1)) ? ((Uint16) -1) : ((Uint16) n); - oval = (Uint) erts_smp_atomic32_xchg(&erts_max_gen_gcs, - (erts_aint32_t) nval); + oval = (Uint) erts_smp_atomic32_xchg_nob(&erts_max_gen_gcs, + (erts_aint32_t) nval); BIF_RET(make_small(oval)); } else if (BIF_ARG_1 == am_min_heap_size) { int oval = H_MIN_SIZE; @@ -3953,11 +4175,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); H_MIN_SIZE = erts_next_heap_size(n, 0); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(make_small(oval)); @@ -3969,11 +4191,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); BIN_VH_MIN_SIZE = erts_next_heap_size(n, 0); - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(make_small(oval)); @@ -3995,7 +4217,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_backtrace_depth = n; BIF_RET(make_small(oval)); } else if (BIF_ARG_1 == am_trace_control_word) { - BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2)); + BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2)); } else if (BIF_ARG_1 == am_sequential_tracer) { Eterm old_value = erts_set_system_seq_tracer(BIF_P, ERTS_PROC_LOCK_MAIN, @@ -4007,27 +4229,47 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) Uint i; ErlMessage* mp; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_smp_block_system(0); + erts_smp_thr_progress_block(); 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; } } } - erts_smp_release_system(); + erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); + } else if (BIF_ARG_1 == am_scheduler_wall_time) { + if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { + erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0; + erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time, + new); + Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new); + ASSERT(is_value(ref)); + BIF_TRAP2(await_sched_wall_time_mod_trap, + BIF_P, + ref, + old ? am_true : am_false); + } } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4047,8 +4289,20 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) if (is_value(res)) BIF_RET(res); } else if (ERTS_IS_ATOM_STR("cpu_topology", BIF_ARG_1)) { + erts_send_warning_to_logger_str( + BIF_P->group_leader, + "A call to erlang:system_flag(cpu_topology, _) was made.\n" + "The cpu_topology argument is deprecated and scheduled\n" + "for removal in erts-5.10/OTP-R16. For more information\n" + "see the erlang:system_flag/2 documentation.\n"); BIF_TRAP1(set_cpu_topology_trap, BIF_P, BIF_ARG_2); } else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) { + erts_send_warning_to_logger_str( + BIF_P->group_leader, + "A call to erlang:system_flag(scheduler_bind_type, _) was\n" + "made. The scheduler_bind_type argument is deprecated and\n" + "scheduled for removal in erts-5.10/OTP-R16. For more\n" + "information see the erlang:system_flag/2 documentation.\n"); return erts_bind_schedulers(BIF_P, BIF_ARG_2); } error: @@ -4235,8 +4489,7 @@ void erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret); } } @@ -4244,8 +4497,7 @@ void erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_reason, am_undefined); } } @@ -4260,7 +4512,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, { ASSERT(is_atom(module) && is_atom(function)); if (skip_current_msgq(c_p)) { - Eterm unused; Eterm term; Eterm *hp; int i; @@ -4272,7 +4523,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, hp += 2; } term = TUPLE3(hp, module, function, term); - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term); } } @@ -4286,7 +4537,7 @@ void erts_init_bif(void) erts_smp_spinlock_init(&make_ref_lock, "make_ref"); erts_smp_mtx_init(&ports_snapshot_mtx, "ports_snapshot"); - erts_smp_atomic_init(&erts_dead_ports_ptr, (erts_aint_t) NULL); + erts_smp_atomic_init_nob(&erts_dead_ports_ptr, (erts_aint_t) NULL); /* * bif_return_trap/1 is a hidden BIF that bifs that need to @@ -4316,6 +4567,9 @@ void erts_init_bif(void) am_format_cpu_topology, 1); await_proc_exit_trap = erts_export_put(am_erlang,am_await_proc_exit,3); + await_sched_wall_time_mod_trap + = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + erts_smp_atomic32_init_nob(&sched_wall_time, 0); } #ifdef HARDDEBUG @@ -4392,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); +} + + |