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