ghc/rts/Sanity.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Sanity.c,v 1.7 1999/01/26 11:12:47 simonm Exp $
   3  *
   4  * Sanity checking code for the heap and stack.
   5  *
   6  * Used when debugging: check that the stack looks reasonable.
   7  *
   8  *    - All things that are supposed to be pointers look like pointers.
   9  *
  10  *    - Objects in text space are marked as static closures, those
  11  *      in the heap are dynamic.
  12  *
  13  * ---------------------------------------------------------------------------*/
  14
  15 #include "Rts.h"
  16
  17 #ifdef DEBUG
  18
  19 #include "RtsFlags.h"
  20 #include "RtsUtils.h"
  21 #include "BlockAlloc.h"
  22 #include "Sanity.h"
  23
  24 #define LOOKS_LIKE_PTR(r) \
  25   (IS_DATA_PTR(r) || ((IS_USER_PTR(r) && Bdescr((P_)r)->free != (void *)-1)))
  26
  27 /* -----------------------------------------------------------------------------
  28    Check stack sanity
  29    -------------------------------------------------------------------------- */
  30
  31 StgOffset checkStackClosure( StgClosure* c );
  32
  33 StgOffset checkStackObject( StgPtr sp );
  34
  35 void      checkStackChunk( StgPtr sp, StgPtr stack_end );
  36
  37 static StgOffset checkSmallBitmap(  StgPtr payload, StgNat32 bitmap );
  38
  39 static StgOffset checkLargeBitmap( StgPtr payload,
  40                                    StgLargeBitmap* large_bitmap );
  41
  42 void checkClosureShallow( StgClosure* p );
  43
  44 static StgOffset
  45 checkSmallBitmap( StgPtr payload, StgNat32 bitmap )
  46 {
  47     StgOffset i;
  48
  49     i = 0;
  50     for(; bitmap != 0; ++i, bitmap >>= 1 ) {
  51         if ((bitmap & 1) == 0) {
  52             checkClosure(stgCast(StgClosure*,payload[i]));
  53         }
  54     }
  55     return i;
  56 }
  57
  58
  59 static StgOffset
  60 checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
  61 {
  62     StgNat32 bmp;
  63     StgOffset i;
  64
  65     i = 0;
  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]));
  71             }
  72         }
  73     }
  74     return i;
  75 }
  76
  77 StgOffset
  78 checkStackClosure( StgClosure* c )
  79 {
  80     const StgInfoTable* info = get_itbl(c);
  81
  82     /* All activation records have 'bitmap' style layout info. */
  83     switch (info->type) {
  84     case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
  85         {
  86             StgRetDyn* r = stgCast(StgRetDyn*,c);
  87             return sizeofW(StgRetDyn) +
  88                    checkSmallBitmap(r->payload,r->liveness);
  89         }
  90     case RET_BCO: /* small bitmap (<= 32 entries) */
  91     case RET_SMALL:
  92     case RET_VEC_SMALL:
  93     case UPDATE_FRAME:
  94     case CATCH_FRAME:
  95     case STOP_FRAME:
  96     case SEQ_FRAME:
  97             return sizeofW(StgClosure) +
  98                    checkSmallBitmap((StgPtr)c->payload,info->layout.bitmap);
  99     case RET_BIG: /* large bitmap (> 32 entries) */
 100     case RET_VEC_BIG:
 101             return sizeofW(StgClosure) +
 102                    checkLargeBitmap((StgPtr)c->payload,
 103                                     info->layout.large_bitmap);
 104     case FUN:
 105     case FUN_STATIC: /* probably a slow-entry point return address: */
 106             return 1;
 107     default:
 108             /* if none of the above, maybe it's a closure which looks a
 109              * little like an infotable
 110              */
 111             checkClosureShallow(*stgCast(StgClosure**,c));
 112             return 1;
 113             /* barf("checkStackClosure: weird activation record found on stack (%p).",c); */
 114     }
 115 }
 116
 117 /*
 118  * check that it looks like a valid closure - without checking its payload
 119  * used to avoid recursion between checking PAPs and checking stack
 120  * chunks.
 121  */
 122
 123 void
 124 checkClosureShallow( StgClosure* p )
 125 {
 126     ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
 127
 128     /* Is it a static closure (i.e. in the data segment)? */
 129     if (LOOKS_LIKE_STATIC(p)) {
 130         ASSERT(closure_STATIC(p));
 131     } else {
 132         ASSERT(!closure_STATIC(p));
 133         ASSERT(LOOKS_LIKE_PTR(p));
 134     }
 135 }
 136
 137 /* check an individual stack object */
 138 StgOffset
 139 checkStackObject( StgPtr sp )
 140 {
 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).
 145          */
 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));
 151         return 1;
 152     }
 153 }
 154
 155 /* check sections of stack between update frames */
 156 void
 157 checkStackChunk( StgPtr sp, StgPtr stack_end )
 158 {
 159     StgPtr p;
 160
 161     p = sp;
 162     while (p < stack_end) {
 163         p += checkStackObject( p );
 164     }
 165     ASSERT( p == stack_end );
 166 }
 167
 168 StgOffset
 169 checkClosure( StgClosure* p )
 170 {
 171     const StgInfoTable *info;
 172
 173 #ifndef INTERPRETER
 174     ASSERT(LOOKS_LIKE_GHC_INFO(p->header.info));
 175 #endif
 176
 177     /* Is it a static closure (i.e. in the data segment)? */
 178     if (LOOKS_LIKE_STATIC(p)) {
 179         ASSERT(closure_STATIC(p));
 180     } else {
 181         ASSERT(!closure_STATIC(p));
 182         ASSERT(LOOKS_LIKE_PTR(p));
 183     }
 184
 185     info = get_itbl(p);
 186     switch (info->type) {
 187     case BCO:
 188         {
 189             StgBCO* bco = stgCast(StgBCO*,p);
 190             nat i;
 191             for(i=0; i < bco->n_ptrs; ++i) {
 192                 ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i)));
 193             }
 194             return bco_sizeW(bco);
 195         }
 196
 197     case MVAR:
 198       {
 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);
 204       }
 205
 206     case FUN:
 207     case THUNK:
 208     case CONSTR:
 209     case IND_PERM:
 210     case IND_OLDGEN:
 211     case IND_OLDGEN_PERM:
 212     case CAF_UNENTERED:
 213     case CAF_ENTERED:
 214     case CAF_BLACKHOLE:
 215     case BLACKHOLE:
 216     case BLACKHOLE_BQ:
 217     case FOREIGN:
 218     case STABLE_NAME:
 219     case MUT_VAR:
 220     case CONSTR_INTLIKE:
 221     case CONSTR_CHARLIKE:
 222     case CONSTR_STATIC:
 223     case CONSTR_NOCAF_STATIC:
 224     case THUNK_STATIC:
 225     case FUN_STATIC:
 226     case IND_STATIC:
 227         {
 228             nat i;
 229             for (i = 0; i < info->layout.payload.ptrs; i++) {
 230                 ASSERT(LOOKS_LIKE_PTR(payloadPtr(p,i)));
 231             }
 232             return sizeW_fromITBL(info);
 233         }
 234
 235     case WEAK:
 236       /* deal with these specially - the info table isn't
 237        * representative of the actual layout.
 238        */
 239       { StgWeak *w = (StgWeak *)p;
 240         ASSERT(LOOKS_LIKE_PTR(w->key));
 241         ASSERT(LOOKS_LIKE_PTR(w->value));
 242         ASSERT(LOOKS_LIKE_PTR(w->finaliser));
 243         if (w->link) {
 244           ASSERT(LOOKS_LIKE_PTR(w->link));
 245         }
 246         return sizeW_fromITBL(info);
 247       }
 248
 249     case THUNK_SELECTOR:
 250             ASSERT(LOOKS_LIKE_PTR(stgCast(StgSelector*,p)->selectee));
 251             return sizeofW(StgHeader) + MIN_UPD_SIZE;
 252
 253     case IND:
 254         {
 255             /* we don't expect to see any of these after GC
 256              * but they might appear during execution
 257              */
 258             P_ q;
 259             StgInd *ind = stgCast(StgInd*,p);
 260             ASSERT(LOOKS_LIKE_PTR(ind->indirectee));
 261             q = (P_)p + sizeofW(StgInd);
 262             while (!*q) { q++; }; /* skip padding words (see GC.c: evacuate())*/
 263             return q - (P_)p;
 264         }
 265
 266     case RET_BCO:
 267     case RET_SMALL:
 268     case RET_VEC_SMALL:
 269     case RET_BIG:
 270     case RET_VEC_BIG:
 271     case RET_DYN:
 272     case UPDATE_FRAME:
 273     case STOP_FRAME:
 274     case CATCH_FRAME:
 275     case SEQ_FRAME:
 276             barf("checkClosure: stack frame");
 277
 278     case AP_UPD: /* we can treat this as being the same as a PAP */
 279     case PAP:
 280         {
 281             StgPAP *pap = stgCast(StgPAP*,p);
 282             ASSERT(LOOKS_LIKE_PTR(pap->fun));
 283             checkStackChunk((StgPtr)pap->payload,
 284                             (StgPtr)pap->payload + pap->n_args
 285                             );
 286             return pap_sizeW(pap);
 287         }
 288
 289     case ARR_WORDS:
 290     case MUT_ARR_WORDS:
 291             return arr_words_sizeW(stgCast(StgArrWords*,p));
 292
 293     case MUT_ARR_PTRS:
 294     case MUT_ARR_PTRS_FROZEN:
 295         {
 296             StgMutArrPtrs* a = stgCast(StgMutArrPtrs*,p);
 297             nat i;
 298             for (i = 0; i < a->ptrs; i++) {
 299                 ASSERT(LOOKS_LIKE_PTR(a->payload[i]));
 300             }
 301             return mut_arr_ptrs_sizeW(a);
 302         }
 303
 304     case TSO:
 305         checkTSO((StgTSO *)p);
 306         return tso_sizeW((StgTSO *)p);
 307
 308     case BLOCKED_FETCH:
 309     case FETCH_ME:
 310     case EVACUATED:
 311             barf("checkClosure: unimplemented/strange closure type");
 312     default:
 313             barf("checkClosure");
 314     }
 315 #undef LOOKS_LIKE_PTR
 316 }
 317
 318 /* -----------------------------------------------------------------------------
 319    Check Heap Sanity
 320
 321    After garbage collection, the live heap is in a state where we can
 322    run through and check that all the pointers point to the right
 323    place.  This function starts at a given position and sanity-checks
 324    all the objects in the remainder of the chain.
 325    -------------------------------------------------------------------------- */
 326
 327 extern void
 328 checkHeap(bdescr *bd, StgPtr start)
 329 {
 330     StgPtr p;
 331
 332     if (start == NULL) {
 333       p = bd->start;
 334     } else {
 335       p = start;
 336     }
 337
 338     while (bd != NULL) {
 339       while (p < bd->free) {
 340         nat size = checkClosure(stgCast(StgClosure*,p));
 341         /* This is the smallest size of closure that can live in the heap. */
 342         ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
 343         p += size;
 344
 345         /* skip over slop */
 346         while (p < bd->free &&
 347                (*p == 0 || !LOOKS_LIKE_GHC_INFO(*p))) { p++; }
 348       }
 349       bd = bd->link;
 350       if (bd != NULL) {
 351         p = bd->start;
 352       }
 353     }
 354 }
 355
 356 extern void
 357 checkChain(bdescr *bd)
 358 {
 359   while (bd != NULL) {
 360     checkClosure((StgClosure *)bd->start);
 361     bd = bd->link;
 362   }
 363 }
 364
 365 /* check stack - making sure that update frames are linked correctly */
 366 void
 367 checkStack(StgPtr sp, StgPtr stack_end, StgUpdateFrame* su )
 368 {
 369     /* check everything down to the first update frame */
 370     checkStackChunk( sp, stgCast(StgPtr,su) );
 371     while ( stgCast(StgPtr,su) < stack_end) {
 372         sp = stgCast(StgPtr,su);
 373         switch (get_itbl(su)->type) {
 374         case UPDATE_FRAME:
 375                 su = su->link;
 376                 break;
 377         case SEQ_FRAME:
 378                 su = stgCast(StgSeqFrame*,su)->link;
 379                 break;
 380         case CATCH_FRAME:
 381                 su = stgCast(StgCatchFrame*,su)->link;
 382                 break;
 383         case STOP_FRAME:
 384                 /* not quite: ASSERT(stgCast(StgPtr,su) == stack_end); */
 385                 return;
 386         default:
 387                 barf("checkStack: weird record found on update frame list.");
 388         }
 389         checkStackChunk( sp, stgCast(StgPtr,su) );
 390     }
 391     ASSERT(stgCast(StgPtr,su) == stack_end);
 392 }
 393
 394 extern void
 395 checkTSO(StgTSO *tso)
 396 {
 397     StgPtr sp = tso->sp;
 398     StgPtr stack = tso->stack;
 399     StgUpdateFrame* su = tso->su;
 400     StgOffset stack_size = tso->stack_size;
 401     StgPtr stack_end = stack + stack_size;
 402
 403     if (tso->whatNext == ThreadComplete ||  tso->whatNext == ThreadKilled) {
 404       /* The garbage collector doesn't bother following any pointers
 405        * from dead threads, so don't check sanity here.
 406        */
 407       return;
 408     }
 409
 410     ASSERT(stack <= sp && sp < stack_end);
 411     ASSERT(sp <= stgCast(StgPtr,su));
 412
 413     checkStack(sp, stack_end, su);
 414 }
 415
 416 /* -----------------------------------------------------------------------------
 417    Check Blackhole Sanity
 418
 419    Test whether an object is already on the update list.
 420    It isn't necessarily an rts error if it is - it might be a programming
 421    error.
 422
 423    Future versions might be able to test for a blackhole without traversing
 424    the update frame list.
 425
 426    -------------------------------------------------------------------------- */
 427 rtsBool isBlackhole( StgTSO* tso, StgClosure* p )
 428 {
 429   StgUpdateFrame* su = tso->su;
 430   do {
 431     switch (get_itbl(su)->type) {
 432     case UPDATE_FRAME:
 433       if (su->updatee == p) {
 434         return rtsTrue;
 435       } else {
 436         su = su->link;
 437       }
 438       break;
 439     case SEQ_FRAME:
 440       su = stgCast(StgSeqFrame*,su)->link;
 441       break;
 442     case CATCH_FRAME:
 443       su = stgCast(StgCatchFrame*,su)->link;
 444       break;
 445     case STOP_FRAME:
 446       return rtsFalse;
 447     default:
 448       barf("isBlackhole: weird record found on update frame list.");
 449     }
 450   } while (1);
 451 }
 452
 453 #endif /* DEBUG */