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