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