%**************************************************************************** % \section[SMmark.lhc]{Pointer-Reversing Mark code} % % (c) P. Sansom, K. Hammond, OBFUSCATION-THROUGH-GRATUITOUS-PREPROCESSOR-ABUSE % Project, Glasgow University, January 26th 1993. % %**************************************************************************** This module contains the specialised and generic code to perform pointer reversal marking. These routines are placed in the info tables of the appropriate closures. Some of the dirt is hidden in macros defined in SMmarkDefs.lh. %**************************************************************************** % \subsection[mark-overview]{Overview of Marking} % %**************************************************************************** This module uses a pointer-reversal algorithm to mark a closure. To mark a closure, first set a bit indicating that the closure has been marked, then mark each pointer in the closure. The mark bit is used to determine whether a node has already been marked before we mark it. Because we set the bit before marking the children of a node, this avoids cycles. Given a closure containing a number of pointers, $n$, $n > 0$ the mark code for that closure can be divided into three parts: \begin{enumerate} \item The mark (or ``start'') code for the closure. Called when an attempt is made to mark the closure, it initialises the mark position in the closure, then jumps to the mark code for the first pointer. \item The return (or ``in'') code for the closure. Called when a closure is returned to after a child is marked, it increments the mark position and jumps to the mark entry for the next pointer \item The last (or ``in-last'') code for the closure. Called when all children have been marked, it just returns to its parent through the appropriate return code. \end{enumerate} For non-\tr{SPEC} closures, the return and last codes are merged in most cases, so the return code checks explicitly whether all pointers have been marked, and returns if so. %**************************************************************************** % \subsubsection[mark-registers]{Registers used when marking} % %**************************************************************************** Two registers are used: \begin{description} \item[Mark] Points to the closure being marked. \item[MStack] Points to the closure on the top of the marking stack. The first closure on the stack contains the continuation to enter when marking is complete. \end{description} The following registers are used by Pointer Reversal Marking: \begin{description} \item[@MStack@] The top of the mark stack. \item[@Mark@] The node being processed. \item[@BitArray@] The bit array (what's that? KH) to mark. \item[@HeapBase@] The base of the heap (to calculate bit to mark). \item[@HeapLim@] The limit of the heap. For generational garbage collection, only closures whose address is $<$ @HeapLim@ will be marked \end{description} To answer KH's question, the @BitArray@ is used to store marks. This avoids the need to include space for a mark bit in the closure itself. The array consists of one bit per word of heap memory that is handled by the compacting collector or the old generation in the generational collector. [ADR] %**************************************************************************** % \subsubsection[mark-conventions]{Calling and Return Conventions} % %**************************************************************************** When a child closure is returned from, the registers have the following values. \begin{description} \item[@Mark@] points to the closure just marked (this may be updated with a new address to short-circuit indirections). \item[MStack] points to the closure whose return code has been entered (this closure is now at the top of the pointer-reversal marking stack). \end{description} The macros @JUMP_MARK@ and @JUMP_MARK_RETURN@ jump to the start code pointed to by the @Mark@ register, or the return code pointed to by the @MStack@ register respectively. %%%% GOT THIS FAR -- KH %%%% Marking A Closure: @_PRStart_N@ Retrieved using PRMARK_CODE(infoptr) Uses pointer reversal marking to mark a closure which contains N ptrs. If the closure has 0 pointers it sets it to a marked state and returns to the closure on top of the PR mark stack (_PRStart_0). If Not (@_PRStart_N@ ($N > 0$)) sets to a state of marking the first pointer pushes this closure on the PR marking stack (in the first ptr location) marks the first child -- enters its marking code A closure that is already marked just indicates this by returning to the closure on the top of the PR mark stack. Calling Conventions: Mark -- points to the closure to mark MStack -- points to the closure on the top of the PR marking stack If the stack is empty it points to a closure which contains the continuation to enter when marking is complete. User Invokation: Have root to mark MStack set to a closure containing the continuation to be called when the root has been marked. Mark pointing to the closure Entering MStack Continuation: Mark points to new value of the closure (indirection short circut) *** Update root being marked with this value. Returning To A Closure Being Marked: _PRIn_I _PRInLast_N Retrieved using PRRETURN_CODE(infoptr) Starts marking the next pointer (_PRIn_I). updates the current poointer being marked with new Mark sets state to next pointer marks the next child If not, (_PRInLast_N), it returns to the closure on the top of the PR marking stack. Calling Conventions: Mark -- points to the closure just marked (may be updated with new address to short indirections) MStack -- points to it -- the closure on the top of the PR marking stack The following registers are used by Pointer Reversal Marking: MStack -- The MarkStack register Mark -- Points to the Node being processed BitArray -- The bit array to mark HeapBase -- The base of the heap (to calculate bit to mark) HeapLim -- The limit of the heap -- For gen gc: only closures < HeapLim will be marked -- OldRoots pointing < HeapLim \input{SMmarkDefs.lh} %**************************************************************************** % \subsection[mark-code]{The actual Marking Code} % %**************************************************************************** This code is only used if @_INFO_MARKING@ is defined. \begin{code} #if defined(_INFO_MARKING) \end{code} First the necessary forward declarations. \begin{code} /* #define MARK_REG_MAP -- Must be done on command line for threaded code */ #include "SMinternal.h" #include "SMmarkDefs.h" #if defined(GRAN) extern P_ ret_MRoot, ret_Mark; #endif \end{code} Define appropriate variables as potential register variables. Assume GC code saves and restores any global registers used. \begin{code} RegisterTable MarkRegTable; \end{code} @_startMarkWorld@ restores registers if necessary, then marks the root pointed to by @Mark@. \begin{code} STGFUN(_startMarkWorld) { FUNBEGIN; #if defined(__STG_GCC_REGS__) && defined(__GNUC__) /* If using registers load from _SAVE (see SMmarking.lc) */ /* I deeply suspect this should be RESTORE_REGS(...) [WDP 95/02] */ #ifdef REG_MarkBase MarkBaseReg = &MarkRegTable; #endif Mark = SAVE_Mark; MRoot = SAVE_MRoot; MStack = SAVE_MStack; BitArray = SAVE_BitArray; HeapBase = SAVE_HeapBase; HeapLim = SAVE_HeapLim; #endif JUMP_MARK; FUNEND; } \end{code} This is the pointer reversal start code for \tr{SPEC} closures with 0 pointers. \begin{code} STGFUN(_PRStart_0) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else INIT_MARK_NODE("SPEC",0); JUMP_MARK_RETURN; FUNEND; } \end{code} This macro defines the format of the pointer reversal start code for a number of pointers \tr{ptrs}, $>$ 0. \begin{code} #define SPEC_PRStart_N_CODE(ptrs) \ STGFUN(CAT2(_PRStart_,ptrs)) \ { \ FUNBEGIN; \ if (IS_MARK_BIT_SET(Mark)) { \ DEBUG_PR_MARKED; \ JUMP_MARK_RETURN; \ } else { \ INIT_MARK_NODE("SPEC",ptrs); \ INIT_MSTACK(SPEC_CLOSURE_PTR); \ } \ FUNEND; \ } \end{code} The definitions of the start code for \tr{SPEC} closures with 1-12 pointers. \begin{code} SPEC_PRStart_N_CODE(1) SPEC_PRStart_N_CODE(2) SPEC_PRStart_N_CODE(3) SPEC_PRStart_N_CODE(4) SPEC_PRStart_N_CODE(5) SPEC_PRStart_N_CODE(6) SPEC_PRStart_N_CODE(7) SPEC_PRStart_N_CODE(8) SPEC_PRStart_N_CODE(9) SPEC_PRStart_N_CODE(10) SPEC_PRStart_N_CODE(11) SPEC_PRStart_N_CODE(12) \end{code} Start code for revertible black holes with underlying @SPEC@ types. \begin{code} #if defined(PAR) || defined(GRAN) #define SPEC_RBH_PRStart_N_CODE(ptrs) \ STGFUN(CAT2(_PRStart_RBH_,ptrs)) \ { \ FUNBEGIN; \ if (IS_MARK_BIT_SET(Mark)) { \ DEBUG_PR_MARKED; \ JUMP_MARK_RETURN; \ } else { \ INIT_MARK_NODE("SRBH",ptrs-1); \ INIT_MSTACK(SPEC_RBH_CLOSURE_PTR); \ } \ FUNEND; \ } SPEC_RBH_PRStart_N_CODE(2) SPEC_RBH_PRStart_N_CODE(3) SPEC_RBH_PRStart_N_CODE(4) SPEC_RBH_PRStart_N_CODE(5) SPEC_RBH_PRStart_N_CODE(6) SPEC_RBH_PRStart_N_CODE(7) SPEC_RBH_PRStart_N_CODE(8) SPEC_RBH_PRStart_N_CODE(9) SPEC_RBH_PRStart_N_CODE(10) SPEC_RBH_PRStart_N_CODE(11) SPEC_RBH_PRStart_N_CODE(12) #endif \end{code} @SPEC_PRIn_N_CODE@ has two different meanings, depending on the world in which we use it: \begin{itemize} \item In the commoned-info-table world, it defines the ``in'' code for a particular number of pointers, and subsumes the functionality of @SPEC_PRInLast_N_NODE@ below. \item Otherwise, it defines the ``in'' code for a particular pointer in a \tr{SPEC} closure. \end{itemize} \begin{code} #define SPEC_PRIn_N_CODE(ptrs) \ STGFUN(CAT2(_PRIn_,ptrs)) \ { \ BitWord mbw; \ FUNBEGIN; \ GET_MARKED_PTRS(mbw,MStack,ptrs); \ if (++mbw < ptrs) { \ SET_MARKED_PTRS(MStack,ptrs,mbw); \ CONTINUE_MARKING_NODE("SPEC",mbw); \ MOVE_TO_NEXT_PTR(SPEC_CLOSURE_PTR,mbw); \ } else { \ SET_MARKED_PTRS(MStack,ptrs,0L); \ POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,ptrs); \ } \ FUNEND; \ } \end{code} Now @SPEC_PRIn_N_CODE@ is used to define the individual entries for \tr{SPEC} closures with 1-12 pointers. \begin{code} STGFUN(_PRIn_0) { FUNBEGIN; fprintf(stderr,"Called _PRIn_0\nShould never occur!\n"); abort(); FUNEND; } STGFUN(_PRIn_1) { FUNBEGIN; POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,1); FUNEND; } SPEC_PRIn_N_CODE(2) SPEC_PRIn_N_CODE(3) SPEC_PRIn_N_CODE(4) SPEC_PRIn_N_CODE(5) SPEC_PRIn_N_CODE(6) SPEC_PRIn_N_CODE(7) SPEC_PRIn_N_CODE(8) SPEC_PRIn_N_CODE(9) SPEC_PRIn_N_CODE(10) SPEC_PRIn_N_CODE(11) SPEC_PRIn_N_CODE(12) \end{code} In code for revertible black holes with underlying @SPEC@ types. \begin{code} #if defined(PAR) || defined(GRAN) #define SPEC_RBH_PRIn_N_CODE(ptrs) \ STGFUN(CAT2(_PRIn_RBH_,ptrs)) \ { \ BitWord mbw; \ FUNBEGIN; \ GET_MARKED_PTRS(mbw,MStack,ptrs-1); \ if (++mbw < ptrs-1) { \ SET_MARKED_PTRS(MStack,ptrs-1,mbw); \ CONTINUE_MARKING_NODE("SRBH",mbw); \ MOVE_TO_NEXT_PTR(SPEC_RBH_CLOSURE_PTR,mbw); \ } else { \ SET_MARKED_PTRS(MStack,ptrs-1,0L); \ POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,ptrs-1); \ } \ FUNEND; \ } STGFUN(_PRIn_RBH_2) { FUNBEGIN; POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,1); FUNEND; } SPEC_RBH_PRIn_N_CODE(3) SPEC_RBH_PRIn_N_CODE(4) SPEC_RBH_PRIn_N_CODE(5) SPEC_RBH_PRIn_N_CODE(6) SPEC_RBH_PRIn_N_CODE(7) SPEC_RBH_PRIn_N_CODE(8) SPEC_RBH_PRIn_N_CODE(9) SPEC_RBH_PRIn_N_CODE(10) SPEC_RBH_PRIn_N_CODE(11) SPEC_RBH_PRIn_N_CODE(12) #endif \end{code} Foreign Objs are in the non-parallel world only. \begin{code} #ifndef PAR STGFUN(_PRStart_ForeignObj) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else INIT_MARK_NODE("ForeignObj ",0); JUMP_MARK_RETURN; FUNEND; } #endif /* !PAR */ \end{code} This defines the start code for generic (\tr{GEN}) closures. \begin{code} STGFUN(_PRStart_N) { W_ ptrs; FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } ptrs = GEN_CLOSURE_NoPTRS(Mark); INIT_MARK_NODE("GEN ",ptrs); if (ptrs == 0) { JUMP_MARK_RETURN; } else { INIT_MSTACK(GEN_CLOSURE_PTR); } FUNEND; } \end{code} Now the ``in'' code for \tr{GEN} closures. \begin{code} STGFUN(_PRIn_I) { W_ ptrs; BitWord pos; FUNBEGIN; ptrs = GEN_CLOSURE_NoPTRS(MStack); GET_GEN_MARKED_PTRS(pos,MStack,ptrs); if (++pos < ptrs) { SET_GEN_MARKED_PTRS(MStack,ptrs,pos); CONTINUE_MARKING_NODE("GEN",pos); MOVE_TO_NEXT_PTR(GEN_CLOSURE_PTR,pos); } else { SET_GEN_MARKED_PTRS(MStack,ptrs,0L); POP_MSTACK("GEN ",GEN_CLOSURE_PTR,ptrs); } FUNEND; } \end{code} And the start/in code for a revertible black hole with an underlying @GEN@ closure. \begin{code} #if defined(PAR) || defined(GRAN) STGFUN(_PRStart_RBH_N) { W_ ptrs; FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } /* * Get pointer count from original closure and adjust for one pointer * in the first two words of the RBH. */ ptrs = GEN_RBH_CLOSURE_NoPTRS(Mark); if (ptrs < 2) ptrs = 1; else ptrs--; INIT_MARK_NODE("GRBH", ptrs); INIT_MSTACK(GEN_RBH_CLOSURE_PTR); FUNEND; } STGFUN(_PRIn_RBH_I) { W_ ptrs; BitWord pos; FUNBEGIN; /* * Get pointer count from original closure and adjust for one pointer * in the first two words of the RBH. */ ptrs = GEN_RBH_CLOSURE_NoPTRS(MStack); if (ptrs < 2) ptrs = 1; else ptrs--; GET_GEN_MARKED_PTRS(pos, MStack, ptrs); if (++pos < ptrs) { SET_GEN_MARKED_PTRS(MStack, ptrs, pos); CONTINUE_MARKING_NODE("GRBH", pos); MOVE_TO_NEXT_PTR(GEN_RBH_CLOSURE_PTR, pos); } else { SET_GEN_MARKED_PTRS(MStack, ptrs, 0L); POP_MSTACK("GRBH", GEN_RBH_CLOSURE_PTR, ptrs); } FUNEND; } #endif \end{code} Start code for dynamic (\tr{DYN}) closures. There is no \tr{DYN} closure with 0 pointers -- \tr{DATA} is used instead. \begin{code} STGFUN(_PRStart_Dyn) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("DYN ", DYN_CLOSURE_NoPTRS(Mark)); INIT_MSTACK(DYN_CLOSURE_PTR); } FUNEND; } \end{code} and the corresponding ``in'' code. \begin{code} STGFUN(_PRIn_I_Dyn) { W_ ptrs; BitWord pos; FUNBEGIN; ptrs = DYN_CLOSURE_NoPTRS(MStack); GET_GEN_MARKED_PTRS(pos,MStack,ptrs); if (++pos < ptrs) { SET_GEN_MARKED_PTRS(MStack,ptrs,pos); CONTINUE_MARKING_NODE("DYN",pos); MOVE_TO_NEXT_PTR(DYN_CLOSURE_PTR,pos); } else { SET_GEN_MARKED_PTRS(MStack,ptrs,0L); POP_MSTACK("DYN ",DYN_CLOSURE_PTR,ptrs); } FUNEND; } \end{code} The start code for \tr{TUPLE} (all-pointer) objects. There can be no such object without any pointers, so we don't check for this case. \begin{code} STGFUN(_PRStart_Tuple) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("TUPL", TUPLE_CLOSURE_NoPTRS(Mark)); INIT_MSTACK(TUPLE_CLOSURE_PTR); } FUNEND; } \end{code} Now the ``in'' case. \begin{code} STGFUN(_PRIn_I_Tuple) { W_ ptrs; BitWord pos; FUNBEGIN; ptrs = TUPLE_CLOSURE_NoPTRS(MStack); GET_GEN_MARKED_PTRS(pos,MStack,ptrs); if (++pos < ptrs) { SET_GEN_MARKED_PTRS(MStack,ptrs,pos); CONTINUE_MARKING_NODE("TUPL",pos); MOVE_TO_NEXT_PTR(TUPLE_CLOSURE_PTR,pos); } else { SET_GEN_MARKED_PTRS(MStack,ptrs,0L); POP_MSTACK("TUPL",TUPLE_CLOSURE_PTR,ptrs); } FUNEND; } \end{code} \begin{code} /*** MUTUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/ /* Only if special GC treatment required */ #ifdef GC_MUT_REQUIRED STGFUN(_PRStart_MuTuple) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("MUT ", MUTUPLE_CLOSURE_NoPTRS(Mark)); INIT_MSTACK(MUTUPLE_CLOSURE_PTR); } FUNEND; } STGFUN(_PRIn_I_MuTuple) { W_ ptrs; BitWord pos; FUNBEGIN; ptrs = MUTUPLE_CLOSURE_NoPTRS(MStack); GET_GEN_MARKED_PTRS(pos,MStack,ptrs); if (++pos < ptrs) { SET_GEN_MARKED_PTRS(MStack,ptrs,pos); CONTINUE_MARKING_NODE("MUT",pos); MOVE_TO_NEXT_PTR(MUTUPLE_CLOSURE_PTR,pos); } else { SET_GEN_MARKED_PTRS(MStack,ptrs,0L); POP_MSTACK("MUT ",MUTUPLE_CLOSURE_PTR,ptrs); } FUNEND; } #endif /* GCap || GCgn */ \end{code} There are no pointers in a \tr{DATA} closure, so just mark the closure and return. \begin{code} STGFUN(_PRStart_Data) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else INIT_MARK_NODE("DATA", 0); JUMP_MARK_RETURN; FUNEND; } \end{code} %**************************************************************************** % \subsubsection[mark-specials]{Special cases} % %**************************************************************************** Black hole closures simply mark themselves and return. \begin{code} STGFUN(_PRStart_BH) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else INIT_MARK_NODE("BH ", 0); JUMP_MARK_RETURN; FUNEND; } \end{code} Marking a Static Closure -- Just return as if Marked \begin{code} STGFUN(_PRStart_Static) { FUNBEGIN; DEBUG_PR_STAT; JUMP_MARK_RETURN; FUNEND; } \end{code} Marking an Indirection -- Set Mark to ind addr and mark this. Updating of reference when we return will short indirection. \begin{code} STGFUN(_PRStart_Ind) { FUNBEGIN; DEBUG_PR_IND; GC_SHORT_IND(); /* ticky: record that we shorted an indirection */ Mark = (P_) IND_CLOSURE_PTR(Mark); JUMP_MARK; FUNEND; } \end{code} ``Permanent indirection''---used in profiling. Works basically like @_PRStart_1@ (one pointer). \begin{code} #if defined(PROFILING) || defined(TICKY_TICKY) STGFUN(_PRStart_PI) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("PI ",1); /* the "1" above is dodgy (i.e. wrong), but it is never used except in debugging info. ToDo??? WDP 95/07 */ INIT_MSTACK(PERM_IND_CLOSURE_PTR); } FUNEND; } STGFUN(_PRIn_PI) { FUNBEGIN; POP_MSTACK("PI ",PERM_IND_CLOSURE_PTR,1); /* the "1" above is dodgy (i.e. wrong), but it is never used except in debugging info. ToDo??? WDP 95/07 */ FUNEND; } #endif /* PROFILING or TICKY */ \end{code} Marking a ``selector closure'': This is a size-2 SPEC thunk that selects word $n$; if the thunk's pointee is evaluated, then we short out the selection, {\em just like an indirection}. If it is still unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}. {\em Should we select ``on the way down'' (in \tr{_PRStart_Selector}) or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on the way down. Downside: we are flummoxed by indirections, so we'll have to wait until the {\em next} major GC to do the selections (after the indirections are shorted out in this GC). But the downside of doing selections on the way back up is that we are then in a world of reversed pointers, and selecting a reversed pointer---we've see this on selectors for very recursive structures---is a total disaster. (WDP 94/12) \begin{code} #if defined(DEBUG) #define IF_GC_DEBUG(x) x #else #define IF_GC_DEBUG(x) /*nothing*/ #endif #if !defined(CONCURRENT) # define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling) #else # define NOT_BLACKHOLING 0 #endif /* _PRStartSelector_ is a (very) glorified _PRStart_1 */ #define MARK_SELECTOR(n) \ STGFUN(CAT2(_PRStartSelector_,n)) \ { \ P_ maybe_con; \ FUNBEGIN; \ \ /* must be a SPEC 2 1 closure */ \ ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \ ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \ ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \ \ if (IS_MARK_BIT_SET(Mark)) { /* already marked */ \ DEBUG_PR_MARKED; \ JUMP_MARK_RETURN; \ } \ \ maybe_con = (P_) *(Mark + _FHS); \ \ IF_GC_DEBUG( \ if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) { \ fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \ (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \ INFO_NoPTRS(INFO_PTR(Mark)), \ maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \ INFO_PTR(maybe_con)); \ fprintf(stderr, ", tag %ld, size %ld, ptrs %ld", \ INFO_TAG(INFO_PTR(maybe_con)), \ INFO_SIZE(INFO_PTR(maybe_con)), \ INFO_NoPTRS(INFO_PTR(maybe_con))); \ if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \ fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \ } \ fprintf(stderr, "\n"); \ } ) \ \ if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\ || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \ || INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ \ || NOT_BLACKHOLING /* see "price of laziness" paper */ \ || (! RTSflags.GcFlags.doSelectorsAtGC )) \ /* see below for OLD test we used here (WDP 95/04) */ \ /* ToDo: decide WHNFness another way? */ \ JMP_(_PRStart_1); \ \ /* some things should be true about the pointee */ \ ASSERT(INFO_TAG(INFO_PTR(maybe_con)) == 0); \ /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \ \ /* OK, it is evaluated: behave just like an indirection */ \ GC_SEL_MAJOR(); /* ticky-ticky */ \ \ Mark = (P_) (maybe_con[_FHS + (n)]); \ /* Mark now has the result of the selection */ \ JUMP_MARK; \ \ FUNEND; \ } #if 0 /* OLD test: the IS_STATIC test was to protect the IS_MARK_BIT_SET check; but the IS_MARK_BIT_SET test was only there to avoid mangled pointers, but we cannot have mangled pointers anymore (after RTBLs came our way). SUMMARY: we toss both of the "guard" tests. */ if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */ || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */ #endif /* 0 */ MARK_SELECTOR(0) MARK_SELECTOR(1) MARK_SELECTOR(2) MARK_SELECTOR(3) MARK_SELECTOR(4) MARK_SELECTOR(5) MARK_SELECTOR(6) MARK_SELECTOR(7) MARK_SELECTOR(8) MARK_SELECTOR(9) MARK_SELECTOR(10) MARK_SELECTOR(11) MARK_SELECTOR(12) #undef IF_GC_DEBUG /* get rid of it */ \end{code} Marking a Constant Closure -- Set Mark to corresponding static closure. Updating of reference will redirect reference to the static closure. \begin{code} STGFUN(_PRStart_Const) { FUNBEGIN; DEBUG_PR_CONST; #ifndef TICKY_TICKY /* normal stuff */ Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark)); #else /* TICKY */ if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else { if (!AllFlags.doUpdEntryCounts) { GC_COMMON_CONST(); /* ticky */ Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark)); } else { /* no commoning */ INIT_MARK_NODE("CONST ",0); } } #endif /* TICKY */ JUMP_MARK_RETURN; FUNEND; } \end{code} Marking a CharLike Closure -- Set Mark to corresponding static closure. Updating of reference will redirect reference to the static closure. \begin{code} STGFUN(_PRStart_CharLike) { #ifdef TICKY_TICKY I_ val; #endif FUNBEGIN; DEBUG_PR_CHARLIKE; #ifndef TICKY_TICKY /* normal stuff */ Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark)); #else /* TICKY */ if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else { val = CHARLIKE_VALUE(Mark); if (!AllFlags.doUpdEntryCounts) { GC_COMMON_CHARLIKE(); /* ticky */ INFO_PTR(Mark) = (W_) Ind_info; IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val); Mark = (P_) IND_CLOSURE_PTR(Mark); } else { /* no commoning */ INIT_MARK_NODE("CHAR ",0); } } #endif /* TICKY */ JUMP_MARK_RETURN; FUNEND; } \end{code} Marking an IntLike Closure -- Set Mark to corresponding static closure if in range. Updating of reference to this will redirect reference to the static closure. \begin{code} STGFUN(_PRStart_IntLike) { I_ val; FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else { val = INTLIKE_VALUE(Mark); if (val >= MIN_INTLIKE && val <= MAX_INTLIKE #ifdef TICKY_TICKY && !AllFlags.doUpdEntryCounts #endif ) { DEBUG_PR_INTLIKE_TO_STATIC; GC_COMMON_INTLIKE(); /* ticky */ INFO_PTR(Mark) = (W_) Ind_info; IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val); Mark = (P_) IND_CLOSURE_PTR(Mark); } else { /* out of range of static closures */ DEBUG_PR_INTLIKE_IN_HEAP; #ifdef TICKY_TICKY if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL(); #endif INIT_MARK_NODE("INT ",0); } } JUMP_MARK_RETURN; FUNEND; } \end{code} Special error routine, used for closures which should never call their ``in'' code. \begin{code} STGFUN(_PRIn_Error) { FUNBEGIN; fprintf(stderr,"Called _PRIn_Error\nShould never occur!\n"); abort(); FUNEND; } \end{code} %**************************************************************************** % \subsubsection[mark-fetchme]{Marking FetchMe Objects (parallel only)} % %**************************************************************************** \begin{code} #ifdef PAR \end{code} FetchMe's present a unique problem during global GC. Since the IMU short-circuits indirections during its evacuation, it may return a PLC as the new global address for a @FetchMe@ node. This has the effect of turning the @FetchMe@ into an indirection during local garbage collection. Of course, we'd like to short-circuit this indirection immediately. \begin{code} STGFUN(_PRStart_FetchMe) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else INIT_MARK_NODE("FME ", 0); JUMP_MARK_RETURN; FUNEND; } STGFUN(_PRStart_BF) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("BF ", BF_CLOSURE_NoPTRS(dummy)); INIT_MSTACK(BF_CLOSURE_PTR); } FUNEND; } STGFUN(_PRIn_BF) { BitWord mbw; FUNBEGIN; GET_MARKED_PTRS(mbw, MStack, BF_CLOSURE_NoPTRS(dummy)); if (++mbw < BF_CLOSURE_NoPTRS(dummy)) { SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), mbw); CONTINUE_MARKING_NODE("BF ", mbw); MOVE_TO_NEXT_PTR(BF_CLOSURE_PTR, mbw); } else { SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), 0L); POP_MSTACK("BF ", BF_CLOSURE_PTR, BF_CLOSURE_NoPTRS(dummy)); } FUNEND; } #endif /* PAR */ \end{code} %**************************************************************************** % \subsubsection[mark-tso]{Marking Thread State Objects (threaded only)} % %**************************************************************************** First mark the link, then mark all live registers (StkO plus the VanillaRegs indicated by Liveness). CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD! \begin{code} #ifdef CONCURRENT STGFUN(_PRStart_BQ) { FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("BQ ", BQ_CLOSURE_NoPTRS(Mark)); INIT_MSTACK(BQ_CLOSURE_PTR); } FUNEND; } STGFUN(_PRIn_BQ) { FUNBEGIN; POP_MSTACK("BQ ",BQ_CLOSURE_PTR,1); FUNEND; } STGFUN(_PRStart_TSO) { P_ temp; FUNBEGIN; if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("TSO ", 0); temp = TSO_LINK(Mark); TSO_LINK(Mark) = MStack; MStack = Mark; Mark = temp; JUMP_MARK; } FUNEND; } \end{code} When we're in the TSO, pos 0 is the link, 1 is the StkO, and 2-10 correspond to the vanilla registers r[pos-2]. \begin{code} STGFUN(_PRIn_TSO) { W_ liveness; BitWord oldpos, newpos; STGRegisterTable *r; P_ temp, mstack; FUNBEGIN; GET_MARKED_PTRS(oldpos,MStack,TSO_PTRS); r = TSO_INTERNAL_PTR(MStack); switch(oldpos) { case 0: /* Just did the link; now do the StkO */ SET_MARKED_PTRS(MStack,TSO_PTRS,1L); temp = r->rStkO; r->rStkO = TSO_LINK(MStack); TSO_LINK(MStack) = Mark; Mark = temp; DEBUG_PRIN("TSO ", 1); JUMP_MARK; break; case 1: /* Just did the StkO; just update it, saving the old mstack */ mstack = r->rStkO; r->rStkO = Mark; break; default: /* update the register we just did; save the old mstack */ mstack = r->rR[oldpos - 2].p; r->rR[oldpos - 2] = Mark; break; } /* liveness of the remaining registers */ liveness = r->rLiveness >> (oldpos - 1); if (liveness == 0) { /* Restore MStack and return */ SET_MARKED_PTRS(MStack,TSO_PTRS,0L); DEBUG_PRLAST("TSO ", oldpos); Mark = MStack; MStack = mstack; JUMP_MARK_RETURN; } /* More to do in this TSO */ /* Shift past non-ptr registers */ for(newpos = oldpos + 1; (liveness & 1) == 0; liveness >>= 1) { newpos++; } /* Mark the next one */ SET_MARKED_PTRS(MStack,TSO_PTRS,newpos); Mark = r->rR[newpos - 2].p; r->rR[newpos - 2].p = mstack; DEBUG_PRIN("TSO ", oldpos); JUMP_MARK; FUNEND; } \end{code} %**************************************************************************** % \subsubsection[mark-stko]{Marking Stack Objects (threaded only)} % %**************************************************************************** First mark the A stack, then mark all updatees in the B stack. \begin{code} STGFUN(_PRStart_StkO) { P_ temp; I_ size; I_ cts_size; FUNBEGIN; /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */ if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { INIT_MARK_NODE("STKO", 0); size = STKO_CLOSURE_SIZE(Mark); cts_size = STKO_CLOSURE_CTS_SIZE(Mark); SET_GEN_MARKED_PTRS(Mark,size,(BitWord)(cts_size + 1)); temp = STKO_LINK(Mark); STKO_LINK(Mark) = MStack; MStack = Mark; Mark = temp; JUMP_MARK; } FUNEND; } \end{code} Now the ``in'' code for \tr{STKO} closures. First the A stack is flushed, then we chain down the update frames in the B stack, marking the update nodes. When all have been marked we pop the stack and return. \begin{code} STGFUN(_PRIn_StkO) { BitWord oldpos, newpos; P_ mstack; I_ size; FUNBEGIN; size = STKO_CLOSURE_SIZE(MStack); GET_GEN_MARKED_PTRS(oldpos, MStack, size); if (oldpos > STKO_CLOSURE_CTS_SIZE(MStack)) { /* Update the link, saving the old mstack */ mstack = STKO_LINK(MStack); STKO_LINK(MStack) = Mark; } else { /* Update the pointer, saving the old mstack */ mstack = (P_) STKO_CLOSURE_PTR(MStack, oldpos); STKO_CLOSURE_PTR(MStack, oldpos) = (W_) Mark; } /* Calculate the next position to mark */ if (oldpos > STKO_SpA_OFFSET(MStack)) { /* Just walk backwards down the A stack */ newpos = oldpos - 1; SET_GEN_MARKED_PTRS(MStack,size,newpos); Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos); STKO_CLOSURE_PTR(MStack, newpos) = (W_) mstack; DEBUG_PRIN("STKA", oldpos); JUMP_MARK; } else if (oldpos <= STKO_SuB_OFFSET(MStack)) { /* We're looking at an updatee in the B stack; find the next SuB up the chain */ P_ subptr; subptr = GRAB_SuB(STKO_CLOSURE_ADDR(MStack, oldpos - BREL(UF_UPDATEE))); newpos = STKO_CLOSURE_OFFSET(MStack,subptr); } else { /* Just fell off the end of the A stack; grab the first SuB */ newpos = STKO_SuB_OFFSET(MStack); } if (newpos == 0) { /* Grrr... newpos is 1-based */ /* Restore MStack and return */ SET_GEN_MARKED_PTRS(MStack,size,0L); DEBUG_PRLAST("STKO", oldpos); Mark = MStack; MStack = mstack; JUMP_MARK_RETURN; } /* newpos is actually the SuB; we want the corresponding updatee */ SET_GEN_MARKED_PTRS(MStack,size,newpos + BREL(UF_UPDATEE)); Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE)); STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE)) = (W_) mstack; DEBUG_PRIN("STKB", oldpos); JUMP_MARK; FUNEND; } #endif /* CONCURRENT */ \end{code} %**************************************************************************** % \subsubsection[mark-caf]{Marking CAFs} % %**************************************************************************** A CAF is shorted out as if it were an indirection. The CAF reference is explicitly updated by the garbage collector. \begin{code} STGFUN(_PRStart_Caf) { FUNBEGIN; DEBUG_PR_CAF; GC_SHORT_CAF(); /* ticky */ Mark = (P_) IND_CLOSURE_PTR(Mark); JUMP_MARK; FUNEND; } \end{code} %**************************************************************************** % \subsection[mark-root]{Root Marking Code} % %**************************************************************************** Used by \tr{SMmarking.lc} -- but needs to be in \tr{.lhc} file. These are routines placed in closures at the bottom of the marking stack \begin{code} STGFUN(_Dummy_PRReturn_entry) { FUNBEGIN; fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n"); abort(); FUNEND; } /* various ways to call _Dummy_PRReturn_entry: */ INTFUN(_PRMarking_MarkNextRoot_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } #ifdef CONCURRENT INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } #endif #ifdef PAR INTFUN(_PRMarking_MarkNextGA_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } #endif # if 1 /* !defined(CONCURRENT) */ /* HWL */ INTFUN(_PRMarking_MarkNextAStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } INTFUN(_PRMarking_MarkNextBStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } # endif INTFUN(_PRMarking_MarkNextCAF_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } #if defined(GRAN) INTFUN(_PRMarking_MarkNextEvent_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } INTFUN(_PRMarking_MarkNextClosureInFetchBuffer_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } #endif /* end of various ways to call _Dummy_PRReturn_entry */ EXTFUN(_PRMarking_MarkNextRoot); EXTFUN(_PRMarking_MarkNextCAF); #ifdef CONCURRENT EXTFUN(_PRMarking_MarkNextSpark); #endif #ifdef PAR EXTFUN(_PRMarking_MarkNextGA); #else # if 1 /* !defined(CONCURRENT) */ /* HWL */ EXTFUN(_PRMarking_MarkNextAStack); EXTFUN(_PRMarking_MarkNextBStack); # endif #endif /* not parallel */ CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN") /* just one, shared */ DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure, _PRMarking_MarkNextRoot_info, _PRMarking_MarkNextRoot, _PRMarking_MarkNextRoot_entry); #ifdef CONCURRENT DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure, _PRMarking_MarkNextSpark_info, _PRMarking_MarkNextSpark, _PRMarking_MarkNextSpark_entry); #endif #if defined(GRAN) DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextEvent_closure, _PRMarking_MarkNextEvent_info, _PRMarking_MarkNextEvent, _PRMarking_MarkNextEvent_entry); DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextClosureInFetchBuffer_closure, _PRMarking_MarkNextClosureInFetchBuffer_info, _PRMarking_MarkNextClosureInFetchBuffer, _PRMarking_MarkNextClosureInFetchBuffer_entry); #endif #ifdef PAR DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure, _PRMarking_MarkNextGA_info, _PRMarking_MarkNextGA, _PRMarking_MarkNextGA_entry); #else # if 1 /* !defined(CONCURRENT) */ /* HWL */ DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure, _PRMarking_MarkNextAStack_info, _PRMarking_MarkNextAStack, _PRMarking_MarkNextAStack_entry); DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure, _PRMarking_MarkNextBStack_info, _PRMarking_MarkNextBStack, _PRMarking_MarkNextBStack_entry); # endif #endif /* PAR */ DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure, _PRMarking_MarkNextCAF_info, _PRMarking_MarkNextCAF, _PRMarking_MarkNextCAF_entry); extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */ STGFUN(_PRMarking_MarkNextRoot) { FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = (W_) Mark; /* Is the next off the end */ if (++MRoot >= sm_roots_end) RESUME_(miniInterpretEnd); Mark = (P_) *MRoot; JUMP_MARK; FUNEND; } #if defined(CONCURRENT) # if !defined(GRAN) extern P_ sm_roots_end; /* PendingSparksTl[pool] */ STGFUN(_PRMarking_MarkNextSpark) { FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = (W_) Mark; /* Is the next off the end */ if (++MRoot >= sm_roots_end) RESUME_(miniInterpretEnd); Mark = (P_) *MRoot; JUMP_MARK; FUNEND; } #else /* GRAN */ STGFUN(_PRMarking_MarkNextSpark) { /* This is more similar to MarkNextGA than to the MarkNextSpark in concurrent-but-not-gran land NB: MRoot is a spark (with an embedded pointer to a closure) */ FUNBEGIN; /* Update root -- may have short circuited Ind */ SPARK_NODE( ((sparkq) MRoot) ) = Mark; MRoot = (P_) SPARK_NEXT( ((sparkq) MRoot) ); /* Is the next off the end */ if (MRoot == NULL) RESUME_(miniInterpretEnd); Mark = (P_) SPARK_NODE( ((sparkq) MRoot) ); JUMP_MARK; FUNEND; } #endif /* GRAN */ #endif /* CONCURRENT */ \end{code} Note: Events are GranSim-only. Marking events is similar to marking GALA entries in parallel-land. The major difference is that depending on the type of the event we have to mark different field of the event (possibly several fields). Even worse, in the case of bulk fetching (@RTSflags.GranFlags.DoGUMMFetching@) we find a buffer of pointers to closures we have to mark (similar to sparks in concurrent-but-not-gransim setup). \begin{code} #if defined(GRAN) STGFUN(_PRMarking_MarkNextEvent) { rtsBool found = rtsFalse; FUNBEGIN; /* First update the right component of the old event */ switch (EVENT_TYPE( ((eventq) MRoot) )) { case CONTINUETHREAD: case STARTTHREAD: case RESUMETHREAD: case MOVETHREAD: EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark; break; case MOVESPARK: SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) )) = (P_) Mark; break; case FETCHNODE: switch (EVENT_GC_INFO( ((eventq) MRoot) )) { case 0: EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark; EVENT_GC_INFO( ((eventq) MRoot) ) = 1; Mark = (P_) EVENT_NODE( ((eventq) MRoot) ); JUMP_MARK; break; case 1: EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark; EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */ break; default: fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n", ((eventq) MRoot) ); EXIT(EXIT_FAILURE); } break; case FETCHREPLY: switch (EVENT_GC_INFO( ((eventq) MRoot) )) { case 0: EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark; EVENT_GC_INFO( ((eventq) MRoot) ) = 1; /* 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 ) { P_ buffer = (P_) EVENT_NODE( ((eventq) MRoot) ); int size = (int) buffer[PACK_SIZE_LOCN]; /* was: for (i = PACK_HDR_SIZE; i <= size-1; i++) ... */ sm_roots_end = buffer + PACK_HDR_SIZE + size; MRoot = (P_) buffer + PACK_HDR_SIZE; ret_MRoot = MRoot; Mark = (P_) *MRoot; ret_Mark = Mark; MStack = (P_) _PRMarking_MarkNextClosureInFetchBuffer_closure; JUMP_MARK; } else { Mark = (P_) EVENT_NODE( ((eventq) MRoot) ); JUMP_MARK; } break; case 1: if ( RTSflags.GranFlags.DoGUMMFetching ) { /* no update necessary; fetch buffers are malloced */ } else { EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark; } EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */ break; default: fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHREPLY event @ %#x\n", ((eventq) MRoot) ); EXIT(EXIT_FAILURE); } break; case GLOBALBLOCK: switch (EVENT_GC_INFO( ((eventq) MRoot) )) { case 0: EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark; EVENT_GC_INFO( ((eventq) MRoot) ) = 1; Mark = (P_) EVENT_NODE( ((eventq) MRoot) ); JUMP_MARK; break; break; case 1: EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark; EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */ break; default: fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of GLOBALBLOCK event @ %#x\n", ((eventq) MRoot) ); EXIT(EXIT_FAILURE); } break; case UNBLOCKTHREAD: EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark; break; case FINDWORK: break; default: fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n", ((eventq) MRoot) ); EXIT(EXIT_FAILURE); } do { MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) ); /* Is the next off the end */ if (MRoot == NULL) RESUME_(miniInterpretEnd); switch (EVENT_TYPE( ((eventq) MRoot) )) { case CONTINUETHREAD: case STARTTHREAD: case RESUMETHREAD: case MOVETHREAD: EVENT_GC_INFO( ((eventq) MRoot) ) = 0; Mark = (P_) EVENT_TSO( ((eventq) MRoot) ); found = rtsTrue; break; case MOVESPARK: EVENT_GC_INFO( ((eventq) MRoot) ) = 0; Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) )); found = rtsTrue; break; case FETCHNODE: EVENT_GC_INFO( ((eventq) MRoot) ) = 0; Mark = (P_) EVENT_TSO( ((eventq) MRoot) ); found = rtsTrue; break; case FETCHREPLY: EVENT_GC_INFO( ((eventq) MRoot) ) = 0; Mark = (P_) EVENT_TSO( ((eventq) MRoot) ); found = rtsTrue; break; case GLOBALBLOCK: EVENT_GC_INFO( ((eventq) MRoot) ) = 0; Mark = (P_) EVENT_TSO( ((eventq) MRoot) ); found = rtsTrue; break; case UNBLOCKTHREAD: Mark = (P_) EVENT_TSO( ((eventq) MRoot) ); found = rtsTrue; break; case FINDWORK: found = rtsFalse; break; default: fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n", EVENT_TYPE( ((eventq) MRoot) ), MRoot); EXIT(EXIT_FAILURE); } } while (!found && MRoot!=NULL); JUMP_MARK; FUNEND; } STGFUN(_PRMarking_MarkNextClosureInFetchBuffer) { FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = Mark; /* Is the next off the end */ if (++MRoot >= sm_roots_end) { /* We know that marking a fetch buffer is only called from within marking a FETCHREPLY event; we have saved the important registers before that */ MRoot = ret_MRoot; Mark = ret_Mark; MStack = (P_) _PRMarking_MarkNextEvent_closure; JUMP_MARK; } Mark = *MRoot; JUMP_MARK; FUNEND; } #endif #ifdef PAR STGFUN(_PRMarking_MarkNextGA) { FUNBEGIN; /* Update root -- may have short circuited Ind */ ((GALA *)MRoot)->la = Mark; do { MRoot = (P_) ((GALA *) MRoot)->next; } while (MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT); /* Is the next off the end */ if (MRoot == NULL) RESUME_(miniInterpretEnd); Mark = ((GALA *)MRoot)->la; JUMP_MARK; FUNEND; } #else STGFUN(_PRMarking_MarkNextAStack) { FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = (W_) Mark; /* Is the next off the end */ if (SUBTRACT_A_STK( (PP_) ++MRoot, stackInfo.botA) < 0) RESUME_(miniInterpretEnd); Mark = (P_) *MRoot; JUMP_MARK; FUNEND; } STGFUN(_PRMarking_MarkNextBStack) { FUNBEGIN; /* Update root -- may have short circuited Ind */ PUSH_UPDATEE(MRoot, Mark); MRoot = GRAB_SuB(MRoot); /* Is the next off the end */ if (SUBTRACT_B_STK(MRoot, stackInfo.botB) < 0) RESUME_(miniInterpretEnd); Mark = GRAB_UPDATEE(MRoot); JUMP_MARK; FUNEND; } #endif /* PAR */ \end{code} Mark the next CAF in the CAF list. \begin{code} STGFUN(_PRMarking_MarkNextCAF) { FUNBEGIN; /* Update root -- may have short circuited Ind */ IND_CLOSURE_PTR(MRoot) = (W_) Mark; MRoot = (P_) IND_CLOSURE_LINK(MRoot); /* Is the next CAF the end of the list */ if (MRoot == 0) RESUME_(miniInterpretEnd); GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */ Mark = (P_) IND_CLOSURE_PTR(MRoot); JUMP_MARK; FUNEND; } \end{code} Multi-slurp protection. \begin{code} #endif /* _INFO_MARKING */ \end{code}