ghc/rts/parallel/ParallelDebug.c

   1 /*
   2   Time-stamp: <Fri Jan 14 2000 13:52:00 Stardate: [-30]4202.88 hwloidl>
   3
   4 Various debugging routines for GranSim and GUM
   5 */
   6
   7 #if 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 "ParallelDebug.h"
  38 # endif
  39
  40 //@node Prototypes, Constants and Variables, Includes, Debugging routines for GranSim and GUM
  41 //@subsection Prototypes
  42 /*
  43 rtsBool  isOffset(globalAddr *ga);
  44 rtsBool  isFixed(globalAddr *ga);
  45 */
  46 //@node Constants and Variables, Closures, Prototypes, Debugging routines for GranSim and GUM
  47 //@subsection Constants and Variables
  48
  49 #if defined(GRAN) && defined(GRAN_CHECK)
  50 //@node Closures, Threads, Constants and Variables, Debugging routines for GranSim and GUM
  51 //@subsection Closures
  52
  53 void
  54 G_PRINT_NODE(node)
  55 StgClosure* node;
  56 {
  57    StgInfoTable *info_ptr;
  58    StgTSO* bqe;
  59    nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0;
  60    char info_hdr_ty[80], info_ty[80];
  61
  62    if (node==NULL) {
  63      fprintf(stderr,"NULL\n");
  64      return;
  65    } else if (node==END_TSO_QUEUE) {
  66      fprintf(stderr,"END_TSO_QUEUE\n");
  67      return;
  68    }
  69    /* size_and_ptrs(node,&size,&ptrs); */
  70    info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_hdr_ty);
  71
  72    /* vhs = var_hdr_size(node); */
  73    display_info_type(info_ptr,info_ty);
  74
  75    fprintf(stderr,"Node: 0x%lx", node);
  76
  77 #if defined(PAR)
  78    fprintf(stderr," [GA: 0x%lx]",GA(node));
  79 #endif
  80
  81 #if defined(USE_COST_CENTRES)
  82    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
  83 #endif
  84
  85 #if defined(GRAN)
  86    fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
  87 #endif
  88
  89    if (info_ptr->type==TSO)
  90      fprintf(stderr," TSO: 0x%lx (%x) IP: 0x%lx (%s), type %s \n     ",
  91              (StgTSO*)node, ((StgTSO*)node)->id, info_ptr, info_hdr_ty, info_ty);
  92    else
  93      fprintf(stderr," IP: 0x%lx (%s), type %s \n       VHS: %d, size: %ld, ptrs:%ld, nonptrs:  %ld\n     ",
  94              info_ptr,info_hdr_ty,info_ty,vhs,size,ptrs,nonptrs);
  95
  96    /* For now, we ignore the variable header */
  97
  98    fprintf(stderr," Ptrs: ");
  99    for(i=0; i < ptrs; ++i)
 100      {
 101      if ( (i+1) % 6 == 0)
 102        fprintf(stderr,"\n      ");
 103      fprintf(stderr," 0x%lx[P]",node->payload[i]);
 104      };
 105
 106    fprintf(stderr," Data: ");
 107    for(i=0; i < nonptrs; ++i)
 108      {
 109        if( (i+1) % 6 == 0)
 110          fprintf(stderr,"\n      ");
 111        fprintf(stderr," %lu[D]",node->payload[ptrs+i]);
 112      }
 113    fprintf(stderr, "\n");
 114
 115
 116    switch (info_ptr->type)
 117     {
 118      case TSO:
 119       fprintf(stderr,"\n TSO_LINK: %#lx",
 120               ((StgTSO*)node)->link);
 121       break;
 122
 123     case BLACKHOLE:
 124     case RBH:
 125       bqe = ((StgBlockingQueue*)node)->blocking_queue;
 126       fprintf(stderr," BQ of %#lx: ", node);
 127       G_PRINT_BQ(bqe);
 128       break;
 129     case FETCH_ME:
 130     case FETCH_ME_BQ:
 131       printf("Panic: found FETCH_ME or FETCH_ME_BQ Infotable in GrAnSim system.\n");
 132       break;
 133     default:
 134       /* do nothing */
 135     }
 136 }
 137
 138 void
 139 G_PPN(node)  /* Extracted from PrintPacket in Pack.lc */
 140 StgClosure* node;
 141 {
 142    StgInfoTable *info ;
 143    nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0, locn = 0;
 144    char info_type[80];
 145
 146    /* size_and_ptrs(node,&size,&ptrs); */
 147    info = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
 148
 149    if (info->type == FETCH_ME || info->type == FETCH_ME_BQ ||
 150        info->type == BLACKHOLE || info->type == RBH )
 151      size = ptrs = nonptrs = vhs = 0;
 152
 153    if (closure_THUNK(node)) {
 154      if (!closure_UNPOINTED(node))
 155        fputs("SHARED ", stderr);
 156      else
 157        fputs("UNSHARED ", stderr);
 158    }
 159    if (info->type==BLACKHOLE) {
 160      fputs("BLACK HOLE\n", stderr);
 161    } else {
 162      /* Fixed header */
 163      fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
 164      for (i = 1; i < FIXED_HS; i++)
 165        fprintf(stderr, " %#lx", node[locn++]);
 166
 167      /* Variable header */
 168      if (vhs > 0) {
 169        fprintf(stderr, "] VH [%#lx", node->payload[0]);
 170
 171        for (i = 1; i < vhs; i++)
 172          fprintf(stderr, " %#lx", node->payload[i]);
 173      }
 174
 175      fprintf(stderr, "] PTRS %u", ptrs);
 176
 177      /* Non-pointers */
 178      if (nonptrs > 0) {
 179        fprintf(stderr, " NPTRS [%#lx", node->payload[ptrs]);
 180
 181        for (i = 1; i < nonptrs; i++)
 182          fprintf(stderr, " %#lx", node->payload[ptrs+i]);
 183
 184        putc(']', stderr);
 185      }
 186      putc('\n', stderr);
 187    }
 188
 189 }
 190
 191 #if 0
 192 // ToDo: fix this!! -- HWL
 193 void
 194 G_INFO_TABLE(node)
 195 StgClosure *node;
 196 {
 197   StgInfoTable *info_ptr;
 198   nat size = 0, ptrs = 0, nonptrs = 0, vhs = 0;
 199   char info_type[80], hdr_type[80];
 200
 201   info_hdr_type(info_ptr, hdr_type);
 202
 203   // get_itbl(node);
 204   info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
 205   fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
 206                  info_type,info_ptr,(W_) ENTRY_CODE(info_ptr),
 207                  size, ptrs);
 208                  // INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
 209
 210   if (closure_THUNK(node) && !closure_UNPOINTED(node) ) {
 211     fprintf(stderr,"  RBH InfoPtr: %#lx\n",
 212             RBH_INFOPTR(info_ptr));
 213   }
 214
 215 #if defined(PAR)
 216   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 217 #endif
 218
 219 #if defined(USE_COST_CENTRES)
 220   fprintf(stderr,"Cost Centre (???):       0x%lx\n",INFO_CAT(info_ptr));
 221 #endif
 222
 223 #if defined(_INFO_COPYING)
 224   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 225           INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
 226 #endif
 227
 228 #if defined(_INFO_COMPACTING)
 229   fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
 230           (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
 231   fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
 232           (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
 233 #if 0 /* avoid INFO_TYPE */
 234   if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
 235     fprintf(stderr,"plus specialised code\n");
 236   else
 237     fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
 238 #endif /* 0 */
 239 #endif /* _INFO_COMPACTING */
 240 }
 241 #endif /* 0 */
 242
 243 //@cindex G_PRINT_BQ
 244 void
 245 G_PRINT_BQ(node)
 246 StgClosure* node;
 247 {
 248     StgInfoTable *info;
 249     StgTSO *tso, *last;
 250     char str[80], str0[80];
 251
 252     fprintf(stderr,"\n[PE %d] @ %lu BQ: ",
 253                     CurrentProc,CurrentTime[CurrentProc]);
 254     if ( node == (StgClosure*)NULL ) {
 255       fprintf(stderr," NULL.\n");
 256       return;
 257     }
 258     if ( node == END_TSO_QUEUE ) {
 259       fprintf(stderr," _|_\n");
 260       return;
 261     }
 262     tso = ((StgBlockingQueue*)node)->blocking_queue;
 263     while (node != END_TSO_QUEUE) {
 264       PEs proc;
 265
 266       /* Find where the tso lives */
 267       proc = where_is(node);
 268       info = get_itbl(node);
 269
 270       switch (info->type) {
 271           case TSO:
 272             strcpy(str0,"TSO");
 273             break;
 274           case BLOCKED_FETCH:
 275             strcpy(str0,"BLOCKED_FETCH");
 276             break;
 277           default:
 278             strcpy(str0,"???");
 279             break;
 280           }
 281
 282       if(proc == CurrentProc)
 283         fprintf(stderr," %#lx (%x) L %s,",
 284                 node, ((StgBlockingQueue*)node)->blocking_queue, str0);
 285       else
 286         fprintf(stderr," %#lx (%x) G (PE %d) %s,",
 287                 node, ((StgBlockingQueue*)node)->blocking_queue, proc, str0);
 288
 289       last = tso;
 290       tso = last->link;
 291     }
 292     if ( tso == END_TSO_QUEUE )
 293       fprintf(stderr," _|_\n");
 294 }
 295
 296 //@node Threads, Events, Closures, Debugging routines for GranSim and GUM
 297 //@subsection Threads
 298
 299 void
 300 G_CURR_THREADQ(verbose)
 301 StgInt verbose;
 302 {
 303   fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
 304   G_THREADQ(run_queue_hd, verbose);
 305 }
 306
 307 void
 308 G_THREADQ(closure, verbose)
 309 StgTSO* closure;
 310 StgInt verbose;
 311 {
 312  StgTSO* x;
 313
 314  fprintf(stderr,"Thread Queue: ");
 315  for (x=closure; x!=END_TSO_QUEUE; x=x->link)
 316    if (verbose)
 317      G_TSO(x,0);
 318    else
 319      fprintf(stderr," %#lx",x);
 320
 321  if (closure==END_TSO_QUEUE)
 322    fprintf(stderr,"NIL\n");
 323  else
 324    fprintf(stderr,"\n");
 325 }
 326
 327 void
 328 G_TSO(closure,verbose)
 329 StgTSO* closure;
 330 StgInt verbose;
 331 {
 332
 333  if (closure==END_TSO_QUEUE) {
 334    fprintf(stderr,"TSO at %#lx is END_TSO_QUEUE!\n");
 335    return;
 336  }
 337
 338  if ( verbose & 0x08 ) {   /* short info */
 339    fprintf(stderr,"[TSO @ %#lx, PE %d]: Id: %#lx, Link: %#lx\n",
 340            closure,where_is(closure),
 341            closure->id,closure->link);
 342    return;
 343  }
 344
 345  fprintf(stderr,"TSO at %#lx has the following contents:\n",
 346                  closure);
 347
 348  fprintf(stderr,"> Id:   \t%#lx",closure->id);
 349  // fprintf(stderr,"\tstate: \t%#lx",closure->state);
 350  fprintf(stderr,"\twhatNext: \t%#lx",closure->whatNext);
 351  fprintf(stderr,"\tlink: \t%#lx\n",closure->link);
 352  // fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
 353  fprintf(stderr,">PRI: \t%#lx", closure->gran.pri);
 354  fprintf(stderr,"\tMAGIC: \t%#lx %s\n", closure->gran.magic,
 355          (closure->gran.magic==TSO_MAGIC ? "it IS a TSO" : "THIS IS NO TSO!!"));
 356  if ( verbose & 0x04 ) {
 357    fprintf(stderr, "Stack: stack @ %#lx (stack_size: %u; max_stack_size: %u)\n",
 358            closure->stack, closure->stack_size, closure->max_stack_size);
 359    fprintf(stderr, "  sp: %#lx, su: %#lx, splim: %#lx\n",
 360            closure->sp, closure->su, closure->splim);
 361  }
 362  // fprintf(stderr,"\n");
 363  if (verbose & 0x01) {
 364    // fprintf(stderr,"} LOCKED: \t%#lx",closure->locked);
 365    fprintf(stderr,"} SPARKNAME: \t%#lx\n", closure->gran.sparkname);
 366    fprintf(stderr,"} STARTEDAT: \t%#lx", closure->gran.startedat);
 367    fprintf(stderr,"\tEXPORTED: \t%#lx\n", closure->gran.exported);
 368    fprintf(stderr,"} BASICBLOCKS: \t%#lx", closure->gran.basicblocks);
 369    fprintf(stderr,"\tALLOCS: \t%#lx\n", closure->gran.allocs);
 370    fprintf(stderr,"} EXECTIME: \t%#lx", closure->gran.exectime);
 371    fprintf(stderr,"\tFETCHTIME: \t%#lx\n", closure->gran.fetchtime);
 372    fprintf(stderr,"} FETCHCOUNT: \t%#lx", closure->gran.fetchcount);
 373    fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", closure->gran.blocktime);
 374    fprintf(stderr,"} BLOCKCOUNT: \t%#lx", closure->gran.blockcount);
 375    fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", closure->gran.blockedat);
 376    fprintf(stderr,"} GLOBALSPARKS:\t%#lx", closure->gran.globalsparks);
 377    fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", closure->gran.localsparks);
 378  }
 379  if ( verbose & 0x02 ) {
 380    fprintf(stderr,"BQ that starts with this TSO: ");
 381    G_PRINT_BQ(closure);
 382  }
 383 }
 384
 385 //@node Events, Sparks, Threads, Debugging routines for GranSim and GUM
 386 //@subsection Events
 387
 388 void
 389 G_EVENT(event, verbose)
 390 rtsEventQ event;
 391 StgInt verbose;
 392 {
 393   if (verbose) {
 394     print_event(event);
 395   }else{
 396     fprintf(stderr," %#lx",event);
 397   }
 398 }
 399
 400 void
 401 G_EVENTQ(verbose)
 402 StgInt verbose;
 403 {
 404  extern rtsEventQ EventHd;
 405  rtsEventQ x;
 406
 407  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 408  for (x=EventHd; x!=NULL; x=x->next) {
 409    G_EVENT(x,verbose);
 410  }
 411  if (EventHd==NULL)
 412    fprintf(stderr,"NIL\n");
 413  else
 414    fprintf(stderr,"\n");
 415 }
 416
 417 void
 418 G_PE_EQ(pe,verbose)
 419 PEs pe;
 420 StgInt verbose;
 421 {
 422  extern rtsEventQ EventHd;
 423  rtsEventQ x;
 424
 425  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 426  for (x=EventHd; x!=NULL; x=x->next) {
 427    if (x->proc==pe)
 428      G_EVENT(x,verbose);
 429  }
 430  if (EventHd==NULL)
 431    fprintf(stderr,"NIL\n");
 432  else
 433    fprintf(stderr,"\n");
 434 }
 435
 436 //@node Sparks, Processors, Events, Debugging routines for GranSim and GUM
 437 //@subsection Sparks
 438
 439 void
 440 G_SPARK(spark, verbose)
 441 rtsSparkQ spark;
 442 StgInt verbose;
 443 {
 444  if (spark==(rtsSpark*)NULL) {
 445    belch("G_SPARK: NULL spark; aborting");
 446    return;
 447  }
 448   if (verbose)
 449     print_spark(spark);
 450   else
 451     fprintf(stderr," %#lx",spark);
 452 }
 453
 454 void
 455 G_SPARKQ(spark,verbose)
 456 rtsSparkQ spark;
 457 StgInt verbose;
 458 {
 459  rtsSparkQ x;
 460
 461  if (spark==(rtsSpark*)NULL) {
 462    belch("G_SPARKQ: NULL spark; aborting");
 463    return;
 464  }
 465
 466  fprintf(stderr,"RtsSparkQ (hd @%#lx):\n",spark);
 467  for (x=spark; x!=NULL; x=x->next) {
 468    G_SPARK(x,verbose);
 469  }
 470  if (spark==NULL)
 471    fprintf(stderr,"NIL\n");
 472  else
 473    fprintf(stderr,"\n");
 474 }
 475
 476 void
 477 G_CURR_SPARKQ(verbose)
 478 StgInt verbose;
 479 {
 480   G_SPARKQ(pending_sparks_hd,verbose);
 481 }
 482
 483 //@node Processors, Shortcuts, Sparks, Debugging routines for GranSim and GUM
 484 //@subsection Processors
 485
 486 void
 487 G_PROC(proc,verbose)
 488 StgInt proc;
 489 StgInt verbose;
 490 {
 491   extern rtsEventQ EventHd;
 492   extern char *proc_status_names[];
 493
 494   fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
 495           proc,CurrentTime[proc],CurrentTime[proc],
 496           (CurrentProc==proc)?"ACTIVE":"INACTIVE",
 497           proc_status_names[procStatus[proc]]);
 498   G_THREADQ(run_queue_hds[proc],verbose & 0x2);
 499   if ( (CurrentProc==proc) )
 500     G_TSO(CurrentTSO,1);
 501
 502   if (EventHd!=NULL)
 503     fprintf(stderr,"Next event (%s) is on proc %d\n",
 504             event_names[EventHd->evttype],EventHd->proc);
 505
 506   if (verbose & 0x1) {
 507     fprintf(stderr,"\nREQUIRED sparks: ");
 508     G_SPARKQ(pending_sparks_hds[proc],1);
 509     fprintf(stderr,"\nADVISORY_sparks: ");
 510     G_SPARKQ(pending_sparks_hds[proc],1);
 511   }
 512 }
 513
 514 //@node Shortcuts, Printing info type, Processors, Debugging routines for GranSim and GUM
 515 //@subsection Shortcuts
 516
 517 /* Debug Processor */
 518 void
 519 GP(proc)
 520 StgInt proc;
 521 { G_PROC(proc,1);
 522 }
 523
 524 /* Debug Current Processor */
 525 void
 526 GCP(){ G_PROC(CurrentProc,2); }
 527
 528 /* Debug TSO */
 529 void
 530 GT(StgPtr tso){
 531   G_TSO(tso,1);
 532 }
 533
 534 /* Debug CurrentTSO */
 535 void
 536 GCT(){
 537   fprintf(stderr,"Current Proc: %d\n",CurrentProc);
 538   G_TSO(CurrentTSO,1);
 539 }
 540
 541 /* Shorthand for debugging event queue */
 542 void
 543 GEQ() { G_EVENTQ(1); }
 544
 545 /* Shorthand for debugging thread queue of a processor */
 546 void
 547 GTQ(PEs p) { G_THREADQ(run_queue_hds[p],1); }
 548
 549 /* Shorthand for debugging thread queue of current processor */
 550 void
 551 GCTQ() { G_THREADQ(run_queue_hds[CurrentProc],1); }
 552
 553 /* Shorthand for debugging spark queue of a processor */
 554 void
 555 GSQ(PEs p) { G_SPARKQ(pending_sparks_hds[p],1); }
 556
 557 /* Shorthand for debugging spark queue of current processor */
 558 void
 559 GCSQ() { G_CURR_SPARKQ(1); }
 560
 561 /* Shorthand for printing a node */
 562 void
 563 GN(StgPtr node) { G_PRINT_NODE(node); }
 564
 565 /* Shorthand for printing info table */
 566 #if 0
 567 // ToDo: fix -- HWL
 568 void
 569 GIT(StgPtr node) { G_INFO_TABLE(node); }
 570 #endif
 571
 572 void
 573 printThreadQPtrs(void)
 574 {
 575   PEs p;
 576   for (p=0; p<RtsFlags.GranFlags.proc; p++) {
 577     fprintf(stderr,", PE %d: (hd=%p,tl=%p)",
 578             run_queue_hds[p], run_queue_tls[p]);
 579   }
 580 }
 581
 582 void
 583 printThreadQ(StgTSO *tso) { G_THREADQ(tso, 0); };
 584
 585 void
 586 printSparkQ(rtsSpark *spark) { G_SPARKQ(spark, 0); };
 587
 588 void
 589 printThreadQ_verbose(StgTSO *tso) { G_THREADQ(tso, 1); };
 590
 591 void
 592 printSparkQ_verbose(rtsSpark *spark) { G_SPARKQ(spark, 1); };
 593
 594 /* Shorthand for some of ADRs debugging functions */
 595
 596 #endif /* GRAN && GRAN_CHECK*/
 597
 598 #if 0
 599 void
 600 DEBUG_PRINT_NODE(node)
 601 StgPtr node;
 602 {
 603    W_ info_ptr = INFO_PTR(node);
 604    StgInt size = 0, ptrs = 0, i, vhs = 0;
 605    char info_type[80];
 606
 607    info_hdr_type(info_ptr, info_type);
 608
 609    size_and_ptrs(node,&size,&ptrs);
 610    vhs = var_hdr_size(node);
 611
 612    fprintf(stderr,"Node: 0x%lx", (W_) node);
 613
 614 #if defined(PAR)
 615    fprintf(stderr," [GA: 0x%lx]",GA(node));
 616 #endif
 617
 618 #if defined(PROFILING)
 619    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 620 #endif
 621
 622 #if defined(GRAN)
 623    fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
 624 #endif
 625
 626    fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
 627                   info_ptr,info_type,size,ptrs);
 628
 629    /* For now, we ignore the variable header */
 630
 631    for(i=0; i < size; ++i)
 632      {
 633        if(i == 0)
 634          fprintf(stderr,"Data: ");
 635
 636        else if(i % 6 == 0)
 637          fprintf(stderr,"\n      ");
 638
 639        if(i < ptrs)
 640          fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
 641        else
 642          fprintf(stderr," %lu[D]",*(node+_FHS+vhs+i));
 643      }
 644    fprintf(stderr, "\n");
 645 }
 646
 647
 648 #define INFO_MASK       0x80000000
 649
 650 void
 651 DEBUG_TREE(node)
 652 StgPtr node;
 653 {
 654   W_ size = 0, ptrs = 0, i, vhs = 0;
 655
 656   /* Don't print cycles */
 657   if((INFO_PTR(node) & INFO_MASK) != 0)
 658     return;
 659
 660   size_and_ptrs(node,&size,&ptrs);
 661   vhs = var_hdr_size(node);
 662
 663   DEBUG_PRINT_NODE(node);
 664   fprintf(stderr, "\n");
 665
 666   /* Mark the node -- may be dangerous */
 667   INFO_PTR(node) |= INFO_MASK;
 668
 669   for(i = 0; i < ptrs; ++i)
 670     DEBUG_TREE((StgPtr)node[i+vhs+_FHS]);
 671
 672   /* Unmark the node */
 673   INFO_PTR(node) &= ~INFO_MASK;
 674 }
 675
 676
 677 void
 678 DEBUG_INFO_TABLE(node)
 679 StgPtr node;
 680 {
 681   W_ info_ptr = INFO_PTR(node);
 682   char *iStgPtrtype = info_hdr_type(info_ptr);
 683
 684   fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
 685                  iStgPtrtype,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
 686 #if defined(PAR)
 687   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 688 #endif
 689
 690 #if defined(PROFILING)
 691   fprintf(stderr,"Cost Centre (???):       0x%lx\n",INFO_CAT(info_ptr));
 692 #endif
 693
 694 #if defined(_INFO_COPYING)
 695   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 696           INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
 697 #endif
 698
 699 #if defined(_INFO_COMPACTING)
 700   fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
 701           (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
 702   fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
 703           (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
 704 #if 0 /* avoid INFO_TYPE */
 705   if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
 706     fprintf(stderr,"plus specialised code\n");
 707   else
 708     fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
 709 #endif /* 0 */
 710 #endif /* _INFO_COMPACTING */
 711 }
 712 #endif /* 0 */
 713
 714 //@node Printing info type, Printing Packet Contents, Shortcuts, Debugging routines for GranSim and GUM
 715 //@subsection Printing info type
 716
 717 char *
 718 display_info_type(closure, str)
 719 StgClosure *closure;
 720 char *str;
 721 {
 722   strcpy(str,"");
 723   if ( closure_HNF(closure) )
 724     strcat(str,"|_HNF ");
 725   else if ( closure_BITMAP(closure) )
 726     strcat(str,"|_BTM");
 727   else if ( !closure_SHOULD_SPARK(closure) )
 728     strcat(str,"|_NS");
 729   else if ( closure_STATIC(closure) )
 730     strcat(str,"|_STA");
 731   else if ( closure_THUNK(closure) )
 732     strcat(str,"|_THU");
 733   else if ( closure_MUTABLE(closure) )
 734     strcat(str,"|_MUT");
 735   else if ( closure_UNPOINTED(closure) )
 736     strcat(str,"|_UPT");
 737   else if ( closure_SRT(closure) )
 738     strcat(str,"|_SRT");
 739
 740   return(str);
 741 }
 742
 743 /*
 744   PrintPacket is in Pack.c because it makes use of closure queues
 745 */
 746
 747 #if defined(GRAN) || defined(PAR)
 748
 749 /*
 750   Print graph rooted at q. The structure of this recursive printing routine
 751   should be the same as in the graph traversals when packing a graph in
 752   GUM. Thus, it demonstrates the structure of such a generic graph
 753   traversal, and in particular, how to extract pointer and non-pointer info
 754   from the multitude of different heap objects available.
 755
 756   {evacuate}Daq ngoqvam nIHlu'pu'!!
 757 */
 758
 759 void
 760 PrintGraph(StgClosure *p, int indent_level)
 761 {
 762   StgPtr x, q;
 763   rtsBool printed = rtsFalse;
 764   nat i, j;
 765   const StgInfoTable *info;
 766
 767   q = p;                        /* save ptr to object */
 768
 769   /* indentation */
 770   for (j=0; j<indent_level; j++)
 771     fputs(" ", stderr);
 772
 773   ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
 774               || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
 775
 776   printClosure(p); // prints contents of this one closure
 777
 778   /* indentation */
 779   for (j=0; j<indent_level; j++)
 780     fputs(" ", stderr);
 781
 782   info = get_itbl((StgClosure *)p);
 783   /* the rest of this fct recursively traverses the graph */
 784   switch (info -> type) {
 785
 786   case BCO:
 787     {
 788         StgBCO* bco = stgCast(StgBCO*,p);
 789         nat i;
 790         fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
 791         for (i = 0; i < bco->n_ptrs; i++) {
 792           // bcoConstCPtr(bco,i) =
 793           PrintGraph(bcoConstCPtr(bco,i), indent_level+1);
 794         }
 795         // p += bco_sizeW(bco);
 796         break;
 797     }
 798
 799   case MVAR:
 800     /* treat MVars specially, because we don't want to PrintGraph the
 801      * mut_link field in the middle of the closure.
 802      */
 803     {
 804         StgMVar *mvar = ((StgMVar *)p);
 805         // evac_gen = 0;
 806         fprintf(stderr, "MVAR (%p) with 3 pointers (head, tail, value)\n", p);
 807         // (StgClosure *)mvar->head =
 808         PrintGraph((StgClosure *)mvar->head, indent_level+1);
 809         // (StgClosure *)mvar->tail =
 810         PrintGraph((StgClosure *)mvar->tail, indent_level+1);
 811         //(StgClosure *)mvar->value =
 812         PrintGraph((StgClosure *)mvar->value, indent_level+1);
 813         // p += sizeofW(StgMVar);
 814         // evac_gen = saved_evac_gen;
 815         break;
 816     }
 817
 818   case THUNK_2_0:
 819     if (!printed) {
 820       fprintf(stderr, "THUNK_2_0 (%p) with 2 pointers\n", p);
 821       printed = rtsTrue;
 822     }
 823   case FUN_2_0:
 824     if (!printed) {
 825       fprintf(stderr, "FUN_2_0 (%p) with 2 pointers\n", p);
 826       printed = rtsTrue;
 827     }
 828     // scavenge_srt(info);
 829   case CONSTR_2_0:
 830     if (!printed) {
 831       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 832       printed = rtsTrue;
 833     }
 834     // ((StgClosure *)p)->payload[0] =
 835     PrintGraph(((StgClosure *)p)->payload[0],
 836                indent_level+1);
 837     // ((StgClosure *)p)->payload[1] =
 838     PrintGraph(((StgClosure *)p)->payload[1],
 839                indent_level+1);
 840     // p += sizeofW(StgHeader) + 2;
 841     break;
 842
 843   case THUNK_1_0:
 844     // scavenge_srt(info);
 845     fprintf(stderr, "THUNK_1_0 (%p) with 1 pointer\n", p);
 846     // ((StgClosure *)p)->payload[0] =
 847     PrintGraph(((StgClosure *)p)->payload[0],
 848                indent_level+1);
 849     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 850     break;
 851
 852   case FUN_1_0:
 853     if (!printed) {
 854       fprintf(stderr, "FUN_1_0 (%p) with 1 pointer\n", p);
 855       printed = rtsTrue;
 856     }
 857     // scavenge_srt(info);
 858   case CONSTR_1_0:
 859     if (!printed) {
 860       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 861       printed = rtsTrue;
 862     }
 863     // ((StgClosure *)p)->payload[0] =
 864     PrintGraph(((StgClosure *)p)->payload[0],
 865                indent_level+1);
 866     // p += sizeofW(StgHeader) + 1;
 867     break;
 868
 869   case THUNK_0_1:
 870     fprintf(stderr, "THUNK_0_1 (%p) with 0 pointers\n", p);
 871     // scavenge_srt(info);
 872     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 873     break;
 874
 875   case FUN_0_1:
 876     fprintf(stderr, "FUN_0_1 (%p) with 0 pointers\n", p);
 877     //scavenge_srt(info);
 878   case CONSTR_0_1:
 879     fprintf(stderr, "CONSTR_0_1 (%p) with 0 pointers\n", p);
 880     //p += sizeofW(StgHeader) + 1;
 881     break;
 882
 883   case THUNK_0_2:
 884     if (!printed) {
 885       fprintf(stderr, "THUNK_0_2 (%p) with 0 pointers\n", p);
 886       printed = rtsTrue;
 887     }
 888   case FUN_0_2:
 889     if (!printed) {
 890       fprintf(stderr, "FUN_0_2 (%p) with 0 pointers\n", p);
 891       printed = rtsTrue;
 892     }
 893     // scavenge_srt(info);
 894   case CONSTR_0_2:
 895     if (!printed) {
 896       fprintf(stderr, "CONSTR_0_2 (%p) with 0 pointers\n", p);
 897       printed = rtsTrue;
 898     }
 899     // p += sizeofW(StgHeader) + 2;
 900     break;
 901
 902   case THUNK_1_1:
 903     if (!printed) {
 904       fprintf(stderr, "THUNK_1_1 (%p) with 1 pointer\n", p);
 905       printed = rtsTrue;
 906     }
 907   case FUN_1_1:
 908     if (!printed) {
 909       fprintf(stderr, "FUN_1_1 (%p) with 1 pointer\n", p);
 910       printed = rtsTrue;
 911     }
 912     // scavenge_srt(info);
 913   case CONSTR_1_1:
 914     if (!printed) {
 915       fprintf(stderr, "CONSTR_1_1 (%p) with 1 pointer\n", p);
 916       printed = rtsTrue;
 917     }
 918     // ((StgClosure *)p)->payload[0] =
 919     PrintGraph(((StgClosure *)p)->payload[0],
 920                indent_level+1);
 921     // p += sizeofW(StgHeader) + 2;
 922     break;
 923
 924   case FUN:
 925     if (!printed) {
 926       fprintf(stderr, "FUN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 927       printed = rtsTrue;
 928     }
 929     /* fall through */
 930
 931   case THUNK:
 932     if (!printed) {
 933       fprintf(stderr, "THUNK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 934       printed = rtsTrue;
 935     }
 936     // scavenge_srt(info);
 937     /* fall through */
 938
 939   case CONSTR:
 940     if (!printed) {
 941       fprintf(stderr, "CONSTR (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 942       printed = rtsTrue;
 943     }
 944     /* basically same as loop in STABLE_NAME case  */
 945     for (i=0; i<info->layout.payload.ptrs; i++)
 946       PrintGraph(((StgClosure *)p)->payload[i],
 947                  indent_level+1);
 948     break;
 949     /* NOT fall through */
 950
 951   case WEAK:
 952     if (!printed) {
 953       fprintf(stderr, "WEAK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 954       printed = rtsTrue;
 955     }
 956     /* fall through */
 957
 958   case FOREIGN:
 959     if (!printed) {
 960       fprintf(stderr, "FOREIGN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 961       printed = rtsTrue;
 962     }
 963     /* fall through */
 964
 965   case STABLE_NAME:
 966     {
 967       StgPtr end;
 968
 969       if (!printed) {
 970         fprintf(stderr, "STABLE_NAME (%p) with %d pointers (not followed!)\n",
 971                 p, info->layout.payload.ptrs);
 972         printed = rtsTrue;
 973       }
 974       end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 975       for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
 976         // (StgClosure *)*p =
 977         //PrintGraph((StgClosure *)*p, indent_level+1);
 978         fprintf(stderr, ", %p", *p);
 979       }
 980       //fputs("\n", stderr);
 981       // p += info->layout.payload.nptrs;
 982       break;
 983     }
 984
 985   case IND_PERM:
 986     //if (step->gen->no != 0) {
 987     //  SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info);
 988     //}
 989     if (!printed) {
 990       fprintf(stderr, "IND_PERM (%p) with indirection to\n",
 991               p, ((StgIndOldGen *)p)->indirectee);
 992       printed = rtsTrue;
 993     }
 994     /* fall through */
 995
 996   case IND_OLDGEN_PERM:
 997     if (!printed) {
 998       fprintf(stderr, "IND_OLDGEN_PERM (%p) with indirection to %p\n",
 999               p, ((StgIndOldGen *)p)->indirectee);
1000       printed = rtsTrue;
1001     }
1002     // ((StgIndOldGen *)p)->indirectee =
1003     PrintGraph(((StgIndOldGen *)p)->indirectee,
1004                indent_level+1);
1005     //if (failed_to_evac) {
1006     //  failed_to_evac = rtsFalse;
1007     //  recordOldToNewPtrs((StgMutClosure *)p);
1008     //}
1009     // p += sizeofW(StgIndOldGen);
1010     break;
1011
1012   case CAF_UNENTERED:
1013     {
1014         StgCAF *caf = (StgCAF *)p;
1015
1016         fprintf(stderr, "CAF_UNENTERED (%p) pointing to %p\n", p, caf->body);
1017         PrintGraph(caf->body, indent_level+1);
1018         //if (failed_to_evac) {
1019         //  failed_to_evac = rtsFalse;
1020         //  recordOldToNewPtrs((StgMutClosure *)p);
1021         //} else {
1022         //  caf->mut_link = NULL;
1023         //}
1024         //p += sizeofW(StgCAF);
1025         break;
1026     }
1027
1028   case CAF_ENTERED:
1029     {
1030         StgCAF *caf = (StgCAF *)p;
1031
1032         fprintf(stderr, "CAF_ENTERED (%p) pointing to %p and %p\n",
1033                 p, caf->body, caf->value);
1034         // caf->body =
1035         PrintGraph(caf->body, indent_level+1);
1036         //caf->value =
1037         PrintGraph(caf->value, indent_level+1);
1038         //if (failed_to_evac) {
1039         //  failed_to_evac = rtsFalse;
1040         //  recordOldToNewPtrs((StgMutClosure *)p);
1041         //} else {
1042         //  caf->mut_link = NULL;
1043         //}
1044         //p += sizeofW(StgCAF);
1045         break;
1046     }
1047
1048   case MUT_VAR:
1049     /* ignore MUT_CONSs */
1050     fprintf(stderr, "MUT_VAR (%p) pointing to %p\n", p, ((StgMutVar *)p)->var);
1051     if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1052       //evac_gen = 0;
1053       PrintGraph(((StgMutVar *)p)->var, indent_level+1);
1054         //evac_gen = saved_evac_gen;
1055     }
1056     //p += sizeofW(StgMutVar);
1057     break;
1058
1059   case CAF_BLACKHOLE:
1060     if (!printed) {
1061       fprintf(stderr, "CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1062       printed = rtsTrue;
1063     }
1064   case SE_CAF_BLACKHOLE:
1065     if (!printed) {
1066       fprintf(stderr, "SE_CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1067       printed = rtsTrue;
1068     }
1069   case SE_BLACKHOLE:
1070     if (!printed) {
1071       fprintf(stderr, "SE_BLACKHOLE (%p) with 0 pointers\n", p);
1072       printed = rtsTrue;
1073     }
1074   case BLACKHOLE:
1075     if (!printed) {
1076       fprintf(stderr, "BLACKHOLE (%p) with 0 pointers\n", p);
1077       printed = rtsTrue;
1078     }
1079     //p += BLACKHOLE_sizeW();
1080     break;
1081
1082   case BLACKHOLE_BQ:
1083     {
1084       StgBlockingQueue *bh = (StgBlockingQueue *)p;
1085       // (StgClosure *)bh->blocking_queue =
1086       fprintf(stderr, "BLACKHOLE_BQ (%p) pointing to %p\n",
1087               p, (StgClosure *)bh->blocking_queue);
1088       PrintGraph((StgClosure *)bh->blocking_queue, indent_level+1);
1089       //if (failed_to_evac) {
1090       //  failed_to_evac = rtsFalse;
1091       //  recordMutable((StgMutClosure *)bh);
1092       //}
1093       // p += BLACKHOLE_sizeW();
1094       break;
1095     }
1096
1097   case THUNK_SELECTOR:
1098     {
1099       StgSelector *s = (StgSelector *)p;
1100       fprintf(stderr, "THUNK_SELECTOR (%p) pointing to %p\n",
1101               p, s->selectee);
1102       PrintGraph(s->selectee, indent_level+1);
1103       // p += THUNK_SELECTOR_sizeW();
1104       break;
1105     }
1106
1107   case IND:
1108     fprintf(stderr, "IND (%p) pointing to %p\n", p, ((StgInd*)p)->indirectee);
1109     PrintGraph(((StgInd*)p)->indirectee, indent_level+1);
1110     break;
1111
1112   case IND_OLDGEN:
1113     fprintf(stderr, "IND_OLDGEN (%p) pointing to %p\n",
1114             p, ((StgIndOldGen*)p)->indirectee);
1115     PrintGraph(((StgIndOldGen*)p)->indirectee, indent_level+1);
1116     break;
1117
1118   case CONSTR_INTLIKE:
1119     fprintf(stderr, "CONSTR_INTLIKE (%p) with 0 pointers\n", p);
1120     break;
1121   case CONSTR_CHARLIKE:
1122     fprintf(stderr, "CONSTR_CHARLIKE (%p) with 0 pointers\n", p);
1123     break;
1124   case CONSTR_STATIC:
1125     fprintf(stderr, "CONSTR_STATIC (%p) with 0 pointers\n", p);
1126     break;
1127   case CONSTR_NOCAF_STATIC:
1128     fprintf(stderr, "CONSTR_NOCAF_STATIC (%p) with 0 pointers\n", p);
1129     break;
1130   case THUNK_STATIC:
1131     fprintf(stderr, "THUNK_STATIC (%p) with 0 pointers\n", p);
1132     break;
1133   case FUN_STATIC:
1134     fprintf(stderr, "FUN_STATIC (%p) with 0 pointers\n", p);
1135     break;
1136   case IND_STATIC:
1137     fprintf(stderr, "IND_STATIC (%p) with 0 pointers\n", p);
1138     break;
1139
1140   case RET_BCO:
1141     fprintf(stderr, "RET_BCO (%p) with 0 pointers\n", p);
1142     break;
1143   case RET_SMALL:
1144     fprintf(stderr, "RET_SMALL (%p) with 0 pointers\n", p);
1145     break;
1146   case RET_VEC_SMALL:
1147     fprintf(stderr, "RET_VEC_SMALL (%p) with 0 pointers\n", p);
1148     break;
1149   case RET_BIG:
1150     fprintf(stderr, "RET_BIG (%p) with 0 pointers\n", p);
1151     break;
1152   case RET_VEC_BIG:
1153     fprintf(stderr, "RET_VEC_BIG (%p) with 0 pointers\n", p);
1154     break;
1155   case RET_DYN:
1156     fprintf(stderr, "RET_DYN (%p) with 0 pointers\n", p);
1157     break;
1158   case UPDATE_FRAME:
1159     fprintf(stderr, "UPDATE_FRAME (%p) with 0 pointers\n", p);
1160     break;
1161   case STOP_FRAME:
1162     fprintf(stderr, "STOP_FRAME (%p) with 0 pointers\n", p);
1163     break;
1164   case CATCH_FRAME:
1165     fprintf(stderr, "CATCH_FRAME (%p) with 0 pointers\n", p);
1166     break;
1167   case SEQ_FRAME:
1168     fprintf(stderr, "SEQ_FRAME (%p) with 0 pointers\n", p);
1169     break;
1170
1171   case AP_UPD: /* same as PAPs */
1172     fprintf(stderr, "AP_UPD (%p) with 0 pointers\n", p);
1173   case PAP:
1174     /* Treat a PAP just like a section of stack, not forgetting to
1175      * PrintGraph the function pointer too...
1176      */
1177     {
1178         StgPAP* pap = stgCast(StgPAP*,p);
1179
1180         fprintf(stderr, "PAP (%p) pointing to %p\n", p, pap->fun);
1181         // pap->fun =
1182         PrintGraph(pap->fun, indent_level+1);
1183         //scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1184         //p += pap_sizeW(pap);
1185         break;
1186     }
1187
1188   case ARR_WORDS:
1189     fprintf(stderr, "ARR_WORDS (%p) with 0 pointers\n", p);
1190     /* nothing to follow */
1191     //p += arr_words_sizeW(stgCast(StgArrWords*,p));
1192     break;
1193
1194   case MUT_ARR_PTRS:
1195     /* follow everything */
1196     {
1197         StgPtr next;
1198
1199         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)\n",
1200                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1201         // evac_gen = 0;                /* repeatedly mutable */
1202         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1203         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1204           // (StgClosure *)*p =
1205           // PrintGraph((StgClosure *)*p, indent_level+1);
1206           fprintf(stderr, ", %p", *p);
1207         }
1208         fputs("\n", stderr);
1209         //evac_gen = saved_evac_gen;
1210         break;
1211     }
1212
1213   case MUT_ARR_PTRS_FROZEN:
1214     /* follow everything */
1215     {
1216         StgPtr start = p, next;
1217
1218         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)",
1219                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1220         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1221         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1222           // (StgClosure *)*p =
1223           // PrintGraph((StgClosure *)*p, indent_level+1);
1224           fprintf(stderr, ", %p", *p);
1225         }
1226         fputs("\n", stderr);
1227         //if (failed_to_evac) {
1228           /* we can do this easier... */
1229         //  recordMutable((StgMutClosure *)start);
1230         //  failed_to_evac = rtsFalse;
1231         //}
1232         break;
1233     }
1234
1235   case TSO:
1236     {
1237         StgTSO *tso;
1238
1239         tso = (StgTSO *)p;
1240         fprintf(stderr, "TSO (%p) with link field %p\n", p, (StgClosure *)tso->link);
1241         // evac_gen = 0;
1242         /* chase the link field for any TSOs on the same queue */
1243         // (StgClosure *)tso->link =
1244         PrintGraph((StgClosure *)tso->link, indent_level+1);
1245         //if (tso->blocked_on) {
1246         //  tso->blocked_on = PrintGraph(tso->blocked_on);
1247         //}
1248         /* scavenge this thread's stack */
1249         //scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1250         //evac_gen = saved_evac_gen;
1251         //p += tso_sizeW(tso);
1252         break;
1253     }
1254
1255 #if defined(GRAN) || defined(PAR)
1256   case RBH:
1257     {
1258     StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
1259     //if (LOOKS_LIKE_GHC_INFO(rip))
1260     //  fprintf(stderr, "RBH (%p) with 0 pointers (reverted type=%s)\n",
1261         //      p, info_type_by_ip(rip));
1262     //else
1263     fprintf(stderr, "RBH (%p) with 0 pointers (reverted IP=%x)\n",
1264             p, rip);
1265     }
1266     break;
1267 #endif
1268 #if defined(PAR)
1269   case BLOCKED_FETCH:
1270     fprintf(stderr, "BLOCKED_FETCH (%p) with 0 pointers (link=%p)\n",
1271             p, ((StgBlockedFetch *)p)->link);
1272     break;
1273   case FETCH_ME:
1274     fprintf(stderr, "FETCH_ME (%p) with 0 pointers\n", p);
1275     break;
1276   case FETCH_ME_BQ:
1277     fprintf(stderr, "FETCH_ME_BQ (%p) with 0 pointers (blocking_queue=%p)\n",
1278             p, ((StgFetchMeBlockingQueue *)p)->blocking_queue);
1279     break;
1280 #endif
1281   case EVACUATED:
1282     fprintf(stderr, "EVACUATED (%p) with 0 pointers (evacuee=%p)\n",
1283             p, ((StgEvacuated *)p)->evacuee);
1284     break;
1285
1286   default:
1287     barf("PrintGraph: unknown closure %d (%s)",
1288          info -> type, info_type(info));
1289   }
1290
1291   /* If we didn't manage to promote all the objects pointed to by
1292    * the current object, then we have to designate this object as
1293    * mutable (because it contains old-to-new generation pointers).
1294    */
1295   //if (failed_to_evac) {
1296   //  mkMutCons((StgClosure *)q, &generations[evac_gen]);
1297   //  failed_to_evac = rtsFalse;
1298   //}
1299 }
1300
1301 #endif /* GRAN */
1302
1303 #endif /* GRAN || PAR */
1304
1305 //@node End of File,  , Printing Packet Contents, Debugging routines for GranSim and GUM
1306 //@subsection End of File