ghc/runtime/storage/SMcopying.lc

   1 \section[SM-copying]{Copying Collector Subroutines}
   2
   3 This is a collection of C functions used in implementing the copying
   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
  16 \begin{code}
  17 #if defined(GC2s) || defined(GCdu) || defined(GCap) || defined(GCgn)
  18     /* to the end */
  19
  20 #define SCAV_REG_MAP
  21 #include "SMinternal.h"
  22 REGDUMP(ScavRegDump);
  23
  24 #include "SMcopying.h"
  25 \end{code}
  26
  27 Comment stolen from SMscav.lc: When doing a new generation copy
  28 collection for Appel's collector only evacuate references that point
  29 to the new generation.  OldGen must be set to point to the end of old
  30 space.
  31
  32 \begin{code}
  33 #ifdef GCap
  34
  35 #define MAYBE_EVACUATE_CLOSURE( closure )   \
  36 do {                                        \
  37   P_ evac = (P_) (closure);                 \
  38   if (evac > OldGen) {                      \
  39     (closure) = EVACUATE_CLOSURE(evac);     \
  40   }                                         \
  41 } while (0)
  42
  43 #else
  44
  45 #define MAYBE_EVACUATE_CLOSURE( closure )   \
  46 do {                                        \
  47   P_ evac = (P_) (closure);                 \
  48   (closure) = EVACUATE_CLOSURE(evac);       \
  49 } while (0)
  50
  51 #endif
  52 \end{code}
  53
  54 \begin{code}
  55 void
  56 SetCAFInfoTables(P_ CAFlist)
  57 {
  58   P_ CAFptr;
  59
  60   /* Set CAF info tables for evacuation */
  61   DEBUG_STRING("Setting Evac & Upd CAFs:");
  62   for (CAFptr = CAFlist;
  63        CAFptr != NULL;
  64        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr) ) {
  65     INFO_PTR(CAFptr) = (W_) Caf_Evac_Upd_info;
  66   }
  67 }
  68 \end{code}
  69
  70 \begin{code}
  71 void
  72 EvacuateRoots(P_ roots[], I_ rootno)
  73 {
  74   I_ root;
  75
  76   DEBUG_STRING("Evacuate (Reg) Roots:");
  77   for (root = 0; root < rootno; root++) {
  78     MAYBE_EVACUATE_CLOSURE( roots[root] );
  79   }
  80 }
  81 \end{code}
  82
  83 \begin{code}
  84 #ifdef CONCURRENT
  85 void
  86 EvacuateSparks(STG_NO_ARGS)
  87 {
  88     PP_ sparkptr;
  89     int pool;
  90
  91
  92     DEBUG_STRING("Evacuate Sparks:");
  93     for (pool = 0; pool < SPARK_POOLS; pool++) {
  94         for (sparkptr = PendingSparksHd[pool];
  95           sparkptr < PendingSparksTl[pool]; sparkptr++) {
  96             MAYBE_EVACUATE_CLOSURE(*((PP_) sparkptr));
  97         }
  98     }
  99 }
 100 #endif
 101 \end{code}
 102
 103 Note: no \tr{evacuate[AB]Stack} for ``parallel'' systems, because they
 104 don't have a single main stack.
 105
 106 \begin{code}
 107 #ifndef PAR
 108 void
 109 EvacuateAStack(PP_ stackA, PP_ botA /* botA points to bottom-most word */)
 110 {
 111   PP_ stackptr;
 112
 113   DEBUG_STRING("Evacuate A Stack:");
 114   for (stackptr = stackA;
 115        SUBTRACT_A_STK(stackptr, botA) >= 0;
 116        stackptr = stackptr + AREL(1)) {
 117     MAYBE_EVACUATE_CLOSURE( *((PP_) stackptr) );
 118   }
 119 }
 120 #endif /* not PAR */
 121 \end{code}
 122
 123 ToDo: Optimisation which squeezes out update frames which point to
 124 garbage closures.
 125
 126 Perform collection first
 127
 128 Then process B stack removing update frames (bot to top via pointer
 129 reversal) that reference garbage closues (test infoptr !=
 130 EVACUATED_INFOPTR)
 131
 132 Otherwise closure is live update reference to to-space address
 133
 134 \begin{code}
 135 #ifndef PAR
 136 void
 137 EvacuateBStack( stackB, botB, roots )
 138   P_ stackB;
 139   P_ botB;  /* botB points to bottom-most word */
 140   I_ *roots;
 141 {
 142   I_ bstk_roots;
 143   P_ updateFramePtr;
 144   P_ updatee;
 145
 146   DEBUG_STRING("Evacuate B Stack:");
 147   bstk_roots = 0;
 148   for (updateFramePtr = stackB;  /* stackB points to topmost update frame */
 149        SUBTRACT_B_STK(updateFramePtr, botB) > 0;
 150        updateFramePtr = GRAB_SuB(updateFramePtr)) {
 151
 152     /* Evacuate the thing to be updated */
 153     updatee = GRAB_UPDATEE(updateFramePtr);
 154     MAYBE_EVACUATE_CLOSURE(updatee);
 155     PUSH_UPDATEE(updateFramePtr, updatee);
 156     bstk_roots++;
 157   }
 158   *roots = bstk_roots;
 159 }
 160 #endif /* not PAR */
 161 \end{code}
 162
 163 When we do a copying collection, we want to evacuate all of the local
 164 entries in the GALA table for which there are outstanding remote
 165 pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
 166
 167 \begin{code}
 168 #ifdef PAR
 169
 170 void
 171 EvacuateLocalGAs(rtsBool full)
 172 {
 173     GALA *gala;
 174     GALA *next;
 175     GALA *prev = NULL;
 176
 177     for (gala = liveIndirections; gala != NULL; gala = next) {
 178         next = gala->next;
 179         ASSERT(gala->ga.loc.gc.gtid == mytid);
 180         if (gala->ga.weight != MAX_GA_WEIGHT) {
 181             /* Remote references exist, so we must evacuate the local closure */
 182             P_ old = gala->la;
 183             MAYBE_EVACUATE_CLOSURE(gala->la);
 184             if (!full && gala->preferred && gala->la != old) {
 185                 (void) removeHashTable(LAtoGALAtable, (W_) old, (void *) gala);
 186                 insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 187             }
 188             gala->next = prev;
 189             prev = gala;
 190         } else {
 191             /* Since we have all of the weight, this GA is no longer needed */
 192             W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 193
 194 #ifdef FREE_DEBUG
 195             fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 196 #endif
 197             gala->next = freeIndirections;
 198             freeIndirections = gala;
 199             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 200             if (!full && gala->preferred)
 201                 (void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 202 #ifdef DEBUG
 203             gala->ga.weight = 0x0d0d0d0d;
 204             gala->la = (P_) 0xbadbad;
 205 #endif
 206         }
 207     }
 208     liveIndirections = prev;
 209 }
 210
 211 \end{code}
 212
 213 \begin{code}
 214
 215 EXTDATA_RO(Forward_Ref_info);
 216
 217 void
 218 RebuildGAtables(rtsBool full)
 219 {
 220     GALA *gala;
 221     GALA *next;
 222     GALA *prev;
 223     P_ closure;
 224
 225     prepareFreeMsgBuffers();
 226
 227     for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 228         next = gala->next;
 229         ASSERT(gala->ga.loc.gc.gtid != mytid);
 230
 231         closure = gala->la;
 232
 233         /*
 234          * If the old closure has not been forwarded, we let go.  Note that this
 235          * approach also drops global aliases for PLCs.
 236          */
 237
 238 #if defined(GCgn) || defined(GCap)
 239         if (closure > OldGen) {
 240 #endif
 241             if (!full && gala->preferred)
 242                 (void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 243
 244             /* Follow indirection chains to the end, just in case */
 245             while (IS_INDIRECTION(INFO_PTR(closure)))
 246                 closure = (P_) IND_CLOSURE_PTR(closure);
 247
 248             /* Change later to incorporate a _FO bit in the INFO_TYPE for GCgn */
 249 #ifdef GCgn
 250     fall over, until _FO bits are added
 251 #endif
 252             if (INFO_PTR(closure) != (W_) Forward_Ref_info) {
 253                 int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
 254                 W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 255
 256                 (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 257                 freeRemoteGA(pe, &(gala->ga));
 258                 gala->next = freeGALAList;
 259                 freeGALAList = gala;
 260             } else {
 261                 /* Find the new space object */
 262                 closure = (P_) FORWARD_ADDRESS(closure);
 263                 gala->la = closure;
 264
 265                 if (!full && gala->preferred)
 266                     insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 267                 gala->next = prev;
 268                 prev = gala;
 269             }
 270 #if defined(GCgn) || defined(GCap)
 271         } else {
 272             /* Old generation, minor collection; just keep it */
 273             gala->next = prev;
 274             prev = gala;
 275         }
 276 #endif
 277     }
 278     liveRemoteGAs = prev;
 279
 280     /* If we have any remaining FREE messages to send off, do so now */
 281     sendFreeMessages();
 282
 283     if (full)
 284         RebuildLAGAtable();
 285 }
 286
 287 #endif
 288
 289 \end{code}
 290
 291 \begin{code}
 292 void
 293 Scavenge(void)
 294 {
 295   DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp);
 296   while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
 297   DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
 298 }
 299 \end{code}
 300
 301 \begin{code}
 302 #ifdef GCdu
 303
 304 void
 305 EvacuateCAFs( CAFlist )
 306   P_ CAFlist;
 307 {
 308   P_ CAFptr;
 309
 310   DEBUG_STRING("Evacuate CAFs:");
 311   for (CAFptr = CAFlist;
 312        CAFptr != NULL;
 313        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 314     EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
 315   }
 316 }
 317
 318 /* ToDo: put GCap EvacuateCAFs code here */
 319
 320 #else /* not GCdu */
 321
 322 void
 323 EvacAndScavengeCAFs( CAFlist, extra_words, roots )
 324   P_ CAFlist;
 325   I_ *extra_words;
 326   I_ *roots;
 327 {
 328   I_ caf_roots = 0;
 329   P_ caf_start = ToHp;
 330   P_ CAFptr;
 331
 332   DEBUG_STRING("Evacuate & Scavenge CAFs:");
 333   for (CAFptr = CAFlist;
 334        CAFptr != NULL;
 335        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 336
 337       EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
 338       caf_roots++;
 339
 340       DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp);
 341       while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
 342       DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
 343   }
 344   *extra_words = ToHp - caf_start;
 345   *roots = caf_roots;
 346 }
 347
 348 #endif /* !GCdu */
 349
 350 #endif /* defined(_INFO_COPYING) */
 351 \end{code}