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 #include "SMmarkDefs.h"
190 #if defined(_INFO_MARKING)
193 First the necessary forward declarations.
196 /* #define MARK_REG_MAP -- Must be done on command line for threaded code */
197 #include "SMinternal.h"
200 extern P_ ret_MRoot, ret_Mark;
204 Define appropriate variables as potential register variables.
205 Assume GC code saves and restores any global registers used.
208 RegisterTable MarkRegTable;
211 @_startMarkWorld@ restores registers if necessary, then marks the
212 root pointed to by @Mark@.
215 STGFUN(_startMarkWorld)
218 #if defined(__STG_GCC_REGS__) && defined(__GNUC__)
219 /* If using registers load from _SAVE (see SMmarking.lc) */
221 /* I deeply suspect this should be RESTORE_REGS(...) [WDP 95/02] */
223 MarkBaseReg = &MarkRegTable;
227 MStack = SAVE_MStack;
228 BitArray = SAVE_BitArray;
229 HeapBase = SAVE_HeapBase;
230 HeapLim = SAVE_HeapLim;
238 This is the pointer reversal start code for \tr{SPEC} closures with 0
245 if (IS_MARK_BIT_SET(Mark)) {
248 INIT_MARK_NODE("SPEC",0);
256 This macro defines the format of the pointer reversal start code for a
257 number of pointers \tr{ptrs}, $>$ 0.
261 #define SPEC_PRStart_N_CODE(ptrs) \
262 STGFUN(CAT2(_PRStart_,ptrs)) \
265 if (IS_MARK_BIT_SET(Mark)) { \
269 INIT_MARK_NODE("SPEC",ptrs); \
270 INIT_MSTACK(SPEC_CLOSURE_PTR); \
277 The definitions of the start code for \tr{SPEC} closures with 1-12
281 SPEC_PRStart_N_CODE(1)
282 SPEC_PRStart_N_CODE(2)
283 SPEC_PRStart_N_CODE(3)
284 SPEC_PRStart_N_CODE(4)
285 SPEC_PRStart_N_CODE(5)
286 SPEC_PRStart_N_CODE(6)
287 SPEC_PRStart_N_CODE(7)
288 SPEC_PRStart_N_CODE(8)
289 SPEC_PRStart_N_CODE(9)
290 SPEC_PRStart_N_CODE(10)
291 SPEC_PRStart_N_CODE(11)
292 SPEC_PRStart_N_CODE(12)
296 Start code for revertible black holes with underlying @SPEC@ types.
300 #if defined(PAR) || defined(GRAN)
301 #define SPEC_RBH_PRStart_N_CODE(ptrs) \
302 STGFUN(CAT2(_PRStart_RBH_,ptrs)) \
305 if (IS_MARK_BIT_SET(Mark)) { \
309 INIT_MARK_NODE("SRBH",ptrs-1); \
310 INIT_MSTACK(SPEC_RBH_CLOSURE_PTR); \
315 SPEC_RBH_PRStart_N_CODE(2)
316 SPEC_RBH_PRStart_N_CODE(3)
317 SPEC_RBH_PRStart_N_CODE(4)
318 SPEC_RBH_PRStart_N_CODE(5)
319 SPEC_RBH_PRStart_N_CODE(6)
320 SPEC_RBH_PRStart_N_CODE(7)
321 SPEC_RBH_PRStart_N_CODE(8)
322 SPEC_RBH_PRStart_N_CODE(9)
323 SPEC_RBH_PRStart_N_CODE(10)
324 SPEC_RBH_PRStart_N_CODE(11)
325 SPEC_RBH_PRStart_N_CODE(12)
331 @SPEC_PRIn_N_CODE@ has two different meanings, depending on the world
335 In the commoned-info-table world, it
336 defines the ``in'' code for a particular number
337 of pointers, and subsumes the functionality of @SPEC_PRInLast_N_NODE@ below.
339 Otherwise, it defines the ``in'' code for a particular pointer in a
345 #define SPEC_PRIn_N_CODE(ptrs) \
346 STGFUN(CAT2(_PRIn_,ptrs)) \
350 GET_MARKED_PTRS(mbw,MStack,ptrs); \
351 if (++mbw < ptrs) { \
352 SET_MARKED_PTRS(MStack,ptrs,mbw); \
353 CONTINUE_MARKING_NODE("SPEC",mbw); \
354 MOVE_TO_NEXT_PTR(SPEC_CLOSURE_PTR,mbw); \
356 SET_MARKED_PTRS(MStack,ptrs,0L); \
357 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,ptrs); \
364 Now @SPEC_PRIn_N_CODE@ is used to define the individual entries for \tr{SPEC} closures
371 fprintf(stderr,"Called _PRIn_0\nShould never occur!\n");
378 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,1);
394 In code for revertible black holes with underlying @SPEC@ types.
397 #if defined(PAR) || defined(GRAN)
398 #define SPEC_RBH_PRIn_N_CODE(ptrs) \
399 STGFUN(CAT2(_PRIn_RBH_,ptrs)) \
403 GET_MARKED_PTRS(mbw,MStack,ptrs-1); \
404 if (++mbw < ptrs-1) { \
405 SET_MARKED_PTRS(MStack,ptrs-1,mbw); \
406 CONTINUE_MARKING_NODE("SRBH",mbw); \
407 MOVE_TO_NEXT_PTR(SPEC_RBH_CLOSURE_PTR,mbw); \
409 SET_MARKED_PTRS(MStack,ptrs-1,0L); \
410 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,ptrs-1); \
418 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,1);
422 SPEC_RBH_PRIn_N_CODE(3)
423 SPEC_RBH_PRIn_N_CODE(4)
424 SPEC_RBH_PRIn_N_CODE(5)
425 SPEC_RBH_PRIn_N_CODE(6)
426 SPEC_RBH_PRIn_N_CODE(7)
427 SPEC_RBH_PRIn_N_CODE(8)
428 SPEC_RBH_PRIn_N_CODE(9)
429 SPEC_RBH_PRIn_N_CODE(10)
430 SPEC_RBH_PRIn_N_CODE(11)
431 SPEC_RBH_PRIn_N_CODE(12)
436 Foreign Objs are in the non-parallel world only.
442 STGFUN(_PRStart_ForeignObj)
445 if (IS_MARK_BIT_SET(Mark)) {
448 INIT_MARK_NODE("ForeignObj ",0);
455 This defines the start code for generic (\tr{GEN}) closures.
464 if (IS_MARK_BIT_SET(Mark)) {
468 ptrs = GEN_CLOSURE_NoPTRS(Mark);
469 INIT_MARK_NODE("GEN ",ptrs);
473 INIT_MSTACK(GEN_CLOSURE_PTR);
479 Now the ``in'' code for \tr{GEN} closures.
489 ptrs = GEN_CLOSURE_NoPTRS(MStack);
490 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
493 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
494 CONTINUE_MARKING_NODE("GEN",pos);
495 MOVE_TO_NEXT_PTR(GEN_CLOSURE_PTR,pos);
497 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
498 POP_MSTACK("GEN ",GEN_CLOSURE_PTR,ptrs);
504 And the start/in code for a revertible black hole with an underlying @GEN@ closure.
508 #if defined(PAR) || defined(GRAN)
510 STGFUN(_PRStart_RBH_N)
516 if (IS_MARK_BIT_SET(Mark)) {
522 * Get pointer count from original closure and adjust for one pointer
523 * in the first two words of the RBH.
525 ptrs = GEN_RBH_CLOSURE_NoPTRS(Mark);
531 INIT_MARK_NODE("GRBH", ptrs);
532 INIT_MSTACK(GEN_RBH_CLOSURE_PTR);
544 * Get pointer count from original closure and adjust for one pointer
545 * in the first two words of the RBH.
547 ptrs = GEN_RBH_CLOSURE_NoPTRS(MStack);
553 GET_GEN_MARKED_PTRS(pos, MStack, ptrs);
556 SET_GEN_MARKED_PTRS(MStack, ptrs, pos);
557 CONTINUE_MARKING_NODE("GRBH", pos);
558 MOVE_TO_NEXT_PTR(GEN_RBH_CLOSURE_PTR, pos);
560 SET_GEN_MARKED_PTRS(MStack, ptrs, 0L);
561 POP_MSTACK("GRBH", GEN_RBH_CLOSURE_PTR, ptrs);
570 Start code for dynamic (\tr{DYN}) closures. There is no \tr{DYN}
571 closure with 0 pointers -- \tr{DATA} is used instead.
577 if (IS_MARK_BIT_SET(Mark)) {
581 INIT_MARK_NODE("DYN ", DYN_CLOSURE_NoPTRS(Mark));
582 INIT_MSTACK(DYN_CLOSURE_PTR);
588 and the corresponding ``in'' code.
597 ptrs = DYN_CLOSURE_NoPTRS(MStack);
598 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
601 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
602 CONTINUE_MARKING_NODE("DYN",pos);
603 MOVE_TO_NEXT_PTR(DYN_CLOSURE_PTR,pos);
605 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
606 POP_MSTACK("DYN ",DYN_CLOSURE_PTR,ptrs);
613 The start code for \tr{TUPLE} (all-pointer) objects. There can be no
614 such object without any pointers, so we don't check for this case.
617 STGFUN(_PRStart_Tuple)
620 if (IS_MARK_BIT_SET(Mark)) {
624 INIT_MARK_NODE("TUPL", TUPLE_CLOSURE_NoPTRS(Mark));
625 INIT_MSTACK(TUPLE_CLOSURE_PTR);
634 STGFUN(_PRIn_I_Tuple)
640 ptrs = TUPLE_CLOSURE_NoPTRS(MStack);
641 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
644 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
645 CONTINUE_MARKING_NODE("TUPL",pos);
646 MOVE_TO_NEXT_PTR(TUPLE_CLOSURE_PTR,pos);
648 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
649 POP_MSTACK("TUPL",TUPLE_CLOSURE_PTR,ptrs);
657 /*** MUTUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
658 /* Only if special GC treatment required */
660 #ifdef GC_MUT_REQUIRED
662 STGFUN(_PRStart_MuTuple)
665 if (IS_MARK_BIT_SET(Mark)) {
669 INIT_MARK_NODE("MUT ", MUTUPLE_CLOSURE_NoPTRS(Mark));
670 if (MUTUPLE_CLOSURE_NoPTRS(Mark) > 0) {
671 INIT_MSTACK(MUTUPLE_CLOSURE_PTR);
679 STGFUN(_PRIn_I_MuTuple)
685 ptrs = MUTUPLE_CLOSURE_NoPTRS(MStack);
686 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
689 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
690 CONTINUE_MARKING_NODE("MUT",pos);
691 MOVE_TO_NEXT_PTR(MUTUPLE_CLOSURE_PTR,pos);
693 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
694 POP_MSTACK("MUT ",MUTUPLE_CLOSURE_PTR,ptrs);
699 #endif /* GCap || GCgn */
702 There are no pointers in a \tr{DATA} closure, so just mark the
706 STGFUN(_PRStart_Data)
709 if (IS_MARK_BIT_SET(Mark)) {
712 INIT_MARK_NODE("DATA", 0);
718 %****************************************************************************
720 \subsubsection[mark-specials]{Special cases}
722 %****************************************************************************
724 Black hole closures simply mark themselves and return.
730 if (IS_MARK_BIT_SET(Mark)) {
733 INIT_MARK_NODE("BH ", 0);
739 Marking a Static Closure -- Just return as if Marked
742 STGFUN(_PRStart_Static)
751 Marking an Indirection -- Set Mark to ind addr and mark this.
752 Updating of reference when we return will short indirection.
759 GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
761 Mark = (P_) IND_CLOSURE_PTR(Mark);
767 ``Permanent indirection''---used in profiling. Works basically
768 like @_PRStart_1@ (one pointer).
770 #if defined(PROFILING) || defined(TICKY_TICKY)
776 if (IS_MARK_BIT_SET(Mark)) {
780 INIT_MARK_NODE("PI ",1);
781 /* the "1" above is dodgy (i.e. wrong), but it is never
782 used except in debugging info. ToDo??? WDP 95/07
784 INIT_MSTACK(PERM_IND_CLOSURE_PTR);
792 POP_MSTACK("PI ",PERM_IND_CLOSURE_PTR,1);
793 /* the "1" above is dodgy (i.e. wrong), but it is never
794 used except in debugging info. ToDo??? WDP 95/07
799 #endif /* PROFILING or TICKY */
802 Marking a ``selector closure'': This is a size-2 SPEC thunk that
803 selects word $n$; if the thunk's pointee is evaluated, then we short
804 out the selection, {\em just like an indirection}. If it is still
805 unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}.
807 {\em Should we select ``on the way down'' (in \tr{_PRStart_Selector})
808 or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on
809 the way down. Downside: we are flummoxed by indirections, so we'll
810 have to wait until the {\em next} major GC to do the selections (after
811 the indirections are shorted out in this GC). But the downside of
812 doing selections on the way back up is that we are then in a world of
813 reversed pointers, and selecting a reversed pointer---we've see this
814 on selectors for very recursive structures---is a total disaster.
819 #define IF_GC_DEBUG(x) x
821 #define IF_GC_DEBUG(x) /*nothing*/
824 #if !defined(CONCURRENT)
825 # define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling)
827 # define NOT_BLACKHOLING 0
830 /* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
832 #define MARK_SELECTOR(n) \
833 STGFUN(CAT2(_PRStartSelector_,n)) \
838 /* must be a SPEC 2 1 closure */ \
839 ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \
840 ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \
841 ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \
843 if (IS_MARK_BIT_SET(Mark)) { /* already marked */ \
848 maybe_con = (P_) *(Mark + _FHS); \
851 if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) { \
852 fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \
853 (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \
854 INFO_NoPTRS(INFO_PTR(Mark)), \
855 maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \
856 INFO_PTR(maybe_con)); \
857 fprintf(stderr, ", tag %ld, size %ld, ptrs %ld", \
858 INFO_TAG(INFO_PTR(maybe_con)), \
859 INFO_SIZE(INFO_PTR(maybe_con)), \
860 INFO_NoPTRS(INFO_PTR(maybe_con))); \
861 if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \
862 fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \
864 fprintf(stderr, "\n"); \
867 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
868 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \
869 || INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ \
870 || NOT_BLACKHOLING /* see "price of laziness" paper */ \
871 || (! RTSflags.GcFlags.doSelectorsAtGC )) \
872 /* see below for OLD test we used here (WDP 95/04) */ \
873 /* ToDo: decide WHNFness another way? */ \
876 /* some things should be true about the pointee */ \
877 ASSERT(INFO_TAG(INFO_PTR(maybe_con)) == 0); \
878 /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
880 /* OK, it is evaluated: behave just like an indirection */ \
881 GC_SEL_MAJOR(); /* ticky-ticky */ \
883 Mark = (P_) (maybe_con[_FHS + (n)]); \
884 /* Mark now has the result of the selection */ \
892 the IS_STATIC test was to protect the IS_MARK_BIT_SET check;
893 but the IS_MARK_BIT_SET test was only there to avoid
894 mangled pointers, but we cannot have mangled pointers anymore
895 (after RTBLs came our way).
896 SUMMARY: we toss both of the "guard" tests.
898 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */
899 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */
900 || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */
917 #undef IF_GC_DEBUG /* get rid of it */
920 Marking a Constant Closure -- Set Mark to corresponding static
921 closure. Updating of reference will redirect reference to the static
925 STGFUN(_PRStart_Const)
932 Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
935 if (IS_MARK_BIT_SET(Mark)) {
938 if (!AllFlags.doUpdEntryCounts) {
940 GC_COMMON_CONST(); /* ticky */
942 Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
944 } else { /* no commoning */
945 INIT_MARK_NODE("CONST ",0);
955 Marking a CharLike Closure -- Set Mark to corresponding static
956 closure. Updating of reference will redirect reference to the static
960 STGFUN(_PRStart_CharLike)
973 Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
977 if (IS_MARK_BIT_SET(Mark)) {
980 val = CHARLIKE_VALUE(Mark);
982 if (!AllFlags.doUpdEntryCounts) {
983 GC_COMMON_CHARLIKE(); /* ticky */
985 INFO_PTR(Mark) = (W_) Ind_info;
986 IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val);
987 Mark = (P_) IND_CLOSURE_PTR(Mark);
989 } else { /* no commoning */
990 INIT_MARK_NODE("CHAR ",0);
1000 Marking an IntLike Closure -- Set Mark to corresponding static closure
1001 if in range. Updating of reference to this will redirect reference to
1005 STGFUN(_PRStart_IntLike)
1010 if (IS_MARK_BIT_SET(Mark)) {
1013 val = INTLIKE_VALUE(Mark);
1015 if (val >= MIN_INTLIKE
1016 && val <= MAX_INTLIKE
1018 && !AllFlags.doUpdEntryCounts
1021 DEBUG_PR_INTLIKE_TO_STATIC;
1022 GC_COMMON_INTLIKE(); /* ticky */
1024 INFO_PTR(Mark) = (W_) Ind_info;
1025 IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
1026 Mark = (P_) IND_CLOSURE_PTR(Mark);
1028 } else { /* out of range of static closures */
1029 DEBUG_PR_INTLIKE_IN_HEAP;
1031 if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
1033 INIT_MARK_NODE("INT ",0);
1041 Special error routine, used for closures which should never call their
1048 fprintf(stderr,"Called _PRIn_Error\nShould never occur!\n");
1054 %****************************************************************************
1056 \subsubsection[mark-fetchme]{Marking FetchMe Objects (parallel only)}
1058 %****************************************************************************
1064 FetchMe's present a unique problem during global GC. Since the IMU short-circuits
1065 indirections during its evacuation, it may return a PLC as the new global address
1066 for a @FetchMe@ node. This has the effect of turning the @FetchMe@ into an
1067 indirection during local garbage collection. Of course, we'd like to short-circuit
1068 this indirection immediately.
1071 STGFUN(_PRStart_FetchMe)
1074 if (IS_MARK_BIT_SET(Mark)) {
1077 INIT_MARK_NODE("FME ", 0);
1086 if (IS_MARK_BIT_SET(Mark)) {
1090 INIT_MARK_NODE("BF ", BF_CLOSURE_NoPTRS(dummy));
1091 INIT_MSTACK(BF_CLOSURE_PTR);
1101 GET_MARKED_PTRS(mbw, MStack, BF_CLOSURE_NoPTRS(dummy));
1102 if (++mbw < BF_CLOSURE_NoPTRS(dummy)) {
1103 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), mbw);
1104 CONTINUE_MARKING_NODE("BF ", mbw);
1105 MOVE_TO_NEXT_PTR(BF_CLOSURE_PTR, mbw);
1107 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), 0L);
1108 POP_MSTACK("BF ", BF_CLOSURE_PTR, BF_CLOSURE_NoPTRS(dummy));
1116 %****************************************************************************
1118 \subsubsection[mark-tso]{Marking Thread State Objects (threaded only)}
1120 %****************************************************************************
1122 First mark the link, then mark all live registers (StkO plus the VanillaRegs
1123 indicated by Liveness).
1125 CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
1134 if (IS_MARK_BIT_SET(Mark)) {
1138 INIT_MARK_NODE("BQ ", BQ_CLOSURE_NoPTRS(Mark));
1139 INIT_MSTACK(BQ_CLOSURE_PTR);
1147 POP_MSTACK("BQ ",BQ_CLOSURE_PTR,1);
1151 STGFUN(_PRStart_TSO)
1155 if (IS_MARK_BIT_SET(Mark)) {
1159 INIT_MARK_NODE("TSO ", 0);
1160 temp = TSO_LINK(Mark);
1161 TSO_LINK(Mark) = MStack;
1170 When we're in the TSO, pos 0 is the link, 1 is the StkO, and 2-10 correspond to
1171 the vanilla registers r[pos-2].
1177 BitWord oldpos, newpos;
1178 STGRegisterTable *r;
1182 GET_MARKED_PTRS(oldpos,MStack,TSO_PTRS);
1183 r = TSO_INTERNAL_PTR(MStack);
1187 /* Just did the link; now do the StkO */
1188 SET_MARKED_PTRS(MStack,TSO_PTRS,1L);
1190 r->rStkO = TSO_LINK(MStack);
1191 TSO_LINK(MStack) = Mark;
1193 DEBUG_PRIN("TSO ", 1);
1197 /* Just did the StkO; just update it, saving the old mstack */
1202 /* update the register we just did; save the old mstack */
1203 mstack = r->rR[oldpos - 2].p;
1204 r->rR[oldpos - 2].p = Mark;
1208 /* liveness of the remaining registers */
1209 liveness = r->rLiveness >> (oldpos - 1);
1211 if (liveness == 0) {
1212 /* Restore MStack and return */
1213 SET_MARKED_PTRS(MStack,TSO_PTRS,0L);
1214 DEBUG_PRLAST("TSO ", oldpos);
1220 /* More to do in this TSO */
1222 /* Shift past non-ptr registers */
1223 for(newpos = oldpos + 1; (liveness & 1) == 0; liveness >>= 1) {
1227 /* Mark the next one */
1228 SET_MARKED_PTRS(MStack,TSO_PTRS,newpos);
1229 Mark = r->rR[newpos - 2].p;
1230 r->rR[newpos - 2].p = mstack;
1231 DEBUG_PRIN("TSO ", oldpos);
1239 %****************************************************************************
1241 \subsubsection[mark-stko]{Marking Stack Objects (threaded only)}
1243 %****************************************************************************
1245 First mark the A stack, then mark all updatees in the B stack.
1249 STGFUN(_PRStart_StkO)
1257 /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */
1259 if (IS_MARK_BIT_SET(Mark)) {
1263 INIT_MARK_NODE("STKO", 0);
1264 size = STKO_CLOSURE_SIZE(Mark);
1265 cts_size = STKO_CLOSURE_CTS_SIZE(Mark);
1266 SET_GEN_MARKED_PTRS(Mark,size,(BitWord)(cts_size + 1));
1267 temp = STKO_LINK(Mark);
1268 STKO_LINK(Mark) = MStack;
1277 Now the ``in'' code for \tr{STKO} closures. First the A stack is flushed,
1278 then we chain down the update frames in the B stack, marking the update
1279 nodes. When all have been marked we pop the stack and return.
1284 BitWord oldpos, newpos;
1290 size = STKO_CLOSURE_SIZE(MStack);
1291 GET_GEN_MARKED_PTRS(oldpos, MStack, size);
1293 if (oldpos > STKO_CLOSURE_CTS_SIZE(MStack)) {
1294 /* Update the link, saving the old mstack */
1295 mstack = STKO_LINK(MStack);
1296 STKO_LINK(MStack) = Mark;
1298 /* Update the pointer, saving the old mstack */
1299 mstack = (P_) STKO_CLOSURE_PTR(MStack, oldpos);
1300 STKO_CLOSURE_PTR(MStack, oldpos) = (W_) Mark;
1303 /* Calculate the next position to mark */
1304 if (oldpos > STKO_SpA_OFFSET(MStack)) {
1305 /* Just walk backwards down the A stack */
1306 newpos = oldpos - 1;
1307 SET_GEN_MARKED_PTRS(MStack,size,newpos);
1308 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos);
1309 STKO_CLOSURE_PTR(MStack, newpos) = (W_) mstack;
1310 DEBUG_PRIN("STKA", oldpos);
1312 } else if (oldpos <= STKO_SuB_OFFSET(MStack)) {
1313 /* We're looking at an updatee in the B stack; find the next SuB up the chain */
1316 subptr = GRAB_SuB(STKO_CLOSURE_ADDR(MStack, oldpos - BREL(UF_UPDATEE)));
1317 newpos = STKO_CLOSURE_OFFSET(MStack,subptr);
1319 /* Just fell off the end of the A stack; grab the first SuB */
1320 newpos = STKO_SuB_OFFSET(MStack);
1323 if (newpos == 0) { /* Grrr... newpos is 1-based */
1324 /* Restore MStack and return */
1325 SET_GEN_MARKED_PTRS(MStack,size,0L);
1326 DEBUG_PRLAST("STKO", oldpos);
1332 /* newpos is actually the SuB; we want the corresponding updatee */
1333 SET_GEN_MARKED_PTRS(MStack,size,newpos + BREL(UF_UPDATEE));
1334 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE));
1335 STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE)) = (W_) mstack;
1336 DEBUG_PRIN("STKB", oldpos);
1341 #endif /* CONCURRENT */
1344 %****************************************************************************
1346 \subsubsection[mark-caf]{Marking CAFs}
1348 %****************************************************************************
1350 A CAF is shorted out as if it were an indirection.
1351 The CAF reference is explicitly updated by the garbage collector.
1354 STGFUN(_PRStart_Caf)
1358 GC_SHORT_CAF(); /* ticky */
1360 Mark = (P_) IND_CLOSURE_PTR(Mark);
1366 %****************************************************************************
1368 \subsection[mark-root]{Root Marking Code}
1370 %****************************************************************************
1372 Used by \tr{SMmarking.lc} -- but needs to be in \tr{.lhc} file.
1374 These are routines placed in closures at the bottom of the marking stack
1377 STGFUN(_Dummy_PRReturn_entry)
1380 fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
1385 /* various ways to call _Dummy_PRReturn_entry: */
1387 INTFUN(_PRMarking_MarkNextRoot_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1389 INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1392 INTFUN(_PRMarking_MarkNextGA_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1394 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1395 INTFUN(_PRMarking_MarkNextAStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1396 INTFUN(_PRMarking_MarkNextBStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1398 INTFUN(_PRMarking_MarkNextCAF_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1401 INTFUN(_PRMarking_MarkNextEvent_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1402 INTFUN(_PRMarking_MarkNextClosureInFetchBuffer_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1405 /* end of various ways to call _Dummy_PRReturn_entry */
1407 EXTFUN(_PRMarking_MarkNextRoot);
1408 EXTFUN(_PRMarking_MarkNextCAF);
1411 EXTFUN(_PRMarking_MarkNextSpark);
1415 EXTFUN(_PRMarking_MarkNextGA);
1417 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1418 EXTFUN(_PRMarking_MarkNextAStack);
1419 EXTFUN(_PRMarking_MarkNextBStack);
1421 #endif /* not parallel */
1423 CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN")
1424 /* just one, shared */
1426 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
1427 _PRMarking_MarkNextRoot_info,
1428 _PRMarking_MarkNextRoot,
1429 _PRMarking_MarkNextRoot_entry);
1432 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
1433 _PRMarking_MarkNextSpark_info,
1434 _PRMarking_MarkNextSpark,
1435 _PRMarking_MarkNextSpark_entry);
1439 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextEvent_closure,
1440 _PRMarking_MarkNextEvent_info,
1441 _PRMarking_MarkNextEvent,
1442 _PRMarking_MarkNextEvent_entry);
1443 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextClosureInFetchBuffer_closure,
1444 _PRMarking_MarkNextClosureInFetchBuffer_info,
1445 _PRMarking_MarkNextClosureInFetchBuffer,
1446 _PRMarking_MarkNextClosureInFetchBuffer_entry);
1450 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
1451 _PRMarking_MarkNextGA_info,
1452 _PRMarking_MarkNextGA,
1453 _PRMarking_MarkNextGA_entry);
1455 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1456 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
1457 _PRMarking_MarkNextAStack_info,
1458 _PRMarking_MarkNextAStack,
1459 _PRMarking_MarkNextAStack_entry);
1461 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
1462 _PRMarking_MarkNextBStack_info,
1463 _PRMarking_MarkNextBStack,
1464 _PRMarking_MarkNextBStack_entry);
1468 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
1469 _PRMarking_MarkNextCAF_info,
1470 _PRMarking_MarkNextCAF,
1471 _PRMarking_MarkNextCAF_entry);
1473 extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */
1475 STGFUN(_PRMarking_MarkNextRoot)
1478 /* Update root -- may have short circuited Ind */
1481 /* Is the next off the end */
1482 if (++MRoot >= sm_roots_end)
1483 RESUME_(miniInterpretEnd);
1490 #if defined(CONCURRENT)
1492 extern P_ sm_roots_end; /* PendingSparksTl[pool] */
1494 STGFUN(_PRMarking_MarkNextSpark)
1497 /* Update root -- may have short circuited Ind */
1500 /* Is the next off the end */
1501 if (++MRoot >= sm_roots_end)
1502 RESUME_(miniInterpretEnd);
1509 STGFUN(_PRMarking_MarkNextSpark)
1511 /* This is more similar to MarkNextGA than to the MarkNextSpark in
1512 concurrent-but-not-gran land
1513 NB: MRoot is a spark (with an embedded pointer to a closure) */
1515 /* Update root -- may have short circuited Ind */
1516 SPARK_NODE( ((sparkq) MRoot) ) = Mark;
1517 MRoot = (P_) SPARK_NEXT( ((sparkq) MRoot) );
1519 /* Is the next off the end */
1521 RESUME_(miniInterpretEnd);
1523 Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
1528 #endif /* CONCURRENT */
1531 Note: Events are GranSim-only.
1532 Marking events is similar to marking GALA entries in parallel-land.
1533 The major difference is that depending on the type of the event we have
1534 to mark different field of the event (possibly several fields).
1535 Even worse, in the case of bulk fetching
1536 (@RTSflags.GranFlags.DoGUMMFetching@) we find a buffer of pointers to
1537 closures we have to mark (similar to sparks in concurrent-but-not-gransim
1542 STGFUN(_PRMarking_MarkNextEvent)
1544 rtsBool found = rtsFalse;
1548 /* First update the right component of the old event */
1549 switch (EVENT_TYPE( ((eventq) MRoot) )) {
1550 case CONTINUETHREAD:
1554 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1557 SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) )) = (P_) Mark;
1560 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1562 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1563 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1564 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1568 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1569 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1572 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
1578 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1580 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1581 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1582 /* In the case of packet fetching, EVENT_NODE(event) points to */
1583 /* the packet (currently, malloced). The packet is just a list of */
1584 /* closure addresses, with the length of the list at index 1 (the */
1585 /* structure of the packet is defined in Pack.lc). */
1586 if ( RTSflags.GranFlags.DoGUMMFetching ) {
1587 P_ buffer = (P_) EVENT_NODE( ((eventq) MRoot) );
1588 int size = (int) buffer[PACK_SIZE_LOCN];
1590 /* was: for (i = PACK_HDR_SIZE; i <= size-1; i++) ... */
1591 sm_roots_end = buffer + PACK_HDR_SIZE + size;
1592 MRoot = (P_) buffer + PACK_HDR_SIZE;
1596 MStack = (P_) _PRMarking_MarkNextClosureInFetchBuffer_closure;
1599 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1604 if ( RTSflags.GranFlags.DoGUMMFetching ) {
1605 /* no update necessary; fetch buffers are malloced */
1607 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1609 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1612 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHREPLY event @ %#x\n",
1619 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1621 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1622 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1623 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1628 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1629 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1632 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of GLOBALBLOCK event @ %#x\n",
1638 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1643 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
1649 MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
1650 /* Is the next off the end */
1652 RESUME_(miniInterpretEnd);
1654 switch (EVENT_TYPE( ((eventq) MRoot) )) {
1655 case CONTINUETHREAD:
1659 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1660 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1664 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1665 Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
1669 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1670 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1674 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1675 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1679 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1680 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1684 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1691 fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n",
1692 EVENT_TYPE( ((eventq) MRoot) ), MRoot);
1695 } while (!found && MRoot!=NULL);
1702 STGFUN(_PRMarking_MarkNextClosureInFetchBuffer)
1705 /* Update root -- may have short circuited Ind */
1708 /* Is the next off the end */
1709 if (++MRoot >= sm_roots_end) {
1710 /* We know that marking a fetch buffer is only called from within
1711 marking a FETCHREPLY event; we have saved the important
1712 registers before that */
1715 MStack = (P_) _PRMarking_MarkNextEvent_closure;
1726 STGFUN(_PRMarking_MarkNextGA)
1729 /* Update root -- may have short circuited Ind */
1730 ((GALA *)MRoot)->la = Mark;
1733 MRoot = (P_) ((GALA *) MRoot)->next;
1734 } while (MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT);
1736 /* Is the next off the end */
1738 RESUME_(miniInterpretEnd);
1740 Mark = ((GALA *)MRoot)->la;
1746 STGFUN(_PRMarking_MarkNextAStack)
1749 /* Update root -- may have short circuited Ind */
1752 /* Is the next off the end */
1753 if (SUBTRACT_A_STK( (PP_) ++MRoot, stackInfo.botA) < 0)
1754 RESUME_(miniInterpretEnd);
1762 STGFUN(_PRMarking_MarkNextBStack)
1765 /* Update root -- may have short circuited Ind */
1766 PUSH_UPDATEE(MRoot, Mark);
1768 MRoot = GRAB_SuB(MRoot);
1770 /* Is the next off the end */
1771 if (SUBTRACT_B_STK(MRoot, stackInfo.botB) < 0)
1772 RESUME_(miniInterpretEnd);
1774 Mark = GRAB_UPDATEE(MRoot);
1781 Mark the next CAF in the CAF list.
1784 STGFUN(_PRMarking_MarkNextCAF)
1788 /* Update root -- may have short circuited Ind */
1789 IND_CLOSURE_PTR(MRoot) = (W_) Mark;
1791 MRoot = (P_) IND_CLOSURE_LINK(MRoot);
1793 /* Is the next CAF the end of the list */
1795 RESUME_(miniInterpretEnd);
1797 GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */
1799 Mark = (P_) IND_CLOSURE_PTR(MRoot);
1805 Multi-slurp protection.
1808 #endif /* _INFO_MARKING */