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 extern P_ ret_MRoot, ret_Mark;
203 Define appropriate variables as potential register variables.
204 Assume GC code saves and restores any global registers used.
207 RegisterTable MarkRegTable;
210 @_startMarkWorld@ restores registers if necessary, then marks the
211 root pointed to by @Mark@.
214 STGFUN(_startMarkWorld)
217 #if defined(__STG_GCC_REGS__) && defined(__GNUC__)
218 /* If using registers load from _SAVE (see SMmarking.lc) */
220 /* I deeply suspect this should be RESTORE_REGS(...) [WDP 95/02] */
222 MarkBaseReg = &MarkRegTable;
226 MStack = SAVE_MStack;
227 BitArray = SAVE_BitArray;
228 HeapBase = SAVE_HeapBase;
229 HeapLim = SAVE_HeapLim;
237 This is the pointer reversal start code for \tr{SPEC} closures with 0
244 if (IS_MARK_BIT_SET(Mark)) {
247 INIT_MARK_NODE("SPEC",0);
255 This macro defines the format of the pointer reversal start code for a
256 number of pointers \tr{ptrs}, $>$ 0.
260 #define SPEC_PRStart_N_CODE(ptrs) \
261 STGFUN(CAT2(_PRStart_,ptrs)) \
264 if (IS_MARK_BIT_SET(Mark)) { \
268 INIT_MARK_NODE("SPEC",ptrs); \
269 INIT_MSTACK(SPEC_CLOSURE_PTR); \
276 The definitions of the start code for \tr{SPEC} closures with 1-12
280 SPEC_PRStart_N_CODE(1)
281 SPEC_PRStart_N_CODE(2)
282 SPEC_PRStart_N_CODE(3)
283 SPEC_PRStart_N_CODE(4)
284 SPEC_PRStart_N_CODE(5)
285 SPEC_PRStart_N_CODE(6)
286 SPEC_PRStart_N_CODE(7)
287 SPEC_PRStart_N_CODE(8)
288 SPEC_PRStart_N_CODE(9)
289 SPEC_PRStart_N_CODE(10)
290 SPEC_PRStart_N_CODE(11)
291 SPEC_PRStart_N_CODE(12)
295 Start code for revertible black holes with underlying @SPEC@ types.
299 #if defined(PAR) || defined(GRAN)
300 #define SPEC_RBH_PRStart_N_CODE(ptrs) \
301 STGFUN(CAT2(_PRStart_RBH_,ptrs)) \
304 if (IS_MARK_BIT_SET(Mark)) { \
308 INIT_MARK_NODE("SRBH",ptrs-1); \
309 INIT_MSTACK(SPEC_RBH_CLOSURE_PTR); \
314 SPEC_RBH_PRStart_N_CODE(2)
315 SPEC_RBH_PRStart_N_CODE(3)
316 SPEC_RBH_PRStart_N_CODE(4)
317 SPEC_RBH_PRStart_N_CODE(5)
318 SPEC_RBH_PRStart_N_CODE(6)
319 SPEC_RBH_PRStart_N_CODE(7)
320 SPEC_RBH_PRStart_N_CODE(8)
321 SPEC_RBH_PRStart_N_CODE(9)
322 SPEC_RBH_PRStart_N_CODE(10)
323 SPEC_RBH_PRStart_N_CODE(11)
324 SPEC_RBH_PRStart_N_CODE(12)
330 @SPEC_PRIn_N_CODE@ has two different meanings, depending on the world
334 In the commoned-info-table world, it
335 defines the ``in'' code for a particular number
336 of pointers, and subsumes the functionality of @SPEC_PRInLast_N_NODE@ below.
338 Otherwise, it defines the ``in'' code for a particular pointer in a
344 #define SPEC_PRIn_N_CODE(ptrs) \
345 STGFUN(CAT2(_PRIn_,ptrs)) \
349 GET_MARKED_PTRS(mbw,MStack,ptrs); \
350 if (++mbw < ptrs) { \
351 SET_MARKED_PTRS(MStack,ptrs,mbw); \
352 CONTINUE_MARKING_NODE("SPEC",mbw); \
353 MOVE_TO_NEXT_PTR(SPEC_CLOSURE_PTR,mbw); \
355 SET_MARKED_PTRS(MStack,ptrs,0L); \
356 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,ptrs); \
363 Now @SPEC_PRIn_N_CODE@ is used to define the individual entries for \tr{SPEC} closures
370 fprintf(stderr,"Called _PRIn_0\nShould never occur!\n");
377 POP_MSTACK("SPEC",SPEC_CLOSURE_PTR,1);
393 In code for revertible black holes with underlying @SPEC@ types.
396 #if defined(PAR) || defined(GRAN)
397 #define SPEC_RBH_PRIn_N_CODE(ptrs) \
398 STGFUN(CAT2(_PRIn_RBH_,ptrs)) \
402 GET_MARKED_PTRS(mbw,MStack,ptrs-1); \
403 if (++mbw < ptrs-1) { \
404 SET_MARKED_PTRS(MStack,ptrs-1,mbw); \
405 CONTINUE_MARKING_NODE("SRBH",mbw); \
406 MOVE_TO_NEXT_PTR(SPEC_RBH_CLOSURE_PTR,mbw); \
408 SET_MARKED_PTRS(MStack,ptrs-1,0L); \
409 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,ptrs-1); \
417 POP_MSTACK("SRBH",SPEC_RBH_CLOSURE_PTR,1);
421 SPEC_RBH_PRIn_N_CODE(3)
422 SPEC_RBH_PRIn_N_CODE(4)
423 SPEC_RBH_PRIn_N_CODE(5)
424 SPEC_RBH_PRIn_N_CODE(6)
425 SPEC_RBH_PRIn_N_CODE(7)
426 SPEC_RBH_PRIn_N_CODE(8)
427 SPEC_RBH_PRIn_N_CODE(9)
428 SPEC_RBH_PRIn_N_CODE(10)
429 SPEC_RBH_PRIn_N_CODE(11)
430 SPEC_RBH_PRIn_N_CODE(12)
435 Foreign Objs are in the non-parallel world only.
441 STGFUN(_PRStart_ForeignObj)
444 if (IS_MARK_BIT_SET(Mark)) {
447 INIT_MARK_NODE("ForeignObj ",0);
454 This defines the start code for generic (\tr{GEN}) closures.
463 if (IS_MARK_BIT_SET(Mark)) {
467 ptrs = GEN_CLOSURE_NoPTRS(Mark);
468 INIT_MARK_NODE("GEN ",ptrs);
472 INIT_MSTACK(GEN_CLOSURE_PTR);
478 Now the ``in'' code for \tr{GEN} closures.
488 ptrs = GEN_CLOSURE_NoPTRS(MStack);
489 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
492 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
493 CONTINUE_MARKING_NODE("GEN",pos);
494 MOVE_TO_NEXT_PTR(GEN_CLOSURE_PTR,pos);
496 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
497 POP_MSTACK("GEN ",GEN_CLOSURE_PTR,ptrs);
503 And the start/in code for a revertible black hole with an underlying @GEN@ closure.
507 #if defined(PAR) || defined(GRAN)
509 STGFUN(_PRStart_RBH_N)
515 if (IS_MARK_BIT_SET(Mark)) {
521 * Get pointer count from original closure and adjust for one pointer
522 * in the first two words of the RBH.
524 ptrs = GEN_RBH_CLOSURE_NoPTRS(Mark);
530 INIT_MARK_NODE("GRBH", ptrs);
531 INIT_MSTACK(GEN_RBH_CLOSURE_PTR);
543 * Get pointer count from original closure and adjust for one pointer
544 * in the first two words of the RBH.
546 ptrs = GEN_RBH_CLOSURE_NoPTRS(MStack);
552 GET_GEN_MARKED_PTRS(pos, MStack, ptrs);
555 SET_GEN_MARKED_PTRS(MStack, ptrs, pos);
556 CONTINUE_MARKING_NODE("GRBH", pos);
557 MOVE_TO_NEXT_PTR(GEN_RBH_CLOSURE_PTR, pos);
559 SET_GEN_MARKED_PTRS(MStack, ptrs, 0L);
560 POP_MSTACK("GRBH", GEN_RBH_CLOSURE_PTR, ptrs);
569 Start code for dynamic (\tr{DYN}) closures. There is no \tr{DYN}
570 closure with 0 pointers -- \tr{DATA} is used instead.
576 if (IS_MARK_BIT_SET(Mark)) {
580 INIT_MARK_NODE("DYN ", DYN_CLOSURE_NoPTRS(Mark));
581 INIT_MSTACK(DYN_CLOSURE_PTR);
587 and the corresponding ``in'' code.
596 ptrs = DYN_CLOSURE_NoPTRS(MStack);
597 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
600 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
601 CONTINUE_MARKING_NODE("DYN",pos);
602 MOVE_TO_NEXT_PTR(DYN_CLOSURE_PTR,pos);
604 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
605 POP_MSTACK("DYN ",DYN_CLOSURE_PTR,ptrs);
612 The start code for \tr{TUPLE} (all-pointer) objects. There can be no
613 such object without any pointers, so we don't check for this case.
616 STGFUN(_PRStart_Tuple)
619 if (IS_MARK_BIT_SET(Mark)) {
623 INIT_MARK_NODE("TUPL", TUPLE_CLOSURE_NoPTRS(Mark));
624 INIT_MSTACK(TUPLE_CLOSURE_PTR);
633 STGFUN(_PRIn_I_Tuple)
639 ptrs = TUPLE_CLOSURE_NoPTRS(MStack);
640 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
643 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
644 CONTINUE_MARKING_NODE("TUPL",pos);
645 MOVE_TO_NEXT_PTR(TUPLE_CLOSURE_PTR,pos);
647 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
648 POP_MSTACK("TUPL",TUPLE_CLOSURE_PTR,ptrs);
656 /*** MUTUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
657 /* Only if special GC treatment required */
659 #ifdef GC_MUT_REQUIRED
661 STGFUN(_PRStart_MuTuple)
664 if (IS_MARK_BIT_SET(Mark)) {
668 INIT_MARK_NODE("MUT ", MUTUPLE_CLOSURE_NoPTRS(Mark));
669 INIT_MSTACK(MUTUPLE_CLOSURE_PTR);
674 STGFUN(_PRIn_I_MuTuple)
680 ptrs = MUTUPLE_CLOSURE_NoPTRS(MStack);
681 GET_GEN_MARKED_PTRS(pos,MStack,ptrs);
684 SET_GEN_MARKED_PTRS(MStack,ptrs,pos);
685 CONTINUE_MARKING_NODE("MUT",pos);
686 MOVE_TO_NEXT_PTR(MUTUPLE_CLOSURE_PTR,pos);
688 SET_GEN_MARKED_PTRS(MStack,ptrs,0L);
689 POP_MSTACK("MUT ",MUTUPLE_CLOSURE_PTR,ptrs);
694 #endif /* GCap || GCgn */
697 There are no pointers in a \tr{DATA} closure, so just mark the
701 STGFUN(_PRStart_Data)
704 if (IS_MARK_BIT_SET(Mark)) {
707 INIT_MARK_NODE("DATA", 0);
713 %****************************************************************************
715 \subsubsection[mark-specials]{Special cases}
717 %****************************************************************************
719 Black hole closures simply mark themselves and return.
725 if (IS_MARK_BIT_SET(Mark)) {
728 INIT_MARK_NODE("BH ", 0);
734 Marking a Static Closure -- Just return as if Marked
737 STGFUN(_PRStart_Static)
746 Marking an Indirection -- Set Mark to ind addr and mark this.
747 Updating of reference when we return will short indirection.
754 GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
756 Mark = (P_) IND_CLOSURE_PTR(Mark);
762 ``Permanent indirection''---used in profiling. Works basically
763 like @_PRStart_1@ (one pointer).
765 #if defined(PROFILING) || defined(TICKY_TICKY)
771 if (IS_MARK_BIT_SET(Mark)) {
775 INIT_MARK_NODE("PI ",1);
776 /* the "1" above is dodgy (i.e. wrong), but it is never
777 used except in debugging info. ToDo??? WDP 95/07
779 INIT_MSTACK(PERM_IND_CLOSURE_PTR);
787 POP_MSTACK("PI ",PERM_IND_CLOSURE_PTR,1);
788 /* the "1" above is dodgy (i.e. wrong), but it is never
789 used except in debugging info. ToDo??? WDP 95/07
794 #endif /* PROFILING or TICKY */
797 Marking a ``selector closure'': This is a size-2 SPEC thunk that
798 selects word $n$; if the thunk's pointee is evaluated, then we short
799 out the selection, {\em just like an indirection}. If it is still
800 unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}.
802 {\em Should we select ``on the way down'' (in \tr{_PRStart_Selector})
803 or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on
804 the way down. Downside: we are flummoxed by indirections, so we'll
805 have to wait until the {\em next} major GC to do the selections (after
806 the indirections are shorted out in this GC). But the downside of
807 doing selections on the way back up is that we are then in a world of
808 reversed pointers, and selecting a reversed pointer---we've see this
809 on selectors for very recursive structures---is a total disaster.
814 #define IF_GC_DEBUG(x) x
816 #define IF_GC_DEBUG(x) /*nothing*/
819 #if !defined(CONCURRENT)
820 # define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling)
822 # define NOT_BLACKHOLING 0
825 /* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */
827 #define MARK_SELECTOR(n) \
828 STGFUN(CAT2(_PRStartSelector_,n)) \
833 /* must be a SPEC 2 1 closure */ \
834 ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \
835 ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \
836 ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \
838 if (IS_MARK_BIT_SET(Mark)) { /* already marked */ \
843 maybe_con = (P_) *(Mark + _FHS); \
846 if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) { \
847 fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \
848 (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \
849 INFO_NoPTRS(INFO_PTR(Mark)), \
850 maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \
851 INFO_PTR(maybe_con)); \
852 fprintf(stderr, ", tag %ld, size %ld, ptrs %ld", \
853 INFO_TAG(INFO_PTR(maybe_con)), \
854 INFO_SIZE(INFO_PTR(maybe_con)), \
855 INFO_NoPTRS(INFO_PTR(maybe_con))); \
856 if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \
857 fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \
859 fprintf(stderr, "\n"); \
862 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\
863 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \
864 || INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ \
865 || NOT_BLACKHOLING /* see "price of laziness" paper */ \
866 || (! RTSflags.GcFlags.doSelectorsAtGC )) \
867 /* see below for OLD test we used here (WDP 95/04) */ \
868 /* ToDo: decide WHNFness another way? */ \
871 /* some things should be true about the pointee */ \
872 ASSERT(INFO_TAG(INFO_PTR(maybe_con)) == 0); \
873 /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \
875 /* OK, it is evaluated: behave just like an indirection */ \
876 GC_SEL_MAJOR(); /* ticky-ticky */ \
878 Mark = (P_) (maybe_con[_FHS + (n)]); \
879 /* Mark now has the result of the selection */ \
887 the IS_STATIC test was to protect the IS_MARK_BIT_SET check;
888 but the IS_MARK_BIT_SET test was only there to avoid
889 mangled pointers, but we cannot have mangled pointers anymore
890 (after RTBLs came our way).
891 SUMMARY: we toss both of the "guard" tests.
893 if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */
894 || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */
895 || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */
912 #undef IF_GC_DEBUG /* get rid of it */
915 Marking a Constant Closure -- Set Mark to corresponding static
916 closure. Updating of reference will redirect reference to the static
920 STGFUN(_PRStart_Const)
927 Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
930 if (IS_MARK_BIT_SET(Mark)) {
933 if (!AllFlags.doUpdEntryCounts) {
935 GC_COMMON_CONST(); /* ticky */
937 Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark));
939 } else { /* no commoning */
940 INIT_MARK_NODE("CONST ",0);
950 Marking a CharLike Closure -- Set Mark to corresponding static
951 closure. Updating of reference will redirect reference to the static
955 STGFUN(_PRStart_CharLike)
968 Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark));
972 if (IS_MARK_BIT_SET(Mark)) {
975 val = CHARLIKE_VALUE(Mark);
977 if (!AllFlags.doUpdEntryCounts) {
978 GC_COMMON_CHARLIKE(); /* ticky */
980 INFO_PTR(Mark) = (W_) Ind_info;
981 IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val);
982 Mark = (P_) IND_CLOSURE_PTR(Mark);
984 } else { /* no commoning */
985 INIT_MARK_NODE("CHAR ",0);
995 Marking an IntLike Closure -- Set Mark to corresponding static closure
996 if in range. Updating of reference to this will redirect reference to
1000 STGFUN(_PRStart_IntLike)
1005 if (IS_MARK_BIT_SET(Mark)) {
1008 val = INTLIKE_VALUE(Mark);
1010 if (val >= MIN_INTLIKE
1011 && val <= MAX_INTLIKE
1013 && !AllFlags.doUpdEntryCounts
1016 DEBUG_PR_INTLIKE_TO_STATIC;
1017 GC_COMMON_INTLIKE(); /* ticky */
1019 INFO_PTR(Mark) = (W_) Ind_info;
1020 IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val);
1021 Mark = (P_) IND_CLOSURE_PTR(Mark);
1023 } else { /* out of range of static closures */
1024 DEBUG_PR_INTLIKE_IN_HEAP;
1026 if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
1028 INIT_MARK_NODE("INT ",0);
1036 Special error routine, used for closures which should never call their
1043 fprintf(stderr,"Called _PRIn_Error\nShould never occur!\n");
1049 %****************************************************************************
1051 \subsubsection[mark-fetchme]{Marking FetchMe Objects (parallel only)}
1053 %****************************************************************************
1059 FetchMe's present a unique problem during global GC. Since the IMU short-circuits
1060 indirections during its evacuation, it may return a PLC as the new global address
1061 for a @FetchMe@ node. This has the effect of turning the @FetchMe@ into an
1062 indirection during local garbage collection. Of course, we'd like to short-circuit
1063 this indirection immediately.
1066 STGFUN(_PRStart_FetchMe)
1069 if (IS_MARK_BIT_SET(Mark)) {
1072 INIT_MARK_NODE("FME ", 0);
1081 if (IS_MARK_BIT_SET(Mark)) {
1085 INIT_MARK_NODE("BF ", BF_CLOSURE_NoPTRS(dummy));
1086 INIT_MSTACK(BF_CLOSURE_PTR);
1096 GET_MARKED_PTRS(mbw, MStack, BF_CLOSURE_NoPTRS(dummy));
1097 if (++mbw < BF_CLOSURE_NoPTRS(dummy)) {
1098 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), mbw);
1099 CONTINUE_MARKING_NODE("BF ", mbw);
1100 MOVE_TO_NEXT_PTR(BF_CLOSURE_PTR, mbw);
1102 SET_MARKED_PTRS(MStack, BF_CLOSURE_NoPTRS(dummy), 0L);
1103 POP_MSTACK("BF ", BF_CLOSURE_PTR, BF_CLOSURE_NoPTRS(dummy));
1111 %****************************************************************************
1113 \subsubsection[mark-tso]{Marking Thread State Objects (threaded only)}
1115 %****************************************************************************
1117 First mark the link, then mark all live registers (StkO plus the VanillaRegs
1118 indicated by Liveness).
1120 CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD!
1129 if (IS_MARK_BIT_SET(Mark)) {
1133 INIT_MARK_NODE("BQ ", BQ_CLOSURE_NoPTRS(Mark));
1134 INIT_MSTACK(BQ_CLOSURE_PTR);
1142 POP_MSTACK("BQ ",BQ_CLOSURE_PTR,1);
1146 STGFUN(_PRStart_TSO)
1150 if (IS_MARK_BIT_SET(Mark)) {
1154 INIT_MARK_NODE("TSO ", 0);
1155 temp = TSO_LINK(Mark);
1156 TSO_LINK(Mark) = MStack;
1165 When we're in the TSO, pos 0 is the link, 1 is the StkO, and 2-10 correspond to
1166 the vanilla registers r[pos-2].
1172 BitWord oldpos, newpos;
1173 STGRegisterTable *r;
1177 GET_MARKED_PTRS(oldpos,MStack,TSO_PTRS);
1178 r = TSO_INTERNAL_PTR(MStack);
1182 /* Just did the link; now do the StkO */
1183 SET_MARKED_PTRS(MStack,TSO_PTRS,1L);
1185 r->rStkO = TSO_LINK(MStack);
1186 TSO_LINK(MStack) = Mark;
1188 DEBUG_PRIN("TSO ", 1);
1192 /* Just did the StkO; just update it, saving the old mstack */
1197 /* update the register we just did; save the old mstack */
1198 mstack = r->rR[oldpos - 2].p;
1199 r->rR[oldpos - 2] = Mark;
1203 /* liveness of the remaining registers */
1204 liveness = r->rLiveness >> (oldpos - 1);
1206 if (liveness == 0) {
1207 /* Restore MStack and return */
1208 SET_MARKED_PTRS(MStack,TSO_PTRS,0L);
1209 DEBUG_PRLAST("TSO ", oldpos);
1215 /* More to do in this TSO */
1217 /* Shift past non-ptr registers */
1218 for(newpos = oldpos + 1; (liveness & 1) == 0; liveness >>= 1) {
1222 /* Mark the next one */
1223 SET_MARKED_PTRS(MStack,TSO_PTRS,newpos);
1224 Mark = r->rR[newpos - 2].p;
1225 r->rR[newpos - 2].p = mstack;
1226 DEBUG_PRIN("TSO ", oldpos);
1234 %****************************************************************************
1236 \subsubsection[mark-stko]{Marking Stack Objects (threaded only)}
1238 %****************************************************************************
1240 First mark the A stack, then mark all updatees in the B stack.
1244 STGFUN(_PRStart_StkO)
1252 /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */
1254 if (IS_MARK_BIT_SET(Mark)) {
1258 INIT_MARK_NODE("STKO", 0);
1259 size = STKO_CLOSURE_SIZE(Mark);
1260 cts_size = STKO_CLOSURE_CTS_SIZE(Mark);
1261 SET_GEN_MARKED_PTRS(Mark,size,(BitWord)(cts_size + 1));
1262 temp = STKO_LINK(Mark);
1263 STKO_LINK(Mark) = MStack;
1272 Now the ``in'' code for \tr{STKO} closures. First the A stack is flushed,
1273 then we chain down the update frames in the B stack, marking the update
1274 nodes. When all have been marked we pop the stack and return.
1279 BitWord oldpos, newpos;
1285 size = STKO_CLOSURE_SIZE(MStack);
1286 GET_GEN_MARKED_PTRS(oldpos, MStack, size);
1288 if (oldpos > STKO_CLOSURE_CTS_SIZE(MStack)) {
1289 /* Update the link, saving the old mstack */
1290 mstack = STKO_LINK(MStack);
1291 STKO_LINK(MStack) = Mark;
1293 /* Update the pointer, saving the old mstack */
1294 mstack = (P_) STKO_CLOSURE_PTR(MStack, oldpos);
1295 STKO_CLOSURE_PTR(MStack, oldpos) = (W_) Mark;
1298 /* Calculate the next position to mark */
1299 if (oldpos > STKO_SpA_OFFSET(MStack)) {
1300 /* Just walk backwards down the A stack */
1301 newpos = oldpos - 1;
1302 SET_GEN_MARKED_PTRS(MStack,size,newpos);
1303 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos);
1304 STKO_CLOSURE_PTR(MStack, newpos) = (W_) mstack;
1305 DEBUG_PRIN("STKA", oldpos);
1307 } else if (oldpos <= STKO_SuB_OFFSET(MStack)) {
1308 /* We're looking at an updatee in the B stack; find the next SuB up the chain */
1311 subptr = GRAB_SuB(STKO_CLOSURE_ADDR(MStack, oldpos - BREL(UF_UPDATEE)));
1312 newpos = STKO_CLOSURE_OFFSET(MStack,subptr);
1314 /* Just fell off the end of the A stack; grab the first SuB */
1315 newpos = STKO_SuB_OFFSET(MStack);
1318 if (newpos == 0) { /* Grrr... newpos is 1-based */
1319 /* Restore MStack and return */
1320 SET_GEN_MARKED_PTRS(MStack,size,0L);
1321 DEBUG_PRLAST("STKO", oldpos);
1327 /* newpos is actually the SuB; we want the corresponding updatee */
1328 SET_GEN_MARKED_PTRS(MStack,size,newpos + BREL(UF_UPDATEE));
1329 Mark = (P_) STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE));
1330 STKO_CLOSURE_PTR(MStack, newpos + BREL(UF_UPDATEE)) = (W_) mstack;
1331 DEBUG_PRIN("STKB", oldpos);
1336 #endif /* CONCURRENT */
1339 %****************************************************************************
1341 \subsubsection[mark-caf]{Marking CAFs}
1343 %****************************************************************************
1345 A CAF is shorted out as if it were an indirection.
1346 The CAF reference is explicitly updated by the garbage collector.
1349 STGFUN(_PRStart_Caf)
1353 GC_SHORT_CAF(); /* ticky */
1355 Mark = (P_) IND_CLOSURE_PTR(Mark);
1361 %****************************************************************************
1363 \subsection[mark-root]{Root Marking Code}
1365 %****************************************************************************
1367 Used by \tr{SMmarking.lc} -- but needs to be in \tr{.lhc} file.
1369 These are routines placed in closures at the bottom of the marking stack
1372 STGFUN(_Dummy_PRReturn_entry)
1375 fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n");
1380 /* various ways to call _Dummy_PRReturn_entry: */
1382 INTFUN(_PRMarking_MarkNextRoot_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1384 INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1387 INTFUN(_PRMarking_MarkNextGA_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1389 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1390 INTFUN(_PRMarking_MarkNextAStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1391 INTFUN(_PRMarking_MarkNextBStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1393 INTFUN(_PRMarking_MarkNextCAF_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1396 INTFUN(_PRMarking_MarkNextEvent_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1397 INTFUN(_PRMarking_MarkNextClosureInFetchBuffer_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; }
1400 /* end of various ways to call _Dummy_PRReturn_entry */
1402 EXTFUN(_PRMarking_MarkNextRoot);
1403 EXTFUN(_PRMarking_MarkNextCAF);
1406 EXTFUN(_PRMarking_MarkNextSpark);
1410 EXTFUN(_PRMarking_MarkNextGA);
1412 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1413 EXTFUN(_PRMarking_MarkNextAStack);
1414 EXTFUN(_PRMarking_MarkNextBStack);
1416 #endif /* not parallel */
1418 CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN")
1419 /* just one, shared */
1421 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure,
1422 _PRMarking_MarkNextRoot_info,
1423 _PRMarking_MarkNextRoot,
1424 _PRMarking_MarkNextRoot_entry);
1427 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure,
1428 _PRMarking_MarkNextSpark_info,
1429 _PRMarking_MarkNextSpark,
1430 _PRMarking_MarkNextSpark_entry);
1434 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextEvent_closure,
1435 _PRMarking_MarkNextEvent_info,
1436 _PRMarking_MarkNextEvent,
1437 _PRMarking_MarkNextEvent_entry);
1438 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextClosureInFetchBuffer_closure,
1439 _PRMarking_MarkNextClosureInFetchBuffer_info,
1440 _PRMarking_MarkNextClosureInFetchBuffer,
1441 _PRMarking_MarkNextClosureInFetchBuffer_entry);
1445 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure,
1446 _PRMarking_MarkNextGA_info,
1447 _PRMarking_MarkNextGA,
1448 _PRMarking_MarkNextGA_entry);
1450 # if 1 /* !defined(CONCURRENT) */ /* HWL */
1451 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure,
1452 _PRMarking_MarkNextAStack_info,
1453 _PRMarking_MarkNextAStack,
1454 _PRMarking_MarkNextAStack_entry);
1456 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure,
1457 _PRMarking_MarkNextBStack_info,
1458 _PRMarking_MarkNextBStack,
1459 _PRMarking_MarkNextBStack_entry);
1463 DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure,
1464 _PRMarking_MarkNextCAF_info,
1465 _PRMarking_MarkNextCAF,
1466 _PRMarking_MarkNextCAF_entry);
1468 extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */
1470 STGFUN(_PRMarking_MarkNextRoot)
1473 /* Update root -- may have short circuited Ind */
1476 /* Is the next off the end */
1477 if (++MRoot >= sm_roots_end)
1478 RESUME_(miniInterpretEnd);
1485 #if defined(CONCURRENT)
1487 extern P_ sm_roots_end; /* PendingSparksTl[pool] */
1489 STGFUN(_PRMarking_MarkNextSpark)
1492 /* Update root -- may have short circuited Ind */
1495 /* Is the next off the end */
1496 if (++MRoot >= sm_roots_end)
1497 RESUME_(miniInterpretEnd);
1504 STGFUN(_PRMarking_MarkNextSpark)
1506 /* This is more similar to MarkNextGA than to the MarkNextSpark in
1507 concurrent-but-not-gran land
1508 NB: MRoot is a spark (with an embedded pointer to a closure) */
1510 /* Update root -- may have short circuited Ind */
1511 SPARK_NODE( ((sparkq) MRoot) ) = Mark;
1512 MRoot = (P_) SPARK_NEXT( ((sparkq) MRoot) );
1514 /* Is the next off the end */
1516 RESUME_(miniInterpretEnd);
1518 Mark = (P_) SPARK_NODE( ((sparkq) MRoot) );
1523 #endif /* CONCURRENT */
1526 Note: Events are GranSim-only.
1527 Marking events is similar to marking GALA entries in parallel-land.
1528 The major difference is that depending on the type of the event we have
1529 to mark different field of the event (possibly several fields).
1530 Even worse, in the case of bulk fetching
1531 (@RTSflags.GranFlags.DoGUMMFetching@) we find a buffer of pointers to
1532 closures we have to mark (similar to sparks in concurrent-but-not-gransim
1537 STGFUN(_PRMarking_MarkNextEvent)
1539 rtsBool found = rtsFalse;
1543 /* First update the right component of the old event */
1544 switch (EVENT_TYPE( ((eventq) MRoot) )) {
1545 case CONTINUETHREAD:
1549 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1552 SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) )) = (P_) Mark;
1555 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1557 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1558 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1559 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1563 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1564 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1567 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
1573 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1575 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1576 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1577 /* In the case of packet fetching, EVENT_NODE(event) points to */
1578 /* the packet (currently, malloced). The packet is just a list of */
1579 /* closure addresses, with the length of the list at index 1 (the */
1580 /* structure of the packet is defined in Pack.lc). */
1581 if ( RTSflags.GranFlags.DoGUMMFetching ) {
1582 P_ buffer = (P_) EVENT_NODE( ((eventq) MRoot) );
1583 int size = (int) buffer[PACK_SIZE_LOCN];
1585 /* was: for (i = PACK_HDR_SIZE; i <= size-1; i++) ... */
1586 sm_roots_end = buffer + PACK_HDR_SIZE + size;
1587 MRoot = (P_) buffer + PACK_HDR_SIZE;
1591 MStack = (P_) _PRMarking_MarkNextClosureInFetchBuffer_closure;
1594 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1599 if ( RTSflags.GranFlags.DoGUMMFetching ) {
1600 /* no update necessary; fetch buffers are malloced */
1602 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1604 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1607 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHREPLY event @ %#x\n",
1614 switch (EVENT_GC_INFO( ((eventq) MRoot) )) {
1616 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1617 EVENT_GC_INFO( ((eventq) MRoot) ) = 1;
1618 Mark = (P_) EVENT_NODE( ((eventq) MRoot) );
1623 EVENT_NODE( ((eventq) MRoot) ) = (P_) Mark;
1624 EVENT_GC_INFO( ((eventq) MRoot) ) = 0; /* reset flag */
1627 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of GLOBALBLOCK event @ %#x\n",
1633 EVENT_TSO( ((eventq) MRoot) ) = (P_) Mark;
1638 fprintf(stderr,"PRMarking_MarkNextEvent: Illegal gc_info field of FETCHNODE event @ %#x\n",
1644 MRoot = (P_) EVENT_NEXT( ((eventq) MRoot) );
1645 /* Is the next off the end */
1647 RESUME_(miniInterpretEnd);
1649 switch (EVENT_TYPE( ((eventq) MRoot) )) {
1650 case CONTINUETHREAD:
1654 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1655 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1659 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1660 Mark = (P_) SPARK_NODE(EVENT_SPARK( ((eventq) MRoot) ));
1664 EVENT_GC_INFO( ((eventq) MRoot) ) = 0;
1665 Mark = (P_) EVENT_TSO( ((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 Mark = (P_) EVENT_TSO( ((eventq) MRoot) );
1686 fprintf(stderr,"Unknown event type %d (event @ %#x) in SMmarking_NextEvent\n",
1687 EVENT_TYPE( ((eventq) MRoot) ), MRoot);
1690 } while (!found && MRoot!=NULL);
1697 STGFUN(_PRMarking_MarkNextClosureInFetchBuffer)
1700 /* Update root -- may have short circuited Ind */
1703 /* Is the next off the end */
1704 if (++MRoot >= sm_roots_end) {
1705 /* We know that marking a fetch buffer is only called from within
1706 marking a FETCHREPLY event; we have saved the important
1707 registers before that */
1710 MStack = (P_) _PRMarking_MarkNextEvent_closure;
1721 STGFUN(_PRMarking_MarkNextGA)
1724 /* Update root -- may have short circuited Ind */
1725 ((GALA *)MRoot)->la = Mark;
1728 MRoot = (P_) ((GALA *) MRoot)->next;
1729 } while (MRoot != NULL && ((GALA *)MRoot)->ga.weight == MAX_GA_WEIGHT);
1731 /* Is the next off the end */
1733 RESUME_(miniInterpretEnd);
1735 Mark = ((GALA *)MRoot)->la;
1741 #if 1 /* !defined(CONCURRENT) */ /* HWL */
1742 STGFUN(_PRMarking_MarkNextAStack)
1745 /* Update root -- may have short circuited Ind */
1748 /* Is the next off the end */
1749 if (SUBTRACT_A_STK( (PP_) ++MRoot, stackInfo.botA) < 0)
1750 RESUME_(miniInterpretEnd);
1758 STGFUN(_PRMarking_MarkNextBStack)
1761 /* Update root -- may have short circuited Ind */
1762 PUSH_UPDATEE(MRoot, Mark);
1764 MRoot = GRAB_SuB(MRoot);
1766 /* Is the next off the end */
1767 if (SUBTRACT_B_STK(MRoot, stackInfo.botB) < 0)
1768 RESUME_(miniInterpretEnd);
1770 Mark = GRAB_UPDATEE(MRoot);
1774 #endif /* !CONCURRENT */
1778 Mark the next CAF in the CAF list.
1781 STGFUN(_PRMarking_MarkNextCAF)
1785 /* Update root -- may have short circuited Ind */
1786 IND_CLOSURE_PTR(MRoot) = (W_) Mark;
1788 MRoot = (P_) IND_CLOSURE_LINK(MRoot);
1790 /* Is the next CAF the end of the list */
1792 RESUME_(miniInterpretEnd);
1794 GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */
1796 Mark = (P_) IND_CLOSURE_PTR(MRoot);
1802 Multi-slurp protection.
1805 #endif /* _INFO_MARKING */