ghc/rts/parallel/Parallel.c

   1 /*
   2   Time-stamp: <Wed Mar 21 2001 16:42:40 Stardate: [-30]6363.48 hwloidl>
   3
   4   Basic functions for use in either GranSim or GUM.
   5 */
   6
   7 #if defined(GRAN) || defined(PAR)                              /* whole file */
   8
   9 //@menu
  10 //* Includes::
  11 //* Variables and constants::
  12 //* Writing to the log-file::
  13 //* Global statistics::
  14 //* Dumping routines::
  15 //@end menu
  16 //*/ fool highlight
  17
  18 //@node Includes, Variables and constants
  19 //@subsection Includes
  20
  21 #include "Rts.h"
  22 #include "RtsFlags.h"
  23 #include "RtsUtils.h"
  24 #include "Storage.h"
  25 #include "GranSimRts.h"
  26 #include "ParallelRts.h"
  27
  28 //@node Variables and constants, Writing to the log-file, Includes
  29 //@subsection Variables and constants
  30
  31 /* Where to write the log file */
  32 FILE *gr_file = NULL;
  33 char gr_filename[STATS_FILENAME_MAXLEN];
  34
  35 #if defined(PAR)
  36 /* Global statistics */
  37 GlobalParStats globalParStats;
  38 #endif
  39
  40 #if defined(PAR) && !defined(DEBUG)
  41 // HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACCCCCCCCCKKKKKKKKKKKK
  42 // Definitely the wrong place for info_type in !DEBUG (see Printer.c) -- HWL
  43
  44 static char *closure_type_names[] = {
  45   "INVALID_OBJECT",             /* 0  */
  46   "CONSTR",                     /* 1  */
  47   "CONSTR_1_0",                 /* 2  */
  48   "CONSTR_0_1",                 /* 3  */
  49   "CONSTR_2_0",                 /* 4  */
  50   "CONSTR_1_1",                 /* 5  */
  51   "CONSTR_0_2",                 /* 6  */
  52   "CONSTR_INTLIKE",             /* 7  */
  53   "CONSTR_CHARLIKE",            /* 8  */
  54   "CONSTR_STATIC",              /* 9  */
  55   "CONSTR_NOCAF_STATIC",        /* 10 */
  56   "FUN",                        /* 11 */
  57   "FUN_1_0",                    /* 12 */
  58   "FUN_0_1",                    /* 13 */
  59   "FUN_2_0",                    /* 14 */
  60   "FUN_1_1",                    /* 15 */
  61   "FUN_0_2",                    /* 16 */
  62   "FUN_STATIC",                 /* 17 */
  63   "THUNK",                      /* 18 */
  64   "THUNK_1_0",                  /* 19 */
  65   "THUNK_0_1",                  /* 20 */
  66   "THUNK_2_0",                  /* 21 */
  67   "THUNK_1_1",                  /* 22 */
  68   "THUNK_0_2",                  /* 23 */
  69   "THUNK_STATIC",               /* 24 */
  70   "THUNK_SELECTOR",             /* 25 */
  71   "BCO",                        /* 26 */
  72   "AP_UPD",                     /* 27 */
  73   "PAP",                        /* 28 */
  74   "IND",                        /* 29 */
  75   "IND_OLDGEN",                 /* 30 */
  76   "IND_PERM",                   /* 31 */
  77   "IND_OLDGEN_PERM",            /* 32 */
  78   "IND_STATIC",                 /* 33 */
  79   "CAF_UNENTERED",              /* 34 */
  80   "CAF_ENTERED",                /* 35 */
  81   "CAF_BLACKHOLE",              /* 36 */
  82   "RET_BCO",                    /* 37 */
  83   "RET_SMALL",                  /* 38 */
  84   "RET_VEC_SMALL",              /* 39 */
  85   "RET_BIG",                    /* 40 */
  86   "RET_VEC_BIG",                /* 41 */
  87   "RET_DYN",                    /* 42 */
  88   "UPDATE_FRAME",               /* 43 */
  89   "CATCH_FRAME",                /* 44 */
  90   "STOP_FRAME",                 /* 45 */
  91   "SEQ_FRAME",                  /* 46 */
  92   "BLACKHOLE",                  /* 47 */
  93   "BLACKHOLE_BQ",               /* 48 */
  94   "SE_BLACKHOLE",               /* 49 */
  95   "SE_CAF_BLACKHOLE",           /* 50 */
  96   "MVAR",                       /* 51 */
  97   "ARR_WORDS",                  /* 52 */
  98   "MUT_ARR_PTRS",               /* 53 */
  99   "MUT_ARR_PTRS_FROZEN",        /* 54 */
 100   "MUT_VAR",                    /* 55 */
 101   "WEAK",                       /* 56 */
 102   "FOREIGN",                    /* 57 */
 103   "STABLE_NAME",                /* 58 */
 104   "TSO",                        /* 59 */
 105   "BLOCKED_FETCH",              /* 60 */
 106   "FETCH_ME",                   /* 61 */
 107   "FETCH_ME_BQ",                /* 62 */
 108   "RBH",                        /* 63 */
 109   "EVACUATED",                  /* 64 */
 110   "REMOTE_REF",                 /* 65 */
 111   "N_CLOSURE_TYPES"             /* 66 */
 112 };
 113
 114 char *
 115 info_type(StgClosure *closure){
 116   return closure_type_names[get_itbl(closure)->type];
 117 }
 118
 119 char *
 120 info_type_by_ip(StgInfoTable *ip){
 121   return closure_type_names[ip->type];
 122 }
 123
 124 void
 125 info_hdr_type(StgClosure *closure, char *res){
 126   strcpy(res,closure_type_names[get_itbl(closure)->type]);
 127 }
 128 #endif
 129
 130 //@node Writing to the log-file, Global statistics, Variables and constants
 131 //@subsection Writing to the log-file
 132 /*
 133   Writing to the log-file
 134
 135   These routines dump event-based info to the main log-file.
 136   The code for writing log files is shared between GranSim and GUM.
 137 */
 138
 139 /*
 140  * If you're not using GNUC and you're on a 32-bit machine, you're
 141  * probably out of luck here.  However, since CONCURRENT currently
 142  * requires GNUC, I'm not too worried about it.  --JSM
 143  */
 144
 145 //@cindex init_gr_simulation
 146 #if defined(GRAN)
 147 void
 148 init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv)
 149 char *prog_argv[], *rts_argv[];
 150 int prog_argc, rts_argc;
 151 {
 152   nat i;
 153   char *extension = RtsFlags.GranFlags.GranSimStats.Binary ? "gb" : "gr";
 154
 155   if (RtsFlags.GranFlags.GranSimStats.Global)
 156     init_gr_stats();
 157
 158   /* init global constants for costs of basic operations */
 159   gran_arith_cost = RtsFlags.GranFlags.Costs.arith_cost;
 160   gran_branch_cost = RtsFlags.GranFlags.Costs.branch_cost;
 161   gran_load_cost = RtsFlags.GranFlags.Costs.load_cost;
 162   gran_store_cost = RtsFlags.GranFlags.Costs.store_cost;
 163   gran_float_cost = RtsFlags.GranFlags.Costs.float_cost;
 164
 165   if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 166     return;
 167
 168   if (!RtsFlags.GranFlags.GranSimStats.Full)
 169     return;
 170
 171   sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension);
 172
 173   if ((gr_file = fopen(gr_filename, "w")) == NULL) {
 174     barf("Can't open granularity simulation report file %s\n",
 175          gr_filename);
 176   }
 177
 178   setbuf(gr_file, NULL);                   /* turn  buffering off */
 179
 180   /* write header with program name, options and setup to gr_file */
 181   fputs("Granularity Simulation for ", gr_file);
 182   for (i = 0; i < prog_argc; ++i) {
 183     fputs(prog_argv[i], gr_file);
 184     fputc(' ', gr_file);
 185   }
 186
 187   if (rts_argc > 0) {
 188     fputs("+RTS ", gr_file);
 189
 190     for (i = 0; i < rts_argc; ++i) {
 191       fputs(rts_argv[i], gr_file);
 192       fputc(' ', gr_file);
 193     }
 194   }
 195
 196   fputs("\nStart time: ", gr_file);
 197   fputs(time_str(), gr_file);               /* defined in RtsUtils.c */
 198   fputc('\n', gr_file);
 199
 200   fputs("\n\n--------------------\n\n", gr_file);
 201
 202   fputs("General Parameters:\n\n", gr_file);
 203
 204   if (RtsFlags.GranFlags.Light)
 205     fprintf(gr_file, "GrAnSim-Light\nPEs infinite, %s Scheduler, %sMigrate Threads %s, %s\n",
 206             RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair",
 207             RtsFlags.GranFlags.DoThreadMigration?"":"Don't ",
 208             RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"",
 209             RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" :
 210             "Block on Fetch");
 211   else
 212     fprintf(gr_file, "PEs %u, %s Scheduler, %sMigrate Threads %s, %s\n",
 213             RtsFlags.GranFlags.proc,RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair",
 214             RtsFlags.GranFlags.DoThreadMigration?"":"Don't ",
 215             RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"",
 216             RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" :
 217             "Block on Fetch");
 218
 219   if (RtsFlags.GranFlags.DoBulkFetching)
 220     if (RtsFlags.GranFlags.ThunksToPack)
 221       fprintf(gr_file, "Bulk Fetching: Fetch %d Thunks in Each Packet (Packet Size = %d closures)\n",
 222               RtsFlags.GranFlags.ThunksToPack,
 223               RtsFlags.GranFlags.packBufferSize);
 224     else
 225       fprintf(gr_file, "Bulk Fetching: Fetch as many closures as possible (Packet Size = %d closures)\n",
 226               RtsFlags.GranFlags.packBufferSize);
 227   else
 228     fprintf(gr_file, "Incremental Fetching: Fetch Exactly One Closure in Each Packet\n");
 229
 230   fprintf(gr_file, "Fetch Strategy(%u):If outstanding fetches %s\n",
 231           RtsFlags.GranFlags.FetchStrategy,
 232           RtsFlags.GranFlags.FetchStrategy==0 ?
 233             " block (block-on-fetch)":
 234           RtsFlags.GranFlags.FetchStrategy==1 ?
 235             "only run runnable threads":
 236           RtsFlags.GranFlags.FetchStrategy==2 ?
 237             "create threads only from local sparks":
 238           RtsFlags.GranFlags.FetchStrategy==3 ?
 239             "create threads from local or global sparks":
 240           RtsFlags.GranFlags.FetchStrategy==4 ?
 241             "create sparks and steal threads if necessary":
 242           "unknown");
 243
 244   if (RtsFlags.GranFlags.DoPrioritySparking)
 245     fprintf(gr_file, "Priority Sparking (i.e. keep sparks ordered by priority)\n");
 246
 247   if (RtsFlags.GranFlags.DoPriorityScheduling)
 248     fprintf(gr_file, "Priority Scheduling (i.e. keep threads ordered by priority)\n");
 249
 250   fprintf(gr_file, "Thread Creation Time %u, Thread Queue Time %u\n",
 251           RtsFlags.GranFlags.Costs.threadcreatetime,
 252           RtsFlags.GranFlags.Costs.threadqueuetime);
 253   fprintf(gr_file, "Thread DeSchedule Time %u, Thread Schedule Time %u\n",
 254           RtsFlags.GranFlags.Costs.threaddescheduletime,
 255           RtsFlags.GranFlags.Costs.threadscheduletime);
 256   fprintf(gr_file, "Thread Context-Switch Time %u\n",
 257           RtsFlags.GranFlags.Costs.threadcontextswitchtime);
 258   fputs("\n\n--------------------\n\n", gr_file);
 259
 260   fputs("Communication Metrics:\n\n", gr_file);
 261   fprintf(gr_file,
 262           "Latency %u (1st) %u (rest), Fetch %u, Notify %u (Global) %u (Local)\n",
 263           RtsFlags.GranFlags.Costs.latency,
 264           RtsFlags.GranFlags.Costs.additional_latency,
 265           RtsFlags.GranFlags.Costs.fetchtime,
 266           RtsFlags.GranFlags.Costs.gunblocktime,
 267           RtsFlags.GranFlags.Costs.lunblocktime);
 268   fprintf(gr_file,
 269           "Message Creation %u (+ %u after send), Message Read %u\n",
 270           RtsFlags.GranFlags.Costs.mpacktime,
 271           RtsFlags.GranFlags.Costs.mtidytime,
 272           RtsFlags.GranFlags.Costs.munpacktime);
 273   fputs("\n\n--------------------\n\n", gr_file);
 274
 275   fputs("Instruction Metrics:\n\n", gr_file);
 276   fprintf(gr_file, "Arith %u, Branch %u, Load %u, Store %u, Float %u, Alloc %u\n",
 277           RtsFlags.GranFlags.Costs.arith_cost,
 278           RtsFlags.GranFlags.Costs.branch_cost,
 279           RtsFlags.GranFlags.Costs.load_cost,
 280           RtsFlags.GranFlags.Costs.store_cost,
 281           RtsFlags.GranFlags.Costs.float_cost,
 282           RtsFlags.GranFlags.Costs.heapalloc_cost);
 283   fputs("\n\n++++++++++++++++++++\n\n", gr_file);
 284
 285 # if 0
 286   /* binary log files are currently not supported */
 287   if (RtsFlags.GranFlags.GranSimStats.Binary)
 288     grputw(sizeof(rtsTime));
 289 # endif
 290
 291   return (0);
 292 }
 293
 294 #elif defined(PAR)
 295
 296 void init_gr_stats (void);
 297
 298 void
 299 init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv)
 300 char *prog_argv[], *rts_argv[];
 301 int prog_argc, rts_argc;
 302 {
 303   nat i;
 304   char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
 305   char *extension = RtsFlags.ParFlags.ParStats.Binary ? "gb" : "gr";
 306
 307   sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension);
 308
 309   if (!RtsFlags.ParFlags.ParStats.Full)
 310     return;
 311
 312   if (RtsFlags.ParFlags.ParStats.Global)
 313     init_gr_stats();
 314
 315   if ((gr_file = fopen(gr_filename, "w")) == NULL)
 316     barf("Can't open activity report file %s\n", gr_filename);
 317
 318   setbuf(gr_file, NULL);                   /* turn  buffering off */
 319
 320   /* write header with program name, options and setup to gr_file */
 321   for (i = 0; i < prog_argc; ++i) {
 322     fputs(prog_argv[i], gr_file);
 323     fputc(' ', gr_file);
 324   }
 325
 326   if (rts_argc > 0) {
 327     fputs("+RTS ", gr_file);
 328
 329     for (i = 0; i < rts_argc; ++i) {
 330       fputs(rts_argv[i], gr_file);
 331       fputc(' ', gr_file);
 332     }
 333   }
 334   fputc('\n', gr_file);
 335
 336   /* record the absolute start time to allow synchronisation of log-files */
 337   fputs("Start-Time: ", gr_file);
 338   fputs(time_str(), gr_file);
 339   fputc('\n', gr_file);
 340
 341   ASSERT(startTime==0);
 342   // startTime = msTime();
 343   startTime = CURRENT_TIME;
 344   ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 345   fprintf(gr_file, "PE %2u [%s]: TIME\n", thisPE, time_string);
 346
 347 # if 0
 348     ngoq Dogh'q' vImuS
 349   IF_PAR_DEBUG(verbose,
 350                belch("== Start-time: %ld (%s)",
 351                      startTime, time_string));
 352
 353     if (startTime > LL(1000000000)) {
 354       fprintf(gr_file, "PE %2u [%lu%lu]: TIME\n", thisPE,
 355             (rtsTime) (startTime / LL(1000000000)),
 356             (rtsTime) (startTime % LL(1000000000)));
 357     } else {
 358       fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime);
 359     }
 360     /* binary log files are currently not supported */
 361     if (RtsFlags.GranFlags.GranSimStats.Binary)
 362         grputw(sizeof(rtsTime));
 363 # endif
 364
 365     return;
 366 }
 367
 368 void
 369 init_gr_stats (void) {
 370   // memset(&globalParStats, '\0', sizeof(GlobalParStats));
 371
 372   globalParStats.tot_mark_GA = globalParStats.tot_rebuild_GA = globalParStats.tot_free_GA = globalParStats.res_mark_GA = globalParStats.res_rebuild_GA = globalParStats.res_free_GA = globalParStats.tot_size_GA = globalParStats.res_size_GA = globalParStats.tot_global = globalParStats.tot_local = 0;
 373   globalParStats.cnt_mark_GA = globalParStats.cnt_rebuild_GA = globalParStats.cnt_free_GA = globalParStats.res_free_GA = globalParStats.local_alloc_GA = 0;
 374
 375   globalParStats.time_mark_GA = 0.0;
 376   globalParStats.time_rebuild_GA = 0.0;
 377   globalParStats.time_sparks = 0.0;
 378   globalParStats.time_pack = 0.0;
 379
 380   globalParStats.res_sp = globalParStats.res_tp = globalParStats.tot_sp = globalParStats.tot_tp = globalParStats.cnt_sp = globalParStats.cnt_tp = globalParStats.emp_sp = globalParStats.emp_tp = 0;
 381   globalParStats.tot_packets = globalParStats.tot_packet_size = globalParStats.tot_thunks = globalParStats.res_packet_size = globalParStats.res_thunks = globalParStats.rec_res_packet_size = globalParStats.rec_res_thunks = 0;
 382
 383   globalParStats.tot_fish_mess = globalParStats.tot_fetch_mess = globalParStats.tot_resume_mess = globalParStats.tot_schedule_mess = 0;
 384   globalParStats.rec_fish_mess = globalParStats.rec_resume_mess = globalParStats.rec_schedule_mess = 0;
 385   globalParStats.rec_fetch_mess = 0;
 386 #if defined(DIST)
 387   globalParStats.tot_reval_mess = 0;
 388   globalParStats.rec_reval_mess = 0;
 389 #endif
 390
 391   globalParStats.tot_threads_created = globalParStats.tot_sparks_created = globalParStats.tot_sparks_ignored = globalParStats.tot_sparks_marked = globalParStats.res_sparks_created = globalParStats.res_sparks_ignored = globalParStats.res_sparks_marked = 0;
 392    globalParStats.tot_yields = globalParStats.tot_stackover = globalParStats.tot_heapover = 0;
 393
 394    globalParStats.tot_arrs = globalParStats.tot_arr_size = 0;
 395 }
 396
 397 #endif /* PAR */
 398
 399 //@cindex end_gr_simulation
 400 #if defined(GRAN)
 401 void
 402 end_gr_simulation(void)
 403 {
 404    char time_string[TIME_STR_LEN];
 405
 406    ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 407
 408    if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 409      return;
 410
 411    /* Print event stats */
 412    if (RtsFlags.GranFlags.GranSimStats.Global) {
 413      nat i;
 414
 415      fprintf(stderr,"Total yields: %d\n",
 416              globalGranStats.tot_yields);
 417
 418      fprintf(stderr,"Total number of threads created: %d ; per PE:\n",
 419              globalGranStats.tot_threads_created);
 420      for (i=0; i<RtsFlags.GranFlags.proc; i++) {
 421        fprintf(stderr,"  PE %d: %d\t",
 422                i, globalGranStats.threads_created_on_PE[i]);
 423        if (i+1 % 4 == 0) fprintf(stderr,"\n");
 424      }
 425      if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n");
 426      fprintf(stderr,"Total number of threads migrated: %d\n",
 427              globalGranStats.tot_TSOs_migrated);
 428
 429      fprintf(stderr,"Total number of sparks created: %d ; per PE:\n",
 430              globalGranStats.tot_sparks_created);
 431      for (i=0; i<RtsFlags.GranFlags.proc; i++) {
 432        fprintf(stderr,"  PE %d: %d\t",
 433                i, globalGranStats.sparks_created_on_PE[i]);
 434        if (i+1 % 4 == 0) fprintf(stderr,"\n");
 435      }
 436      if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n");
 437
 438      fprintf(stderr,"Event statistics (number of events: %d):\n",
 439              globalGranStats.noOfEvents);
 440      for (i=0; i<=MAX_EVENT; i++) {
 441        fprintf(stderr,"  %s (%d): \t%d \t%f%%\t%f%%\n",
 442                event_names[i],i,globalGranStats.event_counts[i],
 443                (float)(100*globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents),
 444                (i==ContinueThread ? 0.0 :
 445                    (float)(100*(globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents-globalGranStats.event_counts[ContinueThread])) ));
 446      }
 447      fprintf(stderr,"Randomized steals: %ld sparks, %ld threads \n \t(Sparks: #%u (avg ntimes=%f; avg fl=%f)\n\t(Threads: %ld)",
 448                      globalGranStats.rs_sp_count,
 449                      globalGranStats.rs_t_count,
 450                      globalGranStats.no_of_steals,
 451                      (float)globalGranStats.ntimes_total/(float)stg_max(globalGranStats.no_of_steals,1),
 452                      (float)globalGranStats.fl_total/(float)stg_max(globalGranStats.no_of_steals,1),
 453                      globalGranStats.no_of_migrates);
 454      fprintf(stderr,"Moved sparks: %d  Withered sparks: %d (%.2f %%)\n",
 455               globalGranStats.tot_sparks, globalGranStats.withered_sparks,
 456              ( globalGranStats.tot_sparks == 0 ? 0 :
 457                   (float)(100*globalGranStats.withered_sparks)/(float)(globalGranStats.tot_sparks)) );
 458      /* Print statistics about priority sparking */
 459      if (RtsFlags.GranFlags.DoPrioritySparking) {
 460         fprintf(stderr,"About Priority Sparking:\n");
 461         fprintf(stderr,"  Total no. NewThreads: %d   Avg. spark queue len: %.2f \n", globalGranStats.tot_sq_probes, (float)globalGranStats.tot_sq_len/(float)globalGranStats.tot_sq_probes);
 462      }
 463      /* Print statistics about priority sparking */
 464      if (RtsFlags.GranFlags.DoPriorityScheduling) {
 465         fprintf(stderr,"About Priority Scheduling:\n");
 466         fprintf(stderr,"  Total no. of StartThreads: %d (non-end: %d) Avg. thread queue len: %.2f\n",
 467                 globalGranStats.tot_add_threads, globalGranStats.non_end_add_threads,
 468                 (float)globalGranStats.tot_tq_len/(float)globalGranStats.tot_add_threads);
 469      }
 470      /* Blocking queue statistics */
 471      if (1) {
 472         fprintf(stderr,"Blocking queue statistcs:\n");
 473         fprintf(stderr,"  Total no. of FMBQs generated: %d\n",
 474                 globalGranStats.tot_FMBQs);
 475         fprintf(stderr,"  Total no. of bqs awakened: %d\n",
 476                 globalGranStats.tot_awbq);
 477         fprintf(stderr,"  Total length of all bqs: %d\tAvg length of bqs: %.2f\n",
 478                 globalGranStats.tot_bq_len, (float)globalGranStats.tot_bq_len/(float)globalGranStats.tot_awbq);
 479         fprintf(stderr,"  Percentage of local TSOs in BQs: %.2f\n",
 480                 (float)globalGranStats.tot_bq_len*100.0/(float)globalGranStats.tot_bq_len);
 481         fprintf(stderr,"  Total time spent processing BQs: %lx\n",
 482                 globalGranStats.tot_bq_processing_time);
 483      }
 484
 485      /* Fetch misses and thunk stealing */
 486      fprintf(stderr,"Number of fetch misses: %d\n",
 487              globalGranStats.fetch_misses);
 488
 489      /* Print packet statistics if GUMM fetching is turned on */
 490      if (RtsFlags.GranFlags.DoBulkFetching) {
 491         fprintf(stderr,"Packet statistcs:\n");
 492         fprintf(stderr,"  Total no. of packets: %d   Avg. packet size: %.2f \n", globalGranStats.tot_packets, (float)globalGranStats.tot_packet_size/(float)globalGranStats.tot_packets);
 493         fprintf(stderr,"  Total no. of thunks: %d   Avg. thunks/packet: %.2f \n", globalGranStats.tot_thunks, (float)globalGranStats.tot_thunks/(float)globalGranStats.tot_packets);
 494         fprintf(stderr,"  Total no. of cuts: %d   Avg. cuts/packet: %.2f\n", globalGranStats.tot_cuts, (float)globalGranStats.tot_cuts/(float)globalGranStats.tot_packets);
 495         /*
 496         if (closure_queue_overflows>0)
 497           fprintf(stderr,"  Number of closure queue overflows: %u\n",
 498                   closure_queue_overflows);
 499         */
 500      }
 501    } /* RtsFlags.GranFlags.GranSimStats.Global */
 502
 503 #  if defined(GRAN_COUNT)
 504 #  error "GRAN_COUNT not supported; should be parallel ticky profiling, really"
 505     fprintf(stderr,"Update count statistics:\n");
 506     fprintf(stderr,"  Total number of updates: %u\n",nUPDs);
 507     fprintf(stderr,"  Needed to awaken BQ: %u with avg BQ len of: %f\n",
 508             nUPDs_BQ,(float)BQ_lens/(float)nUPDs_BQ);
 509     fprintf(stderr,"  Number of PAPs: %u\n",nPAPs);
 510 #  endif
 511
 512     fprintf(stderr, "Simulation finished after @ %s @ cycles. %d sparks created, %d sparks ignored. Check %s for details.\n",
 513             time_string, sparksCreated, sparksIgnored, gr_filename);
 514
 515     if (RtsFlags.GranFlags.GranSimStats.Full)
 516       fclose(gr_file);
 517 }
 518
 519 #elif defined(PAR)
 520
 521 /*
 522   Under GUM we print only one line.
 523 */
 524 void
 525 end_gr_simulation(void)
 526 {
 527   char time_string[TIME_STR_LEN];
 528
 529   ullong_format_string(CURRENT_TIME-startTime, time_string, rtsFalse/*no commas!*/);
 530
 531   fprintf(stderr, "Computation finished after @ %s @ ms. %d sparks created, %d sparks ignored. Check %s for details.\n",
 532             time_string, sparksCreated, sparksIgnored, gr_filename);
 533
 534   if (RtsFlags.ParFlags.ParStats.Full)
 535     fclose(gr_file);
 536 }
 537 #endif /* PAR */
 538
 539 //@node Global statistics, Dumping routines, Writing to the log-file
 540 //@subsection Global statistics
 541 /*
 542    Called at the end of execution
 543 */
 544
 545 //@node Dumping routines,  , Global statistics
 546 //@subsection Dumping routines
 547
 548 //@cindex DumpGranEvent
 549 void
 550 DumpGranEvent(name, tso)
 551 GranEventType name;
 552 StgTSO *tso;
 553 {
 554     DumpRawGranEvent(CURRENT_PROC, (PEs)0, name, tso, &stg_END_TSO_QUEUE_closure, (StgInt)0, (StgInt)0);
 555 }
 556
 557 //@cindex DumpRawGranEvent
 558 void
 559 DumpRawGranEvent(proc, p, name, tso, node, sparkname, len)
 560 PEs proc, p;         /* proc ... where it happens; p ... where node lives */
 561 GranEventType name;
 562 StgTSO *tso;
 563 StgClosure *node;
 564 StgInt sparkname, len;
 565 {
 566 # if defined(GRAN)
 567   DumpVeryRawGranEvent(TIME_ON_PROC(proc),
 568                        proc, p, name, tso, node, sparkname, len);
 569 # elif defined(PAR)
 570   DumpVeryRawGranEvent(CURRENT_TIME,
 571                        proc, p, name, tso, node, sparkname, len);
 572 # endif
 573 }
 574
 575 //@cindex DumpVeryRawGranEvent
 576 void
 577 DumpVeryRawGranEvent(time, proc, p, name, tso, node, sparkname, len)
 578 rtsTime time;
 579 PEs proc, p;         /* proc ... where it happens; p ... where node lives */
 580 GranEventType name;
 581 StgTSO *tso;
 582 StgClosure *node;
 583 StgInt sparkname, len;
 584 {
 585   FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
 586   StgWord id;
 587   char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
 588 # if defined(GRAN)
 589   ullong_format_string(time,
 590                        time_string, rtsFalse/*no commas!*/);
 591 # elif defined(PAR)
 592   ullong_format_string(time,
 593                        time_string, rtsFalse/*no commas!*/);
 594 # endif
 595   output_file = gr_file;
 596
 597 # if defined(GRAN)
 598
 599   if (RtsFlags.GranFlags.GranSimStats.Full)
 600     ASSERT(output_file!=NULL);
 601
 602   if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 603     return;
 604 # elif defined(PAR)
 605
 606   if (RtsFlags.ParFlags.ParStats.Full)
 607     ASSERT(output_file!=NULL);
 608
 609   if (RtsFlags.ParFlags.ParStats.Suppressed)
 610     return;
 611
 612 # endif
 613
 614   id = tso == NULL ? -1 : tso->id;
 615   if (node==stgCast(StgClosure*,&stg_END_TSO_QUEUE_closure))
 616       strcpy(node_str,"________");  /* "END_TSO_QUEUE"); */
 617   else
 618       sprintf(node_str,"0x%-6lx",node);
 619
 620   if (name > GR_EVENT_MAX)
 621         name = GR_EVENT_MAX;
 622
 623   if (BINARY_STATS)
 624     barf("binary log files not yet supported");
 625 #if 0
 626     /* ToDo: fix code for writing binary GrAnSim statistics */
 627     switch (name) {
 628       case GR_START:
 629       case GR_STARTQ:
 630                       grputw(name);
 631                       grputw(proc);
 632                       abort();        /* die please: a single word */
 633                                       /* doesn't represent long long times */
 634                       grputw(TIME_ON_PROC(proc));
 635                       grputw((StgWord)node);
 636                       break;
 637       case GR_FETCH:
 638       case GR_REPLY:
 639       case GR_BLOCK:
 640                       grputw(name);
 641                       grputw(proc);
 642                       abort();        /* die please: a single word */
 643                                       /* doesn't represent long long times */
 644                       grputw(TIME_ON_PROC(proc));  /* this line is bound to */
 645                       grputw(id);                  /*   do the wrong thing */
 646                       break;
 647       default:
 648                       grputw(name);
 649                       grputw(proc);
 650                       abort();        /* die please: a single word */
 651                                       /* doesn't represent long long times */
 652                       grputw(TIME_ON_PROC(proc));
 653                       grputw((StgWord)node);
 654     }
 655 #endif
 656   else /* !BINARY_STATS */
 657     switch (name) {
 658      case GR_START:
 659      case GR_STARTQ:
 660         fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[SN %u]\t[sparks %u]\n",
 661                 proc,time_string,gran_event_names[name],
 662                 id,node_str,sparkname,len);
 663         break;
 664      case GR_FETCH:
 665      case GR_REPLY:
 666      case GR_BLOCK:
 667      case GR_STOLEN:
 668      case GR_STOLENQ:
 669      case GR_STEALING:
 670         fprintf(output_file, "PE %2u [%s]: %-9s\t%lx \t%s\t(from %2u)\n",
 671                 proc, time_string, gran_event_names[name],
 672                 id,node_str,p);
 673         break;
 674      case GR_RESUME:
 675      case GR_RESUMEQ:
 676      case GR_SCHEDULE:
 677      case GR_DESCHEDULE:
 678         fprintf(output_file,"PE %2u [%s]: %-9s\t%lx \n",
 679                 proc,time_string,gran_event_names[name],id);
 680         break;
 681      case GR_ALLOC:
 682         fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t        \tallocating %u words\n",
 683                 proc,time_string,gran_event_names[name],id,len);
 684         break;
 685      default:
 686         fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[sparks %u]\n",
 687                 proc,time_string,gran_event_names[name],id,node_str,len);
 688     }
 689 }
 690
 691 //@cindex DumpGranInfo
 692 void
 693 DumpEndEvent(proc, tso, mandatory_thread)
 694 PEs proc;
 695 StgTSO *tso;
 696 rtsBool mandatory_thread;
 697 {
 698   FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
 699   char time_string[TIME_STR_LEN];
 700 # if defined(GRAN)
 701   ullong_format_string(TIME_ON_PROC(proc),
 702                        time_string, rtsFalse/*no commas!*/);
 703 # elif defined(PAR)
 704   ullong_format_string(CURRENT_TIME,
 705                        time_string, rtsFalse/*no commas!*/);
 706 # endif
 707
 708   output_file = gr_file;
 709   ASSERT(output_file!=NULL);
 710 #if defined(GRAN)
 711     if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 712       return;
 713 #endif
 714
 715     if (BINARY_STATS) {
 716     barf("binary log files not yet supported");
 717 #if 0
 718         grputw(GR_END);
 719         grputw(proc);
 720         abort(); /* die please: a single word doesn't represent long long times */
 721         grputw(CURRENT_TIME); /* this line is bound to fail */
 722         grputw(tso->id);
 723 #ifdef PAR
 724         grputw(0);
 725         grputw(0);
 726         grputw(0);
 727         grputw(0);
 728         grputw(0);
 729         grputw(0);
 730         grputw(0);
 731         grputw(0);
 732         grputw(0);
 733         grputw(0);
 734         grputw(0);
 735         grputw(0);
 736 #else
 737         grputw(tso->gran.sparkname);
 738         grputw(tso->gran.startedat);
 739         grputw(tso->gran.exported);
 740         grputw(tso->gran.basicblocks);
 741         grputw(tso->gran.allocs);
 742         grputw(tso->gran.exectime);
 743         grputw(tso->gran.blocktime);
 744         grputw(tso->gran.blockcount);
 745         grputw(tso->gran.fetchtime);
 746         grputw(tso->gran.fetchcount);
 747         grputw(tso->gran.localsparks);
 748         grputw(tso->gran.globalsparks);
 749 #endif
 750         grputw(mandatory_thread);
 751 #endif /* 0 */
 752     } else {
 753
 754         /*
 755          * NB: DumpGranEvent cannot be used because PE may be wrong
 756          * (as well as the extra info)
 757          */
 758         fprintf(output_file, "PE %2u [%s]: END %lx, SN %u, ST %lu, EXP %s, BB %u, HA %u, RT %u, BT %u (%u), FT %u (%u), LS %u, GS %u, MY %s\n"
 759           ,proc
 760           ,time_string
 761           ,tso->id
 762 #if defined(GRAN)
 763           ,tso->gran.sparkname
 764           ,tso->gran.startedat
 765           ,((tso->gran.exported) ? 'T' : 'F')
 766           ,tso->gran.basicblocks
 767           ,tso->gran.allocs
 768           ,tso->gran.exectime
 769           ,tso->gran.blocktime
 770           ,tso->gran.blockcount
 771           ,tso->gran.fetchtime
 772           ,tso->gran.fetchcount
 773           ,tso->gran.localsparks
 774           ,tso->gran.globalsparks
 775 #elif defined(PAR)
 776           ,tso->par.sparkname
 777           ,tso->par.startedat
 778           ,(tso->par.exported) ? "T" : "F"
 779           ,tso->par.basicblocks
 780           ,tso->par.allocs
 781           ,tso->par.exectime
 782           ,tso->par.blocktime
 783           ,tso->par.blockcount
 784           ,tso->par.fetchtime
 785           ,tso->par.fetchcount
 786           ,tso->par.localsparks
 787           ,tso->par.globalsparks
 788 #endif
 789           ,(mandatory_thread ? "T" : "F")
 790           );
 791     }
 792 }
 793
 794 //@cindex DumpTSO
 795 void
 796 DumpTSO(tso)
 797 StgTSO *tso;
 798 {
 799   FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
 800
 801   output_file = gr_file;
 802   ASSERT(output_file!=NULL);
 803   fprintf(stderr,"TSO 0x%lx, NAME 0x%lx, ID %u, LINK 0x%lx, TYPE %s\n"
 804           ,tso
 805 #if defined(GRAN)
 806           ,tso->gran.sparkname
 807 #elif defined(PAR)
 808           ,tso->par.sparkname
 809 #endif
 810           ,tso->id
 811           ,tso->link
 812           ,/*tso->state==T_MAIN?"MAIN":
 813            TSO_TYPE(tso)==T_FAIL?"FAIL":
 814            TSO_TYPE(tso)==T_REQUIRED?"REQUIRED":
 815            TSO_TYPE(tso)==T_ADVISORY?"ADVISORY":
 816            */
 817            "???"
 818           );
 819
 820   fprintf(output_file,"TSO %lx: SN %u, ST %u, GBL %c, BB %u, HA %u, RT %u, BT %u (%u), FT %u (%u) LS %u, GS %u\n"
 821           ,tso->id
 822 #if defined(GRAN)
 823           ,tso->gran.sparkname
 824           ,tso->gran.startedat
 825           ,tso->gran.exported?'T':'F'
 826           ,tso->gran.basicblocks
 827           ,tso->gran.allocs
 828           ,tso->gran.exectime
 829           ,tso->gran.blocktime
 830           ,tso->gran.blockcount
 831           ,tso->gran.fetchtime
 832           ,tso->gran.fetchcount
 833           ,tso->gran.localsparks
 834           ,tso->gran.globalsparks
 835 #elif defined(PAR)
 836           ,tso->par.sparkname
 837           ,tso->par.startedat
 838           ,tso->par.exported?'T':'F'
 839           ,tso->par.basicblocks
 840           ,tso->par.allocs
 841           ,tso->par.exectime
 842           ,tso->par.blocktime
 843           ,tso->par.blockcount
 844           ,tso->par.fetchtime
 845           ,tso->par.fetchcount
 846           ,tso->par.localsparks
 847           ,tso->par.globalsparks
 848 #endif
 849           );
 850 }
 851
 852 #if 0
 853 /*
 854   ToDo: fix binary output of log files, and support new log file format.
 855 */
 856 /*
 857    Output a terminate event and an 8-byte time.
 858 */
 859
 860 //@cindex grterminate
 861 void
 862 grterminate(v)
 863 rtsTime v;
 864 {
 865   if (!BINARY_STATS)
 866     barf("grterminate: binary statistics not enabled\n");
 867
 868 # if defined(GRAN)
 869     if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 870       return;
 871 # endif
 872
 873     DumpGranEvent(GR_TERMINATE, stgCast(StgTSO*,&stg_END_TSO_QUEUE_closure));
 874
 875     if (sizeof(rtsTime) == 4) {
 876       putc('\0', gr_file);
 877       putc('\0', gr_file);
 878       putc('\0', gr_file);
 879       putc('\0', gr_file);
 880     } else {
 881       putc(v >> 56l, gr_file);
 882       putc((v >> 48l) & 0xffl, gr_file);
 883       putc((v >> 40l) & 0xffl, gr_file);
 884       putc((v >> 32l) & 0xffl, gr_file);
 885     }
 886     putc((v >> 24l) & 0xffl, gr_file);
 887     putc((v >> 16l) & 0xffl, gr_file);
 888     putc((v >> 8l) & 0xffl, gr_file);
 889     putc(v & 0xffl, gr_file);
 890 }
 891
 892 /*
 893    Length-coded output: first 3 bits contain length coding
 894
 895      00x        1 byte
 896      01x        2 bytes
 897      10x        4 bytes
 898      110        8 bytes
 899      111        5 or 9 bytes
 900 */
 901
 902 //@cindex grputw
 903 void
 904 grputw(v)
 905 rtsTime v;
 906 {
 907   if (!BINARY_STATS)
 908     barf("grputw: binary statistics not enabled\n");
 909
 910 # if defined(GRAN)
 911     if (RtsFlags.GranFlags.GranSimStats.Suppressed)
 912       return;
 913 # endif
 914
 915     if (v <= 0x3fl) {                           /* length v = 1 byte */
 916         fputc(v & 0x3f, gr_file);
 917     } else if (v <= 0x3fffl) {                  /* length v = 2 byte */
 918         fputc((v >> 8l) | 0x40l, gr_file);
 919         fputc(v & 0xffl, gr_file);
 920     } else if (v <= 0x3fffffffl) {              /* length v = 4 byte */
 921         fputc((v >> 24l) | 0x80l, gr_file);
 922         fputc((v >> 16l) & 0xffl, gr_file);
 923         fputc((v >> 8l) & 0xffl, gr_file);
 924         fputc(v & 0xffl, gr_file);
 925     } else if (sizeof(TIME) == 4) {
 926         fputc(0x70, gr_file);
 927         fputc((v >> 24l) & 0xffl, gr_file);
 928         fputc((v >> 16l) & 0xffl, gr_file);
 929         fputc((v >> 8l) & 0xffl, gr_file);
 930         fputc(v & 0xffl, gr_file);
 931     } else {
 932         if (v <= 0x3fffffffffffffl)
 933             putc((v >> 56l) | 0x60l, gr_file);
 934         else {
 935             putc(0x70, gr_file);
 936             putc((v >> 56l) & 0xffl, gr_file);
 937         }
 938
 939         putc((v >> 48l) & 0xffl, gr_file);
 940         putc((v >> 40l) & 0xffl, gr_file);
 941         putc((v >> 32l) & 0xffl, gr_file);
 942         putc((v >> 24l) & 0xffl, gr_file);
 943         putc((v >> 16l) & 0xffl, gr_file);
 944         putc((v >> 8l) & 0xffl, gr_file);
 945         putc(v & 0xffl, gr_file);
 946     }
 947 }
 948 #endif /* 0 */
 949
 950 /*
 951    extracting specific info out of a closure; used in packing (GranSim, GUM)
 952 */
 953 //@cindex get_closure_info
 954 StgInfoTable*
 955 get_closure_info(StgClosure* node, nat *size, nat *ptrs, nat *nonptrs,
 956                  nat *vhs, char *info_hdr_ty)
 957 {
 958   StgInfoTable *info;
 959
 960   ASSERT(LOOKS_LIKE_COOL_CLOSURE(node));
 961   info = get_itbl(node);
 962   /* the switch shouldn't be necessary, really; just use default case */
 963   switch (info->type) {
 964   case RBH:
 965     {
 966       StgInfoTable *rip = REVERT_INFOPTR(info); // closure to revert to
 967       *size = sizeW_fromITBL(rip);
 968       *ptrs = (nat) (rip->layout.payload.ptrs);
 969       *nonptrs = (nat) (rip->layout.payload.nptrs);
 970       *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
 971 #if 0 /* DEBUG */
 972       info_hdr_type(node, info_hdr_ty);
 973 #else
 974       strcpy(info_hdr_ty, "RBH");
 975 #endif
 976       return rip;  // NB: we return the reverted info ptr for a RBH!!!!!!
 977     }
 978
 979 #if defined(PAR)
 980   /* Closures specific to GUM */
 981   case FETCH_ME:
 982     *size = sizeofW(StgFetchMe);
 983     *ptrs = (nat)0;
 984     *nonptrs = (nat)0;
 985     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
 986 #if 0 /* DEBUG */
 987     info_hdr_type(node, info_hdr_ty);
 988 #else
 989     strcpy(info_hdr_ty, "FETCH_ME");
 990 #endif
 991     return info;
 992
 993 #ifdef DIST
 994   case REMOTE_REF: //same as for FETCH_ME...
 995     *size = sizeofW(StgFetchMe);
 996     *ptrs = (nat)0;
 997     *nonptrs = (nat)0;
 998     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
 999 #if 0 /* DEBUG */
1000     info_hdr_type(node, info_hdr_ty);
1001 #else
1002     strcpy(info_hdr_ty, "REMOTE_REF");
1003 #endif
1004     return info;
1005 #endif DIST
1006
1007   case FETCH_ME_BQ:
1008     *size = sizeofW(StgFetchMeBlockingQueue);
1009     *ptrs = (nat)0;
1010     *nonptrs = (nat)0;
1011     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1012 #if 0 /* DEBUG */
1013     info_hdr_type(node, info_hdr_ty);
1014 #else
1015     strcpy(info_hdr_ty, "FETCH_ME_BQ");
1016 #endif
1017     return info;
1018
1019   case BLOCKED_FETCH:
1020     *size = sizeofW(StgBlockedFetch);
1021     *ptrs = (nat)0;
1022     *nonptrs = (nat)0;
1023     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1024 #if 0 /* DEBUG */
1025     info_hdr_type(node, info_hdr_ty);
1026 #else
1027     strcpy(info_hdr_ty, "BLOCKED_FETCH");
1028 #endif
1029     return info;
1030 #endif /* PAR */
1031
1032   /* these magic constants are outrageous!! why does the ITBL lie about it? */
1033   case THUNK_SELECTOR:
1034     *size = THUNK_SELECTOR_sizeW();
1035     *ptrs = 1;
1036     *nonptrs = MIN_UPD_SIZE-*ptrs;   // weird
1037     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1038     return info;
1039
1040   case ARR_WORDS:
1041     /* ToDo: check whether this can be merged with the default case */
1042     *size = arr_words_sizeW((StgArrWords *)node);
1043     *ptrs = 0;
1044     *nonptrs = ((StgArrWords *)node)->words;
1045     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1046     return info;
1047
1048   case PAP:
1049     /* ToDo: check whether this can be merged with the default case */
1050     *size = pap_sizeW((StgPAP *)node);
1051     *ptrs = 0;
1052     *nonptrs = 0;
1053     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1054     return info;
1055
1056   case AP_UPD:
1057     /* ToDo: check whether this can be merged with the default case */
1058     *size = AP_sizeW(((StgAP_UPD *)node)->n_args);
1059     *ptrs = 0;
1060     *nonptrs = 0;
1061     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1062     return info;
1063
1064   default:
1065     *size = sizeW_fromITBL(info);
1066     *ptrs = (nat) (info->layout.payload.ptrs);
1067     *nonptrs = (nat) (info->layout.payload.nptrs);
1068     *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
1069 #if 0 /* DEBUG */
1070       info_hdr_type(node, info_hdr_ty);
1071 #else
1072       strcpy(info_hdr_ty, "UNKNOWN");
1073 #endif
1074     return info;
1075   }
1076 }
1077
1078 //@cindex IS_BLACK_HOLE
1079 rtsBool
1080 IS_BLACK_HOLE(StgClosure* node)
1081 {
1082   // StgInfoTable *info;
1083   ASSERT(LOOKS_LIKE_COOL_CLOSURE(node));
1084   switch (get_itbl(node)->type) {
1085   case BLACKHOLE:
1086   case BLACKHOLE_BQ:
1087   case RBH:
1088   case FETCH_ME:
1089   case FETCH_ME_BQ:
1090     return rtsTrue;
1091   default:
1092     return rtsFalse;
1093   }
1094 //return ((info->type == BLACKHOLE || info->type == RBH) ? rtsTrue : rtsFalse);
1095 }
1096
1097 //@cindex IS_INDIRECTION
1098 StgClosure *
1099 IS_INDIRECTION(StgClosure* node)
1100 {
1101   StgInfoTable *info;
1102   ASSERT(LOOKS_LIKE_COOL_CLOSURE(node));
1103   info = get_itbl(node);
1104   switch (info->type) {
1105     case IND:
1106     case IND_OLDGEN:
1107     case IND_PERM:
1108     case IND_OLDGEN_PERM:
1109     case IND_STATIC:
1110       /* relies on indirectee being at same place for all these closure types */
1111       return (((StgInd*)node) -> indirectee);
1112 #if 0
1113     case EVACUATED:           // counting as ind to use in GC routines, too
1114       // could use the same code as above (evacuee is at same pos as indirectee)
1115       return (((StgEvacuated *)node) -> evacuee);
1116 #endif
1117     default:
1118       return NULL;
1119   }
1120 }
1121
1122 //@cindex unwindInd
1123 StgClosure *
1124 UNWIND_IND (StgClosure *closure)
1125 {
1126   StgClosure *next;
1127
1128   while ((next = IS_INDIRECTION((StgClosure *)closure)) != NULL)
1129     closure = next;
1130
1131   ASSERT(next==(StgClosure *)NULL);
1132   ASSERT(LOOKS_LIKE_COOL_CLOSURE(closure));
1133   return closure;
1134 }
1135
1136 #endif /* GRAN || PAR   whole file */