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