tiny GC optimisation
[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 "GCThread.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: 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_GC(q)) {
53 return p;
54 }
55
56 // ignore closures in generations that we're not collecting.
57 bd = Bdescr((P_)q);
58
59 // if it's a pointer into to-space, then we're done
60 if (bd->flags & BF_EVACUATED) {
61 return p;
62 }
63
64 // large objects use the evacuated flag
65 if (bd->flags & BF_LARGE) {
66 if (get_itbl(q)->type == TSO &&
67 ((StgTSO *)p)->what_next == ThreadRelocated) {
68 p = (StgClosure *)((StgTSO *)p)->_link;
69 continue;
70 }
71 return NULL;
72 }
73
74 // check the mark bit for compacted steps
75 if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) {
76 return p;
77 }
78
79 info = q->header.info;
80
81 if (IS_FORWARDING_PTR(info)) {
82 // alive!
83 return (StgClosure*)UN_FORWARDING_PTR(info);
84 }
85
86 info = INFO_PTR_TO_STRUCT(info);
87
88 switch (info->type) {
89
90 case IND:
91 case IND_STATIC:
92 case IND_PERM:
93 case IND_OLDGEN: // rely on compatible layout with StgInd
94 case IND_OLDGEN_PERM:
95 // follow indirections
96 p = ((StgInd *)q)->indirectee;
97 continue;
98
99 case TSO:
100 if (((StgTSO *)q)->what_next == ThreadRelocated) {
101 p = (StgClosure *)((StgTSO *)q)->_link;
102 continue;
103 }
104 return NULL;
105
106 default:
107 // dead.
108 return NULL;
109 }
110 }
111 }
112
113 /* -----------------------------------------------------------------------------
114 Reverting CAFs
115 -------------------------------------------------------------------------- */
116
117 void
118 revertCAFs( void )
119 {
120 StgIndStatic *c;
121
122 for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
123 c = (StgIndStatic *)c->static_link)
124 {
125 SET_INFO(c, c->saved_info);
126 c->saved_info = NULL;
127 // could, but not necessary: c->static_link = NULL;
128 }
129 revertible_caf_list = END_OF_STATIC_LIST;
130 }
131
132 void
133 markCAFs (evac_fn evac, void *user)
134 {
135 StgIndStatic *c;
136
137 for (c = (StgIndStatic *)caf_list;
138 c != (StgIndStatic*)END_OF_STATIC_LIST;
139 c = (StgIndStatic *)c->static_link)
140 {
141 evac(user, &c->indirectee);
142 }
143 for (c = (StgIndStatic *)revertible_caf_list;
144 c != (StgIndStatic*)END_OF_STATIC_LIST;
145 c = (StgIndStatic *)c->static_link)
146 {
147 evac(user, &c->indirectee);
148 }
149 }