1 /* -----------------------------------------------------------------------------
2 * $Id: Sanity.c,v 1.31 2002/12/11 15:36:48 simonmar Exp $
4 * (c) The GHC Team, 1998-2001
6 * Sanity checking code for the heap and stack.
8 * Used when debugging: check that everything 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 * ---------------------------------------------------------------------------*/
17 #include "PosixSource.h"
20 #ifdef DEBUG /* whole file */
24 #include "BlockAlloc.h"
29 #include "StoragePriv.h" // for END_OF_STATIC_LIST
32 /* -----------------------------------------------------------------------------
34 -------------------------------------------------------------------------- */
36 static void checkSmallBitmap ( StgPtr payload, StgWord bitmap, nat );
37 static void checkLargeBitmap ( StgPtr payload, StgLargeBitmap*, nat );
38 static void checkClosureShallow ( StgClosure * );
40 /* -----------------------------------------------------------------------------
42 -------------------------------------------------------------------------- */
45 checkSmallBitmap( StgPtr payload, StgWord bitmap, nat size )
51 for(i = 0; i < size; i++, bitmap >>= 1 ) {
52 if ((bitmap & 1) == 0) {
53 checkClosureShallow((StgClosure *)payload[i]);
59 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
65 for (bmp=0; i < size; bmp++) {
66 StgWord bitmap = large_bitmap->bitmap[bmp];
68 for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
69 if ((bitmap & 1) == 0) {
70 checkClosureShallow((StgClosure *)payload[i]);
77 * check that it looks like a valid closure - without checking its payload
78 * used to avoid recursion between checking PAPs and checking stack
83 checkClosureShallow( StgClosure* p )
85 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
87 /* Is it a static closure? */
88 if (!HEAP_ALLOCED(p)) {
89 ASSERT(closure_STATIC(p));
91 ASSERT(!closure_STATIC(p));
95 // check an individual stack object
97 checkStackFrame( StgPtr c )
100 const StgRetInfoTable* info;
102 info = get_ret_itbl((StgClosure *)c);
104 /* All activation records have 'bitmap' style layout info. */
105 switch (info->i.type) {
106 case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
115 p = (P_)(r->payload);
116 checkSmallBitmap(p,GET_LIVENESS(r->liveness),RET_DYN_SIZE);
119 // skip over the non-pointers
120 p += GET_NONPTRS(dyn);
122 // follow the ptr words
123 for (size = GET_PTRS(dyn); size > 0; size--) {
124 checkClosureShallow((StgClosure *)*p);
128 return sizeofW(StgRetDyn) + RET_DYN_SIZE +
129 GET_NONPTRS(dyn) + GET_PTRS(dyn);
133 ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee));
135 // small bitmap cases (<= 32 entries)
139 size = BITMAP_SIZE(info->i.layout.bitmap);
140 checkSmallBitmap((StgPtr)c + 1,
141 BITMAP_BITS(info->i.layout.bitmap), size);
147 bco = (StgBCO *)*(c+1);
148 size = BCO_BITMAP_SIZE(bco);
149 checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size);
153 case RET_BIG: // large bitmap (> 32 entries)
155 size = info->i.layout.large_bitmap->size;
156 checkLargeBitmap((StgPtr)c + 1, info->i.layout.large_bitmap, size);
161 StgFunInfoTable *fun_info;
164 ret_fun = (StgRetFun *)c;
165 fun_info = get_fun_itbl(ret_fun->fun);
166 size = ret_fun->size;
167 switch (fun_info->fun_type) {
169 checkSmallBitmap((StgPtr)ret_fun->payload,
170 BITMAP_BITS(fun_info->bitmap), size);
173 checkLargeBitmap((StgPtr)ret_fun->payload,
174 (StgLargeBitmap *)fun_info->bitmap, size);
177 checkSmallBitmap((StgPtr)ret_fun->payload,
178 BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]),
182 return sizeofW(StgRetFun) + size;
186 barf("checkStackFrame: weird activation record found on stack (%p).",c);
190 // check sections of stack between update frames
192 checkStackChunk( StgPtr sp, StgPtr stack_end )
197 while (p < stack_end) {
198 p += checkStackFrame( p );
200 // ASSERT( p == stack_end ); -- HWL
204 checkClosure( StgClosure* p )
206 const StgInfoTable *info;
208 ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info));
210 /* Is it a static closure (i.e. in the data segment)? */
211 if (!HEAP_ALLOCED(p)) {
212 ASSERT(closure_STATIC(p));
214 ASSERT(!closure_STATIC(p));
218 switch (info->type) {
222 StgMVar *mvar = (StgMVar *)p;
223 ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head));
224 ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail));
225 ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value));
228 checkBQ((StgBlockingQueueElement *)mvar->head, p);
230 checkBQ(mvar->head, p);
233 return sizeofW(StgMVar);
244 for (i = 0; i < info->layout.payload.ptrs; i++) {
245 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
247 return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
251 checkBQ(((StgBlockingQueue *)p)->blocking_queue, p);
252 /* fall through to basic ptr check */
267 case IND_OLDGEN_PERM:
270 case SE_CAF_BLACKHOLE:
280 case CONSTR_CHARLIKE:
282 case CONSTR_NOCAF_STATIC:
287 for (i = 0; i < info->layout.payload.ptrs; i++) {
288 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
290 return sizeW_fromITBL(info);
293 case IND_STATIC: /* (1, 0) closure */
294 ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgIndStatic*)p)->indirectee));
295 return sizeW_fromITBL(info);
298 /* deal with these specially - the info table isn't
299 * representative of the actual layout.
301 { StgWeak *w = (StgWeak *)p;
302 ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key));
303 ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value));
304 ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer));
306 ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link));
308 return sizeW_fromITBL(info);
312 ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee));
313 return sizeofW(StgHeader) + MIN_UPD_SIZE;
317 /* we don't expect to see any of these after GC
318 * but they might appear during execution
321 StgInd *ind = (StgInd *)p;
322 ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
323 q = (P_)p + sizeofW(StgInd);
324 while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
337 barf("checkClosure: stack frame");
339 case AP: /* we can treat this as being the same as a PAP */
342 StgFunInfoTable *fun_info;
343 StgPAP* pap = (StgPAP *)p;
345 ASSERT(LOOKS_LIKE_CLOSURE_PTR(pap->fun));
346 fun_info = get_fun_itbl(pap->fun);
348 p = (StgClosure *)pap->payload;
349 switch (fun_info->fun_type) {
351 checkSmallBitmap( (StgPtr)pap->payload,
352 BITMAP_BITS(fun_info->bitmap), pap->n_args );
355 checkLargeBitmap( (StgPtr)pap->payload,
356 (StgLargeBitmap *)fun_info->bitmap,
360 checkLargeBitmap( (StgPtr)pap->payload,
361 BCO_BITMAP(pap->fun),
365 checkSmallBitmap( (StgPtr)pap->payload,
366 BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]),
370 return pap_sizeW(pap);
375 StgAP_STACK *ap = (StgAP_STACK *)p;
376 ASSERT(LOOKS_LIKE_CLOSURE_PTR(ap->fun));
377 checkStackChunk((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
378 return ap_stack_sizeW(ap);
382 return arr_words_sizeW((StgArrWords *)p);
385 case MUT_ARR_PTRS_FROZEN:
387 StgMutArrPtrs* a = (StgMutArrPtrs *)p;
389 for (i = 0; i < a->ptrs; i++) {
390 ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i]));
392 return mut_arr_ptrs_sizeW(a);
396 checkTSO((StgTSO *)p);
397 return tso_sizeW((StgTSO *)p);
402 ASSERT(LOOKS_LIKE_GA(&(((StgBlockedFetch *)p)->ga)));
403 ASSERT(LOOKS_LIKE_CLOSURE_PTR((((StgBlockedFetch *)p)->node)));
404 return sizeofW(StgBlockedFetch); // see size used in evacuate()
408 return sizeofW(StgFetchMe);
412 ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga));
413 return sizeofW(StgFetchMe); // see size used in evacuate()
416 checkBQ(((StgFetchMeBlockingQueue *)p)->blocking_queue, (StgClosure *)p);
417 return sizeofW(StgFetchMeBlockingQueue); // see size used in evacuate()
420 /* In an RBH the BQ may be empty (ie END_BQ_QUEUE) but not NULL */
421 ASSERT(((StgRBH *)p)->blocking_queue!=NULL);
422 if (((StgRBH *)p)->blocking_queue!=END_BQ_QUEUE)
423 checkBQ(((StgRBH *)p)->blocking_queue, p);
424 ASSERT(LOOKS_LIKE_INFO_PTR(REVERT_INFOPTR(get_itbl((StgClosure *)p))));
425 return BLACKHOLE_sizeW(); // see size used in evacuate()
426 // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p)));
431 barf("checkClosure: found EVACUATED closure %d",
434 barf("checkClosure (closure type %d)", info->type);
440 #define PVM_PE_MASK 0xfffc0000
441 #define MAX_PVM_PES MAX_PES
442 #define MAX_PVM_TIDS MAX_PES
443 #define MAX_SLOTS 100000
446 looks_like_tid(StgInt tid)
448 StgInt hi = (tid & PVM_PE_MASK) >> 18;
449 StgInt lo = (tid & ~PVM_PE_MASK);
450 rtsBool ok = (hi != 0) && (lo < MAX_PVM_TIDS) && (hi < MAX_PVM_TIDS);
455 looks_like_slot(StgInt slot)
457 /* if tid is known better use looks_like_ga!! */
458 rtsBool ok = slot<MAX_SLOTS;
459 // This refers only to the no. of slots on the current PE
460 // rtsBool ok = slot<=highest_slot();
465 looks_like_ga(globalAddr *ga)
467 rtsBool is_tid = looks_like_tid((ga)->payload.gc.gtid);
468 rtsBool is_slot = ((ga)->payload.gc.gtid==mytid) ?
469 (ga)->payload.gc.slot<=highest_slot() :
470 (ga)->payload.gc.slot<MAX_SLOTS;
471 rtsBool ok = is_tid && is_slot;
478 /* -----------------------------------------------------------------------------
481 After garbage collection, the live heap is in a state where we can
482 run through and check that all the pointers point to the right
483 place. This function starts at a given position and sanity-checks
484 all the objects in the remainder of the chain.
485 -------------------------------------------------------------------------- */
488 checkHeap(bdescr *bd)
492 for (; bd != NULL; bd = bd->link) {
494 while (p < bd->free) {
495 nat size = checkClosure((StgClosure *)p);
496 /* This is the smallest size of closure that can live in the heap */
497 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
501 while (p < bd->free &&
502 (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; }
509 Check heap between start and end. Used after unpacking graphs.
512 checkHeapChunk(StgPtr start, StgPtr end)
514 extern globalAddr *LAGAlookup(StgClosure *addr);
518 for (p=start; p<end; p+=size) {
519 ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
520 if (get_itbl((StgClosure*)p)->type == FETCH_ME &&
521 *(p+1) == 0x0000eeee /* ie. unpack garbage (see SetGAandCommonUp) */) {
522 /* if it's a FM created during unpack and commoned up, it's not global */
523 ASSERT(LAGAlookup((StgClosure*)p)==NULL);
524 size = sizeofW(StgFetchMe);
525 } else if (get_itbl((StgClosure*)p)->type == IND) {
526 *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */
529 size = checkClosure((StgClosure *)p);
530 /* This is the smallest size of closure that can live in the heap. */
531 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
537 checkHeapChunk(StgPtr start, StgPtr end)
542 for (p=start; p<end; p+=size) {
543 ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
544 size = checkClosure((StgClosure *)p);
545 /* This is the smallest size of closure that can live in the heap. */
546 ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
552 checkChain(bdescr *bd)
555 checkClosure((StgClosure *)bd->start);
561 checkTSO(StgTSO *tso)
564 StgPtr stack = tso->stack;
565 StgOffset stack_size = tso->stack_size;
566 StgPtr stack_end = stack + stack_size;
568 if (tso->what_next == ThreadRelocated) {
573 if (tso->what_next == ThreadKilled) {
574 /* The garbage collector doesn't bother following any pointers
575 * from dead threads, so don't check sanity here.
580 ASSERT(stack <= sp && sp < stack_end);
583 ASSERT(tso->par.magic==TSO_MAGIC);
585 switch (tso->why_blocked) {
587 checkClosureShallow(tso->block_info.closure);
588 ASSERT(/* Can't be a FETCH_ME because *this* closure is on its BQ */
589 get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
591 case BlockedOnGA_NoSend:
592 checkClosureShallow(tso->block_info.closure);
593 ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
595 case BlockedOnBlackHole:
596 checkClosureShallow(tso->block_info.closure);
597 ASSERT(/* Can't be a BLACKHOLE because *this* closure is on its BQ */
598 get_itbl(tso->block_info.closure)->type==BLACKHOLE_BQ ||
599 get_itbl(tso->block_info.closure)->type==RBH);
604 /* isOnBQ(blocked_queue) */
606 case BlockedOnException:
607 /* isOnSomeBQ(tso) */
608 ASSERT(get_itbl(tso->block_info.tso)->type==TSO);
611 ASSERT(get_itbl(tso->block_info.closure)->type==MVAR);
615 Could check other values of why_blocked but I am more
616 lazy than paranoid (bad combination) -- HWL
620 /* if the link field is non-nil it most point to one of these
621 three closure types */
622 ASSERT(tso->link == END_TSO_QUEUE ||
623 get_itbl(tso->link)->type == TSO ||
624 get_itbl(tso->link)->type == BLOCKED_FETCH ||
625 get_itbl(tso->link)->type == CONSTR);
628 checkStackChunk(sp, stack_end);
633 checkTSOsSanity(void) {
637 belch("Checking sanity of all runnable TSOs:");
639 for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
640 for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
641 fprintf(stderr, "TSO %p on PE %d ...", tso, i);
643 fprintf(stderr, "OK, ");
648 belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
655 checkThreadQSanity (PEs proc, rtsBool check_TSO_too)
659 /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */
660 ASSERT(run_queue_hds[proc]!=NULL);
661 ASSERT(run_queue_tls[proc]!=NULL);
662 /* if either head or tail is NIL then the other one must be NIL, too */
663 ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE);
664 ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE);
665 for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE;
667 prev=tso, tso=tso->link) {
668 ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) &&
669 (prev==END_TSO_QUEUE || prev->link==tso));
673 ASSERT(prev==run_queue_tls[proc]);
677 checkThreadQsSanity (rtsBool check_TSO_too)
681 for (p=0; p<RtsFlags.GranFlags.proc; p++)
682 checkThreadQSanity(p, check_TSO_too);
687 Check that all TSOs have been evacuated.
688 Optionally also check the sanity of the TSOs.
691 checkGlobalTSOList (rtsBool checkTSOs)
693 extern StgTSO *all_threads;
695 for (tso=all_threads; tso != END_TSO_QUEUE; tso = tso->global_link) {
696 ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso));
697 ASSERT(get_itbl(tso)->type == TSO);
703 /* -----------------------------------------------------------------------------
704 Check mutable list sanity.
705 -------------------------------------------------------------------------- */
708 checkMutableList( StgMutClosure *p, nat gen )
712 for (; p != END_MUT_LIST; p = p->mut_link) {
714 ASSERT(closure_MUTABLE(p));
715 ASSERT(bd->gen_no == gen);
716 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link));
721 checkMutOnceList( StgMutClosure *p, nat gen )
726 for (; p != END_MUT_LIST; p = p->mut_link) {
730 ASSERT(!closure_MUTABLE(p));
731 ASSERT(ip_STATIC(info) || bd->gen_no == gen);
732 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->mut_link));
734 switch (info->type) {
737 case IND_OLDGEN_PERM:
741 barf("checkMutOnceList: strange closure %p (%s)",
742 p, info_type((StgClosure *)p));
748 Check the static objects list.
751 checkStaticObjects ( StgClosure* static_objects )
753 StgClosure *p = static_objects;
756 while (p != END_OF_STATIC_LIST) {
759 switch (info->type) {
762 StgClosure *indirectee = ((StgIndStatic *)p)->indirectee;
764 ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
765 ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));
766 p = IND_STATIC_LINK((StgClosure *)p);
771 p = THUNK_STATIC_LINK((StgClosure *)p);
775 p = FUN_STATIC_LINK((StgClosure *)p);
779 p = STATIC_LINK(info,(StgClosure *)p);
783 barf("checkStaticObjetcs: strange closure %p (%s)",
790 Check the sanity of a blocking queue starting at bqe with closure being
791 the closure holding the blocking queue.
792 Note that in GUM we can have several different closure types in a
797 checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure)
799 rtsBool end = rtsFalse;
800 StgInfoTable *info = get_itbl(closure);
802 ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR
803 || info->type == FETCH_ME_BQ || info->type == RBH);
806 switch (get_itbl(bqe)->type) {
809 checkClosure((StgClosure *)bqe);
811 end = (bqe==END_BQ_QUEUE);
815 checkClosure((StgClosure *)bqe);
820 barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n",
821 get_itbl(bqe)->type, closure, info_type(closure));
827 checkBQ (StgTSO *bqe, StgClosure *closure)
829 rtsBool end = rtsFalse;
830 StgInfoTable *info = get_itbl(closure);
832 ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
835 switch (get_itbl(bqe)->type) {
838 checkClosure((StgClosure *)bqe);
840 end = (bqe==END_BQ_QUEUE);
844 barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n",
845 get_itbl(bqe)->type, closure, info_type(closure));
851 checkBQ (StgTSO *bqe, StgClosure *closure)
853 rtsBool end = rtsFalse;
854 StgInfoTable *info = get_itbl(closure);
856 ASSERT(info->type == BLACKHOLE_BQ || info->type == MVAR);
859 switch (get_itbl(bqe)->type) {
861 checkClosure((StgClosure *)bqe);
863 end = (bqe==END_TSO_QUEUE);
867 barf("checkBQ: strange closure %d in blocking queue for closure %p\n",
868 get_itbl(bqe)->type, closure, info->type);
878 This routine checks the sanity of the LAGA and GALA tables. They are
879 implemented as lists through one hash table, LAtoGALAtable, because entries
880 in both tables have the same structure:
881 - the LAGA table maps local addresses to global addresses; it starts
882 with liveIndirections
883 - the GALA table maps global addresses to local addresses; it starts
890 /* hidden in parallel/Global.c; only accessed for testing here */
891 extern GALA *liveIndirections;
892 extern GALA *liveRemoteGAs;
893 extern HashTable *LAtoGALAtable;
896 checkLAGAtable(rtsBool check_closures)
899 nat n=0, m=0; // debugging
901 for (gala = liveIndirections; gala != NULL; gala = gala->next) {
903 gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
904 ASSERT(!gala->preferred || gala == gala0);
905 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
906 ASSERT(gala->next!=gala); // detect direct loops
907 if ( check_closures ) {
908 checkClosure((StgClosure *)gala->la);
912 for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
914 gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
915 ASSERT(!gala->preferred || gala == gala0);
916 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
917 ASSERT(gala->next!=gala); // detect direct loops
919 if ( check_closures ) {
920 checkClosure((StgClosure *)gala->la);