ghc/rts/parallel/Parallel.c

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