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