\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}