ghc/rts/Sparks.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Sparks.c,v 1.1 2000/01/12 15:15:18 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 2000
   5  *
   6  * Sparking support for PAR and SMP versions of the RTS.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #if defined(SMP) || defined(PAR)
  11
  12 #include "Rts.h"
  13 #include "Schedule.h"
  14 #include "SchedAPI.h"
  15 #include "Sparks.h"
  16 #include "Storage.h"
  17 #include "RtsFlags.h"
  18 #include "RtsUtils.h"
  19
  20 static void slide_spark_pool( StgSparkPool *pool );
  21
  22 void
  23 initSparkPools( void )
  24 {
  25   Capability *cap;
  26   StgSparkPool *pool;
  27
  28 #ifdef SMP
  29   /* walk over the capabilities, allocating a spark pool for each one */
  30   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
  31 #else
  32   /* allocate a single spark pool */
  33   cap = &MainRegTable;
  34   {
  35 #endif
  36     pool = &(cap->rSparks);
  37
  38     pool->base = stgMallocBytes(RtsFlags.ParFlags.maxLocalSparks
  39                                      * sizeof(StgClosure *),
  40                                      "initSparkPools");
  41     pool->lim = pool->base + RtsFlags.ParFlags.maxLocalSparks;
  42     pool->hd  = pool->base;
  43     pool->tl  = pool->base;
  44   }
  45 }
  46
  47 StgClosure *
  48 findSpark( void )
  49 {
  50   Capability *cap;
  51   StgSparkPool *pool;
  52   StgClosure *spark;
  53
  54 #ifdef SMP
  55   /* walk over the capabilities, allocating a spark pool for each one */
  56   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
  57 #else
  58   /* allocate a single spark pool */
  59   cap = &MainRegTable;
  60   {
  61 #endif
  62     pool = &(cap->rSparks);
  63     while (pool->hd < pool->tl) {
  64       spark = *pool->hd++;
  65       if (closure_SHOULD_SPARK(spark))
  66         return spark;
  67     }
  68     slide_spark_pool(pool);
  69   }
  70   return NULL;
  71 }
  72
  73 rtsBool
  74 add_to_spark_queue( StgClosure *closure, StgSparkPool *pool )
  75 {
  76   if (pool->tl == pool->lim)
  77     slide_spark_pool(pool);
  78
  79   if (closure_SHOULD_SPARK(closure) &&
  80       pool->tl < pool->lim) {
  81     *(pool->tl++) = closure;
  82     return rtsTrue;
  83   } else {
  84     return rtsFalse;
  85   }
  86 }
  87
  88 static void
  89 slide_spark_pool( StgSparkPool *pool )
  90 {
  91   StgClosure **sparkp, **to_sparkp;
  92
  93   sparkp = pool->hd;
  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));
  99
 100     if (closure_SHOULD_SPARK(*sparkp)) {
 101       *to_sparkp++ = *sparkp++;
 102     } else {
 103       sparkp++;
 104     }
 105   }
 106   pool->hd = pool->base;
 107   pool->tl = to_sparkp;
 108 }
 109
 110 static inline nat
 111 spark_queue_len( StgSparkPool *pool )
 112 {
 113   return (nat) (pool->tl - pool->hd);
 114 }
 115
 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
 119 */
 120 void
 121 markSparkQueue( void )
 122 {
 123   StgClosure **sparkp, **to_sparkp;
 124 #ifdef DEBUG
 125   nat n, pruned_sparks;
 126 #endif
 127   StgSparkPool *pool;
 128   Capability *cap;
 129
 130 #ifdef SMP
 131   /* walk over the capabilities, allocating a spark pool for each one */
 132   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
 133 #else
 134   /* allocate a single spark pool */
 135   cap = &MainRegTable;
 136   {
 137 #endif
 138     pool = &(cap->rSparks);
 139
 140 #ifdef DEBUG
 141     n = 0;
 142     pruned_sparks = 0;
 143 #endif
 144
 145     sparkp = pool->hd;
 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);
 154         to_sparkp++;
 155 #ifdef DEBUG
 156         n++;
 157 #endif
 158       } else {
 159 #ifdef DEBUG
 160         pruned_sparks++;
 161 #endif
 162       }
 163       sparkp++;
 164     }
 165     pool->hd = pool->base;
 166     pool->tl = to_sparkp;
 167
 168 #if defined(SMP)
 169     IF_DEBUG(scheduler,
 170              belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
 171                    n, pruned_sparks, pthread_self()));
 172 #elif defined(PAR)
 173     IF_DEBUG(scheduler,
 174              belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
 175                    n, pruned_sparks, mytid));
 176 #else
 177     IF_DEBUG(scheduler,
 178              belch("markSparkQueue: marked %d sparks and pruned %d sparks",
 179                    n, pruned_sparks));
 180 #endif
 181
 182     IF_DEBUG(scheduler,
 183              belch("markSparkQueue:   new spark queue len=%d; (hd=%p; tl=%p)",
 184                    spark_queue_len(pool), pool->hd, pool->tl));
 185
 186   }
 187 }
 188
 189 #endif /* SMP || PAR */
 190
 191 #if defined(GRAN)
 192
 193 ... ToDo ...
 194
 195 #endif