ghc/runtime/storage/SMcompacting.lc

   1 \section[SM-compacting]{Compacting Collector Subroutines}
   2
   3 This is a collection of C functions used in implementing the compacting
   4 collectors.
   5
   6 The motivation for making this a separate file/section is twofold:
   7
   8 1) It lets us focus on one thing.
   9
  10 2) If we don't do this, there will be a huge amount of repetition
  11    between the various GC schemes --- a maintenance nightmare.
  12
  13 The second is the major motivation.
  14
  15 ToDo ADR: trash contents of other semispace after GC in debugging version
  16
  17 \begin{code}
  18 #if defined(GC1s) || defined(GCdu) || defined(GCap) || defined(GCgn)
  19     /* to the end */
  20
  21 #if defined(GC1s)
  22
  23 #define  SCAN_REG_DUMP
  24 #include "SMinternal.h"
  25 REGDUMP(ScanRegDump);
  26
  27 #else /* GCdu, GCap, GCgn */
  28
  29 #define SCAV_REG_MAP
  30 #include "SMinternal.h"
  31 REGDUMP(ScavRegDump);
  32
  33 #endif
  34
  35 #include "SMcompacting.h"
  36 \end{code}
  37
  38 \begin{code}
  39 void
  40 LinkRoots(roots, rootno)
  41 P_ roots[];
  42 I_ rootno;
  43 {
  44     I_ root;
  45
  46     DEBUG_STRING("Linking Roots:");
  47     for (root = 0; root < rootno; root++) {
  48         LINK_LOCATION_TO_CLOSURE(&(roots[root]));
  49     }
  50 }
  51
  52 \end{code}
  53
  54 \begin{code}
  55 #if defined(GRAN)
  56 void
  57 LinkEvents(STG_NO_ARGS)
  58 {
  59   eventq event = EventHd;
  60
  61 # if defined(GRAN) && defined(GRAN_CHECK)
  62   if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
  63     fprintf(RTSflags.GcFlags.statsFile,"Linking Events ...\n");
  64 #endif
  65
  66   DEBUG_STRING("Linking Events:");
  67   while(event != NULL)
  68     {
  69       if(EVENT_TYPE(event) == RESUMETHREAD ||
  70          EVENT_TYPE(event) == MOVETHREAD ||
  71          EVENT_TYPE(event) == CONTINUETHREAD ||
  72          EVENT_TYPE(event) == STARTTHREAD )
  73
  74         { LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) ); }
  75
  76       else if(EVENT_TYPE(event) == MOVESPARK)
  77
  78         { LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(EVENT_SPARK(event))) ); }
  79
  80       else if (EVENT_TYPE(event) == FETCHNODE ||
  81                EVENT_TYPE(event) == FETCHREPLY )
  82         {
  83           LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
  84
  85           /* In the case of packet fetching, EVENT_NODE(event) points to */
  86           /* the packet (currently, malloced). The packet is just a list of */
  87           /* closure addresses, with the length of the list at index 1 (the */
  88           /* structure of the packet is defined in Pack.lc). */
  89           if ( RTSflags.GranFlags.DoGUMMFetching &&
  90                (EVENT_TYPE(event)==FETCHREPLY)) {
  91             P_ buffer = (P_) EVENT_NODE(event);
  92             int size = (int) buffer[PACK_SIZE_LOCN], i;
  93
  94             for (i = PACK_HDR_SIZE; i <= size-1; i++) {
  95               LINK_LOCATION_TO_CLOSURE( (buffer+i) );
  96             }
  97           } else
  98             { LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) ); }
  99         }
 100       else if (EVENT_TYPE(event) == GLOBALBLOCK)
 101         {
 102           LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
 103           LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) );
 104         }
 105       else if (EVENT_TYPE(event) == UNBLOCKTHREAD)
 106         {
 107           LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
 108         }
 109       event = EVENT_NEXT(event);
 110     }
 111 }
 112 #endif  /* GRAN */
 113 \end{code}
 114
 115 \begin{code}
 116
 117 #if defined(CONCURRENT)
 118 # if defined(GRAN)
 119 void
 120 LinkSparks(STG_NO_ARGS)
 121 {
 122   sparkq spark;
 123   PROC proc;
 124   I_ pool, total_sparks=0;
 125
 126 # if defined(GRAN) && defined(GRAN_CHECK)
 127   if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
 128     fprintf(RTSflags.GcFlags.statsFile,"Linking Sparks ...\n");
 129 #endif
 130
 131   DEBUG_STRING("Linking Sparks:");
 132   for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
 133     for(pool = 0; pool < SPARK_POOLS; ++pool) {
 134       for(spark = PendingSparksHd[proc][pool];
 135           spark != NULL;
 136           spark = SPARK_NEXT(spark))
 137         {
 138           LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(spark)));
 139         } /* forall spark ... */
 140       }  /* forall pool ... */
 141    }    /*forall proc .. */
 142 }
 143
 144 # else /* ! GRAN */
 145
 146 void
 147 LinkSparks(STG_NO_ARGS)
 148 {
 149     PP_ sparkptr;
 150     int pool;
 151
 152     DEBUG_STRING("Linking Sparks:");
 153     for (pool = 0; pool < SPARK_POOLS; pool++) {
 154         for (sparkptr = PendingSparksHd[pool];
 155           sparkptr < PendingSparksTl[pool]; sparkptr++) {
 156             LINK_LOCATION_TO_CLOSURE(sparkptr);
 157         }
 158     }
 159 }
 160 #endif   /* GRAN */
 161 #endif   /* CONCURRENT */
 162
 163 \end{code}
 164
 165 \begin{code}
 166
 167 #ifdef PAR
 168
 169 void
 170 LinkLiveGAs(P_ base, BitWord *bits)
 171 {
 172     GALA *gala;
 173     GALA *next;
 174     GALA *prev;
 175     long _hp_word, bit_index, bit;
 176
 177     DEBUG_STRING("Linking Live GAs:");
 178
 179     for (gala = liveIndirections, prev = NULL; gala != NULL; gala = next) {
 180         next = gala->next;
 181         ASSERT(gala->ga.loc.gc.gtid == mytid);
 182         if (gala->ga.weight != MAX_GA_WEIGHT) {
 183             LINK_LOCATION_TO_CLOSURE(&gala->la);
 184             gala->next = prev;
 185             prev = gala;
 186         } else {
 187             /* Since we have all of the weight, this GA is no longer needed */
 188             W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 189
 190 #ifdef FREE_DEBUG
 191             fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 192 #endif
 193             gala->next = freeIndirections;
 194             freeIndirections->next = gala;
 195             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 196 #ifdef DEBUG
 197             gala->ga.weight = 0x0d0d0d0d;
 198             gala->la = (P_) 0xbadbad;
 199 #endif
 200         }
 201     }
 202     liveIndirections = prev;
 203
 204     prepareFreeMsgBuffers();
 205
 206     for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 207         next = gala->next;
 208         ASSERT(gala->ga.loc.gc.gtid != mytid);
 209
 210         _hp_word = gala->la - base;
 211         bit_index = _hp_word / BITS_IN(BitWord);
 212         bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
 213         if (!(bits[bit_index] & bit)) {
 214             int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
 215             W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 216
 217             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 218             freeRemoteGA(pe, &(gala->ga));
 219             gala->next = freeGALAList;
 220             freeGALAList = gala;
 221         } else {
 222             LINK_LOCATION_TO_CLOSURE(&gala->la);
 223             gala->next = prev;
 224             prev = gala;
 225         }
 226     }
 227     liveRemoteGAs = prev;
 228
 229     /* If we have any remaining FREE messages to send off, do so now */
 230     sendFreeMessages();
 231 }
 232
 233 #endif
 234
 235 \end{code}
 236
 237 Note: no \tr{Link[AB]Stack} for ``parallel'' systems, because they
 238 don't have a single main stack.
 239
 240 \begin{code}
 241 #if !defined(PAR) /* && !defined(GRAN) */  /* HWL */
 242
 243 void
 244 LinkAStack(stackA, botA)
 245 PP_ stackA;
 246 PP_ botA;
 247 {
 248     PP_ stackptr;
 249
 250     DEBUG_STRING("Linking A Stack:");
 251     for (stackptr = stackA;
 252       SUBTRACT_A_STK(stackptr, botA) >= 0;
 253       stackptr = stackptr + AREL(1)) {
 254         LINK_LOCATION_TO_CLOSURE(stackptr);
 255     }
 256 }
 257 #endif /* PAR */
 258 \end{code}
 259
 260 ToDo (Patrick?): Dont explicitly mark & compact unmarked Bstack frames
 261
 262 \begin{code}
 263 #if !defined(PAR) /* && !defined(CONCURRENT) */ /* HWL */
 264
 265 void
 266 LinkBStack(stackB, botB)
 267 P_ stackB;
 268 P_ botB;                        /* stackB points to topmost update frame */
 269 {
 270     P_ updateFramePtr;
 271
 272     DEBUG_STRING("Linking B Stack:");
 273     for (updateFramePtr = stackB;
 274          SUBTRACT_B_STK(updateFramePtr, botB) > 0;
 275          updateFramePtr = GRAB_SuB(updateFramePtr)) {
 276
 277         P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
 278
 279         LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
 280     }
 281 }
 282 #endif /* not PAR */
 283 \end{code}
 284
 285 \begin{code}
 286 I_
 287 CountCAFs(P_ CAFlist)
 288 {
 289     I_ caf_no = 0;
 290
 291     for (caf_no = 0; CAFlist != NULL; CAFlist = (P_) IND_CLOSURE_LINK(CAFlist))
 292         caf_no++;
 293
 294     return caf_no;
 295 }
 296 \end{code}
 297
 298 \begin{code}
 299 void
 300 LinkCAFs(P_ CAFlist)
 301 {
 302     DEBUG_STRING("Linking CAF Ptr Locations:");
 303     while(CAFlist != NULL) {
 304         DEBUG_LINK_CAF(CAFlist);
 305         LINK_LOCATION_TO_CLOSURE(&IND_CLOSURE_PTR(CAFlist));
 306         CAFlist = (P_) IND_CLOSURE_LINK(CAFlist);
 307     }
 308 }
 309
 310 #endif /* defined(_INFO_COMPACTING) */
 311 \end{code}