+++ /dev/null
-\section[SM-compacting]{Compacting Collector Subroutines}
-
-This is a collection of C functions used in implementing the compacting
-collectors.
-
-The motivation for making this a separate file/section is twofold:
-
-1) It lets us focus on one thing.
-
-2) If we don't do this, there will be a huge amount of repetition
- between the various GC schemes --- a maintenance nightmare.
-
-The second is the major motivation.
-
-ToDo ADR: trash contents of other semispace after GC in debugging version
-
-\begin{code}
-#if defined(GC1s) || defined(GCdu) || defined(GCap) || defined(GCgn)
- /* to the end */
-
-#if defined(GC1s)
-
-#define SCAN_REG_DUMP
-#include "SMinternal.h"
-REGDUMP(ScanRegDump);
-
-#else /* GCdu, GCap, GCgn */
-
-#define SCAV_REG_MAP
-#include "SMinternal.h"
-REGDUMP(ScavRegDump);
-
-#endif
-
-#include "SMcompacting.h"
-\end{code}
-
-\begin{code}
-void
-LinkRoots(roots, rootno)
-P_ roots[];
-I_ rootno;
-{
- I_ root;
-
- DEBUG_STRING("Linking Roots:");
- for (root = 0; root < rootno; root++) {
- LINK_LOCATION_TO_CLOSURE(&(roots[root]));
- }
-}
-
-\end{code}
-
-\begin{code}
-#if defined(GRAN)
-void
-LinkEvents(STG_NO_ARGS)
-{
- eventq event = EventHd;
-
-# if defined(GRAN) && defined(GRAN_CHECK)
- if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
- fprintf(RTSflags.GcFlags.statsFile,"Linking Events ...\n");
-#endif
-
- DEBUG_STRING("Linking Events:");
- while(event != NULL)
- {
- if(EVENT_TYPE(event) == RESUMETHREAD ||
- EVENT_TYPE(event) == MOVETHREAD ||
- EVENT_TYPE(event) == CONTINUETHREAD ||
- EVENT_TYPE(event) == STARTTHREAD )
-
- { LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) ); }
-
- else if(EVENT_TYPE(event) == MOVESPARK)
-
- { LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(EVENT_SPARK(event))) ); }
-
- else if (EVENT_TYPE(event) == FETCHNODE ||
- EVENT_TYPE(event) == FETCHREPLY )
- {
- LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
-
- /* In the case of packet fetching, EVENT_NODE(event) points to */
- /* the packet (currently, malloced). The packet is just a list of */
- /* closure addresses, with the length of the list at index 1 (the */
- /* structure of the packet is defined in Pack.lc). */
- if ( RTSflags.GranFlags.DoGUMMFetching &&
- (EVENT_TYPE(event)==FETCHREPLY)) {
- P_ buffer = (P_) EVENT_NODE(event);
- int size = (int) buffer[PACK_SIZE_LOCN], i;
-
- for (i = PACK_HDR_SIZE; i <= size-1; i++) {
- LINK_LOCATION_TO_CLOSURE( (buffer+i) );
- }
- } else
- { LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) ); }
- }
- else if (EVENT_TYPE(event) == GLOBALBLOCK)
- {
- LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
- LINK_LOCATION_TO_CLOSURE( &(EVENT_NODE(event)) );
- }
- else if (EVENT_TYPE(event) == UNBLOCKTHREAD)
- {
- LINK_LOCATION_TO_CLOSURE( &(EVENT_TSO(event)) );
- }
- event = EVENT_NEXT(event);
- }
-}
-#endif /* GRAN */
-\end{code}
-
-\begin{code}
-
-#if defined(CONCURRENT)
-# if defined(GRAN)
-void
-LinkSparks(STG_NO_ARGS)
-{
- sparkq spark;
- PROC proc;
- I_ pool, total_sparks=0;
-
-# if defined(GRAN) && defined(GRAN_CHECK)
- if ( RTSflags.GcFlags.giveStats && (RTSflags.GranFlags.debug & 0x40) )
- fprintf(RTSflags.GcFlags.statsFile,"Linking Sparks ...\n");
-#endif
-
- DEBUG_STRING("Linking Sparks:");
- for(proc = 0; proc < RTSflags.GranFlags.proc; ++proc) {
- for(pool = 0; pool < SPARK_POOLS; ++pool) {
- for(spark = PendingSparksHd[proc][pool];
- spark != NULL;
- spark = SPARK_NEXT(spark))
- {
- LINK_LOCATION_TO_CLOSURE( &(SPARK_NODE(spark)));
- } /* forall spark ... */
- } /* forall pool ... */
- } /*forall proc .. */
-}
-
-# else /* ! GRAN */
-
-void
-LinkSparks(STG_NO_ARGS)
-{
- PP_ sparkptr;
- int pool;
-
- DEBUG_STRING("Linking Sparks:");
- for (pool = 0; pool < SPARK_POOLS; pool++) {
- for (sparkptr = PendingSparksHd[pool];
- sparkptr < PendingSparksTl[pool]; sparkptr++) {
- LINK_LOCATION_TO_CLOSURE(sparkptr);
- }
- }
-}
-#endif /* GRAN */
-#endif /* CONCURRENT */
-
-\end{code}
-
-\begin{code}
-
-#ifdef PAR
-
-void
-LinkLiveGAs(P_ base, BitWord *bits)
-{
- GALA *gala;
- GALA *next;
- GALA *prev;
- long _hp_word, bit_index, bit;
-
- DEBUG_STRING("Linking Live GAs:");
-
- for (gala = liveIndirections, prev = NULL; gala != NULL; gala = next) {
- next = gala->next;
- ASSERT(gala->ga.loc.gc.gtid == mytid);
- if (gala->ga.weight != MAX_GA_WEIGHT) {
- LINK_LOCATION_TO_CLOSURE(&gala->la);
- gala->next = prev;
- prev = gala;
- } else {
- /* Since we have all of the weight, this GA is no longer needed */
- W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot);
-
-#ifdef FREE_DEBUG
- fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot);
-#endif
- gala->next = freeIndirections;
- freeIndirections->next = gala;
- (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
-#ifdef DEBUG
- gala->ga.weight = 0x0d0d0d0d;
- gala->la = (P_) 0xbadbad;
-#endif
- }
- }
- liveIndirections = prev;
-
- prepareFreeMsgBuffers();
-
- for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
- next = gala->next;
- ASSERT(gala->ga.loc.gc.gtid != mytid);
-
- _hp_word = gala->la - base;
- bit_index = _hp_word / BITS_IN(BitWord);
- bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
- if (!(bits[bit_index] & bit)) {
- int pe = taskIDtoPE(gala->ga.loc.gc.gtid);
- W_ pga = PackGA(pe, gala->ga.loc.gc.slot);
-
- (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
- freeRemoteGA(pe, &(gala->ga));
- gala->next = freeGALAList;
- freeGALAList = gala;
- } else {
- LINK_LOCATION_TO_CLOSURE(&gala->la);
- gala->next = prev;
- prev = gala;
- }
- }
- liveRemoteGAs = prev;
-
- /* If we have any remaining FREE messages to send off, do so now */
- sendFreeMessages();
-}
-
-#endif
-
-\end{code}
-
-Note: no \tr{Link[AB]Stack} for ``parallel'' systems, because they
-don't have a single main stack.
-
-\begin{code}
-#if !defined(PAR) /* && !defined(GRAN) */ /* HWL */
-
-void
-LinkAStack(stackA, botA)
-PP_ stackA;
-PP_ botA;
-{
- PP_ stackptr;
-
- DEBUG_STRING("Linking A Stack:");
- for (stackptr = stackA;
- SUBTRACT_A_STK(stackptr, botA) >= 0;
- stackptr = stackptr + AREL(1)) {
- LINK_LOCATION_TO_CLOSURE(stackptr);
- }
-}
-#endif /* PAR */
-\end{code}
-
-ToDo (Patrick?): Dont explicitly mark & compact unmarked Bstack frames
-
-\begin{code}
-#if !defined(PAR) /* && !defined(CONCURRENT) */ /* HWL */
-
-void
-LinkBStack(stackB, botB)
-P_ stackB;
-P_ botB; /* stackB points to topmost update frame */
-{
- P_ updateFramePtr;
-
- DEBUG_STRING("Linking B Stack:");
- for (updateFramePtr = stackB;
- SUBTRACT_B_STK(updateFramePtr, botB) > 0;
- updateFramePtr = GRAB_SuB(updateFramePtr)) {
-
- P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE);
-
- LINK_LOCATION_TO_CLOSURE(updateClosurePtr);
- }
-}
-#endif /* not PAR */
-\end{code}
-
-\begin{code}
-I_
-CountCAFs(P_ CAFlist)
-{
- I_ caf_no = 0;
-
- for (caf_no = 0; CAFlist != NULL; CAFlist = (P_) IND_CLOSURE_LINK(CAFlist))
- caf_no++;
-
- return caf_no;
-}
-\end{code}
-
-\begin{code}
-void
-LinkCAFs(P_ CAFlist)
-{
- DEBUG_STRING("Linking CAF Ptr Locations:");
- while(CAFlist != NULL) {
- DEBUG_LINK_CAF(CAFlist);
- LINK_LOCATION_TO_CLOSURE(&IND_CLOSURE_PTR(CAFlist));
- CAFlist = (P_) IND_CLOSURE_LINK(CAFlist);
- }
-}
-
-#endif /* defined(_INFO_COMPACTING) */
-\end{code}
projects / ghc-hetmet.git / blobdiff