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 Evacuating events is necessary in GRAN since some TSOs and closures are only
  84 pointed at by events we have to schedule later on.
  85
  86 \begin{code}
  87 #if defined(GRAN)
  88 void
  89 EvacuateEvents(STG_NO_ARGS)
  90 {
  91   eventq event = EventHd;
  92
  93 # if defined(GRAN) && defined(GRAN_CHECK)
  94   if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
  95     fprintf(RTSflags.GcFlags.statsFile,"Evacuating Events ...\n");
  96 #endif
  97
  98   DEBUG_STRING("Evacuate Events:");
  99   while(event != NULL)
 100     {
 101       if(EVENT_TYPE(event) == RESUMETHREAD ||
 102          EVENT_TYPE(event) == MOVETHREAD ||
 103          EVENT_TYPE(event) == CONTINUETHREAD ||
 104          EVENT_TYPE(event) == STARTTHREAD )
 105
 106        MAYBE_EVACUATE_CLOSURE( EVENT_TSO(event) );
 107
 108       else if(EVENT_TYPE(event) == MOVESPARK)
 109
 110         MAYBE_EVACUATE_CLOSURE( SPARK_NODE(EVENT_SPARK(event)) );
 111
 112       else if (EVENT_TYPE(event) == FETCHNODE ||
 113                EVENT_TYPE(event) == FETCHREPLY )
 114         {
 115
 116           MAYBE_EVACUATE_CLOSURE( EVENT_TSO(event) );
 117
 118           /* In the case of packet fetching, EVENT_NODE(event) points to */
 119           /* the packet (currently, malloced). The packet is just a list of */
 120           /* closure addresses, with the length of the list at index 1 (the */
 121           /* structure of the packet is defined in Pack.lc). */
 122           if ( RTSflags.GranFlags.DoGUMMFetching &&
 123                (EVENT_TYPE(event)==FETCHREPLY)) {
 124             P_ buffer = (P_) EVENT_NODE(event);
 125             int size = (int) buffer[PACK_SIZE_LOCN], i;
 126
 127             for (i = PACK_HDR_SIZE; i <= size-1; i++) {
 128               MAYBE_EVACUATE_CLOSURE( (P_)buffer[i] );
 129             }
 130           } else
 131             MAYBE_EVACUATE_CLOSURE( EVENT_NODE(event) );
 132         }
 133       else if (EVENT_TYPE(event) == GLOBALBLOCK)
 134         {
 135           MAYBE_EVACUATE_CLOSURE( EVENT_TSO(event) );
 136           MAYBE_EVACUATE_CLOSURE( EVENT_NODE(event) );
 137         }
 138       else if (EVENT_TYPE(event) == UNBLOCKTHREAD)
 139         {
 140           MAYBE_EVACUATE_CLOSURE( EVENT_TSO(event) );
 141         }
 142       event = EVENT_NEXT(event);
 143     }
 144 }
 145 #endif  /* GRAN */
 146 \end{code}
 147
 148 \begin{code}
 149 #if defined(CONCURRENT)
 150 # if defined(GRAN)
 151 void
 152 EvacuateSparks(STG_NO_ARGS)
 153 {
 154   sparkq spark;
 155   PROC proc;
 156   I_ pool, total_sparks=0;
 157
 158   /* Sparks have been pruned already at this point */
 159
 160 # if defined(GRAN) && defined(GRAN_CHECK)
 161   if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
 162     fprintf(RTSflags.GcFlags.statsFile,"Evacuating Sparks ...\n");
 163 # endif
 164
 165   DEBUG_STRING("Evacuate Sparks (GRAN):");
 166   for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
 167     for(pool = 0; pool < SPARK_POOLS; ++pool) {
 168       for(spark = PendingSparksHd[proc][pool];
 169           spark != NULL;
 170           spark = SPARK_NEXT(spark))
 171         {
 172 # if defined(GRAN) && defined(GRAN_CHECK)
 173           if ( RTSflags.GcFlags.giveStats &&
 174                (RTSflags.GranFlags.debug & 0x40) &&
 175                !SHOULD_SPARK(SPARK_NODE(spark)) )
 176              fprintf(RTSflags.GcFlags.statsFile,"Qagh {EvacuateSparks}Daq: spark @ 0x%x with node 0x%x shouldn't spark!\n",
 177                      spark,SPARK_NODE(spark));
 178 # endif
 179           MAYBE_EVACUATE_CLOSURE(SPARK_NODE(spark));
 180         }  /* forall spark ... */
 181     }     /* forall pool ... */
 182   }      /* forall proc ... */
 183 }
 184
 185 # else  /* !GRAN */
 186
 187 void
 188 EvacuateSparks(STG_NO_ARGS)
 189 {
 190     PP_ sparkptr;
 191     int pool;
 192
 193
 194     DEBUG_STRING("Evacuate Sparks:");
 195     for (pool = 0; pool < SPARK_POOLS; pool++) {
 196         for (sparkptr = PendingSparksHd[pool];
 197           sparkptr < PendingSparksTl[pool]; sparkptr++) {
 198             MAYBE_EVACUATE_CLOSURE(*((PP_) sparkptr));
 199         }
 200     }
 201 }
 202 # endif
 203 #endif  /* CONCURRENT */
 204 \end{code}
 205
 206 Note: no \tr{evacuate[AB]Stack} for ``parallel'' systems, because they
 207 don't have a single main stack.
 208
 209 \begin{code}
 210 #if !defined(PAR)
 211 void
 212 EvacuateAStack(PP_ stackA, PP_ botA /* botA points to bottom-most word */)
 213 {
 214   PP_ stackptr;
 215
 216   DEBUG_STRING("Evacuate A Stack:");
 217   for (stackptr = stackA;
 218        SUBTRACT_A_STK(stackptr, botA) >= 0;
 219        stackptr = stackptr + AREL(1)) {
 220     MAYBE_EVACUATE_CLOSURE( *((PP_) stackptr) );
 221   }
 222 }
 223 #endif /* not PAR */
 224 \end{code}
 225
 226 ToDo: Optimisation which squeezes out update frames which point to
 227 garbage closures.
 228
 229 Perform collection first
 230
 231 Then process B stack removing update frames (bot to top via pointer
 232 reversal) that reference garbage closues (test infoptr !=
 233 EVACUATED_INFOPTR)
 234
 235 Otherwise closure is live update reference to to-space address
 236
 237 \begin{code}
 238 #if !defined(PAR)
 239 void
 240 EvacuateBStack( stackB, botB, roots )
 241   P_ stackB;
 242   P_ botB;  /* botB points to bottom-most word */
 243   I_ *roots;
 244 {
 245   I_ bstk_roots;
 246   P_ updateFramePtr;
 247   P_ updatee;
 248
 249   DEBUG_STRING("Evacuate B Stack:");
 250   bstk_roots = 0;
 251   for (updateFramePtr = stackB;  /* stackB points to topmost update frame */
 252        SUBTRACT_B_STK(updateFramePtr, botB) > 0;
 253        updateFramePtr = GRAB_SuB(updateFramePtr)) {
 254
 255     /* Evacuate the thing to be updated */
 256     updatee = GRAB_UPDATEE(updateFramePtr);
 257     MAYBE_EVACUATE_CLOSURE(updatee);
 258     PUSH_UPDATEE(updateFramePtr, updatee);
 259     bstk_roots++;
 260   }
 261   *roots = bstk_roots;
 262 }
 263 #endif /* not PAR */
 264 \end{code}
 265
 266 When we do a copying collection, we want to evacuate all of the local
 267 entries in the GALA table for which there are outstanding remote
 268 pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
 269
 270 \begin{code}
 271 #ifdef PAR
 272
 273 void
 274 EvacuateLocalGAs(rtsBool full)
 275 {
 276     GALA *gala;
 277     GALA *next;
 278     GALA *prev = NULL;
 279
 280     for (gala = liveIndirections; gala != NULL; gala = next) {
 281         next = gala->next;
 282         ASSERT(gala->ga.loc.gc.gtid == mytid);
 283         if (gala->ga.weight != MAX_GA_WEIGHT) {
 284             /* Remote references exist, so we must evacuate the local closure */
 285             P_ old = gala->la;
 286             MAYBE_EVACUATE_CLOSURE(gala->la);
 287             if (!full && gala->preferred && gala->la != old) {
 288                 (void) removeHashTable(LAtoGALAtable, (W_) old, (void *) gala);
 289                 insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 290             }
 291             gala->next = prev;
 292             prev = gala;
 293         } else {
 294             /* Since we have all of the weight, this GA is no longer needed */
 295             W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
 296
 297 #ifdef FREE_DEBUG
 298             fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 299 #endif
 300             gala->next = freeIndirections;
 301             freeIndirections = gala;
 302             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 303             if (!full && gala->preferred)
 304                 (void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 305 #ifdef DEBUG
 306             gala->ga.weight = 0x0d0d0d0d;
 307             gala->la = (P_) 0xbadbad;
 308 #endif
 309         }
 310     }
 311     liveIndirections = prev;
 312 }
 313
 314 \end{code}
 315
 316 \begin{code}
 317
 318 EXTDATA_RO(Forward_Ref_info);
 319
 320 void
 321 RebuildGAtables(rtsBool full)
 322 {
 323     GALA *gala;
 324     GALA *next;
 325     GALA *prev;
 326     P_ closure;
 327
 328     prepareFreeMsgBuffers();
 329
 330     for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 331         next = gala->next;
 332         ASSERT(gala->ga.loc.gc.gtid != mytid);
 333
 334         closure = gala->la;
 335
 336         /*
 337          * If the old closure has not been forwarded, we let go.  Note that this
 338          * approach also drops global aliases for PLCs.
 339          */
 340
 341 #if defined(GCgn) || defined(GCap)
 342         if (closure > OldGen) {
 343 #endif
 344             if (!full && gala->preferred)
 345                 (void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 346
 347             /* Follow indirection chains to the end, just in case */
 348             while (IS_INDIRECTION(INFO_PTR(closure)))
 349                 closure = (P_) IND_CLOSURE_PTR(closure);
 350
 351             /* Change later to incorporate a _FO bit in the INFO_TYPE for GCgn */
 352 #ifdef GCgn
 353     fall over, until _FO bits are added
 354 #endif
 355             if (INFO_PTR(closure) != (W_) Forward_Ref_info) {
 356                 int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
 357                 W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 358
 359                 (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 360                 freeRemoteGA(pe, &(gala->ga));
 361                 gala->next = freeGALAList;
 362                 freeGALAList = gala;
 363             } else {
 364                 /* Find the new space object */
 365                 closure = (P_) FORWARD_ADDRESS(closure);
 366                 gala->la = closure;
 367
 368                 if (!full && gala->preferred)
 369                     insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
 370                 gala->next = prev;
 371                 prev = gala;
 372             }
 373 #if defined(GCgn) || defined(GCap)
 374         } else {
 375             /* Old generation, minor collection; just keep it */
 376             gala->next = prev;
 377             prev = gala;
 378         }
 379 #endif
 380     }
 381     liveRemoteGAs = prev;
 382
 383     /* If we have any remaining FREE messages to send off, do so now */
 384     sendFreeMessages();
 385
 386     if (full)
 387         RebuildLAGAtable();
 388 }
 389
 390 #endif
 391
 392 \end{code}
 393
 394 \begin{code}
 395 void
 396 Scavenge(void)
 397 {
 398   DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp);
 399   while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
 400   DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
 401 }
 402 \end{code}
 403
 404 \begin{code}
 405 #ifdef GCdu
 406
 407 void
 408 EvacuateCAFs( CAFlist )
 409   P_ CAFlist;
 410 {
 411   P_ CAFptr;
 412
 413   DEBUG_STRING("Evacuate CAFs:");
 414   for (CAFptr = CAFlist;
 415        CAFptr != NULL;
 416        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 417     EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
 418   }
 419 }
 420
 421 /* ToDo: put GCap EvacuateCAFs code here */
 422
 423 #else /* not GCdu */
 424
 425 void
 426 EvacAndScavengeCAFs( CAFlist, extra_words, roots )
 427   P_ CAFlist;
 428   I_ *extra_words;
 429   I_ *roots;
 430 {
 431   I_ caf_roots = 0;
 432   P_ caf_start = ToHp;
 433   P_ CAFptr;
 434
 435   DEBUG_STRING("Evacuate & Scavenge CAFs:");
 436   for (CAFptr = CAFlist;
 437        CAFptr != NULL;
 438        CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) {
 439
 440       EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */
 441       caf_roots++;
 442
 443       DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp);
 444       while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
 445       DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp);
 446   }
 447   *extra_words = ToHp - caf_start;
 448   *roots = caf_roots;
 449 }
 450
 451 #endif /* !GCdu */
 452
 453 #endif /* defined(_INFO_COPYING) */
 454 \end{code}