Add erlang:system_monitor(Pid,[{long_schedule,Millis}])

7 files changed, 124 insertions, 2 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index afcbd732df..62e08cd7e5 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -303,6 +303,7 @@ atom load_cancelled
 atom load_failure
 atom local
 atom long_gc
+atom long_schedule
 atom low
 atom Lt='<'
 atom machine
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 6d3b15cd46..364f90e281 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -934,6 +934,7 @@ extern int count_instructions;
 #  define NOINLINE
 #endif
 
+
 /*
  * The following functions are called directly by process_main().
  * Don't inline them.
@@ -952,6 +953,7 @@ static BeamInstr* apply_fun(Process* p, Eterm fun,
 			    Eterm args, Eterm* reg) NOINLINE;
 static Eterm new_fun(Process* p, Eterm* reg,
 		     ErlFunEntry* fe, int num_free) NOINLINE;
+static Uint64 timestamp_millis(void);
 
 
 /*
@@ -1184,6 +1186,9 @@ void process_main(void)
 
     Eterm pt_arity;		/* Used by do_put_tuple */
 
+    Uint64 start_time = 0;          /* Monitor long schedule */
+    BeamInstr* start_time_i = NULL;
+
     ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
 
 
@@ -1206,6 +1211,16 @@ void process_main(void)
  do_schedule:
     reds_used = REDS_IN(c_p) - FCALLS;
  do_schedule1:
+
+    if (start_time != 0) {
+        Sint64 diff = timestamp_millis() - start_time;
+	if (diff > 0 && (Uint) diff >  erts_system_monitor_long_schedule) {
+	    BeamInstr *inptr = find_function_from_pc(start_time_i);
+	    BeamInstr *outptr = find_function_from_pc(c_p->i);
+	    monitor_long_schedule(c_p,inptr,outptr,(Uint) diff);
+	}
+    }
+
     PROCESS_MAIN_CHK_LOCKS(c_p);
     ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
 #if HALFWORD_HEAP
@@ -1214,11 +1229,18 @@ void process_main(void)
     ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
     c_p = schedule(c_p, reds_used);
     ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+    start_time = 0;
 #ifdef DEBUG
     pid = c_p->id; /* Save for debugging purpouses */
 #endif
     ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
     PROCESS_MAIN_CHK_LOCKS(c_p);
+
+    if (erts_system_monitor_long_schedule != 0) {
+	start_time = timestamp_millis();
+	start_time_i = c_p->i;
+    }
+
     reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
     freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
 #if !HEAP_ON_C_STACK
@@ -6475,6 +6497,19 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg)
     return call_fun(p, arity, reg, args);
 }
 
+static Uint64 timestamp_millis(void)
+{
+#ifdef HAVE_GETHRTIME
+    return (Uint64) (sys_gethrtime() / 1000000);
+#else
+    Uint64 res;
+    SysTimeval tv;
+    sys_gettimeofday(&tv);
+    res = (Uint64) tv.tv_sec*1000000;
+    res += (Uint64) tv.tv_usec;
+    return (res / 1000);
+#endif
+}
 
 static Eterm
 new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 80f774523c..3d1afdd11c 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1902,6 +1902,7 @@ void erts_system_monitor_clear(Process *c_p) {
 #endif
     erts_set_system_monitor(NIL);
     erts_system_monitor_long_gc = 0;
+    erts_system_monitor_long_schedule = 0;
     erts_system_monitor_large_heap = 0;
     erts_system_monitor_flags.busy_port = 0;
     erts_system_monitor_flags.busy_dist_port = 0;
@@ -1926,12 +1927,17 @@ static Eterm system_monitor_get(Process *p)
 	Uint hsz = 3 + (erts_system_monitor_flags.busy_dist_port ? 2 : 0) +
 	    (erts_system_monitor_flags.busy_port ? 2 : 0); 
 	Eterm long_gc = NIL;
+	Eterm long_schedule = NIL;
 	Eterm large_heap = NIL;
 
 	if (erts_system_monitor_long_gc != 0) {
 	    hsz += 2+3;
 	    (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_gc);
 	}
+	if (erts_system_monitor_long_schedule != 0) {
+	    hsz += 2+3;
+	    (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_schedule);
+	}
 	if (erts_system_monitor_large_heap != 0) {
 	    hsz += 2+3;
 	    (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_large_heap);
@@ -1941,6 +1947,10 @@ static Eterm system_monitor_get(Process *p)
 	if (erts_system_monitor_long_gc != 0) {
 	    long_gc = erts_bld_uint(&hp, NULL, erts_system_monitor_long_gc);
 	}
+	if (erts_system_monitor_long_schedule != 0) {
+	    long_schedule = erts_bld_uint(&hp, NULL, 
+					  erts_system_monitor_long_schedule);
+	}
 	if (erts_system_monitor_large_heap != 0) {
 	    large_heap = erts_bld_uint(&hp, NULL, erts_system_monitor_large_heap);
 	}
@@ -1949,6 +1959,10 @@ static Eterm system_monitor_get(Process *p)
 	    Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3;
 	    res = CONS(hp, t, res); hp += 2;
 	}
+	if (long_schedule != NIL) {
+	    Eterm t = TUPLE2(hp, am_long_schedule, long_schedule); hp += 3;
+	    res = CONS(hp, t, res); hp += 2;
+	}
 	if (large_heap != NIL) {
 	    Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3;
 	    res = CONS(hp, t, res); hp += 2;
@@ -2003,7 +2017,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
     }
     if (is_not_list(list)) goto error;
     else {
-	Uint long_gc, large_heap;
+	Uint long_gc, long_schedule, large_heap;
 	int busy_port, busy_dist_port;
 
 	system_blocked = 1;
@@ -2013,7 +2027,8 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
 	if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0))
 	    goto error;
 
-	for (long_gc = 0, large_heap = 0, busy_port = 0, busy_dist_port = 0;
+	for (long_gc = 0, long_schedule = 0, large_heap = 0, 
+		 busy_port = 0, busy_dist_port = 0;
 	     is_list(list);
 	     list = CDR(list_val(list))) {
 	    Eterm t = CAR(list_val(list));
@@ -2023,6 +2038,9 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
 		if (tp[1] == am_long_gc) {
 		    if (! term_to_Uint(tp[2], &long_gc)) goto error;
 		    if (long_gc < 1) long_gc = 1;
+		} else if (tp[1] == am_long_schedule) {
+		    if (! term_to_Uint(tp[2], &long_schedule)) goto error;
+		    if (long_schedule < 1) long_schedule = 1;
 		} else if (tp[1] == am_large_heap) {
 		    if (! term_to_Uint(tp[2], &large_heap)) goto error;
 		    if (large_heap < 16384) large_heap = 16384;
@@ -2038,6 +2056,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
 	prev = system_monitor_get(p);
 	erts_set_system_monitor(monitor_pid);
 	erts_system_monitor_long_gc = long_gc;
+	erts_system_monitor_long_schedule = long_schedule;
 	erts_system_monitor_large_heap = large_heap;
 	erts_system_monitor_flags.busy_port = !!busy_port;
 	erts_system_monitor_flags.busy_dist_port = !!busy_dist_port;
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index c5127bc29d..9425fa7088 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -240,6 +240,7 @@ static Uint last_exact_reductions;
 Uint erts_default_process_flags;
 Eterm erts_system_monitor;
 Eterm erts_system_monitor_long_gc;
+Uint erts_system_monitor_long_schedule;
 Eterm erts_system_monitor_large_heap;
 struct erts_system_monitor_flags_t erts_system_monitor_flags;
 
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 7c481a91dd..968971ed4c 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -894,6 +894,7 @@ extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
 */
 extern Eterm erts_system_monitor;
 extern Uint erts_system_monitor_long_gc;
+extern Uint erts_system_monitor_long_schedule;
 extern Uint erts_system_monitor_large_heap;
 struct erts_system_monitor_flags_t {
 	 unsigned int busy_port : 1;
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 009ca1eb52..702fcc7f89 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2415,7 +2415,70 @@ trace_gc(Process *p, Eterm what)
 #undef LOCAL_HEAP_SIZE
 }
 
+void 
+monitor_long_schedule(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time)
+{
+    ErlHeapFragment *bp;
+    ErlOffHeap *off_heap;
+#ifndef ERTS_SMP
+    Process *monitor_p;
+#endif
+    Uint hsz;
+    Eterm *hp, list, in_mfa = am_undefined, out_mfa = am_undefined;
+    Eterm in_tpl, out_tpl, tmo_tpl, tmo, msg;
+ 
 
+#ifndef ERTS_SMP
+    ASSERT(is_internal_pid(system_monitor)
+	   && internal_pid_index(system_monitor) < erts_max_processes);
+    monitor_p = process_tab[internal_pid_index(system_monitor)];
+    if (INVALID_PID(monitor_p, system_monitor) || p == monitor_p) {
+	return;
+    }
+#endif
+    /* 
+     * Size: {monitor, pid, long_schedule, [{timeout, T}, {in, {M,F,A}},{out,{M,F,A}}]} ->
+     * 5 (top tuple of 4), (3 (elements) * 2 (cons)) + 3 (timeout tuple of 2) + size of Timeout +
+     * (2 * 3 (in/out tuple of 2)) + 
+     * 0 (unknown) or 4 (MFA tuple of 3) + 0 (unknown) or 4 (MFA tuple of 3)
+     * = 20 + (in_fp != NULL) ? 4 : 0 + (out_fp != NULL) ? 4 : 0 + size of Timeout
+     */
+    hsz = 20 + ((in_fp != NULL) ? 4 : 0) + ((out_fp != NULL) ? 4 : 0);
+    (void) erts_bld_uint(NULL, &hsz, time);
+    hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p);
+    tmo = erts_bld_uint(&hp, NULL, time);
+    if (in_fp != NULL) {
+	in_mfa = TUPLE3(hp,(Eterm) in_fp[0], (Eterm) in_fp[1], make_small(in_fp[2]));
+	hp +=4;
+    } 
+    if (out_fp != NULL) {
+	out_mfa = TUPLE3(hp,(Eterm) out_fp[0], (Eterm) out_fp[1], make_small(out_fp[2]));
+	hp +=4;
+    } 
+    tmo_tpl = TUPLE2(hp,am_timeout, tmo);
+    hp += 3;
+    in_tpl = TUPLE2(hp,am_in,in_mfa);
+    hp += 3;
+    out_tpl = TUPLE2(hp,am_out,out_mfa);
+    hp += 3;
+    list = CONS(hp,out_tpl,NIL); 
+    hp += 2;
+    list = CONS(hp,in_tpl,list);
+    hp += 2;
+    list = CONS(hp,tmo_tpl,list);
+    hp += 2;
+    msg = TUPLE4(hp, am_monitor, p->id, am_long_schedule, list);
+    hp += 5;
+#ifdef ERTS_SMP
+    enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp);
+#else
+    erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef USE_VM_PROBES
+			   , NIL
+#endif
+		       );
+#endif
+}
 
 void
 monitor_long_gc(Process *p, Uint time) {
@@ -3157,6 +3220,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
     case SYS_MSG_TYPE_SYSMON:
 	if (receiver == NIL
 	    && !erts_system_monitor_long_gc
+	    && !erts_system_monitor_long_schedule
 	    && !erts_system_monitor_large_heap
 	    && !erts_system_monitor_flags.busy_port
 	    && !erts_system_monitor_flags.busy_dist_port)
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 2c20e3da3b..70459bfebc 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1455,6 +1455,7 @@ void erts_system_profile_setup_active_schedulers(void);
 
 /* system_monitor */
 void monitor_long_gc(Process *p, Uint time);
+void monitor_long_schedule(Process *p, BeamInstr *in_i, BeamInstr *out_i, Uint time);
 void monitor_large_heap(Process *p);
 void monitor_generic(Process *p, Eterm type, Eterm spec);
 Uint erts_trace_flag2bit(Eterm flag);