add numSparks# primop (#4167)

compiler/prelude/primops.txt.pp

@@ -1544,6 +1544,13 @@ primop GetSparkOp "getSpark#" GenPrimOp
    has_side_effects = True
    out_of_line = True
 
+primop NumSparks "numSparks#" GenPrimOp
+   State# s -> (# State# s, Int# #)
+   { Returns the number of sparks in the local spark pool. }
+   with
+   has_side_effects = True
+   out_of_line = True
+
 -- HWL: The first 4 Int# in all par... annotations denote:
 --   name, granularity info, size of result, degree of parallelism
 --      Same  structure as _seq_ i.e. returns Int#

includes/mkDerivedConstants.c

@@ -234,6 +234,7 @@ main(int argc, char *argv[])
     field_offset(Capability, lock);
     struct_field(Capability, mut_lists);
     struct_field(Capability, context_switch);
+    struct_field(Capability, sparks);
 
     struct_field(bdescr, start);
     struct_field(bdescr, free);

includes/stg/MiscClosures.h

@@ -440,6 +440,7 @@ RTS_FUN_DECL(stg_checkzh);
 RTS_FUN_DECL(stg_unpackClosurezh);
 RTS_FUN_DECL(stg_getApStackValzh);
 RTS_FUN_DECL(stg_getSparkzh);
+RTS_FUN_DECL(stg_numSparkszh);
 
 RTS_FUN_DECL(stg_noDuplicatezh);
 

rts/Inlines.c

@@ -6,3 +6,4 @@
 #include "Rts.h"
 #include "Schedule.h"
 #include "Capability.h"
+#include "WSDeque.h"

rts/Linker.c

@@ -789,6 +789,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_unpackClosurezh)                \
       SymI_HasProto(stg_getApStackValzh)                \
       SymI_HasProto(stg_getSparkzh)                     \
+      SymI_HasProto(stg_numSparkszh)                    \
       SymI_HasProto(stg_isCurrentThreadBoundzh)	        \
       SymI_HasProto(stg_isEmptyMVarzh)			\
       SymI_HasProto(stg_killThreadzh)			\

rts/PrimOps.cmm

@@ -2020,6 +2020,17 @@ stg_getSparkzh
 #endif
 }
 
+stg_numSparkszh
+{
+  W_ n;
+#ifdef THREADED_RTS
+  (n) = foreign "C" dequeElements(Capability_sparks(MyCapability()));
+#else
+  n = 0;
+#endif
+  RET_N(n);
+}
+
 stg_traceEventzh
 {
    W_ msg;

rts/WSDeque.h

@@ -79,7 +79,7 @@ void* popWSDeque (WSDeque *q);
 rtsBool pushWSDeque (WSDeque *q, void *elem);
 
 // Removes all elements from the deque
-INLINE_HEADER void discardElements (WSDeque *q);
+EXTERN_INLINE void discardElements (WSDeque *q);
 
 // Removes an element of the deque from the "read" end, or returns
 // NULL if the pool is empty, or if there was a collision with another
@@ -93,15 +93,15 @@ void * stealWSDeque (WSDeque *q);
 // "guesses" whether a deque is empty. Can return false negatives in
 //  presence of concurrent steal() calls, and false positives in
 //  presence of a concurrent pushBottom().
-INLINE_HEADER rtsBool looksEmptyWSDeque (WSDeque* q);
+EXTERN_INLINE rtsBool looksEmptyWSDeque (WSDeque* q);
 
-INLINE_HEADER long dequeElements   (WSDeque *q);
+EXTERN_INLINE long dequeElements   (WSDeque *q);
 
 /* -----------------------------------------------------------------------------
  * PRIVATE below here
  * -------------------------------------------------------------------------- */
 
-INLINE_HEADER long
+EXTERN_INLINE long
 dequeElements (WSDeque *q)
 {
     StgWord t = q->top;
@@ -110,13 +110,13 @@ dequeElements (WSDeque *q)
     return ((long)b - (long)t);
 }
 
-INLINE_HEADER rtsBool
+EXTERN_INLINE rtsBool
 looksEmptyWSDeque (WSDeque *q)
 {
     return (dequeElements(q) <= 0);
 }
 
-INLINE_HEADER void
+EXTERN_INLINE void
 discardElements (WSDeque *q)
 {
     q->top = q->bottom;