1 %****************************************************************************
3 \section[SMmark.lhc]{Pointer-Reversing Mark code}
5 % (c) P. Sansom, K. Hammond, OBFUSCATION-THROUGH-GRATUITOUS-PREPROCESSOR-ABUSE
6 % Project, Glasgow University, January 26th 1993.
8 %****************************************************************************
10 This module contains the specialised and generic code to perform
11 pointer reversal marking. These routines are placed in the info
12 tables of the appropriate closures.
14 Some of the dirt is hidden in macros defined in SMmarkDefs.lh.
16 %****************************************************************************
18 \subsection[mark-overview]{Overview of Marking}
20 %****************************************************************************
22 This module uses a pointer-reversal algorithm to mark a closure.
23 To mark a closure, first set a bit indicating that the closure
24 has been marked, then mark each pointer in the closure. The mark
25 bit is used to determine whether a node has already been
26 marked before we mark it. Because we set the bit before marking
27 the children of a node, this avoids cycles.
29 Given a closure containing a number of pointers, $n$, $n > 0$ the mark
30 code for that closure can be divided into three parts:
33 The mark (or ``start'') code for the closure. Called when an attempt is made
34 to mark the closure, it initialises the mark position in the
35 closure, then jumps to the mark code for the first pointer.
37 The return (or ``in'') code for the closure. Called when a closure is
38 returned to after a child is marked, it increments the mark position
39 and jumps to the mark entry for the next pointer
41 The last (or ``in-last'') code for the closure. Called when all children
42 have been marked, it just returns to its parent through the appropriate
46 For non-\tr{SPEC} closures, the return and last codes are merged in most
47 cases, so the return code checks explicitly whether all pointers have
48 been marked, and returns if so.
50 %****************************************************************************
52 \subsubsection[mark-registers]{Registers used when marking}
54 %****************************************************************************
56 Two registers are used:
59 Points to the closure being marked.
61 Points to the closure on the top of the marking stack.
62 The first closure on the stack contains the continuation to
63 enter when marking is complete.
66 The following registers are used by Pointer Reversal Marking:
70 The top of the mark stack.
72 The node being processed.
74 The bit array (what's that? KH) to mark.
76 The base of the heap (to calculate bit to mark).
78 The limit of the heap. For generational garbage collection,
79 only closures whose address is $<$ @HeapLim@ will be marked
82 To answer KH's question, the @BitArray@ is used to store marks. This
83 avoids the need to include space for a mark bit in the closure itself.
84 The array consists of one bit per word of heap memory that is handled
85 by the compacting collector or the old generation in the generational
88 %****************************************************************************
90 \subsubsection[mark-conventions]{Calling and Return Conventions}
92 %****************************************************************************
94 When a child closure is returned from, the registers have the following
99 points to the closure just marked (this may be updated with a new
100 address to short-circuit indirections).
102 points to the closure whose return code has been entered
103 (this closure is now at the top of the pointer-reversal marking stack).
106 The macros @JUMP_MARK@ and @JUMP_MARK_RETURN@ jump to the start code
107 pointed to by the @Mark@ register, or the return code pointed to by
108 the @MStack@ register respectively.
111 %%%% GOT THIS FAR -- KH %%%%
116 Retrieved using PRMARK_CODE(infoptr)
118 Uses pointer reversal marking to mark a closure which contains N ptrs.
119 If the closure has 0 pointers it sets it to a marked state and returns
120 to the closure on top of the PR mark stack (_PRStart_0).
122 If Not (@_PRStart_N@ ($N > 0$))
123 sets to a state of marking the first pointer
124 pushes this closure on the PR marking stack (in the first ptr location)
125 marks the first child -- enters its marking code
127 A closure that is already marked just indicates this by returning to the
128 closure on the top of the PR mark stack.
131 Mark -- points to the closure to mark
132 MStack -- points to the closure on the top of the PR marking stack
133 If the stack is empty it points to a closure which contains
134 the continuation to enter when marking is complete.
138 MStack set to a closure containing the continuation to be called when
139 the root has been marked.
140 Mark pointing to the closure
142 Entering MStack Continuation:
143 Mark points to new value of the closure (indirection short circut)
144 *** Update root being marked with this value.
147 Returning To A Closure Being Marked:
151 Retrieved using PRRETURN_CODE(infoptr)
153 Starts marking the next pointer (_PRIn_I).
154 updates the current poointer being marked with new Mark
155 sets state to next pointer
157 If not, (_PRInLast_N), it returns to the closure on the top of the PR
161 Mark -- points to the closure just marked (may be updated with new
162 address to short indirections)
163 MStack -- points to it -- the closure on the top of the PR marking stack
167 The following registers are used by Pointer Reversal Marking:
169 MStack -- The MarkStack register
170 Mark -- Points to the Node being processed
171 BitArray -- The bit array to mark
172 HeapBase -- The base of the heap (to calculate bit to mark)
173 HeapLim -- The limit of the heap
174 -- For gen gc: only closures < HeapLim will be marked
175 -- OldRoots pointing < HeapLim
177 \input{SMmarkDefs.lh}
179 %****************************************************************************
181 \subsection[mark-code]{The actual Marking Code}
183 %****************************************************************************
185 This code is only used if @_INFO_MARKING@ is defined.
188 #if defined(_INFO_MARKING)
191 First the necessary forward declarations.
194 /* #define MARK_REG_MAP -- Must be done on command line for threaded code */
195 #include "SMinternal.h"
196 #include "SMmarkDefs.h"
199 Define appropriate variables as potential register variables.
200 Assume GC code saves and restores any global registers used.
203 RegisterTable MarkRegTable;
206 @_startMarkWorld@ restores registers if necessary, then marks the
207 root pointed to by @Mark@.
210 STGFUN(_startMarkWorld)
213 #if defined(__STG_GCC_REGS__) && defined(__GNUC__)
214 /* If using registers load from _SAVE (see SMmarking.lc) */
216 /* I deeply suspect this should be RESTORE_REGS(...) [WDP 95/02] */
218 MarkBaseReg = &MarkRegTable;
222 MStack = SAVE_MStack;
223 BitArray = SAVE_BitArray;
224 HeapBase = SAVE_HeapBase;
225 HeapLim = SAVE_HeapLim;
233 This is the pointer reversal start code for \tr{SPEC} closures with 0
240 if (IS_MARK_BIT_SET(Mark)) {
243 INIT_MARK_NODE("SPEC",0);
251 This macro defines the format of the pointer reversal start code for a
252 number of pointers \tr{ptrs}, $>$ 0.
256 #define SPEC_PRStart_N_CODE(ptrs) \
257 STGFUN(CAT2(_PRStart_,ptrs)) \
260 if (IS_MARK_BIT_SET(Mark)) { \
264 INIT_MARK_NODE("SPEC",ptrs); \
265 INIT_MSTACK(SPEC_CLOSURE_PTR); \
272 The definitions of the start code for \tr{SPEC} closures with 1-12
276 SPEC_PRStart_N_CODE(1)
277 SPEC_PRStart_N_CODE(2)
278 SPEC_PRStart_N_CODE(3)
279 SPEC_PRStart_N_CODE(4)
280 SPEC_PRStart_N_CODE(5)
281 SPEC_PRStart_N_CODE(6)
282 SPEC_PRStart_N_CODE(7)
283 SPEC_PRStart_N_CODE(8)
284 SPEC_PRStart_N_CODE(9)
285 SPEC_PRStart_N_CODE(10)
286 SPEC_PRStart_N_CODE(11)
287 SPEC_PRStart_N_CODE(12)
291 Start code for revertible black holes with underlying @SPEC@ types.
296 #define SPEC_RBH_PRStart_N_CODE(ptrs) \
297 STGFUN(CAT2(_PRStart_RBH_,ptrs)) \
300 if (IS_MARK_BIT_SET(Mark)) { \
304 INIT_MARK_NODE("SRBH",ptrs-1); \
305 INIT_MSTACK(SPEC_RBH_CLOSURE_PTR); \
310 SPEC_RBH_PRStart_N_CODE(2)
311 SPEC_RBH_PRStart_N_CODE(3)
312 SPEC_RBH_PRStart_N_CODE(4)
313 SPEC_RBH_PRStart_N_CODE(5)
314 SPEC_RBH_PRStart_N_CODE(6)
315 SPEC_RBH_PRStart_N_CODE(7)
316 SPEC_RBH_PRStart_N_CODE(8)
317 SPEC_RBH_PRStart_N_CODE(9)
318 SPEC_RBH_PRStart_N_CODE(10)
319 SPEC_RBH_PRStart_N_CODE(11)
320 SPEC_RBH_PRStart_N_CODE(12)
326 @SPEC_PRIn_N_CODE@ has two different meanings, depending on the world
330 In the commoned-info-table world, it
331 defines the ``in'' code for a particular number
332 of pointers, and subsumes the functionality of @SPEC_PRInLast_N_NODE@ below.
334 Otherwise, it defines the ``in'' code for a particular pointer in a
340 #define SPEC_PRIn_N_CODE(ptrs) \
341 STGFUN(CAT2(_PRIn_,ptrs)) \
345 GET_MARKED_PTRS(mbw,MStack,ptrs); \
346 if (++mbw < ptrs) { \
347 SET_MARKED_PTRS(MStack,ptrs,mbw); \
348 CONTINUE_MARKING_NODE("SPEC",mbw); \
349 MOVE_TO_NEXT_PTR(SPEC_CLOSURE_PTR,mbw); \
351 SET_MARKED_PTRS(MStack,ptrs,0L); \
352 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,ptrs); \
359 Now @SPEC_PRIn_N_CODE@ is used to define the individual entries for \tr{SPEC} closures
366 fprintf(stderr,"Called _PRIn_0\nShould never occur!\n");
373 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,1);
389 In code for revertible black holes with underlying @SPEC@ types.
393 #define SPEC_RBH_PRIn_N_CODE(ptrs) \
394 STGFUN(CAT2(_PRIn_RBH_,ptrs)) \
398 GET_MARKED_PTRS(mbw,MStack,ptrs-1); \
399 if (++mbw < ptrs-1) { \
400 SET_MARKED_PTRS(MStack,ptrs-1,mbw); \
401 CONTINUE_MARKING_NODE("SRBH",mbw); \
402 MOVE_TO_NEXT_PTR(SPEC_RBH_CLOSURE_PTR,mbw); \
404 SET_MARKED_PTRS(MStack,ptrs-1,0L); \
405 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,ptrs-1); \
413 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,1);
417 SPEC_RBH_PRIn_N_CODE(3)
418 SPEC_RBH_PRIn_N_CODE(4)
419 SPEC_RBH_PRIn_N_CODE(5)
420 SPEC_RBH_PRIn_N_CODE(6)
421 SPEC_RBH_PRIn_N_CODE(7)
422 SPEC_RBH_PRIn_N_CODE(8)
423 SPEC_RBH_PRIn_N_CODE(9)
424 SPEC_RBH_PRIn_N_CODE(10)
425 SPEC_RBH_PRIn_N_CODE(11)
426 SPEC_RBH_PRIn_N_CODE(12)
431 Malloc Ptrs are in the sequential world only.
437 STGFUN(_PRStart_MallocPtr)
440 if (IS_MARK_BIT_SET(Mark)) {
443 INIT_MARK_NODE("MallocPtr ",0);
450 This defines the start code for generic (\tr{GEN}) closures.
459 if (IS_MARK_BIT_SET(Mark)) {
463 ptrs = GEN_CLOSURE_NoPTRS(Mark);
464 INIT_MARK_NODE("GEN ",ptrs);
468 INIT_MSTACK(GEN_CLOSURE_PTR);
474 Now the ``in'' code for \tr{GEN} closures.
484 ptrs = GEN_CLOSURE_NoPTRS(MStack);
485 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
488 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
489 CONTINUE_MARKING_NODE("GEN",pos);
490 MOVE_TO_NEXT_PTR(GEN_CLOSURE_PTR,pos);
492 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
493 POP_MSTACK("GEN ",GEN_CLOSURE_PTR,ptrs);
499 And the start/in code for a revertible black hole with an underlying @GEN@ closure.
505 STGFUN(_PRStart_RBH_N)
511 if (IS_MARK_BIT_SET(Mark)) {
517 * Get pointer count from original closure and adjust for one pointer
518 * in the first two words of the RBH.
520 ptrs = GEN_RBH_CLOSURE_NoPTRS(Mark);
526 INIT_MARK_NODE("GRBH", ptrs);
527 INIT_MSTACK(GEN_RBH_CLOSURE_PTR);
539 * Get pointer count from original closure and adjust for one pointer
540 * in the first two words of the RBH.
542 ptrs = GEN_RBH_CLOSURE_NoPTRS(MStack);
548 GET_GEN_MARKED_PTRS(pos, MStack, ptrs);
551 SET_GEN_MARKED_PTRS(MStack, ptrs, pos);
552 CONTINUE_MARKING_NODE("GRBH", pos);
553 MOVE_TO_NEXT_PTR(GEN_RBH_CLOSURE_PTR, pos);
555 SET_GEN_MARKED_PTRS(MStack, ptrs, 0L);
556 POP_MSTACK("GRBH", GEN_RBH_CLOSURE_PTR, ptrs);
565 Start code for dynamic (\tr{DYN}) closures. There is no \tr{DYN}
566 closure with 0 pointers -- \tr{DATA} is used instead.
572 if (IS_MARK_BIT_SET(Mark)) {
576 INIT_MARK_NODE("DYN ", DYN_CLOSURE_NoPTRS(Mark));
577 INIT_MSTACK(DYN_CLOSURE_PTR);
583 and the corresponding ``in'' code.
592 ptrs = DYN_CLOSURE_NoPTRS(MStack);
593 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
596 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
597 CONTINUE_MARKING_NODE("DYN",pos);
598 MOVE_TO_NEXT_PTR(DYN_CLOSURE_PTR,pos);
600 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
601 POP_MSTACK("DYN ",DYN_CLOSURE_PTR,ptrs);
608 The start code for \tr{TUPLE} (all-pointer) objects. There can be no
609 such object without any pointers, so we don't check for this case.
612 STGFUN(_PRStart_Tuple)
615 if (IS_MARK_BIT_SET(Mark)) {
619 INIT_MARK_NODE("TUPL", TUPLE_CLOSURE_NoPTRS(Mark));
620 INIT_MSTACK(TUPLE_CLOSURE_PTR);
629 STGFUN(_PRIn_I_Tuple)
635 ptrs = TUPLE_CLOSURE_NoPTRS(MStack);
636 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
639 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
640 CONTINUE_MARKING_NODE("TUPL",pos);
641 MOVE_TO_NEXT_PTR(TUPLE_CLOSURE_PTR,pos);
643 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
644 POP_MSTACK("TUPL",TUPLE_CLOSURE_PTR,ptrs);
652 /*** MUTUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
653 /* Only if special GC treatment required */
655 #ifdef GC_MUT_REQUIRED
657 STGFUN(_PRStart_MuTuple)
660 if (IS_MARK_BIT_SET(Mark)) {
664 INIT_MARK_NODE("MUT ", MUTUPLE_CLOSURE_NoPTRS(Mark));
665 INIT_MSTACK(MUTUPLE_CLOSURE_PTR);
670 STGFUN(_PRIn_I_MuTuple)
676 ptrs = MUTUPLE_CLOSURE_NoPTRS(MStack);
677 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
680 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
681 CONTINUE_MARKING_NODE("MUT",pos);
682 MOVE_TO_NEXT_PTR(MUTUPLE_CLOSURE_PTR,pos);
684 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
685 POP_MSTACK("MUT ",MUTUPLE_CLOSURE_PTR,ptrs);
690 #endif /* GCap || GCgn */
693 There are no pointers in a \tr{DATA} closure, so just mark the
697 STGFUN(_PRStart_Data)
700 if (IS_MARK_BIT_SET(Mark)) {
703 INIT_MARK_NODE("DATA", 0);
709 %****************************************************************************
711 \subsubsection[mark-specials]{Special cases}
713 %****************************************************************************
715 Black hole closures simply mark themselves and return.
721 if (IS_MARK_BIT_SET(Mark)) {
724 INIT_MARK_NODE("BH ", 0);
730 Marking a Static Closure -- Just return as if Marked
733 STGFUN(_PRStart_Static)
742 Marking an Indirection -- Set Mark to ind addr and mark this.
743 Updating of reference when we return will short indirection.
750 Mark = (P_) IND_CLOSURE_PTR(Mark);
756 ``Permanent indirection''---used in profiling. Works basically
757 like @_PRStart_1@ (one pointer).
759 #if defined(USE_COST_CENTRES)
763 /* This test would be here if it really was like a PRStart_1.
764 But maybe it is not needed because a PI cannot have two
765 things pointing at it (so no need to mark it), because
766 they are only created in exactly one place in UpdatePAP.
769 if (IS_MARK_BIT_SET(Mark)) {
774 INIT_MARK_NODE("PI ",1);
775 /* the "1" above is dodgy (i.e. wrong), but it is never
776 used except in debugging info. ToDo??? WDP 95/07
778 INIT_MSTACK(PERM_IND_CLOSURE_PTR);
785 POP_MSTACK("PI ",PERM_IND_CLOSURE_PTR,1);
786 /* the "1" above is dodgy (i.e. wrong), but it is never
787 used except in debugging info. ToDo??? WDP 95/07
794 Marking a ``selector closure'': This is a size-2 SPEC thunk that
795 selects word $n$; if the thunk's pointee is evaluated, then we short
796 out the selection, {\em just like an indirection}. If it is still
797 unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}.
799 {\em Should we select ``on the way down'' (in \tr{_PRStart_Selector})
800 or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on
801 the way down. Downside: we are flummoxed by indirections, so we'll
802 have to wait until the {\em next} major GC to do the selections (after
803 the indirections are sorted out in this GC). But the downside of
804 doing selections on the way back up is that we are then in a world of
805 reversed pointers, and selecting a reversed pointer---we've see this
806 on selectors for very recursive structures---is a total disaster.
810 #if defined(_GC_DEBUG)
811 #define IF_GC_DEBUG(x) x
813 #define IF_GC_DEBUG(x) /*nothing*/
816 /* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
820 #define MARK_SELECTOR(n) \
821 STGFUN(CAT2(_PRStartSelector_,n)) \
826 /* must be a SPEC 2 1 closure */ \
827 ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \
828 ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \
829 ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \
837 #define MARK_SELECTOR(n) \
838 STGFUN(CAT2(_PRStartSelector_,n)) \
843 /* must be a SPEC 2 1 closure */ \
844 ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \
845 ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \
846 ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \
848 if (IS_MARK_BIT_SET(Mark)) { /* already marked */ \
853 maybe_con = (P_) *(Mark + _FHS); \
856 if (SM_trace & 2) { \
857 fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, marked? 0x%%lx, info 0x%lx", \
858 (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \
859 INFO_NoPTRS(INFO_PTR(Mark)), \
860 maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \
861 INFO_PTR(maybe_con)); \
862 fprintf(stderr, ", tag %ld, size %ld, ptrs %ld", \
863 INFO_TAG(INFO_PTR(maybe_con)), \
864 INFO_SIZE(INFO_PTR(maybe_con)), \
865 INFO_NoPTRS(INFO_PTR(maybe_con))); \
866 if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \
868 /* for (i = 0; i < INFO_SIZE(INFO_PTR(maybe_con)); i++) { */ \
869 /* fprintf(stderr, ", 0x%lx", maybe_con[_FHS + i]); */ \
871 fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \
873 fprintf(stderr, "\n"); \
876 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
877 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \
878 || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */ \
879 /* see below for OLD test we used here (WDP 95/04) */ \
880 /* ToDo: decide WHNFness another way? */ \
883 /* some things should be true about the pointee */ \
884 ASSERT(INFO_TAG(INFO_PTR(maybe_con)) == 0); \
885 /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
887 /* OK, it is evaluated: behave just like an indirection */ \
889 Mark = (P_) (maybe_con[_FHS + (n)]); \
890 /* Mark now has the result of the selection */ \
898 the IS_STATIC test was to protect the IS_MARK_BIT_SET check;
899 but the IS_MARK_BIT_SET test was only there to avoid
900 mangled pointers, but we cannot have mangled pointers anymore
901 (after RTBLs came our way).
902 SUMMARY: we toss both of the "guard" tests.
904 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */
905 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */
906 || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */
923 #undef IF_GC_DEBUG /* get rid of it */
926 Marking a Constant Closure -- Set Mark to corresponding static
927 closure. Updating of reference will redirect reference to the static
931 STGFUN(_PRStart_Const)
935 Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
941 Marking a CharLike Closure -- Set Mark to corresponding static
942 closure. Updating of reference will redirect reference to the static
946 STGFUN(_PRStart_CharLike)
950 Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
956 Marking an IntLike Closure -- Set Mark to corresponding static closure
957 if in range. Updating of reference to this will redirect reference to
961 STGFUN(_PRStart_IntLike)
966 if (IS_MARK_BIT_SET(Mark)) {
969 val = INTLIKE_VALUE(Mark);
971 if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
972 DEBUG_PR_INTLIKE_TO_STATIC;
973 INFO_PTR(Mark) = (W_) Ind_info;
974 IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
975 Mark = (P_) IND_CLOSURE_PTR(Mark);
977 /* out of range of static closures */
978 DEBUG_PR_INTLIKE_IN_HEAP;
979 INIT_MARK_NODE("INT ",0);
987 CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
992 /* Marking an OldGen root -- treat as indirection if it references the old generation */
994 STGFUN(_PRStart_OldRoot)
999 oldroot = (P_) IND_CLOSURE_PTR(Mark);
1001 if (oldroot <= HeapLim) /* does the root reference the old generation ? */
1004 Mark = oldroot; /* short circut if the old generation root */
1005 JUMP_MARK; /* references an old generation closure */
1010 INIT_MARK_NODE("OldRoot",1); /* oldroot to new generation */
1011 INIT_MSTACK(SPEC_CLOSURE_PTR); /* treat as _PRStart_1 */
1020 Special error routine, used for closures which should never call their
1027 fprintf(stderr,"Called _PRIn_Error\nShould never occur!\n");
1033 %****************************************************************************
1035 \subsubsection[mark-fetchme]{Marking FetchMe Objects (parallel only)}
1037 %****************************************************************************
1043 FetchMe's present a unique problem during global GC. Since the IMU short-circuits
1044 indirections during its evacuation, it may return a PLC as the new global address
1045 for a @FetchMe@ node. This has the effect of turning the @FetchMe@ into an
1046 indirection during local garbage collection. Of course, we'd like to short-circuit
1047 this indirection immediately.
1050 STGFUN(_PRStart_FetchMe)
1053 if (IS_MARK_BIT_SET(Mark)) {
1056 INIT_MARK_NODE("FME ", 0);
1065 if (IS_MARK_BIT_SET(Mark)) {
1069 INIT_MARK_NODE("BF ", BF_CLOSURE_NoPTRS(dummy));
1070 INIT_MSTACK(BF_CLOSURE_PTR);
1080 GET_MARKED_PTRS(mbw, MStack, BF_CLOSURE_NoPTRS(dummy));
1081 if (++mbw < BF_CLOSURE_NoPTRS(dummy)) {
1082 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), mbw);
1083 CONTINUE_MARKING_NODE("BF ", mbw);
1084 MOVE_TO_NEXT_PTR(BF_CLOSURE_PTR, mbw);
1086 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), 0L);
1087 POP_MSTACK("BF ", BF_CLOSURE_PTR, BF_CLOSURE_NoPTRS(dummy));
1095 %****************************************************************************
1097 \subsubsection[mark-tso]{Marking Thread State Objects (threaded only)}
1099 %****************************************************************************
1101 First mark the link, then mark all live registers (StkO plus the VanillaRegs
1102 indicated by Liveness).
1104 CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
1113 if (IS_MARK_BIT_SET(Mark)) {
1117 INIT_MARK_NODE("BQ ", BQ_CLOSURE_NoPTRS(Mark));
1118 INIT_MSTACK(BQ_CLOSURE_PTR);
1126 POP_MSTACK("BQ ",BQ_CLOSURE_PTR,1);
1130 STGFUN(_PRStart_TSO)
1134 if (IS_MARK_BIT_SET(Mark)) {
1138 INIT_MARK_NODE("TSO ", 0);
1139 temp = TSO_LINK(Mark);
1140 TSO_LINK(Mark) = MStack;
1149 When we're in the TSO, pos 0 is the link, 1 is the StkO, and 2-10 correspond to
1150 the vanilla registers r[pos-2].
1156 BitWord oldpos, newpos;
1157 STGRegisterTable *r;
1161 GET_MARKED_PTRS(oldpos,MStack,TSO_PTRS);
1162 r = TSO_INTERNAL_PTR(MStack);
1166 /* Just did the link; now do the StkO */
1167 SET_MARKED_PTRS(MStack,TSO_PTRS,1L);
1169 r->rStkO = TSO_LINK(MStack);
1170 TSO_LINK(MStack) = Mark;
1172 DEBUG_PRIN("TSO ", 1);
1176 /* Just did the StkO; just update it, saving the old mstack */
1181 /* update the register we just did; save the old mstack */
1182 mstack = r->rR[oldpos - 2].p;
1183 r->rR[oldpos - 2] = Mark;
1187 /* liveness of the remaining registers */
1188 liveness = r->rLiveness >> (oldpos - 1);
1190 if (liveness == 0) {
1191 /* Restore MStack and return */
1192 SET_MARKED_PTRS(MStack,TSO_PTRS,0L);
1193 DEBUG_PRLAST("TSO ", oldpos);
1199 /* More to do in this TSO */
1201 /* Shift past non-ptr registers */
1202 for(newpos = oldpos + 1; (liveness & 1) == 0; liveness >>= 1) {
1206 /* Mark the next one */
1207 SET_MARKED_PTRS(MStack,TSO_PTRS,newpos);
1208 Mark = r->rR[newpos - 2].p;
1209 r->rR[newpos - 2].p = mstack;
1210 DEBUG_PRIN("TSO ", oldpos);
1218 %****************************************************************************
1220 \subsubsection[mark-stko]{Marking Stack Objects (threaded only)}
1222 %****************************************************************************
1224 First mark the A stack, then mark all updatees in the B stack.
1228 STGFUN(_PRStart_StkO)
1235 if (IS_MARK_BIT_SET(Mark)) {
1239 INIT_MARK_NODE("STKO", 0);
1240 size = STKO_CLOSURE_SIZE(Mark);
1241 cts_size = STKO_CLOSURE_CTS_SIZE(Mark);
1242 SET_GEN_MARKED_PTRS(Mark,size,(BitWord)(cts_size + 1));
1243 temp = STKO_LINK(Mark);
1244 STKO_LINK(Mark) = MStack;
1253 Now the ``in'' code for \tr{STKO} closures. First the A stack is flushed,
1254 then we chain down the update frames in the B stack, marking the update
1255 nodes. When all have been marked we pop the stack and return.
1260 BitWord oldpos, newpos;
1266 size = STKO_CLOSURE_SIZE(MStack);
1267 GET_GEN_MARKED_PTRS(oldpos, MStack, size);
1269 if (oldpos > STKO_CLOSURE_CTS_SIZE(MStack)) {
1270 /* Update the link, saving the old mstack */
1271 mstack = STKO_LINK(MStack);
1272 STKO_LINK(MStack) = Mark;
1274 /* Update the pointer, saving the old mstack */
1275 mstack = (P_) STKO_CLOSURE_PTR(MStack, oldpos);
1276 STKO_CLOSURE_PTR(MStack, oldpos) = (W_) Mark;
1279 /* Calculate the next position to mark */
1280 if (oldpos > STKO_SpA_OFFSET(MStack)) {
1281 /* Just walk backwards down the A stack */
1282 newpos = oldpos - 1;
1283 SET_GEN_MARKED_PTRS(MStack,size,newpos);
1284 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos);
1285 STKO_CLOSURE_PTR(MStack, newpos) = (W_) mstack;
1286 DEBUG_PRIN("STKA", oldpos);
1288 } else if (oldpos <= STKO_SuB_OFFSET(MStack)) {
1289 /* We're looking at an updatee in the B stack; find the next SuB up the chain */
1292 subptr = GRAB_SuB(STKO_CLOSURE_ADDR(MStack, oldpos - BREL(UF_UPDATEE)));
1293 newpos = STKO_CLOSURE_OFFSET(MStack,subptr);
1295 /* Just fell off the end of the A stack; grab the first SuB */
1296 newpos = STKO_SuB_OFFSET(MStack);
1299 if (newpos == 0) { /* Grrr... newpos is 1-based */
1300 /* Restore MStack and return */
1301 SET_GEN_MARKED_PTRS(MStack,size,0L);
1302 DEBUG_PRLAST("STKO", oldpos);
1308 /* newpos is actually the SuB; we want the corresponding updatee */
1309 SET_GEN_MARKED_PTRS(MStack,size,newpos + BREL(UF_UPDATEE));
1310 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE));
1311 STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE)) = (W_) mstack;
1312 DEBUG_PRIN("STKB", oldpos);
1317 #endif /* CONCURRENT */
1320 %****************************************************************************
1322 \subsubsection[mark-caf]{Marking CAFs}
1324 %****************************************************************************
1326 A CAF is shorted out as if it is an indirection.
1327 The CAF reference is explicitly updated by the garbage collector.
1330 STGFUN(_PRStart_Caf)
1334 Mark = (P_) IND_CLOSURE_PTR(Mark);
1339 #if 0 /* Code to avoid explicit updating of CAF references */
1340 /* We need auxiliary mark and update reference info table */
1342 CAF_MARK_UPD_ITBL(Caf_Mark_Upd_info,const);
1344 /* Start marking a CAF -- special mark upd info table */
1345 /* Change to marking state and mark reference */
1347 STGFUN(_PRStart_Caf)
1350 if (IS_MARK_BIT_SET(Mark)) {
1354 INIT_MARK_NODE("CAF ",1);
1355 INIT_MSTACK(IND_CLOSURE_PTR2);
1360 /* Completed marking a CAF -- special mark upd info table */
1361 /* Change info table back to normal CAF info, return reference (Mark) */
1363 STGFUN(_PRInLast_Caf)
1369 SET_INFO_PTR(MStack, Caf_info); /* normal marked CAF */
1371 /* Like POP_MSTACK */
1373 MStack = (P_) IND_CLOSURE_PTR(temp);
1374 IND_CLOSURE_PTR(temp) = (W_) Mark;
1376 /* Mark left unmodified so CAF reference is returned */
1381 /* Marking a CAF currently being marked -- special mark upd info table */
1382 /* Just return CAF as if marked -- wont be shorted out */
1383 /* Marking once reference marked and updated -- normal CAF info table */
1384 /* Return reference to short CAF out */
1386 STGFUN(_PRStart_Caf)
1389 if (IS_MARK_BIT_SET(Mark)) {
1390 DEBUG_PR_MARKING_CAF;
1393 DEBUG_PR_MARKED_CAF;
1394 Mark = (P_) IND_CLOSURE_PTR(Mark);
1400 #define DEBUG_PR_MARKED_CAF \
1402 fprintf(stderr, "PRMark CAF (Marked): 0x%lx -> 0x%lx, info 0x%lx\n", \
1403 Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark))
1405 #define DEBUG_PR_MARKING_CAF \
1407 fprintf(stderr, "PRMark CAF (Marking): 0x%lx -> 0x%lx, info 0x%lx\n", \
1408 Mark, Mark, INFO_PTR(Mark))
1410 #define DEBUG_PRLAST_CAF \
1412 fprintf(stderr, "PRRet Last (CAF ): 0x%lx -> 0x%lx, info 0x%lx -> 0x%lx ptrs 1\n", \
1413 MStack, Mark, INFO_PTR(MStack), Caf_info)
1419 %****************************************************************************
1421 \subsection[mark-root]{Root Marking Code}
1423 %****************************************************************************
1425 Used by \tr{SMmarking.lc} -- but needs to be in \tr{.lhc} file.
1427 These are routines placed in closures at the bottom of the marking stack
1430 STGFUN(_Dummy_PRReturn_entry)
1433 fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
1435 return(0); /* won't happen; quiets compiler warnings */
1439 EXTFUN(_PRMarking_MarkNextRoot);
1440 EXTFUN(_PRMarking_MarkNextCAF);
1443 EXTFUN(_PRMarking_MarkNextSpark);
1447 EXTFUN(_PRMarking_MarkNextGA);
1449 EXTFUN(_PRMarking_MarkNextAStack);
1450 EXTFUN(_PRMarking_MarkNextBStack);
1451 #endif /* not parallel */
1453 CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN")
1454 /* just one, shared */
1456 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
1457 _PRMarking_MarkNextRoot_info,
1458 _PRMarking_MarkNextRoot,
1459 _Dummy_PRReturn_entry);
1462 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
1463 _PRMarking_MarkNextSpark_info,
1464 _PRMarking_MarkNextSpark,
1465 _Dummy_PRReturn_entry);
1469 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
1470 _PRMarking_MarkNextGA_info,
1471 _PRMarking_MarkNextGA,
1472 _Dummy_PRReturn_entry);
1474 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
1475 _PRMarking_MarkNextAStack_info,
1476 _PRMarking_MarkNextAStack,
1477 _Dummy_PRReturn_entry);
1479 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
1480 _PRMarking_MarkNextBStack_info,
1481 _PRMarking_MarkNextBStack,
1482 _Dummy_PRReturn_entry);
1486 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
1487 _PRMarking_MarkNextCAF_info,
1488 _PRMarking_MarkNextCAF,
1489 _Dummy_PRReturn_entry);
1491 STGFUN(_PRMarking_MarkNextRoot)
1493 extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */
1496 /* Update root -- may have short circuited Ind */
1499 /* Is the next off the end */
1500 if (++MRoot >= sm_roots_end)
1501 RESUME_(miniInterpretEnd);
1509 STGFUN(_PRMarking_MarkNextSpark)
1511 extern P_ sm_roots_end; /* PendingSparksTl[pool] */
1514 /* Update root -- may have short circuited Ind */
1517 /* Is the next off the end */
1518 if (++MRoot >= sm_roots_end)
1519 RESUME_(miniInterpretEnd);
1528 STGFUN(_PRMarking_MarkNextGA)
1531 /* Update root -- may have short circuited Ind */
1532 ((GALA *)MRoot)->la = Mark;
1535 MRoot = (P_) ((GALA *) MRoot)->next;
1536 } while (MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT);
1538 /* Is the next off the end */
1540 RESUME_(miniInterpretEnd);
1542 Mark = ((GALA *)MRoot)->la;
1549 STGFUN(_PRMarking_MarkNextAStack)
1552 /* Update root -- may have short circuited Ind */
1555 /* Is the next off the end */
1556 if (SUBTRACT_A_STK( (PP_) ++MRoot, stackInfo.botA) < 0)
1557 RESUME_(miniInterpretEnd);
1565 STGFUN(_PRMarking_MarkNextBStack)
1568 /* Update root -- may have short circuited Ind */
1569 PUSH_UPDATEE(MRoot, Mark);
1571 MRoot = GRAB_SuB(MRoot);
1573 /* Is the next off the end */
1574 if (SUBTRACT_B_STK(MRoot, stackInfo.botB) < 0)
1575 RESUME_(miniInterpretEnd);
1577 Mark = GRAB_UPDATEE(MRoot);
1584 Mark the next CAF in the CAF list.
1587 STGFUN(_PRMarking_MarkNextCAF)
1590 /* Update root -- may have short circuted Ind */
1591 IND_CLOSURE_PTR(MRoot) = (W_) Mark;
1593 MRoot = (P_) IND_CLOSURE_LINK(MRoot);
1595 /* Is the next CAF the end of the list */
1597 RESUME_(miniInterpretEnd);
1599 Mark = (P_) IND_CLOSURE_PTR(MRoot);
1606 #if 0 /* Code to avoid explicit updating of CAF references */
1608 STGFUN(_PRMarking_MarkNextCAF)
1611 MRoot = (P_) IND_CLOSURE_LINK(MRoot);
1613 /* Is the next CAF the end of the list */
1615 RESUME_(miniInterpretEnd);
1624 Multi-slurp protection.
1627 #endif /* _INFO_MARKING */