Reorganisation to fix problems related to the gct register variable
[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 info = get_itbl(q);
45
46 // ignore static closures
47 //
48 // ToDo: for static closures, check the static link field.
49 // Problem here is that we sometimes don't set the link field, eg.
50 // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
51 //
52 if (!HEAP_ALLOCED(q)) {
53 return p;
54 }
55
56 // ignore closures in generations that we're not collecting.
57 bd = Bdescr((P_)q);
58 if (bd->gen_no > N) {
59 return p;
60 }
61
62 // if it's a pointer into to-space, then we're done
63 if (bd->flags & BF_EVACUATED) {
64 return p;
65 }
66
67 // large objects use the evacuated flag
68 if (bd->flags & BF_LARGE) {
69 return NULL;
70 }
71
72 // check the mark bit for compacted steps
73 if ((bd->flags & BF_COMPACTED) && is_marked((P_)q,bd)) {
74 return p;
75 }
76
77 switch (info->type) {
78
79 case IND:
80 case IND_STATIC:
81 case IND_PERM:
82 case IND_OLDGEN: // rely on compatible layout with StgInd
83 case IND_OLDGEN_PERM:
84 // follow indirections
85 p = ((StgInd *)q)->indirectee;
86 continue;
87
88 case EVACUATED:
89 // alive!
90 return ((StgEvacuated *)q)->evacuee;
91
92 case TSO:
93 if (((StgTSO *)q)->what_next == ThreadRelocated) {
94 p = (StgClosure *)((StgTSO *)q)->link;
95 continue;
96 }
97 return NULL;
98
99 default:
100 // dead.
101 return NULL;
102 }
103 }
104 }
105
106 /* -----------------------------------------------------------------------------
107 Reverting CAFs
108 -------------------------------------------------------------------------- */
109
110 void
111 revertCAFs( void )
112 {
113 StgIndStatic *c;
114
115 for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
116 c = (StgIndStatic *)c->static_link)
117 {
118 SET_INFO(c, c->saved_info);
119 c->saved_info = NULL;
120 // could, but not necessary: c->static_link = NULL;
121 }
122 revertible_caf_list = NULL;
123 }
124
125 void
126 markCAFs (evac_fn evac, void *user)
127 {
128 StgIndStatic *c;
129
130 for (c = (StgIndStatic *)caf_list; c != NULL;
131 c = (StgIndStatic *)c->static_link)
132 {
133 evac(user, &c->indirectee);
134 }
135 for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
136 c = (StgIndStatic *)c->static_link)
137 {
138 evac(user, &c->indirectee);
139 }
140 }