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