Fold ghc-prim.git into ghc.git (re #8545)
[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 "PosixSource.h"
11 #include "Rts.h"
12
13 #include "GC.h"
14 #include "Storage.h"
15 #include "Compact.h"
16 #include "Task.h"
17 #include "Capability.h"
18 #include "Trace.h"
19 #include "Schedule.h"
20 // DO NOT include "GCTDecl.h", we don't want the register variable
21
22 /* -----------------------------------------------------------------------------
23 isAlive determines whether the given closure is still alive (after
24 a garbage collection) or not. It returns the new address of the
25 closure if it is alive, or NULL otherwise.
26
27 NOTE: Use it before compaction only!
28 It untags and (if needed) retags pointers to closures.
29 -------------------------------------------------------------------------- */
30
31 StgClosure *
32 isAlive(StgClosure *p)
33 {
34 const StgInfoTable *info;
35 bdescr *bd;
36 StgWord tag;
37 StgClosure *q;
38
39 while (1) {
40 /* The tag and the pointer are split, to be merged later when needed. */
41 tag = GET_CLOSURE_TAG(p);
42 q = UNTAG_CLOSURE(p);
43
44 ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
45
46 // ignore static closures
47 //
48 // ToDo: This means we never look through IND_STATIC, which means
49 // isRetainer needs to handle the IND_STATIC case rather than
50 // raising an error.
51 //
52 // ToDo: for static closures, check the static link field.
53 // Problem here is that we sometimes don't set the link field, eg.
54 // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
55 //
56 if (!HEAP_ALLOCED_GC(q)) {
57 return p;
58 }
59
60 // ignore closures in generations that we're not collecting.
61 bd = Bdescr((P_)q);
62
63 // if it's a pointer into to-space, then we're done
64 if (bd->flags & BF_EVACUATED) {
65 return p;
66 }
67
68 // large objects use the evacuated flag
69 if (bd->flags & BF_LARGE) {
70 return NULL;
71 }
72
73 // check the mark bit for compacted steps
74 if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) {
75 return p;
76 }
77
78 info = q->header.info;
79
80 if (IS_FORWARDING_PTR(info)) {
81 // alive!
82 return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info));
83 }
84
85 info = INFO_PTR_TO_STRUCT(info);
86
87 switch (info->type) {
88
89 case IND:
90 case IND_STATIC:
91 case IND_PERM:
92 // follow indirections
93 p = ((StgInd *)q)->indirectee;
94 continue;
95
96 case BLACKHOLE:
97 p = ((StgInd*)q)->indirectee;
98 if (GET_CLOSURE_TAG(p) != 0) {
99 continue;
100 } else {
101 return NULL;
102 }
103
104 default:
105 // dead.
106 return NULL;
107 }
108 }
109 }
110
111 /* -----------------------------------------------------------------------------
112 Reverting CAFs
113 -------------------------------------------------------------------------- */
114
115 void
116 revertCAFs( void )
117 {
118 StgIndStatic *c;
119
120 for (c = revertible_caf_list;
121 c != (StgIndStatic *)END_OF_STATIC_LIST;
122 c = (StgIndStatic *)c->static_link)
123 {
124 SET_INFO((StgClosure *)c, c->saved_info);
125 c->saved_info = NULL;
126 // could, but not necessary: c->static_link = NULL;
127 }
128 revertible_caf_list = (StgIndStatic*)END_OF_STATIC_LIST;
129 }
130
131 void
132 markCAFs (evac_fn evac, void *user)
133 {
134 StgIndStatic *c;
135
136 for (c = dyn_caf_list;
137 c != (StgIndStatic*)END_OF_STATIC_LIST;
138 c = (StgIndStatic *)c->static_link)
139 {
140 evac(user, &c->indirectee);
141 }
142 for (c = revertible_caf_list;
143 c != (StgIndStatic*)END_OF_STATIC_LIST;
144 c = (StgIndStatic *)c->static_link)
145 {
146 evac(user, &c->indirectee);
147 }
148 }