remove EVACUATED: store the forwarding pointer in the info pointer
[ghc.git] / rts / sm / GCAux.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team 1998-2008
4 *
5 * Functions called from outside the GC need to be separate from GC.c,
6 * because GC.c is compiled with register variable(s).
7 *
8 * ---------------------------------------------------------------------------*/
9
10 #include "Rts.h"
11 #include "Storage.h"
12 #include "MBlock.h"
13 #include "GC.h"
14 #include "Compact.h"
15 #include "Task.h"
16 #include "Capability.h"
17 #include "Trace.h"
18 #include "Schedule.h"
19 // DO NOT include "GCThread.h", we don't want the register variable
20
21 /* -----------------------------------------------------------------------------
22 isAlive determines whether the given closure is still alive (after
23 a garbage collection) or not. It returns the new address of the
24 closure if it is alive, or NULL otherwise.
25
26 NOTE: Use it before compaction only!
27 It untags and (if needed) retags pointers to closures.
28 -------------------------------------------------------------------------- */
29
30 StgClosure *
31 isAlive(StgClosure *p)
32 {
33 const StgInfoTable *info;
34 bdescr *bd;
35 StgWord tag;
36 StgClosure *q;
37
38 while (1) {
39 /* The tag and the pointer are split, to be merged later when needed. */
40 tag = GET_CLOSURE_TAG(p);
41 q = UNTAG_CLOSURE(p);
42
43 ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
44
45 // ignore static closures
46 //
47 // ToDo: for static closures, check the static link field.
48 // Problem here is that we sometimes don't set the link field, eg.
49 // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
50 //
51 if (!HEAP_ALLOCED(q)) {
52 return p;
53 }
54
55 // ignore closures in generations that we're not collecting.
56 bd = Bdescr((P_)q);
57
58 // if it's a pointer into to-space, then we're done
59 if (bd->flags & BF_EVACUATED) {
60 return p;
61 }
62
63 // large objects use the evacuated flag
64 if (bd->flags & BF_LARGE) {
65 return NULL;
66 }
67
68 // check the mark bit for compacted steps
69 if ((bd->flags & BF_COMPACTED) && is_marked((P_)q,bd)) {
70 return p;
71 }
72
73 info = q->header.info;
74
75 if (IS_FORWARDING_PTR(info)) {
76 // alive!
77 return (StgClosure*)UN_FORWARDING_PTR(info);
78 }
79
80 info = INFO_PTR_TO_STRUCT(info);
81
82 switch (info->type) {
83
84 case IND:
85 case IND_STATIC:
86 case IND_PERM:
87 case IND_OLDGEN: // rely on compatible layout with StgInd
88 case IND_OLDGEN_PERM:
89 // follow indirections
90 p = ((StgInd *)q)->indirectee;
91 continue;
92
93 case TSO:
94 if (((StgTSO *)q)->what_next == ThreadRelocated) {
95 p = (StgClosure *)((StgTSO *)q)->_link;
96 continue;
97 }
98 return NULL;
99
100 default:
101 // dead.
102 return NULL;
103 }
104 }
105 }
106
107 /* -----------------------------------------------------------------------------
108 Reverting CAFs
109 -------------------------------------------------------------------------- */
110
111 void
112 revertCAFs( void )
113 {
114 StgIndStatic *c;
115
116 for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
117 c = (StgIndStatic *)c->static_link)
118 {
119 SET_INFO(c, c->saved_info);
120 c->saved_info = NULL;
121 // could, but not necessary: c->static_link = NULL;
122 }
123 revertible_caf_list = NULL;
124 }
125
126 void
127 markCAFs (evac_fn evac, void *user)
128 {
129 StgIndStatic *c;
130
131 for (c = (StgIndStatic *)caf_list; c != NULL;
132 c = (StgIndStatic *)c->static_link)
133 {
134 evac(user, &c->indirectee);
135 }
136 for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
137 c = (StgIndStatic *)c->static_link)
138 {
139 evac(user, &c->indirectee);
140 }
141 }