vectoriser: delete dead code
[ghc-hetmet.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: 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 (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     default:
97       // dead. 
98       return NULL;
99     }
100   }
101 }
102
103 /* -----------------------------------------------------------------------------
104    Reverting CAFs
105    -------------------------------------------------------------------------- */
106
107 void
108 revertCAFs( void )
109 {
110     StgIndStatic *c;
111
112     for (c = (StgIndStatic *)revertible_caf_list; 
113          c != (StgIndStatic *)END_OF_STATIC_LIST; 
114          c = (StgIndStatic *)c->static_link) 
115     {
116         SET_INFO(c, c->saved_info);
117         c->saved_info = NULL;
118         // could, but not necessary: c->static_link = NULL; 
119     }
120     revertible_caf_list = END_OF_STATIC_LIST;
121 }
122
123 void
124 markCAFs (evac_fn evac, void *user)
125 {
126     StgIndStatic *c;
127
128     for (c = (StgIndStatic *)caf_list;
129          c != (StgIndStatic*)END_OF_STATIC_LIST; 
130          c = (StgIndStatic *)c->static_link) 
131     {
132         evac(user, &c->indirectee);
133     }
134     for (c = (StgIndStatic *)revertible_caf_list; 
135          c != (StgIndStatic*)END_OF_STATIC_LIST; 
136          c = (StgIndStatic *)c->static_link) 
137     {
138         evac(user, &c->indirectee);
139     }
140 }