1 /* -----------------------------------------------------------------------------
2 * $Id: Sanity.c,v 1.18 2000/03/17 14:37:21 simonmar 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 //* Thread Queue Sanity::
24 //* Blackhole Sanity::
27 //@node Includes, Macros
28 //@subsection Includes
32 #ifdef DEBUG /* whole file */
36 #include "BlockAlloc.h"
39 //@node Macros, Stack sanity, Includes
42 #define LOOKS_LIKE_PTR(r) (LOOKS_LIKE_STATIC_CLOSURE(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
44 //@node Stack sanity, Heap Sanity, Macros
45 //@subsection Stack sanity
47 /* -----------------------------------------------------------------------------
49 -------------------------------------------------------------------------- */
51 StgOffset checkStackClosure( StgClosure* c );
53 StgOffset checkStackObject( StgPtr sp );
55 void checkStackChunk( StgPtr sp, StgPtr stack_end );
57 static StgOffset checkSmallBitmap( StgPtr payload, StgWord32 bitmap );
59 static StgOffset checkLargeBitmap( StgPtr payload,
60 StgLargeBitmap* large_bitmap );
62 void checkClosureShallow( StgClosure* p );
64 //@cindex checkSmallBitmap
66 checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
71 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
72 if ((bitmap & 1) == 0) {
73 checkClosure(stgCast(StgClosure*,payload[i]));
79 //@cindex checkLargeBitmap
81 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
87 for (bmp=0; bmp<large_bitmap->size; bmp++) {
88 StgWord32 bitmap = large_bitmap->bitmap[bmp];
89 for(; bitmap != 0; ++i, bitmap >>= 1 ) {
90 if ((bitmap & 1) == 0) {
91 checkClosure(stgCast(StgClosure*,payload[i]));
98 //@cindex checkStackClosure
100 checkStackClosure( StgClosure* c )
102 const StgInfoTable* info = get_itbl(c);
104 /* All activation records have 'bitmap' style layout info. */
105 switch (info->type) {
106 case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
108 StgRetDyn* r = (StgRetDyn *)c;
109 return sizeofW(StgRetDyn) +
110 checkSmallBitmap(r->payload,r->liveness);
112 case RET_BCO: /* small bitmap (<= 32 entries) */
115 return 1 + checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
126 checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
127 case RET_BIG: /* large bitmap (> 32 entries) */
129 return 1 + checkLargeBitmap((StgPtr)c + 1,info->layout.large_bitmap);
131 case FUN_STATIC: /* probably a slow-entry point return address: */
132 #if 0 && defined(GRAN)
138 /* if none of the above, maybe it's a closure which looks a
139 * little like an infotable
141 checkClosureShallow(*(StgClosure **)c);
143 /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
148 * check that it looks like a valid closure - without checking its payload
149 * used to avoid recursion between checking PAPs and checking stack
153 //@cindex checkClosureShallow
155 checkClosureShallow( StgClosure* p )
157 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
159 /* Is it a static closure (i.e. in the data segment)? */
160 if (LOOKS_LIKE_STATIC(p)) {
161 ASSERT(closure_STATIC(p));
163 ASSERT(!closure_STATIC(p));
164 ASSERT(LOOKS_LIKE_PTR(p));
168 /* check an individual stack object */
169 //@cindex checkStackObject
171 checkStackObject( StgPtr sp )
173 if (IS_ARG_TAG(*sp)) {
174 /* Tagged words might be "stubbed" pointers, so there's no
175 * point checking to see whether they look like pointers or
176 * not (some of them will).
178 return ARG_SIZE(*sp) + 1;
179 } else if (LOOKS_LIKE_GHC_INFO(*stgCast(StgPtr*,sp))) {
180 return checkStackClosure(stgCast(StgClosure*,sp));
181 } else { /* must be an untagged closure pointer in the stack */
182 checkClosureShallow(*stgCast(StgClosure**,sp));
187 /* check sections of stack between update frames */
188 //@cindex checkStackChunk
190 checkStackChunk( StgPtr sp, StgPtr stack_end )
195 while (p < stack_end) {
196 p += checkStackObject( p );
198 // ASSERT( p == stack_end ); -- HWL
201 //@cindex checkStackChunk
203 checkClosure( StgClosure* p )
205 const StgInfoTable *info;
208 ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
211 /* Is it a static closure (i.e. in the data segment)? */
212 if (LOOKS_LIKE_STATIC(p)) {
213 ASSERT(closure_STATIC(p));
215 ASSERT(!closure_STATIC(p));
216 ASSERT(LOOKS_LIKE_PTR(p));
220 switch (info->type) {
223 StgBCO* bco = stgCast(StgBCO*,p);
225 for(i=0; i < bco->n_ptrs; ++i) {
226 ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
228 return bco_sizeW(bco);
233 StgMVar *mvar = (StgMVar *)p;
234 ASSERT(LOOKS_LIKE_PTR(mvar->head));
235 ASSERT(LOOKS_LIKE_PTR(mvar->tail));
236 ASSERT(LOOKS_LIKE_PTR(mvar->value));
237 return sizeofW(StgMVar);
248 for (i = 0; i < info->layout.payload.ptrs; i++) {
249 ASSERT(LOOKS_LIKE_PTR(p->payload[i]));
251 return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
268 case IND_OLDGEN_PERM:
273 case SE_CAF_BLACKHOLE:
282 case CONSTR_CHARLIKE:
284 case CONSTR_NOCAF_STATIC:
290 for (i = 0; i < info->layout.payload.ptrs; i++) {
291 ASSERT(LOOKS_LIKE_PTR(p->payload[i]));
293 return sizeW_fromITBL(info);
297 /* deal with these specially - the info table isn't
298 * representative of the actual layout.
300 { StgWeak *w = (StgWeak *)p;
301 ASSERT(LOOKS_LIKE_PTR(w->key));
302 ASSERT(LOOKS_LIKE_PTR(w->value));
303 ASSERT(LOOKS_LIKE_PTR(w->finalizer));
305 ASSERT(LOOKS_LIKE_PTR(w->link));
307 return sizeW_fromITBL(info);
311 ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee));
312 return sizeofW(StgHeader) + MIN_UPD_SIZE;
316 /* we don't expect to see any of these after GC
317 * but they might appear during execution
320 StgInd *ind = stgCast(StgInd*,p);
321 ASSERT(LOOKS_LIKE_PTR(ind->indirectee));
322 q = (P_)p + sizeofW(StgInd);
323 while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
337 barf("checkClosure: stack frame");
339 case AP_UPD: /* we can treat this as being the same as a PAP */
342 StgPAP *pap = stgCast(StgPAP*,p);
343 ASSERT(LOOKS_LIKE_PTR(pap->fun));
344 checkStackChunk((StgPtr)pap->payload,
345 (StgPtr)pap->payload + pap->n_args
347 return pap_sizeW(pap);
351 return arr_words_sizeW(stgCast(StgArrWords*,p));
354 case MUT_ARR_PTRS_FROZEN:
356 StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
358 for (i = 0; i < a->ptrs; i++) {
359 ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
361 return mut_arr_ptrs_sizeW(a);
365 checkTSO((StgTSO *)p);
366 return tso_sizeW((StgTSO *)p);
371 barf("checkClosure: unimplemented/strange closure type %d",
374 barf("checkClosure (closure type %d)", info->type);
376 #undef LOOKS_LIKE_PTR
379 //@node Heap Sanity, TSO Sanity, Stack sanity
380 //@subsection Heap Sanity
382 /* -----------------------------------------------------------------------------
385 After garbage collection, the live heap is in a state where we can
386 run through and check that all the pointers point to the right
387 place. This function starts at a given position and sanity-checks
388 all the objects in the remainder of the chain.
389 -------------------------------------------------------------------------- */
393 checkHeap(bdescr *bd, StgPtr start)
404 while (p < bd->free) {
405 nat size = checkClosure(stgCast(StgClosure*,p));
406 /* This is the smallest size of closure that can live in the heap. */
407 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
411 while (p < bd->free &&
412 (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
423 checkChain(bdescr *bd)
426 checkClosure((StgClosure *)bd->start);
431 /* check stack - making sure that update frames are linked correctly */
434 checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
436 /* check everything down to the first update frame */
437 checkStackChunk( sp, stgCast(StgPtr,su) );
438 while ( stgCast(StgPtr,su) < stack_end) {
439 sp = stgCast(StgPtr,su);
440 switch (get_itbl(su)->type) {
445 su = stgCast(StgSeqFrame*,su)->link;
448 su = stgCast(StgCatchFrame*,su)->link;
451 /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */
454 barf("checkStack: weird record found on update frame list.");
456 checkStackChunk( sp, stgCast(StgPtr,su) );
458 ASSERT(stgCast(StgPtr,su) == stack_end);
461 //@node TSO Sanity, Thread Queue Sanity, Heap Sanity
462 //@subsection TSO Sanity
466 checkTSO(StgTSO *tso)
469 StgPtr stack = tso->stack;
470 StgUpdateFrame* su = tso->su;
471 StgOffset stack_size = tso->stack_size;
472 StgPtr stack_end = stack + stack_size;
474 if (tso->what_next == ThreadRelocated) {
479 if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
480 /* The garbage collector doesn't bother following any pointers
481 * from dead threads, so don't check sanity here.
486 ASSERT(stack <= sp && sp < stack_end);
487 ASSERT(sp <= stgCast(StgPtr,su));
489 checkStack(sp, stack_end, su);
493 //@cindex checkTSOsSanity
495 checkTSOsSanity(void) {
499 belch("Checking sanity of all runnable TSOs:");
501 for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
502 for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
503 fprintf(stderr, "TSO %p on PE %d ...", tso, i);
505 fprintf(stderr, "OK, ");
510 belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
513 //@node Thread Queue Sanity, Blackhole Sanity, TSO Sanity
514 //@subsection Thread Queue Sanity
518 //@cindex checkThreadQSanity
520 checkThreadQSanity (PEs proc, rtsBool check_TSO_too)
524 /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */
525 ASSERT(run_queue_hds[proc]!=NULL);
526 ASSERT(run_queue_tls[proc]!=NULL);
527 /* if either head or tail is NIL then the other one must be NIL, too */
528 ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE);
529 ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE);
530 for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE;
532 prev=tso, tso=tso->link) {
533 ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) &&
534 (prev==END_TSO_QUEUE || prev->link==tso));
538 ASSERT(prev==run_queue_tls[proc]);
541 //@cindex checkThreadQsSanity
543 checkThreadQsSanity (rtsBool check_TSO_too)
547 for (p=0; p<RtsFlags.GranFlags.proc; p++)
548 checkThreadQSanity(p, check_TSO_too);
552 //@node Blackhole Sanity, Index, Thread Queue Sanity
553 //@subsection Blackhole Sanity
555 /* -----------------------------------------------------------------------------
556 Check Blackhole Sanity
558 Test whether an object is already on the update list.
559 It isn't necessarily an rts error if it is - it might be a programming
562 Future versions might be able to test for a blackhole without traversing
563 the update frame list.
565 -------------------------------------------------------------------------- */
566 //@cindex isBlackhole
568 isBlackhole( StgTSO* tso, StgClosure* p )
570 StgUpdateFrame* su = tso->su;
572 switch (get_itbl(su)->type) {
574 if (su->updatee == p) {
581 su = stgCast(StgSeqFrame*,su)->link;
584 su = stgCast(StgCatchFrame*,su)->link;
589 barf("isBlackhole: weird record found on update frame list.");
594 //@node Index, , Blackhole Sanity
598 //* checkChain:: @cindex\s-+checkChain
599 //* checkClosureShallow:: @cindex\s-+checkClosureShallow
600 //* checkHeap:: @cindex\s-+checkHeap
601 //* checkLargeBitmap:: @cindex\s-+checkLargeBitmap
602 //* checkSmallBitmap:: @cindex\s-+checkSmallBitmap
603 //* checkStack:: @cindex\s-+checkStack
604 //* checkStackChunk:: @cindex\s-+checkStackChunk
605 //* checkStackChunk:: @cindex\s-+checkStackChunk
606 //* checkStackClosure:: @cindex\s-+checkStackClosure
607 //* checkStackObject:: @cindex\s-+checkStackObject
608 //* checkTSO:: @cindex\s-+checkTSO
609 //* checkTSOsSanity:: @cindex\s-+checkTSOsSanity
610 //* checkThreadQSanity:: @cindex\s-+checkThreadQSanity
611 //* checkThreadQsSanity:: @cindex\s-+checkThreadQsSanity
612 //* isBlackhole:: @cindex\s-+isBlackhole