1 /* -----------------------------------------------------------------------------
2 * $Id: Sanity.c,v 1.6 1999/01/19 16:56:50 simonm Exp $
4 * Sanity checking code for the heap and stack.
6 * Used when debugging: check that the stack looks reasonable.
8 * - All things that are supposed to be pointers look like pointers.
10 * - Objects in text space are marked as static closures, those
11 * in the heap are dynamic.
13 * ---------------------------------------------------------------------------*/
21 #include "BlockAlloc.h"
24 #define LOOKS_LIKE_PTR(r) \
25 (IS_DATA_PTR(r) || ((IS_USER_PTR(r) && Bdescr((P_)r)->free != (void *)-1)))
27 /* -----------------------------------------------------------------------------
29 -------------------------------------------------------------------------- */
31 StgOffset checkStackClosure( StgClosure* c );
33 StgOffset checkStackObject( StgPtr sp );
35 void checkStackChunk( StgPtr sp, StgPtr stack_end );
37 static StgOffset checkSmallBitmap( StgPtr payload, StgNat32 bitmap );
39 static StgOffset checkLargeBitmap( StgPtr payload,
40 StgLargeBitmap* large_bitmap );
42 void checkClosureShallow( StgClosure* p );
45 checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
50 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
51 if ((bitmap & 1) == 0) {
52 checkClosure(stgCast(StgClosure*,payload[i]));
60 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
66 for (bmp=0; bmp<large_bitmap->size; bmp++) {
67 StgNat32 bitmap = large_bitmap->bitmap[bmp];
68 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
69 if ((bitmap & 1) == 0) {
70 checkClosure(stgCast(StgClosure*,payload[i]));
78 checkStackClosure( StgClosure* c )
80 const StgInfoTable* info = get_itbl(c);
82 /* All activation records have 'bitmap' style layout info. */
84 case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
86 StgRetDyn* r = stgCast(StgRetDyn*,c);
87 return sizeofW(StgRetDyn) +
88 checkSmallBitmap(r->payload,r->liveness);
90 case RET_BCO: /* small bitmap (<= 32 entries) */
97 return sizeofW(StgClosure) +
98 checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap);
99 case RET_BIG: /* large bitmap (> 32 entries) */
101 return sizeofW(StgClosure) +
102 checkLargeBitmap((StgPtr)c->payload,
103 info->layout.large_bitmap);
105 case FUN_STATIC: /* probably a slow-entry point return address: */
108 /* if none of the above, maybe it's a closure which looks a
109 * little like an infotable
111 checkClosureShallow(*stgCast(StgClosure**,c));
113 /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
118 * check that it looks like a valid closure - without checking its payload
119 * used to avoid recursion between checking PAPs and checking stack
124 checkClosureShallow( StgClosure* p )
126 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
128 /* Is it a static closure (i.e. in the data segment)? */
129 if (LOOKS_LIKE_STATIC(p)) {
130 ASSERT(closure_STATIC(p));
132 ASSERT(!closure_STATIC(p));
133 ASSERT(LOOKS_LIKE_PTR(p));
137 /* check an individual stack object */
139 checkStackObject( StgPtr sp )
141 if (IS_ARG_TAG(*sp)) {
142 /* Tagged words might be "stubbed" pointers, so there's no
143 * point checking to see whether they look like pointers or
144 * not (some of them will).
146 return ARG_SIZE(*sp) + 1;
147 } else if (LOOKS_LIKE_GHC_INFO(*stgCast(StgPtr*,sp))) {
148 return checkStackClosure(stgCast(StgClosure*,sp));
149 } else { /* must be an untagged closure pointer in the stack */
150 checkClosureShallow(*stgCast(StgClosure**,sp));
155 /* check sections of stack between update frames */
157 checkStackChunk( StgPtr sp, StgPtr stack_end )
162 while (p < stack_end) {
163 p += checkStackObject( p );
165 ASSERT( p == stack_end );
169 checkClosure( StgClosure* p )
171 const StgInfoTable *info;
174 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
177 /* Is it a static closure (i.e. in the data segment)? */
178 if (LOOKS_LIKE_STATIC(p)) {
179 ASSERT(closure_STATIC(p));
181 ASSERT(!closure_STATIC(p));
182 ASSERT(LOOKS_LIKE_PTR(p));
186 switch (info->type) {
189 StgBCO* bco = stgCast(StgBCO*,p);
191 for(i=0; i < bco->n_ptrs; ++i) {
192 ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
194 return bco_sizeW(bco);
199 StgMVar *mvar = (StgMVar *)p;
200 ASSERT(LOOKS_LIKE_PTR(mvar->head));
201 ASSERT(LOOKS_LIKE_PTR(mvar->tail));
202 ASSERT(LOOKS_LIKE_PTR(mvar->value));
203 return sizeofW(StgMVar);
211 case IND_OLDGEN_PERM:
220 case CONSTR_CHARLIKE:
222 case CONSTR_NOCAF_STATIC:
228 for (i = 0; i < info->layout.payload.ptrs; i++) {
229 ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
231 return sizeW_fromITBL(info);
235 /* deal with these specially - the info table isn't
236 * representative of the actual layout.
238 { StgWeak *w = (StgWeak *)p;
239 ASSERT(LOOKS_LIKE_PTR(w->key));
240 ASSERT(LOOKS_LIKE_PTR(w->value));
241 ASSERT(LOOKS_LIKE_PTR(w->finaliser));
243 ASSERT(LOOKS_LIKE_PTR(w->link));
245 return sizeW_fromITBL(info);
249 ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee));
250 return sizeofW(StgHeader) + MIN_UPD_SIZE;
254 /* we don't expect to see any of these after GC
255 * but they might appear during execution
258 StgInd *ind = stgCast(StgInd*,p);
259 ASSERT(LOOKS_LIKE_PTR(ind->indirectee));
260 q = (P_)p + sizeofW(StgInd);
261 while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
275 barf("checkClosure: stack frame");
277 case AP_UPD: /* we can treat this as being the same as a PAP */
280 StgPAP *pap = stgCast(StgPAP*,p);
281 ASSERT(LOOKS_LIKE_PTR(pap->fun));
282 checkStackChunk((StgPtr)pap->payload,
283 (StgPtr)pap->payload + pap->n_args
285 return pap_sizeW(pap);
290 return arr_words_sizeW(stgCast(StgArrWords*,p));
293 case MUT_ARR_PTRS_FROZEN:
295 StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
297 for (i = 0; i < a->ptrs; i++) {
298 ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
300 return mut_arr_ptrs_sizeW(a);
304 checkTSO((StgTSO *)p);
305 return tso_sizeW((StgTSO *)p);
310 barf("checkClosure: unimplemented/strange closure type");
312 barf("checkClosure");
314 #undef LOOKS_LIKE_PTR
317 /* -----------------------------------------------------------------------------
320 After garbage collection, the live heap is in a state where we can
321 run through and check that all the pointers point to the right
322 place. This function starts at a given position and sanity-checks
323 all the objects in the remainder of the chain.
324 -------------------------------------------------------------------------- */
327 checkHeap(bdescr *bd, StgPtr start)
338 while (p < bd->free) {
339 nat size = checkClosure(stgCast(StgClosure*,p));
340 /* This is the smallest size of closure that can live in the heap. */
341 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
345 while (p < bd->free &&
346 (*p == 0 || !LOOKS_LIKE_GHC_INFO(*p))) { p++; }
356 checkChain(bdescr *bd)
359 checkClosure((StgClosure *)bd->start);
364 /* check stack - making sure that update frames are linked correctly */
366 checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
368 /* check everything down to the first update frame */
369 checkStackChunk( sp, stgCast(StgPtr,su) );
370 while ( stgCast(StgPtr,su) < stack_end) {
371 sp = stgCast(StgPtr,su);
372 switch (get_itbl(su)->type) {
377 su = stgCast(StgSeqFrame*,su)->link;
380 su = stgCast(StgCatchFrame*,su)->link;
383 /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */
386 barf("checkStack: weird record found on update frame list.");
388 checkStackChunk( sp, stgCast(StgPtr,su) );
390 ASSERT(stgCast(StgPtr,su) == stack_end);
394 checkTSO(StgTSO *tso)
397 StgPtr stack = tso->stack;
398 StgUpdateFrame* su = tso->su;
399 StgOffset stack_size = tso->stack_size;
400 StgPtr stack_end = stack + stack_size;
402 if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
403 /* The garbage collector doesn't bother following any pointers
404 * from dead threads, so don't check sanity here.
409 ASSERT(stack <= sp && sp < stack_end);
410 ASSERT(sp <= stgCast(StgPtr,su));
412 checkStack(sp, stack_end, su);
415 /* -----------------------------------------------------------------------------
416 Check Blackhole Sanity
418 Test whether an object is already on the update list.
419 It isn't necessarily an rts error if it is - it might be a programming
422 Future versions might be able to test for a blackhole without traversing
423 the update frame list.
425 -------------------------------------------------------------------------- */
426 rtsBool isBlackhole( StgTSO* tso, StgClosure* p )
428 StgUpdateFrame* su = tso->su;
430 switch (get_itbl(su)->type) {
432 if (su->updatee == p) {
439 su = stgCast(StgSeqFrame*,su)->link;
442 su = stgCast(StgCatchFrame*,su)->link;
447 barf("isBlackhole: weird record found on update frame list.");