+++ /dev/null
-%
-% (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 = PrelBase_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 == PrelBase_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}
projects / ghc-hetmet.git / blobdiff