[project @ 2002-04-19 10:23:43 by simonmar]
[ghc-hetmet.git] / ghc / rts / Weak.c
1 /* -----------------------------------------------------------------------------
2  * $Id: Weak.c,v 1.22 2002/04/19 10:23:43 simonmar Exp $
3  *
4  * (c) The GHC Team, 1998-1999
5  *
6  * Weak pointers / finalizers
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "PosixSource.h"
11 #include "Rts.h"
12 #include "RtsAPI.h"
13 #include "SchedAPI.h"
14 #include "RtsFlags.h"
15 #include "Weak.h"
16 #include "Storage.h"
17 #include "Prelude.h"
18
19 StgWeak *weak_ptr_list;
20
21 /*
22  * finalizeWeakPointersNow() is called just before the system is shut
23  * down.  It runs the finalizer for each weak pointer still in the
24  * system.
25  *
26  * Careful here - rts_evalIO might cause a garbage collection, which
27  * might change weak_ptr_list.  Must re-load weak_ptr_list each time
28  * around the loop.
29  */
30
31 void
32 finalizeWeakPointersNow(void)
33 {
34   StgWeak *w;
35   
36   while ((w = weak_ptr_list)) {
37     weak_ptr_list = w->link;
38     if (w->header.info != &stg_DEAD_WEAK_info) {
39         w->header.info = &stg_DEAD_WEAK_info;
40         IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
41         if (w->finalizer != &stg_NO_FINALIZER_closure) {
42             rts_evalIO(w->finalizer,NULL);
43         }
44     }
45   }
46
47
48 /*
49  * scheduleFinalizers() is called on the list of weak pointers found
50  * to be dead after a garbage collection.  It overwrites each object
51  * with DEAD_WEAK, and creates a new thread to run the pending finalizers.
52  *
53  * This function is called just after GC.  The weak pointers on the
54  * argument list are those whose keys were found to be not reachable,
55  * however the value and finalizer fields have by now been marked live.
56  * The weak pointer object itself may not be alive - i.e. we may be
57  * looking at either an object in from-space or one in to-space.  It
58  * doesn't really matter either way.
59  *
60  * Pre-condition: sched_mutex _not_ held.
61  */
62
63 void
64 scheduleFinalizers(StgWeak *list)
65 {
66     StgWeak *w;
67     StgTSO *t;
68     StgMutArrPtrs *arr;
69     nat n;
70
71     /* count number of finalizers first... */
72     for (n = 0, w = list; w; w = w->link) { 
73         if (w->header.info != &stg_DEAD_WEAK_info &&
74             w->finalizer != &stg_NO_FINALIZER_closure)
75             n++;
76     }
77         
78     if (n == 0) return;
79
80     IF_DEBUG(weak,fprintf(stderr,"weak: batching %d finalizers\n", n));
81
82     arr = (StgMutArrPtrs *)allocate(sizeofW(StgMutArrPtrs) + n);
83     SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
84     arr->ptrs = n;
85
86     for (n = 0, w = list; w; w = w->link) {
87         if (w->header.info != &stg_DEAD_WEAK_info &&
88             w->finalizer != &stg_NO_FINALIZER_closure) {
89             arr->payload[n] = w->finalizer;
90             n++;
91         }
92
93 #ifdef PROFILING
94         // A weak pointer is inherently used, so we do not need to call
95         // LDV_recordDead().
96         //
97         // Furthermore, when PROFILING is turned on, dead weak
98         // pointers are exactly as large as weak pointers, so there is
99         // no need to fill the slop, either.  See stg_DEAD_WEAK_info
100         // in StgMiscClosures.hc.
101 #endif
102         SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
103     }
104
105     t = createIOThread(RtsFlags.GcFlags.initialStkSize, 
106                        rts_apply(
107                            rts_apply(
108                                (StgClosure *)runFinalizerBatch_closure,
109                                rts_mkInt(n)), 
110                            (StgClosure *)arr)
111         );
112     scheduleThread(t);
113 }