[project @ 2003-01-25 15:54:48 by wolfgang]
[ghc-hetmet.git] / ghc / rts / Weak.c
1 /* -----------------------------------------------------------------------------
2  * $Id: Weak.c,v 1.27 2003/01/25 15:54:50 wolfgang Exp $
3  *
4  * (c) The GHC Team, 1998-1999
5  *
6  * Weak pointers / finalizers
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "PosixSource.h"
11 #define COMPILING_RTS_MAIN
12 #include "Rts.h"
13 #include "SchedAPI.h"
14 #include "RtsFlags.h"
15 #include "Weak.h"
16 #include "Storage.h"
17 #include "Prelude.h"
18 #include "RtsAPI.h"
19
20 StgWeak *weak_ptr_list;
21
22 /*
23  * finalizeWeakPointersNow() is called just before the system is shut
24  * down.  It runs the finalizer for each weak pointer still in the
25  * system.
26  *
27  * Careful here - rts_evalIO might cause a garbage collection, which
28  * might change weak_ptr_list.  Must re-load weak_ptr_list each time
29  * around the loop.
30  */
31
32 void
33 finalizeWeakPointersNow(void)
34 {
35   StgWeak *w;
36   
37 #if defined(RTS_SUPPORTS_THREADS)
38   rts_lock();
39 #endif
40   while ((w = weak_ptr_list)) {
41     weak_ptr_list = w->link;
42     if (w->header.info != &stg_DEAD_WEAK_info) {
43         w->header.info = &stg_DEAD_WEAK_info;
44         IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
45         if (w->finalizer != &stg_NO_FINALIZER_closure) {
46 #if defined(RTS_SUPPORTS_THREADS)
47             rts_evalIO(w->finalizer,NULL);
48             rts_unlock();
49             rts_lock();
50 #else
51             rts_mainEvalIO(w->finalizer,NULL);
52 #endif
53         }
54     }
55   }
56 #if defined(RTS_SUPPORTS_THREADS)
57   rts_unlock();
58 #endif
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(StgWeak *list)
78 {
79     StgWeak *w;
80     StgTSO *t;
81     StgMutArrPtrs *arr;
82     nat n;
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
88         // Better not be a DEAD_WEAK at this stage; the garbage
89         // collector removes DEAD_WEAKs from the weak pointer list.
90         ASSERT(w->header.info != &stg_DEAD_WEAK_info);
91
92         if (w->finalizer != &stg_NO_FINALIZER_closure) {
93             n++;
94         }
95
96 #ifdef PROFILING
97         // A weak pointer is inherently used, so we do not need to call
98         // LDV_recordDead().
99         //
100         // Furthermore, when PROFILING is turned on, dead weak
101         // pointers are exactly as large as weak pointers, so there is
102         // no need to fill the slop, either.  See stg_DEAD_WEAK_info
103         // in StgMiscClosures.hc.
104 #endif
105         SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
106     }
107         
108     // No finalizers to run?
109     if (n == 0) return;
110
111     IF_DEBUG(weak,fprintf(stderr,"weak: batching %d finalizers\n", n));
112
113     arr = (StgMutArrPtrs *)allocate(sizeofW(StgMutArrPtrs) + n);
114     TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
115     SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
116     arr->ptrs = n;
117
118     n = 0;
119     for (w = list; w; w = w->link) {
120         if (w->finalizer != &stg_NO_FINALIZER_closure) {
121             arr->payload[n] = w->finalizer;
122             n++;
123         }
124     }
125
126     t = createIOThread(RtsFlags.GcFlags.initialStkSize, 
127                        rts_apply(
128                            rts_apply(
129                                (StgClosure *)runFinalizerBatch_closure,
130                                rts_mkInt(n)), 
131                            (StgClosure *)arr)
132         );
133     scheduleThread(t);
134 }