Add long_schedule detection for ports and testcases

10 files changed, 379 insertions, 19 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 62e08cd7e5..89249cee2f 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -172,6 +172,7 @@ atom disable_trace
 atom disabled
 atom display_items
 atom dist
+atom dist_cmd
 atom Div='/'
 atom div
 atom dlink
@@ -420,6 +421,7 @@ atom pid
 atom port
 atom ports
 atom port_count
+atom port_op
 atom print
 atom priority
 atom private
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 364f90e281..c5c57c1125 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -953,7 +953,6 @@ 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);
 
 
 /*
@@ -1213,11 +1212,11 @@ void process_main(void)
  do_schedule1:
 
     if (start_time != 0) {
-        Sint64 diff = timestamp_millis() - start_time;
+        Sint64 diff = erts_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);
+	    monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff);
 	}
     }
 
@@ -1237,7 +1236,7 @@ void process_main(void)
     PROCESS_MAIN_CHK_LOCKS(c_p);
 
     if (erts_system_monitor_long_schedule != 0) {
-	start_time = timestamp_millis();
+	start_time = erts_timestamp_millis();
 	start_time_i = c_p->i;
     }
 
@@ -6497,19 +6496,7 @@ 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_port_task.c b/erts/emulator/beam/erl_port_task.c
index 3dc7c14faf..d25af94099 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -746,6 +746,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
     int reds = ERTS_PORT_REDS_EXECUTE;
     erts_aint_t io_tasks_executed = 0;
     int fpe_was_unmasked;
+    Uint64 start_time = 0;
 
     ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
 
@@ -808,6 +809,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	reset_handle(ptp);
 	erts_smp_runq_unlock(runq);
 
+	if (erts_system_monitor_long_schedule != 0) {
+	    start_time = erts_timestamp_millis();
+	}
+
 	ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
 	ERTS_SMP_CHK_NO_PROC_LOCKS;
 	ASSERT(pp->drv_ptr);
@@ -881,6 +886,13 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	    erts_terminate_port(pp);
 	}
 
+	if (start_time != 0) {
+	    Sint64 diff = erts_timestamp_millis() - start_time;
+	    if (diff > 0 && (Uint) diff >  erts_system_monitor_long_schedule) {
+		monitor_long_schedule_port(pp,ptp->type,(Uint) diff);
+	    }
+	}
+	start_time = 0;
 	ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
 
 #ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 702fcc7f89..dc8b4bbe6e 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2416,7 +2416,7 @@ trace_gc(Process *p, Eterm what)
 }
 
 void 
-monitor_long_schedule(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time)
+monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time)
 {
     ErlHeapFragment *bp;
     ErlOffHeap *off_heap;
@@ -2479,6 +2479,72 @@ monitor_long_schedule(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time
 		       );
 #endif
 }
+void 
+monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
+{
+    ErlHeapFragment *bp;
+    ErlOffHeap *off_heap;
+#ifndef ERTS_SMP
+    Process *monitor_p;
+#endif
+    Uint hsz;
+    Eterm *hp, list, op;
+    Eterm op_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)) {
+	return;
+    }
+#endif
+    /* 
+     * Size: {monitor, port, long_schedule, [{timeout, T}, {op, Operation}]} ->
+     * 5 (top tuple of 4), (2 (elements) * 2 (cons)) + 3 (timeout tuple of 2) 
+     * + size of Timeout + 3 (op tuple of 2 atoms)
+     * = 15 + size of Timeout
+     */
+    hsz = 15;
+    (void) erts_bld_uint(NULL, &hsz, time);
+
+    hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p);
+
+    switch (type) {
+    case ERTS_PORT_TASK_FREE: op = am_free; break;
+    case ERTS_PORT_TASK_TIMEOUT: op = am_timeout; break;
+    case ERTS_PORT_TASK_INPUT: op = am_input; break;
+    case ERTS_PORT_TASK_OUTPUT: op = am_output; break;
+    case ERTS_PORT_TASK_EVENT: op = am_event; break;
+    case ERTS_PORT_TASK_DIST_CMD: op = am_dist_cmd; break;
+    default: op = am_undefined; break;
+    }
+
+    tmo = erts_bld_uint(&hp, NULL, time);
+
+    op_tpl = TUPLE2(hp,am_port_op,op); 
+    hp += 3;
+
+    tmo_tpl = TUPLE2(hp,am_timeout, tmo);
+    hp += 3;
+
+    list = CONS(hp,op_tpl,NIL);
+    hp += 2;
+    list = CONS(hp,tmo_tpl,list);
+    hp += 2;
+    msg = TUPLE4(hp, am_monitor, pp->id, am_long_schedule, list);
+    hp += 5;
+#ifdef ERTS_SMP
+    enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->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) {
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 70459bfebc..5f41ed0dc4 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1455,13 +1455,15 @@ 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_long_schedule_proc(Process *p, BeamInstr *in_i, BeamInstr *out_i, Uint time);
+void monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time);
 void monitor_large_heap(Process *p);
 void monitor_generic(Process *p, Eterm type, Eterm spec);
 Uint erts_trace_flag2bit(Eterm flag);
 int erts_trace_flags(Eterm List, 
 		 Uint *pMask, Eterm *pTracer, int *pCpuTimestamp);
 Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I);
+Uint64 erts_timestamp_millis(void);
 
 #ifdef ERTS_SMP
 void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index bd708ceee6..9e8b1086d4 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -3436,6 +3436,24 @@ void erts_silence_warn_unused_result(long unused)
 
 }
 
+/*
+ * A millisecond timestamp without time correction where there's no hrtime
+ * - for tracing on "long" things...
+ */
+Uint64 erts_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
+}
+
 #ifdef DEBUG
 /*
  * Handy functions when using a debugger - don't use in the code!
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 221b65309a..ead433f9f8 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -34,6 +34,7 @@
 	 system_monitor_args/1, more_system_monitor_args/1,
 	 system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, 
 	 system_monitor_large_heap_1/1, system_monitor_large_heap_2/1,
+	 system_monitor_long_schedule/1,
 	 bad_flag/1, trace_delivered/1]).
 
 -include_lib("test_server/include/test_server.hrl").
@@ -52,6 +53,7 @@ all() ->
      set_on_first_spawn, system_monitor_args,
      more_system_monitor_args, system_monitor_long_gc_1,
      system_monitor_long_gc_2, system_monitor_large_heap_1,
+      system_monitor_long_schedule,
      system_monitor_large_heap_2, bad_flag, trace_delivered].
 
 groups() -> 
@@ -508,6 +510,58 @@ try_l(Val) ->
     ?line {Self,Comb1} = erlang:system_monitor(undefined),
     ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1).
 
+monitor_sys(Parent) ->
+    receive 
+	{monitor,Pid,long_schedule,Data} when is_pid(Pid) -> 
+	    io:format("Long schedule of ~w: ~w~n",[Pid,Data]),
+	    Parent ! {Pid,Data},
+	    monitor_sys(Parent);
+	{monitor,Port,long_schedule,Data} when is_port(Port) -> 
+	    {name,Name} = erlang:port_info(Port,name),
+	    io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]),
+	    Parent ! {Port,Data},
+	    monitor_sys(Parent);
+	Other ->
+	    erlang:display(Other)
+    end.
+
+start_monitor() ->
+    Parent = self(),
+    Mpid = spawn_link(fun() -> monitor_sys(Parent) end),
+    erlang:system_monitor(Mpid,[{long_schedule,100}]).
+
+system_monitor_long_schedule(suite) ->
+    [];
+system_monitor_long_schedule(doc) ->
+    ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"];
+system_monitor_long_schedule(Config) when is_list(Config) ->
+    Path = ?config(data_dir, Config),
+    erl_ddll:start(),
+    ok = load_driver(Path, slow_drv),
+    start_monitor(),
+    erlang:yield(), % Need to be rescheduled for the trace to take
+    Port = open_port({spawn_driver,slow_drv}, []),
+    "ok" = erlang:port_control(Port,0,[]),
+    Self = self(),
+    receive
+	{Self,L} when is_list(L) ->
+	    ok
+    after 1000 ->
+	    ?t:fail(no_trace_of_pid)
+    end,
+    "ok" = erlang:port_control(Port,1,[]),
+    "ok" = erlang:port_control(Port,2,[]),
+    receive
+	{Port,LL} when is_list(LL) ->
+	    ok
+    after 1000 ->
+	    ?t:fail(no_trace_of_port)
+    end,
+    port_close(Port),
+    erlang:system_monitor(undefined),
+    ok.
+
+
 -define(LONG_GC_SLEEP, 670).
 
 system_monitor_long_gc_1(suite) ->
@@ -1521,3 +1575,11 @@ issue_non_empty_runq_warning(DeadLine, RQLen) ->
 	      "         Processes info: ~p~n",
 	      [DeadLine div 1000, RQLen, self(), PIs]),
     receive after 1000 -> ok end.
+
+load_driver(Dir, Driver) ->
+    case erl_ddll:load_driver(Dir, Driver) of
+	ok -> ok;
+	{error, Error} = Res ->
+	    io:format("~s\n", [erl_ddll:format_error(Error)]),
+	    Res
+    end.
diff --git a/erts/emulator/test/trace_SUITE_data/Makefile.src b/erts/emulator/test/trace_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..4cd9249b8f
--- /dev/null
+++ b/erts/emulator/test/trace_SUITE_data/Makefile.src
@@ -0,0 +1,5 @@
+DRVS =	slow_drv@dll@
+
+all: $(DRVS) 
+
+@SHLIB_RULES@
diff --git a/erts/emulator/test/trace_SUITE_data/slow_drv.c b/erts/emulator/test/trace_SUITE_data/slow_drv.c
new file mode 100644
index 0000000000..c3e9db0fb8
--- /dev/null
+++ b/erts/emulator/test/trace_SUITE_data/slow_drv.c
@@ -0,0 +1,205 @@
+/* ``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 via the world wide web 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.
+ * 
+ * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+ * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+ * AB. All Rights Reserved.''
+ * 
+ *     $Id$
+ */
+
+#ifndef UNIX
+#if !defined(__WIN32__) && !defined(VXWORKS)
+#define UNIX 1
+#endif
+#endif
+
+/* We actually only want to run this on 
+   Unix machines which have the usleep call */
+#if defined(UNIX) && !defined(HAVE_USLEEP)
+#undef UNIX
+#endif
+
+#ifdef UNIX
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h> /* rand */
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#ifdef HAVE_POLL_H
+#  include <poll.h>
+#endif
+#endif /* UNIX */
+
+#include "erl_driver.h"
+
+static int slow_drv_init(void);
+static void slow_drv_finish(void);
+static ErlDrvData slow_drv_start(ErlDrvPort, char *);
+static void slow_drv_stop(ErlDrvData);
+static void slow_drv_ready_input(ErlDrvData, ErlDrvEvent);
+static ErlDrvSSizeT slow_drv_control(ErlDrvData, unsigned int,
+				      char *, ErlDrvSizeT, char **, ErlDrvSizeT);
+
+static ErlDrvEntry slow_drv_entry = { 
+    slow_drv_init,
+    slow_drv_start,
+    slow_drv_stop,
+    NULL, /* output */
+    slow_drv_ready_input,
+    NULL, /* ready_output */
+    "slow_drv",
+    slow_drv_finish,
+    NULL, /* handle */
+    slow_drv_control,
+    NULL, /* timeout */
+    NULL, /* outputv */
+    NULL, /* ready_async */
+    NULL, /* flush */
+    NULL, /* call */
+    NULL, /* event */
+
+    ERL_DRV_EXTENDED_MARKER,
+    ERL_DRV_EXTENDED_MAJOR_VERSION,
+    ERL_DRV_EXTENDED_MINOR_VERSION,
+    ERL_DRV_FLAG_USE_PORT_LOCKING,
+    NULL,/* void *handle2 */
+    NULL,/* process_exit */
+    NULL /* stop select */
+};
+typedef struct {
+    ErlDrvPort port;
+    ErlDrvTermData id;
+    int test;
+    int s[2];
+} SlowDrvData;
+
+/* -------------------------------------------------------------------------
+** Entry functions
+**/
+
+DRIVER_INIT(slow_drv)
+{
+    return &slow_drv_entry;
+}
+
+
+static int
+slow_drv_init(void)
+{
+    return 0;
+}
+
+static void
+slow_drv_finish(void)
+{
+}
+
+
+static ErlDrvData
+slow_drv_start(ErlDrvPort port, char *command)
+{
+#ifndef UNIX
+    return NULL;
+#else
+    SlowDrvData *sddp = driver_alloc(sizeof(SlowDrvData));
+    if (!sddp) {
+	errno = ENOMEM;
+	return ERL_DRV_ERROR_ERRNO;
+    }
+    sddp->port = port;
+    sddp->id = driver_mk_port(port);
+    sddp->test = 0;
+    sddp->s[0] = sddp->s[1] = -1;
+    return (ErlDrvData) sddp;
+#endif
+}
+
+static void
+slow_drv_stop(ErlDrvData drv_data) {
+#ifdef UNIX
+    SlowDrvData *sddp = (SlowDrvData *) drv_data;
+
+    if (sddp->test) {
+	driver_select(sddp->port, (ErlDrvEvent) (ErlDrvSInt) sddp->s[0], DO_READ, 0);
+	close(sddp->s[0]);
+	close(sddp->s[1]);
+    }
+
+    driver_free((void *) sddp);
+
+#endif
+}
+
+static ErlDrvSSizeT
+slow_drv_control(ErlDrvData drv_data,
+		 unsigned int command,
+		 char *buf, ErlDrvSizeT len,
+		 char **rbuf, ErlDrvSizeT rlen)
+{
+    SlowDrvData *sddp = (SlowDrvData *) drv_data;
+    char *res_str = "ok";
+    int res_len;
+    switch (command) {
+    case 0:
+	/* just be slow */
+	usleep(222000);
+	break;
+    case 1:
+	/* create pipes and select on input */
+	if (sddp->test) {
+	    res_str = "no";
+	    break;
+	}
+	sddp->test = 1;
+	pipe(sddp->s);
+	driver_select(sddp->port, (ErlDrvEvent) (ErlDrvSInt) sddp->s[0], DO_READ, 1);
+	break;
+    case 2:
+	if (!sddp->test) {
+	    res_str = "no";
+	    break;
+	}
+	write(sddp->s[1],"boo",3);
+	break;
+    }
+
+    res_len = strlen(res_str);
+    if (res_len > rlen) {
+	char *abuf = driver_alloc(sizeof(char)*res_len);
+	if (!abuf)
+	    return 0;
+	*rbuf = abuf;
+    }
+
+    memcpy((void *) *rbuf, (void *) res_str, res_len);
+
+    return res_len;
+}
+
+static void
+slow_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event)
+{
+#ifdef UNIX
+    SlowDrvData *sddp = (SlowDrvData *) drv_data;
+    int fd = (int) (ErlDrvSInt) event;
+    if (sddp->test) {
+	char buff[3];
+	usleep(212000);
+	read(sddp->s[0],buff,3);
+	driver_output(sddp->port, "TheEnd", 6);
+    }
+
+#endif
+}
diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in
index 785bab395c..b8fddf1481 100644
--- a/lib/test_server/src/configure.in
+++ b/lib/test_server/src/configure.in
@@ -276,6 +276,7 @@ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
 dnl Checks for library functions.
 AC_CHECK_FUNCS(strerror)
 AC_CHECK_FUNCS(vsnprintf)
+AC_CHECK_FUNCS(usleep)
 
 # First check if the library is available, then if we can choose between
 # two versions of gethostbyname