ghc/rts/parallel/ParallelDebug.c

   1 /*
   2   Time-stamp: <Mon Mar 20 2000 19:27:38 Stardate: [-30]4534.05 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,"\twhat_next: \t%#lx",closure->what_next);
 351  fprintf(stderr,"\tlink: \t%#lx\n",closure->link);
 352  fprintf(stderr,"\twhy_blocked: \t%d", closure->why_blocked);
 353  fprintf(stderr,"\tblock_info: \t%p\n", closure->block_info);
 354  // fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
 355  fprintf(stderr,">PRI: \t%#lx", closure->gran.pri);
 356  fprintf(stderr,"\tMAGIC: \t%#lx %s\n", closure->gran.magic,
 357          (closure->gran.magic==TSO_MAGIC ? "it IS a TSO" : "THIS IS NO TSO!!"));
 358  if ( verbose & 0x04 ) {
 359    fprintf(stderr, "Stack: stack @ %#lx (stack_size: %u; max_stack_size: %u)\n",
 360            closure->stack, closure->stack_size, closure->max_stack_size);
 361    fprintf(stderr, "  sp: %#lx, su: %#lx, splim: %#lx\n",
 362            closure->sp, closure->su, closure->splim);
 363  }
 364  // fprintf(stderr,"\n");
 365  if (verbose & 0x01) {
 366    // fprintf(stderr,"} LOCKED: \t%#lx",closure->locked);
 367    fprintf(stderr,"} SPARKNAME: \t%#lx\n", closure->gran.sparkname);
 368    fprintf(stderr,"} STARTEDAT: \t%#lx", closure->gran.startedat);
 369    fprintf(stderr,"\tEXPORTED: \t%#lx\n", closure->gran.exported);
 370    fprintf(stderr,"} BASICBLOCKS: \t%#lx", closure->gran.basicblocks);
 371    fprintf(stderr,"\tALLOCS: \t%#lx\n", closure->gran.allocs);
 372    fprintf(stderr,"} EXECTIME: \t%#lx", closure->gran.exectime);
 373    fprintf(stderr,"\tFETCHTIME: \t%#lx\n", closure->gran.fetchtime);
 374    fprintf(stderr,"} FETCHCOUNT: \t%#lx", closure->gran.fetchcount);
 375    fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", closure->gran.blocktime);
 376    fprintf(stderr,"} BLOCKCOUNT: \t%#lx", closure->gran.blockcount);
 377    fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", closure->gran.blockedat);
 378    fprintf(stderr,"} GLOBALSPARKS:\t%#lx", closure->gran.globalsparks);
 379    fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", closure->gran.localsparks);
 380  }
 381  if ( verbose & 0x02 ) {
 382    fprintf(stderr,"BQ that starts with this TSO: ");
 383    G_PRINT_BQ(closure);
 384  }
 385 }
 386
 387 //@node Events, Sparks, Threads, Debugging routines for GranSim and GUM
 388 //@subsection Events
 389
 390 void
 391 G_EVENT(event, verbose)
 392 rtsEventQ event;
 393 StgInt verbose;
 394 {
 395   if (verbose) {
 396     print_event(event);
 397   }else{
 398     fprintf(stderr," %#lx",event);
 399   }
 400 }
 401
 402 void
 403 G_EVENTQ(verbose)
 404 StgInt verbose;
 405 {
 406  extern rtsEventQ EventHd;
 407  rtsEventQ x;
 408
 409  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 410  for (x=EventHd; x!=NULL; x=x->next) {
 411    G_EVENT(x,verbose);
 412  }
 413  if (EventHd==NULL)
 414    fprintf(stderr,"NIL\n");
 415  else
 416    fprintf(stderr,"\n");
 417 }
 418
 419 void
 420 G_PE_EQ(pe,verbose)
 421 PEs pe;
 422 StgInt verbose;
 423 {
 424  extern rtsEventQ EventHd;
 425  rtsEventQ x;
 426
 427  fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
 428  for (x=EventHd; x!=NULL; x=x->next) {
 429    if (x->proc==pe)
 430      G_EVENT(x,verbose);
 431  }
 432  if (EventHd==NULL)
 433    fprintf(stderr,"NIL\n");
 434  else
 435    fprintf(stderr,"\n");
 436 }
 437
 438 //@node Sparks, Processors, Events, Debugging routines for GranSim and GUM
 439 //@subsection Sparks
 440
 441 void
 442 G_SPARK(spark, verbose)
 443 rtsSparkQ spark;
 444 StgInt verbose;
 445 {
 446  if (spark==(rtsSpark*)NULL) {
 447    belch("G_SPARK: NULL spark; aborting");
 448    return;
 449  }
 450   if (verbose)
 451     print_spark(spark);
 452   else
 453     fprintf(stderr," %#lx",spark);
 454 }
 455
 456 void
 457 G_SPARKQ(spark,verbose)
 458 rtsSparkQ spark;
 459 StgInt verbose;
 460 {
 461  rtsSparkQ x;
 462
 463  if (spark==(rtsSpark*)NULL) {
 464    belch("G_SPARKQ: NULL spark; aborting");
 465    return;
 466  }
 467
 468  fprintf(stderr,"RtsSparkQ (hd @%#lx):\n",spark);
 469  for (x=spark; x!=NULL; x=x->next) {
 470    G_SPARK(x,verbose);
 471  }
 472  if (spark==NULL)
 473    fprintf(stderr,"NIL\n");
 474  else
 475    fprintf(stderr,"\n");
 476 }
 477
 478 void
 479 G_CURR_SPARKQ(verbose)
 480 StgInt verbose;
 481 {
 482   G_SPARKQ(pending_sparks_hd,verbose);
 483 }
 484
 485 //@node Processors, Shortcuts, Sparks, Debugging routines for GranSim and GUM
 486 //@subsection Processors
 487
 488 void
 489 G_PROC(proc,verbose)
 490 StgInt proc;
 491 StgInt verbose;
 492 {
 493   extern rtsEventQ EventHd;
 494   extern char *proc_status_names[];
 495
 496   fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
 497           proc,CurrentTime[proc],CurrentTime[proc],
 498           (CurrentProc==proc)?"ACTIVE":"INACTIVE",
 499           proc_status_names[procStatus[proc]]);
 500   G_THREADQ(run_queue_hds[proc],verbose & 0x2);
 501   if ( (CurrentProc==proc) )
 502     G_TSO(CurrentTSO,1);
 503
 504   if (EventHd!=NULL)
 505     fprintf(stderr,"Next event (%s) is on proc %d\n",
 506             event_names[EventHd->evttype],EventHd->proc);
 507
 508   if (verbose & 0x1) {
 509     fprintf(stderr,"\nREQUIRED sparks: ");
 510     G_SPARKQ(pending_sparks_hds[proc],1);
 511     fprintf(stderr,"\nADVISORY_sparks: ");
 512     G_SPARKQ(pending_sparks_hds[proc],1);
 513   }
 514 }
 515
 516 //@node Shortcuts, Printing info type, Processors, Debugging routines for GranSim and GUM
 517 //@subsection Shortcuts
 518
 519 /* Debug Processor */
 520 void
 521 GP(proc)
 522 StgInt proc;
 523 { G_PROC(proc,1);
 524 }
 525
 526 /* Debug Current Processor */
 527 void
 528 GCP(){ G_PROC(CurrentProc,2); }
 529
 530 /* Debug TSO */
 531 void
 532 GT(StgPtr tso){
 533   G_TSO(tso,1);
 534 }
 535
 536 /* Debug CurrentTSO */
 537 void
 538 GCT(){
 539   fprintf(stderr,"Current Proc: %d\n",CurrentProc);
 540   G_TSO(CurrentTSO,1);
 541 }
 542
 543 /* Shorthand for debugging event queue */
 544 void
 545 GEQ() { G_EVENTQ(1); }
 546
 547 /* Shorthand for debugging thread queue of a processor */
 548 void
 549 GTQ(PEs p) { G_THREADQ(run_queue_hds[p],1); }
 550
 551 /* Shorthand for debugging thread queue of current processor */
 552 void
 553 GCTQ() { G_THREADQ(run_queue_hds[CurrentProc],1); }
 554
 555 /* Shorthand for debugging spark queue of a processor */
 556 void
 557 GSQ(PEs p) { G_SPARKQ(pending_sparks_hds[p],1); }
 558
 559 /* Shorthand for debugging spark queue of current processor */
 560 void
 561 GCSQ() { G_CURR_SPARKQ(1); }
 562
 563 /* Shorthand for printing a node */
 564 void
 565 GN(StgPtr node) { G_PRINT_NODE(node); }
 566
 567 /* Shorthand for printing info table */
 568 #if 0
 569 // ToDo: fix -- HWL
 570 void
 571 GIT(StgPtr node) { G_INFO_TABLE(node); }
 572 #endif
 573
 574 void
 575 printThreadQPtrs(void)
 576 {
 577   PEs p;
 578   for (p=0; p<RtsFlags.GranFlags.proc; p++) {
 579     fprintf(stderr,", PE %d: (hd=%p,tl=%p)",
 580             run_queue_hds[p], run_queue_tls[p]);
 581   }
 582 }
 583
 584 void
 585 printThreadQ(StgTSO *tso) { G_THREADQ(tso, 0); };
 586
 587 void
 588 printSparkQ(rtsSpark *spark) { G_SPARKQ(spark, 0); };
 589
 590 void
 591 printThreadQ_verbose(StgTSO *tso) { G_THREADQ(tso, 1); };
 592
 593 void
 594 printSparkQ_verbose(rtsSpark *spark) { G_SPARKQ(spark, 1); };
 595
 596 /* Shorthand for some of ADRs debugging functions */
 597
 598 #endif /* GRAN && GRAN_CHECK*/
 599
 600 #if 0
 601 void
 602 DEBUG_PRINT_NODE(node)
 603 StgPtr node;
 604 {
 605    W_ info_ptr = INFO_PTR(node);
 606    StgInt size = 0, ptrs = 0, i, vhs = 0;
 607    char info_type[80];
 608
 609    info_hdr_type(info_ptr, info_type);
 610
 611    size_and_ptrs(node,&size,&ptrs);
 612    vhs = var_hdr_size(node);
 613
 614    fprintf(stderr,"Node: 0x%lx", (W_) node);
 615
 616 #if defined(PAR)
 617    fprintf(stderr," [GA: 0x%lx]",GA(node));
 618 #endif
 619
 620 #if defined(PROFILING)
 621    fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
 622 #endif
 623
 624 #if defined(GRAN)
 625    fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
 626 #endif
 627
 628    fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
 629                   info_ptr,info_type,size,ptrs);
 630
 631    /* For now, we ignore the variable header */
 632
 633    for(i=0; i < size; ++i)
 634      {
 635        if(i == 0)
 636          fprintf(stderr,"Data: ");
 637
 638        else if(i % 6 == 0)
 639          fprintf(stderr,"\n      ");
 640
 641        if(i < ptrs)
 642          fprintf(stderr," 0x%lx[P]",*(node+_FHS+vhs+i));
 643        else
 644          fprintf(stderr," %lu[D]",*(node+_FHS+vhs+i));
 645      }
 646    fprintf(stderr, "\n");
 647 }
 648
 649
 650 #define INFO_MASK       0x80000000
 651
 652 void
 653 DEBUG_TREE(node)
 654 StgPtr node;
 655 {
 656   W_ size = 0, ptrs = 0, i, vhs = 0;
 657
 658   /* Don't print cycles */
 659   if((INFO_PTR(node) & INFO_MASK) != 0)
 660     return;
 661
 662   size_and_ptrs(node,&size,&ptrs);
 663   vhs = var_hdr_size(node);
 664
 665   DEBUG_PRINT_NODE(node);
 666   fprintf(stderr, "\n");
 667
 668   /* Mark the node -- may be dangerous */
 669   INFO_PTR(node) |= INFO_MASK;
 670
 671   for(i = 0; i < ptrs; ++i)
 672     DEBUG_TREE((StgPtr)node[i+vhs+_FHS]);
 673
 674   /* Unmark the node */
 675   INFO_PTR(node) &= ~INFO_MASK;
 676 }
 677
 678
 679 void
 680 DEBUG_INFO_TABLE(node)
 681 StgPtr node;
 682 {
 683   W_ info_ptr = INFO_PTR(node);
 684   char *iStgPtrtype = info_hdr_type(info_ptr);
 685
 686   fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
 687                  iStgPtrtype,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
 688 #if defined(PAR)
 689   fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
 690 #endif
 691
 692 #if defined(PROFILING)
 693   fprintf(stderr,"Cost Centre (???):       0x%lx\n",INFO_CAT(info_ptr));
 694 #endif
 695
 696 #if defined(_INFO_COPYING)
 697   fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
 698           INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
 699 #endif
 700
 701 #if defined(_INFO_COMPACTING)
 702   fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
 703           (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
 704   fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
 705           (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
 706 #if 0 /* avoid INFO_TYPE */
 707   if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
 708     fprintf(stderr,"plus specialised code\n");
 709   else
 710     fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
 711 #endif /* 0 */
 712 #endif /* _INFO_COMPACTING */
 713 }
 714 #endif /* 0 */
 715
 716 //@node Printing info type, Printing Packet Contents, Shortcuts, Debugging routines for GranSim and GUM
 717 //@subsection Printing info type
 718
 719 char *
 720 display_info_type(closure, str)
 721 StgClosure *closure;
 722 char *str;
 723 {
 724   strcpy(str,"");
 725   if ( closure_HNF(closure) )
 726     strcat(str,"|_HNF ");
 727   else if ( closure_BITMAP(closure) )
 728     strcat(str,"|_BTM");
 729   else if ( !closure_SHOULD_SPARK(closure) )
 730     strcat(str,"|_NS");
 731   else if ( closure_STATIC(closure) )
 732     strcat(str,"|_STA");
 733   else if ( closure_THUNK(closure) )
 734     strcat(str,"|_THU");
 735   else if ( closure_MUTABLE(closure) )
 736     strcat(str,"|_MUT");
 737   else if ( closure_UNPOINTED(closure) )
 738     strcat(str,"|_UPT");
 739   else if ( closure_SRT(closure) )
 740     strcat(str,"|_SRT");
 741
 742   return(str);
 743 }
 744
 745 /*
 746   PrintPacket is in Pack.c because it makes use of closure queues
 747 */
 748
 749 #if defined(GRAN) || defined(PAR)
 750
 751 /*
 752   Print graph rooted at q. The structure of this recursive printing routine
 753   should be the same as in the graph traversals when packing a graph in
 754   GUM. Thus, it demonstrates the structure of such a generic graph
 755   traversal, and in particular, how to extract pointer and non-pointer info
 756   from the multitude of different heap objects available.
 757
 758   {evacuate}Daq ngoqvam nIHlu'pu'!!
 759 */
 760
 761 void
 762 PrintGraph(StgClosure *p, int indent_level)
 763 {
 764   StgPtr x, q;
 765   rtsBool printed = rtsFalse;
 766   nat i, j;
 767   const StgInfoTable *info;
 768
 769   q = p;                        /* save ptr to object */
 770
 771   /* indentation */
 772   for (j=0; j<indent_level; j++)
 773     fputs(" ", stderr);
 774
 775   ASSERT(p!=(StgClosure*)NULL);
 776   ASSERT(LOOKS_LIKE_STATIC(p) ||
 777          LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
 778          IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
 779
 780   printClosure(p); // prints contents of this one closure
 781
 782   /* indentation */
 783   for (j=0; j<indent_level; j++)
 784     fputs(" ", stderr);
 785
 786   info = get_itbl((StgClosure *)p);
 787   /* the rest of this fct recursively traverses the graph */
 788   switch (info -> type) {
 789
 790   case BCO:
 791     {
 792         StgBCO* bco = stgCast(StgBCO*,p);
 793         nat i;
 794         fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
 795         for (i = 0; i < bco->n_ptrs; i++) {
 796           // bcoConstCPtr(bco,i) =
 797           PrintGraph(bcoConstCPtr(bco,i), indent_level+1);
 798         }
 799         // p += bco_sizeW(bco);
 800         break;
 801     }
 802
 803   case MVAR:
 804     /* treat MVars specially, because we don't want to PrintGraph the
 805      * mut_link field in the middle of the closure.
 806      */
 807     {
 808         StgMVar *mvar = ((StgMVar *)p);
 809         // evac_gen = 0;
 810         fprintf(stderr, "MVAR (%p) with 3 pointers (head, tail, value)\n", p);
 811         // (StgClosure *)mvar->head =
 812         PrintGraph((StgClosure *)mvar->head, indent_level+1);
 813         // (StgClosure *)mvar->tail =
 814         PrintGraph((StgClosure *)mvar->tail, indent_level+1);
 815         //(StgClosure *)mvar->value =
 816         PrintGraph((StgClosure *)mvar->value, indent_level+1);
 817         // p += sizeofW(StgMVar);
 818         // evac_gen = saved_evac_gen;
 819         break;
 820     }
 821
 822   case THUNK_2_0:
 823     if (!printed) {
 824       fprintf(stderr, "THUNK_2_0 (%p) with 2 pointers\n", p);
 825       printed = rtsTrue;
 826     }
 827   case FUN_2_0:
 828     if (!printed) {
 829       fprintf(stderr, "FUN_2_0 (%p) with 2 pointers\n", p);
 830       printed = rtsTrue;
 831     }
 832     // scavenge_srt(info);
 833   case CONSTR_2_0:
 834     if (!printed) {
 835       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 836       printed = rtsTrue;
 837     }
 838     // ((StgClosure *)p)->payload[0] =
 839     PrintGraph(((StgClosure *)p)->payload[0],
 840                indent_level+1);
 841     // ((StgClosure *)p)->payload[1] =
 842     PrintGraph(((StgClosure *)p)->payload[1],
 843                indent_level+1);
 844     // p += sizeofW(StgHeader) + 2;
 845     break;
 846
 847   case THUNK_1_0:
 848     // scavenge_srt(info);
 849     fprintf(stderr, "THUNK_1_0 (%p) with 1 pointer\n", p);
 850     // ((StgClosure *)p)->payload[0] =
 851     PrintGraph(((StgClosure *)p)->payload[0],
 852                indent_level+1);
 853     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 854     break;
 855
 856   case FUN_1_0:
 857     if (!printed) {
 858       fprintf(stderr, "FUN_1_0 (%p) with 1 pointer\n", p);
 859       printed = rtsTrue;
 860     }
 861     // scavenge_srt(info);
 862   case CONSTR_1_0:
 863     if (!printed) {
 864       fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
 865       printed = rtsTrue;
 866     }
 867     // ((StgClosure *)p)->payload[0] =
 868     PrintGraph(((StgClosure *)p)->payload[0],
 869                indent_level+1);
 870     // p += sizeofW(StgHeader) + 1;
 871     break;
 872
 873   case THUNK_0_1:
 874     fprintf(stderr, "THUNK_0_1 (%p) with 0 pointers\n", p);
 875     // scavenge_srt(info);
 876     // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
 877     break;
 878
 879   case FUN_0_1:
 880     fprintf(stderr, "FUN_0_1 (%p) with 0 pointers\n", p);
 881     //scavenge_srt(info);
 882   case CONSTR_0_1:
 883     fprintf(stderr, "CONSTR_0_1 (%p) with 0 pointers\n", p);
 884     //p += sizeofW(StgHeader) + 1;
 885     break;
 886
 887   case THUNK_0_2:
 888     if (!printed) {
 889       fprintf(stderr, "THUNK_0_2 (%p) with 0 pointers\n", p);
 890       printed = rtsTrue;
 891     }
 892   case FUN_0_2:
 893     if (!printed) {
 894       fprintf(stderr, "FUN_0_2 (%p) with 0 pointers\n", p);
 895       printed = rtsTrue;
 896     }
 897     // scavenge_srt(info);
 898   case CONSTR_0_2:
 899     if (!printed) {
 900       fprintf(stderr, "CONSTR_0_2 (%p) with 0 pointers\n", p);
 901       printed = rtsTrue;
 902     }
 903     // p += sizeofW(StgHeader) + 2;
 904     break;
 905
 906   case THUNK_1_1:
 907     if (!printed) {
 908       fprintf(stderr, "THUNK_1_1 (%p) with 1 pointer\n", p);
 909       printed = rtsTrue;
 910     }
 911   case FUN_1_1:
 912     if (!printed) {
 913       fprintf(stderr, "FUN_1_1 (%p) with 1 pointer\n", p);
 914       printed = rtsTrue;
 915     }
 916     // scavenge_srt(info);
 917   case CONSTR_1_1:
 918     if (!printed) {
 919       fprintf(stderr, "CONSTR_1_1 (%p) with 1 pointer\n", p);
 920       printed = rtsTrue;
 921     }
 922     // ((StgClosure *)p)->payload[0] =
 923     PrintGraph(((StgClosure *)p)->payload[0],
 924                indent_level+1);
 925     // p += sizeofW(StgHeader) + 2;
 926     break;
 927
 928   case FUN:
 929     if (!printed) {
 930       fprintf(stderr, "FUN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 931       printed = rtsTrue;
 932     }
 933     /* fall through */
 934
 935   case THUNK:
 936     if (!printed) {
 937       fprintf(stderr, "THUNK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 938       printed = rtsTrue;
 939     }
 940     // scavenge_srt(info);
 941     /* fall through */
 942
 943   case CONSTR:
 944     if (!printed) {
 945       fprintf(stderr, "CONSTR (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 946       printed = rtsTrue;
 947     }
 948     /* basically same as loop in STABLE_NAME case  */
 949     for (i=0; i<info->layout.payload.ptrs; i++)
 950       PrintGraph(((StgClosure *)p)->payload[i],
 951                  indent_level+1);
 952     break;
 953     /* NOT fall through */
 954
 955   case WEAK:
 956     if (!printed) {
 957       fprintf(stderr, "WEAK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 958       printed = rtsTrue;
 959     }
 960     /* fall through */
 961
 962   case FOREIGN:
 963     if (!printed) {
 964       fprintf(stderr, "FOREIGN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
 965       printed = rtsTrue;
 966     }
 967     /* fall through */
 968
 969   case STABLE_NAME:
 970     {
 971       StgPtr end;
 972
 973       if (!printed) {
 974         fprintf(stderr, "STABLE_NAME (%p) with %d pointers (not followed!)\n",
 975                 p, info->layout.payload.ptrs);
 976         printed = rtsTrue;
 977       }
 978       end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
 979       for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
 980         // (StgClosure *)*p =
 981         //PrintGraph((StgClosure *)*p, indent_level+1);
 982         fprintf(stderr, ", %p", *p);
 983       }
 984       //fputs("\n", stderr);
 985       // p += info->layout.payload.nptrs;
 986       break;
 987     }
 988
 989   case IND_PERM:
 990     //if (step->gen->no != 0) {
 991     //  SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info);
 992     //}
 993     if (!printed) {
 994       fprintf(stderr, "IND_PERM (%p) with indirection to\n",
 995               p, ((StgIndOldGen *)p)->indirectee);
 996       printed = rtsTrue;
 997     }
 998     /* fall through */
 999
1000   case IND_OLDGEN_PERM:
1001     if (!printed) {
1002       fprintf(stderr, "IND_OLDGEN_PERM (%p) with indirection to %p\n",
1003               p, ((StgIndOldGen *)p)->indirectee);
1004       printed = rtsTrue;
1005     }
1006     // ((StgIndOldGen *)p)->indirectee =
1007     PrintGraph(((StgIndOldGen *)p)->indirectee,
1008                indent_level+1);
1009     //if (failed_to_evac) {
1010     //  failed_to_evac = rtsFalse;
1011     //  recordOldToNewPtrs((StgMutClosure *)p);
1012     //}
1013     // p += sizeofW(StgIndOldGen);
1014     break;
1015
1016   case CAF_UNENTERED:
1017     {
1018         StgCAF *caf = (StgCAF *)p;
1019
1020         fprintf(stderr, "CAF_UNENTERED (%p) pointing to %p\n", p, caf->body);
1021         PrintGraph(caf->body, indent_level+1);
1022         //if (failed_to_evac) {
1023         //  failed_to_evac = rtsFalse;
1024         //  recordOldToNewPtrs((StgMutClosure *)p);
1025         //} else {
1026         //  caf->mut_link = NULL;
1027         //}
1028         //p += sizeofW(StgCAF);
1029         break;
1030     }
1031
1032   case CAF_ENTERED:
1033     {
1034         StgCAF *caf = (StgCAF *)p;
1035
1036         fprintf(stderr, "CAF_ENTERED (%p) pointing to %p and %p\n",
1037                 p, caf->body, caf->value);
1038         // caf->body =
1039         PrintGraph(caf->body, indent_level+1);
1040         //caf->value =
1041         PrintGraph(caf->value, indent_level+1);
1042         //if (failed_to_evac) {
1043         //  failed_to_evac = rtsFalse;
1044         //  recordOldToNewPtrs((StgMutClosure *)p);
1045         //} else {
1046         //  caf->mut_link = NULL;
1047         //}
1048         //p += sizeofW(StgCAF);
1049         break;
1050     }
1051
1052   case MUT_VAR:
1053     /* ignore MUT_CONSs */
1054     fprintf(stderr, "MUT_VAR (%p) pointing to %p\n", p, ((StgMutVar *)p)->var);
1055     if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1056       //evac_gen = 0;
1057       PrintGraph(((StgMutVar *)p)->var, indent_level+1);
1058         //evac_gen = saved_evac_gen;
1059     }
1060     //p += sizeofW(StgMutVar);
1061     break;
1062
1063   case CAF_BLACKHOLE:
1064     if (!printed) {
1065       fprintf(stderr, "CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1066       printed = rtsTrue;
1067     }
1068   case SE_CAF_BLACKHOLE:
1069     if (!printed) {
1070       fprintf(stderr, "SE_CAF_BLACKHOLE (%p) with 0 pointers\n", p);
1071       printed = rtsTrue;
1072     }
1073   case SE_BLACKHOLE:
1074     if (!printed) {
1075       fprintf(stderr, "SE_BLACKHOLE (%p) with 0 pointers\n", p);
1076       printed = rtsTrue;
1077     }
1078   case BLACKHOLE:
1079     if (!printed) {
1080       fprintf(stderr, "BLACKHOLE (%p) with 0 pointers\n", p);
1081       printed = rtsTrue;
1082     }
1083     //p += BLACKHOLE_sizeW();
1084     break;
1085
1086   case BLACKHOLE_BQ:
1087     {
1088       StgBlockingQueue *bh = (StgBlockingQueue *)p;
1089       // (StgClosure *)bh->blocking_queue =
1090       fprintf(stderr, "BLACKHOLE_BQ (%p) pointing to %p\n",
1091               p, (StgClosure *)bh->blocking_queue);
1092       PrintGraph((StgClosure *)bh->blocking_queue, indent_level+1);
1093       //if (failed_to_evac) {
1094       //  failed_to_evac = rtsFalse;
1095       //  recordMutable((StgMutClosure *)bh);
1096       //}
1097       // p += BLACKHOLE_sizeW();
1098       break;
1099     }
1100
1101   case THUNK_SELECTOR:
1102     {
1103       StgSelector *s = (StgSelector *)p;
1104       fprintf(stderr, "THUNK_SELECTOR (%p) pointing to %p\n",
1105               p, s->selectee);
1106       PrintGraph(s->selectee, indent_level+1);
1107       // p += THUNK_SELECTOR_sizeW();
1108       break;
1109     }
1110
1111   case IND:
1112     fprintf(stderr, "IND (%p) pointing to %p\n", p, ((StgInd*)p)->indirectee);
1113     PrintGraph(((StgInd*)p)->indirectee, indent_level+1);
1114     break;
1115
1116   case IND_OLDGEN:
1117     fprintf(stderr, "IND_OLDGEN (%p) pointing to %p\n",
1118             p, ((StgIndOldGen*)p)->indirectee);
1119     PrintGraph(((StgIndOldGen*)p)->indirectee, indent_level+1);
1120     break;
1121
1122   case CONSTR_INTLIKE:
1123     fprintf(stderr, "CONSTR_INTLIKE (%p) with 0 pointers\n", p);
1124     break;
1125   case CONSTR_CHARLIKE:
1126     fprintf(stderr, "CONSTR_CHARLIKE (%p) with 0 pointers\n", p);
1127     break;
1128   case CONSTR_STATIC:
1129     fprintf(stderr, "CONSTR_STATIC (%p) with 0 pointers\n", p);
1130     break;
1131   case CONSTR_NOCAF_STATIC:
1132     fprintf(stderr, "CONSTR_NOCAF_STATIC (%p) with 0 pointers\n", p);
1133     break;
1134   case THUNK_STATIC:
1135     fprintf(stderr, "THUNK_STATIC (%p) with 0 pointers\n", p);
1136     break;
1137   case FUN_STATIC:
1138     fprintf(stderr, "FUN_STATIC (%p) with 0 pointers\n", p);
1139     break;
1140   case IND_STATIC:
1141     fprintf(stderr, "IND_STATIC (%p) with 0 pointers\n", p);
1142     break;
1143
1144   case RET_BCO:
1145     fprintf(stderr, "RET_BCO (%p) with 0 pointers\n", p);
1146     break;
1147   case RET_SMALL:
1148     fprintf(stderr, "RET_SMALL (%p) with 0 pointers\n", p);
1149     break;
1150   case RET_VEC_SMALL:
1151     fprintf(stderr, "RET_VEC_SMALL (%p) with 0 pointers\n", p);
1152     break;
1153   case RET_BIG:
1154     fprintf(stderr, "RET_BIG (%p) with 0 pointers\n", p);
1155     break;
1156   case RET_VEC_BIG:
1157     fprintf(stderr, "RET_VEC_BIG (%p) with 0 pointers\n", p);
1158     break;
1159   case RET_DYN:
1160     fprintf(stderr, "RET_DYN (%p) with 0 pointers\n", p);
1161     break;
1162   case UPDATE_FRAME:
1163     fprintf(stderr, "UPDATE_FRAME (%p) with 0 pointers\n", p);
1164     break;
1165   case STOP_FRAME:
1166     fprintf(stderr, "STOP_FRAME (%p) with 0 pointers\n", p);
1167     break;
1168   case CATCH_FRAME:
1169     fprintf(stderr, "CATCH_FRAME (%p) with 0 pointers\n", p);
1170     break;
1171   case SEQ_FRAME:
1172     fprintf(stderr, "SEQ_FRAME (%p) with 0 pointers\n", p);
1173     break;
1174
1175   case AP_UPD: /* same as PAPs */
1176     fprintf(stderr, "AP_UPD (%p) with 0 pointers\n", p);
1177   case PAP:
1178     /* Treat a PAP just like a section of stack, not forgetting to
1179      * PrintGraph the function pointer too...
1180      */
1181     {
1182         StgPAP* pap = stgCast(StgPAP*,p);
1183
1184         fprintf(stderr, "PAP (%p) pointing to %p\n", p, pap->fun);
1185         // pap->fun =
1186         //PrintGraph(pap->fun, indent_level+1);
1187         //scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1188         //p += pap_sizeW(pap);
1189         break;
1190     }
1191
1192   case ARR_WORDS:
1193     /* an array of (non-mutable) words */
1194     fprintf(stderr, "ARR_WORDS (%p) of %d non-ptrs (maybe a string?)\n",
1195             p, ((StgArrWords *)q)->words);
1196     break;
1197
1198   case MUT_ARR_PTRS:
1199     /* follow everything */
1200     {
1201         StgPtr next;
1202
1203         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)\n",
1204                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1205         // evac_gen = 0;                /* repeatedly mutable */
1206         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1207         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1208           // (StgClosure *)*p =
1209           // PrintGraph((StgClosure *)*p, indent_level+1);
1210           fprintf(stderr, ", %p", *p);
1211         }
1212         fputs("\n", stderr);
1213         //evac_gen = saved_evac_gen;
1214         break;
1215     }
1216
1217   case MUT_ARR_PTRS_FROZEN:
1218     /* follow everything */
1219     {
1220         StgPtr start = p, next;
1221
1222         fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)",
1223                 p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
1224         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1225         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1226           // (StgClosure *)*p =
1227           // PrintGraph((StgClosure *)*p, indent_level+1);
1228           fprintf(stderr, ", %p", *p);
1229         }
1230         fputs("\n", stderr);
1231         //if (failed_to_evac) {
1232           /* we can do this easier... */
1233         //  recordMutable((StgMutClosure *)start);
1234         //  failed_to_evac = rtsFalse;
1235         //}
1236         break;
1237     }
1238
1239   case TSO:
1240     {
1241         StgTSO *tso;
1242
1243         tso = (StgTSO *)p;
1244         fprintf(stderr, "TSO (%p) with link field %p\n", p, (StgClosure *)tso->link);
1245         // evac_gen = 0;
1246         /* chase the link field for any TSOs on the same queue */
1247         // (StgClosure *)tso->link =
1248         PrintGraph((StgClosure *)tso->link, indent_level+1);
1249         //if (tso->blocked_on) {
1250         //  tso->blocked_on = PrintGraph(tso->blocked_on);
1251         //}
1252         /* scavenge this thread's stack */
1253         //scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1254         //evac_gen = saved_evac_gen;
1255         //p += tso_sizeW(tso);
1256         break;
1257     }
1258
1259 #if defined(GRAN) || defined(PAR)
1260   case RBH:
1261     {
1262     StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
1263     //if (LOOKS_LIKE_GHC_INFO(rip))
1264     //  fprintf(stderr, "RBH (%p) with 0 pointers (reverted type=%s)\n",
1265         //      p, info_type_by_ip(rip));
1266     //else
1267     fprintf(stderr, "RBH (%p) with 0 pointers (reverted IP=%x)\n",
1268             p, rip);
1269     }
1270     break;
1271 #endif
1272 #if defined(PAR)
1273   case BLOCKED_FETCH:
1274     fprintf(stderr, "BLOCKED_FETCH (%p) with 0 pointers (link=%p)\n",
1275             p, ((StgBlockedFetch *)p)->link);
1276     break;
1277   case FETCH_ME:
1278     fprintf(stderr, "FETCH_ME (%p) with 0 pointers\n", p);
1279     break;
1280   case FETCH_ME_BQ:
1281     fprintf(stderr, "FETCH_ME_BQ (%p) with 0 pointers (blocking_queue=%p)\n",
1282             p, ((StgFetchMeBlockingQueue *)p)->blocking_queue);
1283     break;
1284 #endif
1285   case EVACUATED:
1286     fprintf(stderr, "EVACUATED (%p) with 0 pointers (evacuee=%p)\n",
1287             p, ((StgEvacuated *)p)->evacuee);
1288     break;
1289
1290   default:
1291     barf("PrintGraph: unknown closure %d (%s)",
1292          info -> type, info_type(info));
1293   }
1294
1295   /* If we didn't manage to promote all the objects pointed to by
1296    * the current object, then we have to designate this object as
1297    * mutable (because it contains old-to-new generation pointers).
1298    */
1299   //if (failed_to_evac) {
1300   //  mkMutCons((StgClosure *)q, &generations[evac_gen]);
1301   //  failed_to_evac = rtsFalse;
1302   //}
1303 }
1304
1305 /*
1306   Do a sanity check on the whole graph, down to a recursion level of level.
1307   Same structure as PrintGraph (nona).
1308 */
1309 void
1310 checkGraph(StgClosure *p, int rec_level)
1311 {
1312   StgPtr x, q;
1313   nat i, j;
1314   const StgInfoTable *info;
1315
1316   if (rec_level==0)
1317     return;
1318
1319   q = p;                        /* save ptr to object */
1320
1321   /* First, the obvious generic checks */
1322   ASSERT(p!=(StgClosure*)NULL);
1323   checkClosure(p);              /* see Sanity.c for what's actually checked */
1324
1325   info = get_itbl((StgClosure *)p);
1326   /* the rest of this fct recursively traverses the graph */
1327   switch (info -> type) {
1328
1329   case BCO:
1330     {
1331         StgBCO* bco = stgCast(StgBCO*,p);
1332         nat i;
1333         for (i = 0; i < bco->n_ptrs; i++) {
1334           checkGraph(bcoConstCPtr(bco,i), rec_level-1);
1335         }
1336         break;
1337     }
1338
1339   case MVAR:
1340     /* treat MVars specially, because we don't want to PrintGraph the
1341      * mut_link field in the middle of the closure.
1342      */
1343     {
1344         StgMVar *mvar = ((StgMVar *)p);
1345         checkGraph((StgClosure *)mvar->head, rec_level-1);
1346         checkGraph((StgClosure *)mvar->tail, rec_level-1);
1347         checkGraph((StgClosure *)mvar->value, rec_level-1);
1348         break;
1349     }
1350
1351   case THUNK_2_0:
1352   case FUN_2_0:
1353   case CONSTR_2_0:
1354     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1355     checkGraph(((StgClosure *)p)->payload[1], rec_level-1);
1356     break;
1357
1358   case THUNK_1_0:
1359     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1360     break;
1361
1362   case FUN_1_0:
1363   case CONSTR_1_0:
1364     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1365     break;
1366
1367   case THUNK_0_1:
1368     break;
1369
1370   case FUN_0_1:
1371   case CONSTR_0_1:
1372     break;
1373
1374   case THUNK_0_2:
1375   case FUN_0_2:
1376   case CONSTR_0_2:
1377     break;
1378
1379   case THUNK_1_1:
1380   case FUN_1_1:
1381   case CONSTR_1_1:
1382     checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
1383     break;
1384
1385   case FUN:
1386   case THUNK:
1387   case CONSTR:
1388     for (i=0; i<info->layout.payload.ptrs; i++)
1389       checkGraph(((StgClosure *)p)->payload[i], rec_level-1);
1390     break;
1391
1392   case WEAK:
1393   case FOREIGN:
1394   case STABLE_NAME:
1395     {
1396       StgPtr end;
1397
1398       end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1399       for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
1400         checkGraph(*(StgClosure **)p, rec_level-1);
1401       }
1402       break;
1403     }
1404
1405   case IND_PERM:
1406   case IND_OLDGEN_PERM:
1407     checkGraph(((StgIndOldGen *)p)->indirectee, rec_level-1);
1408     break;
1409
1410   case CAF_UNENTERED:
1411     {
1412         StgCAF *caf = (StgCAF *)p;
1413
1414         fprintf(stderr, "CAF_UNENTERED (%p) pointing to %p\n", p, caf->body);
1415         checkGraph(caf->body, rec_level-1);
1416         break;
1417     }
1418
1419   case CAF_ENTERED:
1420     {
1421         StgCAF *caf = (StgCAF *)p;
1422
1423         fprintf(stderr, "CAF_ENTERED (%p) pointing to %p and %p\n",
1424                 p, caf->body, caf->value);
1425         checkGraph(caf->body, rec_level-1);
1426         checkGraph(caf->value, rec_level-1);
1427         break;
1428     }
1429
1430   case MUT_VAR:
1431     /* ignore MUT_CONSs */
1432     if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1433       checkGraph(((StgMutVar *)p)->var, rec_level-1);
1434     }
1435     break;
1436
1437   case CAF_BLACKHOLE:
1438   case SE_CAF_BLACKHOLE:
1439   case SE_BLACKHOLE:
1440   case BLACKHOLE:
1441     break;
1442
1443   case BLACKHOLE_BQ:
1444     break;
1445
1446   case THUNK_SELECTOR:
1447     {
1448       StgSelector *s = (StgSelector *)p;
1449       checkGraph(s->selectee, rec_level-1);
1450       break;
1451     }
1452
1453   case IND:
1454     checkGraph(((StgInd*)p)->indirectee, rec_level-1);
1455     break;
1456
1457   case IND_OLDGEN:
1458     checkGraph(((StgIndOldGen*)p)->indirectee, rec_level-1);
1459     break;
1460
1461   case CONSTR_INTLIKE:
1462     break;
1463   case CONSTR_CHARLIKE:
1464     break;
1465   case CONSTR_STATIC:
1466     break;
1467   case CONSTR_NOCAF_STATIC:
1468     break;
1469   case THUNK_STATIC:
1470     break;
1471   case FUN_STATIC:
1472     break;
1473   case IND_STATIC:
1474     break;
1475
1476   case RET_BCO:
1477     break;
1478   case RET_SMALL:
1479     break;
1480   case RET_VEC_SMALL:
1481     break;
1482   case RET_BIG:
1483     break;
1484   case RET_VEC_BIG:
1485     break;
1486   case RET_DYN:
1487     break;
1488   case UPDATE_FRAME:
1489     break;
1490   case STOP_FRAME:
1491     break;
1492   case CATCH_FRAME:
1493     break;
1494   case SEQ_FRAME:
1495     break;
1496
1497   case AP_UPD: /* same as PAPs */
1498   case PAP:
1499     /* Treat a PAP just like a section of stack, not forgetting to
1500      * checkGraph the function pointer too...
1501      */
1502     {
1503         StgPAP* pap = stgCast(StgPAP*,p);
1504
1505         checkGraph(pap->fun, rec_level-1);
1506         break;
1507     }
1508
1509   case ARR_WORDS:
1510     break;
1511
1512   case MUT_ARR_PTRS:
1513     /* follow everything */
1514     {
1515         StgPtr next;
1516
1517         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1518         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1519           checkGraph(*(StgClosure **)p, rec_level-1);
1520         }
1521         break;
1522     }
1523
1524   case MUT_ARR_PTRS_FROZEN:
1525     /* follow everything */
1526     {
1527         StgPtr start = p, next;
1528
1529         next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1530         for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1531           checkGraph(*(StgClosure **)p, rec_level-1);
1532         }
1533         break;
1534     }
1535
1536   case TSO:
1537     {
1538         StgTSO *tso;
1539
1540         tso = (StgTSO *)p;
1541         checkGraph((StgClosure *)tso->link, rec_level-1);
1542         break;
1543     }
1544
1545 #if defined(GRAN) || defined(PAR)
1546   case RBH:
1547     break;
1548 #endif
1549 #if defined(PAR)
1550   case BLOCKED_FETCH:
1551     break;
1552   case FETCH_ME:
1553     break;
1554   case FETCH_ME_BQ:
1555     break;
1556 #endif
1557   case EVACUATED:
1558     barf("checkGraph: found EVACUATED closure %p (%s)",
1559          p, info_type(p));
1560     break;
1561
1562   default:
1563   }
1564 }
1565
1566 #endif /* GRAN */
1567
1568 #endif /* GRAN || PAR */
1569
1570 //@node End of File,  , Printing Packet Contents, Debugging routines for GranSim and GUM
1571 //@subsection End of File