Merge branch 'maint'

17 files changed, 376 insertions, 10 deletions

diff --git a/erts/configure.in b/erts/configure.in
index c47c211c4e..b056ba44e2 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -429,7 +429,7 @@ case $host_os in
     win32)
 	# The ethread library requires _WIN32_WINNT of at least 0x0403.
 	# -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS.
-	CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0500 -DWINVER=0x0500"
+	CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0501 -DWINVER=0x0501"
 	;;
     darwin*)
         CPPFLAGS="$CPPFLAGS -D_XOPEN_SOURCE"
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 81e9084e07..14ac97767d 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -6038,6 +6038,49 @@ ok
 	      notice.
 	      </p>
           </item>
+          <tag><c>{long_schedule, Time}</c></tag>
+          <item>
+              <p>If a process or port in the system runs uninterrupted
+              for at least <c>Time</c> wall clock milliseconds, a
+              message <c>{monitor, PidOrPort, long_schedule, Info}</c>
+              is sent to <c>MonitorPid</c>. <c>PidOrPort</c> is the
+              process or port that was running and <c>Info</c> is a
+              list of two-element tuples describing the event. In case
+              of a <c>pid()</c>, the tuples <c>{timeout, Millis}</c>,
+              <c>{in, Location}</c> and <c>{out, Location}</c> will be
+              present, where <c>Location</c> is either an MFA
+              (<c>{Module, Function, Arity}</c>) describing the
+              function where the process was scheduled in/out, or the
+              atom <c>undefined</c>. In case of a <c>port()</c>, the
+              tuples <c>{timeout, Millis}</c> and <c>{port_op,Op}</c>
+              will be present. <c>Op</c> will be one of <c>proc_sig</c>,
+              <c>timeout</c>, <c>input</c>, <c>output</c>,
+              <c>event</c> or <c>dist_cmd</c>, depending on which
+              driver callback was executing. <c>proc_sig</c> is an
+              internal operation and should never appear, while the
+              others represent the corresponding driver callbacks
+              <c>timeout</c>, <c>ready_input</c>, <c>ready_output</c>,
+              <c>event</c> and finally <c>outputv</c> (when the port
+              is used by distribution).  The <c>Millis</c> value in
+              the <c>timeout</c> tuple will tell you the actual
+              uninterrupted execution time of the process or port,
+              which will always be <c>&gt;=</c> the <c>Time</c> value
+              supplied when starting the trace. New tuples may be
+              added to the <c>Info</c> list in the future, and the
+              order of the tuples in the list may be changed at any
+              time without prior notice.
+	      </p>
+	      <p>This can be used to detect problems with NIF's or
+	      drivers that take too long to execute. Generally, 1 ms
+	      is considered a good maximum time for a driver callback
+	      or a NIF. However, a time sharing system should usually
+	      consider everything below 100 ms as "possible" and
+	      fairly "normal". Schedule times above that might however
+	      indicate swapping or a NIF/driver that is
+	      misbehaving. Misbehaving NIF's and drivers could cause
+	      bad resource utilization and bad overall performance of
+	      the system.</p>
+          </item>
           <tag><c>{large_heap, Size}</c></tag>
           <item>
             <p>If a garbage collection in the system results in
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 7d86e486f1..3ee9eb0f88 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -178,6 +178,7 @@ atom disable_trace
 atom disabled
 atom display_items
 atom dist
+atom dist_cmd
 atom Div='/'
 atom div
 atom dlink
@@ -313,6 +314,7 @@ atom load_cancelled
 atom load_failure
 atom local
 atom long_gc
+atom long_schedule
 atom low
 atom Lt='<'
 atom machine
@@ -432,6 +434,7 @@ atom port
 atom ports
 atom port_count
 atom port_limit
+atom port_op
 atom print
 atom priority
 atom private
@@ -443,6 +446,7 @@ atom process_display
 atom process_limit
 atom process_dump
 atom procs
+atom proc_sig
 atom profile
 atom protected
 atom protection
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 944ed6da81..5781009f58 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -924,6 +924,7 @@ extern int count_instructions;
 #  define NOINLINE
 #endif
 
+
 /*
  * The following functions are called directly by process_main().
  * Don't inline them.
@@ -1153,6 +1154,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 */
 
 
@@ -1175,6 +1179,16 @@ void process_main(void)
  do_schedule:
     reds_used = REDS_IN(c_p) - FCALLS;
  do_schedule1:
+
+    if (start_time != 0) {
+        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_proc(c_p,inptr,outptr,(Uint) diff);
+	}
+    }
+
     PROCESS_MAIN_CHK_LOCKS(c_p);
     ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
 #if HALFWORD_HEAP
@@ -1183,11 +1197,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->common.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 = erts_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
@@ -6151,6 +6172,7 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg)
 }
 
 
+
 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 559cb3efa1..06fbbea123 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -2012,6 +2012,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;
@@ -2036,12 +2037,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);
@@ -2051,6 +2057,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);
 	}
@@ -2059,6 +2069,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;
@@ -2113,7 +2127,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;
@@ -2123,7 +2137,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));
@@ -2133,6 +2148,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;
@@ -2148,6 +2166,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_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index bc59fe55d4..2ac5e24d3a 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -180,6 +180,11 @@ static erts_lc_lock_order_t erts_lock_order[] = {
     {   "efile_drv dtrace mutex",               NULL                    },
 #endif
     {	"mtrace_buf",				NULL			},
+#ifdef __WIN32__
+#ifdef ERTS_SMP
+    {   "sys_gethrtime",                        NULL                    },
+#endif
+#endif
     {	"erts_alloc_hard_debug",		NULL			}
 };
 
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index f753de8f52..7d53ce7152 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1594,6 +1594,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
     int fpe_was_unmasked;
     erts_aint32_t state;
     int active;
+    Uint64 start_time = 0;
 
     ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
 
@@ -1655,6 +1656,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 
 	reset_handle(ptp);
 
+	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);
@@ -1723,6 +1728,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 
 	reds += erts_port_driver_callback_epilogue(pp, &state);
 
+	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;
+
     aborted_port_task:
 	schedule_port_task_free(ptp);
 
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 88eb224f84..3d161f2aa0 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -267,6 +267,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 865ac6c43f..3c1edfad7a 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1009,6 +1009,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 848877d43e..bb6ed44523 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2268,7 +2268,134 @@ trace_gc(Process *p, Eterm what)
 #undef LOCAL_HEAP_SIZE
 }
 
+void 
+monitor_long_schedule_proc(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));
+    monitor_p = erts_proc_lookup(system_monitor);
+    if (!monitor_p || 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->common.id, am_long_schedule, list);
+    hp += 5;
+#ifdef ERTS_SMP
+    enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
+#else
+    erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef USE_VM_PROBES
+			   , NIL
+#endif
+		       );
+#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));
+    monitor_p = erts_proc_lookup(system_monitor);
+    if (!monitor_p) {
+	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_PROC_SIG: op = am_proc_sig; 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->common.id, am_long_schedule, list);
+    hp += 5;
+#ifdef ERTS_SMP
+    enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.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) {
@@ -3011,6 +3138,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/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 50fb27aab0..54d3aafdda 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -83,6 +83,8 @@ void erts_system_profile_setup_active_schedulers(void);
 
 /* system_monitor */
 void monitor_long_gc(Process *p, 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);
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 71794e1101..8f1b22ff92 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -1723,14 +1723,14 @@ static BIF_RETTYPE do_bif_utf8_to_list(Process *p,
     if (b_sz) {
 	ErlSubBin *sb;
 	Eterm orig;
-	ERTS_DECLARE_DUMMY(Uint offset);
+	Uint offset;
 	ASSERT(state != ERTS_UTF8_OK);
 	hp = HAlloc(p, ERL_SUB_BIN_SIZE);
 	sb = (ErlSubBin *) hp;
 	ERTS_GET_REAL_BIN(orig_bin, orig, offset, bitoffs, bitsize);
 	sb->thing_word = HEADER_SUB_BIN;
 	sb->size = b_sz;
-	sb->offs = num_bytes_to_process + num_processed_bytes;
+	sb->offs = offset + num_bytes_to_process + num_processed_bytes;
 	sb->orig = orig;
 	sb->bitoffs = bitoffs;
 	sb->bitsize = bitsize;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 325e6658d9..bc4a7fc838 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -740,6 +740,8 @@ void erl_drv_thr_init(void);
 /* utils.c */
 void erts_cleanup_offheap(ErlOffHeap *offheap);
 
+Uint64 erts_timestamp_millis(void);
+
 Export* erts_find_function(Eterm, Eterm, unsigned int, ErtsCodeIndex);
 
 Eterm store_external_or_ref_in_proc_(Process *, Eterm);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index d5d97d748a..0a833f7e66 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -3722,6 +3722,24 @@ erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
 }
 
 
+/*
+ * 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/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index 2f2dfc8197..f7f0161b58 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -63,6 +63,8 @@
  
 static SysHrTime wrap = 0;
 static DWORD last_tick_count = 0;
+static erts_smp_mtx_t wrap_lock;
+static ULONGLONG (WINAPI *pGetTickCount64)(void) = NULL;
 
 /* Getting timezone information is a heavy operation, so we want to do this 
    only once */
@@ -77,11 +79,23 @@ static int days_in_month[2][13] = {
 int 
 sys_init_time(void)
 {
+    char kernel_dll_name[] = "kernel32";
+    HMODULE module;
+
+    module = GetModuleHandle(kernel_dll_name);
+    pGetTickCount64 = (module != NULL) ? 
+	(ULONGLONG (WINAPI *)(void)) 
+	GetProcAddress(module,"GetTickCount64") : 
+	NULL;
+
     if(GetTimeZoneInformation(&static_tzi) && 
        static_tzi.StandardDate.wMonth != 0 &&
        static_tzi.DaylightDate.wMonth != 0) {
 	have_static_tzi = 1;
     }
+
+    erts_smp_mtx_init(&wrap_lock, "sys_gethrtime");
+
     return 1;
 }
 
@@ -363,15 +377,39 @@ sys_gettimeofday(SysTimeval *tv)
 			 EPOCH_JULIAN_DIFF);
 }
 
+extern int erts_initialized;
 SysHrTime 
 sys_gethrtime(void) 
 {
-    DWORD ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF);
-    if (ticks < (SysHrTime) last_tick_count) {
-	wrap += LL_LITERAL(1) << 31;
+    if (pGetTickCount64 != NULL) {
+	return ((SysHrTime) pGetTickCount64()) * LL_LITERAL(1000000);
+    } else {
+	DWORD ticks;
+	SysHrTime res;
+	erts_smp_mtx_lock(&wrap_lock);
+	ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF);
+	if (ticks < (SysHrTime) last_tick_count) {
+	    /* Detect a race that should no longer be here... */
+	    if ((((SysHrTime) last_tick_count) - ((SysHrTime) ticks)) > 1000) {
+		wrap += LL_LITERAL(1) << 31;
+	    } else {
+		/* 
+		 * XXX Debug: Violates locking order, remove all this,
+		 * after testing!
+		 */
+		erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+		erts_dsprintf(dsbufp, "Did not wrap when last_tick %d "
+			      "and tick %d", 
+			      last_tick_count, ticks);
+		erts_send_error_to_logger_nogl(dsbufp);
+		ticks = last_tick_count;
+	    }
+	}
+	last_tick_count = ticks;
+	res = ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000));
+	erts_smp_mtx_unlock(&wrap_lock);
+	return res;
     }
-    last_tick_count = ticks;
-    return ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000));
 }
 
 clock_t 
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 221b65309a..caa58ae281 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,65 @@ 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}]),
+    erlang:yield(), % Need to be rescheduled for the trace to take
+    ok.
+
+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(),
+    case (catch load_driver(Path, slow_drv)) of
+	ok ->
+	    do_system_monitor_long_schedule();
+	_Error ->
+	    {skip, "Unable to load slow_drv (windows or no usleep()?)"}
+    end.
+do_system_monitor_long_schedule() ->
+    start_monitor(),
+    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 +1582,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/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index fb869bae66..4fab04322f 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -188,6 +188,7 @@
       'busy_port' |
       'busy_dist_port' |
       {'long_gc', non_neg_integer()} |
+      {'long_schedule', non_neg_integer()} |
       {'large_heap', non_neg_integer()}.