Merge branch 'rickard/erl_drv_consume_timeslice/OTP-10810'

* rickard/erl_drv_consume_timeslice/OTP-10810:
  Implement erl_drv_consume_timeslice()

11 files changed, 643 insertions, 29 deletions

diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index 0e27f8a5bd..636326e4e1 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -170,10 +170,13 @@
      callback, the best approach is to divide the work into multiple chunks of
      work and trigger multiple calls to the
      <seealso marker="driver_entry#timeout">timeout callback</seealso> using
-     zero timeouts. This might, however, not always be possible, e.g. when
-     calling third party libraries. In this case you typically want to dispatch
-     the work to another thread. Information about thread primitives can be
-     found below.</p>
+     zero timeouts. The
+     <seealso marker="#erl_drv_consume_timeslice"><c>erl_drv_consume_timeslice()</c></seealso>
+     function can be useful in order to determine when to trigger such
+     timeout callback calls. It might, however, not always be possible to
+     implement it this way, e.g. when calling third party libraries. In this
+     case you typically want to dispatch the work to another thread.
+     Information about thread primitives can be found below.</p>
   </description>
 
   <section>
@@ -2805,7 +2808,6 @@ ERL_DRV_EXT2TERM     char *buf, ErlDrvUInt len
         <p>This function is thread-safe.</p>
       </desc>
     </func>
-
     <func>
       <name><ret>int</ret><nametext>erl_drv_getenv(char *key, char *value, size_t *value_size)</nametext></name>
       <fsummary>Get the value of an environment variable</fsummary>
@@ -2841,6 +2843,52 @@ ERL_DRV_EXT2TERM     char *buf, ErlDrvUInt len
         <p>This function is thread-safe.</p>
       </desc>
     </func>
+    <func>
+      <name><ret>int</ret><nametext>erl_drv_consume_timeslice(ErlDrvPort port, int percent)</nametext></name>
+      <fsummary>Give the runtime system a hint about how much CPU time the
+      current driver callback call has consumed</fsummary>
+      <desc>
+        <marker id="erl_drv_consume_timeslice"></marker>
+        <p>Arguments:</p>
+        <taglist>
+          <tag><c>port</c></tag>
+          <item>Port handle of the executing port.</item>
+          <tag><c>percent</c></tag>
+          <item>Approximate consumed fraction of a full
+	  time-slice in percent.</item>
+        </taglist>
+	<p>Give the runtime system a hint about how much CPU time the
+	current driver callback call has consumed since last hint, or
+	since the start of the callback if no previous hint has been given.
+	The time is given as a fraction, in percent, of a full time-slice
+	that a port is allowed to execute before it should surrender the
+	CPU to other runnable ports or processes. Valid range is
+	<c>[1, 100]</c>. The scheduling time-slice is not an exact entity,
+	but can usually be approximated to about 1 millisecond.</p>
+
+	<p>Note that it is up to the runtime system to determine if and
+	how to	use this information. Implementations on some platforms
+	may use other means in order to determine the consumed fraction
+	of the time-slice. Lengthy driver callbacks should regardless of
+	this frequently call the <c>erl_drv_consume_timeslice()</c>
+	function in order to determine if it is allowed to continue
+	execution or not.</p>
+
+	<p><c>erl_drv_consume_timeslice()</c> returns a non-zero value
+	if the time-slice has been exhausted, and zero if the callback is
+	allowed to continue execution. If a non-zero value is
+	returned the driver callback should return as soon as possible in
+	order for the port to be able to yield.</p>
+
+	<p>This function is provided to better support co-operative scheduling,
+	improve system responsiveness, and to make it easier to prevent
+	misbehaviors of the VM due to a port monopolizing a scheduler thread.
+	It can be used when dividing length work into a number of repeated
+	driver callback calls without the need to use threads. Also see the
+	important <seealso marker="#WARNING">warning</seealso> text at the
+	beginning of this document.</p>
+      </desc>
+    </func>
   </funcs>
 
   <section>
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 5adcf6d5c7..9c438679ea 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -2070,11 +2070,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
     result = do_send(p, to, msg, suspend, &ref);
     if (result > 0) {
 	ERTS_VBUMP_REDS(p, result);
+	if (ERTS_IS_PROC_OUT_OF_REDS(p))
+	    goto yield_return;
 	BIF_RET(am_ok);
     }
 
     switch (result) {
     case 0:
+	/* May need to yield even though we do not bump reds here... */
+	if (ERTS_IS_PROC_OUT_OF_REDS(p))
+	    goto yield_return;
 	BIF_RET(am_ok); 
 	break;
     case SEND_TRAP:
@@ -2092,10 +2097,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
 	}
 	break;
     case SEND_YIELD_RETURN:
-	if (suspend)
-	    ERTS_BIF_YIELD_RETURN(p, am_ok);
-	else
+	if (!suspend)
 	    BIF_RET(am_nosuspend);
+    yield_return:
+	ERTS_BIF_YIELD_RETURN(p, am_ok);
     case SEND_AWAIT_RESULT:
 	ASSERT(is_internal_ref(ref));
 	BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok);
@@ -2134,11 +2139,16 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
     
     if (result > 0) {
 	ERTS_VBUMP_REDS(p, result);
+	if (ERTS_IS_PROC_OUT_OF_REDS(p))
+	    goto yield_return;
 	BIF_RET(msg);
     }
 
     switch (result) {
     case 0:
+	/* May need to yield even though we do not bump reds here... */
+	if (ERTS_IS_PROC_OUT_OF_REDS(p))
+	    goto yield_return;
 	BIF_RET(msg); 
 	break;
     case SEND_TRAP:
@@ -2148,6 +2158,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
 	ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg);
 	break;
     case SEND_YIELD_RETURN:
+    yield_return:
 	ERTS_BIF_YIELD_RETURN(p, msg);
     case SEND_AWAIT_RESULT:
 	ASSERT(is_internal_ref(ref));
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index ceaf747875..51b77a95ed 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -35,6 +35,13 @@ extern Export* erts_format_cpu_topology_trap;
 #define BIF_ARG_2  (BIF__ARGS[1])
 #define BIF_ARG_3  (BIF__ARGS[2])
 
+#define ERTS_IS_PROC_OUT_OF_REDS(p)		\
+    ((p)->fcalls > 0				\
+     ? 0					\
+     : (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))	\
+	? (p)->fcalls == 0			\
+	: ((p)->fcalls == -CONTEXT_REDS)))
+
 #define BUMP_ALL_REDS(p) do {			\
     if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) 	\
 	(p)->fcalls = 0; 			\
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index a9a50a10bf..e280563de1 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -408,6 +408,11 @@ EXTERN int driver_cancel_timer(ErlDrvPort port);
 EXTERN int driver_read_timer(ErlDrvPort port, unsigned long *time_left);
 
 /*
+ * Inform runtime system about lengthy work.
+ */
+EXTERN int erl_drv_consume_timeslice(ErlDrvPort port, int percent);
+
+/*
  * Get plain-text error message from within a driver
  */
 EXTERN char* erl_errno_id(int error);
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index a971685d7b..ac4f7af5a7 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -175,6 +175,7 @@ struct _erl_drv_port {
     ErlDrvPDL port_data_lock;
 
     ErtsPrtSD *psd;		 /* Port specific data */
+    int reds; /* Only used while executing driver callbacks */
 };
 
 #define ERTS_PORT_GET_CONNECTED(PRT) \
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 9687db4780..ce045ec94e 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1160,6 +1160,27 @@ select_task_for_exec(Port *pp,
 }
 
 /*
+ * Cut time slice
+ */
+
+int
+erl_drv_consume_timeslice(ErlDrvPort dprt, int percent)
+{
+    Port *pp = erts_drvport2port(dprt);
+    if (pp == ERTS_INVALID_ERL_DRV_PORT)
+	return -1;
+    if (percent < 1)
+	percent = 1;
+    else if (100 < percent)
+	percent = 100;
+    pp->reds += percent*((CONTEXT_REDS+99)/100);
+    if (pp->reds < CONTEXT_REDS)
+	return 0;
+    pp->reds = CONTEXT_REDS;
+    return 1;
+}
+
+/*
  * Abort a scheduled task.
  */
 
@@ -1550,7 +1571,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
     int processing_busy_q;
     int res = 0;
     int vreds = 0;
-    int reds = ERTS_PORT_REDS_EXECUTE;
+    int reds = 0;
     erts_aint_t io_tasks_executed = 0;
     int fpe_was_unmasked;
     erts_aint32_t state;
@@ -1595,6 +1616,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
     fpe_was_unmasked = erts_block_fpe();
 
     state = erts_atomic32_read_nob(&pp->state);
+    pp->reds = ERTS_PORT_REDS_EXECUTE;
     goto begin_handle_tasks;
 
     while (1) {
@@ -1621,14 +1643,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 
 	switch (ptp->type) {
 	case ERTS_PORT_TASK_TIMEOUT:
-	    reds += ERTS_PORT_REDS_TIMEOUT;
+	    reds = ERTS_PORT_REDS_TIMEOUT;
 	    if (!(state & ERTS_PORT_SFLGS_DEAD)) {
                 DTRACE_DRIVER(driver_timeout, pp);
 		(*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data);
             }
 	    break;
 	case ERTS_PORT_TASK_INPUT:
-	    reds += ERTS_PORT_REDS_INPUT;
+	    reds = ERTS_PORT_REDS_INPUT;
 	    ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
             DTRACE_DRIVER(driver_ready_input, pp);
 	    /* NOTE some windows drivers use ->ready_input for input and output */
@@ -1637,7 +1659,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	    io_tasks_executed++;
 	    break;
 	case ERTS_PORT_TASK_OUTPUT:
-	    reds += ERTS_PORT_REDS_OUTPUT;
+	    reds = ERTS_PORT_REDS_OUTPUT;
 	    ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
             DTRACE_DRIVER(driver_ready_output, pp);
 	    (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data,
@@ -1645,7 +1667,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	    io_tasks_executed++;
 	    break;
 	case ERTS_PORT_TASK_EVENT:
-	    reds += ERTS_PORT_REDS_EVENT;
+	    reds = ERTS_PORT_REDS_EVENT;
 	    ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
             DTRACE_DRIVER(driver_event, pp);
 	    (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data,
@@ -1657,22 +1679,22 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	    ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data;
 	    ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
 	    if (!pp->sched.taskq.bpq)
-		reds += ptp->u.alive.td.psig.callback(pp,
-						      state,
-						      ERTS_PROC2PORT_SIG_EXEC,
-						      sigdp);
+		reds = ptp->u.alive.td.psig.callback(pp,
+						     state,
+						     ERTS_PROC2PORT_SIG_EXEC,
+						     sigdp);
 	    else {
 		ErlDrvSizeT size = erts_proc2port_sig_command_data_size(sigdp);
-		reds += ptp->u.alive.td.psig.callback(pp,
-						      state,
-						      ERTS_PROC2PORT_SIG_EXEC,
-						      sigdp);
+		reds = ptp->u.alive.td.psig.callback(pp,
+						     state,
+						     ERTS_PROC2PORT_SIG_EXEC,
+						     sigdp);
 		dequeued_proc2port_data(pp, size);
 	    }
 	    break;
 	}
 	case ERTS_PORT_TASK_DIST_CMD:
-	    reds += erts_dist_command(pp, CONTEXT_REDS-reds);
+	    reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds);
 	    break;
 	default:
 	    erl_exit(ERTS_ABORT_EXIT,
@@ -1697,7 +1719,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 	vreds += ERTS_PORT_CALLBACK_VREDS;
 	reds += ERTS_PORT_CALLBACK_VREDS;
 
-	if (reds >= CONTEXT_REDS)
+	pp->reds += reds;
+	reds = 0;
+
+	if (pp->reds >= CONTEXT_REDS)
 	    break;
     }
 
@@ -1721,6 +1746,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
 
     active = finalize_exec(pp, &execq, processing_busy_q);
 
+    reds = pp->reds - vreds;
+
     erts_port_release(pp);
 
     *curr_port_pp = NULL;
@@ -1766,7 +1793,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
     res = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks)
 	   != (erts_aint_t) 0);
 
-    reds -= vreds;
     runq->scheduler->reductions += reds;
 
     ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 99766b7997..b73c883658 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1199,6 +1199,7 @@ typedef struct {
     int async; /* Asynchronous operation */
     int pre_chk_sched_flags; /* Check sched flags before lock? */
     int fpe_was_unmasked;
+    int reds_left_in;
 } ErtsTryImmDrvCallState;
 
 #define ERTS_INIT_TRY_IMM_DRV_CALL_STATE(C_P, PRT, SFLGS, PTS_FLGS, A, PRT_OP) \
@@ -1213,6 +1214,7 @@ static ERTS_INLINE ErtsTryImmDrvCallResult
 try_imm_drv_call(ErtsTryImmDrvCallState *sp)
 {
     ErtsTryImmDrvCallResult res;
+    int reds_left_in;
     erts_aint32_t invalid_state, invalid_sched_flags;
     Port *prt = sp->port;
     Process *c_p = sp->c_p;
@@ -1246,16 +1248,24 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
 	goto locked_fail;
     }
 
-    if (c_p) {
+
+    if (!c_p)
+	reds_left_in = CONTEXT_REDS/10;
+    else {
 	if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS))
 	    trace_virtual_sched(c_p, am_out);
 	if (erts_system_profile_flags.runnable_procs
 	    && erts_system_profile_flags.exclusive)
 	    profile_runnable_proc(c_p, am_inactive);
 
+	reds_left_in = ERTS_BIF_REDS_LEFT(c_p);
 	erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
     }
 
+    ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS);
+    sp->reds_left_in = reds_left_in;
+    prt->reds = CONTEXT_REDS - reds_left_in;
+
     ERTS_SMP_CHK_NO_PROC_LOCKS;
 
     if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
@@ -1276,10 +1286,12 @@ locked_fail:
 static ERTS_INLINE void
 finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
 {
+    int reds;
     Port *prt = sp->port;
     Process *c_p = sp->c_p;
 
-    erts_port_driver_callback_epilogue(prt, NULL);
+    reds = prt->reds;
+    reds += erts_port_driver_callback_epilogue(prt, NULL);
 
     erts_unblock_fpe(sp->fpe_was_unmasked);
 
@@ -1294,6 +1306,12 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
     if (c_p) {
 	erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
 
+	if (reds != (CONTEXT_REDS - sp->reds_left_in)) {
+	    int bump_reds = reds - (CONTEXT_REDS - sp->reds_left_in);
+	    ASSERT(bump_reds > 0);
+	    BUMP_REDS(c_p, bump_reds);
+	}
+
 	if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS))
 	    trace_virtual_sched(c_p, am_in);
 	if (erts_system_profile_flags.runnable_procs
diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h
index 932c920595..a7c53c904d 100644
--- a/erts/emulator/sys/win32/erl_win_dyn_driver.h
+++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h
@@ -48,6 +48,7 @@ WDD_TYPEDEF(ErlDrvSizeT, driver_vec_to_buf, (ErlIOVec *, char *, ErlDrvSizeT));
 WDD_TYPEDEF(int, driver_set_timer, (ErlDrvPort, unsigned long));
 WDD_TYPEDEF(int, driver_cancel_timer, (ErlDrvPort));
 WDD_TYPEDEF(int, driver_read_timer, (ErlDrvPort, unsigned long *));
+WDD_TYPEDEF(int, erl_drv_consume_timeslice, (ErlDrvPort, int));
 WDD_TYPEDEF(char *, erl_errno_id, (int));
 WDD_TYPEDEF(void, set_busy_port, (ErlDrvPort, int));
 WDD_TYPEDEF(void, set_port_control_flags, (ErlDrvPort, int));
@@ -164,6 +165,7 @@ typedef struct {
     WDD_FTYPE(driver_set_timer) *driver_set_timer;
     WDD_FTYPE(driver_cancel_timer) *driver_cancel_timer;
     WDD_FTYPE(driver_read_timer) *driver_read_timer;
+    WDD_FTYPE(erl_drv_consume_timeslice) *erl_drv_consume_timeslice;
     WDD_FTYPE(erl_errno_id) *erl_errno_id;
     WDD_FTYPE(set_busy_port)* set_busy_port;
     WDD_FTYPE(set_port_control_flags) *set_port_control_flags;
@@ -274,6 +276,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks;
 #define driver_set_timer (WinDynDriverCallbacks.driver_set_timer)
 #define driver_cancel_timer (WinDynDriverCallbacks.driver_cancel_timer)
 #define driver_read_timer (WinDynDriverCallbacks.driver_read_timer)
+#define erl_drv_consume_timeslice (WinDynDriverCallbacks.erl_drv_consume_timeslice)
 #define erl_errno_id (WinDynDriverCallbacks.erl_errno_id)
 #define set_busy_port (WinDynDriverCallbacks.set_busy_port)
 #define set_port_control_flags (WinDynDriverCallbacks.set_port_control_flags)
@@ -408,6 +411,7 @@ do {				                        \
 ((W).driver_set_timer) = driver_set_timer;		\
 ((W).driver_cancel_timer) = driver_cancel_timer;	\
 ((W).driver_read_timer) = driver_read_timer;		\
+((W).erl_drv_consume_timeslice) = erl_drv_consume_timeslice;\
 ((W).erl_errno_id) = erl_errno_id;			\
 ((W).set_busy_port) = set_busy_port;			\
 ((W).set_port_control_flags) = set_port_control_flags;	\
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index dae36fed8f..dfba7d098f 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -78,7 +78,8 @@
 	 otp_9302/1,
 	 thr_free_drv/1,
 	 async_blast/1,
-	 thr_msg_blast/1]).
+	 thr_msg_blast/1,
+	 consume_timeslice/1]).
 
 -export([bin_prefix/2]).
 
@@ -149,7 +150,8 @@ all() ->
      otp_9302,
      thr_free_drv,
      async_blast,
-     thr_msg_blast].
+     thr_msg_blast,
+     consume_timeslice].
 
 groups() -> 
     [{timer, [],
@@ -2073,10 +2075,329 @@ thr_msg_blast(Config) when is_list(Config) ->
 	    Res
     end.
 
+consume_timeslice(Config) when is_list(Config) ->
+    %%
+    %% Verify that erl_drv_consume_timeslice() works.
+    %%
+    %% The first four cases expect that the command signal is
+    %% delivered immediately, i.e., isn't scheduled. Since there
+    %% are no conflicts these signals should normally be delivered
+    %% immediately. However some builds and configurations may
+    %% schedule these ops anyway, in these cases we do not verify
+    %% scheduling counts.
+    %%
+    %% When signal is delivered immediately we must take into account
+    %% that process and port are "virtualy" scheduled out and in
+    %% in the trace generated.
+    %%
+    %% Port ! {_, {command, _}, and port_command() differs. The send
+    %% instruction needs to check if the caller is out of reductions
+    %% at the end of the instruction, since no erlang function call
+    %% is involved. Otherwise, a sequence of send instructions would
+    %% not be scheduled out even when out of reductions. port_commond()
+    %% doesn't do that since it will always (since R16A) be called via
+    %% the erlang wrappers in the erlang module.
+    %%
+    %% The last two cases tests scheduled operations. We create
+    %% a conflict by executing at the same time on different
+    %% schedulers. When only one scheduler we enable parallelism on
+    %% the port instead.
+    %%
+
+    Path = ?config(data_dir, Config),
+    erl_ddll:start(),
+    ok = load_driver(Path, consume_timeslice_drv),
+    Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]),
+
+    Parent = self(),
+    Go = make_ref(),
+
+    "enabled" = port_control(Port, $E, ""),
+    Proc1 = spawn_link(fun () ->
+			       receive Go -> ok end,
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}}
+		       end),
+    receive after 100 -> ok end,
+    count_pp_sched_start(),
+    Proc1 ! Go,
+    wait_command_msgs(Port, 10),
+    [{Port, Sprt1}, {Proc1, Sproc1}] = count_pp_sched_stop([Port, Proc1]),
+    case Sprt1 of
+	10 ->
+	    true = in_range(5, Sproc1-10, 7);
+	_ ->
+	    case erlang:system_info(lock_checking) of
+		true -> ?t:format("Ignore bad sched count due to lock checking", []);
+		false -> ?t:fail({unexpected_sched_counts, Sprt1, Sproc1})
+	    end
+    end,
+
+    "disabled" = port_control(Port, $D, ""),
+    Proc2 = spawn_link(fun () ->
+			       receive Go -> ok end,
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}},
+			       Port ! {Parent, {command, ""}}
+		       end),
+    receive after 100 -> ok end,
+    count_pp_sched_start(),
+    Proc2 ! Go,
+    wait_command_msgs(Port, 10),
+    [{Port, Sprt2}, {Proc2, Sproc2}] = count_pp_sched_stop([Port, Proc2]),
+    case Sprt2 of
+	10 ->
+	    true = in_range(1, Sproc2-10, 2);
+	_ ->
+	    case erlang:system_info(lock_checking) of
+		true -> ?t:format("Ignore bad sched count due to lock checking", []);
+		false -> ?t:fail({unexpected_sched_counts, Sprt2, Sproc2})
+	    end
+    end,
+
+    "enabled" = port_control(Port, $E, ""),
+    Proc3 = spawn_link(fun () ->
+			       receive Go -> ok end,
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, "")
+		       end),
+    count_pp_sched_start(),
+    Proc3 ! Go,
+    wait_command_msgs(Port, 10),
+    [{Port, Sprt3}, {Proc3, Sproc3}] = count_pp_sched_stop([Port, Proc3]),
+    case Sprt3 of
+	10 ->
+	    true = in_range(5, Sproc3-10, 7);
+	_ ->
+	    case erlang:system_info(lock_checking) of
+		true -> ?t:format("Ignore bad sched count due to lock checking", []);
+		false -> ?t:fail({unexpected_sched_counts, Sprt3, Sproc3})
+	    end
+    end,
+
+    "disabled" = port_control(Port, $D, ""),
+    Proc4 = spawn_link(fun () ->
+			       receive Go -> ok end,
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, ""),
+			       port_command(Port, "")
+		       end),
+    count_pp_sched_start(),
+    Proc4 ! Go,
+    wait_command_msgs(Port, 10),
+    [{Port, Sprt4}, {Proc4, Sproc4}] = count_pp_sched_stop([Port, Proc4]),
+    case Sprt4 of
+	10 ->
+	    true = in_range(1, Sproc4-10, 2);
+	_ ->
+	    case erlang:system_info(lock_checking) of
+		true -> ?t:format("Ignore bad sched count due to lock checking", []);
+		false -> ?t:fail({unexpected_sched_counts, Sprt4, Sproc4})
+	    end
+    end,
+
+    SOnl = erlang:system_info(schedulers_online),
+    %% If only one scheduler use port with parallelism set to true,
+    %% in order to trigger scheduling of command signals
+    Port2 = case SOnl of
+		1 ->
+		    Port ! {self(), close},
+		    receive {Port, closed} -> ok end,
+		    open_port({spawn, consume_timeslice_drv},
+			      [{parallelism, true}]);
+		_ ->
+		    process_flag(scheduler, 1),
+		    1 = erlang:system_info(scheduler_id),
+		    Port
+	    end,
+    count_pp_sched_start(),
+    "enabled" = port_control(Port2, $E, ""),
+    W5 = case SOnl of
+	     1 ->
+		 false;
+	     _ ->
+		 W1= spawn_opt(fun () ->
+				       2 = erlang:system_info(scheduler_id),
+				       "sleeped" = port_control(Port2, $S, "")
+			       end, [link,{scheduler,2}]),
+		 receive after 100 -> ok end,
+		 W1
+	 end,
+    Proc5 = spawn_opt(fun () ->
+			      receive Go -> ok end,
+			      1 = erlang:system_info(scheduler_id),
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}}
+		      end, [link,{scheduler,1}]),
+    receive after 100 -> ok end,
+    Proc5 ! Go,
+    wait_procs_exit([W5, Proc5]),
+    wait_command_msgs(Port2, 10),
+    [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]),
+    true = in_range(2, Sproc5, 3),
+    true = in_range(7, Sprt5, 20),
+		  
+    count_pp_sched_start(),
+    "disabled" = port_control(Port2, $D, ""),
+    W6 = case SOnl of
+	     1 ->
+		 false;
+	     _ ->
+		 W2= spawn_opt(fun () ->
+				       2 = erlang:system_info(scheduler_id),
+				       "sleeped" = port_control(Port2, $S, "")
+			       end, [link,{scheduler,2}]),
+		 receive after 100 -> ok end,
+		 W2
+	 end,
+    Proc6 = spawn_opt(fun () ->
+			      receive Go -> ok end,
+			      1 = erlang:system_info(scheduler_id),
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}},
+			      Port2 ! {Parent, {command, ""}}
+		      end, [link,{scheduler,1}]),
+    receive after 100 -> ok end,
+    Proc6 ! Go,
+    wait_procs_exit([W6, Proc6]),
+    wait_command_msgs(Port2, 10),
+    [{Port2, Sprt6}, {Proc6, Sproc6}] = count_pp_sched_stop([Port2, Proc6]),
+    true = in_range(2, Sproc6, 3),
+    true = in_range(3, Sprt6, 6),
+
+    process_flag(scheduler, 0),
+
+    Port2 ! {self(), close},
+    receive {Port2, closed} -> ok end,
+    ok.
+
+wait_command_msgs(_, 0) ->
+    ok;
+wait_command_msgs(Port, N) ->
+    receive
+	{Port, command} ->
+	    wait_command_msgs(Port, N-1)
+    end.
+
+in_range(Low, Val, High) when is_integer(Low),
+			      is_integer(Val),
+			      is_integer(High),
+			      Low =< Val,
+			      Val =< High ->
+    true;
+in_range(Low, Val, High) when is_integer(Low),
+			      is_integer(Val),
+			      is_integer(High) ->
+    false.
+
+count_pp_sched_start() ->
+    erlang:trace(all, true, [running_procs, running_ports, {tracer, self()}]),
+    ok.
+
+count_pp_sched_stop(Ps) ->
+    Td = erlang:trace_delivered(all),
+    erlang:trace(all, false, [running_procs, running_ports, {tracer, self()}]),
+    PNs = lists:map(fun (P) -> {P, 0} end, Ps),
+    receive {trace_delivered, all, Td} -> ok end,
+    Res = count_proc_sched(Ps, PNs),
+    ?t:format("Scheduling counts: ~p~n", [Res]),
+    erlang:display({scheduling_counts, Res}),
+    Res.
+
+do_inc_pn(_P, []) ->
+    throw(undefined);
+do_inc_pn(P, [{P,N}|PNs]) ->
+    [{P,N+1}|PNs];
+do_inc_pn(P, [PN|PNs]) ->
+    [PN|do_inc_pn(P, PNs)].
+
+inc_pn(P, PNs) ->
+    try
+	do_inc_pn(P, PNs)
+    catch
+	throw:undefined -> PNs
+    end.
+
+count_proc_sched(Ps, PNs) ->
+    receive
+	TT when element(1, TT) == trace, element(3, TT) == in ->
+%	    erlang:display(TT),
+	    count_proc_sched(Ps, inc_pn(element(2, TT), PNs));
+	TT when element(1, TT) == trace, element(3, TT) == out ->
+	    count_proc_sched(Ps, PNs)
+    after 0 ->
+	    PNs
+    end.
+    
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% 		Utilities
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+%flush_msgs() ->
+%    receive
+%	M ->
+%	    erlang:display(M),
+%	    flush_msgs()
+%    after 0 ->
+%	    ok
+%    end.
+
+wait_procs_exit([]) ->
+    ok;
+wait_procs_exit([P|Ps]) when is_pid(P) ->
+    Mon = erlang:monitor(process, P),
+    receive
+	{'DOWN', Mon, process, P, _} ->
+	    wait_procs_exit(Ps)
+    end;
+wait_procs_exit([_|Ps]) ->
+    wait_procs_exit(Ps).
+
 get_port_msg(Port, Timeout) ->
     receive
 	{Port, What} ->
diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src
index b667dff6b6..1fedd72200 100644
--- a/erts/emulator/test/driver_SUITE_data/Makefile.src
+++ b/erts/emulator/test/driver_SUITE_data/Makefile.src
@@ -15,7 +15,8 @@ MISC_DRVS =		outputv_drv@dll@ \
 			otp_9302_drv@dll@ \
 			thr_free_drv@dll@ \
 			async_blast_drv@dll@ \
-			thr_msg_blast_drv@dll@
+			thr_msg_blast_drv@dll@ \
+			consume_timeslice_drv@dll@
 
 SYS_INFO_DRVS = 	sys_info_base_drv@dll@ \
 			sys_info_prev_drv@dll@ \
diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c
new file mode 100644
index 0000000000..6b0c4cf37d
--- /dev/null
+++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c
@@ -0,0 +1,172 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 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
+ * 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 online 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.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_driver.h"
+#ifdef __WIN32__
+#include <windows.h>
+#else
+#include <unistd.h>
+#endif
+#include <stdio.h>
+#include <string.h>
+
+static void stop(ErlDrvData drv_data);
+static ErlDrvData start(ErlDrvPort port,
+			char *command);
+static void output(ErlDrvData drv_data,
+		   char *buf, ErlDrvSizeT len);
+static ErlDrvSSizeT control(ErlDrvData drv_data,
+			    unsigned int command,
+			    char *buf, ErlDrvSizeT len,
+			    char **rbuf, ErlDrvSizeT rlen);
+
+static ErlDrvEntry consume_timeslice_drv_entry = { 
+    NULL /* init */,
+    start,
+    stop,
+    output,
+    NULL /* ready_input */,
+    NULL /* ready_output */,
+    "consume_timeslice_drv",
+    NULL /* finish */,
+    NULL /* handle */,
+    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 /* handle2 */,
+    NULL /* handle_monitor */
+};
+
+typedef struct {
+    ErlDrvPort port;
+    ErlDrvTermData tport;
+    ErlDrvTermData cmd_msg[6];
+    int consume_timeslice;
+} consume_timeslice_data_t;
+
+
+DRIVER_INIT(consume_timeslice_drv)
+{
+    return &consume_timeslice_drv_entry;
+}
+
+static void stop(ErlDrvData drv_data)
+{
+    driver_free((void *) drv_data);
+}
+
+static ErlDrvData start(ErlDrvPort port,
+			char *command)
+{
+    consume_timeslice_data_t *ctsd;
+
+    ctsd = driver_alloc(sizeof(consume_timeslice_data_t));
+    if (!ctsd)
+	return ERL_DRV_ERROR_GENERAL;
+
+    ctsd->port = port;
+    ctsd->tport = driver_mk_port(port);
+    ctsd->consume_timeslice = 0;
+
+    ctsd->cmd_msg[0] = ERL_DRV_PORT;
+    ctsd->cmd_msg[1] = ctsd->tport;
+    ctsd->cmd_msg[2] = ERL_DRV_ATOM;
+    ctsd->cmd_msg[3] = driver_mk_atom("command");
+    ctsd->cmd_msg[4] = ERL_DRV_TUPLE;
+    ctsd->cmd_msg[5] = (ErlDrvTermData) 2;
+
+    return (ErlDrvData) ctsd;
+}
+
+static void output(ErlDrvData drv_data,
+		   char *buf, ErlDrvSizeT len)
+{
+    consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data;
+    int res;
+
+    if (ctsd->consume_timeslice) {
+	int res = erl_drv_consume_timeslice(ctsd->port, 50);
+	if (res < 0) {
+	    driver_failure_atom(ctsd->port, "erl_drv_consume_timeslice() failed");
+	    return;
+	}
+    }
+
+    res = erl_drv_output_term(ctsd->tport,
+			      ctsd->cmd_msg,
+			      sizeof(ctsd->cmd_msg)/sizeof(ErlDrvTermData));
+    if (res <= 0) {
+	driver_failure_atom(ctsd->port, "erl_drv_output_term() failed");
+	return;
+    }
+}
+static ErlDrvSSizeT control(ErlDrvData drv_data,
+			    unsigned int command,
+			    char *buf, ErlDrvSizeT len,
+			    char **rbuf, ErlDrvSizeT rlen)
+{
+    consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data;
+    int res;
+    char *res_str;
+    ErlDrvSSizeT res_len;
+
+    switch (command) {
+    case 'E':
+	ctsd->consume_timeslice = 1;
+	res_str = "enabled";
+	break;
+    case 'D':
+	ctsd->consume_timeslice = 0;
+	res_str = "disabled";
+	break;
+    case 'S':
+#ifdef __WIN32__
+	Sleep((DWORD) 1000);
+#else
+	sleep(1);
+#endif
+	res_str = "sleeped";
+	break;
+    default:
+	res_str = "what?";
+	break;
+    }
+
+    res_len = strlen(res_str);
+    if (res_len > rlen) {
+	char *abuf = driver_alloc(sizeof(char)*res_len);
+	if (!abuf) {
+	    driver_failure_atom(ctsd->port, "driver_alloc() failed");
+	    return 0;
+	}
+	*rbuf = abuf;
+    }
+
+    memcpy((void *) *rbuf, (void *) res_str, res_len);
+
+    return res_len;
+}