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