ghc/runtime/main/GranSim.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[GranSim.lc]{Granularity Simulator Routines}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 Macros for dealing with the new and improved GA field for simulating
  11 parallel execution. Based on @CONCURRENT@ package. The GA field now
  12 contains a mask, where the n-th bit stands for the n-th processor,
  13 where this data can be found. In case of multiple copies, several bits
  14 are set. The total number of processors is bounded by @MAX_PROC@,
  15 which should be <= the length of a word in bits.  -- HWL
  16
  17 \begin{code}
  18 #if defined(GRAN) || defined(PAR)
  19
  20 #define NON_POSIX_SOURCE    /* gettimeofday */
  21
  22 #include "rtsdefs.h"
  23
  24
  25 #ifdef HAVE_GETCLOCK
  26
  27 #ifdef HAVE_SYS_TIMERS_H
  28 #define POSIX_4D9 1
  29 #include <sys/timers.h>
  30 #endif
  31
  32 #else
  33 #ifdef HAVE_GETTIMEOFDAY
  34
  35 #ifdef HAVE_SYS_TIME_H
  36 #include <sys/time.h>
  37 #endif
  38
  39 #else
  40
  41 #ifdef HAVE_TIME_H
  42 #include <time.h>
  43 #endif
  44
  45 #endif
  46 #endif
  47
  48 void grputw PROTO((TIME v));
  49
  50 #if defined(GRAN)
  51 /* Pointer to the event queue; events are currently malloc'ed */
  52 static eventq EventHd = NULL;
  53
  54 PROC
  55 ga_to_proc(W_ ga)
  56 {
  57     PROC i;
  58
  59     for (i = 0; i < MAX_PROC && !IS_LOCAL_TO(ga, i); i++);
  60
  61     return (i);
  62 }
  63
  64 /* NB: This takes a *node* rather than just a ga as input */
  65 PROC
  66 where_is(P_ node)
  67 { return (ga_to_proc(PROCS(node))); }   /* Access the GA field of the node */
  68
  69 #if 0
  70 PROC
  71 no_of_copies(W_ ga)     /* DaH lo'lu'Qo'; currently unused */
  72 {
  73     PROC i, n;
  74
  75     for (i = 0, n = 0; i < MAX_PROC; i++)
  76         if (IS_LOCAL_TO(ga, i))
  77             n++;;
  78
  79     return (n);
  80 }
  81 #endif
  82
  83 eventq
  84 getnextevent()
  85 {
  86   static eventq entry = NULL;
  87
  88   if(EventHd == NULL)
  89     {
  90       fprintf(stderr,"No next event\n");
  91       exit(EXIT_FAILURE); /* why not EXIT??? WDP 95/07 */
  92     }
  93
  94   if(entry != NULL)
  95     free((char *)entry);
  96
  97 #if defined(GRAN_CHECK) && defined(GRAN)
  98   if (debug & 0x20) {     /* count events */
  99     noOfEvents++;
 100     event_counts[(EVENT_TYPE(EventHd)>=CONTINUETHREAD1) ?
 101                    CONTINUETHREAD :
 102                    EVENT_TYPE(EventHd)]++;
 103   }
 104 #endif
 105
 106   entry = EventHd;
 107   EventHd = EVENT_NEXT(EventHd);
 108   return(entry);
 109 }
 110
 111 /* ToDo: replace malloc/free with a free list */
 112
 113 /* NB: newevent unused (WDP 95/07) */
 114
 115 static
 116 newevent(proc,creator,time,evttype,tso,node,spark)
 117   PROC proc, creator;
 118   TIME time;
 119   EVTTYPE evttype;
 120   P_ tso, node;
 121   sparkq spark;
 122 {
 123   eventq newentry = (eventq) xmalloc(sizeof(struct event));
 124
 125   EVENT_PROC(newentry) = proc;
 126   EVENT_CREATOR(newentry) = creator;
 127   EVENT_TIME(newentry) = time;
 128   EVENT_TYPE(newentry) = evttype;
 129   EVENT_TSO(newentry) =  tso;
 130   EVENT_NODE(newentry) =  node;
 131   EVENT_SPARK(newentry) =  spark;
 132   EVENT_NEXT(newentry) = NULL;
 133
 134   insert_event(newentry);
 135 }
 136
 137 #endif /* GRAN ; HWL */
 138 \end{code}
 139
 140 %****************************************************************************
 141 %
 142 \subsection[GrAnSim-profile]{Writing profiling info for GrAnSim}
 143 %
 144 %****************************************************************************
 145
 146 Event dumping routines.
 147
 148 \begin{code}
 149
 150 FILE *gr_file = NULL;
 151
 152 char *gran_event_names[] = {
 153     "START", "START(Q)",
 154     "STEALING", "STOLEN", "STOLEN(Q)",
 155     "FETCH", "REPLY", "BLOCK", "RESUME", "RESUME(Q)",
 156     "SCHEDULE", "DESCHEDULE",
 157     "END",
 158     "SPARK", "SPARKAT", "USED", "PRUNED", "EXPORTED", "ACQUIRED",
 159     "TERMINATE",
 160     "??"
 161 };
 162
 163 /*
 164  * If you're not using GNUC and you're on a 32-bit machine, you're
 165  * probably out of luck here.  However, since CONCURRENT currently
 166  * requires GNUC, I'm not too worried about it.  --JSM
 167  */
 168
 169 #if !defined(GRAN)
 170
 171 static ullong startTime = 0;
 172
 173 ullong
 174 msTime(STG_NO_ARGS)
 175 {
 176 # ifdef HAVE_GETCLOCK
 177     struct timespec tv;
 178
 179     if (getclock(TIMEOFDAY, &tv) != 0) {
 180         fflush(stdout);
 181         fprintf(stderr, "Clock failed\n");
 182         EXIT(EXIT_FAILURE);
 183     }
 184     return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
 185 # else
 186 # ifdef HAVE_GETTIMEOFDAY
 187     struct timeval tv;
 188
 189     if (gettimeofday(&tv, NULL) != 0) {
 190         fflush(stdout);
 191         fprintf(stderr, "Clock failed\n");
 192         EXIT(EXIT_FAILURE);
 193     }
 194     return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
 195 # else
 196     time_t t;
 197     if ((t = time(NULL)) == (time_t) -1) {
 198         fflush(stdout);
 199         fprintf(stderr, "Clock failed\n");
 200         EXIT(EXIT_FAILURE);
 201     }
 202     return t * LL(1000);
 203 # endif
 204 # endif
 205 }
 206
 207 #endif /* !GRAN */
 208
 209
 210 void
 211 DumpGranEvent(name, tso)
 212 enum gran_event_types name;
 213 P_ tso;
 214 {
 215     DumpRawGranEvent(CURRENT_PROC, name, TSO_ID(tso));
 216 }
 217
 218 void
 219 DumpSparkGranEvent(name, id)
 220 enum gran_event_types name;
 221 W_ id;
 222 {
 223     DumpRawGranEvent(CURRENT_PROC, name, id);
 224 }
 225
 226 void
 227 DumpGranEventAndNode(name, tso, node, proc)
 228 enum gran_event_types name;
 229 P_ tso, node;
 230 PROC proc;
 231 {
 232     PROC pe = CURRENT_PROC;
 233     W_ id;
 234
 235     char time_string[500]; /*ToDo: kill magic constant */
 236     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 237
 238 #ifdef PAR
 239     id = tso == NULL ? -1 : TSO_ID(tso);
 240 #else
 241     id = TSO_ID(tso);
 242 #endif
 243     if (name > GR_EVENT_MAX)
 244         name = GR_EVENT_MAX;
 245
 246     if (do_gr_binary) {
 247         grputw(name);
 248         grputw(pe);
 249         abort(); /* die please: a single word doesn't represent long long times */
 250         grputw(CURRENT_TIME); /* this line is bound to do the wrong thing */
 251         grputw(id);
 252     } else
 253         fprintf(gr_file, "PE %2u [%s]: %s %lx \t0x%lx\t(from %2u)\n",
 254           pe, time_string, gran_event_names[name], id, (W_) node, proc);
 255 }
 256
 257 void
 258 DumpRawGranEvent(pe, name, id)
 259 PROC pe;
 260 enum gran_event_types name;
 261 W_ id;
 262 {
 263     char time_string[500]; /* ToDo: kill magic constant */
 264
 265     if (name > GR_EVENT_MAX)
 266         name = GR_EVENT_MAX;
 267
 268     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 269
 270     if (do_gr_binary) {
 271         grputw(name);
 272         grputw(pe);
 273         abort(); /* die please: a single word doesn't represent long long times */
 274         grputw(CURRENT_TIME); /* this line is bound to fail */
 275         grputw(id);
 276     } else
 277         fprintf(gr_file, "PE %2u [%s]: %s %lx\n",
 278           pe, time_string, gran_event_names[name], id);
 279 }
 280
 281 void
 282 DumpGranInfo(pe, tso, mandatory_thread)
 283 PROC pe;
 284 P_ tso;
 285 rtsBool mandatory_thread;
 286 {
 287     char time_string[500]; /* ToDo: kill magic constant */
 288     ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
 289
 290     if (do_gr_binary) {
 291         grputw(GR_END);
 292         grputw(pe);
 293         abort(); /* die please: a single word doesn't represent long long times */
 294         grputw(CURRENT_TIME); /* this line is bound to fail */
 295         grputw(TSO_ID(tso));
 296 #ifdef PAR
 297         grputw(0);
 298         grputw(0);
 299         grputw(0);
 300         grputw(0);
 301         grputw(0);
 302         grputw(0);
 303         grputw(0);
 304         grputw(0);
 305         grputw(0);
 306         grputw(0);
 307         grputw(0);
 308         grputw(0);
 309 #else
 310         grputw(TSO_SPARKNAME(tso));
 311         grputw(TSO_STARTEDAT(tso));
 312         grputw(TSO_EXPORTED(tso));
 313         grputw(TSO_BASICBLOCKS(tso));
 314         grputw(TSO_ALLOCS(tso));
 315         grputw(TSO_EXECTIME(tso));
 316         grputw(TSO_BLOCKTIME(tso));
 317         grputw(TSO_BLOCKCOUNT(tso));
 318         grputw(TSO_FETCHTIME(tso));
 319         grputw(TSO_FETCHCOUNT(tso));
 320         grputw(TSO_LOCALSPARKS(tso));
 321         grputw(TSO_GLOBALSPARKS(tso));
 322 #endif
 323         grputw(mandatory_thread);
 324     } else {
 325
 326         /*
 327          * NB: DumpGranEvent cannot be used because PE may be wrong (as well as the
 328          * extra info)
 329          */
 330         fprintf(gr_file, "PE %2u [%s]: END %lx, SN %lu, ST %lu, EXP %c, BB %lu, HA %lu, RT %lu, BT %lu (%lu), FT %lu (%lu), LS %lu, GS %lu, MY %c\n"
 331           ,pe
 332           ,time_string
 333           ,TSO_ID(tso)
 334           ,TSO_SPARKNAME(tso)
 335           ,TSO_STARTEDAT(tso)
 336           ,TSO_EXPORTED(tso) ? 'T' : 'F'
 337           ,TSO_BASICBLOCKS(tso)
 338           ,TSO_ALLOCS(tso)
 339           ,TSO_EXECTIME(tso)
 340           ,TSO_BLOCKTIME(tso)
 341           ,TSO_BLOCKCOUNT(tso)
 342           ,TSO_FETCHTIME(tso)
 343           ,TSO_FETCHCOUNT(tso)
 344           ,TSO_LOCALSPARKS(tso)
 345           ,TSO_GLOBALSPARKS(tso)
 346           ,mandatory_thread ? 'T' : 'F'
 347           );
 348     }
 349 }
 350
 351 /*
 352    Output a terminate event and an 8-byte time.
 353 */
 354
 355 void
 356 grterminate(v)
 357 TIME v;
 358 {
 359     DumpGranEvent(GR_TERMINATE, 0);
 360
 361     if (sizeof(TIME) == 4) {
 362         putc('\0', gr_file);
 363         putc('\0', gr_file);
 364         putc('\0', gr_file);
 365         putc('\0', gr_file);
 366     } else {
 367         putc(v >> 56l, gr_file);
 368         putc((v >> 48l) & 0xffl, gr_file);
 369         putc((v >> 40l) & 0xffl, gr_file);
 370         putc((v >> 32l) & 0xffl, gr_file);
 371     }
 372     putc((v >> 24l) & 0xffl, gr_file);
 373     putc((v >> 16l) & 0xffl, gr_file);
 374     putc((v >> 8l) & 0xffl, gr_file);
 375     putc(v & 0xffl, gr_file);
 376 }
 377
 378 /*
 379    Length-coded output: first 3 bits contain length coding
 380
 381      00x        1 byte
 382      01x        2 bytes
 383      10x        4 bytes
 384      110        8 bytes
 385      111        5 or 9 bytes
 386 */
 387
 388 void
 389 grputw(v)
 390 TIME v;
 391 {
 392     if (v <= 0x3fl) {
 393         fputc(v & 0x3f, gr_file);
 394     } else if (v <= 0x3fffl) {
 395         fputc((v >> 8l) | 0x40l, gr_file);
 396         fputc(v & 0xffl, gr_file);
 397     } else if (v <= 0x3fffffffl) {
 398         fputc((v >> 24l) | 0x80l, gr_file);
 399         fputc((v >> 16l) & 0xffl, gr_file);
 400         fputc((v >> 8l) & 0xffl, gr_file);
 401         fputc(v & 0xffl, gr_file);
 402     } else if (sizeof(TIME) == 4) {
 403         fputc(0x70, gr_file);
 404         fputc((v >> 24l) & 0xffl, gr_file);
 405         fputc((v >> 16l) & 0xffl, gr_file);
 406         fputc((v >> 8l) & 0xffl, gr_file);
 407         fputc(v & 0xffl, gr_file);
 408     } else {
 409         if (v <= 0x3fffffffffffffl)
 410             putc((v >> 56l) | 0x60l, gr_file);
 411         else {
 412             putc(0x70, gr_file);
 413             putc((v >> 56l) & 0xffl, gr_file);
 414         }
 415
 416         putc((v >> 48l) & 0xffl, gr_file);
 417         putc((v >> 40l) & 0xffl, gr_file);
 418         putc((v >> 32l) & 0xffl, gr_file);
 419         putc((v >> 24l) & 0xffl, gr_file);
 420         putc((v >> 16l) & 0xffl, gr_file);
 421         putc((v >> 8l) & 0xffl, gr_file);
 422         putc(v & 0xffl, gr_file);
 423     }
 424 }
 425
 426 \end{code}
 427
 428 %****************************************************************************
 429 %
 430 \subsection[gr-simulation]{Granularity Simulation}
 431 %
 432 %****************************************************************************
 433
 434 \begin{code}
 435 #ifdef GRAN
 436 char gr_filename[32]; /*ToDo: magic short filename constant????? WDP 95/07 */
 437 I_ do_gr_sim = 0;
 438
 439 int
 440 init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv)
 441 char *prog_argv[], *rts_argv[];
 442 int prog_argc, rts_argc;
 443 {
 444     I_ i;
 445
 446     if (do_gr_sim) {
 447         char *extension = do_gr_binary ? "gb" : "gr";
 448
 449         sprintf(gr_filename, "%0.28s.%0.2s", prog_argv[0], extension);
 450
 451         if ((gr_file = fopen(gr_filename, "w")) == NULL) {
 452             fprintf(stderr, "Can't open granularity simulation report file %s\n", gr_filename);
 453             exit(EXIT_FAILURE); /* why not EXIT??? WDP 95/07 */
 454         }
 455 #if defined(GRAN_CHECK) && defined(GRAN)
 456         if (DoReScheduleOnFetch)
 457             setbuf(gr_file, NULL);
 458 #endif
 459
 460         fputs("Granularity Simulation for ", gr_file);
 461         for (i = 0; i < prog_argc; ++i) {
 462             fputs(prog_argv[i], gr_file);
 463             fputc(' ', gr_file);
 464         }
 465
 466         if (rts_argc > 0) {
 467             fputs("+RTS ", gr_file);
 468
 469             for (i = 0; i < rts_argc; ++i) {
 470                 fputs(rts_argv[i], gr_file);
 471                 fputc(' ', gr_file);
 472             }
 473         }
 474         fputs("\n\n--------------------\n\n", gr_file);
 475
 476         fputs("General Parameters:\n\n", gr_file);
 477
 478         fprintf(gr_file, "PEs %u, %s Scheduler, %sMigrate Threads%s ????? %s\n",
 479           max_proc, DoFairSchedule ? "Fair" : "Unfair",
 480           DoThreadMigration ? "" : "Don't ",
 481           DoThreadMigration && DoStealThreadsFirst ? " Before Sparks" : "",
 482           DoReScheduleOnFetch ? "" : "Don't ");
 483
 484         fprintf(gr_file, "%s, Fetch %s in Each Packet\n",
 485           SimplifiedFetch ? "Simplified Fetch" : (DoReScheduleOnFetch ? "Reschedule on Fetch" : "Block on Fetch"),
 486           DoGUMMFetching ? "Many Closures" : "Exactly One Closure");
 487         fprintf(gr_file, "Fetch Strategy(%lu): If outstanding fetches %s\n",
 488           FetchStrategy,
 489           FetchStrategy == 1 ? "only run runnable threads (don't create new ones" :
 490           FetchStrategy == 2 ? "create threads only from local sparks" :
 491           FetchStrategy == 3 ? "create threads from local or global sparks" :
 492           FetchStrategy == 4 ? "create sparks and steal threads if necessary" :
 493           "unknown");
 494
 495         fprintf(gr_file, "Thread Creation Time %lu, Thread Queue Time %lu\n",
 496           gran_threadcreatetime, gran_threadqueuetime);
 497         fprintf(gr_file, "Thread DeSchedule Time %lu, Thread Schedule Time %lu\n",
 498           gran_threaddescheduletime, gran_threadscheduletime);
 499         fprintf(gr_file, "Thread Context-Switch Time %lu\n",
 500           gran_threadcontextswitchtime);
 501         fputs("\n\n--------------------\n\n", gr_file);
 502
 503         fputs("Communication Metrics:\n\n", gr_file);
 504         fprintf(gr_file,
 505           "Latency %lu (1st) %lu (rest), Fetch %lu, Notify %lu (Global) %lu (Local)\n",
 506           gran_latency, gran_additional_latency, gran_fetchtime,
 507           gran_gunblocktime, gran_lunblocktime);
 508         fprintf(gr_file,
 509           "Message Creation %lu (+ %lu after send), Message Read %lu\n",
 510           gran_mpacktime, gran_mtidytime, gran_munpacktime);
 511         fputs("\n\n--------------------\n\n", gr_file);
 512
 513         fputs("Instruction Metrics:\n\n", gr_file);
 514         fprintf(gr_file, "Arith %lu, Branch %lu, Load %lu, Store %lu, Float %lu, Alloc %lu\n",
 515           gran_arith_cost, gran_branch_cost,
 516           gran_load_cost, gran_store_cost, gran_float_cost, gran_heapalloc_cost);
 517         fputs("\n\n++++++++++++++++++++\n\n", gr_file);
 518     }
 519     if (do_gr_binary)
 520         grputw(sizeof(TIME));
 521
 522     Idlers = max_proc;
 523     return (0);
 524 }
 525
 526 void
 527 end_gr_simulation(STG_NO_ARGS)
 528 {
 529     if (do_gr_sim) {
 530         fprintf(stderr, "The simulation is finished. Look at %s for details.\n",
 531           gr_filename);
 532         fclose(gr_file);
 533     }
 534 }
 535
 536 #endif /* GRAN */
 537
 538 #ifdef PAR
 539 char gr_filename[50]; /*ToDo: (small) magic constant alert!!!! WDP 95/07 */
 540
 541 I_ do_gr_profile = 0;
 542 I_ do_sp_profile = 0;
 543 I_ do_gr_binary = 0;
 544
 545 void
 546 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv)
 547 char *prog_argv[], *rts_argv[];
 548 int prog_argc, rts_argc;
 549 {
 550     int i;
 551
 552     char *extension = do_gr_binary ? "gb" : "gr";
 553
 554     sprintf(gr_filename, "%0.28s.%03d.%0.2s", prog_argv[0], thisPE, extension);
 555
 556     if ((gr_file = fopen(gr_filename, "w")) == NULL) {
 557         fprintf(stderr, "Can't open activity report file %s\n", gr_filename);
 558         EXIT(EXIT_FAILURE);
 559     }
 560
 561     for (i = 0; i < prog_argc; ++i) {
 562         fputs(prog_argv[i], gr_file);
 563         fputc(' ', gr_file);
 564     }
 565
 566     if (rts_argc > 0) {
 567         fputs("+RTS ", gr_file);
 568
 569         for (i = 0; i < rts_argc; ++i) {
 570             fputs(rts_argv[i], gr_file);
 571             fputc(' ', gr_file);
 572         }
 573     }
 574     fputc('\n', gr_file);
 575
 576     startTime = CURRENT_TIME;
 577
 578     if (startTime > LL(1000000000)) {
 579         /* This shouldn't overflow twice */
 580         fprintf(gr_file, "PE %2u [%lu%lu]: TIME\n", thisPE,
 581             (TIME) (startTime / LL(1000000000)),
 582             (TIME) (startTime % LL(1000000000)));
 583     } else {
 584         fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime);
 585     }
 586
 587     if (do_gr_binary)
 588         grputw(sizeof(TIME));
 589 }
 590 #endif /* PAR */
 591
 592 #endif /* GRAN || PAR */
 593 \end{code}
 594
 595