Re-enable a flag-consistency check
[ghc.git] / rts / Weak.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-1999
4 *
5 * Weak pointers / finalizers
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11 #include "RtsAPI.h"
12
13 #include "RtsUtils.h"
14 #include "Weak.h"
15 #include "Schedule.h"
16 #include "Prelude.h"
17 #include "Trace.h"
18
19 // ForeignPtrs with C finalizers rely on weak pointers inside weak_ptr_list
20 // to always be in the same order.
21
22 StgWeak *weak_ptr_list;
23
24 void
25 runCFinalizer(void *fn, void *ptr, void *env, StgWord flag)
26 {
27 if (flag)
28 ((void (*)(void *, void *))fn)(env, ptr);
29 else
30 ((void (*)(void *))fn)(ptr);
31 }
32
33 void
34 runAllCFinalizers(StgWeak *list)
35 {
36 StgWeak *w;
37 Task *task;
38
39 task = myTask();
40 if (task != NULL) {
41 task->running_finalizers = rtsTrue;
42 }
43
44 for (w = list; w; w = w->link) {
45 StgArrWords *farr;
46
47 farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
48
49 if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
50 runCFinalizer((void *)farr->payload[0],
51 (void *)farr->payload[1],
52 (void *)farr->payload[2],
53 farr->payload[3]);
54 }
55
56 if (task != NULL) {
57 task->running_finalizers = rtsFalse;
58 }
59 }
60
61 /*
62 * scheduleFinalizers() is called on the list of weak pointers found
63 * to be dead after a garbage collection. It overwrites each object
64 * with DEAD_WEAK, and creates a new thread to run the pending finalizers.
65 *
66 * This function is called just after GC. The weak pointers on the
67 * argument list are those whose keys were found to be not reachable,
68 * however the value and finalizer fields have by now been marked live.
69 * The weak pointer object itself may not be alive - i.e. we may be
70 * looking at either an object in from-space or one in to-space. It
71 * doesn't really matter either way.
72 *
73 * Pre-condition: sched_mutex _not_ held.
74 */
75
76 void
77 scheduleFinalizers(Capability *cap, StgWeak *list)
78 {
79 StgWeak *w;
80 StgTSO *t;
81 StgMutArrPtrs *arr;
82 StgWord size;
83 nat n, i;
84 Task *task;
85
86 task = myTask();
87 if (task != NULL) {
88 task->running_finalizers = rtsTrue;
89 }
90
91 // count number of finalizers, and kill all the weak pointers first...
92 n = 0;
93 for (w = list; w; w = w->link) {
94 StgArrWords *farr;
95
96 // Better not be a DEAD_WEAK at this stage; the garbage
97 // collector removes DEAD_WEAKs from the weak pointer list.
98 ASSERT(w->header.info != &stg_DEAD_WEAK_info);
99
100 if (w->finalizer != &stg_NO_FINALIZER_closure) {
101 n++;
102 }
103
104 farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
105
106 if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
107 runCFinalizer((void *)farr->payload[0],
108 (void *)farr->payload[1],
109 (void *)farr->payload[2],
110 farr->payload[3]);
111
112 #ifdef PROFILING
113 // A weak pointer is inherently used, so we do not need to call
114 // LDV_recordDead().
115 //
116 // Furthermore, when PROFILING is turned on, dead weak
117 // pointers are exactly as large as weak pointers, so there is
118 // no need to fill the slop, either. See stg_DEAD_WEAK_info
119 // in StgMiscClosures.hc.
120 #endif
121 SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
122 }
123
124 if (task != NULL) {
125 task->running_finalizers = rtsFalse;
126 }
127
128 // No finalizers to run?
129 if (n == 0) return;
130
131 debugTrace(DEBUG_weak, "weak: batching %d finalizers", n);
132
133 size = n + mutArrPtrsCardTableSize(n);
134 arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
135 TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
136 SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
137 arr->ptrs = n;
138 arr->size = size;
139
140 n = 0;
141 for (w = list; w; w = w->link) {
142 if (w->finalizer != &stg_NO_FINALIZER_closure) {
143 arr->payload[n] = w->finalizer;
144 n++;
145 }
146 }
147 // set all the cards to 1
148 for (i = n; i < size; i++) {
149 arr->payload[i] = (StgClosure *)(W_)(-1);
150 }
151
152 t = createIOThread(cap,
153 RtsFlags.GcFlags.initialStkSize,
154 rts_apply(cap,
155 rts_apply(cap,
156 (StgClosure *)runFinalizerBatch_closure,
157 rts_mkInt(cap,n)),
158 (StgClosure *)arr)
159 );
160 scheduleThread(cap,t);
161 }