X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSparks.h;h=fd62c1288d35ddb833a656f50a262e4d476d38f6;hb=65914a2cb71caf01655b16a75b283871e2482041;hp=bf10a59d57944a2aa9d4b7ac61cf6b3cc834e129;hpb=3eb8462836317d1c21bfd51969b2042fab6676cb;p=ghc-hetmet.git diff --git a/rts/Sparks.h b/rts/Sparks.h index bf10a59..fd62c12 100644 --- a/rts/Sparks.h +++ b/rts/Sparks.h @@ -9,21 +9,85 @@ #ifndef SPARKS_H #define SPARKS_H +#if defined(PARALLEL_HASKELL) +#error Sparks.c using new internal structure, needs major overhaul! +#endif + +/* typedef for SparkPool in RtsTypes.h */ + #if defined(THREADED_RTS) -StgClosure * findSpark (Capability *cap); -void initSparkPools (void); -void freeSparkPool (StgSparkPool *pool); -void createSparkThread (Capability *cap, StgClosure *p); -void updateSparkQueue (Capability *cap); -void traverseSparkQueue(evac_fn evac, void *user, Capability *cap); -INLINE_HEADER void discardSparks (StgSparkPool *pool); -INLINE_HEADER nat sparkPoolSize (StgSparkPool *pool); -INLINE_HEADER rtsBool emptySparkPool (StgSparkPool *pool); +/* Spark pools: used to store pending sparks + * (THREADED_RTS & PARALLEL_HASKELL only) + * Implementation uses a DeQue to enable concurrent read accesses at + * the top end. + */ +typedef struct SparkPool_ { + /* Size of elements array. Used for modulo calculation: we round up + to powers of 2 and use the dyadic log (modulo == bitwise &) */ + StgWord size; + StgWord moduloSize; /* bitmask for modulo */ + + /* top, index where multiple readers steal() (protected by a cas) */ + volatile StgWord top; + + /* bottom, index of next free place where one writer can push + elements. This happens unsynchronised. */ + volatile StgWord bottom; + /* both position indices are continuously incremented, and used as + an index modulo the current array size. */ + + /* lower bound on the current top value. This is an internal + optimisation to avoid unnecessarily accessing the top field + inside pushBottom */ + volatile StgWord topBound; + + /* The elements array */ + StgClosurePtr* elements; + /* Please note: the dataspace cannot follow the admin fields + immediately, as it should be possible to enlarge it without + disposing the old one automatically (as realloc would)! */ + +} SparkPool; + + +/* INVARIANTS, in this order: reasonable size, + topBound consistent, space pointer, space accessible to us. + + NB. This is safe to use only (a) on a spark pool owned by the + current thread, or (b) when there's only one thread running, or no + stealing going on (e.g. during GC). +*/ +#define ASSERT_SPARK_POOL_INVARIANTS(p) \ + ASSERT((p)->size > 0); \ + ASSERT((p)->topBound <= (p)->top); \ + ASSERT((p)->elements != NULL); \ + ASSERT(*((p)->elements) || 1); \ + ASSERT(*((p)->elements - 1 + ((p)->size)) || 1); + +// No: it is possible that top > bottom when using reclaimSpark() +// ASSERT((p)->bottom >= (p)->top); +// ASSERT((p)->size > (p)->bottom - (p)->top); + +// Initialisation +void initSparkPools (void); + +// Take a spark from the "write" end of the pool. Can be called +// by the pool owner only. +StgClosure* reclaimSpark(SparkPool *pool); + +// Returns True if the spark pool is empty (can give a false positive +// if the pool is almost empty). +rtsBool looksEmpty(SparkPool* deque); + +StgClosure * tryStealSpark (Capability *cap); +void freeSparkPool (SparkPool *pool); +void createSparkThread (Capability *cap); +void traverseSparkQueue(evac_fn evac, void *user, Capability *cap); +void pruneSparkQueue (evac_fn evac, void *user, Capability *cap); -INLINE_HEADER void discardSparksCap (Capability *cap); -INLINE_HEADER nat sparkPoolSizeCap (Capability *cap); -INLINE_HEADER rtsBool emptySparkPoolCap (Capability *cap); +INLINE_HEADER void discardSparks (SparkPool *pool); +INLINE_HEADER nat sparkPoolSize (SparkPool *pool); #endif /* ----------------------------------------------------------------------------- @@ -32,47 +96,20 @@ INLINE_HEADER rtsBool emptySparkPoolCap (Capability *cap); #if defined(PARALLEL_HASKELL) || defined(THREADED_RTS) -INLINE_HEADER rtsBool -emptySparkPool (StgSparkPool *pool) -{ - return (pool->hd == pool->tl); -} - -INLINE_HEADER rtsBool -emptySparkPoolCap (Capability *cap) -{ return emptySparkPool(&cap->r.rSparks); } +INLINE_HEADER rtsBool +emptySparkPool (SparkPool *pool) +{ return looksEmpty(pool); } INLINE_HEADER nat -sparkPoolSize (StgSparkPool *pool) -{ - if (pool->hd <= pool->tl) { - return (pool->tl - pool->hd); - } else { - return (pool->lim - pool->hd + pool->tl - pool->base); - } -} - -INLINE_HEADER nat -sparkPoolSizeCap (Capability *cap) -{ return sparkPoolSize(&cap->r.rSparks); } +sparkPoolSize (SparkPool *pool) +{ return (pool->bottom - pool->top); } INLINE_HEADER void -discardSparks (StgSparkPool *pool) +discardSparks (SparkPool *pool) { - pool->hd = pool->tl; + pool->top = pool->topBound = pool->bottom = 0; } -INLINE_HEADER void -discardSparksCap (Capability *cap) -{ return discardSparks(&cap->r.rSparks); } - - -#elif defined(THREADED_RTS) - -INLINE_HEADER rtsBool -emptySparkPoolCap (Capability *cap STG_UNUSED) -{ return rtsTrue; } - #endif #endif /* SPARKS_H */