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
  56 #ifdef CONCURRENT
  57 void
  58 LinkSparks(STG_NO_ARGS)
  59 {
  60     PP_ sparkptr;
  61     int pool;
  62
  63     DEBUG_STRING("Linking Sparks:");
  64     for (pool = 0; pool < SPARK_POOLS; pool++) {
  65         for (sparkptr = PendingSparksHd[pool];
  66           sparkptr < PendingSparksTl[pool]; sparkptr++) {
  67             LINK_LOCATION_TO_CLOSURE(sparkptr);
  68         }
  69     }
  70 }
  71 #endif
  72
  73 \end{code}
  74
  75 \begin{code}
  76
  77 #ifdef PAR
  78
  79 void
  80 LinkLiveGAs(P_ base, BitWord *bits)
  81 {
  82     GALA *gala;
  83     GALA *next;
  84     GALA *prev;
  85     long _hp_word, bit_index, bit;
  86
  87     DEBUG_STRING("Linking Live GAs:");
  88
  89     for (gala = liveIndirections, prev = NULL; gala != NULL; gala = next) {
  90         next = gala->next;
  91         ASSERT(gala->ga.loc.gc.gtid == mytid);
  92         if (gala->ga.weight != MAX_GA_WEIGHT) {
  93             LINK_LOCATION_TO_CLOSURE(&gala->la);
  94             gala->next = prev;
  95             prev = gala;
  96         } else {
  97             /* Since we have all of the weight, this GA is no longer needed */
  98             W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
  99
 100 #ifdef FREE_DEBUG
 101             fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
 102 #endif
 103             gala->next = freeIndirections;
 104             freeIndirections->next = gala;
 105             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 106 #ifdef DEBUG
 107             gala->ga.weight = 0x0d0d0d0d;
 108             gala->la = (P_) 0xbadbad;
 109 #endif
 110         }
 111     }
 112     liveIndirections = prev;
 113
 114     prepareFreeMsgBuffers();
 115
 116     for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
 117         next = gala->next;
 118         ASSERT(gala->ga.loc.gc.gtid != mytid);
 119
 120         _hp_word = gala->la - base;
 121         bit_index = _hp_word / BITS_IN(BitWord);
 122         bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
 123         if (!(bits[bit_index] & bit)) {
 124             int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
 125             W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
 126
 127             (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
 128             freeRemoteGA(pe, &(gala->ga));
 129             gala->next = freeGALAList;
 130             freeGALAList = gala;
 131         } else {
 132             LINK_LOCATION_TO_CLOSURE(&gala->la);
 133             gala->next = prev;
 134             prev = gala;
 135         }
 136     }
 137     liveRemoteGAs = prev;
 138
 139     /* If we have any remaining FREE messages to send off, do so now */
 140     sendFreeMessages();
 141 }
 142
 143 #else
 144
 145 \end{code}
 146
 147 Note: no \tr{Link[AB]Stack} for ``parallel'' systems, because they
 148 don't have a single main stack.
 149
 150 \begin{code}
 151
 152 void
 153 LinkAStack(stackA, botA)
 154 PP_ stackA;
 155 PP_ botA;
 156 {
 157     PP_ stackptr;
 158
 159     DEBUG_STRING("Linking A Stack:");
 160     for (stackptr = stackA;
 161       SUBTRACT_A_STK(stackptr, botA) >= 0;
 162       stackptr = stackptr + AREL(1)) {
 163         LINK_LOCATION_TO_CLOSURE(stackptr);
 164     }
 165 }
 166 #endif /* PAR */
 167 \end{code}
 168
 169 ToDo (Patrick?): Dont explicitly mark & compact unmarked Bstack frames
 170
 171 \begin{code}
 172 #if ! defined(PAR)
 173 void
 174 LinkBStack(stackB, botB)
 175 P_ stackB;
 176 P_ botB;                        /* stackB points to topmost update frame */
 177 {
 178     P_ updateFramePtr;
 179
 180     DEBUG_STRING("Linking B Stack:");
 181     for (updateFramePtr = stackB;
 182          SUBTRACT_B_STK(updateFramePtr, botB) > 0;
 183          updateFramePtr = GRAB_SuB(updateFramePtr)) {
 184
 185         P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
 186
 187         LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
 188     }
 189 }
 190 #endif /* not PAR */
 191 \end{code}
 192
 193 \begin{code}
 194 I_
 195 CountCAFs(P_ CAFlist)
 196 {
 197     I_ caf_no = 0;
 198
 199     for (caf_no = 0; CAFlist != NULL; CAFlist = (P_) IND_CLOSURE_LINK(CAFlist))
 200         caf_no++;
 201
 202     return caf_no;
 203 }
 204 \end{code}
 205
 206 \begin{code}
 207 void
 208 LinkCAFs(P_ CAFlist)
 209 {
 210     DEBUG_STRING("Linking CAF Ptr Locations:");
 211     while(CAFlist != NULL) {
 212         DEBUG_LINK_CAF(CAFlist);
 213         LINK_LOCATION_TO_CLOSURE(&IND_CLOSURE_PTR(CAFlist));
 214         CAFlist = (P_) IND_CLOSURE_LINK(CAFlist);
 215     }
 216 }
 217
 218 #endif /* defined(_INFO_COMPACTING) */
 219 \end{code}