path: root/ghc/runtime/gum/RBH.lc

%
% (c) The AQUA/Parade Projects, Glasgow University, 1995
%
%************************************************************************
%*                                                                      *
\section[RBH.lc]{Revertible Black Hole Manipulation}
%*									*
%************************************************************************

\begin{code}
#if defined(PAR) || defined(GRAN) /* whole file */

#include "rtsdefs.h"
\end{code}

Turn a closure into a revertible black hole.  After the conversion,
the first two words of the closure will be a link to the mutables
list (if appropriate for the garbage collector), and a pointer
to the blocking queue.  The blocking queue is terminated by a 2-word
SPEC closure which holds the original contents of the first two
words of the closure.

\begin{code}
EXTFUN(RBH_Save_0_info);
EXTFUN(RBH_Save_1_info);
EXTFUN(RBH_Save_2_info);

P_
convertToRBH(closure)
P_ closure;
{
    P_ infoPtr, newInfoPtr;
    W_ size, ptrs, nonptrs, vhs;
    P_	rbh_save;
    rtsBool isSpec;
    char str[80];

    if ((rbh_save = AllocateHeap(SPEC_HS + 2)) == NULL)
	return NULL;

    infoPtr = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
    ASSERT(size >= MIN_UPD_SIZE);

    switch (BASE_INFO_TYPE(infoPtr)) {
    case INFO_SPEC_TYPE:
	isSpec = rtsTrue;
	break;
    case INFO_GEN_TYPE:
	isSpec = rtsFalse;
	break;
    default:
	fprintf(stderr, "Panic: turn %#lx (IP %#lx) into RBH\n", (W_)closure, (W_)infoPtr);
	EXIT(EXIT_FAILURE);
    }

    /* Fill in the RBH_Save closure with the original data */
    rbh_save[SPEC_HS] = closure[isSpec ? SPEC_HS : GEN_HS];
    rbh_save[SPEC_HS + 1] = closure[(isSpec ? SPEC_HS : GEN_HS) + 1];

    /*
     * Set the info_ptr for the rbh_Save closure according to the number of pointers
     * in the original
     */

    newInfoPtr = (P_) (ptrs == 0 ? RBH_Save_0_info :
                       ptrs == 1 ? RBH_Save_1_info :
                       RBH_Save_2_info);
    SET_INFO_PTR(rbh_save, newInfoPtr);

    /* Do some magic garbage collection mangling on the first word */

#if defined(GCap) || defined(GCgn)

    /*
     * If the closure's in the old generation, we have to make sure it goes on the
     * mutables list
     */

    if (closure <= StorageMgrInfo.OldLim) {
	MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
	StorageMgrInfo.OldMutables = closure;
    } else
	MUT_LINK(closure) = MUT_NOT_LINKED;
#endif

    /*
     * Second word points to the RBH_Save closure with the original data. This may
     * become a blocking queue terminated by the RBH_Save closure.
     */
    if (isSpec)
        SPEC_RBH_BQ(closure) = (W_) rbh_save;
    else
	GEN_RBH_BQ(closure) = (W_) rbh_save;

    /* OK, now actually turn it into a RBH (what a great system!) */
    SET_INFO_PTR(closure, RBH_INFOPTR(INFO_PTR(closure)));

    return closure;
}

\end{code}

Converting a closure to a FetchMe is trivial, unless the closure has
acquired a blocking queue.  If that has happened, we first have to
awaken the blocking queue.  What a nuisance!  Fortunately,
@AwakenBlockingQueue@ should now know what to do.

A note on GrAnSim: In GrAnSim we don't have FetchMe closures. However, we
have to turn a RBH back to its original form when the simulated transfer
of the closure has been finished. Therefore we need the @convertFromRBH@
routine below. After converting the RBH back to its original form and 
awakening all TSOs, the first TSO will reenter the closure which is now
local and carry on merrily reducing it (the other TSO will be less merrily 
blocked on the now local closure; we're costing the difference between
local and global blocks in the BQ code).

\begin{code}
#if defined(PAR)

EXTDATA_RO(FetchMe_info);

void
convertToFetchMe(closure, ga)
P_ closure;
globalAddr *ga;
{
    P_ ip = (P_) INFO_PTR(closure);
    P_ bqe;
#if defined(GCap) || defined(GCgn)    
    rtsBool linked = IS_MUTABLE(ip) && MUT_LINK(closure) != MUT_NOT_LINKED;
#endif

    switch(INFO_TYPE(ip)) {
    case INFO_SPEC_RBH_TYPE:
	bqe = (P_) SPEC_RBH_BQ(closure);
	break;
    case INFO_GEN_RBH_TYPE:
	bqe = (P_) GEN_RBH_BQ(closure);
	break;
    default:
#ifdef DEBUG
	fprintf(stderr, "Weird...just tried to convert %#lx (IP %#lx) to FetchMe\n",
	  closure, ip);
#endif
	return;
    }

    SET_INFO_PTR(closure, FetchMe_info);

#if defined(GCap) || defined(GCgn)
    /* If we modify a fetchme in the old generation,
       we have to make sure it goes on the mutables list */

    if(closure <= StorageMgrInfo.OldLim) {
	if (!linked) {
	    MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
            StorageMgrInfo.OldMutables = closure;
	}
    } else
        MUT_LINK(closure) = MUT_NOT_LINKED;
#endif
    
    FETCHME_GA(closure) = ga;
    if (IS_MUTABLE(INFO_PTR(bqe)))
	AwakenBlockingQueue(bqe);
}
#else  /* GRAN */
/* Prototype */
void UnlinkFromMUT(P_ closure); 

void
convertFromRBH(closure)  /* The corresponding function in GUM is: */  
                         /* convertToFetchMe */
P_ closure;
{
    P_ ip = (P_) INFO_PTR(closure);
    P_ bqe, rbh_save = Prelude_Z91Z93_closure;
    int isSpec;
#if defined(GCap) || defined(GCgn)    
    rtsBool linked = IS_MUTABLE(ip) && MUT_LINK(closure) != MUT_NOT_LINKED;
    P_ oldLink = MUT_LINK(closure);
#endif

    switch(INFO_TYPE(ip)) {
    case INFO_SPEC_RBH_TYPE:
	bqe = (P_) SPEC_RBH_BQ(closure);
	isSpec = 1;
	break;
    case INFO_GEN_RBH_TYPE:
	bqe = (P_) GEN_RBH_BQ(closure);
	isSpec = 0;
	break;
    default:
#if 1
	fprintf(stderr, "Weird...just tried to convert %#lx (IP %#lx) to FetchMe\n",
	  closure, ip);
#endif
	return;
    }

#  if defined(GCap) || defined(GCgn)
    /* If the RBH is turned back to a SPEC or GEN closure we have to take 
       it off  the mutables list */

    if (linked) {
#  if defined(GRAN_CHECK)
      if (RTSflags.GranFlags.debug & 0x100) {
            fprintf(stderr,"\n**>>>> Unlinking closure %#lx from mutables list on PE %d @ %ld (next mutable=%#lx)\n",
                           closure,
                           where_is(closure), CurrentTime[where_is(closure)],
                           MUT_LINK(closure));
            GN(closure);
          }
#  endif
      UnlinkFromMUT(closure);
    }
#  endif
    
    /* FETCHME_GA(closure) = ga; */
    if (IS_MUTABLE(INFO_PTR(bqe))) {
      PROC old_proc = CurrentProc,        /* NB: For AwakenBlockingQueue, */
           new_proc = where_is(closure);  /*     CurentProc must be where */
					  /*     closure lives. */
      CurrentProc = new_proc;

#  if defined(GRAN_CHECK)
      if (RTSflags.GranFlags.debug & 0x100)
        fprintf(stderr,"===== AwBQ of node 0x%lx (%s) [PE %2u]\n",
	               closure, (isSpec ? "SPEC_RBH" : "GEN_RBH"), new_proc);
#  endif

      rbh_save = AwakenBlockingQueue(bqe);     /* AwakenBlockingQueue(bqe); */
      CurrentProc = old_proc;
    } else {
        rbh_save = bqe;
    }

    /* Put data from special RBH save closures back into the closure */
    if ( rbh_save == Prelude_Z91Z93_closure ) {
      fprintf(stderr,"convertFromRBH: No RBH_Save_? closure found at end of BQ!\n");
      EXIT(EXIT_FAILURE);
    } else {
      closure[isSpec ? SPEC_HS : GEN_HS] = rbh_save[SPEC_HS];
      closure[(isSpec ? SPEC_HS : GEN_HS) + 1] = rbh_save[SPEC_HS + 1];
    }

    /* Put back old info pointer (only in GrAnSim) -- HWL */
    SET_INFO_PTR(closure, REVERT_INFOPTR(INFO_PTR(closure)));

#  if (defined(GCap) || defined(GCgn))
    /* If we convert from an RBH in the old generation,
       we have to make sure it goes on the mutables list */

    if(closure <= StorageMgrInfo.OldLim) {
	if (IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) == MUT_NOT_LINKED) {
	    MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
            StorageMgrInfo.OldMutables = closure;
	}
    }
#  endif
}

/* Remove closure from the mutables list */

void
UnlinkFromMUT(P_ closure) 
{
  P_ curr = StorageMgrInfo.OldMutables, prev = NULL;

  while (curr != NULL && curr != closure) {
    ASSERT(MUT_LINK(curr)!=MUT_NOT_LINKED);
    prev=curr;
    curr=MUT_LINK(curr); 
  }
  if (curr==closure) {   
   if (prev==NULL) 
     StorageMgrInfo.OldMutables = MUT_LINK(curr);
   else   
     MUT_LINK(prev) = MUT_LINK(curr);
   MUT_LINK(curr) = MUT_NOT_LINKED;
  }

#if 0 && (defined(GCap) || defined(GCgn))
  {
    closq newclos;
    extern closq ex_RBH_q;

    newclos = (closq) stgMallocBytes(sizeof(struct clos), "UnlinkFromMUT");
    CLOS_CLOSURE(newclos) = closure;
    CLOS_PREV(newclos) = NULL;
    CLOS_NEXT(newclos) = ex_RBH_q;
    if (ex_RBH_q!=NULL)
      CLOS_PREV(ex_RBH_q) = newclos;
    ex_RBH_q = newclos;
  }
#endif
}

#endif /* PAR */

#endif /* PAR || GRAN -- whole file */
\end{code}