Weak.c 4.19 KB
Newer Older
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"
Simon Marlow's avatar
Simon Marlow committed
11 12
#include "RtsAPI.h"

13
#include "RtsUtils.h"
14
#include "Weak.h"
sof's avatar
sof committed
15
#include "Schedule.h"
16
#include "Prelude.h"
Simon Marlow's avatar
Simon Marlow committed
17
#include "Trace.h"
18

19 20 21
// ForeignPtrs with C finalizers rely on weak pointers inside weak_ptr_list
// to always be in the same order.

22 23
StgWeak *weak_ptr_list;

24
void
Simon Marlow's avatar
Simon Marlow committed
25
runCFinalizer(void *fn, void *ptr, void *env, StgWord flag)
26 27 28 29 30 31 32 33 34 35 36
{
    if (flag)
	((void (*)(void *, void *))fn)(env, ptr);
    else
	((void (*)(void *))fn)(ptr);
}

void
runAllCFinalizers(StgWeak *list)
{
    StgWeak *w;
37
    Task *task;
38

39 40 41 42
    task = myTask();
    if (task != NULL) {
        task->running_finalizers = rtsTrue;
    }
43

44 45 46 47 48 49
    for (w = list; w; w = w->link) {
	StgArrWords *farr;

	farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);

	if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
Simon Marlow's avatar
Simon Marlow committed
50 51 52
	    runCFinalizer((void *)farr->payload[0],
	                  (void *)farr->payload[1],
	                  (void *)farr->payload[2],
53 54
	                  farr->payload[3]);
    }
55

56 57 58
    if (task != NULL) {
        task->running_finalizers = rtsFalse;
    }
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 67 68 69 70 71
 *
 * 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.
sof's avatar
sof committed
72 73
 *
 * Pre-condition: sched_mutex _not_ held.
74 75 76
 */

void
77
scheduleFinalizers(Capability *cap, StgWeak *list)
78
{
79 80 81
    StgWeak *w;
    StgTSO *t;
    StgMutArrPtrs *arr;
82 83
    StgWord size;
    nat n, i;
84
    Task *task;
85

86 87 88 89
    task = myTask();
    if (task != NULL) {
        task->running_finalizers = rtsTrue;
    }
90

91
    // count number of finalizers, and kill all the weak pointers first...
92 93
    n = 0;
    for (w = list; w; w = w->link) { 
94
	StgArrWords *farr;
95 96 97 98 99 100

	// 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) {
101
	    n++;
102 103
	}

104 105 106
	farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);

	if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
Simon Marlow's avatar
Simon Marlow committed
107 108 109
	    runCFinalizer((void *)farr->payload[0],
	                  (void *)farr->payload[1],
	                  (void *)farr->payload[2],
110 111
	                  farr->payload[3]);

112 113 114 115 116 117 118 119 120 121
#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);
122
    }
123
	
124 125 126
    if (task != NULL) {
        task->running_finalizers = rtsFalse;
    }
127

128
    // No finalizers to run?
129 130
    if (n == 0) return;

Simon Marlow's avatar
Simon Marlow committed
131
    debugTrace(DEBUG_weak, "weak: batching %d finalizers", n);
132

133 134
    size = n + mutArrPtrsCardTableSize(n);
    arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
135
    TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
136
    SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
137
    arr->ptrs = n;
138
    arr->size = size;
139

140 141 142
    n = 0;
    for (w = list; w; w = w->link) {
	if (w->finalizer != &stg_NO_FINALIZER_closure) {
143 144 145 146
	    arr->payload[n] = w->finalizer;
	    n++;
	}
    }
147 148 149 150
    // set all the cards to 1
    for (i = n; i < size; i++) {
        arr->payload[i] = (StgClosure *)(W_)(-1);
    }
151

152 153 154 155
    t = createIOThread(cap, 
		       RtsFlags.GcFlags.initialStkSize, 
		       rts_apply(cap,
			   rts_apply(cap,
156
			       (StgClosure *)runFinalizerBatch_closure,
157
			       rts_mkInt(cap,n)), 
158 159
			   (StgClosure *)arr)
	);
160
    scheduleThread(cap,t);
161
}