1 /* -----------------------------------------------------------------------------
2 * $Id: Sparks.c,v 1.1 2000/01/12 15:15:18 simonmar Exp $
4 * (c) The GHC Team, 2000
6 * Sparking support for PAR and SMP versions of the RTS.
8 * ---------------------------------------------------------------------------*/
10 #if defined(SMP) || defined(PAR)
20 static void slide_spark_pool( StgSparkPool *pool );
23 initSparkPools( void )
29 /* walk over the capabilities, allocating a spark pool for each one */
30 for (cap = free_capabilities; cap != NULL; cap = cap->link) {
32 /* allocate a single spark pool */
36 pool = &(cap->rSparks);
38 pool->base = stgMallocBytes(RtsFlags.ParFlags.maxLocalSparks
39 * sizeof(StgClosure *),
41 pool->lim = pool->base + RtsFlags.ParFlags.maxLocalSparks;
42 pool->hd = pool->base;
43 pool->tl = pool->base;
55 /* walk over the capabilities, allocating a spark pool for each one */
56 for (cap = free_capabilities; cap != NULL; cap = cap->link) {
58 /* allocate a single spark pool */
62 pool = &(cap->rSparks);
63 while (pool->hd < pool->tl) {
65 if (closure_SHOULD_SPARK(spark))
68 slide_spark_pool(pool);
74 add_to_spark_queue( StgClosure *closure, StgSparkPool *pool )
76 if (pool->tl == pool->lim)
77 slide_spark_pool(pool);
79 if (closure_SHOULD_SPARK(closure) &&
80 pool->tl < pool->lim) {
81 *(pool->tl++) = closure;
89 slide_spark_pool( StgSparkPool *pool )
91 StgClosure **sparkp, **to_sparkp;
94 to_sparkp = pool->base;
95 while (sparkp < pool->tl) {
96 ASSERT(to_sparkp<=sparkp);
97 ASSERT(*sparkp!=NULL);
98 ASSERT(LOOKS_LIKE_GHC_INFO((*sparkp)->header.info));
100 if (closure_SHOULD_SPARK(*sparkp)) {
101 *to_sparkp++ = *sparkp++;
106 pool->hd = pool->base;
107 pool->tl = to_sparkp;
111 spark_queue_len( StgSparkPool *pool )
113 return (nat) (pool->tl - pool->hd);
116 /* Mark all nodes pointed to by sparks in the spark queues (for GC) Does an
117 implicit slide i.e. after marking all sparks are at the beginning of the
118 spark pool and the spark pool only contains sparkable closures
121 markSparkQueue( void )
123 StgClosure **sparkp, **to_sparkp;
125 nat n, pruned_sparks;
131 /* walk over the capabilities, allocating a spark pool for each one */
132 for (cap = free_capabilities; cap != NULL; cap = cap->link) {
134 /* allocate a single spark pool */
138 pool = &(cap->rSparks);
146 to_sparkp = pool->base;
147 while (sparkp < pool->tl) {
148 ASSERT(to_sparkp<=sparkp);
149 ASSERT(*sparkp!=NULL);
150 ASSERT(LOOKS_LIKE_GHC_INFO(((StgClosure *)*sparkp)->header.info));
151 // ToDo?: statistics gathering here (also for GUM!)
152 if (closure_SHOULD_SPARK(*sparkp)) {
153 *to_sparkp = MarkRoot(*sparkp);
165 pool->hd = pool->base;
166 pool->tl = to_sparkp;
170 belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
171 n, pruned_sparks, pthread_self()));
174 belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
175 n, pruned_sparks, mytid));
178 belch("markSparkQueue: marked %d sparks and pruned %d sparks",
183 belch("markSparkQueue: new spark queue len=%d; (hd=%p; tl=%p)",
184 spark_queue_len(pool), pool->hd, pool->tl));
189 #endif /* SMP || PAR */