diff options
Diffstat (limited to 'ghc/rts/parallel/Parallel.c')
| -rw-r--r-- | ghc/rts/parallel/Parallel.c | 1140 |
1 files changed, 0 insertions, 1140 deletions
diff --git a/ghc/rts/parallel/Parallel.c b/ghc/rts/parallel/Parallel.c deleted file mode 100644 index 414b7e4406..0000000000 --- a/ghc/rts/parallel/Parallel.c +++ /dev/null @@ -1,1140 +0,0 @@ -/* - Time-stamp: <Wed Mar 21 2001 16:42:40 Stardate: [-30]6363.48 hwloidl> - - Basic functions for use in either GranSim or GUM. -*/ - -#if defined(GRAN) || defined(PAR) /* whole file */ - -//@menu -//* Includes:: -//* Variables and constants:: -//* Writing to the log-file:: -//* Global statistics:: -//* Dumping routines:: -//@end menu -//*/ fool highlight - -//@node Includes, Variables and constants -//@subsection Includes - -#include "Rts.h" -#include "RtsFlags.h" -#include "RtsUtils.h" -#include "Storage.h" -#include "GranSimRts.h" -#include "ParallelRts.h" - -//@node Variables and constants, Writing to the log-file, Includes -//@subsection Variables and constants - -/* Where to write the log file */ -FILE *gr_file = NULL; -char gr_filename[STATS_FILENAME_MAXLEN]; - -#if defined(PAR) -/* Global statistics */ -GlobalParStats globalParStats; -#endif - -#if defined(PAR) -ullong startTime = 0; -#endif - -#if defined(PAR) && !defined(DEBUG) -// HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACCCCCCCCCKKKKKKKKKKKK -// Definitely the wrong place for info_type in !DEBUG (see Printer.c) -- HWL - -static char *closure_type_names[] = { - "INVALID_OBJECT", /* 0 */ - "CONSTR", /* 1 */ - "CONSTR_1_0", /* 2 */ - "CONSTR_0_1", /* 3 */ - "CONSTR_2_0", /* 4 */ - "CONSTR_1_1", /* 5 */ - "CONSTR_0_2", /* 6 */ - "CONSTR_INTLIKE", /* 7 */ - "CONSTR_CHARLIKE", /* 8 */ - "CONSTR_STATIC", /* 9 */ - "CONSTR_NOCAF_STATIC", /* 10 */ - "FUN", /* 11 */ - "FUN_1_0", /* 12 */ - "FUN_0_1", /* 13 */ - "FUN_2_0", /* 14 */ - "FUN_1_1", /* 15 */ - "FUN_0_2", /* 16 */ - "FUN_STATIC", /* 17 */ - "THUNK", /* 18 */ - "THUNK_1_0", /* 19 */ - "THUNK_0_1", /* 20 */ - "THUNK_2_0", /* 21 */ - "THUNK_1_1", /* 22 */ - "THUNK_0_2", /* 23 */ - "THUNK_STATIC", /* 24 */ - "THUNK_SELECTOR", /* 25 */ - "BCO", /* 26 */ - "AP_UPD", /* 27 */ - "PAP", /* 28 */ - "IND", /* 29 */ - "IND_OLDGEN", /* 30 */ - "IND_PERM", /* 31 */ - "IND_OLDGEN_PERM", /* 32 */ - "IND_STATIC", /* 33 */ - "CAF_UNENTERED", /* 34 */ - "CAF_ENTERED", /* 35 */ - "CAF_BLACKHOLE", /* 36 */ - "RET_BCO", /* 37 */ - "RET_SMALL", /* 38 */ - "RET_VEC_SMALL", /* 39 */ - "RET_BIG", /* 40 */ - "RET_VEC_BIG", /* 41 */ - "RET_DYN", /* 42 */ - "UPDATE_FRAME", /* 43 */ - "CATCH_FRAME", /* 44 */ - "STOP_FRAME", /* 45 */ - "SEQ_FRAME", /* 46 */ - "BLACKHOLE", /* 47 */ - "BLACKHOLE_BQ", /* 48 */ - "SE_BLACKHOLE", /* 49 */ - "SE_CAF_BLACKHOLE", /* 50 */ - "MVAR", /* 51 */ - "ARR_WORDS", /* 52 */ - "MUT_ARR_PTRS", /* 53 */ - "MUT_ARR_PTRS_FROZEN", /* 54 */ - "MUT_VAR", /* 55 */ - "WEAK", /* 56 */ - "FOREIGN", /* 57 */ - "STABLE_NAME", /* 58 */ - "TSO", /* 59 */ - "BLOCKED_FETCH", /* 60 */ - "FETCH_ME", /* 61 */ - "FETCH_ME_BQ", /* 62 */ - "RBH", /* 63 */ - "EVACUATED", /* 64 */ - "REMOTE_REF", /* 65 */ - "N_CLOSURE_TYPES" /* 66 */ -}; - -char * -info_type(StgClosure *closure){ - return closure_type_names[get_itbl(closure)->type]; -} - -char * -info_type_by_ip(StgInfoTable *ip){ - return closure_type_names[ip->type]; -} - -void -info_hdr_type(StgClosure *closure, char *res){ - strcpy(res,closure_type_names[get_itbl(closure)->type]); -} -#endif - -//@node Writing to the log-file, Global statistics, Variables and constants -//@subsection Writing to the log-file -/* - Writing to the log-file - - These routines dump event-based info to the main log-file. - The code for writing log files is shared between GranSim and GUM. -*/ - -/* - * If you're not using GNUC and you're on a 32-bit machine, you're - * probably out of luck here. However, since CONCURRENT currently - * requires GNUC, I'm not too worried about it. --JSM - */ - -//@cindex init_gr_simulation -#if defined(GRAN) -void -init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv) -char *prog_argv[], *rts_argv[]; -int prog_argc, rts_argc; -{ - nat i; - char *extension = RtsFlags.GranFlags.GranSimStats.Binary ? "gb" : "gr"; - - if (RtsFlags.GranFlags.GranSimStats.Global) - init_gr_stats(); - - /* init global constants for costs of basic operations */ - gran_arith_cost = RtsFlags.GranFlags.Costs.arith_cost; - gran_branch_cost = RtsFlags.GranFlags.Costs.branch_cost; - gran_load_cost = RtsFlags.GranFlags.Costs.load_cost; - gran_store_cost = RtsFlags.GranFlags.Costs.store_cost; - gran_float_cost = RtsFlags.GranFlags.Costs.float_cost; - - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; - - if (!RtsFlags.GranFlags.GranSimStats.Full) - return; - - sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension); - - if ((gr_file = fopen(gr_filename, "w")) == NULL) { - barf("Can't open granularity simulation report file %s\n", - gr_filename); - } - - setbuf(gr_file, NULL); /* turn buffering off */ - - /* write header with program name, options and setup to gr_file */ - fputs("Granularity Simulation for ", gr_file); - for (i = 0; i < prog_argc; ++i) { - fputs(prog_argv[i], gr_file); - fputc(' ', gr_file); - } - - if (rts_argc > 0) { - fputs("+RTS ", gr_file); - - for (i = 0; i < rts_argc; ++i) { - fputs(rts_argv[i], gr_file); - fputc(' ', gr_file); - } - } - - fputs("\nStart time: ", gr_file); - fputs(time_str(), gr_file); /* defined in RtsUtils.c */ - fputc('\n', gr_file); - - fputs("\n\n--------------------\n\n", gr_file); - - fputs("General Parameters:\n\n", gr_file); - - if (RtsFlags.GranFlags.Light) - fprintf(gr_file, "GrAnSim-Light\nPEs infinite, %s Scheduler, %sMigrate Threads %s, %s\n", - RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair", - RtsFlags.GranFlags.DoThreadMigration?"":"Don't ", - RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"", - RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" : - "Block on Fetch"); - else - fprintf(gr_file, "PEs %u, %s Scheduler, %sMigrate Threads %s, %s\n", - RtsFlags.GranFlags.proc,RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair", - RtsFlags.GranFlags.DoThreadMigration?"":"Don't ", - RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"", - RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" : - "Block on Fetch"); - - if (RtsFlags.GranFlags.DoBulkFetching) - if (RtsFlags.GranFlags.ThunksToPack) - fprintf(gr_file, "Bulk Fetching: Fetch %d Thunks in Each Packet (Packet Size = %d closures)\n", - RtsFlags.GranFlags.ThunksToPack, - RtsFlags.GranFlags.packBufferSize); - else - fprintf(gr_file, "Bulk Fetching: Fetch as many closures as possible (Packet Size = %d closures)\n", - RtsFlags.GranFlags.packBufferSize); - else - fprintf(gr_file, "Incremental Fetching: Fetch Exactly One Closure in Each Packet\n"); - - fprintf(gr_file, "Fetch Strategy(%u):If outstanding fetches %s\n", - RtsFlags.GranFlags.FetchStrategy, - RtsFlags.GranFlags.FetchStrategy==0 ? - " block (block-on-fetch)": - RtsFlags.GranFlags.FetchStrategy==1 ? - "only run runnable threads": - RtsFlags.GranFlags.FetchStrategy==2 ? - "create threads only from local sparks": - RtsFlags.GranFlags.FetchStrategy==3 ? - "create threads from local or global sparks": - RtsFlags.GranFlags.FetchStrategy==4 ? - "create sparks and steal threads if necessary": - "unknown"); - - if (RtsFlags.GranFlags.DoPrioritySparking) - fprintf(gr_file, "Priority Sparking (i.e. keep sparks ordered by priority)\n"); - - if (RtsFlags.GranFlags.DoPriorityScheduling) - fprintf(gr_file, "Priority Scheduling (i.e. keep threads ordered by priority)\n"); - - fprintf(gr_file, "Thread Creation Time %u, Thread Queue Time %u\n", - RtsFlags.GranFlags.Costs.threadcreatetime, - RtsFlags.GranFlags.Costs.threadqueuetime); - fprintf(gr_file, "Thread DeSchedule Time %u, Thread Schedule Time %u\n", - RtsFlags.GranFlags.Costs.threaddescheduletime, - RtsFlags.GranFlags.Costs.threadscheduletime); - fprintf(gr_file, "Thread Context-Switch Time %u\n", - RtsFlags.GranFlags.Costs.threadcontextswitchtime); - fputs("\n\n--------------------\n\n", gr_file); - - fputs("Communication Metrics:\n\n", gr_file); - fprintf(gr_file, - "Latency %u (1st) %u (rest), Fetch %u, Notify %u (Global) %u (Local)\n", - RtsFlags.GranFlags.Costs.latency, - RtsFlags.GranFlags.Costs.additional_latency, - RtsFlags.GranFlags.Costs.fetchtime, - RtsFlags.GranFlags.Costs.gunblocktime, - RtsFlags.GranFlags.Costs.lunblocktime); - fprintf(gr_file, - "Message Creation %u (+ %u after send), Message Read %u\n", - RtsFlags.GranFlags.Costs.mpacktime, - RtsFlags.GranFlags.Costs.mtidytime, - RtsFlags.GranFlags.Costs.munpacktime); - fputs("\n\n--------------------\n\n", gr_file); - - fputs("Instruction Metrics:\n\n", gr_file); - fprintf(gr_file, "Arith %u, Branch %u, Load %u, Store %u, Float %u, Alloc %u\n", - RtsFlags.GranFlags.Costs.arith_cost, - RtsFlags.GranFlags.Costs.branch_cost, - RtsFlags.GranFlags.Costs.load_cost, - RtsFlags.GranFlags.Costs.store_cost, - RtsFlags.GranFlags.Costs.float_cost, - RtsFlags.GranFlags.Costs.heapalloc_cost); - fputs("\n\n++++++++++++++++++++\n\n", gr_file); - -# if 0 - /* binary log files are currently not supported */ - if (RtsFlags.GranFlags.GranSimStats.Binary) - grputw(sizeof(rtsTime)); -# endif - - return (0); -} - -#elif defined(PAR) - -void init_gr_stats (void); - -void -init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv) -char *prog_argv[], *rts_argv[]; -int prog_argc, rts_argc; -{ - nat i; - char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN]; - char *extension = RtsFlags.ParFlags.ParStats.Binary ? "gb" : "gr"; - - sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension); - - if (!RtsFlags.ParFlags.ParStats.Full) - return; - - if (RtsFlags.ParFlags.ParStats.Global) - init_gr_stats(); - - if ((gr_file = fopen(gr_filename, "w")) == NULL) - barf("Can't open activity report file %s\n", gr_filename); - - setbuf(gr_file, NULL); /* turn buffering off */ - - /* write header with program name, options and setup to gr_file */ - for (i = 0; i < prog_argc; ++i) { - fputs(prog_argv[i], gr_file); - fputc(' ', gr_file); - } - - if (rts_argc > 0) { - fputs("+RTS ", gr_file); - - for (i = 0; i < rts_argc; ++i) { - fputs(rts_argv[i], gr_file); - fputc(' ', gr_file); - } - } - fputc('\n', gr_file); - - /* record the absolute start time to allow synchronisation of log-files */ - fputs("Start-Time: ", gr_file); - fputs(time_str(), gr_file); - fputc('\n', gr_file); - - ASSERT(startTime==0); - // startTime = msTime(); - startTime = CURRENT_TIME; - ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/); - fprintf(gr_file, "PE %2u [%s]: TIME\n", thisPE, time_string); - -# if 0 - ngoq Dogh'q' vImuS - IF_PAR_DEBUG(verbose, - belch("== Start-time: %ld (%s)", - startTime, time_string)); - - if (startTime > LL(1000000000)) { - fprintf(gr_file, "PE %2u [%lu%lu]: TIME\n", thisPE, - (rtsTime) (startTime / LL(1000000000)), - (rtsTime) (startTime % LL(1000000000))); - } else { - fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime); - } - /* binary log files are currently not supported */ - if (RtsFlags.GranFlags.GranSimStats.Binary) - grputw(sizeof(rtsTime)); -# endif - - return; -} - -void -init_gr_stats (void) { - // memset(&globalParStats, '\0', sizeof(GlobalParStats)); - - 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; - globalParStats.cnt_mark_GA = globalParStats.cnt_rebuild_GA = globalParStats.cnt_free_GA = globalParStats.res_free_GA = globalParStats.local_alloc_GA = 0; - - globalParStats.time_mark_GA = 0.0; - globalParStats.time_rebuild_GA = 0.0; - globalParStats.time_sparks = 0.0; - globalParStats.time_pack = 0.0; - - 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; - 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; - - globalParStats.tot_fish_mess = globalParStats.tot_fetch_mess = globalParStats.tot_resume_mess = globalParStats.tot_schedule_mess = 0; - globalParStats.rec_fish_mess = globalParStats.rec_resume_mess = globalParStats.rec_schedule_mess = 0; - globalParStats.rec_fetch_mess = 0; -#if defined(DIST) - globalParStats.tot_reval_mess = 0; - globalParStats.rec_reval_mess = 0; -#endif - - 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; - globalParStats.tot_yields = globalParStats.tot_stackover = globalParStats.tot_heapover = 0; - - globalParStats.tot_arrs = globalParStats.tot_arr_size = 0; -} - -#endif /* PAR */ - -//@cindex end_gr_simulation -#if defined(GRAN) -void -end_gr_simulation(void) -{ - char time_string[TIME_STR_LEN]; - - ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/); - - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; - - /* Print event stats */ - if (RtsFlags.GranFlags.GranSimStats.Global) { - nat i; - - fprintf(stderr,"Total yields: %d\n", - globalGranStats.tot_yields); - - fprintf(stderr,"Total number of threads created: %d ; per PE:\n", - globalGranStats.tot_threads_created); - for (i=0; i<RtsFlags.GranFlags.proc; i++) { - fprintf(stderr," PE %d: %d\t", - i, globalGranStats.threads_created_on_PE[i]); - if (i+1 % 4 == 0) fprintf(stderr,"\n"); - } - if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n"); - fprintf(stderr,"Total number of threads migrated: %d\n", - globalGranStats.tot_TSOs_migrated); - - fprintf(stderr,"Total number of sparks created: %d ; per PE:\n", - globalGranStats.tot_sparks_created); - for (i=0; i<RtsFlags.GranFlags.proc; i++) { - fprintf(stderr," PE %d: %d\t", - i, globalGranStats.sparks_created_on_PE[i]); - if (i+1 % 4 == 0) fprintf(stderr,"\n"); - } - if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n"); - - fprintf(stderr,"Event statistics (number of events: %d):\n", - globalGranStats.noOfEvents); - for (i=0; i<=MAX_EVENT; i++) { - fprintf(stderr," %s (%d): \t%d \t%f%%\t%f%%\n", - event_names[i],i,globalGranStats.event_counts[i], - (float)(100*globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents), - (i==ContinueThread ? 0.0 : - (float)(100*(globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents-globalGranStats.event_counts[ContinueThread])) )); - } - fprintf(stderr,"Randomized steals: %ld sparks, %ld threads \n \t(Sparks: #%u (avg ntimes=%f; avg fl=%f)\n\t(Threads: %ld)", - globalGranStats.rs_sp_count, - globalGranStats.rs_t_count, - globalGranStats.no_of_steals, - (float)globalGranStats.ntimes_total/(float)stg_max(globalGranStats.no_of_steals,1), - (float)globalGranStats.fl_total/(float)stg_max(globalGranStats.no_of_steals,1), - globalGranStats.no_of_migrates); - fprintf(stderr,"Moved sparks: %d Withered sparks: %d (%.2f %%)\n", - globalGranStats.tot_sparks, globalGranStats.withered_sparks, - ( globalGranStats.tot_sparks == 0 ? 0 : - (float)(100*globalGranStats.withered_sparks)/(float)(globalGranStats.tot_sparks)) ); - /* Print statistics about priority sparking */ - if (RtsFlags.GranFlags.DoPrioritySparking) { - fprintf(stderr,"About Priority Sparking:\n"); - 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); - } - /* Print statistics about priority sparking */ - if (RtsFlags.GranFlags.DoPriorityScheduling) { - fprintf(stderr,"About Priority Scheduling:\n"); - fprintf(stderr," Total no. of StartThreads: %d (non-end: %d) Avg. thread queue len: %.2f\n", - globalGranStats.tot_add_threads, globalGranStats.non_end_add_threads, - (float)globalGranStats.tot_tq_len/(float)globalGranStats.tot_add_threads); - } - /* Blocking queue statistics */ - if (1) { - fprintf(stderr,"Blocking queue statistcs:\n"); - fprintf(stderr," Total no. of FMBQs generated: %d\n", - globalGranStats.tot_FMBQs); - fprintf(stderr," Total no. of bqs awakened: %d\n", - globalGranStats.tot_awbq); - fprintf(stderr," Total length of all bqs: %d\tAvg length of bqs: %.2f\n", - globalGranStats.tot_bq_len, (float)globalGranStats.tot_bq_len/(float)globalGranStats.tot_awbq); - fprintf(stderr," Percentage of local TSOs in BQs: %.2f\n", - (float)globalGranStats.tot_bq_len*100.0/(float)globalGranStats.tot_bq_len); - fprintf(stderr," Total time spent processing BQs: %lx\n", - globalGranStats.tot_bq_processing_time); - } - - /* Fetch misses and thunk stealing */ - fprintf(stderr,"Number of fetch misses: %d\n", - globalGranStats.fetch_misses); - - /* Print packet statistics if GUMM fetching is turned on */ - if (RtsFlags.GranFlags.DoBulkFetching) { - fprintf(stderr,"Packet statistcs:\n"); - fprintf(stderr," Total no. of packets: %d Avg. packet size: %.2f \n", globalGranStats.tot_packets, (float)globalGranStats.tot_packet_size/(float)globalGranStats.tot_packets); - fprintf(stderr," Total no. of thunks: %d Avg. thunks/packet: %.2f \n", globalGranStats.tot_thunks, (float)globalGranStats.tot_thunks/(float)globalGranStats.tot_packets); - fprintf(stderr," Total no. of cuts: %d Avg. cuts/packet: %.2f\n", globalGranStats.tot_cuts, (float)globalGranStats.tot_cuts/(float)globalGranStats.tot_packets); - /* - if (closure_queue_overflows>0) - fprintf(stderr," Number of closure queue overflows: %u\n", - closure_queue_overflows); - */ - } - } /* RtsFlags.GranFlags.GranSimStats.Global */ - -# if defined(GRAN_COUNT) -# error "GRAN_COUNT not supported; should be parallel ticky profiling, really" - fprintf(stderr,"Update count statistics:\n"); - fprintf(stderr," Total number of updates: %u\n",nUPDs); - fprintf(stderr," Needed to awaken BQ: %u with avg BQ len of: %f\n", - nUPDs_BQ,(float)BQ_lens/(float)nUPDs_BQ); - fprintf(stderr," Number of PAPs: %u\n",nPAPs); -# endif - - fprintf(stderr, "Simulation finished after @ %s @ cycles. %d sparks created, %d sparks ignored. Check %s for details.\n", - time_string, sparksCreated, sparksIgnored, gr_filename); - - if (RtsFlags.GranFlags.GranSimStats.Full) - fclose(gr_file); -} - -#elif defined(PAR) - -/* - Under GUM we print only one line. -*/ -void -end_gr_simulation(void) -{ - char time_string[TIME_STR_LEN]; - - ullong_format_string(CURRENT_TIME-startTime, time_string, rtsFalse/*no commas!*/); - - fprintf(stderr, "Computation finished after @ %s @ ms. %d sparks created, %d sparks ignored. Check %s for details.\n", - time_string, sparksCreated, sparksIgnored, gr_filename); - - if (RtsFlags.ParFlags.ParStats.Full) - fclose(gr_file); -} -#endif /* PAR */ - -//@node Global statistics, Dumping routines, Writing to the log-file -//@subsection Global statistics -/* - Called at the end of execution -*/ - -//@node Dumping routines, , Global statistics -//@subsection Dumping routines - -//@cindex DumpGranEvent -void -DumpGranEvent(name, tso) -GranEventType name; -StgTSO *tso; -{ - DumpRawGranEvent(CURRENT_PROC, (PEs)0, name, tso, &stg_END_TSO_QUEUE_closure, (StgInt)0, (StgInt)0); -} - -//@cindex DumpRawGranEvent -void -DumpRawGranEvent(proc, p, name, tso, node, sparkname, len) -PEs proc, p; /* proc ... where it happens; p ... where node lives */ -GranEventType name; -StgTSO *tso; -StgClosure *node; -StgInt sparkname, len; -{ -# if defined(GRAN) - DumpVeryRawGranEvent(TIME_ON_PROC(proc), - proc, p, name, tso, node, sparkname, len); -# elif defined(PAR) - DumpVeryRawGranEvent(CURRENT_TIME, - proc, p, name, tso, node, sparkname, len); -# endif -} - -//@cindex DumpVeryRawGranEvent -void -DumpVeryRawGranEvent(time, proc, p, name, tso, node, sparkname, len) -rtsTime time; -PEs proc, p; /* proc ... where it happens; p ... where node lives */ -GranEventType name; -StgTSO *tso; -StgClosure *node; -StgInt sparkname, len; -{ - FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1 - StgWord id; - char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN]; -# if defined(GRAN) - ullong_format_string(time, - time_string, rtsFalse/*no commas!*/); -# elif defined(PAR) - ullong_format_string(time, - time_string, rtsFalse/*no commas!*/); -# endif - output_file = gr_file; - -# if defined(GRAN) - - if (RtsFlags.GranFlags.GranSimStats.Full) - ASSERT(output_file!=NULL); - - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; -# elif defined(PAR) - - if (RtsFlags.ParFlags.ParStats.Full) - ASSERT(output_file!=NULL); - - if (RtsFlags.ParFlags.ParStats.Suppressed) - return; - -# endif - - id = tso == NULL ? -1 : tso->id; - if (node==stgCast(StgClosure*,&stg_END_TSO_QUEUE_closure)) - strcpy(node_str,"________"); /* "END_TSO_QUEUE"); */ - else - sprintf(node_str,"0x%-6lx",node); - - if (name > GR_EVENT_MAX) - name = GR_EVENT_MAX; - - if (BINARY_STATS) - barf("binary log files not yet supported"); -#if 0 - /* ToDo: fix code for writing binary GrAnSim statistics */ - switch (name) { - case GR_START: - case GR_STARTQ: - grputw(name); - grputw(proc); - abort(); /* die please: a single word */ - /* doesn't represent long long times */ - grputw(TIME_ON_PROC(proc)); - grputw((StgWord)node); - break; - case GR_FETCH: - case GR_REPLY: - case GR_BLOCK: - grputw(name); - grputw(proc); - abort(); /* die please: a single word */ - /* doesn't represent long long times */ - grputw(TIME_ON_PROC(proc)); /* this line is bound to */ - grputw(id); /* do the wrong thing */ - break; - default: - grputw(name); - grputw(proc); - abort(); /* die please: a single word */ - /* doesn't represent long long times */ - grputw(TIME_ON_PROC(proc)); - grputw((StgWord)node); - } -#endif - else /* !BINARY_STATS */ - switch (name) { - case GR_START: - case GR_STARTQ: - fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[SN %u]\t[sparks %u]\n", - proc,time_string,gran_event_names[name], - id,node_str,sparkname,len); - break; - case GR_FETCH: - case GR_REPLY: - case GR_BLOCK: - case GR_STOLEN: - case GR_STOLENQ: - case GR_STEALING: - fprintf(output_file, "PE %2u [%s]: %-9s\t%lx \t%s\t(from %2u)\n", - proc, time_string, gran_event_names[name], - id,node_str,p); - break; - case GR_RESUME: - case GR_RESUMEQ: - case GR_SCHEDULE: - case GR_DESCHEDULE: - fprintf(output_file,"PE %2u [%s]: %-9s\t%lx \n", - proc,time_string,gran_event_names[name],id); - break; - case GR_ALLOC: - fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t \tallocating %u words\n", - proc,time_string,gran_event_names[name],id,len); - break; - default: - fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[sparks %u]\n", - proc,time_string,gran_event_names[name],id,node_str,len); - } -} - -//@cindex DumpGranInfo -void -DumpEndEvent(proc, tso, mandatory_thread) -PEs proc; -StgTSO *tso; -rtsBool mandatory_thread; -{ - FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1 - char time_string[TIME_STR_LEN]; -# if defined(GRAN) - ullong_format_string(TIME_ON_PROC(proc), - time_string, rtsFalse/*no commas!*/); -# elif defined(PAR) - ullong_format_string(CURRENT_TIME, - time_string, rtsFalse/*no commas!*/); -# endif - - output_file = gr_file; - ASSERT(output_file!=NULL); -#if defined(GRAN) - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; -#endif - - if (BINARY_STATS) { - barf("binary log files not yet supported"); -#if 0 - grputw(GR_END); - grputw(proc); - abort(); /* die please: a single word doesn't represent long long times */ - grputw(CURRENT_TIME); /* this line is bound to fail */ - grputw(tso->id); -#ifdef PAR - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); - grputw(0); -#else - grputw(tso->gran.sparkname); - grputw(tso->gran.startedat); - grputw(tso->gran.exported); - grputw(tso->gran.basicblocks); - grputw(tso->gran.allocs); - grputw(tso->gran.exectime); - grputw(tso->gran.blocktime); - grputw(tso->gran.blockcount); - grputw(tso->gran.fetchtime); - grputw(tso->gran.fetchcount); - grputw(tso->gran.localsparks); - grputw(tso->gran.globalsparks); -#endif - grputw(mandatory_thread); -#endif /* 0 */ - } else { - - /* - * NB: DumpGranEvent cannot be used because PE may be wrong - * (as well as the extra info) - */ - 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" - ,proc - ,time_string - ,tso->id -#if defined(GRAN) - ,tso->gran.sparkname - ,tso->gran.startedat - ,((tso->gran.exported) ? 'T' : 'F') - ,tso->gran.basicblocks - ,tso->gran.allocs - ,tso->gran.exectime - ,tso->gran.blocktime - ,tso->gran.blockcount - ,tso->gran.fetchtime - ,tso->gran.fetchcount - ,tso->gran.localsparks - ,tso->gran.globalsparks -#elif defined(PAR) - ,tso->par.sparkname - ,tso->par.startedat - ,(tso->par.exported) ? "T" : "F" - ,tso->par.basicblocks - ,tso->par.allocs - ,tso->par.exectime - ,tso->par.blocktime - ,tso->par.blockcount - ,tso->par.fetchtime - ,tso->par.fetchcount - ,tso->par.localsparks - ,tso->par.globalsparks -#endif - ,(mandatory_thread ? "T" : "F") - ); - } -} - -//@cindex DumpTSO -void -DumpTSO(tso) -StgTSO *tso; -{ - FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1 - - output_file = gr_file; - ASSERT(output_file!=NULL); - fprintf(stderr,"TSO 0x%lx, NAME 0x%lx, ID %u, LINK 0x%lx, TYPE %s\n" - ,tso -#if defined(GRAN) - ,tso->gran.sparkname -#elif defined(PAR) - ,tso->par.sparkname -#endif - ,tso->id - ,tso->link - ,/*tso->state==T_MAIN?"MAIN": - TSO_TYPE(tso)==T_FAIL?"FAIL": - TSO_TYPE(tso)==T_REQUIRED?"REQUIRED": - TSO_TYPE(tso)==T_ADVISORY?"ADVISORY": - */ - "???" - ); - - 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" - ,tso->id -#if defined(GRAN) - ,tso->gran.sparkname - ,tso->gran.startedat - ,tso->gran.exported?'T':'F' - ,tso->gran.basicblocks - ,tso->gran.allocs - ,tso->gran.exectime - ,tso->gran.blocktime - ,tso->gran.blockcount - ,tso->gran.fetchtime - ,tso->gran.fetchcount - ,tso->gran.localsparks - ,tso->gran.globalsparks -#elif defined(PAR) - ,tso->par.sparkname - ,tso->par.startedat - ,tso->par.exported?'T':'F' - ,tso->par.basicblocks - ,tso->par.allocs - ,tso->par.exectime - ,tso->par.blocktime - ,tso->par.blockcount - ,tso->par.fetchtime - ,tso->par.fetchcount - ,tso->par.localsparks - ,tso->par.globalsparks -#endif - ); -} - -#if 0 -/* - ToDo: fix binary output of log files, and support new log file format. -*/ -/* - Output a terminate event and an 8-byte time. -*/ - -//@cindex grterminate -void -grterminate(v) -rtsTime v; -{ - if (!BINARY_STATS) - barf("grterminate: binary statistics not enabled\n"); - -# if defined(GRAN) - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; -# endif - - DumpGranEvent(GR_TERMINATE, stgCast(StgTSO*,&stg_END_TSO_QUEUE_closure)); - - if (sizeof(rtsTime) == 4) { - putc('\0', gr_file); - putc('\0', gr_file); - putc('\0', gr_file); - putc('\0', gr_file); - } else { - putc(v >> 56l, gr_file); - putc((v >> 48l) & 0xffl, gr_file); - putc((v >> 40l) & 0xffl, gr_file); - putc((v >> 32l) & 0xffl, gr_file); - } - putc((v >> 24l) & 0xffl, gr_file); - putc((v >> 16l) & 0xffl, gr_file); - putc((v >> 8l) & 0xffl, gr_file); - putc(v & 0xffl, gr_file); -} - -/* - Length-coded output: first 3 bits contain length coding - - 00x 1 byte - 01x 2 bytes - 10x 4 bytes - 110 8 bytes - 111 5 or 9 bytes -*/ - -//@cindex grputw -void -grputw(v) -rtsTime v; -{ - if (!BINARY_STATS) - barf("grputw: binary statistics not enabled\n"); - -# if defined(GRAN) - if (RtsFlags.GranFlags.GranSimStats.Suppressed) - return; -# endif - - if (v <= 0x3fl) { /* length v = 1 byte */ - fputc(v & 0x3f, gr_file); - } else if (v <= 0x3fffl) { /* length v = 2 byte */ - fputc((v >> 8l) | 0x40l, gr_file); - fputc(v & 0xffl, gr_file); - } else if (v <= 0x3fffffffl) { /* length v = 4 byte */ - fputc((v >> 24l) | 0x80l, gr_file); - fputc((v >> 16l) & 0xffl, gr_file); - fputc((v >> 8l) & 0xffl, gr_file); - fputc(v & 0xffl, gr_file); - } else if (sizeof(TIME) == 4) { - fputc(0x70, gr_file); - fputc((v >> 24l) & 0xffl, gr_file); - fputc((v >> 16l) & 0xffl, gr_file); - fputc((v >> 8l) & 0xffl, gr_file); - fputc(v & 0xffl, gr_file); - } else { - if (v <= 0x3fffffffffffffl) - putc((v >> 56l) | 0x60l, gr_file); - else { - putc(0x70, gr_file); - putc((v >> 56l) & 0xffl, gr_file); - } - - putc((v >> 48l) & 0xffl, gr_file); - putc((v >> 40l) & 0xffl, gr_file); - putc((v >> 32l) & 0xffl, gr_file); - putc((v >> 24l) & 0xffl, gr_file); - putc((v >> 16l) & 0xffl, gr_file); - putc((v >> 8l) & 0xffl, gr_file); - putc(v & 0xffl, gr_file); - } -} -#endif /* 0 */ - -/* - extracting specific info out of a closure; used in packing (GranSim, GUM) -*/ -//@cindex get_closure_info -StgInfoTable* -get_closure_info(StgClosure* node, nat *size, nat *ptrs, nat *nonptrs, - nat *vhs, char *info_hdr_ty) -{ - StgInfoTable *info; - - ASSERT(LOOKS_LIKE_COOL_CLOSURE(node)); - info = get_itbl(node); - /* the switch shouldn't be necessary, really; just use default case */ - switch (info->type) { - case RBH: - { - StgInfoTable *rip = REVERT_INFOPTR(info); // closure to revert to - *size = sizeW_fromITBL(rip); - *ptrs = (nat) (rip->layout.payload.ptrs); - *nonptrs = (nat) (rip->layout.payload.nptrs); - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "RBH"); -#endif - return rip; // NB: we return the reverted info ptr for a RBH!!!!!! - } - -#if defined(PAR) - /* Closures specific to GUM */ - case FETCH_ME: - *size = sizeofW(StgFetchMe); - *ptrs = (nat)0; - *nonptrs = (nat)0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "FETCH_ME"); -#endif - return info; - -#ifdef DIST - case REMOTE_REF: //same as for FETCH_ME... - *size = sizeofW(StgFetchMe); - *ptrs = (nat)0; - *nonptrs = (nat)0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "REMOTE_REF"); -#endif - return info; -#endif /* DIST */ - - case FETCH_ME_BQ: - *size = sizeofW(StgFetchMeBlockingQueue); - *ptrs = (nat)0; - *nonptrs = (nat)0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "FETCH_ME_BQ"); -#endif - return info; - - case BLOCKED_FETCH: - *size = sizeofW(StgBlockedFetch); - *ptrs = (nat)0; - *nonptrs = (nat)0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "BLOCKED_FETCH"); -#endif - return info; -#endif /* PAR */ - - /* these magic constants are outrageous!! why does the ITBL lie about it? */ - case THUNK_SELECTOR: - *size = THUNK_SELECTOR_sizeW(); - *ptrs = 1; - *nonptrs = MIN_UPD_SIZE-*ptrs; // weird - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); - return info; - - case ARR_WORDS: - /* ToDo: check whether this can be merged with the default case */ - *size = arr_words_sizeW((StgArrWords *)node); - *ptrs = 0; - *nonptrs = ((StgArrWords *)node)->words; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); - return info; - - case PAP: - /* ToDo: check whether this can be merged with the default case */ - *size = pap_sizeW((StgPAP *)node); - *ptrs = 0; - *nonptrs = 0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); - return info; - - case AP_UPD: - /* ToDo: check whether this can be merged with the default case */ - *size = AP_sizeW(((StgAP_UPD *)node)->n_args); - *ptrs = 0; - *nonptrs = 0; - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); - return info; - - default: - *size = sizeW_fromITBL(info); - *ptrs = (nat) (info->layout.payload.ptrs); - *nonptrs = (nat) (info->layout.payload.nptrs); - *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader); -#if 0 /* DEBUG */ - info_hdr_type(node, info_hdr_ty); -#else - strcpy(info_hdr_ty, "UNKNOWN"); -#endif - return info; - } -} - -//@cindex IS_BLACK_HOLE -rtsBool -IS_BLACK_HOLE(StgClosure* node) -{ - // StgInfoTable *info; - ASSERT(LOOKS_LIKE_COOL_CLOSURE(node)); - switch (get_itbl(node)->type) { - case BLACKHOLE: - case BLACKHOLE_BQ: - case RBH: - case FETCH_ME: - case FETCH_ME_BQ: - return rtsTrue; - default: - return rtsFalse; - } -//return ((info->type == BLACKHOLE || info->type == RBH) ? rtsTrue : rtsFalse); -} - -//@cindex IS_INDIRECTION -StgClosure * -IS_INDIRECTION(StgClosure* node) -{ - StgInfoTable *info; - ASSERT(LOOKS_LIKE_COOL_CLOSURE(node)); - info = get_itbl(node); - switch (info->type) { - case IND: - case IND_OLDGEN: - case IND_PERM: - case IND_OLDGEN_PERM: - case IND_STATIC: - /* relies on indirectee being at same place for all these closure types */ - return (((StgInd*)node) -> indirectee); -#if 0 - case EVACUATED: // counting as ind to use in GC routines, too - // could use the same code as above (evacuee is at same pos as indirectee) - return (((StgEvacuated *)node) -> evacuee); -#endif - default: - return NULL; - } -} - -//@cindex unwindInd -StgClosure * -UNWIND_IND (StgClosure *closure) -{ - StgClosure *next; - - while ((next = IS_INDIRECTION((StgClosure *)closure)) != NULL) - closure = next; - - ASSERT(next==(StgClosure *)NULL); - ASSERT(LOOKS_LIKE_COOL_CLOSURE(closure)); - return closure; -} - -#endif /* GRAN || PAR whole file */ |