erts: Add BIF erts_internal:system_check/1

This commit implements erts_internal:system_check(schedulers) with the
intent of a basic responsiveness test check of the schedulers.

7 files changed, 138 insertions, 0 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 07f6492948..cb6d294a41 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -269,6 +269,7 @@ atom getenv
 atom gather_gc_info_result
 atom gather_io_bytes
 atom gather_sched_wall_time_result
+atom gather_system_check_result
 atom getting_linked
 atom getting_unlinked
 atom global
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 4f0656d174..3177d5dae7 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -174,6 +174,8 @@ bif erts_internal:time_unit/0
 
 bif erts_internal:is_system_process/1
 
+bif erts_internal:system_check/1
+
 # inet_db support
 bif erlang:port_set_data/2
 bif erlang:port_get_data/1
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 1ecebdeb07..7738531142 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -369,6 +369,7 @@ type	AINFO_REQ	STANDARD_LOW	SYSTEM		alloc_info_request
 type	SCHED_WTIME_REQ	STANDARD_LOW	SYSTEM		sched_wall_time_request
 type	GC_INFO_REQ	STANDARD_LOW	SYSTEM		gc_info_request
 type	PORT_DATA_HEAP	STANDARD_LOW	SYSTEM		port_data_heap
+type	SYS_CHECK_REQ	STANDARD_LOW	SYSTEM		system_check_request
 
 +else # "fullword"
 
@@ -389,6 +390,7 @@ type	AINFO_REQ	SHORT_LIVED	SYSTEM		alloc_info_request
 type	SCHED_WTIME_REQ	SHORT_LIVED	SYSTEM		sched_wall_time_request
 type	GC_INFO_REQ	SHORT_LIVED	SYSTEM		gc_info_request
 type	PORT_DATA_HEAP	STANDARD	SYSTEM		port_data_heap
+type	SYS_CHECK_REQ	SHORT_LIVED	SYSTEM		system_check_request
 
 +endif
 
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 414ff6711a..8bf6877bea 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -65,6 +65,7 @@ static Export* gather_io_bytes_trap = NULL;
 
 static Export *gather_sched_wall_time_res_trap;
 static Export *gather_gc_info_res_trap;
+static Export *gather_system_check_res_trap;
 
 #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
 
@@ -3784,6 +3785,18 @@ BIF_RETTYPE erts_internal_is_system_process_1(BIF_ALIST_1)
     BIF_ERROR(BIF_P, BADARG);
 }
 
+BIF_RETTYPE erts_internal_system_check_1(BIF_ALIST_1)
+{
+    Eterm res;
+    if (ERTS_IS_ATOM_STR("schedulers", BIF_ARG_1)) {
+	res = erts_system_check_request(BIF_P);
+	if (is_non_value(res))
+	    BIF_RET(am_undefined);
+	BIF_TRAP1(gather_system_check_res_trap, BIF_P, res);
+    }
+
+    BIF_ERROR(BIF_P, BADARG);
+}
 
 static erts_smp_atomic_t hipe_test_reschedule_flag;
 
@@ -4391,6 +4404,8 @@ erts_bif_info_init(void)
 	= erts_export_put(am_erlang, am_gather_gc_info_result, 1);
     gather_io_bytes_trap
 	= erts_export_put(am_erts_internal, am_gather_io_bytes, 2);
+    gather_system_check_res_trap
+	= erts_export_put(am_erts_internal, am_gather_system_check_result, 1);
     process_info_init();
     os_info_init();
 }
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index b24f26138c..8e4a42fbe4 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -967,11 +967,25 @@ typedef struct {
     erts_smp_atomic32_t refc;
 } ErtsSchedWallTimeReq;
 
+typedef struct {
+    Process *proc;
+    Eterm ref;
+    Eterm ref_heap[REF_THING_SIZE];
+    Uint req_sched;
+    erts_smp_atomic32_t refc;
+} ErtsSystemCheckReq;
+
+
 #if !HALFWORD_HEAP
 ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq,
 				 ErtsSchedWallTimeReq,
 				 5,
 				 ERTS_ALC_T_SCHED_WTIME_REQ)
+
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq,
+				 ErtsSystemCheckReq,
+				 5,
+				 ERTS_ALC_T_SYS_CHECK_REQ)
 #else
 static ERTS_INLINE ErtsSchedWallTimeReq *
 swtreq_alloc(void)
@@ -985,6 +999,19 @@ swtreq_free(ErtsSchedWallTimeReq *ptr)
 {
     erts_free(ERTS_ALC_T_SCHED_WTIME_REQ, ptr);
 }
+
+static ERTS_INLINE ErtsSystemCheckReq *
+screq_alloc(void)
+{
+    return erts_alloc(ERTS_ALC_T_SYS_CHECK_REQ,
+		      sizeof(ErtsSystemCheckReq));
+}
+
+static ERTS_INLINE void
+screq_free(ErtsSystemCheckReq *ptr)
+{
+    erts_free(ERTS_ALC_T_SYS_CHECK_REQ, ptr);
+}
 #endif
 
 static void
@@ -1118,6 +1145,75 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable)
     return ref;
 }
 
+static void
+reply_system_check(void *vscrp)
+{
+    ErtsSchedulerData *esdp = erts_get_scheduler_data();
+    ErtsSystemCheckReq *scrp = (ErtsSystemCheckReq *) vscrp;
+    ErtsProcLocks rp_locks = (scrp->req_sched == esdp->no ? ERTS_PROC_LOCK_MAIN : 0);
+    Process *rp = scrp->proc;
+    Eterm msg;
+    Eterm *hp = NULL;
+    Eterm **hpp;
+    Uint sz;
+    ErlOffHeap *ohp = NULL;
+    ErlHeapFragment *bp = NULL;
+
+    ASSERT(esdp);
+#ifdef ERTS_DIRTY_SCHEDULERS
+    ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+#endif
+
+    sz = REF_THING_SIZE;
+    hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+    hpp = &hp;
+    msg = STORE_NC(hpp, ohp, scrp->ref);
+
+    erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+
+    if (scrp->req_sched == esdp->no)
+	rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+    if (rp_locks)
+	erts_smp_proc_unlock(rp, rp_locks);
+
+    erts_proc_dec_refc(rp);
+
+    if (erts_smp_atomic32_dec_read_nob(&scrp->refc) == 0)
+	screq_free(vscrp);
+}
+
+
+Eterm erts_system_check_request(Process *c_p) {
+    ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+    Eterm ref;
+    ErtsSystemCheckReq *scrp;
+    Eterm *hp;
+
+    scrp = screq_alloc();
+    ref = erts_make_ref(c_p);
+    hp = &scrp->ref_heap[0];
+
+    scrp->proc = c_p;
+    scrp->ref = STORE_NC(&hp, NULL, ref);
+    scrp->req_sched = esdp->no;
+    erts_smp_atomic32_init_nob(&scrp->refc, (erts_aint32_t) erts_no_schedulers);
+
+    erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+    if (erts_no_schedulers > 1)
+	erts_schedule_multi_misc_aux_work(1,
+					  erts_no_schedulers,
+					  reply_system_check,
+					  (void *) scrp);
+#endif
+
+    reply_system_check((void *) scrp);
+
+    return ref;
+}
+
 static ERTS_INLINE ErtsProcList *
 proclist_create(Process *p)
 {
@@ -5792,6 +5888,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
     init_misc_aux_work();
 #if !HALFWORD_HEAP
     init_swtreq_alloc();
+    init_screq_alloc();
 #endif
 
     erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 799e49005c..f1570a835c 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1483,6 +1483,7 @@ void erts_init_scheduling(int, int
 
 int erts_set_gc_state(Process *c_p, int enable);
 Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable);
+Eterm erts_system_check_request(Process *c_p);
 Eterm erts_gc_info_request(Process *c_p);
 Uint64 erts_get_proc_interval(void);
 Uint64 erts_ensure_later_proc_interval(Uint64);
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 7ed4efea4b..6db77a8482 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -35,6 +35,9 @@
 -export([port_command/3, port_connect/2, port_close/1,
 	 port_control/3, port_call/3, port_info/1, port_info/2]).
 
+-export([system_check/1,
+         gather_system_check_result/1]).
+
 -export([request_system_task/3]).
 
 -export([check_process_code/2]).
@@ -197,6 +200,23 @@ request_system_task(_Pid, _Prio, _Request) ->
 check_process_code(_Module, _OptionList) ->
     erlang:nif_error(undefined).
 
+-spec system_check(Type) -> 'ok' when
+      Type :: 'schedulers'.
+
+system_check(_Type) ->
+    erlang:nif_error(undefined).
+
+gather_system_check_result(Ref) when is_reference(Ref) ->
+    gather_system_check_result(Ref, erlang:system_info(schedulers)).
+
+gather_system_check_result(_Ref, 0) ->
+    ok;
+gather_system_check_result(Ref, N) ->
+    receive
+        Ref ->
+            gather_system_check_result(Ref, N - 1)
+    end.
+
 %% term compare where integer() < float() = true
 
 -spec cmp_term(A,B) -> Result when