rts/parallel/ParallelDebug.c

   1 /*
   2   Time-stamp: <Sun Mar 18 2001 19:32:56 Stardate: [-30]6349.07 hwloidl>
   3
   4   Various debugging routines for GranSim and GUM
   5 */
   6
   7 #if defined(DEBUG) && (defined(GRAN) || defined(PAR))        /* whole file */
   8
   9 //@node Debugging routines for GranSim and GUM, , ,
  10 //@section Debugging routines for GranSim and GUM
  11
  12 //@menu
  13 //* Includes::
  14 //* Constants and Variables::
  15 //* Closures::
  16 //* Threads::
  17 //* Events::
  18 //* Sparks::
  19 //* Processors::
  20 //* Shortcuts::
  21 //* Printing info type::
  22 //* Printing Pack:et Contents::
  23 //* End of File::
  24 //@end menu
  25 //*/
  26
  27 //@node Includes, Prototypes, Debugging routines for GranSim and GUM, Debugging routines for GranSim and GUM
  28 //@subsection Includes
  29
  30 #include "Rts.h"
  31 #include "RtsFlags.h"
  32 #include "GranSimRts.h"
  33 #include "ParallelRts.h"
  34 #include "StgMiscClosures.h"
  35 #include "Printer.h"
  36 # if defined(DEBUG)
  37 # include "Hash.h"
  38 # include "Storage.h"
  39 # include "ParallelDebug.h"
  40 # endif
  41
  42 //@node Prototypes, Constants and Variables, Includes, Debugging routines for GranSim and GUM
  43 //@subsection Prototypes
  44 /*
  45 rtsBool  isOffset(globalAddr *ga);
  46 rtsBool  isFixed(globalAddr *ga);
  47 */
  48 //@node Constants and Variables, Closures, Prototypes, Debugging routines for GranSim and GUM
  49 //@subsection Constants and Variables
  50
  51 static HashTable *tmpClosureTable;  // used in GraphFingerPrint and PrintGraph
  52
  53 #if defined(PAR)
  54 static char finger_print_char[] = {
  55  '/',  /* INVALID_OBJECT          0 */
  56  'C', /* CONSTR                  1 */
  57  'C', /*        CONSTR_1_0              2 */
  58  'C', /*        CONSTR_0_1              3 */
  59  'C', /*        CONSTR_2_0              4 */
  60  'C', /*        CONSTR_1_1              5 */
  61  'C', /*        CONSTR_0_2              6 */
  62  'I', /* CONSTR_INTLIKE         7  */
  63  'I', /* CONSTR_CHARLIKE                8  */
  64  'S', /* CONSTR_STATIC          9  */
  65  'S', /* CONSTR_NOCAF_STATIC     10 */
  66  'F', /* FUN                    11 */
  67  'F', /*        FUN_1_0                 12 */
  68  'F', /*        FUN_0_1                 13 */
  69  'F', /*        FUN_2_0                 14 */
  70  'F', /*        FUN_1_1                 15 */
  71  'F', /*        FUN_0_2                 16 */
  72  'S', /* FUN_STATIC             17 */
  73  'T', /* THUNK                  18 */
  74  'T', /*        THUNK_1_0       19 */
  75  'T', /*        THUNK_0_1       20 */
  76  'T', /*        THUNK_2_0       21 */
  77  'T', /*        THUNK_1_1       22 */
  78  'T', /*        THUNK_0_2       23 */
  79  'S', /* THUNK_STATIC           24 */
  80  'E', /* THUNK_SELECTOR         25 */
  81  'b', /* BCO                    26 */
  82  'p', /* AP_UPD                 27 */
  83  'p', /* PAP                    28 */
  84  '_', /* IND                    29 */
  85  '_', /* IND_OLDGEN             30 */
  86  '_', /* IND_PERM               31 */
  87  '_', /* IND_OLDGEN_PERM        32 */
  88  '_', /* IND_STATIC             33 */
  89  '?', /* ***unused***           34 */
  90  '?', /* ***unused***           35 */
  91  '^', /* RET_BCO                36 */
  92  '^', /* RET_SMALL              37 */
  93  '^', /* RET_VEC_SMALL          38 */
  94  '^', /* RET_BIG                39 */
  95  '^', /* RET_VEC_BIG            40 */
  96  '^', /* RET_DYN                41 */
  97  '~', /* UPDATE_FRAME           42 */
  98  '~', /* CATCH_FRAME            43 */
  99  '~', /* STOP_FRAME             44 */
 100  '~', /* SEQ_FRAME              45 */
 101  'o', /* CAF_BLACKHOLE          46 */
 102  'o', /* BLACKHOLE              47 */
 103  'o', /* BLACKHOLE_BQ           48 */
 104  'o', /* SE_BLACKHOLE           49 */
 105  'o', /* SE_CAF_BLACKHOLE       50 */
 106  'm', /* MVAR                   51 */
 107  'a', /* ARR_WORDS              52 */
 108  'a', /* MUT_ARR_PTRS           53 */
 109  'a', /* MUT_ARR_PTRS_FROZEN    54 */
 110  'q', /* MUT_VAR                55 */
 111  'w', /* WEAK                   56 */
 112  'f', /* FOREIGN                57 */
 113  's', /* STABLE_NAME            58 */
 114  '@', /* TSO                    59 */
 115  '#', /* BLOCKED_FETCH          60 */
 116  '>', /* FETCH_ME               61 */
 117  '>', /* FETCH_ME_BQ            62 */
 118  '$', /* RBH                    63 */
 119  'v', /* EVACUATED              64 */
 120  '>' /* REMOTE_REF              65 */
 121      /* ASSERT(there are N_CLOSURE_TYPES (==66) in this arrary) */
 122 };
 123 #endif /* PAR */
 124
 125 #if defined(GRAN) && defined(GRAN_CHECK)
 126 //@node Closures, Threads, Constants and Variables, Debugging routines for GranSim and GUM
 127 //@subsection Closures
 128
 129 void
 130 G_PRINT_NODE(node)
 131 StgClosure* node;
 132 {
 133    StgInfoTable *info_ptr;
 134    StgTSO* bqe;
 135    nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0;
 136    char info_hdr_ty[80], info_ty[80];
 137
 138    if (node==NULL) {
 139      fprintf(stderr,"NULL\n");
 140      return;
 141    } else if (node==END_TSO_QUEUE) {
 142      fprintf(stderr,"END_TSO_QUEUE\n");
 143      return;
 144    }
 145    /* size_and_ptrs(node,&size,&ptrs); */
 146    info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_hdr_ty);
 147
 148    /* vhs = var_hdr_size(node); */
 149    display_info_type(info_ptr,info_ty);
 150
 151    fprintf(stderr,"Node: 0x%lx", node);
 152
 153 #if defined(PAR)
 154    fprintf(stderr," [GA: 0x%lx]",GA(node));
 155 #endif
 156
 157 #if defined(USE_COST_CENTRES)
 158    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 159 #endif
 160
 161 #if defined(GRAN)
 162    fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
 163 #endif
 164
 165    if (info_ptr->type==TSO)
 166      fprintf(stderr," TSO: 0x%lx (%x) IP: 0x%lx (%s), type %s \n     ",
 167              (StgTSO*)node, ((StgTSO*)node)->id, info_ptr, info_hdr_ty, info_ty);
 168    else
 169      fprintf(stderr," IP: 0x%lx (%s), type %s \n       VHS: %d, size: %ld, ptrs:%ld, nonptrs:  %ld\n     ",
 170              info_ptr,info_hdr_ty,info_ty,vhs,size,ptrs,nonptrs);
 171
 172    /* For now, we ignore the variable header */
 173
 174    fprintf(stderr," Ptrs: ");
 175    for(i=0; i < ptrs; ++i)
 176      {
 177      if ( (i+1) % 6 == 0)
 178        fprintf(stderr,"\n      ");
 179      fprintf(stderr," 0x%lx[P]",node->payload[i]);
 180      };
 181
 182    fprintf(stderr," Data: ");
 183    for(i=0; i < nonptrs; ++i)
 184      {
 185        if( (i+1) % 6 == 0)
 186          fprintf(stderr,"\n      ");
 187        fprintf(stderr," %lu[D]",node->payload[ptrs+i]);
 188      }
 189    fprintf(stderr, "\n");
 190
 191
 192    switch (info_ptr->type)
 193     {
 194      case TSO:
 195       fprintf(stderr,"\n TSO_LINK: %#lx",
 196               ((StgTSO*)node)->link);
 197       break;
 198
 199     case BLACKHOLE:
 200     case RBH:
 201       bqe = ((StgBlockingQueue*)node)->blocking_queue;
 202       fprintf(stderr," BQ of %#lx: ", node);
 203       G_PRINT_BQ(bqe);
 204       break;
 205     case FETCH_ME:
 206     case FETCH_ME_BQ:
 207       printf("Panic: found FETCH_ME or FETCH_ME_BQ Infotable in GrAnSim system.\n");
 208       break;
 209     default:
 210       /* do nothing */
 211     }
 212 }
 213
 214 void
 215 G_PPN(node)  /* Extracted from PrintPacket in Pack.lc */
 216 StgClosure* node;
 217 {
 218    StgInfoTable *info ;
 219    nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0, locn = 0;
 220    char info_type[80];
 221
 222    /* size_and_ptrs(node,&size,&ptrs); */
 223    info = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
 224
 225    if (info->type == FETCH_ME || info->type == FETCH_ME_BQ ||
 226        info->type == BLACKHOLE || info->type == RBH )
 227      size = ptrs = nonptrs = vhs = 0;
 228
 229    if (closure_THUNK(node)) {
 230      if (!closure_UNPOINTED(node))
 231        fputs("SHARED ", stderr);
 232      else
 233        fputs("UNSHARED ", stderr);
 234    }
 235    if (info->type==BLACKHOLE) {
 236      fputs("BLACK HOLE\n", stderr);
 237    } else {
 238      /* Fixed header */
 239      fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
 240      for (i = 1; i < _HS; i++)
 241        fprintf(stderr, " %#lx", node[locn++]);
 242
 243      /* Variable header */
 244      if (vhs > 0) {
 245        fprintf(stderr, "] VH [%#lx", node->payload[0]);
 246
 247        for (i = 1; i < vhs; i++)
 248          fprintf(stderr, " %#lx", node->payload[i]);
 249      }
 250
 251      fprintf(stderr, "] PTRS %u", ptrs);
 252
 253      /* Non-pointers */
 254      if (nonptrs > 0) {
 255        fprintf(stderr, " NPTRS [%#lx", node->payload[ptrs]);
 256
 257        for (i = 1; i < nonptrs; i++)
 258          fprintf(stderr, " %#lx", node->payload[ptrs+i]);
 259
 260        putc(']', stderr);
 261      }
 262      putc('\n', stderr);
 263    }
 264
 265 }
 266
 267 #if 0
 268 // ToDo: fix this!! -- HWL
 269 void
 270 G_INFO_TABLE(node)
 271 StgClosure *node;
 272 {
 273   StgInfoTable *info_ptr;
 274   nat size = 0, ptrs = 0, nonptrs = 0, vhs = 0;
 275   char info_type[80], hdr_type[80];
 276
 277   info_hdr_type(info_ptr, hdr_type);
 278
 279   // get_itbl(node);
 280   info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
 281   fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
 282                  info_type,info_ptr,(W_) ENTRY_CODE(info_ptr),
 283                  size, ptrs);
 284                  // INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
 285
 286   if (closure_THUNK(node) && !closure_UNPOINTED(node) ) {
 287     fprintf(stderr,"  RBH InfoPtr: %#lx\n",
 288             RBH_INFOPTR(info_ptr));
 289   }
 290
 291 #if defined(PAR)
 292   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 293 #endif
 294
 295 #if defined(USE_COST_CENTRES)
 296   fprintf(stderr,"Cost Centre (?):       0x%lx\n",INFO_CAT(info_ptr));
 297 #endif
 298
 299 #if defined(_INFO_COPYING)
 300   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 301           INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
 302 #endif
 303
 304 #if defined(_INFO_COMPACTING)
 305   fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
 306           (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
 307   fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
 308           (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
 309 #if 0 /* avoid INFO_TYPE */
 310   if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
 311     fprintf(stderr,"plus specialised code\n");
 312   else
 313     fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
 314 #endif /* 0 */
 315 #endif /* _INFO_COMPACTING */
 316 }
 317 #endif /* 0 */
 318
 319 //@cindex G_PRINT_BQ
 320 void
 321 G_PRINT_BQ(node)
 322 StgClosure* node;
 323 {
 324     StgInfoTable *info;
 325     StgTSO *tso, *last;
 326     char str[80], str0[80];
 327
 328     fprintf(stderr,"\n[PE %d] @ %lu BQ: ",
 329                     CurrentProc,CurrentTime[CurrentProc]);
 330     if ( node == (StgClosure*)NULL ) {
 331       fprintf(stderr," NULL.\n");
 332       return;
 333     }
 334     if ( node == END_TSO_QUEUE ) {
 335       fprintf(stderr," _|_\n");
 336       return;
 337     }
 338     tso = ((StgBlockingQueue*)node)->blocking_queue;
 339     while (node != END_TSO_QUEUE) {
 340       PEs proc;
 341
 342       /* Find where the tso lives */
 343       proc = where_is(node);
 344       info = get_itbl(node);
 345
 346       switch (info->type) {
 347           case TSO:
 348             strcpy(str0,"TSO");
 349             break;
 350           case BLOCKED_FETCH:
 351             strcpy(str0,"BLOCKED_FETCH");
 352             break;
 353           default:
 354             strcpy(str0,"???");
 355             break;
 356           }
 357
 358       if(proc == CurrentProc)
 359         fprintf(stderr," %#lx (%x) L %s,",
 360                 node, ((StgBlockingQueue*)node)->blocking_queue, str0);
 361       else
 362         fprintf(stderr," %#lx (%x) G (PE %d) %s,",
 363                 node, ((StgBlockingQueue*)node)->blocking_queue, proc, str0);
 364
 365       last = tso;
 366       tso = last->link;
 367     }
 368     if ( tso == END_TSO_QUEUE )
 369       fprintf(stderr," _|_\n");
 370 }
 371
 372 //@node Threads, Events, Closures, Debugging routines for GranSim and GUM
 373 //@subsection Threads
 374
 375 void
 376 G_CURR_THREADQ(verbose)
 377 StgInt verbose;
 378 {
 379   fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
 380   G_THREADQ(run_queue_hd, verbose);
 381 }
 382
 383 void
 384 G_THREADQ(closure, verbose)
 385 StgTSO* closure;
 386 StgInt verbose;
 387 {
 388  StgTSO* x;
 389
 390  fprintf(stderr,"Thread Queue: ");
 391  for (x=closure; x!=END_TSO_QUEUE; x=x->link)
 392    if (verbose)
 393      G_TSO(x,0);
 394    else
 395      fprintf(stderr," %#lx",x);
 396
 397  if (closure==END_TSO_QUEUE)
 398    fprintf(stderr,"NIL\n");
 399  else
 400    fprintf(stderr,"\n");
 401 }
 402
 403 void
 404 G_TSO(closure,verbose)
 405 StgTSO* closure;
 406 StgInt verbose;
 407 {
 408
 409  if (closure==END_TSO_QUEUE) {
 410    fprintf(stderr,"TSO at %#lx is END_TSO_QUEUE!\n");
 411    return;
 412  }
 413
 414  if ( verbose & 0x08 ) {   /* short info */
 415    fprintf(stderr,"[TSO @ %#lx, PE %d]: Id: %#lx, Link: %#lx\n",
 416            closure,where_is(closure),
 417            closure->id,closure->link);
 418    return;
 419  }
 420
 421  fprintf(stderr,"TSO at %#lx has the following contents:\n",
 422                  closure);
 423
 424  fprintf(stderr,"> Id:   \t%#lx",closure->id);
 425  // fprintf(stderr,"\tstate: \t%#lx",closure->state);
 426  fprintf(stderr,"\twhat_next: \t%#lx",closure->what_next);
 427  fprintf(stderr,"\tlink: \t%#lx\n",closure->link);
 428  fprintf(stderr,"\twhy_blocked: \t%d", closure->why_blocked);
 429  fprintf(stderr,"\tblock_info: \t%p\n", closure->block_info);
 430  // fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
 431  fprintf(stderr,">PRI: \t%#lx", closure->gran.pri);
 432  fprintf(stderr,"\tMAGIC: \t%#lx %s\n", closure->gran.magic,
 433          (closure->gran.magic==TSO_MAGIC ? "it IS a TSO" : "THIS IS NO TSO!!"));
 434  if ( verbose & 0x04 ) {
 435    fprintf(stderr, "Stack: stack @ %#lx (stack_size: %u; max_stack_size: %u)\n",
 436            closure->stack, closure->stack_size, closure->max_stack_size);
 437    fprintf(stderr, "  sp: %#lx, su: %#lx, splim: %#lx\n",
 438            closure->sp, closure->su, closure->splim);
 439  }
 440  // fprintf(stderr,"\n");
 441  if (verbose & 0x01) {
 442    // fprintf(stderr,"} LOCKED: \t%#lx",closure->locked);
 443    fprintf(stderr,"} SPARKNAME: \t%#lx\n", closure->gran.sparkname);
 444    fprintf(stderr,"} STARTEDAT: \t%#lx", closure->gran.startedat);
 445    fprintf(stderr,"\tEXPORTED: \t%#lx\n", closure->gran.exported);
 446    fprintf(stderr,"} BASICBLOCKS: \t%#lx", closure->gran.basicblocks);
 447    fprintf(stderr,"\tALLOCS: \t%#lx\n", closure->gran.allocs);
 448    fprintf(stderr,"} EXECTIME: \t%#lx", closure->gran.exectime);
 449    fprintf(stderr,"\tFETCHTIME: \t%#lx\n", closure->gran.fetchtime);
 450    fprintf(stderr,"} FETCHCOUNT: \t%#lx", closure->gran.fetchcount);
 451    fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", closure->gran.blocktime);
 452    fprintf(stderr,"} BLOCKCOUNT: \t%#lx", closure->gran.blockcount);
 453    fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", closure->gran.blockedat);
 454    fprintf(stderr,"} GLOBALSPARKS:\t%#lx", closure->gran.globalsparks);
 455    fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", closure->gran.localsparks);
 456  }
 457  if ( verbose & 0x02 ) {
 458    fprintf(stderr,"BQ that starts with this TSO: ");
 459    G_PRINT_BQ(closure);
 460  }
 461 }
 462
 463 //@node Events, Sparks, Threads, Debugging routines for GranSim and GUM
 464 //@subsection Events
 465
 466 void
 467 G_EVENT(event, verbose)
 468 rtsEventQ event;
 469 StgInt verbose;
 470 {
 471   if (verbose) {
 472     print_event(event);
 473   }else{
 474     fprintf(stderr," %#lx",event);
 475   }
 476 }
 477
 478 void
 479 G_EVENTQ(verbose)
 480 StgInt verbose;
 481 {
 482  extern rtsEventQ EventHd;
 483  rtsEventQ x;
 484
 485  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 486  for (x=EventHd; x!=NULL; x=x->next) {
 487    G_EVENT(x,verbose);
 488  }
 489  if (EventHd==NULL)
 490    fprintf(stderr,"NIL\n");
 491  else
 492    fprintf(stderr,"\n");
 493 }
 494
 495 void
 496 G_PE_EQ(pe,verbose)
 497 PEs pe;
 498 StgInt verbose;
 499 {
 500  extern rtsEventQ EventHd;
 501  rtsEventQ x;
 502
 503  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 504  for (x=EventHd; x!=NULL; x=x->next) {
 505    if (x->proc==pe)
 506      G_EVENT(x,verbose);
 507  }
 508  if (EventHd==NULL)
 509    fprintf(stderr,"NIL\n");
 510  else
 511    fprintf(stderr,"\n");
 512 }
 513
 514 //@node Sparks, Processors, Events, Debugging routines for GranSim and GUM
 515 //@subsection Sparks
 516
 517 void
 518 G_SPARK(spark, verbose)
 519 rtsSparkQ spark;
 520 StgInt verbose;
 521 {
 522  if (spark==(rtsSpark*)NULL) {
 523    belch("G_SPARK: NULL spark; aborting");
 524    return;
 525  }
 526   if (verbose)
 527     print_spark(spark);
 528   else
 529     fprintf(stderr," %#lx",spark);
 530 }
 531
 532 void
 533 G_SPARKQ(spark,verbose)
 534 rtsSparkQ spark;
 535 StgInt verbose;
 536 {
 537  rtsSparkQ x;
 538
 539  if (spark==(rtsSpark*)NULL) {
 540    belch("G_SPARKQ: NULL spark; aborting");
 541    return;
 542  }
 543
 544  fprintf(stderr,"RtsSparkQ (hd @%#lx):\n",spark);
 545  for (x=spark; x!=NULL; x=x->next) {
 546    G_SPARK(x,verbose);
 547  }
 548  if (spark==NULL)
 549    fprintf(stderr,"NIL\n");
 550  else
 551    fprintf(stderr,"\n");
 552 }
 553
 554 void
 555 G_CURR_SPARKQ(verbose)
 556 StgInt verbose;
 557 {
 558   G_SPARKQ(pending_sparks_hd,verbose);
 559 }
 560
 561 //@node Processors, Shortcuts, Sparks, Debugging routines for GranSim and GUM
 562 //@subsection Processors
 563
 564 void
 565 G_PROC(proc,verbose)
 566 StgInt proc;
 567 StgInt verbose;
 568 {
 569   extern rtsEventQ EventHd;
 570   extern char *proc_status_names[];
 571
 572   fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
 573           proc,CurrentTime[proc],CurrentTime[proc],
 574           (CurrentProc==proc)?"ACTIVE":"INACTIVE",
 575           proc_status_names[procStatus[proc]]);
 576   G_THREADQ(run_queue_hds[proc],verbose & 0x2);
 577   if ( (CurrentProc==proc) )
 578     G_TSO(CurrentTSO,1);
 579
 580   if (EventHd!=NULL)
 581     fprintf(stderr,"Next event (%s) is on proc %d\n",
 582             event_names[EventHd->evttype],EventHd->proc);
 583
 584   if (verbose & 0x1) {
 585     fprintf(stderr,"\nREQUIRED sparks: ");
 586     G_SPARKQ(pending_sparks_hds[proc],1);
 587     fprintf(stderr,"\nADVISORY_sparks: ");
 588     G_SPARKQ(pending_sparks_hds[proc],1);
 589   }
 590 }
 591
 592 //@node Shortcuts, Printing info type, Processors, Debugging routines for GranSim and GUM
 593 //@subsection Shortcuts
 594
 595 /* Debug Processor */
 596 void
 597 GP(proc)
 598 StgInt proc;
 599 { G_PROC(proc,1);
 600 }
 601
 602 /* Debug Current Processor */
 603 void
 604 GCP(){ G_PROC(CurrentProc,2); }
 605
 606 /* Debug TSO */
 607 void
 608 GT(StgPtr tso){
 609   G_TSO(tso,1);
 610 }
 611
 612 /* Debug CurrentTSO */
 613 void
 614 GCT(){
 615   fprintf(stderr,"Current Proc: %d\n",CurrentProc);
 616   G_TSO(CurrentTSO,1);
 617 }
 618
 619 /* Shorthand for debugging event queue */
 620 void
 621 GEQ() { G_EVENTQ(1); }
 622
 623 /* Shorthand for debugging thread queue of a processor */
 624 void
 625 GTQ(PEs p) { G_THREADQ(run_queue_hds[p],1); }
 626
 627 /* Shorthand for debugging thread queue of current processor */
 628 void
 629 GCTQ() { G_THREADQ(run_queue_hds[CurrentProc],1); }
 630
 631 /* Shorthand for debugging spark queue of a processor */
 632 void
 633 GSQ(PEs p) { G_SPARKQ(pending_sparks_hds[p],1); }
 634
 635 /* Shorthand for debugging spark queue of current processor */
 636 void
 637 GCSQ() { G_CURR_SPARKQ(1); }
 638
 639 /* Shorthand for printing a node */
 640 void
 641 GN(StgPtr node) { G_PRINT_NODE(node); }
 642
 643 /* Shorthand for printing info table */
 644 #if 0
 645 // ToDo: fix -- HWL
 646 void
 647 GIT(StgPtr node) { G_INFO_TABLE(node); }
 648 #endif
 649
 650 void
 651 printThreadQPtrs(void)
 652 {
 653   PEs p;
 654   for (p=0; p<RtsFlags.GranFlags.proc; p++) {
 655     fprintf(stderr,", PE %d: (hd=%p,tl=%p)",
 656             run_queue_hds[p], run_queue_tls[p]);
 657   }
 658 }
 659
 660 void
 661 printThreadQ(StgTSO *tso) { G_THREADQ(tso, 0); };
 662
 663 void
 664 printSparkQ(rtsSpark *spark) { G_SPARKQ(spark, 0); };
 665
 666 void
 667 printThreadQ_verbose(StgTSO *tso) { G_THREADQ(tso, 1); };
 668
 669 void
 670 printSparkQ_verbose(rtsSpark *spark) { G_SPARKQ(spark, 1); };
 671
 672 /* Shorthand for some of ADRs debugging functions */
 673
 674 #endif /* GRAN && GRAN_CHECK*/
 675
 676 #if 0
 677 void
 678 DEBUG_PRINT_NODE(node)
 679 StgPtr node;
 680 {
 681    W_ info_ptr = INFO_PTR(node);
 682    StgInt size = 0, ptrs = 0, i, vhs = 0;
 683    char info_type[80];
 684
 685    info_hdr_type(info_ptr, info_type);
 686
 687    size_and_ptrs(node,&size,&ptrs);
 688    vhs = var_hdr_size(node);
 689
 690    fprintf(stderr,"Node: 0x%lx", (W_) node);
 691
 692 #if defined(PAR)
 693    fprintf(stderr," [GA: 0x%lx]",GA(node));
 694 #endif
 695
 696 #if defined(PROFILING)
 697    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 698 #endif
 699
 700 #if defined(GRAN)
 701    fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
 702 #endif
 703
 704    fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
 705                   info_ptr,info_type,size,ptrs);
 706
 707    /* For now, we ignore the variable header */
 708
 709    for(i=0; i < size; ++i)
 710      {
 711        if(i == 0)
 712          fprintf(stderr,"Data: ");
 713
 714        else if(i % 6 == 0)
 715          fprintf(stderr,"\n      ");
 716
 717        if(i < ptrs)
 718          fprintf(stderr," 0x%lx[P]",*(node+_HS+vhs+i));
 719        else
 720          fprintf(stderr," %lu[D]",*(node+_HS+vhs+i));
 721      }
 722    fprintf(stderr, "\n");
 723 }
 724
 725
 726 #define INFO_MASK       0x80000000
 727
 728 void
 729 DEBUG_TREE(node)
 730 StgPtr node;
 731 {
 732   W_ size = 0, ptrs = 0, i, vhs = 0;
 733
 734   /* Don't print cycles */
 735   if((INFO_PTR(node) & INFO_MASK) != 0)
 736     return;
 737
 738   size_and_ptrs(node,&size,&ptrs);
 739   vhs = var_hdr_size(node);
 740
 741   DEBUG_PRINT_NODE(node);
 742   fprintf(stderr, "\n");
 743
 744   /* Mark the node -- may be dangerous */
 745   INFO_PTR(node) |= INFO_MASK;
 746
 747   for(i = 0; i < ptrs; ++i)
 748     DEBUG_TREE((StgPtr)node[i+vhs+_HS]);
 749
 750   /* Unmark the node */
 751   INFO_PTR(node) &= ~INFO_MASK;
 752 }
 753
 754
 755 void
 756 DEBUG_INFO_TABLE(node)
 757 StgPtr node;
 758 {
 759   W_ info_ptr = INFO_PTR(node);
 760   char *iStgPtrtype = info_hdr_type(info_ptr);
 761
 762   fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
 763                  iStgPtrtype,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
 764 #if defined(PAR)
 765   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 766 #endif
 767
 768 #if defined(PROFILING)
 769   fprintf(stderr,"Cost Centre (?):       0x%lx\n",INFO_CAT(info_ptr));
 770 #endif
 771
 772 #if defined(_INFO_COPYING)
 773   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 774           INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
 775 #endif
 776
 777 #if defined(_INFO_COMPACTING)
 778   fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
 779           (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
 780   fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
 781           (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
 782 #if 0 /* avoid INFO_TYPE */
 783   if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
 784     fprintf(stderr,"plus specialised code\n");
 785   else
 786     fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
 787 #endif /* 0 */
 788 #endif /* _INFO_COMPACTING */
 789 }
 790 #endif /* 0 */
 791
 792 //@node Printing info type, Printing Packet Contents, Shortcuts, Debugging routines for GranSim and GUM
 793 //@subsection Printing info type
 794
 795 char *
 796 display_info_type(closure, str)
 797 StgClosure *closure;
 798 char *str;
 799 {
 800   strcpy(str,"");
 801   if ( closure_HNF(closure) )
 802     strcat(str,"|_HNF ");
 803   else if ( closure_BITMAP(closure) )
 804     strcat(str,"|_BTM");
 805   else if ( !closure_SHOULD_SPARK(closure) )
 806     strcat(str,"|_NS");
 807   else if ( closure_STATIC(closure) )
 808     strcat(str,"|_STA");
 809   else if ( closure_THUNK(closure) )
 810     strcat(str,"|_THU");
 811   else if ( closure_MUTABLE(closure) )
 812     strcat(str,"|_MUT");
 813   else if ( closure_UNPOINTED(closure) )
 814     strcat(str,"|_UPT");
 815   else if ( closure_SRT(closure) )
 816     strcat(str,"|_SRT");
 817
 818   return(str);
 819 }
 820
 821 /*
 822   PrintPacket is in Pack.c because it makes use of closure queues
 823 */
 824
 825 #if defined(GRAN) || defined(PAR)
 826
 827 /*
 828   Print graph rooted at q. The structure of this recursive printing routine
 829   should be the same as in the graph traversals when packing a graph in
 830   GUM. Thus, it demonstrates the structure of such a generic graph
 831   traversal, and in particular, how to extract pointer and non-pointer info
 832   from the multitude of different heap objects available.
 833
 834   {evacuate}Daq ngoqvam nIHlu'pu'!!
 835 */
 836
 837 void
 838 PrintGraph(StgClosure *p, int indent_level)
 839 {
 840   void PrintGraph_(StgClosure *p, int indent_level);
 841
 842   ASSERT(tmpClosureTable==NULL);
 843
 844   /* init hash table */
 845   tmpClosureTable = allocHashTable();
 846
 847   /* now do the real work */
 848   PrintGraph_(p, indent_level);
 849
 850   /* nuke hash table */
 851   freeHashTable(tmpClosureTable, NULL);
 852   tmpClosureTable = NULL;
 853 }
 854
 855 /*
 856   This is the actual worker functions.
 857   All recursive calls should be made to this function.
 858 */
 859 void
 860 PrintGraph_(StgClosure *p, int indent_level)
 861 {
 862   StgPtr x, q;
 863   rtsBool printed = rtsFalse;
 864   nat i, j;
 865   const StgInfoTable *info;
 866
 867   /* check whether we have met this node already to break cycles */
 868   if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
 869     /* indentation */
 870     for (j=0; j<indent_level; j++)
 871       fputs(" ", stderr);
 872
 873     fprintf(stderr, "#### cylce to %p", p);
 874     return;
 875   }
 876
 877   /* record that we are processing this closure */
 878   insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
 879
 880   q = p;                        /* save ptr to object */
 881
 882   /* indentation */
 883   for (j=0; j<indent_level; j++)
 884     fputs(" ", stderr);
 885
 886   ASSERT(p!=(StgClosure*)NULL);
 887   ASSERT(LOOKS_LIKE_STATIC(p) ||
 888          LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
 889          IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
 890
 891   printClosure(p); // prints contents of this one closure
 892
 893   /* indentation */
 894   for (j=0; j<indent_level; j++)
 895     fputs(" ", stderr);
 896
 897   info = get_itbl((StgClosure *)p);
 898   /* the rest of this fct recursively traverses the graph */
 899   switch (info -> type) {
 900
 901   case BCO:
 902     {
 903         StgBCO* bco = stgCast(StgBCO*,p);
 904         nat i;
 905         fprintf(stderr, "BCO (%p)\n", p);
 906         /*
 907         for (i = 0; i < bco->n_ptrs; i++) {
 908           // bcoConstCPtr(bco,i) =
 909           PrintGraph_(bcoConstCPtr(bco,i), indent_level+1);
 910         }
 911         */
 912         // p += bco_sizeW(bco);
 913         break;
 914     }
 915
 916   case MVAR:
 917     /* treat MVars specially, because we don't want to PrintGraph the
 918      * mut_link field in the middle of the closure.
 919      */
 920     {
 921         StgMVar *mvar = ((StgMVar *)p);
 922         // evac_gen = 0;
 923         fprintf(stderr, "MVAR (%p) with 3 pointers (head, tail, value)\n", p);
 924         // (StgClosure *)mvar->head =
 925         PrintGraph_((StgClosure *)mvar->head, indent_level+1);
 926         // (StgClosure *)mvar->tail =
 927         PrintGraph_((StgClosure *)mvar->tail, indent_level+1);
 928         //(StgClosure *)mvar->value =
 929         PrintGraph_((StgClosure *)mvar->value, indent_level+1);
 930         // p += sizeofW(StgMVar);
 931         // evac_gen = saved_evac_gen;
 932         break;
 933     }
 934
 935   case THUNK_2_0:
 936     if (!printed) {
 937       fprintf(stderr, "THUNK_2_0 (%p) with 2 pointers\n", p);
 938       printed = rtsTrue;
 939     }
 940   case FUN_2_0:
 941     if (!printed) {
 942       fprintf(stderr, "FUN_2_0 (%p) with 2 pointers\n", p);
 943       printed = rtsTrue;
 944     }
 945     // scavenge_srt(info);
 946   case CONSTR_2_0:
 947     if (!printed) {
 948       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 949       printed = rtsTrue;
 950     }
 951     // ((StgClosure *)p)->payload[0] =
 952     PrintGraph_(((StgClosure *)p)->payload[0],
 953                indent_level+1);
 954     // ((StgClosure *)p)->payload[1] =
 955     PrintGraph_(((StgClosure *)p)->payload[1],
 956                indent_level+1);
 957     // p += sizeofW(StgHeader) + 2;
 958     break;
 959
 960   case THUNK_1_0:
 961     // scavenge_srt(info);
 962     fprintf(stderr, "THUNK_1_0 (%p) with 1 pointer\n", p);
 963     // ((StgClosure *)p)->payload[0] =
 964     PrintGraph_(((StgClosure *)p)->payload[0],
 965                indent_level+1);
 966     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 967     break;
 968
 969   case FUN_1_0:
 970     if (!printed) {
 971       fprintf(stderr, "FUN_1_0 (%p) with 1 pointer\n", p);
 972       printed = rtsTrue;
 973     }
 974     // scavenge_srt(info);
 975   case CONSTR_1_0:
 976     if (!printed) {
 977       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 978       printed = rtsTrue;
 979     }
 980     // ((StgClosure *)p)->payload[0] =
 981     PrintGraph_(((StgClosure *)p)->payload[0],
 982                indent_level+1);
 983     // p += sizeofW(StgHeader) + 1;
 984     break;
 985
 986   case THUNK_0_1:
 987     fprintf(stderr, "THUNK_0_1 (%p) with 0 pointers\n", p);
 988     // scavenge_srt(info);
 989     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 990     break;
 991
 992   case FUN_0_1:
 993     fprintf(stderr, "FUN_0_1 (%p) with 0 pointers\n", p);
 994     //scavenge_srt(info);
 995   case CONSTR_0_1:
 996     fprintf(stderr, "CONSTR_0_1 (%p) with 0 pointers\n", p);
 997     //p += sizeofW(StgHeader) + 1;
 998     break;
 999
1000   case THUNK_0_2:
1001     if (!printed) {
1002       fprintf(stderr, "THUNK_0_2 (%p) with 0 pointers\n", p);
1003       printed = rtsTrue;
1004     }
1005   case FUN_0_2:
1006     if (!printed) {
1007       fprintf(stderr, "FUN_0_2 (%p) with 0 pointers\n", p);
1008       printed = rtsTrue;
1009     }
1010     // scavenge_srt(info);
1011   case CONSTR_0_2:
1012     if (!printed) {
1013       fprintf(stderr, "CONSTR_0_2 (%p) with 0 pointers\n", p);
1014       printed = rtsTrue;
1015     }
1016     // p += sizeofW(StgHeader) + 2;
1017     break;
1018
1019   case THUNK_1_1:
1020     if (!printed) {
1021       fprintf(stderr, "THUNK_1_1 (%p) with 1 pointer\n", p);
1022       printed = rtsTrue;
1023     }
1024   case FUN_1_1:
1025     if (!printed) {
1026       fprintf(stderr, "FUN_1_1 (%p) with 1 pointer\n", p);
1027       printed = rtsTrue;
1028     }
1029     // scavenge_srt(info);
1030   case CONSTR_1_1:
1031     if (!printed) {
1032       fprintf(stderr, "CONSTR_1_1 (%p) with 1 pointer\n", p);
1033       printed = rtsTrue;
1034     }
1035     // ((StgClosure *)p)->payload[0] =
1036     PrintGraph_(((StgClosure *)p)->payload[0],
1037                indent_level+1);
1038     // p += sizeofW(StgHeader) + 2;
1039     break;
1040
1041   case FUN:
1042     if (!printed) {
1043       fprintf(stderr, "FUN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
1044       printed = rtsTrue;
1045     }
1046     /* fall through */
1047
1048   case THUNK:
1049     if (!printed) {
1050       fprintf(stderr, "THUNK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
1051       printed = rtsTrue;
1052     }
1053     // scavenge_srt(info);
1054     /* fall through */
1055
1056   case CONSTR:
1057     if (!printed) {
1058       fprintf(stderr, "CONSTR (%p) with %d pointers\n", p, info->layout.payload.ptrs);
1059       printed = rtsTrue;
1060     }
1061     /* basically same as loop in STABLE_NAME case  */
1062     for (i=0; i<info->layout.payload.ptrs; i++)
1063       PrintGraph_(((StgClosure *)p)->payload[i],
1064                  indent_level+1);
1065     break;
1066     /* NOT fall through */
1067
1068   case WEAK:
1069     if (!printed) {
1070       fprintf(stderr, "WEAK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
1071       printed = rtsTrue;
1072     }
1073     /* fall through */
1074
1075   case FOREIGN:
1076     if (!printed) {
1077       fprintf(stderr, "FOREIGN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
1078       printed = rtsTrue;
1079     }
1080     /* fall through */
1081
1082   case STABLE_NAME:
1083     {
1084       StgPtr end;
1085
1086       if (!printed) {
1087         fprintf(stderr, "STABLE_NAME (%p) with %d pointers (not followed!)\n",
1088                 p, info->layout.payload.ptrs);
1089         printed = rtsTrue;
1090       }
1091       end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1092       for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
1093         // (StgClosure *)*p =
1094         //PrintGraph_((StgClosure *)*p, indent_level+1);
1095         fprintf(stderr, ", %p", *p);
1096       }
1097       //fputs("\n", stderr);
1098       // p += info->layout.payload.nptrs;
1099       break;
1100     }
1101
1102   case IND_PERM:
1103     //if (step->gen->no != 0) {
1104     //  SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info);
1105     //}
1106     if (!printed) {
1107       fprintf(stderr, "IND_PERM (%p) with indirection to\n",
1108               p, ((StgIndOldGen *)p)->indirectee);
1109       printed = rtsTrue;
1110     }
1111     /* fall through */
1112
1113   case IND_OLDGEN_PERM:
1114     if (!printed) {
1115       fprintf(stderr, "IND_OLDGEN_PERM (%p) with indirection to %p\n",
1116               p, ((StgIndOldGen *)p)->indirectee);
1117       printed = rtsTrue;
1118     }
1119     // ((StgIndOldGen *)p)->indirectee =
1120     PrintGraph_(((StgIndOldGen *)p)->indirectee,
1121                indent_level+1);
1122     //if (failed_to_evac) {
1123     //  failed_to_evac = rtsFalse;
1124     //  recordOldToNewPtrs((StgMutClosure *)p);
1125     //}
1126     // p += sizeofW(StgIndOldGen);
1127     break;
1128
1129   case MUT_VAR:
1130     /* ignore MUT_CONSs */
1131     fprintf(stderr, "MUT_VAR (%p) pointing to %p\n", p, ((StgMutVar *)p)->var);
1132     if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
1133       //evac_gen = 0;
1134       PrintGraph_(((StgMutVar *)p)->var, indent_level+1);
1135         //evac_gen = saved_evac_gen;
1136     }
1137     //p += sizeofW(StgMutVar);
1138     break;
1139
1140   case CAF_BLACKHOLE:
1141     if (!printed) {
1142       fprintf(stderr, "CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1143       printed = rtsTrue;
1144     }
1145   case SE_CAF_BLACKHOLE:
1146     if (!printed) {
1147       fprintf(stderr, "SE_CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1148       printed = rtsTrue;
1149     }
1150   case SE_BLACKHOLE:
1151     if (!printed) {
1152       fprintf(stderr, "SE_BLACKHOLE (%p) with 0 pointers\n", p);
1153       printed = rtsTrue;
1154     }
1155   case BLACKHOLE:
1156     if (!printed) {
1157       fprintf(stderr, "BLACKHOLE (%p) with 0 pointers\n", p);
1158       printed = rtsTrue;
1159     }
1160     //p += BLACKHOLE_sizeW();
1161     break;
1162
1163   case BLACKHOLE_BQ:
1164     {
1165       StgBlockingQueue *bh = (StgBlockingQueue *)p;
1166       // (StgClosure *)bh->blocking_queue =
1167       fprintf(stderr, "BLACKHOLE_BQ (%p) pointing to %p\n",
1168               p, (StgClosure *)bh->blocking_queue);
1169       PrintGraph_((StgClosure *)bh->blocking_queue, indent_level+1);
1170       //if (failed_to_evac) {
1171       //  failed_to_evac = rtsFalse;
1172       //  recordMutable((StgMutClosure *)bh);
1173       //}
1174       // p += BLACKHOLE_sizeW();
1175       break;
1176     }
1177
1178   case THUNK_SELECTOR:
1179     {
1180       StgSelector *s = (StgSelector *)p;
1181       fprintf(stderr, "THUNK_SELECTOR (%p) pointing to %p\n",
1182               p, s->selectee);
1183       PrintGraph_(s->selectee, indent_level+1);
1184       // p += THUNK_SELECTOR_sizeW();
1185       break;
1186     }
1187
1188   case IND:
1189     fprintf(stderr, "IND (%p) pointing to %p\n", p, ((StgInd*)p)->indirectee);
1190     PrintGraph_(((StgInd*)p)->indirectee, indent_level+1);
1191     break;
1192
1193   case IND_OLDGEN:
1194     fprintf(stderr, "IND_OLDGEN (%p) pointing to %p\n",
1195             p, ((StgIndOldGen*)p)->indirectee);
1196     PrintGraph_(((StgIndOldGen*)p)->indirectee, indent_level+1);
1197     break;
1198
1199   case CONSTR_INTLIKE:
1200     fprintf(stderr, "CONSTR_INTLIKE (%p) with 0 pointers\n", p);
1201     break;
1202   case CONSTR_CHARLIKE:
1203     fprintf(stderr, "CONSTR_CHARLIKE (%p) with 0 pointers\n", p);
1204     break;
1205   case CONSTR_STATIC:
1206     fprintf(stderr, "CONSTR_STATIC (%p) with 0 pointers\n", p);
1207     break;
1208   case CONSTR_NOCAF_STATIC:
1209     fprintf(stderr, "CONSTR_NOCAF_STATIC (%p) with 0 pointers\n", p);
1210     break;
1211   case THUNK_STATIC:
1212     fprintf(stderr, "THUNK_STATIC (%p) with 0 pointers\n", p);
1213     break;
1214   case FUN_STATIC:
1215     fprintf(stderr, "FUN_STATIC (%p) with 0 pointers\n", p);
1216     break;
1217   case IND_STATIC:
1218     fprintf(stderr, "IND_STATIC (%p) with 0 pointers\n", p);
1219     break;
1220
1221   case RET_BCO:
1222     fprintf(stderr, "RET_BCO (%p) with 0 pointers\n", p);
1223     break;
1224   case RET_SMALL:
1225     fprintf(stderr, "RET_SMALL (%p) with 0 pointers\n", p);
1226     break;
1227   case RET_VEC_SMALL:
1228     fprintf(stderr, "RET_VEC_SMALL (%p) with 0 pointers\n", p);
1229     break;
1230   case RET_BIG:
1231     fprintf(stderr, "RET_BIG (%p) with 0 pointers\n", p);
1232     break;
1233   case RET_VEC_BIG:
1234     fprintf(stderr, "RET_VEC_BIG (%p) with 0 pointers\n", p);
1235     break;
1236   case RET_DYN:
1237     fprintf(stderr, "RET_DYN (%p) with 0 pointers\n", p);
1238     break;
1239   case UPDATE_FRAME:
1240     fprintf(stderr, "UPDATE_FRAME (%p) with 0 pointers\n", p);
1241     break;
1242   case STOP_FRAME:
1243     fprintf(stderr, "STOP_FRAME (%p) with 0 pointers\n", p);
1244     break;
1245   case CATCH_FRAME:
1246     fprintf(stderr, "CATCH_FRAME (%p) with 0 pointers\n", p);
1247     break;
1248   case SEQ_FRAME:
1249     fprintf(stderr, "SEQ_FRAME (%p) with 0 pointers\n", p);
1250     break;
1251
1252   case AP_UPD: /* same as PAPs */
1253     fprintf(stderr, "AP_UPD (%p) with 0 pointers\n", p);
1254   case PAP:
1255     /* Treat a PAP just like a section of stack, not forgetting to
1256      * PrintGraph_ the function pointer too...
1257      */
1258     {
1259         StgPAP* pap = stgCast(StgPAP*,p);
1260
1261         fprintf(stderr, "PAP (%p) pointing to %p\n", p, pap->fun);
1262         // pap->fun =
1263         //PrintGraph_(pap->fun, indent_level+1);
1264         //scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1265         //p += pap_sizeW(pap);
1266         break;
1267     }
1268
1269   case ARR_WORDS:
1270     /* an array of (non-mutable) words */
1271     fprintf(stderr, "ARR_WORDS (%p) of %d non-ptrs (maybe a string?)\n",
1272             p, ((StgArrWords *)q)->words);
1273     break;
1274
1275   case MUT_ARR_PTRS:
1276     /* follow everything */
1277     {
1278         StgPtr next;
1279
1280         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)\n",
1281                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1282         // evac_gen = 0;                /* repeatedly mutable */
1283         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1284         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1285           // (StgClosure *)*p =
1286           // PrintGraph_((StgClosure *)*p, indent_level+1);
1287           fprintf(stderr, ", %p", *p);
1288         }
1289         fputs("\n", stderr);
1290         //evac_gen = saved_evac_gen;
1291         break;
1292     }
1293
1294   case MUT_ARR_PTRS_FROZEN:
1295     /* follow everything */
1296     {
1297         StgPtr start = p, next;
1298
1299         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)",
1300                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1301         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1302         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1303           // (StgClosure *)*p =
1304           // PrintGraph_((StgClosure *)*p, indent_level+1);
1305           fprintf(stderr, ", %p", *p);
1306         }
1307         fputs("\n", stderr);
1308         //if (failed_to_evac) {
1309           /* we can do this easier... */
1310         //  recordMutable((StgMutClosure *)start);
1311         //  failed_to_evac = rtsFalse;
1312         //}
1313         break;
1314     }
1315
1316   case TSO:
1317     {
1318         StgTSO *tso;
1319
1320         tso = (StgTSO *)p;
1321         fprintf(stderr, "TSO (%p) with link field %p\n", p, (StgClosure *)tso->link);
1322         // evac_gen = 0;
1323         /* chase the link field for any TSOs on the same queue */
1324         // (StgClosure *)tso->link =
1325         PrintGraph_((StgClosure *)tso->link, indent_level+1);
1326         //if (tso->blocked_on) {
1327         //  tso->blocked_on = PrintGraph_(tso->blocked_on);
1328         //}
1329         /* scavenge this thread's stack */
1330         //scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1331         //evac_gen = saved_evac_gen;
1332         //p += tso_sizeW(tso);
1333         break;
1334     }
1335
1336 #if defined(GRAN) || defined(PAR)
1337   case RBH:
1338     {
1339     StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
1340     //if (LOOKS_LIKE_GHC_INFO(rip))
1341     //  fprintf(stderr, "RBH (%p) with 0 pointers (reverted type=%s)\n",
1342         //      p, info_type_by_ip(rip));
1343     //else
1344     fprintf(stderr, "RBH (%p) with 0 pointers (reverted IP=%x)\n",
1345             p, rip);
1346     }
1347     break;
1348 #endif
1349 #if defined(PAR)
1350   case BLOCKED_FETCH:
1351     fprintf(stderr, "BLOCKED_FETCH (%p) with 0 pointers (link=%p)\n",
1352             p, ((StgBlockedFetch *)p)->link);
1353     break;
1354   case FETCH_ME:
1355     fprintf(stderr, "FETCH_ME (%p) with 0 pointers\n", p);
1356     break;
1357   case FETCH_ME_BQ:
1358     fprintf(stderr, "FETCH_ME_BQ (%p) with 0 pointers (blocking_queue=%p)\n",
1359             p, ((StgFetchMeBlockingQueue *)p)->blocking_queue);
1360     break;
1361 #endif
1362
1363 #ifdef DIST
1364   case REMOTE_REF:
1365     fprintf(stderr, "REMOTE_REF (%p) with 0 pointers\n", p);
1366     break;
1367 #endif
1368
1369   case EVACUATED:
1370     fprintf(stderr, "EVACUATED (%p) with 0 pointers (evacuee=%p)\n",
1371             p, ((StgEvacuated *)p)->evacuee);
1372     break;
1373
1374   default:
1375     barf("PrintGraph_: unknown closure %d (%s)",
1376          info -> type, info_type(info));
1377   }
1378
1379   /* If we didn't manage to promote all the objects pointed to by
1380    * the current object, then we have to designate this object as
1381    * mutable (because it contains old-to-new generation pointers).
1382    */
1383   //if (failed_to_evac) {
1384   //  mkMutCons((StgClosure *)q, &generations[evac_gen]);
1385   //  failed_to_evac = rtsFalse;
1386   //}
1387 }
1388
1389 # if defined(PAR)
1390 /*
1391   Generate a finger-print for a graph.
1392   A finger-print is a string, with each char representing one node;
1393   depth-first traversal
1394 */
1395
1396 void
1397 GraphFingerPrint(StgClosure *p, char *finger_print)
1398 {
1399   void GraphFingerPrint_(StgClosure *p, char *finger_print);
1400
1401   ASSERT(tmpClosureTable==NULL);
1402   ASSERT(strlen(finger_print)==0);
1403
1404   /* init hash table */
1405   tmpClosureTable = allocHashTable();
1406
1407   /* now do the real work */
1408   GraphFingerPrint_(p, finger_print);
1409
1410   /* nuke hash table */
1411   freeHashTable(tmpClosureTable, NULL);
1412   tmpClosureTable = NULL;
1413 }
1414
1415 /*
1416   This is the actual worker functions.
1417   All recursive calls should be made to this function.
1418 */
1419 void
1420 GraphFingerPrint_(StgClosure *p, char *finger_print)
1421 {
1422   StgPtr x, q;
1423   rtsBool printed = rtsFalse;
1424   nat i, j, len;
1425   const StgInfoTable *info;
1426
1427   q = p;                        /* save ptr to object */
1428   len = strlen(finger_print);
1429   ASSERT(len<=MAX_FINGER_PRINT_LEN);
1430   /* at most 7 chars for this node (I think) */
1431   if (len+7>=MAX_FINGER_PRINT_LEN)
1432     return;
1433
1434   /* check whether we have met this node already to break cycles */
1435   if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
1436     strcat(finger_print, "#");
1437     return;
1438   }
1439
1440   /* record that we are processing this closure */
1441   insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
1442
1443   ASSERT(p!=(StgClosure*)NULL);
1444   ASSERT(LOOKS_LIKE_STATIC(p) ||
1445          LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
1446          IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
1447
1448   info = get_itbl((StgClosure *)p);
1449   // append char for this node
1450   finger_print[len] = finger_print_char[info->type]; finger_print[len+1] = '\0';
1451   /* the rest of this fct recursively traverses the graph */
1452   switch (info -> type) {
1453
1454   case BCO:
1455     {
1456         StgBCO* bco = stgCast(StgBCO*,p);
1457         nat i;
1458         //%% fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
1459         /*
1460         for (i = 0; i < bco->n_ptrs; i++) {
1461           // bcoConstCPtr(bco,i) =
1462           GraphFingerPrint_(bcoConstCPtr(bco,i), finger_print);
1463         }
1464         */
1465         // p += bco_sizeW(bco);
1466         break;
1467     }
1468
1469   case MVAR:
1470     break;
1471
1472   case THUNK_2_0:
1473   case FUN_2_0:
1474   case CONSTR_2_0:
1475     // append char for this node
1476     strcat(finger_print, "22(");
1477     GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
1478     GraphFingerPrint_(((StgClosure *)p)->payload[1], finger_print);
1479     if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
1480       strcat(finger_print, ")");
1481     break;
1482
1483   case THUNK_1_0:
1484   case FUN_1_0:
1485   case CONSTR_1_0:
1486     // append char for this node
1487     strcat(finger_print, "12(");
1488     GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
1489     if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
1490       strcat(finger_print, ")");
1491     break;
1492
1493   case THUNK_0_1:
1494   case FUN_0_1:
1495   case CONSTR_0_1:
1496     // append char for this node
1497     strcat(finger_print, "01");
1498     break;
1499
1500   case THUNK_0_2:
1501   case FUN_0_2:
1502   case CONSTR_0_2:
1503     // append char for this node
1504     strcat(finger_print, "02");
1505     break;
1506
1507   case THUNK_1_1:
1508   case FUN_1_1:
1509   case CONSTR_1_1:
1510     // append char for this node
1511     strcat(finger_print, "11(");
1512     GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
1513     if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
1514       strcat(finger_print, ")");
1515     break;
1516
1517   case FUN:
1518   case THUNK:
1519   case CONSTR:
1520     /* basically same as loop in STABLE_NAME case  */
1521     {
1522         char str[6];
1523         sprintf(str,"%d?(",info->layout.payload.ptrs);
1524         strcat(finger_print,str);
1525         for (i=0; i<info->layout.payload.ptrs; i++)
1526           GraphFingerPrint_(((StgClosure *)p)->payload[i], finger_print);
1527         if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
1528           strcat(finger_print, ")");
1529     }
1530     break;
1531
1532   case WEAK:
1533   case FOREIGN:
1534   case STABLE_NAME:
1535     {
1536       StgPtr end;
1537       char str[6];
1538       sprintf(str,"%d?", info->layout.payload.ptrs);
1539       strcat(finger_print,str);
1540
1541         //end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1542       //for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
1543       // GraphFingerPrint_((StgClosure *)*p, finger_print);
1544       //}
1545       break;
1546     }
1547
1548   case IND_PERM:
1549   case IND_OLDGEN_PERM:
1550     GraphFingerPrint_(((StgIndOldGen *)p)->indirectee, finger_print);
1551     break;
1552
1553   case MUT_VAR:
1554     /* ignore MUT_CONSs */
1555     if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
1556       GraphFingerPrint_(((StgMutVar *)p)->var, finger_print);
1557     }
1558     break;
1559
1560   case CAF_BLACKHOLE:
1561   case SE_CAF_BLACKHOLE:
1562   case SE_BLACKHOLE:
1563   case BLACKHOLE:
1564     break;
1565
1566   case BLACKHOLE_BQ:
1567     {
1568       StgBlockingQueue *bh = (StgBlockingQueue *)p;
1569       // GraphFingerPrint_((StgClosure *)bh->blocking_queue, finger_print);
1570       break;
1571     }
1572
1573   case THUNK_SELECTOR:
1574     {
1575       StgSelector *s = (StgSelector *)p;
1576       GraphFingerPrint_(s->selectee, finger_print);
1577       break;
1578     }
1579
1580   case IND:
1581     GraphFingerPrint_(((StgInd*)p)->indirectee, finger_print);
1582     break;
1583
1584   case IND_OLDGEN:
1585     GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
1586     break;
1587
1588   case IND_STATIC:
1589     GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
1590     break;
1591
1592   case CONSTR_INTLIKE:
1593   case CONSTR_CHARLIKE:
1594   case CONSTR_STATIC:
1595   case CONSTR_NOCAF_STATIC:
1596   case THUNK_STATIC:
1597   case FUN_STATIC:
1598     break;
1599
1600   case RET_BCO:
1601   case RET_SMALL:
1602   case RET_VEC_SMALL:
1603   case RET_BIG:
1604   case RET_VEC_BIG:
1605   case RET_DYN:
1606   case UPDATE_FRAME:
1607   case STOP_FRAME:
1608   case CATCH_FRAME:
1609   case SEQ_FRAME:
1610     break;
1611
1612   case AP_UPD: /* same as PAPs */
1613   case PAP:
1614     /* Treat a PAP just like a section of stack, not forgetting to
1615      * GraphFingerPrint_ the function pointer too...
1616      */
1617     {
1618         StgPAP* pap = stgCast(StgPAP*,p);
1619         char str[6];
1620         sprintf(str,"%d",pap->n_args);
1621         strcat(finger_print,str);
1622         //GraphFingerPrint_(pap->fun, finger_print); // ??
1623         break;
1624     }
1625
1626   case ARR_WORDS:
1627     {
1628         char str[6];
1629         sprintf(str,"%d",((StgArrWords*)p)->words);
1630         strcat(finger_print,str);
1631     }
1632     break;
1633
1634   case MUT_ARR_PTRS:
1635     /* follow everything */
1636     {
1637         char str[6];
1638         sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
1639         strcat(finger_print,str);
1640     }
1641     {
1642         StgPtr next;
1643         //next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1644         //for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1645         //  GraphFingerPrint_((StgClosure *)*p, finger_print);
1646         //}
1647         break;
1648     }
1649
1650   case MUT_ARR_PTRS_FROZEN:
1651     /* follow everything */
1652     {
1653         char str[6];
1654         sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
1655         strcat(finger_print,str);
1656     }
1657     {
1658         StgPtr start = p, next;
1659         //next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1660         //for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1661         //  GraphFingerPrint_((StgClosure *)*p, finger_print);
1662         //}
1663         break;
1664     }
1665
1666   case TSO:
1667     {
1668       StgTSO *tso = (StgTSO *)p;
1669       char str[6];
1670       sprintf(str,"%d",tso->id);
1671       strcat(finger_print,str);
1672     }
1673     //GraphFingerPrint_((StgClosure *)tso->link, indent_level+1);
1674     break;
1675
1676 #if defined(GRAN) || defined(PAR)
1677   case RBH:
1678     {
1679       // use this
1680       // StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
1681     }
1682     break;
1683 #endif
1684 #if defined(PAR)
1685   case BLOCKED_FETCH:
1686     break;
1687   case FETCH_ME:
1688     break;
1689   case FETCH_ME_BQ:
1690     break;
1691 #endif
1692 #ifdef DIST
1693   case REMOTE_REF:
1694     break;
1695 #endif
1696   case EVACUATED:
1697     break;
1698
1699   default:
1700     barf("GraphFingerPrint_: unknown closure %d (%s)",
1701          info -> type, info_type(info));
1702   }
1703
1704 }
1705 # endif /* PAR */
1706
1707 /*
1708   Do a sanity check on the whole graph, down to a recursion level of level.
1709   Same structure as PrintGraph (nona).
1710 */
1711 void
1712 checkGraph(StgClosure *p, int rec_level)
1713 {
1714   StgPtr x, q;
1715   nat i, j;
1716   const StgInfoTable *info;
1717
1718   if (rec_level==0)
1719     return;
1720
1721   q = p;                        /* save ptr to object */
1722
1723   /* First, the obvious generic checks */
1724   ASSERT(p!=(StgClosure*)NULL);
1725   checkClosure(p);              /* see Sanity.c for what's actually checked */
1726
1727   info = get_itbl((StgClosure *)p);
1728   /* the rest of this fct recursively traverses the graph */
1729   switch (info -> type) {
1730
1731   case BCO:
1732     {
1733         StgBCO* bco = stgCast(StgBCO*,p);
1734         nat i;
1735         /*
1736         for (i = 0; i < bco->n_ptrs; i++) {
1737           checkGraph(bcoConstCPtr(bco,i), rec_level-1);
1738         }
1739         */
1740         break;
1741     }
1742
1743   case MVAR:
1744     /* treat MVars specially, because we don't want to PrintGraph the
1745      * mut_link field in the middle of the closure.
1746      */
1747     {
1748         StgMVar *mvar = ((StgMVar *)p);
1749         checkGraph((StgClosure *)mvar->head, rec_level-1);
1750         checkGraph((StgClosure *)mvar->tail, rec_level-1);
1751         checkGraph((StgClosure *)mvar->value, rec_level-1);
1752         break;
1753     }
1754
1755   case THUNK_2_0:
1756   case FUN_2_0:
1757   case CONSTR_2_0:
1758     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1759     checkGraph(((StgClosure *)p)->payload[1], rec_level-1);
1760     break;
1761
1762   case THUNK_1_0:
1763     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1764     break;
1765
1766   case FUN_1_0:
1767   case CONSTR_1_0:
1768     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1769     break;
1770
1771   case THUNK_0_1:
1772     break;
1773
1774   case FUN_0_1:
1775   case CONSTR_0_1:
1776     break;
1777
1778   case THUNK_0_2:
1779   case FUN_0_2:
1780   case CONSTR_0_2:
1781     break;
1782
1783   case THUNK_1_1:
1784   case FUN_1_1:
1785   case CONSTR_1_1:
1786     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1787     break;
1788
1789   case FUN:
1790   case THUNK:
1791   case CONSTR:
1792     for (i=0; i<info->layout.payload.ptrs; i++)
1793       checkGraph(((StgClosure *)p)->payload[i], rec_level-1);
1794     break;
1795
1796   case WEAK:
1797   case FOREIGN:
1798   case STABLE_NAME:
1799     {
1800       StgPtr end;
1801
1802       end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1803       for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
1804         checkGraph(*(StgClosure **)p, rec_level-1);
1805       }
1806       break;
1807     }
1808
1809   case IND_PERM:
1810   case IND_OLDGEN_PERM:
1811     checkGraph(((StgIndOldGen *)p)->indirectee, rec_level-1);
1812     break;
1813
1814   case MUT_VAR:
1815     /* ignore MUT_CONSs */
1816     if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
1817       checkGraph(((StgMutVar *)p)->var, rec_level-1);
1818     }
1819     break;
1820
1821   case CAF_BLACKHOLE:
1822   case SE_CAF_BLACKHOLE:
1823   case SE_BLACKHOLE:
1824   case BLACKHOLE:
1825     break;
1826
1827   case BLACKHOLE_BQ:
1828     break;
1829
1830   case THUNK_SELECTOR:
1831     {
1832       StgSelector *s = (StgSelector *)p;
1833       checkGraph(s->selectee, rec_level-1);
1834       break;
1835     }
1836
1837   case IND:
1838     checkGraph(((StgInd*)p)->indirectee, rec_level-1);
1839     break;
1840
1841   case IND_OLDGEN:
1842     checkGraph(((StgIndOldGen*)p)->indirectee, rec_level-1);
1843     break;
1844
1845   case CONSTR_INTLIKE:
1846     break;
1847   case CONSTR_CHARLIKE:
1848     break;
1849   case CONSTR_STATIC:
1850     break;
1851   case CONSTR_NOCAF_STATIC:
1852     break;
1853   case THUNK_STATIC:
1854     break;
1855   case FUN_STATIC:
1856     break;
1857   case IND_STATIC:
1858     break;
1859
1860   case RET_BCO:
1861     break;
1862   case RET_SMALL:
1863     break;
1864   case RET_VEC_SMALL:
1865     break;
1866   case RET_BIG:
1867     break;
1868   case RET_VEC_BIG:
1869     break;
1870   case RET_DYN:
1871     break;
1872   case UPDATE_FRAME:
1873     break;
1874   case STOP_FRAME:
1875     break;
1876   case CATCH_FRAME:
1877     break;
1878   case SEQ_FRAME:
1879     break;
1880
1881   case AP_UPD: /* same as PAPs */
1882   case PAP:
1883     /* Treat a PAP just like a section of stack, not forgetting to
1884      * checkGraph the function pointer too...
1885      */
1886     {
1887         StgPAP* pap = stgCast(StgPAP*,p);
1888
1889         checkGraph(pap->fun, rec_level-1);
1890         break;
1891     }
1892
1893   case ARR_WORDS:
1894     break;
1895
1896   case MUT_ARR_PTRS:
1897     /* follow everything */
1898     {
1899         StgPtr next;
1900
1901         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1902         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1903           checkGraph(*(StgClosure **)p, rec_level-1);
1904         }
1905         break;
1906     }
1907
1908   case MUT_ARR_PTRS_FROZEN:
1909     /* follow everything */
1910     {
1911         StgPtr start = p, next;
1912
1913         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1914         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1915           checkGraph(*(StgClosure **)p, rec_level-1);
1916         }
1917         break;
1918     }
1919
1920   case TSO:
1921     {
1922         StgTSO *tso;
1923
1924         tso = (StgTSO *)p;
1925         checkGraph((StgClosure *)tso->link, rec_level-1);
1926         break;
1927     }
1928
1929 #if defined(GRAN) || defined(PAR)
1930   case RBH:
1931     break;
1932 #endif
1933 #if defined(PAR)
1934   case BLOCKED_FETCH:
1935     break;
1936   case FETCH_ME:
1937     break;
1938   case FETCH_ME_BQ:
1939     break;
1940 #endif
1941   case EVACUATED:
1942     barf("checkGraph: found EVACUATED closure %p (%s)",
1943          p, info_type(p));
1944     break;
1945
1946   default:
1947   }
1948 }
1949
1950 #endif /* GRAN */
1951
1952 #endif /* GRAN || PAR */
1953
1954 //@node End of File,  , Printing Packet Contents, Debugging routines for GranSim and GUM
1955 //@subsection End of File