ghc/rts/Sanity.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Sanity.c,v 1.15 2000/01/13 14:34:04 hwloidl Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Sanity checking code for the heap and stack.
   7  *
   8  * Used when debugging: check that the stack looks reasonable.
   9  *
  10  *    - All things that are supposed to be pointers look like pointers.
  11  *
  12  *    - Objects in text space are marked as static closures, those
  13  *      in the heap are dynamic.
  14  *
  15  * ---------------------------------------------------------------------------*/
  16
  17 //@menu
  18 //* Includes::
  19 //* Macros::
  20 //* Stack sanity::
  21 //* Heap Sanity::
  22 //* TSO Sanity::
  23 //* Thread Queue Sanity::
  24 //* Blackhole Sanity::
  25 //@end menu
  26
  27 //@node Includes, Macros
  28 //@subsection Includes
  29
  30 #include "Rts.h"
  31
  32 #ifdef DEBUG                                                   /* whole file */
  33
  34 #include "RtsFlags.h"
  35 #include "RtsUtils.h"
  36 #include "BlockAlloc.h"
  37 #include "Sanity.h"
  38
  39 //@node Macros, Stack sanity, Includes
  40 //@subsection Macros
  41
  42 #define LOOKS_LIKE_PTR(r) (LOOKS_LIKE_STATIC_CLOSURE(r) || ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
  43
  44 //@node Stack sanity, Heap Sanity, Macros
  45 //@subsection Stack sanity
  46
  47 /* -----------------------------------------------------------------------------
  48    Check stack sanity
  49    -------------------------------------------------------------------------- */
  50
  51 StgOffset checkStackClosure( StgClosure* c );
  52
  53 StgOffset checkStackObject( StgPtr sp );
  54
  55 void      checkStackChunk( StgPtr sp, StgPtr stack_end );
  56
  57 static StgOffset checkSmallBitmap(  StgPtr payload, StgWord32 bitmap );
  58
  59 static StgOffset checkLargeBitmap( StgPtr payload,
  60                                    StgLargeBitmap* large_bitmap );
  61
  62 void checkClosureShallow( StgClosure* p );
  63
  64 //@cindex checkSmallBitmap
  65 static StgOffset
  66 checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
  67 {
  68     StgOffset i;
  69
  70     i = 0;
  71     for(; bitmap != 0; ++i, bitmap >>= 1 ) {
  72         if ((bitmap & 1) == 0) {
  73             checkClosure(stgCast(StgClosure*,payload[i]));
  74         }
  75     }
  76     return i;
  77 }
  78
  79 //@cindex checkLargeBitmap
  80 static StgOffset
  81 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
  82 {
  83     StgWord32 bmp;
  84     StgOffset i;
  85
  86     i = 0;
  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]));
  92             }
  93         }
  94     }
  95     return i;
  96 }
  97
  98 //@cindex checkStackClosure
  99 StgOffset
 100 checkStackClosure( StgClosure* c )
 101 {
 102     const StgInfoTable* info = get_itbl(c);
 103
 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 */
 107         {
 108             StgRetDyn* r = (StgRetDyn *)c;
 109             return sizeofW(StgRetDyn) +
 110                    checkSmallBitmap(r->payload,r->liveness);
 111         }
 112     case RET_BCO: /* small bitmap (<= 32 entries) */
 113     case RET_SMALL:
 114     case RET_VEC_SMALL:
 115             return 1 + checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
 116
 117     case UPDATE_FRAME:
 118     case CATCH_FRAME:
 119     case STOP_FRAME:
 120     case SEQ_FRAME:
 121 #if defined(GRAN)
 122             return 2 +
 123 #else
 124             return 1 +
 125 #endif
 126                        checkSmallBitmap((StgPtr)c + 1,info->layout.bitmap);
 127     case RET_BIG: /* large bitmap (> 32 entries) */
 128     case RET_VEC_BIG:
 129             return 1 + checkLargeBitmap((StgPtr)c + 1,info->layout.large_bitmap);
 130     case FUN:
 131     case FUN_STATIC: /* probably a slow-entry point return address: */
 132 #if 0 && defined(GRAN)
 133             return 2;
 134 #else
 135             return 1;
 136 #endif
 137     default:
 138             /* if none of the above, maybe it's a closure which looks a
 139              * little like an infotable
 140              */
 141             checkClosureShallow(*(StgClosure **)c);
 142             return 1;
 143             /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
 144     }
 145 }
 146
 147 /*
 148  * check that it looks like a valid closure - without checking its payload
 149  * used to avoid recursion between checking PAPs and checking stack
 150  * chunks.
 151  */
 152
 153 //@cindex checkClosureShallow
 154 void
 155 checkClosureShallow( StgClosure* p )
 156 {
 157     ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
 158
 159     /* Is it a static closure (i.e. in the data segment)? */
 160     if (LOOKS_LIKE_STATIC(p)) {
 161         ASSERT(closure_STATIC(p));
 162     } else {
 163         ASSERT(!closure_STATIC(p));
 164         ASSERT(LOOKS_LIKE_PTR(p));
 165     }
 166 }
 167
 168 /* check an individual stack object */
 169 //@cindex checkStackObject
 170 StgOffset
 171 checkStackObject( StgPtr sp )
 172 {
 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).
 177          */
 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));
 183         return 1;
 184     }
 185 }
 186
 187 /* check sections of stack between update frames */
 188 //@cindex checkStackChunk
 189 void
 190 checkStackChunk( StgPtr sp, StgPtr stack_end )
 191 {
 192     StgPtr p;
 193
 194     p = sp;
 195     while (p < stack_end) {
 196         p += checkStackObject( p );
 197     }
 198     // ASSERT( p == stack_end ); -- HWL
 199 }
 200
 201 //@cindex checkStackChunk
 202 StgOffset
 203 checkClosure( StgClosure* p )
 204 {
 205     const StgInfoTable *info;
 206
 207 #ifndef INTERPRETER
 208     ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
 209 #endif
 210
 211     /* Is it a static closure (i.e. in the data segment)? */
 212     if (LOOKS_LIKE_STATIC(p)) {
 213         ASSERT(closure_STATIC(p));
 214     } else {
 215         ASSERT(!closure_STATIC(p));
 216         ASSERT(LOOKS_LIKE_PTR(p));
 217     }
 218
 219     info = get_itbl(p);
 220     switch (info->type) {
 221     case BCO:
 222         {
 223             StgBCO* bco = stgCast(StgBCO*,p);
 224             nat i;
 225             for(i=0; i < bco->n_ptrs; ++i) {
 226                 ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
 227             }
 228             return bco_sizeW(bco);
 229         }
 230
 231     case MVAR:
 232       {
 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);
 238       }
 239
 240     case THUNK:
 241     case THUNK_1_0:
 242     case THUNK_0_1:
 243     case THUNK_1_1:
 244     case THUNK_0_2:
 245     case THUNK_2_0:
 246       {
 247         nat i;
 248         for (i = 0; i < info->layout.payload.ptrs; i++) {
 249           ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
 250         }
 251         return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
 252       }
 253
 254     case FUN:
 255     case FUN_1_0:
 256     case FUN_0_1:
 257     case FUN_1_1:
 258     case FUN_0_2:
 259     case FUN_2_0:
 260     case CONSTR:
 261     case CONSTR_1_0:
 262     case CONSTR_0_1:
 263     case CONSTR_1_1:
 264     case CONSTR_0_2:
 265     case CONSTR_2_0:
 266     case IND_PERM:
 267     case IND_OLDGEN:
 268     case IND_OLDGEN_PERM:
 269     case CAF_UNENTERED:
 270     case CAF_ENTERED:
 271     case CAF_BLACKHOLE:
 272 #ifdef TICKY_TICKY
 273     case SE_CAF_BLACKHOLE:
 274     case SE_BLACKHOLE:
 275 #endif
 276     case BLACKHOLE:
 277     case BLACKHOLE_BQ:
 278     case FOREIGN:
 279     case STABLE_NAME:
 280     case MUT_VAR:
 281     case CONSTR_INTLIKE:
 282     case CONSTR_CHARLIKE:
 283     case CONSTR_STATIC:
 284     case CONSTR_NOCAF_STATIC:
 285     case THUNK_STATIC:
 286     case FUN_STATIC:
 287     case IND_STATIC:
 288         {
 289             nat i;
 290             for (i = 0; i < info->layout.payload.ptrs; i++) {
 291                 ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
 292             }
 293             return sizeW_fromITBL(info);
 294         }
 295
 296     case WEAK:
 297       /* deal with these specially - the info table isn't
 298        * representative of the actual layout.
 299        */
 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));
 304         if (w->link) {
 305           ASSERT(LOOKS_LIKE_PTR(w->link));
 306         }
 307         return sizeW_fromITBL(info);
 308       }
 309
 310     case THUNK_SELECTOR:
 311             ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee));
 312             return sizeofW(StgHeader) + MIN_UPD_SIZE;
 313
 314     case IND:
 315         {
 316             /* we don't expect to see any of these after GC
 317              * but they might appear during execution
 318              */
 319             P_ q;
 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())*/
 324             return q - (P_)p;
 325         }
 326
 327     case RET_BCO:
 328     case RET_SMALL:
 329     case RET_VEC_SMALL:
 330     case RET_BIG:
 331     case RET_VEC_BIG:
 332     case RET_DYN:
 333     case UPDATE_FRAME:
 334     case STOP_FRAME:
 335     case CATCH_FRAME:
 336     case SEQ_FRAME:
 337             barf("checkClosure: stack frame");
 338
 339     case AP_UPD: /* we can treat this as being the same as a PAP */
 340     case PAP:
 341         {
 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
 346                             );
 347             return pap_sizeW(pap);
 348         }
 349
 350     case ARR_WORDS:
 351             return arr_words_sizeW(stgCast(StgArrWords*,p));
 352
 353     case MUT_ARR_PTRS:
 354     case MUT_ARR_PTRS_FROZEN:
 355         {
 356             StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
 357             nat i;
 358             for (i = 0; i < a->ptrs; i++) {
 359                 ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
 360             }
 361             return mut_arr_ptrs_sizeW(a);
 362         }
 363
 364     case TSO:
 365         checkTSO((StgTSO *)p);
 366         return tso_sizeW((StgTSO *)p);
 367
 368     case BLOCKED_FETCH:
 369     case FETCH_ME:
 370     case EVACUATED:
 371             barf("checkClosure: unimplemented/strange closure type %d",
 372                  info->type);
 373     default:
 374             barf("checkClosure (closure type %d)", info->type);
 375     }
 376 #undef LOOKS_LIKE_PTR
 377 }
 378
 379 //@node Heap Sanity, TSO Sanity, Stack sanity
 380 //@subsection Heap Sanity
 381
 382 /* -----------------------------------------------------------------------------
 383    Check Heap Sanity
 384
 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    -------------------------------------------------------------------------- */
 390
 391 //@cindex checkHeap
 392 extern void
 393 checkHeap(bdescr *bd, StgPtr start)
 394 {
 395     StgPtr p;
 396
 397     if (start == NULL) {
 398       p = bd->start;
 399     } else {
 400       p = start;
 401     }
 402
 403     while (bd != NULL) {
 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) );
 408         p += size;
 409
 410         /* skip over slop */
 411         while (p < bd->free &&
 412                (*p == 0 || !LOOKS_LIKE_GHC_INFO((void*)*p))) { p++; }
 413       }
 414       bd = bd->link;
 415       if (bd != NULL) {
 416         p = bd->start;
 417       }
 418     }
 419 }
 420
 421 //@cindex checkChain
 422 extern void
 423 checkChain(bdescr *bd)
 424 {
 425   while (bd != NULL) {
 426     checkClosure((StgClosure *)bd->start);
 427     bd = bd->link;
 428   }
 429 }
 430
 431 /* check stack - making sure that update frames are linked correctly */
 432 //@cindex checkStack
 433 void
 434 checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
 435 {
 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) {
 441         case UPDATE_FRAME:
 442                 su = su->link;
 443                 break;
 444         case SEQ_FRAME:
 445                 su = stgCast(StgSeqFrame*,su)->link;
 446                 break;
 447         case CATCH_FRAME:
 448                 su = stgCast(StgCatchFrame*,su)->link;
 449                 break;
 450         case STOP_FRAME:
 451                 /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */
 452                 return;
 453         default:
 454                 barf("checkStack: weird record found on update frame list.");
 455         }
 456         checkStackChunk( sp, stgCast(StgPtr,su) );
 457     }
 458     ASSERT(stgCast(StgPtr,su) == stack_end);
 459 }
 460
 461 //@node TSO Sanity, Thread Queue Sanity, Heap Sanity
 462 //@subsection TSO Sanity
 463
 464 //@cindex checkTSO
 465 extern void
 466 checkTSO(StgTSO *tso)
 467 {
 468     StgPtr sp = tso->sp;
 469     StgPtr stack = tso->stack;
 470     StgUpdateFrame* su = tso->su;
 471     StgOffset stack_size = tso->stack_size;
 472     StgPtr stack_end = stack + stack_size;
 473
 474     if (tso->whatNext == ThreadComplete ||  tso->whatNext == ThreadKilled) {
 475       /* The garbage collector doesn't bother following any pointers
 476        * from dead threads, so don't check sanity here.
 477        */
 478       return;
 479     }
 480
 481     ASSERT(stack <= sp && sp < stack_end);
 482     ASSERT(sp <= stgCast(StgPtr,su));
 483
 484     checkStack(sp, stack_end, su);
 485 }
 486
 487 #if defined(GRAN)
 488 //@cindex checkTSOsSanity
 489 extern void
 490 checkTSOsSanity(void) {
 491   nat i, tsos;
 492   StgTSO *tso;
 493
 494   belch("Checking sanity of all runnable TSOs:");
 495
 496   for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
 497     for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
 498       fprintf(stderr, "TSO %p on PE %d ...", tso, i);
 499       checkTSO(tso);
 500       fprintf(stderr, "OK, ");
 501       tsos++;
 502     }
 503   }
 504
 505   belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
 506 }
 507
 508 //@node Thread Queue Sanity, Blackhole Sanity, TSO Sanity
 509 //@subsection Thread Queue Sanity
 510
 511 // still GRAN only
 512
 513 //@cindex checkThreadQSanity
 514 extern rtsBool
 515 checkThreadQSanity (PEs proc, rtsBool check_TSO_too)
 516 {
 517   StgTSO *tso, *prev;
 518
 519   /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */
 520   ASSERT(run_queue_hds[proc]!=NULL);
 521   ASSERT(run_queue_tls[proc]!=NULL);
 522   /* if either head or tail is NIL then the other one must be NIL, too */
 523   ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE);
 524   ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE);
 525   for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE;
 526        tso!=END_TSO_QUEUE;
 527        prev=tso, tso=tso->link) {
 528     ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) &&
 529            (prev==END_TSO_QUEUE || prev->link==tso));
 530     if (check_TSO_too)
 531       checkTSO(tso);
 532   }
 533   ASSERT(prev==run_queue_tls[proc]);
 534 }
 535
 536 //@cindex checkThreadQsSanity
 537 extern rtsBool
 538 checkThreadQsSanity (rtsBool check_TSO_too)
 539 {
 540   PEs p;
 541
 542   for (p=0; p<RtsFlags.GranFlags.proc; p++)
 543     checkThreadQSanity(p, check_TSO_too);
 544 }
 545 #endif /* GRAN */
 546
 547 //@node Blackhole Sanity, Index, Thread Queue Sanity
 548 //@subsection Blackhole Sanity
 549
 550 /* -----------------------------------------------------------------------------
 551    Check Blackhole Sanity
 552
 553    Test whether an object is already on the update list.
 554    It isn't necessarily an rts error if it is - it might be a programming
 555    error.
 556
 557    Future versions might be able to test for a blackhole without traversing
 558    the update frame list.
 559
 560    -------------------------------------------------------------------------- */
 561 //@cindex isBlackhole
 562 rtsBool
 563 isBlackhole( StgTSO* tso, StgClosure* p )
 564 {
 565   StgUpdateFrame* su = tso->su;
 566   do {
 567     switch (get_itbl(su)->type) {
 568     case UPDATE_FRAME:
 569       if (su->updatee == p) {
 570         return rtsTrue;
 571       } else {
 572         su = su->link;
 573       }
 574       break;
 575     case SEQ_FRAME:
 576       su = stgCast(StgSeqFrame*,su)->link;
 577       break;
 578     case CATCH_FRAME:
 579       su = stgCast(StgCatchFrame*,su)->link;
 580       break;
 581     case STOP_FRAME:
 582       return rtsFalse;
 583     default:
 584       barf("isBlackhole: weird record found on update frame list.");
 585     }
 586   } while (1);
 587 }
 588
 589 //@node Index,  , Blackhole Sanity
 590 //@subsection Index
 591
 592 //@index
 593 //* checkChain::  @cindex\s-+checkChain
 594 //* checkClosureShallow::  @cindex\s-+checkClosureShallow
 595 //* checkHeap::  @cindex\s-+checkHeap
 596 //* checkLargeBitmap::  @cindex\s-+checkLargeBitmap
 597 //* checkSmallBitmap::  @cindex\s-+checkSmallBitmap
 598 //* checkStack::  @cindex\s-+checkStack
 599 //* checkStackChunk::  @cindex\s-+checkStackChunk
 600 //* checkStackChunk::  @cindex\s-+checkStackChunk
 601 //* checkStackClosure::  @cindex\s-+checkStackClosure
 602 //* checkStackObject::  @cindex\s-+checkStackObject
 603 //* checkTSO::  @cindex\s-+checkTSO
 604 //* checkTSOsSanity::  @cindex\s-+checkTSOsSanity
 605 //* checkThreadQSanity::  @cindex\s-+checkThreadQSanity
 606 //* checkThreadQsSanity::  @cindex\s-+checkThreadQsSanity
 607 //* isBlackhole::  @cindex\s-+isBlackhole
 608 //@end index
 609
 610 #endif /* DEBUG */
 611