1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
*
* Lag/Drag/Void profiling.
*
* ---------------------------------------------------------------------------*/
#if defined(PROFILING)
#include "rts/PosixSource.h"
#include "Rts.h"
#include "Profiling.h"
#include "LdvProfile.h"
#include "Stats.h"
#include "RtsUtils.h"
#include "Schedule.h"
bool isInherentlyUsed( StgHalfWord closure_type )
{
switch(closure_type) {
case TSO:
case STACK:
case MVAR_CLEAN:
case MVAR_DIRTY:
case TVAR:
case MUT_ARR_PTRS_CLEAN:
case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN_CLEAN:
case MUT_ARR_PTRS_FROZEN_DIRTY:
case SMALL_MUT_ARR_PTRS_CLEAN:
case SMALL_MUT_ARR_PTRS_DIRTY:
case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
case ARR_WORDS:
case WEAK:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case BCO:
case PRIM:
case MUT_PRIM:
case TREC_CHUNK:
return true;
default:
return false;
}
}
/* --------------------------------------------------------------------------
* This function is called eventually on every object destroyed during
* a garbage collection, whether it is a major garbage collection or
* not. If c is an 'inherently used' closure, nothing happens. If c
* is an ordinary closure, LDV_recordDead() is called on c with its
* proper size which excludes the profiling header portion in the
* closure. Returns the size of the closure, including the profiling
* header portion, so that the caller can find the next closure.
* ----------------------------------------------------------------------- */
STATIC_INLINE uint32_t
processHeapClosureForDead( const StgClosure *c )
{
uint32_t size;
const StgInfoTable *info;
info = get_itbl(c);
info = c->header.info;
if (IS_FORWARDING_PTR(info)) {
// The size of the evacuated closure is currently stored in
// the LDV field. See SET_EVACUAEE_FOR_LDV() in
// rts/include/StgLdvProf.h.
return LDVW(c);
}
info = INFO_PTR_TO_STRUCT(info);
ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
(
(LDVW(c) & LDV_LAST_MASK) <= era &&
(LDVW(c) & LDV_LAST_MASK) > 0
));
size = closure_sizeW(c);
/*
'inherently used' cases: do nothing.
*/
if(isInherentlyUsed(info->type))
return size;
switch (info->type) {
/*
ordinary cases: call LDV_recordDead().
*/
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
case THUNK_SELECTOR:
case THUNK_2_0:
case THUNK_1_1:
case THUNK_0_2:
case AP:
case PAP:
case AP_STACK:
case CONSTR:
case CONSTR_1_0:
case CONSTR_0_1:
case CONSTR_2_0:
case CONSTR_1_1:
case CONSTR_0_2:
case CONSTR_NOCAF:
case FUN:
case FUN_1_0:
case FUN_0_1:
case FUN_2_0:
case FUN_1_1:
case FUN_0_2:
case BLACKHOLE:
case BLOCKING_QUEUE:
/*
'Ignore' cases
*/
// Why can we ignore IND closures? We assume that
// any census is preceded by a major garbage collection, which
// IND closures cannot survive. Therefore, it is no
// use considering IND closures in the meanwhile
// because they will perish before the next census at any
// rate.
case IND:
// Found a dead closure: record its size
LDV_recordDead(c, size);
return size;
/*
Error case
*/
// static objects
case IND_STATIC:
case FUN_STATIC:
case THUNK_STATIC:
// stack objects
case UPDATE_FRAME:
case CATCH_FRAME:
case UNDERFLOW_FRAME:
case STOP_FRAME:
case RET_BCO:
case RET_SMALL:
case RET_BIG:
case CATCH_STM_FRAME:
case CATCH_RETRY_FRAME:
case ATOMICALLY_FRAME:
// others
case INVALID_OBJECT:
case COMPACT_NFDATA:
default:
barf("Invalid object in processHeapClosureForDead(): %d", info->type);
return 0;
}
}
/* --------------------------------------------------------------------------
* Calls processHeapClosureForDead() on every *dead* closures in the
* heap blocks starting at bd.
* ----------------------------------------------------------------------- */
static void
processHeapForDead( bdescr *bd )
{
StgPtr p;
while (bd != NULL) {
p = bd->start;
while (p < bd->free) {
p += processHeapClosureForDead((StgClosure *)p);
while (p < bd->free && !*p) // skip slop
p++;
}
ASSERT(p == bd->free);
bd = bd->link;
}
}
/* --------------------------------------------------------------------------
* Calls processHeapClosureForDead() on every *dead* closures in the closure
* chain.
* ----------------------------------------------------------------------- */
static void
processChainForDead( bdescr *bd )
{
// Any object still in the chain is dead!
while (bd != NULL) {
if (!(bd->flags & BF_PINNED)) {
processHeapClosureForDead((StgClosure *)bd->start);
}
bd = bd->link;
}
}
/* --------------------------------------------------------------------------
* Start a census for *dead* closures, and calls
* processHeapClosureForDead() on every closure which died in the
* current garbage collection. This function is called from a garbage
* collector right before tidying up, when all dead closures are still
* stored in the heap and easy to identify. Generations 0 through N
* have just been garbage collected.
* ----------------------------------------------------------------------- */
void
LdvCensusForDead( uint32_t N )
{
uint32_t g;
// era == 0 means that LDV profiling is currently turned off.
if (era == 0)
return;
if (RtsFlags.GcFlags.generations == 1) {
//
// Todo: support LDV for two-space garbage collection.
//
barf("Lag/Drag/Void profiling not supported with -G1");
} else {
for (g = 0; g <= N; g++) {
processHeapForDead(generations[g].old_blocks);
processChainForDead(generations[g].large_objects);
}
}
}
/* --------------------------------------------------------------------------
* Regard any closure in the current heap as dead or moribund and update
* LDV statistics accordingly.
* Called from shutdownHaskell() in RtsStartup.c.
* Also, stops LDV profiling by resetting 'era' to 0.
* ----------------------------------------------------------------------- */
void
LdvCensusKillAll( void )
{
LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
}
#endif /* PROFILING */
|
