1 /* -----------------------------------------------------------------------------
2 * $Id: Sanity.c,v 1.11 1999/03/03 19:07:39 sof Exp $
4 * (c) The GHC Team, 1998-1999
6 * Sanity checking code for the heap and stack.
8 * Used when debugging: check that the stack looks reasonable.
10 * - All things that are supposed to be pointers look like pointers.
12 * - Objects in text space are marked as static closures, those
13 * in the heap are dynamic.
15 * ---------------------------------------------------------------------------*/
23 #include "BlockAlloc.h"
26 #define LOOKS_LIKE_PTR(r) (IS_DATA_PTR(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
28 /* -----------------------------------------------------------------------------
30 -------------------------------------------------------------------------- */
32 StgOffset checkStackClosure( StgClosure* c );
34 StgOffset checkStackObject( StgPtr sp );
36 void checkStackChunk( StgPtr sp, StgPtr stack_end );
38 static StgOffset checkSmallBitmap( StgPtr payload, StgWord32 bitmap );
40 static StgOffset checkLargeBitmap( StgPtr payload,
41 StgLargeBitmap* large_bitmap );
43 void checkClosureShallow( StgClosure* p );
46 checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
51 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
52 if ((bitmap & 1) == 0) {
53 checkClosure(stgCast(StgClosure*,payload[i]));
61 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
67 for (bmp=0; bmp<large_bitmap->size; bmp++) {
68 StgWord32 bitmap = large_bitmap->bitmap[bmp];
69 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
70 if ((bitmap & 1) == 0) {
71 checkClosure(stgCast(StgClosure*,payload[i]));
79 checkStackClosure( StgClosure* c )
81 const StgInfoTable* info = get_itbl(c);
83 /* All activation records have 'bitmap' style layout info. */
85 case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
87 StgRetDyn* r = stgCast(StgRetDyn*,c);
88 return sizeofW(StgRetDyn) +
89 checkSmallBitmap(r->payload,r->liveness);
91 case RET_BCO: /* small bitmap (<= 32 entries) */
98 return sizeofW(StgClosure) +
99 checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap);
100 case RET_BIG: /* large bitmap (> 32 entries) */
102 return sizeofW(StgClosure) +
103 checkLargeBitmap((StgPtr)c->payload,
104 info->layout.large_bitmap);
106 case FUN_STATIC: /* probably a slow-entry point return address: */
109 /* if none of the above, maybe it's a closure which looks a
110 * little like an infotable
112 checkClosureShallow(*stgCast(StgClosure**,c));
114 /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
119 * check that it looks like a valid closure - without checking its payload
120 * used to avoid recursion between checking PAPs and checking stack
125 checkClosureShallow( StgClosure* p )
127 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
129 /* Is it a static closure (i.e. in the data segment)? */
130 if (LOOKS_LIKE_STATIC(p)) {
131 ASSERT(closure_STATIC(p));
133 ASSERT(!closure_STATIC(p));
134 ASSERT(LOOKS_LIKE_PTR(p));
138 /* check an individual stack object */
140 checkStackObject( StgPtr sp )
142 if (IS_ARG_TAG(*sp)) {
143 /* Tagged words might be "stubbed" pointers, so there's no
144 * point checking to see whether they look like pointers or
145 * not (some of them will).
147 return ARG_SIZE(*sp) + 1;
148 } else if (LOOKS_LIKE_GHC_INFO(*stgCast(StgPtr*,sp))) {
149 return checkStackClosure(stgCast(StgClosure*,sp));
150 } else { /* must be an untagged closure pointer in the stack */
151 checkClosureShallow(*stgCast(StgClosure**,sp));
156 /* check sections of stack between update frames */
158 checkStackChunk( StgPtr sp, StgPtr stack_end )
163 while (p < stack_end) {
164 p += checkStackObject( p );
166 ASSERT( p == stack_end );
170 checkClosure( StgClosure* p )
172 const StgInfoTable *info;
175 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
178 /* Is it a static closure (i.e. in the data segment)? */
179 if (LOOKS_LIKE_STATIC(p)) {
180 ASSERT(closure_STATIC(p));
182 ASSERT(!closure_STATIC(p));
183 ASSERT(LOOKS_LIKE_PTR(p));
187 switch (info->type) {
190 StgBCO* bco = stgCast(StgBCO*,p);
192 for(i=0; i < bco->n_ptrs; ++i) {
193 ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
195 return bco_sizeW(bco);
200 StgMVar *mvar = (StgMVar *)p;
201 ASSERT(LOOKS_LIKE_PTR(mvar->head));
202 ASSERT(LOOKS_LIKE_PTR(mvar->tail));
203 ASSERT(LOOKS_LIKE_PTR(mvar->value));
204 return sizeofW(StgMVar);
215 for (i = 0; i < info->layout.payload.ptrs; i++) {
216 ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
218 return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
235 case IND_OLDGEN_PERM:
245 case CONSTR_CHARLIKE:
247 case CONSTR_NOCAF_STATIC:
253 for (i = 0; i < info->layout.payload.ptrs; i++) {
254 ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
256 return sizeW_fromITBL(info);
260 /* deal with these specially - the info table isn't
261 * representative of the actual layout.
263 { StgWeak *w = (StgWeak *)p;
264 ASSERT(LOOKS_LIKE_PTR(w->key));
265 ASSERT(LOOKS_LIKE_PTR(w->value));
266 ASSERT(LOOKS_LIKE_PTR(w->finalizer));
268 ASSERT(LOOKS_LIKE_PTR(w->link));
270 return sizeW_fromITBL(info);
274 ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee));
275 return sizeofW(StgHeader) + MIN_UPD_SIZE;
279 /* we don't expect to see any of these after GC
280 * but they might appear during execution
283 StgInd *ind = stgCast(StgInd*,p);
284 ASSERT(LOOKS_LIKE_PTR(ind->indirectee));
285 q = (P_)p + sizeofW(StgInd);
286 while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
300 barf("checkClosure: stack frame");
302 case AP_UPD: /* we can treat this as being the same as a PAP */
305 StgPAP *pap = stgCast(StgPAP*,p);
306 ASSERT(LOOKS_LIKE_PTR(pap->fun));
307 checkStackChunk((StgPtr)pap->payload,
308 (StgPtr)pap->payload + pap->n_args
310 return pap_sizeW(pap);
314 return arr_words_sizeW(stgCast(StgArrWords*,p));
317 case MUT_ARR_PTRS_FROZEN:
319 StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
321 for (i = 0; i < a->ptrs; i++) {
322 ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
324 return mut_arr_ptrs_sizeW(a);
328 checkTSO((StgTSO *)p);
329 return tso_sizeW((StgTSO *)p);
334 barf("checkClosure: unimplemented/strange closure type");
336 barf("checkClosure");
338 #undef LOOKS_LIKE_PTR
341 /* -----------------------------------------------------------------------------
344 After garbage collection, the live heap is in a state where we can
345 run through and check that all the pointers point to the right
346 place. This function starts at a given position and sanity-checks
347 all the objects in the remainder of the chain.
348 -------------------------------------------------------------------------- */
351 checkHeap(bdescr *bd, StgPtr start)
362 while (p < bd->free) {
363 nat size = checkClosure(stgCast(StgClosure*,p));
364 /* This is the smallest size of closure that can live in the heap. */
365 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
369 while (p < bd->free &&
370 (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
380 checkChain(bdescr *bd)
383 checkClosure((StgClosure *)bd->start);
388 /* check stack - making sure that update frames are linked correctly */
390 checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
392 /* check everything down to the first update frame */
393 checkStackChunk( sp, stgCast(StgPtr,su) );
394 while ( stgCast(StgPtr,su) < stack_end) {
395 sp = stgCast(StgPtr,su);
396 switch (get_itbl(su)->type) {
401 su = stgCast(StgSeqFrame*,su)->link;
404 su = stgCast(StgCatchFrame*,su)->link;
407 /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */
410 barf("checkStack: weird record found on update frame list.");
412 checkStackChunk( sp, stgCast(StgPtr,su) );
414 ASSERT(stgCast(StgPtr,su) == stack_end);
418 checkTSO(StgTSO *tso)
421 StgPtr stack = tso->stack;
422 StgUpdateFrame* su = tso->su;
423 StgOffset stack_size = tso->stack_size;
424 StgPtr stack_end = stack + stack_size;
426 if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
427 /* The garbage collector doesn't bother following any pointers
428 * from dead threads, so don't check sanity here.
433 ASSERT(stack <= sp && sp < stack_end);
434 ASSERT(sp <= stgCast(StgPtr,su));
436 checkStack(sp, stack_end, su);
439 /* -----------------------------------------------------------------------------
440 Check Blackhole Sanity
442 Test whether an object is already on the update list.
443 It isn't necessarily an rts error if it is - it might be a programming
446 Future versions might be able to test for a blackhole without traversing
447 the update frame list.
449 -------------------------------------------------------------------------- */
450 rtsBool isBlackhole( StgTSO* tso, StgClosure* p )
452 StgUpdateFrame* su = tso->su;
454 switch (get_itbl(su)->type) {
456 if (su->updatee == p) {
463 su = stgCast(StgSeqFrame*,su)->link;
466 su = stgCast(StgCatchFrame*,su)->link;
471 barf("isBlackhole: weird record found on update frame list.");