diff options
43 files changed, 31 insertions, 4164 deletions
diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs index 75329c19cd..32d9583800 100644 --- a/compiler/codeGen/SMRep.lhs +++ b/compiler/codeGen/SMRep.lhs @@ -258,16 +258,12 @@ Size of a closure header. \begin{code} fixedHdrSize :: WordOff -fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize +fixedHdrSize = sTD_HDR_SIZE + profHdrSize profHdrSize :: WordOff profHdrSize | opt_SccProfilingOn = pROF_HDR_SIZE | otherwise = 0 -granHdrSize :: WordOff -granHdrSize | opt_GranMacros = gRAN_HDR_SIZE - | otherwise = 0 - arrWordsHdrSize :: ByteOff arrWordsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr diff --git a/compiler/main/Constants.lhs b/compiler/main/Constants.lhs index 51971728a0..b809f5280b 100644 --- a/compiler/main/Constants.lhs +++ b/compiler/main/Constants.lhs @@ -107,9 +107,6 @@ sTD_HDR_SIZE = STD_HDR_SIZE pROF_HDR_SIZE :: Int pROF_HDR_SIZE = PROF_HDR_SIZE - -gRAN_HDR_SIZE :: Int -gRAN_HDR_SIZE = GRAN_HDR_SIZE \end{code} Size of a double in StgWords. diff --git a/includes/ClosureMacros.h b/includes/ClosureMacros.h index cae5f13c2b..1c371b25e8 100644 --- a/includes/ClosureMacros.h +++ b/includes/ClosureMacros.h @@ -127,22 +127,6 @@ #define SET_STATIC_PROF_HDR(ccs) #endif -#ifdef GRAN -#define SET_GRAN_HDR(c,pe) (c)->header.gran.procs = pe -#define SET_STATIC_GRAN_HDR gran : { procs : Everywhere }, -#else -#define SET_GRAN_HDR(c,pe) -#define SET_STATIC_GRAN_HDR -#endif - -#ifdef PAR -#define SET_PAR_HDR(c,stuff) -#define SET_STATIC_PAR_HDR(stuff) -#else -#define SET_PAR_HDR(c,stuff) -#define SET_STATIC_PAR_HDR(stuff) -#endif - #ifdef TICKY_TICKY #define SET_TICKY_HDR(c,stuff) /* old: (c)->header.ticky.updated = stuff */ #define SET_STATIC_TICKY_HDR(stuff) /* old: ticky : { updated : stuff } */ @@ -154,8 +138,6 @@ #define SET_HDR(c,_info,ccs) \ { \ (c)->header.info = _info; \ - SET_GRAN_HDR((StgClosure *)(c),ThisPE); \ - SET_PAR_HDR((StgClosure *)(c),LOCAL_GA); \ SET_PROF_HDR((StgClosure *)(c),ccs); \ SET_TICKY_HDR((StgClosure *)(c),0); \ } diff --git a/includes/Closures.h b/includes/Closures.h index 15955fdcba..ef5fa4e807 100644 --- a/includes/Closures.h +++ b/includes/Closures.h @@ -27,14 +27,6 @@ typedef struct { } StgProfHeader; /* ----------------------------------------------------------------------------- - The GranSim header - -------------------------------------------------------------------------- */ - -typedef struct { - StgWord procs; /* bitmask indicating on which PEs this closure resides */ -} StgGranHeader; - -/* ----------------------------------------------------------------------------- The SMP header A thunk has a padding word to take the updated value. This is so @@ -63,9 +55,6 @@ typedef struct { #ifdef PROFILING StgProfHeader prof; #endif -#ifdef GRAN - StgGranHeader gran; -#endif } StgHeader; typedef struct { @@ -73,9 +62,6 @@ typedef struct { #ifdef PROFILING StgProfHeader prof; #endif -#ifdef GRAN - StgGranHeader gran; -#endif StgSMPThunkHeader smp; } StgThunkHeader; @@ -427,67 +413,4 @@ typedef struct { StgClosure *alt_code; } StgCatchRetryFrame; -#if defined(PAR) || defined(GRAN) -/* - StgBlockingQueueElement is a ``collective type'' representing the types - of closures that can be found on a blocking queue: StgTSO, StgRBHSave, - StgBlockedFetch. (StgRBHSave can only appear at the end of a blocking - queue). Logically, this is a union type, but defining another struct - with a common layout is easier to handle in the code. - Note that in the standard setup only StgTSOs can be on a blocking queue. - This is one of the main reasons for slightly different code in files - such as Schedule.c. -*/ -typedef struct StgBlockingQueueElement_ { - StgHeader header; - struct StgBlockingQueueElement_ *link; /* next elem in BQ */ - struct StgClosure_ *payload[FLEXIBLE_ARRAY];/* contents of the closure */ -} StgBlockingQueueElement; - -/* only difference to std code is type of the elem in the BQ */ -typedef struct StgBlockingQueue_ { - StgHeader header; - struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ -} StgBlockingQueue; - -/* this closure is hanging at the end of a blocking queue in (see RBH.c) */ -typedef struct StgRBHSave_ { - StgHeader header; - StgClosure *payload[FLEXIBLE_ARRAY]; /* 2 words ripped out of the guts of the */ -} StgRBHSave; /* closure holding the blocking queue */ - -typedef struct StgRBH_ { - StgHeader header; - struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ -} StgRBH; - -#endif - -#if defined(PAR) -/* global indirections aka FETCH_ME closures */ -typedef struct StgFetchMe_ { - StgHeader header; - globalAddr *ga; /* ptr to unique id for a closure */ -} StgFetchMe; - -/* same contents as an ordinary StgBlockingQueue */ -typedef struct StgFetchMeBlockingQueue_ { - StgHeader header; - struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ -} StgFetchMeBlockingQueue; - -/* This is an entry in a blocking queue. It indicates a fetch request from a - TSO on another PE demanding the value of this closur. Note that a - StgBlockedFetch can only occur in a BQ. Once the node is evaluated and - updated with the result, the result will be sent back (the PE is encoded - in the globalAddr) and the StgBlockedFetch closure will be nuked. -*/ -typedef struct StgBlockedFetch_ { - StgHeader header; - struct StgBlockingQueueElement_ *link; /* next elem in the BQ */ - StgClosure *node; /* node to fetch */ - globalAddr ga; /* where to send the result to */ -} StgBlockedFetch; /* NB: not just a ptr to a GA */ -#endif - #endif /* CLOSURES_H */ diff --git a/includes/Hooks.h b/includes/Hooks.h index 38014cc8f7..e281c89ab9 100644 --- a/includes/Hooks.h +++ b/includes/Hooks.h @@ -14,7 +14,3 @@ extern void StackOverflowHook (unsigned long stack_size); extern void OutOfHeapHook (unsigned long request_size, unsigned long heap_size); extern void MallocFailHook (unsigned long request_size /* in bytes */, char *msg); extern void defaultsHook (void); -#if defined(PAR) -extern void InitEachPEHook (void); -extern void ShutdownEachPEHook (void); -#endif diff --git a/includes/InfoTables.h b/includes/InfoTables.h index bbffea6468..0c6ab52745 100644 --- a/includes/InfoTables.h +++ b/includes/InfoTables.h @@ -54,70 +54,6 @@ typedef struct { } StgProfInfo; /* ----------------------------------------------------------------------------- - Parallelism info - -------------------------------------------------------------------------- */ - -#if 0 && (defined(PAR) || defined(GRAN)) - -/* CURRENTLY UNUSED - ToDo: use this in StgInfoTable (mutually recursive) -- HWL */ - -typedef struct { - StgInfoTable *rbh_infoptr; /* infoptr to the RBH */ -} StgParInfo; - -#endif /* 0 */ - -/* - Copied from ghc-0.29; ToDo: check this code -- HWL - - In the parallel system, all updatable closures have corresponding - revertible black holes. When we are assembly-mangling, we guarantee - that the revertible black hole code precedes the normal entry code, so - that the RBH info table resides at a fixed offset from the normal info - table. Otherwise, we add the RBH info table pointer to the end of the - normal info table and vice versa. - - Currently has to use a !RBH_MAGIC_OFFSET setting. - Still todo: init of par.infoptr field in all infotables!! -*/ - -#if defined(PAR) || defined(GRAN) - -# ifdef RBH_MAGIC_OFFSET - -# error magic offset not yet implemented - -# define RBH_INFO_WORDS 0 -# define INCLUDE_RBH_INFO(infoptr) - -# define RBH_INFOPTR(infoptr) (((P_)infoptr) - RBH_MAGIC_OFFSET) -# define REVERT_INFOPTR(infoptr) (((P_)infoptr) + RBH_MAGIC_OFFSET) - -# else - -# define RBH_INFO_WORDS 1 -# define INCLUDE_RBH_INFO(info) rbh_infoptr : &(info) - -# define RBH_INFOPTR(infoptr) (((StgInfoTable *)(infoptr))->rbh_infoptr) -# define REVERT_INFOPTR(infoptr) (((StgInfoTable *)(infoptr))->rbh_infoptr) - -# endif - -/* see ParallelRts.h */ -/* -EXTFUN(RBH_entry); -StgClosure *convertToRBH(StgClosure *closure); -#if defined(GRAN) -void convertFromRBH(StgClosure *closure); -#elif defined(PAR) -void convertToFetchMe(StgPtr closure, globalAddr *ga); -#endif -*/ - -#endif - -/* ----------------------------------------------------------------------------- Ticky info There is no ticky-specific stuff in an info table at this time. @@ -282,9 +218,6 @@ typedef struct _StgInfoTable { StgFunPtr entry; /* pointer to the entry code */ #endif -#if defined(PAR) || defined(GRAN) - struct _StgInfoTable *rbh_infoptr; -#endif #ifdef PROFILING StgProfInfo prof; #endif diff --git a/includes/README b/includes/README index fef91fe0fd..90695a6e7c 100644 --- a/includes/README +++ b/includes/README @@ -64,6 +64,7 @@ Rts.h StgDLL.h /* stuff related to Windows DLLs */ MachRegs.h /* global register assignments for this arch */ Regs.h /* "registers" in the virtual machine */ + TickyCounters.h StgMiscClosures.h /* decls for closures & info tables in the RTS */ SMP.h /* basic primitives for synchronisation */ diff --git a/includes/Rts.h b/includes/Rts.h index 1d455f0d6d..b038867e01 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -170,11 +170,7 @@ TAG_CLOSURE(StgWord tag,StgClosure * p) /* Info tables, closures & code fragments defined in the RTS */ #include "StgMiscClosures.h" -/* Simulated-parallel information */ -#include "GranSim.h" - /* Parallel information */ -#include "Parallel.h" #include "OSThreads.h" #include "SMPClosureOps.h" #include "SpinLock.h" @@ -190,9 +186,6 @@ TAG_CLOSURE(StgWord tag,StgClosure * p) #include "Block.h" #include "ClosureMacros.h" - /* Ticky-ticky counters */ -#include "TickyCounters.h" - /* Runtime-system hooks */ #include "Hooks.h" #include "RtsMessages.h" @@ -287,18 +280,6 @@ TICK_VAR(2) #define DEBUG_ONLY(s) doNothing() #endif -#if defined(GRAN) && defined(DEBUG) -#define IF_GRAN_DEBUG(c,s) if (RtsFlags.GranFlags.Debug.c) { s; } -#else -#define IF_GRAN_DEBUG(c,s) doNothing() -#endif - -#if defined(PAR) && defined(DEBUG) -#define IF_PAR_DEBUG(c,s) if (RtsFlags.ParFlags.Debug.c) { s; } -#else -#define IF_PAR_DEBUG(c,s) doNothing() -#endif - /* ----------------------------------------------------------------------------- Useful macros and inline functions -------------------------------------------------------------------------- */ diff --git a/includes/RtsConfig.h b/includes/RtsConfig.h index 2f683cb00f..3b088b7417 100644 --- a/includes/RtsConfig.h +++ b/includes/RtsConfig.h @@ -24,7 +24,7 @@ /* * Whether the runtime system will use libbfd for debugging purposes. */ -#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32) && !defined(PAR) && !defined(GRAN) +#if defined(DEBUG) && defined(HAVE_BFD_H) && defined(HAVE_LIBBFD) && !defined(_WIN32) #define USING_LIBBFD 1 #endif @@ -55,9 +55,7 @@ Signals - supported on non-PAR versions of the runtime. See RtsSignals.h. -------------------------------------------------------------------------- */ -#if !defined(PAR) #define RTS_USER_SIGNALS 1 -#endif /* Profile spin locks */ diff --git a/includes/RtsFlags.h b/includes/RtsFlags.h index 348a8f5225..ab6f2982cd 100644 --- a/includes/RtsFlags.h +++ b/includes/RtsFlags.h @@ -61,8 +61,6 @@ struct DEBUG_FLAGS { rtsBool stable; /* 't' */ rtsBool prof; /* 'p' */ rtsBool eventlog; /* 'e' */ - rtsBool gran; /* 'r' */ - rtsBool par; /* 'P' */ rtsBool linker; /* 'l' the object linker */ rtsBool apply; /* 'a' */ rtsBool stm; /* 'm' */ @@ -134,54 +132,6 @@ struct MISC_FLAGS { * for the linker, NULL ==> off */ }; -#ifdef PAR -/* currently the same as GRAN_STATS_FLAGS */ -struct PAR_STATS_FLAGS { - rtsBool Full; /* Full .gr profile (rtsTrue) or only END events? */ - rtsBool Suppressed; /* No .gr profile at all */ - rtsBool Binary; /* Binary profile? (not yet implemented) */ - rtsBool Sparks; /* Info on sparks in profile? */ - rtsBool Heap; /* Info on heap allocs in profile? */ - rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */ - rtsBool Global; /* Global statistics? (printed on shutdown; no log file) */ -}; - -struct PAR_DEBUG_FLAGS { - /* flags to control debugging output in various subsystems */ - rtsBool verbose : 1; /* 1 */ - rtsBool bq : 1; /* 2 */ - rtsBool schedule : 1; /* 4 */ - rtsBool free : 1; /* 8 */ - rtsBool resume : 1; /* 16 */ - rtsBool weight : 1; /* 32 */ - rtsBool fetch : 1; /* 64 */ - rtsBool fish : 1; /* 128 */ - rtsBool tables : 1; /* 256 */ - rtsBool packet : 1; /* 512 */ - rtsBool pack : 1; /* 1024 */ - rtsBool paranoia : 1; /* 2048 */ -}; - -#define MAX_PAR_DEBUG_OPTION 11 -#define PAR_DEBUG_MASK(n) ((nat)(ldexp(1,n))) -#define MAX_PAR_DEBUG_MASK ((nat)(ldexp(1,(MAX_PAR_DEBUG_OPTION+1))-1)) - -struct PAR_FLAGS { - struct PAR_STATS_FLAGS ParStats; /* profile and stats output */ - struct PAR_DEBUG_FLAGS Debug; /* debugging options */ - rtsBool outputDisabled; /* Disable output for performance purposes */ - rtsBool doFairScheduling; /* Fair-ish scheduling (round robin; no time-slices) */ - nat packBufferSize; - nat thunksToPack; /* number of thunks in packet + 1 */ - nat globalising; /* globalisation scheme */ - nat maxLocalSparks; /* spark pool size */ - nat maxThreads; /* thread pool size */ - nat maxFishes; /* max number of active fishes */ - rtsTime fishDelay; /* delay before sending a new fish */ - long wait; -}; -#endif /* PAR */ - #ifdef THREADED_RTS struct PAR_FLAGS { nat nNodes; /* number of threads to run simultaneously */ @@ -196,121 +146,6 @@ struct PAR_FLAGS { }; #endif /* THREADED_RTS */ -#ifdef GRAN -struct GRAN_STATS_FLAGS { - rtsBool Full; /* Full .gr profile (rtsTrue) or only END events? */ - rtsBool Suppressed; /* No .gr profile at all */ - rtsBool Binary; /* Binary profile? (not yet implemented) */ - rtsBool Sparks; /* Info on sparks in profile? */ - rtsBool Heap; /* Info on heap allocs in profile? */ - rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */ - rtsBool Global; /* Global statistics? (printed on shutdown; no log file) */ -}; - -struct GRAN_COST_FLAGS { - /* Communication Cost Variables -- set in main program */ - nat latency; /* Latency for single packet */ - nat additional_latency; /* Latency for additional packets */ - nat fetchtime; - nat lunblocktime; /* Time for local unblock */ - nat gunblocktime; /* Time for global unblock */ - nat mpacktime; /* Cost of creating a packet */ - nat munpacktime; /* Cost of receiving a packet */ - nat mtidytime; /* Cost of cleaning up after send */ - - nat threadcreatetime; /* Thread creation costs */ - nat threadqueuetime; /* Cost of adding a thread to the running/runnable queue */ - nat threaddescheduletime; /* Cost of descheduling a thread */ - nat threadscheduletime; /* Cost of scheduling a thread */ - nat threadcontextswitchtime; /* Cost of context switch */ - - /* Instruction Costs */ - nat arith_cost; /* arithmetic instructions (+,i,< etc) */ - nat branch_cost; /* branch instructions */ - nat load_cost; /* load into register */ - nat store_cost; /* store into memory */ - nat float_cost; /* floating point operations */ - - nat heapalloc_cost; /* heap allocation costs */ - - /* Overhead for granularity control mechanisms */ - /* overhead per elem of spark queue */ - nat pri_spark_overhead; - /* overhead per elem of thread queue */ - nat pri_sched_overhead; -}; - -struct GRAN_DEBUG_FLAGS { - /* flags to control debugging output in various subsystems */ - rtsBool event_trace : 1; /* 1 */ - rtsBool event_stats : 1; /* 2 */ - rtsBool bq : 1; /* 4 */ - rtsBool pack : 1; /* 8 */ - rtsBool checkSparkQ : 1; /* 16 */ - rtsBool thunkStealing : 1; /* 32 */ - rtsBool randomSteal : 1; /* 64 */ - rtsBool findWork : 1; /* 128 */ - rtsBool unused : 1; /* 256 */ - rtsBool pri : 1; /* 512 */ - rtsBool checkLight : 1; /* 1024 */ - rtsBool sortedQ : 1; /* 2048 */ - rtsBool blockOnFetch : 1; /* 4096 */ - rtsBool packBuffer : 1; /* 8192 */ - rtsBool blockOnFetch_sanity : 1; /* 16384 */ -}; - -#define MAX_GRAN_DEBUG_OPTION 14 -#define GRAN_DEBUG_MASK(n) ((nat)(ldexp(1,n))) -#define MAX_GRAN_DEBUG_MASK ((nat)(ldexp(1,(MAX_GRAN_DEBUG_OPTION+1))-1)) - -struct GRAN_FLAGS { - struct GRAN_STATS_FLAGS GranSimStats; /* profile and stats output */ - struct GRAN_COST_FLAGS Costs; /* cost metric for simulation */ - struct GRAN_DEBUG_FLAGS Debug; /* debugging options */ - - nat maxThreads; /* ToDo: share with THREADED_RTS and GUM */ - /* rtsBool labelling; */ - nat packBufferSize; - nat packBufferSize_internal; - - PEs proc; /* number of processors */ - rtsBool Fishing; /* Simulate GUM style fishing mechanism? */ - nat maxFishes; /* max number of spark or thread steals */ - rtsTime time_slice; /* max time slice of one reduction thread */ - - /* GrAnSim-Light: This version puts no bound on the number of - processors but in exchange doesn't model communication costs - (all communication is 0 cost). Mainly intended to show maximal - degree of parallelism in the program (*not* to simulate the - execution on a real machine). */ - - rtsBool Light; - - rtsBool DoFairSchedule ; /* fair scheduling alg? default: unfair */ - rtsBool DoAsyncFetch; /* async. communication? */ - rtsBool DoStealThreadsFirst; /* prefer threads over sparks when stealing */ - rtsBool DoAlwaysCreateThreads; /* eager thread creation */ - rtsBool DoBulkFetching; /* bulk fetching */ - rtsBool DoThreadMigration; /* allow to move threads */ - nat FetchStrategy; /* what to do when waiting for data */ - rtsBool PreferSparksOfLocalNodes; /* prefer local over global sparks */ - rtsBool DoPrioritySparking; /* sparks sorted by priorities */ - rtsBool DoPriorityScheduling; /* threads sorted by priorities */ - nat SparkPriority; /* threshold for cut-off mechanism */ - nat SparkPriority2; - rtsBool RandomPriorities; - rtsBool InversePriorities; - rtsBool IgnorePriorities; - nat ThunksToPack; /* number of thunks in packet + 1 */ - rtsBool RandomSteal; /* steal spark/thread from random proc */ - rtsBool NoForward; /* no forwarding of fetch messages */ - - /* unsigned int debug; */ - /* rtsBool event_trace; */ - /* rtsBool event_trace_all; */ -}; -#endif /* GRAN */ - struct TICKY_FLAGS { rtsBool showTickyStats; FILE *tickyFile; @@ -349,12 +184,9 @@ typedef struct _RTS_FLAGS { #endif struct TICKY_FLAGS TickyFlags; -#if defined(THREADED_RTS) || defined(PAR) +#if defined(THREADED_RTS) struct PAR_FLAGS ParFlags; #endif -#ifdef GRAN - struct GRAN_FLAGS GranFlags; -#endif #ifdef USE_PAPI struct PAPI_FLAGS PapiFlags; #endif diff --git a/includes/RtsTypes.h b/includes/RtsTypes.h index d4970053e7..79bbf1fccf 100644 --- a/includes/RtsTypes.h +++ b/includes/RtsTypes.h @@ -41,50 +41,4 @@ typedef enum { typedef ullong rtsTime; -#if defined(PAR) -/* types only needed in the parallel system */ -typedef struct hashtable ParHashTable; -typedef struct hashlist ParHashList; - -/* typedef double REAL_TIME; */ -/* typedef W_ TIME; */ -/* typedef GlobalTaskId Proc; */ -typedef int GlobalTaskId; -typedef GlobalTaskId PEs; -typedef unsigned int rtsWeight; -typedef int rtsPacket; -typedef int OpCode; - -/* Global addresses i.e. unique ids in a parallel setup; needed in Closures.h*/ -typedef struct { - union { - StgPtr plc; - struct { - GlobalTaskId gtid; - int slot; - } gc; - } payload; - rtsWeight weight; -} globalAddr; - -/* (GA, LA) pairs */ -typedef struct gala { - globalAddr ga; - StgPtr la; - struct gala *next; - rtsBool preferred; -} GALA; - -#elif defined(GRAN) - -/* - * GlobalTaskId is dummy in GranSim; - * we define it to have cleaner code in the RTS - */ -typedef int GlobalTaskId; -typedef lnat rtsTime; -typedef StgWord PEs; - -#endif - #endif /* RTS_TYPES_H */ diff --git a/includes/SMP.h b/includes/SMP.h index ac98feb7a3..873bbbbfc2 100644 --- a/includes/SMP.h +++ b/includes/SMP.h @@ -18,7 +18,7 @@ #if defined(THREADED_RTS) -#if defined(TICKY_TICKY) +#if defined(TICKY_TICKY) #error Build options incompatible with THREADED_RTS. #endif diff --git a/includes/SchedAPI.h b/includes/SchedAPI.h index 8dff6ea63d..b11437bda2 100644 --- a/includes/SchedAPI.h +++ b/includes/SchedAPI.h @@ -10,19 +10,10 @@ #ifndef SCHEDAPI_H #define SCHEDAPI_H -#if defined(GRAN) -/* Dummy def for NO_PRI if not in GranSim */ -#define NO_PRI 0 -#endif - /* * Creating threads */ -#if defined(GRAN) -StgTSO *createThread (Capability *cap, nat stack_size, StgInt pri); -#else StgTSO *createThread (Capability *cap, nat stack_size); -#endif Capability *scheduleWaitThread (StgTSO *tso, /*out*/HaskellObj* ret, Capability *cap); diff --git a/includes/Stg.h b/includes/Stg.h index 2b2095f030..341cda3668 100644 --- a/includes/Stg.h +++ b/includes/Stg.h @@ -206,9 +206,7 @@ typedef StgWord StgWordArray[]; #include "MachRegs.h" #include "Regs.h" -#ifdef TICKY_TICKY #include "TickyCounters.h" -#endif #if IN_STG_CODE /* diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h index e2ec9e4d74..5131f01b9b 100644 --- a/includes/StgMiscClosures.h +++ b/includes/StgMiscClosures.h @@ -92,12 +92,6 @@ RTS_INFO(stg_BLACKHOLE_info); RTS_INFO(__stg_EAGER_BLACKHOLE_info); RTS_INFO(stg_CAF_BLACKHOLE_info); -#if defined(PAR) || defined(GRAN) -RTS_INFO(stg_RBH_info); -#endif -#if defined(PAR) -RTS_INFO(stg_FETCH_ME_BQ_info); -#endif RTS_FUN_INFO(stg_BCO_info); RTS_INFO(stg_EVACUATED_info); RTS_INFO(stg_WEAK_info); @@ -147,12 +141,6 @@ RTS_ENTRY(stg_WHITEHOLE_entry); RTS_ENTRY(stg_BLACKHOLE_entry); RTS_ENTRY(__stg_EAGER_BLACKHOLE_entry); RTS_ENTRY(stg_CAF_BLACKHOLE_entry); -#if defined(PAR) || defined(GRAN) -RTS_ENTRY(stg_RBH_entry); -#endif -#if defined(PAR) -RTS_ENTRY(stg_FETCH_ME_BQ_entry); -#endif RTS_ENTRY(stg_BCO_entry); RTS_ENTRY(stg_EVACUATED_entry); RTS_ENTRY(stg_WEAK_entry); diff --git a/includes/TSO.h b/includes/TSO.h index c6ec6697d4..be50c124fc 100644 --- a/includes/TSO.h +++ b/includes/TSO.h @@ -33,16 +33,6 @@ typedef struct { } StgTSOStatBuf; /* - * GRAN: We distinguish between the various classes of threads in - * the system. - */ -typedef enum { - AdvisoryPriority, - MandatoryPriority, - RevalPriority -} StgThreadPriority; - -/* * PROFILING info in a TSO */ typedef struct { @@ -50,25 +40,6 @@ typedef struct { } StgTSOProfInfo; /* - * PAR info in a TSO - */ -typedef StgTSOStatBuf StgTSOParInfo; - -/* - * DIST info in a TSO - */ -typedef struct { - StgThreadPriority priority; - StgInt revalTid; /* ToDo: merge both into 1 word */ - StgInt revalSlot; -} StgTSODistInfo; - -/* - * GRAN info in a TSO - */ -typedef StgTSOStatBuf StgTSOGranInfo; - -/* * There is no TICKY info in a TSO at this time. */ @@ -164,15 +135,6 @@ typedef struct StgTSO_ { #ifdef PROFILING StgTSOProfInfo prof; #endif -#ifdef PAR - StgTSOParInfo par; -#endif -#ifdef GRAN - StgTSOGranInfo gran; -#endif -#ifdef DIST - StgTSODistInfo dist; -#endif #ifdef mingw32_HOST_OS StgWord32 saved_winerror; #endif @@ -260,16 +222,7 @@ extern StgTSO dummy_tso; #define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_)) - /* this is the NIL ptr for a TSO queue (e.g. runnable queue) */ #define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure) -#if defined(PAR) || defined(GRAN) -/* this is the NIL ptr for a blocking queue */ -# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure) -/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */ -# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure) -#endif -/* ToDo?: different name for end of sleeping queue ? -- HWL */ - #endif /* TSO_H */ diff --git a/includes/TickyCounters.h b/includes/TickyCounters.h index 80d1aee2e4..38e84ef2af 100644 --- a/includes/TickyCounters.h +++ b/includes/TickyCounters.h @@ -159,19 +159,6 @@ EXTERN StgInt RET_SEMI_loads_avoided INIT(0); /* End of counter declarations. */ -/* Here are stubs for a bunch of macros that aren't - implemented yet. */ - -#define TICK_ALLOC_FUN(g,s) -#define TICK_ALLOC_CON(g,s) -#define TICK_ALLOC_TUP(g,s) -#define TICK_ALLOC_BH(g,s) -#define TICK_ALLOC_PAP(g,s) -#define TICK_ALLOC_FMBQ(a,g,s) -#define TICK_ALLOC_FME(a,g,s) -#define TICK_ALLOC_BF(a,g,s) -#define TICK_ALLOC_PRIM2(w) - #endif /* TICKY_TICKY */ /* This is ugly, but the story is: diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index e9bff955a8..323a7d4641 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -168,7 +168,7 @@ /* Full byte offset for a TSO field, for use from Cmm */ #define tso_field_offset_macro(str) \ - printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+SIZEOF_OPT_StgTSOParInfo+SIZEOF_OPT_StgTSOGranInfo+SIZEOF_OPT_StgTSODistInfo+OFFSET_" str ")\n"); + printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); #define tso_field_offset(s_type, field) \ tso_payload_offset(s_type, field); \ @@ -200,7 +200,6 @@ main(int argc, char *argv[]) printf("#define STD_HDR_SIZE %lu\n", (unsigned long)sizeofW(StgHeader) - sizeofW(StgProfHeader)); /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */ printf("#define PROF_HDR_SIZE %lu\n", (unsigned long)sizeofW(StgProfHeader)); - printf("#define GRAN_HDR_SIZE %lu\n", (unsigned long)sizeofW(StgGranHeader)); printf("#define BLOCK_SIZE %u\n", BLOCK_SIZE); printf("#define MBLOCK_SIZE %u\n", MBLOCK_SIZE); @@ -309,14 +308,8 @@ main(int argc, char *argv[]) tso_field(StgTSO, stack_size); struct_size(StgTSOProfInfo); - struct_size(StgTSOParInfo); - struct_size(StgTSOGranInfo); - struct_size(StgTSODistInfo); opt_struct_size(StgTSOProfInfo,PROFILING); - opt_struct_size(StgTSOParInfo,PAR); - opt_struct_size(StgTSOGranInfo,GRAN); - opt_struct_size(StgTSODistInfo,DIST); closure_field(StgUpdateFrame, updatee); diff --git a/rts/Capability.c b/rts/Capability.c index fcfca3c733..c27733fa64 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -819,7 +819,7 @@ static void freeCapability (Capability *cap) { stgFree(cap->mut_lists); -#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) +#if defined(THREADED_RTS) freeSparkPool(cap->sparks); #endif } diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index a1b6d65f34..0c1af6292e 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -148,296 +148,6 @@ __stg_gc_enter_1 GC_GENERIC } -#if defined(GRAN) -/* - ToDo: merge the block and yield macros, calling something like BLOCK(N) - at the end; -*/ - -/* - Should we actually ever do a yield in such a case?? -- HWL -*/ -gran_yield_0 -{ - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -gran_yield_1 -{ - Sp_adj(-1); - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 2 Regs--------------------------------------------------------------------*/ - -gran_yield_2 -{ - Sp_adj(-2); - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 3 Regs -------------------------------------------------------------------*/ - -gran_yield_3 -{ - Sp_adj(-3); - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 4 Regs -------------------------------------------------------------------*/ - -gran_yield_4 -{ - Sp_adj(-4); - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 5 Regs -------------------------------------------------------------------*/ - -gran_yield_5 -{ - Sp_adj(-5); - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 6 Regs -------------------------------------------------------------------*/ - -gran_yield_6 -{ - Sp_adj(-6); - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 7 Regs -------------------------------------------------------------------*/ - -gran_yield_7 -{ - Sp_adj(-7); - Sp(6) = R7; - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -/*- 8 Regs -------------------------------------------------------------------*/ - -gran_yield_8 -{ - Sp_adj(-8); - Sp(7) = R8; - Sp(6) = R7; - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadYielding; - jump StgReturn; -} - -// the same routines but with a block rather than a yield - -gran_block_1 -{ - Sp_adj(-1); - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 2 Regs--------------------------------------------------------------------*/ - -gran_block_2 -{ - Sp_adj(-2); - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 3 Regs -------------------------------------------------------------------*/ - -gran_block_3 -{ - Sp_adj(-3); - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 4 Regs -------------------------------------------------------------------*/ - -gran_block_4 -{ - Sp_adj(-4); - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 5 Regs -------------------------------------------------------------------*/ - -gran_block_5 -{ - Sp_adj(-5); - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 6 Regs -------------------------------------------------------------------*/ - -gran_block_6 -{ - Sp_adj(-6); - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 7 Regs -------------------------------------------------------------------*/ - -gran_block_7 -{ - Sp_adj(-7); - Sp(6) = R7; - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -/*- 8 Regs -------------------------------------------------------------------*/ - -gran_block_8 -{ - Sp_adj(-8); - Sp(7) = R8; - Sp(6) = R7; - Sp(5) = R6; - Sp(4) = R5; - Sp(3) = R4; - Sp(2) = R3; - Sp(1) = R2; - Sp(0) = R1; - SAVE_THREAD_STATE(); - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -#endif - -#if 0 && defined(PAR) - -/* - Similar to stg_block_1 (called via StgMacro BLOCK_NP) but separates the - saving of the thread state from the actual jump via an StgReturn. - We need this separation because we call RTS routines in blocking entry codes - before jumping back into the RTS (see parallel/FetchMe.hc). -*/ - -par_block_1_no_jump -{ - Sp_adj(-1); - Sp(0) = R1; - SAVE_THREAD_STATE(); -} - -par_jump -{ - TSO_what_next(CurrentTSO) = ThreadRunGHC; - R1 = ThreadBlocked; - jump StgReturn; -} - -#endif - /* ----------------------------------------------------------------------------- Heap checks in Primitive case alternatives diff --git a/rts/Linker.c b/rts/Linker.c index b123f78dd2..3a4ec936d1 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -222,15 +222,10 @@ typedef struct _RtsSymbolVal { void *addr; } RtsSymbolVal; -#if !defined(PAR) #define Maybe_Stable_Names SymI_HasProto(mkWeakzh_fast) \ SymI_HasProto(mkWeakForeignEnvzh_fast) \ SymI_HasProto(makeStableNamezh_fast) \ SymI_HasProto(finalizzeWeakzh_fast) -#else -/* These are not available in GUM!!! -- HWL */ -#define Maybe_Stable_Names -#endif #if !defined (mingw32_HOST_OS) #define RTS_POSIX_ONLY_SYMBOLS \ diff --git a/rts/Printer.c b/rts/Printer.c index 2fbe2765a6..a0040a5d46 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -22,12 +22,6 @@ #include <stdlib.h> #include <string.h> -#if defined(GRAN) || defined(PAR) -// HWL: explicit fixed header size to make debugging easier -int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable), - uf_sz=sizeofW(StgUpdateFrame); -#endif - /* -------------------------------------------------------------------------- * local function decls * ------------------------------------------------------------------------*/ @@ -375,37 +369,6 @@ printClosure( StgClosure *obj ) debugBelch(")\n"); break; -#if defined(PAR) - case BLOCKED_FETCH: - debugBelch("BLOCKED_FETCH("); - printGA(&(stgCast(StgBlockedFetch*,obj)->ga)); - printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node)); - debugBelch(")\n"); - break; - - case FETCH_ME: - debugBelch("FETCH_ME("); - printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - debugBelch(")\n"); - break; - - case FETCH_ME_BQ: - debugBelch("FETCH_ME_BQ("); - // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue); - debugBelch(")\n"); - break; -#endif - -#if defined(GRAN) || defined(PAR) - case RBH: - debugBelch("RBH("); - printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue); - debugBelch(")\n"); - break; - -#endif - #if 0 /* Symptomatic of a problem elsewhere, have it fall-through & fail */ case EVACUATED: @@ -415,14 +378,6 @@ printClosure( StgClosure *obj ) break; #endif -#if defined(PAR) && defined(DIST) - case REMOTE_REF: - debugBelch("REMOTE_REF("); - printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - debugBelch(")\n"); - break; -#endif - default: //barf("printClosure %d",get_itbl(obj)->type); debugBelch("*** printClosure: unknown type %d ****\n", diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index d0d8d58a34..0748871ca7 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -497,11 +497,7 @@ StgTSO * createGenThread (Capability *cap, nat stack_size, StgClosure *closure) { StgTSO *t; -#if defined(GRAN) - t = createThread (cap, stack_size, NO_PRI); -#else t = createThread (cap, stack_size); -#endif pushClosure(t, (W_)closure); pushClosure(t, (W_)&stg_enter_info); return t; @@ -511,11 +507,7 @@ StgTSO * createIOThread (Capability *cap, nat stack_size, StgClosure *closure) { StgTSO *t; -#if defined(GRAN) - t = createThread (cap, stack_size, NO_PRI); -#else t = createThread (cap, stack_size); -#endif pushClosure(t, (W_)&stg_noforceIO_info); pushClosure(t, (W_)&stg_ap_v_info); pushClosure(t, (W_)closure); @@ -532,11 +524,7 @@ StgTSO * createStrictIOThread(Capability *cap, nat stack_size, StgClosure *closure) { StgTSO *t; -#if defined(GRAN) - t = createThread(cap, stack_size, NO_PRI); -#else t = createThread(cap, stack_size); -#endif pushClosure(t, (W_)&stg_forceIO_info); pushClosure(t, (W_)&stg_ap_v_info); pushClosure(t, (W_)closure); diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index 0794dc4c87..856137119c 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -40,57 +40,6 @@ char *rts_argv[MAX_RTS_ARGS]; #define RTS 1 #define PGM 0 -#if defined(GRAN) - -static char *gran_debug_opts_strs[] = { - "DEBUG (-bDe, -bD1): event_trace; printing event trace.\n", - "DEBUG (-bDE, -bD2): event_stats; printing event statistics.\n", - "DEBUG (-bDb, -bD4): bq; check blocking queues\n", - "DEBUG (-bDG, -bD8): pack; routines for (un-)packing graph structures.\n", - "DEBUG (-bDq, -bD16): checkSparkQ; check consistency of the spark queues.\n", - "DEBUG (-bDf, -bD32): thunkStealing; print forwarding of fetches.\n", - "DEBUG (-bDr, -bD64): randomSteal; stealing sparks/threads from random PEs.\n", - "DEBUG (-bDF, -bD128): findWork; searching spark-pools (local & remote), thread queues for work.\n", - "DEBUG (-bDu, -bD256): unused; currently unused flag.\n", - "DEBUG (-bDS, -bD512): pri; priority sparking or scheduling.\n", - "DEBUG (-bD:, -bD1024): checkLight; check GranSim-Light setup.\n", - "DEBUG (-bDo, -bD2048): sortedQ; check whether spark/thread queues are sorted.\n", - "DEBUG (-bDz, -bD4096): blockOnFetch; check for blocked on fetch.\n", - "DEBUG (-bDP, -bD8192): packBuffer; routines handling pack buffer (GranSim internal!).\n", - "DEBUG (-bDt, -bD16384): blockOnFetch_sanity; check for TSO asleep on fetch.\n", -}; - -/* one character codes for the available debug options */ -static char gran_debug_opts_flags[] = { - 'e', 'E', 'b', 'G', 'q', 'f', 'r', 'F', 'u', 'S', ':', 'o', 'z', 'P', 't' -}; - -#elif defined(PAR) - -static char *par_debug_opts_strs[] = { - "DEBUG (-qDv, -qD1): verbose; be generally verbose with parallel related stuff.\n", - "DEBUG (-qDq, -qD2): bq; print blocking queues.\n", - "DEBUG (-qDs, -qD4): schedule; scheduling of parallel threads.\n", - "DEBUG (-qDe, -qD8): free; free messages.\n", - "DEBUG (-qDr, -qD16): resume; resume messages.\n", - "DEBUG (-qDw, -qD32): weight; print weights and distrib GC stuff.\n", - "DEBUG (-qDF, -qD64): fetch; fetch messages.\n", - // "DEBUG (-qDa, -qD128): ack; ack messages.\n", - "DEBUG (-qDf, -qD128): fish; fish messages.\n", - //"DEBUG (-qDo, -qD512): forward; forwarding messages to other PEs.\n", - "DEBUG (-qDl, -qD256): tables; print internal LAGA etc tables.\n", - "DEBUG (-qDo, -qD512): packet; packets and graph structures when packing.\n", - "DEBUG (-qDp, -qD1024): pack; packing and unpacking graphs.\n", - "DEBUG (-qDz, -qD2048): paranoia; ridiculously detailed output (excellent for filling a partition).\n" -}; - -/* one character codes for the available debug options */ -static char par_debug_opts_flags[] = { - 'v', 'q', 's', 'e', 'r', 'w', 'F', 'f', 'l', 'o', 'p', 'z' -}; - -#endif /* PAR */ - /* ----------------------------------------------------------------------------- Static function decls -------------------------------------------------------------------------- */ @@ -106,17 +55,6 @@ open_stats_file ( static I_ decode(const char *s); static void bad_option(const char *s); -#if defined(GRAN) -static void enable_GranSimLight(void); -static void process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error); -static void set_GranSim_debug_options(nat n); -static void help_GranSim_debug_options(nat n); -#elif defined(PAR) -static void process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error); -static void set_par_debug_options(nat n); -static void help_par_debug_options(nat n); -#endif - /* ----------------------------------------------------------------------------- * Command-line option parsing routines. * ---------------------------------------------------------------------------*/ @@ -135,16 +73,9 @@ void initRtsFlagsDefaults(void) RtsFlags.GcFlags.heapSizeSuggestion = 0; /* none */ RtsFlags.GcFlags.pcFreeHeap = 3; /* 3% */ RtsFlags.GcFlags.oldGenFactor = 2; -#if defined(PAR) - /* A hack currently needed for GUM -- HWL */ - RtsFlags.GcFlags.generations = 1; - RtsFlags.GcFlags.steps = 2; - RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse; -#else RtsFlags.GcFlags.generations = 2; RtsFlags.GcFlags.steps = 2; RtsFlags.GcFlags.squeezeUpdFrames = rtsTrue; -#endif RtsFlags.GcFlags.compact = rtsFalse; RtsFlags.GcFlags.compactThreshold = 30.0; RtsFlags.GcFlags.sweep = rtsFalse; @@ -177,8 +108,6 @@ void initRtsFlagsDefaults(void) RtsFlags.DebugFlags.stm = rtsFalse; RtsFlags.DebugFlags.prof = rtsFalse; RtsFlags.DebugFlags.eventlog = rtsFalse; - RtsFlags.DebugFlags.gran = rtsFalse; - RtsFlags.DebugFlags.par = rtsFalse; RtsFlags.DebugFlags.apply = rtsFalse; RtsFlags.DebugFlags.linker = rtsFalse; RtsFlags.DebugFlags.squeeze = rtsFalse; @@ -186,9 +115,9 @@ void initRtsFlagsDefaults(void) RtsFlags.DebugFlags.timestamp = rtsFalse; #endif -#if defined(PROFILING) || defined(PAR) +#if defined(PROFILING) RtsFlags.CcFlags.doCostCentres = 0; -#endif /* PROFILING or PAR */ +#endif /* PROFILING */ RtsFlags.ProfFlags.doHeapProfile = rtsFalse; RtsFlags.ProfFlags.profileInterval = 100; @@ -228,100 +157,9 @@ void initRtsFlagsDefaults(void) RtsFlags.ParFlags.setAffinity = 0; #endif -#ifdef PAR - RtsFlags.ParFlags.ParStats.Full = rtsFalse; - RtsFlags.ParFlags.ParStats.Suppressed = rtsFalse; - RtsFlags.ParFlags.ParStats.Binary = rtsFalse; - RtsFlags.ParFlags.ParStats.Sparks = rtsFalse; - RtsFlags.ParFlags.ParStats.Heap = rtsFalse; - RtsFlags.ParFlags.ParStats.NewLogfile = rtsFalse; - RtsFlags.ParFlags.ParStats.Global = rtsFalse; - - RtsFlags.ParFlags.outputDisabled = rtsFalse; -#ifdef DIST - RtsFlags.ParFlags.doFairScheduling = rtsTrue; /* fair sched by def */ -#else - RtsFlags.ParFlags.doFairScheduling = rtsFalse; /* unfair sched by def */ -#endif - RtsFlags.ParFlags.packBufferSize = 1024; - RtsFlags.ParFlags.thunksToPack = 1; /* 0 ... infinity; */ - RtsFlags.ParFlags.globalising = 1; /* 0 ... everything */ - RtsFlags.ParFlags.maxThreads = 1024; - RtsFlags.ParFlags.maxFishes = MAX_FISHES; - RtsFlags.ParFlags.fishDelay = FISH_DELAY; -#endif - -#if defined(PAR) || defined(THREADED_RTS) +#if defined(THREADED_RTS) RtsFlags.ParFlags.maxLocalSparks = 4096; -#endif /* PAR || THREADED_RTS */ - -#if defined(GRAN) - /* ToDo: check defaults for GranSim and GUM */ - RtsFlags.GcFlags.maxStkSize = (8 * 1024 * 1024) / sizeof(W_); - RtsFlags.GcFlags.initialStkSize = 1024 / sizeof(W_); - - RtsFlags.GranFlags.maxThreads = 65536; // refers to mandatory threads - RtsFlags.GranFlags.GranSimStats.Full = rtsFalse; - RtsFlags.GranFlags.GranSimStats.Suppressed = rtsFalse; - RtsFlags.GranFlags.GranSimStats.Binary = rtsFalse; - RtsFlags.GranFlags.GranSimStats.Sparks = rtsFalse; - RtsFlags.GranFlags.GranSimStats.Heap = rtsFalse; - RtsFlags.GranFlags.GranSimStats.NewLogfile = rtsFalse; - RtsFlags.GranFlags.GranSimStats.Global = rtsFalse; - - RtsFlags.GranFlags.packBufferSize = 1024; - RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE; - - RtsFlags.GranFlags.proc = MAX_PROC; - RtsFlags.GranFlags.Fishing = rtsFalse; - RtsFlags.GranFlags.maxFishes = MAX_FISHES; - RtsFlags.GranFlags.time_slice = GRAN_TIME_SLICE; - RtsFlags.GranFlags.Light = rtsFalse; - - RtsFlags.GranFlags.Costs.latency = LATENCY; - RtsFlags.GranFlags.Costs.additional_latency = ADDITIONAL_LATENCY; - RtsFlags.GranFlags.Costs.fetchtime = FETCHTIME; - RtsFlags.GranFlags.Costs.lunblocktime = LOCALUNBLOCKTIME; - RtsFlags.GranFlags.Costs.gunblocktime = GLOBALUNBLOCKTIME; - RtsFlags.GranFlags.Costs.mpacktime = MSGPACKTIME; - RtsFlags.GranFlags.Costs.munpacktime = MSGUNPACKTIME; - RtsFlags.GranFlags.Costs.mtidytime = MSGTIDYTIME; - - RtsFlags.GranFlags.Costs.threadcreatetime = THREADCREATETIME; - RtsFlags.GranFlags.Costs.threadqueuetime = THREADQUEUETIME; - RtsFlags.GranFlags.Costs.threaddescheduletime = THREADDESCHEDULETIME; - RtsFlags.GranFlags.Costs.threadscheduletime = THREADSCHEDULETIME; - RtsFlags.GranFlags.Costs.threadcontextswitchtime = THREADCONTEXTSWITCHTIME; - - RtsFlags.GranFlags.Costs.arith_cost = ARITH_COST; - RtsFlags.GranFlags.Costs.branch_cost = BRANCH_COST; - RtsFlags.GranFlags.Costs.load_cost = LOAD_COST; - RtsFlags.GranFlags.Costs.store_cost = STORE_COST; - RtsFlags.GranFlags.Costs.float_cost = FLOAT_COST; - - RtsFlags.GranFlags.Costs.heapalloc_cost = HEAPALLOC_COST; - - RtsFlags.GranFlags.Costs.pri_spark_overhead = PRI_SPARK_OVERHEAD; - RtsFlags.GranFlags.Costs.pri_sched_overhead = PRI_SCHED_OVERHEAD; - - RtsFlags.GranFlags.DoFairSchedule = rtsFalse; - RtsFlags.GranFlags.DoAsyncFetch = rtsFalse; - RtsFlags.GranFlags.DoStealThreadsFirst = rtsFalse; - RtsFlags.GranFlags.DoAlwaysCreateThreads = rtsFalse; - RtsFlags.GranFlags.DoBulkFetching = rtsFalse; - RtsFlags.GranFlags.DoThreadMigration = rtsFalse; - RtsFlags.GranFlags.FetchStrategy = 2; - RtsFlags.GranFlags.PreferSparksOfLocalNodes = rtsFalse; - RtsFlags.GranFlags.DoPrioritySparking = rtsFalse; - RtsFlags.GranFlags.DoPriorityScheduling = rtsFalse; - RtsFlags.GranFlags.SparkPriority = 0; - RtsFlags.GranFlags.SparkPriority2 = 0; - RtsFlags.GranFlags.RandomPriorities = rtsFalse; - RtsFlags.GranFlags.InversePriorities = rtsFalse; - RtsFlags.GranFlags.IgnorePriorities = rtsFalse; - RtsFlags.GranFlags.ThunksToPack = 0; - RtsFlags.GranFlags.RandomSteal = rtsTrue; -#endif +#endif /* THREADED_RTS */ #ifdef TICKY_TICKY RtsFlags.TickyFlags.showTickyStats = rtsFalse; @@ -377,7 +215,7 @@ usage_text[] = { "", " -Z Don't squeeze out update frames on stack overflow", " -B Sound the bell at the start of each garbage collection", -#if defined(PROFILING) || defined(PAR) +#if defined(PROFILING) "", " -px Time/allocation profile (XML) (output file <program>.prof)", " -p Time/allocation profile (output file <program>.prof)", @@ -431,10 +269,6 @@ usage_text[] = { " -r<file> Produce ticky-ticky statistics (with -rstderr for stderr)", "", #endif -#if defined(PAR) -" -N<n> Use <n> PVMish processors in parallel (default: 2)", -/* NB: the -N<n> is implemented by the driver!! */ -#endif " -C<secs> Context-switch interval in seconds.", " 0 or no argument means switch as often as possible.", " Default: 0.02 sec; resolution is set by -V below.", @@ -455,8 +289,6 @@ usage_text[] = { " -Dt DEBUG: stable", " -Dp DEBUG: prof", " -De DEBUG: event logging", -" -Dr DEBUG: gran", -" -DP DEBUG: par", " -Da DEBUG: apply", " -Dl DEBUG: linker", " -Dm DEBUG: stm", @@ -476,26 +308,12 @@ usage_text[] = { #endif " --install-signal-handlers=<yes|no>", " Install signal handlers (default: yes)", -#if defined(THREADED_RTS) || defined(PAR) +#if defined(THREADED_RTS) " -e<size> Size of spark pools (default 100)", #endif -#if defined(PAR) -" -t<num> Set maximum number of advisory threads per PE (default 32)", -" -qP Enable activity profile (output files in ~/<program>*.gr)", -" -qQ<size> Set pack-buffer size (default: 1024)", -" -qd Turn on PVM-ish debugging", -" -qO Disable output for performance measurement", -#endif -#if defined(THREADED_RTS) || defined(PAR) +#if defined(THREADED_RTS) " -e<n> Maximum number of outstanding local sparks (default: 4096)", #endif -#if defined(PAR) -" -d Turn on PVM-ish debugging", -" -O Disable output for performance measurement", -#endif /* PAR */ -#if defined(GRAN) /* ToDo: fill in decent Docu here */ -" -b... All GranSim options start with -b; see GranSim User's Guide for details", -#endif #if defined(x86_64_HOST_ARCH) " -xm Base address to mmap memory in the GHCi linker", " (hex; must be <80000000)", @@ -632,12 +450,11 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]) } else { switch(rts_argv[arg][1]) { - /* process: general args, then PROFILING-only ones, - then CONCURRENT-only, PARallel-only, GRAN-only, - TICKY-only (same order as defined in RtsFlags.lh); - within those groups, mostly in case-insensitive - alphabetical order. - Final group is x*, which allows for more options. + /* process: general args, then PROFILING-only ones, then + CONCURRENT-only, TICKY-only (same order as defined in + RtsFlags.lh); within those groups, mostly in + case-insensitive alphabetical order. Final group is + x*, which allows for more options. */ #ifdef TICKY_TICKY @@ -648,14 +465,6 @@ errorBelch("not built for: ticky-ticky stats"); \ error = rtsTrue; #endif -#if defined(PROFILING) -# define COST_CENTRE_USING_BUILD_ONLY(x) x -#else -# define COST_CENTRE_USING_BUILD_ONLY(x) \ -errorBelch("not built for: -prof or -parallel"); \ -error = rtsTrue; -#endif - #ifdef PROFILING # define PROFILING_BUILD_ONLY(x) x #else @@ -672,14 +481,6 @@ errorBelch("not built for: -par-prof"); \ error = rtsTrue; #endif -#ifdef PAR -# define PAR_BUILD_ONLY(x) x -#else -# define PAR_BUILD_ONLY(x) \ -errorBelch("not built for: -parallel"); \ -error = rtsTrue; -#endif - #ifdef THREADED_RTS # define THREADED_BUILD_ONLY(x) x #else @@ -688,22 +489,6 @@ errorBelch("not built for: -smp"); \ error = rtsTrue; #endif -#if defined(THREADED_RTS) || defined(PAR) -# define PAR_OR_THREADED_BUILD_ONLY(x) x -#else -# define PAR_OR_THREADED_BUILD_ONLY(x) \ -errorBelch("not built for: -parallel or -smp"); \ -error = rtsTrue; -#endif - -#ifdef GRAN -# define GRAN_BUILD_ONLY(x) x -#else -# define GRAN_BUILD_ONLY(x) \ -errorBelch("not built for: -gransim"); \ -error = rtsTrue; -#endif - /* =========== GENERAL ========================== */ case '?': error = rtsTrue; @@ -836,12 +621,6 @@ error = rtsTrue; case 'e': RtsFlags.DebugFlags.eventlog = rtsTrue; break; - case 'r': - RtsFlags.DebugFlags.gran = rtsTrue; - break; - case 'P': - RtsFlags.DebugFlags.par = rtsTrue; - break; case 'l': RtsFlags.DebugFlags.linker = rtsTrue; break; @@ -949,11 +728,6 @@ error = rtsTrue; goto stats; stats: -#ifdef PAR - /* Opening all those files would almost certainly fail... */ - // RtsFlags.ParFlags.ParStats.Full = rtsTrue; - RtsFlags.GcFlags.statsFile = NULL; /* temporary; ToDo: rm */ -#else { int r; r = open_stats_file(arg, *argc, argv, @@ -961,8 +735,7 @@ error = rtsTrue; &RtsFlags.GcFlags.statsFile); if (r == -1) { error = rtsTrue; } } -#endif - break; + break; case 'Z': RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse; @@ -980,7 +753,7 @@ error = rtsTrue; case 'P': /* detailed cost centre profiling (time/alloc) */ case 'p': /* cost centre profiling (time/alloc) */ - COST_CENTRE_USING_BUILD_ONLY( + PROFILING_BUILD_ONLY( switch (rts_argv[arg][2]) { case 'x': RtsFlags.CcFlags.doCostCentres = COST_CENTRES_XML; @@ -1246,7 +1019,7 @@ error = rtsTrue; #endif /* =========== PARALLEL =========================== */ case 'e': - PAR_OR_THREADED_BUILD_ONLY( + THREADED_BUILD_ONLY( if (rts_argv[arg][2] != '\0') { RtsFlags.ParFlags.maxLocalSparks = strtol(rts_argv[arg]+2, (char **) NULL, 10); @@ -1257,20 +1030,6 @@ error = rtsTrue; } ) break; -#ifdef PAR - case 'q': - PAR_BUILD_ONLY( - process_par_option(arg, rts_argc, rts_argv, &error); - ) break; -#endif - - /* =========== GRAN =============================== */ - - case 'b': - GRAN_BUILD_ONLY( - process_gran_option(arg, rts_argc, rts_argv, &error); - ) break; - /* =========== TICKY ============================== */ case 'r': /* Basic profiling stats */ @@ -1431,978 +1190,6 @@ error = rtsTrue; } } -#if defined(GRAN) - -static void -enable_GranSimLight(void) { - - debugBelch("GrAnSim Light enabled (infinite number of processors; 0 communication costs)\n"); - RtsFlags.GranFlags.Light=rtsTrue; - RtsFlags.GranFlags.Costs.latency = - RtsFlags.GranFlags.Costs.fetchtime = - RtsFlags.GranFlags.Costs.additional_latency = - RtsFlags.GranFlags.Costs.gunblocktime = - RtsFlags.GranFlags.Costs.lunblocktime = - RtsFlags.GranFlags.Costs.threadcreatetime = - RtsFlags.GranFlags.Costs.threadqueuetime = - RtsFlags.GranFlags.Costs.threadscheduletime = - RtsFlags.GranFlags.Costs.threaddescheduletime = - RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0; - - RtsFlags.GranFlags.Costs.mpacktime = - RtsFlags.GranFlags.Costs.munpacktime = 0; - - RtsFlags.GranFlags.DoFairSchedule = rtsTrue; - RtsFlags.GranFlags.DoAsyncFetch = rtsFalse; - RtsFlags.GranFlags.DoAlwaysCreateThreads = rtsTrue; - /* FetchStrategy is irrelevant in GrAnSim-Light */ - - /* GrAnSim Light often creates an abundance of parallel threads, - each with its own stack etc. Therefore, it's in general a good - idea to use small stack chunks (use the -o<size> option to - increase it again). - */ - // RtsFlags.ConcFlags.stkChunkSize = 100; - - RtsFlags.GranFlags.proc = 1; -} - -static void -process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) -{ - if (rts_argv[arg][1] != 'b') /* All GranSim options start with -b */ - return; - - /* or a ridiculously idealised simulator */ - if(strcmp((rts_argv[arg]+2),"oring")==0) { - RtsFlags.GranFlags.Costs.latency = - RtsFlags.GranFlags.Costs.fetchtime = - RtsFlags.GranFlags.Costs.additional_latency = - RtsFlags.GranFlags.Costs.gunblocktime = - RtsFlags.GranFlags.Costs.lunblocktime = - RtsFlags.GranFlags.Costs.threadcreatetime = - RtsFlags.GranFlags.Costs.threadqueuetime = - RtsFlags.GranFlags.Costs.threadscheduletime = - RtsFlags.GranFlags.Costs.threaddescheduletime = - RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0; - - RtsFlags.GranFlags.Costs.mpacktime = - RtsFlags.GranFlags.Costs.munpacktime = 0; - - RtsFlags.GranFlags.Costs.arith_cost = - RtsFlags.GranFlags.Costs.float_cost = - RtsFlags.GranFlags.Costs.load_cost = - RtsFlags.GranFlags.Costs.store_cost = - RtsFlags.GranFlags.Costs.branch_cost = 0; - - RtsFlags.GranFlags.Costs.heapalloc_cost = 1; - - /* ++RtsFlags.GranFlags.DoFairSchedule; */ - RtsFlags.GranFlags.DoStealThreadsFirst = rtsTrue; /* -bZ */ - RtsFlags.GranFlags.DoThreadMigration = rtsTrue; /* -bM */ - RtsFlags.GranFlags.GranSimStats.Full = rtsTrue; /* -bP */ - return; - } - - /* or a somewhat idealised simulator */ - if(strcmp((rts_argv[arg]+2),"onzo")==0) { - RtsFlags.GranFlags.Costs.latency = - RtsFlags.GranFlags.Costs.fetchtime = - RtsFlags.GranFlags.Costs.additional_latency = - RtsFlags.GranFlags.Costs.gunblocktime = - RtsFlags.GranFlags.Costs.lunblocktime = - RtsFlags.GranFlags.Costs.threadcreatetime = - RtsFlags.GranFlags.Costs.threadqueuetime = - RtsFlags.GranFlags.Costs.threadscheduletime = - RtsFlags.GranFlags.Costs.threaddescheduletime = - RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0; - - RtsFlags.GranFlags.Costs.mpacktime = - RtsFlags.GranFlags.Costs.munpacktime = 0; - - RtsFlags.GranFlags.Costs.heapalloc_cost = 1; - - /* RtsFlags.GranFlags.DoFairSchedule = rtsTrue; */ /* -b-R */ - /* RtsFlags.GranFlags.DoStealThreadsFirst = rtsTrue; */ /* -b-T */ - RtsFlags.GranFlags.DoAsyncFetch = rtsTrue; /* -bZ */ - RtsFlags.GranFlags.DoThreadMigration = rtsTrue; /* -bM */ - RtsFlags.GranFlags.GranSimStats.Full = rtsTrue; /* -bP */ -# if defined(GRAN_CHECK) && defined(GRAN) - RtsFlags.GranFlags.Debug.event_stats = rtsTrue; /* print event statistics */ -# endif - return; - } - - /* Communication and task creation cost parameters */ - switch(rts_argv[arg][2]) { - case '.': - IgnoreYields = rtsTrue; // HWL HACK - break; - - case ':': - enable_GranSimLight(); /* set flags for GrAnSim-Light mode */ - break; - - case 'l': - if (rts_argv[arg][3] != '\0') - { - RtsFlags.GranFlags.Costs.gunblocktime = - RtsFlags.GranFlags.Costs.latency = decode(rts_argv[arg]+3); - RtsFlags.GranFlags.Costs.fetchtime = 2*RtsFlags.GranFlags.Costs.latency; - } - else - RtsFlags.GranFlags.Costs.latency = LATENCY; - break; - - case 'a': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.additional_latency = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.additional_latency = ADDITIONAL_LATENCY; - break; - - case 'm': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.mpacktime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.mpacktime = MSGPACKTIME; - break; - - case 'x': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.mtidytime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.mtidytime = 0; - break; - - case 'r': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.munpacktime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.munpacktime = MSGUNPACKTIME; - break; - - case 'g': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.fetchtime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.fetchtime = FETCHTIME; - break; - - case 'n': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.gunblocktime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.gunblocktime = GLOBALUNBLOCKTIME; - break; - - case 'u': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.lunblocktime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.lunblocktime = LOCALUNBLOCKTIME; - break; - - /* Thread-related metrics */ - case 't': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.threadcreatetime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.threadcreatetime = THREADCREATETIME; - break; - - case 'q': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.threadqueuetime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.threadqueuetime = THREADQUEUETIME; - break; - - case 'c': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.threadscheduletime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.threadscheduletime = THREADSCHEDULETIME; - - RtsFlags.GranFlags.Costs.threadcontextswitchtime = RtsFlags.GranFlags.Costs.threadscheduletime - + RtsFlags.GranFlags.Costs.threaddescheduletime; - break; - - case 'd': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.threaddescheduletime = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.threaddescheduletime = THREADDESCHEDULETIME; - - RtsFlags.GranFlags.Costs.threadcontextswitchtime = RtsFlags.GranFlags.Costs.threadscheduletime - + RtsFlags.GranFlags.Costs.threaddescheduletime; - break; - - /* Instruction Cost Metrics */ - case 'A': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.arith_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.arith_cost = ARITH_COST; - break; - - case 'F': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.float_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.float_cost = FLOAT_COST; - break; - - case 'B': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.branch_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.branch_cost = BRANCH_COST; - break; - - case 'L': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.load_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.load_cost = LOAD_COST; - break; - - case 'S': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.store_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.store_cost = STORE_COST; - break; - - case 'H': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.heapalloc_cost = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.heapalloc_cost = 0; - break; - - case 'y': - RtsFlags.GranFlags.DoAsyncFetch = rtsTrue; - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.FetchStrategy = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.FetchStrategy = 2; - if (RtsFlags.GranFlags.FetchStrategy == 0) - RtsFlags.GranFlags.DoAsyncFetch = rtsFalse; - break; - - case 'K': /* sort overhead (per elem in spark list) */ - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.pri_spark_overhead = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.pri_spark_overhead = PRI_SPARK_OVERHEAD; - debugBelch("Overhead for pri spark: %d (per elem).\n", - RtsFlags.GranFlags.Costs.pri_spark_overhead); - break; - - case 'O': /* sort overhead (per elem in spark list) */ - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.Costs.pri_sched_overhead = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.Costs.pri_sched_overhead = PRI_SCHED_OVERHEAD; - debugBelch("Overhead for pri sched: %d (per elem).\n", - RtsFlags.GranFlags.Costs.pri_sched_overhead); - break; - - /* General Parameters */ - case 'p': - if (rts_argv[arg][3] != '\0') - { - RtsFlags.GranFlags.proc = decode(rts_argv[arg]+3); - if (RtsFlags.GranFlags.proc==0) { - enable_GranSimLight(); /* set flags for GrAnSim-Light mode */ - } else if (RtsFlags.GranFlags.proc > MAX_PROC || - RtsFlags.GranFlags.proc < 1) - { - debugBelch("setupRtsFlags: no more than %u processors allowed\n", - MAX_PROC); - *error = rtsTrue; - } - } - else - RtsFlags.GranFlags.proc = MAX_PROC; - break; - - case 'f': - RtsFlags.GranFlags.Fishing = rtsTrue; - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.maxFishes = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.maxFishes = MAX_FISHES; - break; - - case 'w': - if (rts_argv[arg][3] != '\0') - RtsFlags.GranFlags.time_slice = decode(rts_argv[arg]+3); - else - RtsFlags.GranFlags.time_slice = GRAN_TIME_SLICE; - break; - - case 'C': - RtsFlags.GranFlags.DoAlwaysCreateThreads=rtsTrue; - RtsFlags.GranFlags.DoThreadMigration=rtsTrue; - break; - - case 'G': - debugBelch("Bulk fetching enabled.\n"); - RtsFlags.GranFlags.DoBulkFetching=rtsTrue; - break; - - case 'M': - debugBelch("Thread migration enabled.\n"); - RtsFlags.GranFlags.DoThreadMigration=rtsTrue; - break; - - case 'R': - debugBelch("Fair Scheduling enabled.\n"); - RtsFlags.GranFlags.DoFairSchedule=rtsTrue; - break; - - case 'I': - debugBelch("Priority Scheduling enabled.\n"); - RtsFlags.GranFlags.DoPriorityScheduling=rtsTrue; - break; - - case 'T': - RtsFlags.GranFlags.DoStealThreadsFirst=rtsTrue; - RtsFlags.GranFlags.DoThreadMigration=rtsTrue; - break; - - case 'Z': - RtsFlags.GranFlags.DoAsyncFetch=rtsTrue; - break; - -/* case 'z': */ -/* RtsFlags.GranFlags.SimplifiedFetch=rtsTrue; */ -/* break; */ - - case 'N': - RtsFlags.GranFlags.PreferSparksOfLocalNodes=rtsTrue; - break; - - case 'b': - RtsFlags.GranFlags.GranSimStats.Binary=rtsTrue; - break; - - case 'P': - /* format is -bP<c> where <c> is one char describing kind of profile */ - RtsFlags.GranFlags.GranSimStats.Full = rtsTrue; - switch(rts_argv[arg][3]) { - case '\0': break; // nothing special, just an ordinary profile - case '0': RtsFlags.GranFlags.GranSimStats.Suppressed = rtsTrue; - break; - case 'b': RtsFlags.GranFlags.GranSimStats.Binary = rtsTrue; - break; - case 's': RtsFlags.GranFlags.GranSimStats.Sparks = rtsTrue; - break; - case 'h': RtsFlags.GranFlags.GranSimStats.Heap = rtsTrue; - break; - case 'n': RtsFlags.GranFlags.GranSimStats.NewLogfile = rtsTrue; - break; - case 'g': RtsFlags.GranFlags.GranSimStats.Global = rtsTrue; - break; - default: barf("Unknown option -bP%c", rts_argv[arg][3]); - } - break; - - case 's': - RtsFlags.GranFlags.GranSimStats.Sparks=rtsTrue; - break; - - case 'h': - RtsFlags.GranFlags.GranSimStats.Heap=rtsTrue; - break; - - case 'Y': /* syntax: -bY<n>[,<n>] n ... pos int */ - if (rts_argv[arg][3] != '\0') { - char *arg0, *tmp; - - arg0 = rts_argv[arg]+3; - if ((tmp = strstr(arg0,","))==NULL) { - RtsFlags.GranFlags.SparkPriority = decode(arg0); - debugBelch("SparkPriority: %u.\n",RtsFlags.GranFlags.SparkPriority); - } else { - *(tmp++) = '\0'; - RtsFlags.GranFlags.SparkPriority = decode(arg0); - RtsFlags.GranFlags.SparkPriority2 = decode(tmp); - debugBelch("SparkPriority: %u.\n", - RtsFlags.GranFlags.SparkPriority); - debugBelch("SparkPriority2:%u.\n", - RtsFlags.GranFlags.SparkPriority2); - if (RtsFlags.GranFlags.SparkPriority2 < - RtsFlags.GranFlags.SparkPriority) { - debugBelch("WARNING: 2nd pri < main pri (%u<%u); 2nd pri has no effect\n", - RtsFlags.GranFlags.SparkPriority2, - RtsFlags.GranFlags.SparkPriority); - } - } - } else { - /* plain pri spark is now invoked with -bX - RtsFlags.GranFlags.DoPrioritySparking = 1; - debugBelch("PrioritySparking.\n"); - */ - } - break; - - case 'Q': - if (rts_argv[arg][3] != '\0') { - RtsFlags.GranFlags.ThunksToPack = decode(rts_argv[arg]+3); - } else { - RtsFlags.GranFlags.ThunksToPack = 1; - } - debugBelch("Thunks To Pack in one packet: %u.\n", - RtsFlags.GranFlags.ThunksToPack); - break; - - case 'e': - RtsFlags.GranFlags.RandomSteal = rtsFalse; - debugBelch("Deterministic mode (no random stealing)\n"); - break; - - /* The following class of options contains eXperimental */ - /* features in connection with exploiting granularity */ - /* information. I.e. if -bY is chosen these options */ - /* tell the RTS what to do with the supplied info --HWL */ - - case 'W': - if (rts_argv[arg][3] != '\0') { - RtsFlags.GranFlags.packBufferSize_internal = decode(rts_argv[arg]+3); - } else { - RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE; - } - debugBelch("Size of GranSim internal pack buffer: %u.\n", - RtsFlags.GranFlags.packBufferSize_internal); - break; - - case 'X': - switch(rts_argv[arg][3]) { - - case '\0': - RtsFlags.GranFlags.DoPrioritySparking = 1; - debugBelch("Priority Sparking with Normal Priorities.\n"); - RtsFlags.GranFlags.InversePriorities = rtsFalse; - RtsFlags.GranFlags.RandomPriorities = rtsFalse; - RtsFlags.GranFlags.IgnorePriorities = rtsFalse; - break; - - case 'I': - RtsFlags.GranFlags.DoPrioritySparking = 1; - debugBelch("Priority Sparking with Inverse Priorities.\n"); - RtsFlags.GranFlags.InversePriorities++; - break; - - case 'R': - RtsFlags.GranFlags.DoPrioritySparking = 1; - debugBelch("Priority Sparking with Random Priorities.\n"); - RtsFlags.GranFlags.RandomPriorities++; - break; - - case 'N': - RtsFlags.GranFlags.DoPrioritySparking = 1; - debugBelch("Priority Sparking with No Priorities.\n"); - RtsFlags.GranFlags.IgnorePriorities++; - break; - - default: - bad_option( rts_argv[arg] ); - break; - } - break; - - case '-': - switch(rts_argv[arg][3]) { - - case 'C': - RtsFlags.GranFlags.DoAlwaysCreateThreads=rtsFalse; - RtsFlags.GranFlags.DoThreadMigration=rtsFalse; - break; - - case 'G': - RtsFlags.GranFlags.DoBulkFetching=rtsFalse; - break; - - case 'M': - RtsFlags.GranFlags.DoThreadMigration=rtsFalse; - break; - - case 'R': - RtsFlags.GranFlags.DoFairSchedule=rtsFalse; - break; - - case 'T': - RtsFlags.GranFlags.DoStealThreadsFirst=rtsFalse; - RtsFlags.GranFlags.DoThreadMigration=rtsFalse; - break; - - case 'Z': - RtsFlags.GranFlags.DoAsyncFetch=rtsFalse; - break; - - case 'N': - RtsFlags.GranFlags.PreferSparksOfLocalNodes=rtsFalse; - break; - - case 'P': - RtsFlags.GranFlags.GranSimStats.Suppressed=rtsTrue; - break; - - case 's': - RtsFlags.GranFlags.GranSimStats.Sparks=rtsFalse; - break; - - case 'h': - RtsFlags.GranFlags.GranSimStats.Heap=rtsFalse; - break; - - case 'b': - RtsFlags.GranFlags.GranSimStats.Binary=rtsFalse; - break; - - case 'X': - RtsFlags.GranFlags.DoPrioritySparking = rtsFalse; - break; - - case 'Y': - RtsFlags.GranFlags.DoPrioritySparking = rtsFalse; - RtsFlags.GranFlags.SparkPriority = rtsFalse; - break; - - case 'I': - RtsFlags.GranFlags.DoPriorityScheduling = rtsFalse; - break; - - case 'e': - RtsFlags.GranFlags.RandomSteal = rtsFalse; - break; - - default: - bad_option( rts_argv[arg] ); - break; - } - break; - -# if defined(GRAN_CHECK) && defined(GRAN) - case 'D': - switch(rts_argv[arg][3]) { - case 'Q': /* Set pack buffer size (same as 'Q' in GUM) */ - if (rts_argv[arg][4] != '\0') { - RtsFlags.GranFlags.packBufferSize = decode(rts_argv[arg]+4); - debugBelch("Pack buffer size: %d\n", - RtsFlags.GranFlags.packBufferSize); - } else { - debugBelch("setupRtsFlags: missing size of PackBuffer (for -Q)\n"); - *error = rtsTrue; - } - break; - - default: - if (isdigit(rts_argv[arg][3])) {/* Set all debugging options in one */ - /* hack warning: interpret the flags as a binary number */ - nat n = decode(rts_argv[arg]+3); - set_GranSim_debug_options(n); - } else { - nat i; - for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) - if (rts_argv[arg][3] == gran_debug_opts_flags[i]) - break; - - if (i==MAX_GRAN_DEBUG_OPTION+1) { - debugBelch("Valid GranSim debug options are:\n"); - help_GranSim_debug_options(MAX_GRAN_DEBUG_MASK); - bad_option( rts_argv[arg] ); - } else { // flag found; now set it - set_GranSim_debug_options(GRAN_DEBUG_MASK(i)); // 2^i - } - } - break; - -#if 0 - case 'e': /* event trace; also -bD1 */ - debugBelch("DEBUG: event_trace; printing event trace.\n"); - RtsFlags.GranFlags.Debug.event_trace = rtsTrue; - /* RtsFlags.GranFlags.event_trace=rtsTrue; */ - break; - - case 'E': /* event statistics; also -bD2 */ - debugBelch("DEBUG: event_stats; printing event statistics.\n"); - RtsFlags.GranFlags.Debug.event_stats = rtsTrue; - /* RtsFlags.GranFlags.Debug |= 0x20; print event statistics */ - break; - - case 'f': /* thunkStealing; also -bD4 */ - debugBelch("DEBUG: thunkStealing; printing forwarding of FETCHNODES.\n"); - RtsFlags.GranFlags.Debug.thunkStealing = rtsTrue; - /* RtsFlags.GranFlags.Debug |= 0x2; print fwd messages */ - break; - - case 'z': /* blockOnFetch; also -bD8 */ - debugBelch("DEBUG: blockOnFetch; check for blocked on fetch.\n"); - RtsFlags.GranFlags.Debug.blockOnFetch = rtsTrue; - /* RtsFlags.GranFlags.Debug |= 0x4; debug non-reschedule-on-fetch */ - break; - - case 't': /* blockOnFetch_sanity; also -bD16 */ - debugBelch("DEBUG: blockOnFetch_sanity; check for TSO asleep on fetch.\n"); - RtsFlags.GranFlags.Debug.blockOnFetch_sanity = rtsTrue; - /* RtsFlags.GranFlags.Debug |= 0x10; debug TSO asleep for fetch */ - break; - - case 'S': /* priSpark; also -bD32 */ - debugBelch("DEBUG: priSpark; priority sparking.\n"); - RtsFlags.GranFlags.Debug.priSpark = rtsTrue; - break; - - case 's': /* priSched; also -bD64 */ - debugBelch("DEBUG: priSched; priority scheduling.\n"); - RtsFlags.GranFlags.Debug.priSched = rtsTrue; - break; - - case 'F': /* findWork; also -bD128 */ - debugBelch("DEBUG: findWork; searching spark-pools (local & remote), thread queues for work.\n"); - RtsFlags.GranFlags.Debug.findWork = rtsTrue; - break; - - case 'g': /* globalBlock; also -bD256 */ - debugBelch("DEBUG: globalBlock; blocking on remote closures (FETCHMEs etc in GUM).\n"); - RtsFlags.GranFlags.Debug.globalBlock = rtsTrue; - break; - - case 'G': /* pack; also -bD512 */ - debugBelch("DEBUG: pack; routines for (un-)packing graph structures.\n"); - RtsFlags.GranFlags.Debug.pack = rtsTrue; - break; - - case 'P': /* packBuffer; also -bD1024 */ - debugBelch("DEBUG: packBuffer; routines handling pack buffer (GranSim internal!).\n"); - RtsFlags.GranFlags.Debug.packBuffer = rtsTrue; - break; - - case 'o': /* sortedQ; also -bD2048 */ - debugBelch("DEBUG: sortedQ; check whether spark/thread queues are sorted.\n"); - RtsFlags.GranFlags.Debug.sortedQ = rtsTrue; - break; - - case 'r': /* randomSteal; also -bD4096 */ - debugBelch("DEBUG: randomSteal; stealing sparks/threads from random PEs.\n"); - RtsFlags.GranFlags.Debug.randomSteal = rtsTrue; - break; - - case 'q': /* checkSparkQ; also -bD8192 */ - debugBelch("DEBUG: checkSparkQ; check consistency of the spark queues.\n"); - RtsFlags.GranFlags.Debug.checkSparkQ = rtsTrue; - break; - - case ':': /* checkLight; also -bD16384 */ - debugBelch("DEBUG: checkLight; check GranSim-Light setup.\n"); - RtsFlags.GranFlags.Debug.checkLight = rtsTrue; - break; - - case 'b': /* bq; also -bD32768 */ - debugBelch("DEBUG: bq; check blocking queues\n"); - RtsFlags.GranFlags.Debug.bq = rtsTrue; - break; - - case 'd': /* all options turned on */ - debugBelch("DEBUG: all options turned on.\n"); - set_GranSim_debug_options(MAX_GRAN_DEBUG_MASK); - /* RtsFlags.GranFlags.Debug |= 0x40; */ - break; - -/* case '\0': */ -/* RtsFlags.GranFlags.Debug = 1; */ -/* break; */ -#endif - - } - break; -# endif /* GRAN_CHECK */ - default: - bad_option( rts_argv[arg] ); - break; - } -} - -/* - Interpret n as a binary number masking GranSim debug options and set the - correxponding option. See gran_debug_opts_strs for explanations of the flags. -*/ -static void -set_GranSim_debug_options(nat n) { - nat i; - - for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) - if ((n>>i)&1) { - errorBelch(gran_debug_opts_strs[i]); - switch (i) { - case 0: RtsFlags.GranFlags.Debug.event_trace = rtsTrue; break; - case 1: RtsFlags.GranFlags.Debug.event_stats = rtsTrue; break; - case 2: RtsFlags.GranFlags.Debug.bq = rtsTrue; break; - case 3: RtsFlags.GranFlags.Debug.pack = rtsTrue; break; - case 4: RtsFlags.GranFlags.Debug.checkSparkQ = rtsTrue; break; - case 5: RtsFlags.GranFlags.Debug.thunkStealing = rtsTrue; break; - case 6: RtsFlags.GranFlags.Debug.randomSteal = rtsTrue; break; - case 7: RtsFlags.GranFlags.Debug.findWork = rtsTrue; break; - case 8: RtsFlags.GranFlags.Debug.unused = rtsTrue; break; - case 9: RtsFlags.GranFlags.Debug.pri = rtsTrue; break; - case 10: RtsFlags.GranFlags.Debug.checkLight = rtsTrue; break; - case 11: RtsFlags.GranFlags.Debug.sortedQ = rtsTrue; break; - case 12: RtsFlags.GranFlags.Debug.blockOnFetch = rtsTrue; break; - case 13: RtsFlags.GranFlags.Debug.packBuffer = rtsTrue; break; - case 14: RtsFlags.GranFlags.Debug.blockOnFetch_sanity = rtsTrue; break; - default: barf("set_GranSim_debug_options: only %d debug options expected"); - } /* switch */ - } /* if */ -} - -/* - Print one line explanation for each of the GranSim debug options specified - in the bitmask n. -*/ -static void -help_GranSim_debug_options(nat n) { - nat i; - - for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) - if ((n>>i)&1) - debugBelch(gran_debug_opts_strs[i]); -} - -# elif defined(PAR) - -static void -process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) -{ - - if (rts_argv[arg][1] != 'q') { /* All GUM options start with -q */ - errorBelch("Warning: GUM option does not start with -q: %s", rts_argv[arg]); - return; - } - - /* Communication and task creation cost parameters */ - switch(rts_argv[arg][2]) { - case 'e': /* -qe<n> ... allow <n> local sparks */ - if (rts_argv[arg][3] != '\0') { /* otherwise, stick w/ the default */ - RtsFlags.ParFlags.maxLocalSparks - = strtol(rts_argv[arg]+3, (char **) NULL, 10); - - if (RtsFlags.ParFlags.maxLocalSparks <= 0) { - errorBelch("setupRtsFlags: bad value for -e\n"); - *error = rtsTrue; - } - } - IF_PAR_DEBUG(verbose, - errorBelch("-qe<n>: max %d local sparks", - RtsFlags.ParFlags.maxLocalSparks)); - break; - - case 't': - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.maxThreads - = strtol(rts_argv[arg]+3, (char **) NULL, 10); - } else { - errorBelch("missing size for -qt\n"); - *error = rtsTrue; - } - IF_PAR_DEBUG(verbose, - errorBelch("-qt<n>: max %d threads", - RtsFlags.ParFlags.maxThreads)); - break; - - case 'f': - if (rts_argv[arg][3] != '\0') - RtsFlags.ParFlags.maxFishes = decode(rts_argv[arg]+3); - else - RtsFlags.ParFlags.maxFishes = MAX_FISHES; - break; - IF_PAR_DEBUG(verbose, - errorBelch("-qf<n>: max %d fishes sent out at one time", - RtsFlags.ParFlags.maxFishes)); - break; - - case 'F': - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.fishDelay - = strtol(rts_argv[arg]+3, (char **) NULL, 10); - } else { - errorBelch("missing fish delay time for -qF\n"); - *error = rtsTrue; - } - IF_PAR_DEBUG(verbose, - errorBelch("-qF<n>: fish delay time %d us", - RtsFlags.ParFlags.fishDelay)); - break; - - case 'O': - RtsFlags.ParFlags.outputDisabled = rtsTrue; - IF_PAR_DEBUG(verbose, - errorBelch("-qO: output disabled")); - break; - - case 'g': /* -qg<n> ... globalisation scheme */ - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.globalising = decode(rts_argv[arg]+3); - } else { - errorBelch("missing identifier for globalisation scheme (for -qg)\n"); - *error = rtsTrue; - } - IF_PAR_DEBUG(verbose, - debugBelch("-qg<n>: globalisation scheme set to %d", - RtsFlags.ParFlags.globalising)); - break; - - case 'h': /* -qh<n> ... max number of thunks (except root) in packet */ - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.thunksToPack = decode(rts_argv[arg]+3); - } else { - errorBelch("missing number of thunks per packet (for -qh)\n"); - *error = rtsTrue; - } - IF_PAR_DEBUG(verbose, - debugBelch("-qh<n>: thunks per packet set to %d", - RtsFlags.ParFlags.thunksToPack)); - break; - - case 'P': /* -qP for writing a log file */ - //RtsFlags.ParFlags.ParStats.Full = rtsFalse; - /* same encoding as in GranSim after -bP */ - switch(rts_argv[arg][3]) { - case '\0': RtsFlags.ParFlags.ParStats.Full = rtsTrue; - break; // nothing special, just an ordinary profile - case '0': RtsFlags.ParFlags.ParStats.Suppressed = rtsTrue; - RtsFlags.ParFlags.ParStats.Full = rtsFalse; - break; - case 'b': RtsFlags.ParFlags.ParStats.Binary = rtsTrue; - break; - case 's': RtsFlags.ParFlags.ParStats.Sparks = rtsTrue; - break; - //case 'h': RtsFlags.parFlags.ParStats.Heap = rtsTrue; - // break; - case 'n': RtsFlags.ParFlags.ParStats.NewLogfile = rtsTrue; - break; - case 'g': -# if defined(PAR_TICKY) - RtsFlags.ParFlags.ParStats.Global = rtsTrue; -# else - errorBelch("-qPg is only possible for a PAR_TICKY RTS, which this is not"); - stg_exit(EXIT_FAILURE); -# endif - break; - default: barf("Unknown option -qP%c", rts_argv[arg][2]); - } - IF_PAR_DEBUG(verbose, - debugBelch("(-qP) writing to log-file (RtsFlags.ParFlags.ParStats.Full=%s)", - (RtsFlags.ParFlags.ParStats.Full ? "rtsTrue" : "rtsFalse"))); - break; - - case 'Q': /* -qQ<n> ... set pack buffer size to <n> */ - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.packBufferSize = decode(rts_argv[arg]+3); - } else { - errorBelch("missing size of PackBuffer (for -qQ)\n"); - *error = rtsTrue; - } - IF_PAR_DEBUG(verbose, - debugBelch("-qQ<n>: pack buffer size set to %d", - RtsFlags.ParFlags.packBufferSize)); - break; - - case 'R': - RtsFlags.ParFlags.doFairScheduling = rtsTrue; - IF_PAR_DEBUG(verbose, - debugBelch("-qR: fair-ish scheduling")); - break; - -# if defined(DEBUG) - case 'w': - if (rts_argv[arg][3] != '\0') { - RtsFlags.ParFlags.wait - = strtol(rts_argv[arg]+3, (char **) NULL, 10); - } else { - RtsFlags.ParFlags.wait = 1000; - } - IF_PAR_DEBUG(verbose, - debugBelch("-qw<n>: length of wait loop after synchr before reduction: %d", - RtsFlags.ParFlags.wait)); - break; - - case 'D': /* -qD ... all the debugging options */ - if (isdigit(rts_argv[arg][3])) {/* Set all debugging options in one */ - /* hack warning: interpret the flags as a binary number */ - nat n = decode(rts_argv[arg]+3); - set_par_debug_options(n); - } else { - nat i; - for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) - if (rts_argv[arg][3] == par_debug_opts_flags[i]) - break; - - if (i==MAX_PAR_DEBUG_OPTION+1) { - errorBelch("Valid GUM debug options are:\n"); - help_par_debug_options(MAX_PAR_DEBUG_MASK); - bad_option( rts_argv[arg] ); - } else { // flag found; now set it - set_par_debug_options(PAR_DEBUG_MASK(i)); // 2^i - } - } - break; -# endif - default: - errorBelch("Unknown option -q%c (%d opts in total)", - rts_argv[arg][2], *rts_argc); - break; - } /* switch */ -} - -/* - Interpret n as a binary number masking Par debug options and set the - correxponding option. See par_debug_opts_strs for explanations of the flags. -*/ -static void -set_par_debug_options(nat n) { - nat i; - - for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) - if ((n>>i)&1) { - debugBelch(par_debug_opts_strs[i]); - switch (i) { - case 0: RtsFlags.ParFlags.Debug.verbose = rtsTrue; break; - case 1: RtsFlags.ParFlags.Debug.bq = rtsTrue; break; - case 2: RtsFlags.ParFlags.Debug.schedule = rtsTrue; break; - case 3: RtsFlags.ParFlags.Debug.free = rtsTrue; break; - case 4: RtsFlags.ParFlags.Debug.resume = rtsTrue; break; - case 5: RtsFlags.ParFlags.Debug.weight = rtsTrue; break; - case 6: RtsFlags.ParFlags.Debug.fetch = rtsTrue; break; - //case 7: RtsFlags.ParFlags.Debug.ack = rtsTrue; break; - case 7: RtsFlags.ParFlags.Debug.fish = rtsTrue; break; - case 8: RtsFlags.ParFlags.Debug.tables = rtsTrue; break; - case 9: RtsFlags.ParFlags.Debug.packet = rtsTrue; break; - case 10: RtsFlags.ParFlags.Debug.pack = rtsTrue; break; - case 11: RtsFlags.ParFlags.Debug.paranoia = rtsTrue; break; - default: barf("set_par_debug_options: only %d debug options expected", - MAX_PAR_DEBUG_OPTION); - } /* switch */ - } /* if */ -} - -/* - Print one line explanation for each of the GranSim debug options specified - in the bitmask n. -*/ -static void -help_par_debug_options(nat n) { - nat i; - - for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) - if ((n>>i)&1) - debugBelch(par_debug_opts_strs[i]); -} - -#endif /* PAR */ static void stats_fprintf(FILE *f, char *s, ...) diff --git a/rts/RtsMain.c b/rts/RtsMain.c index aa2fe0f6dc..438110a179 100644 --- a/rts/RtsMain.c +++ b/rts/RtsMain.c @@ -26,16 +26,6 @@ # include "Printer.h" /* for printing */ #endif -#ifdef PAR -# include "Parallel.h" -# include "ParallelRts.h" -# include "LLC.h" -#endif - -#if defined(GRAN) || defined(PAR) -# include "GranSimRts.h" -#endif - #ifdef HAVE_WINDOWS_H # include <windows.h> #endif @@ -72,44 +62,6 @@ static void real_main(void) (IAmMainThread is set in startupHaskell) */ -# if defined(PAR) - -# if defined(DEBUG) - { /* a wait loop to allow attachment of gdb to UNIX threads */ - nat i, j, s; - - for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++) - for (j=0; j<1000000; j++) - s += j % 65536; - } - IF_PAR_DEBUG(verbose, - belch("Passed wait loop")); -# endif - - if (IAmMainThread == rtsTrue) { - IF_PAR_DEBUG(verbose, - debugBelch("==== [%x] Main Thread Started ...\n", mytid)); - - /* ToDo: Dump event for the main thread */ - status = rts_mainLazyIO(progmain_closure, NULL); - } else { - /* Just to show we're alive */ - IF_PAR_DEBUG(verbose, - debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n", - mytid)); - - /* all non-main threads enter the scheduler without work */ - taskStart(); - status = Success; // declare victory (see shutdownParallelSystem) - } - -# elif defined(GRAN) - - /* ToDo: Dump event for the main thread */ - status = rts_mainLazyIO(progmain_closure, NULL); - -# else /* !PAR && !GRAN */ - /* ToDo: want to start with a larger stack size */ { Capability *cap = rts_lock(); @@ -119,8 +71,6 @@ static void real_main(void) rts_unlock(cap); } -# endif /* !PAR && !GRAN */ - /* check the status of the entire Haskell computation */ switch (status) { case Killed: @@ -137,12 +87,6 @@ static void real_main(void) case Success: exit_status = EXIT_SUCCESS; break; -#if defined(PAR) - case NoStatus: - errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); - exit_status = EXIT_KILLED; - break; -#endif default: barf("main thread completed with invalid status"); } diff --git a/rts/RtsSignals.h b/rts/RtsSignals.h index 77f22249b2..e130fb4281 100644 --- a/rts/RtsSignals.h +++ b/rts/RtsSignals.h @@ -9,7 +9,7 @@ #ifndef RTS_SIGNALS_H #define RTS_SIGNALS_H -#if !defined(PAR) && !defined(mingw32_HOST_OS) +#if !defined(mingw32_HOST_OS) #include "posix/Signals.h" diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index c9edeace8e..2eae0916bb 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -47,19 +47,6 @@ # include "RetainerProfile.h" #endif -#if defined(GRAN) -# include "GranSimRts.h" -#endif - -#if defined(GRAN) || defined(PAR) -# include "ParallelRts.h" -#endif - -#if defined(PAR) -# include "Parallel.h" -# include "LLC.h" -#endif - #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS) #include "win32/AsyncIO.h" #endif @@ -158,22 +145,6 @@ hs_init(int *argc, char **argv[]) initAllocator(); #endif -#ifdef PAR - /* - * The parallel system needs to be initialised and synchronised before - * the program is run. - */ - startupParallelSystem(argv); - - if (*argv[0] == '-') { /* Strip off mainPE flag argument */ - argv++; - argc--; - } - - argv[1] = argv[0]; /* ignore the nPEs argument */ - argv++; argc--; -#endif - /* Set the RTS flags to default values. */ initRtsFlagsDefaults(); @@ -200,28 +171,11 @@ hs_init(int *argc, char **argv[]) initTracing(); #endif -#if defined(PAR) - /* NB: this really must be done after processing the RTS flags */ - IF_PAR_DEBUG(verbose, - debugBelch("==== Synchronising system (%d PEs)\n", nPEs)); - synchroniseSystem(); // calls initParallelSystem etc -#endif /* PAR */ - /* initialise scheduler data structures (needs to be done before * initStorage()). */ initScheduler(); -#if defined(GRAN) - /* And start GranSim profiling if required: */ - if (RtsFlags.GranFlags.GranSimStats.Full) - init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv); -#elif defined(PAR) - /* And start GUM profiling if required: */ - if (RtsFlags.ParFlags.ParStats.Full) - init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv); -#endif /* PAR || GRAN */ - /* initialize the storage manager */ initStorage(); @@ -427,12 +381,6 @@ hs_exit_(rtsBool wait_foreign) } #endif -#if defined(GRAN) - /* end_gr_simulation prints global stats if requested -- HWL */ - if (!RtsFlags.GranFlags.GranSimStats.Suppressed) - end_gr_simulation(); -#endif - /* stop the ticker */ stopTimer(); exitTimer(); @@ -463,14 +411,6 @@ hs_exit_(rtsBool wait_foreign) } #endif -#if defined(PAR) - /* controlled exit; good thread! */ - shutdownParallelSystem(0); - - /* global statistics in parallel system */ - PAR_TICKY_PAR_END(); -#endif - // uninstall signal handlers resetDefaultHandlers(); @@ -573,12 +513,7 @@ shutdownHaskellAndExit(int n) hs_exit_(rtsFalse); if (hs_init_count == 0) { -#if defined(PAR) - /* really exit (stg_exit() would call shutdownParallelSystem() again) */ - exit(n); -#else stg_exit(n); -#endif } } @@ -595,24 +530,11 @@ shutdownHaskellAndSignal(int sig) * called from STG-land to exit the program */ -#ifdef PAR -static int exit_started=rtsFalse; -#endif - void (*exitFn)(int) = 0; void stg_exit(int n) { -#ifdef PAR - /* HACK: avoid a loop when exiting due to a stupid error */ - if (exit_started) - return; - exit_started=rtsTrue; - - IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid)); - shutdownParallelSystem(n); -#endif if (exitFn) (*exitFn)(n); exit(n); diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index 4d3724df3f..dda9660b14 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -380,43 +380,6 @@ void resetNonBlockingFd(int fd STG_UNUSED) {} void setNonBlockingFd(int fd STG_UNUSED) {} #endif -#ifdef PAR -static ullong startTime = 0; - -/* used in a parallel setup */ -ullong -msTime(void) -{ -# if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH) - struct timespec tv; - - if (getclock(TIMEOFDAY, &tv) != 0) { - fflush(stdout); - fprintf(stderr, "Clock failed\n"); - stg_exit(EXIT_FAILURE); - } - return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime; -# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH) - struct timeval tv; - - if (gettimeofday(&tv, NULL) != 0) { - fflush(stdout); - fprintf(stderr, "Clock failed\n"); - stg_exit(EXIT_FAILURE); - } - return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime; -# else - time_t t; - if ((t = time(NULL)) == (time_t) -1) { - fflush(stdout); - fprintf(stderr, "Clock failed\n"); - stg_exit(EXIT_FAILURE); - } - return t * LL(1000) - startTime; -# endif -} -#endif /* PAR */ - /* ----------------------------------------------------------------------------- Print large numbers, with punctuation. -------------------------------------------------------------------------- */ diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h index c29c959d76..fea1d4191c 100644 --- a/rts/RtsUtils.h +++ b/rts/RtsUtils.h @@ -40,10 +40,6 @@ extern nat stg_strlen(char *str); extern char *time_str(void); extern char *ullong_format_string(ullong, char *, rtsBool); -#ifdef PAR -extern ullong msTime(void); -#endif - #ifdef DEBUG extern void heapCheckFail( void ); #endif diff --git a/rts/Sanity.c b/rts/Sanity.c index 3f4b3cf7b0..02d81ed7ce 100644 --- a/rts/Sanity.c +++ b/rts/Sanity.c @@ -273,13 +273,6 @@ checkClosure( StgClosure* p ) ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value)); -#if 0 -#if defined(PAR) - checkBQ((StgBlockingQueueElement *)mvar->head, p); -#else - checkBQ(mvar->head, p); -#endif -#endif return sizeofW(StgMVar); } @@ -423,37 +416,6 @@ checkClosure( StgClosure* p ) checkTSO((StgTSO *)p); return tso_sizeW((StgTSO *)p); -#if defined(PAR) - - case BLOCKED_FETCH: - ASSERT(LOOKS_LIKE_GA(&(((StgBlockedFetch *)p)->ga))); - ASSERT(LOOKS_LIKE_CLOSURE_PTR((((StgBlockedFetch *)p)->node))); - return sizeofW(StgBlockedFetch); // see size used in evacuate() - -#ifdef DIST - case REMOTE_REF: - return sizeofW(StgFetchMe); -#endif /*DIST */ - - case FETCH_ME: - ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga)); - return sizeofW(StgFetchMe); // see size used in evacuate() - - case FETCH_ME_BQ: - checkBQ(((StgFetchMeBlockingQueue *)p)->blocking_queue, (StgClosure *)p); - return sizeofW(StgFetchMeBlockingQueue); // see size used in evacuate() - - case RBH: - /* In an RBH the BQ may be empty (ie END_BQ_QUEUE) but not NULL */ - ASSERT(((StgRBH *)p)->blocking_queue!=NULL); - if (((StgRBH *)p)->blocking_queue!=END_BQ_QUEUE) - checkBQ(((StgRBH *)p)->blocking_queue, p); - ASSERT(LOOKS_LIKE_INFO_PTR(REVERT_INFOPTR(get_itbl((StgClosure *)p)))); - return BLACKHOLE_sizeW(); // see size used in evacuate() - // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p))); - -#endif - case TVAR_WATCH_QUEUE: { StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p; @@ -513,45 +475,6 @@ checkClosure( StgClosure* p ) } } -#if defined(PAR) - -#define PVM_PE_MASK 0xfffc0000 -#define MAX_PVM_PES MAX_PES -#define MAX_PVM_TIDS MAX_PES -#define MAX_SLOTS 100000 - -rtsBool -looks_like_tid(StgInt tid) -{ - StgInt hi = (tid & PVM_PE_MASK) >> 18; - StgInt lo = (tid & ~PVM_PE_MASK); - rtsBool ok = (hi != 0) && (lo < MAX_PVM_TIDS) && (hi < MAX_PVM_TIDS); - return ok; -} - -rtsBool -looks_like_slot(StgInt slot) -{ - /* if tid is known better use looks_like_ga!! */ - rtsBool ok = slot<MAX_SLOTS; - // This refers only to the no. of slots on the current PE - // rtsBool ok = slot<=highest_slot(); - return ok; -} - -rtsBool -looks_like_ga(globalAddr *ga) -{ - rtsBool is_tid = looks_like_tid((ga)->payload.gc.gtid); - rtsBool is_slot = ((ga)->payload.gc.gtid==mytid) ? - (ga)->payload.gc.slot<=highest_slot() : - (ga)->payload.gc.slot<MAX_SLOTS; - rtsBool ok = is_tid && is_slot; - return ok; -} - -#endif - /* ----------------------------------------------------------------------------- Check Heap Sanity @@ -588,35 +511,6 @@ checkHeap(bdescr *bd) } } -#if defined(PAR) -/* - Check heap between start and end. Used after unpacking graphs. -*/ -void -checkHeapChunk(StgPtr start, StgPtr end) -{ - extern globalAddr *LAGAlookup(StgClosure *addr); - StgPtr p; - nat size; - - for (p=start; p<end; p+=size) { - ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p)); - if (get_itbl((StgClosure*)p)->type == FETCH_ME && - *(p+1) == 0x0000eeee /* ie. unpack garbage (see SetGAandCommonUp) */) { - /* if it's a FM created during unpack and commoned up, it's not global */ - ASSERT(LAGAlookup((StgClosure*)p)==NULL); - size = sizeofW(StgFetchMe); - } else if (get_itbl((StgClosure*)p)->type == IND) { - *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */ - size = sizeofW(StgInd); - } else { - size = checkClosure((StgClosure *)p); - /* This is the smallest size of closure that can live in the heap. */ - ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); - } - } -} -#else /* !PAR */ void checkHeapChunk(StgPtr start, StgPtr end) { @@ -630,7 +524,6 @@ checkHeapChunk(StgPtr start, StgPtr end) ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) ); } } -#endif void checkLargeObjects(bdescr *bd) @@ -665,115 +558,9 @@ checkTSO(StgTSO *tso) ASSERT(stack <= sp && sp < stack_end); -#if defined(PAR) - ASSERT(tso->par.magic==TSO_MAGIC); - - switch (tso->why_blocked) { - case BlockedOnGA: - checkClosureShallow(tso->block_info.closure); - ASSERT(/* Can't be a FETCH_ME because *this* closure is on its BQ */ - get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ); - break; - case BlockedOnGA_NoSend: - checkClosureShallow(tso->block_info.closure); - ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ); - break; - case BlockedOnBlackHole: - checkClosureShallow(tso->block_info.closure); - ASSERT(get_itbl(tso->block_info.closure)->type==BLACKHOLE || - get_itbl(tso->block_info.closure)->type==RBH); - break; - case BlockedOnRead: - case BlockedOnWrite: - case BlockedOnDelay: -#if defined(mingw32_HOST_OS) - case BlockedOnDoProc: -#endif - /* isOnBQ(blocked_queue) */ - break; - case BlockedOnException: - /* isOnSomeBQ(tso) */ - ASSERT(get_itbl(tso->block_info.tso)->type==TSO); - break; - case BlockedOnMVar: - ASSERT(get_itbl(tso->block_info.closure)->type==MVAR); - break; - case BlockedOnSTM: - ASSERT(tso->block_info.closure == END_TSO_QUEUE); - break; - default: - /* - Could check other values of why_blocked but I am more - lazy than paranoid (bad combination) -- HWL - */ - } - - /* if the link field is non-nil it most point to one of these - three closure types */ - ASSERT(tso->link == END_TSO_QUEUE || - get_itbl(tso->link)->type == TSO || - get_itbl(tso->link)->type == BLOCKED_FETCH || - get_itbl(tso->link)->type == CONSTR); -#endif - checkStackChunk(sp, stack_end); } -#if defined(GRAN) -void -checkTSOsSanity(void) { - nat i, tsos; - StgTSO *tso; - - debugBelch("Checking sanity of all runnable TSOs:"); - - for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) { - for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) { - debugBelch("TSO %p on PE %d ...", tso, i); - checkTSO(tso); - debugBelch("OK, "); - tsos++; - } - } - - debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc); -} - - -// still GRAN only - -rtsBool -checkThreadQSanity (PEs proc, rtsBool check_TSO_too) -{ - StgTSO *tso, *prev; - - /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */ - ASSERT(run_queue_hds[proc]!=NULL); - ASSERT(run_queue_tls[proc]!=NULL); - /* if either head or tail is NIL then the other one must be NIL, too */ - ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE); - ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE); - for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE; - tso!=END_TSO_QUEUE; - prev=tso, tso=tso->link) { - ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) && - (prev==END_TSO_QUEUE || prev->link==tso)); - if (check_TSO_too) - checkTSO(tso); - } - ASSERT(prev==run_queue_tls[proc]); -} - -rtsBool -checkThreadQsSanity (rtsBool check_TSO_too) -{ - PEs p; - - for (p=0; p<RtsFlags.GranFlags.proc; p++) - checkThreadQSanity(p, check_TSO_too); -} -#endif /* GRAN */ - /* Check that all TSOs have been evacuated. Optionally also check the sanity of the TSOs. @@ -881,117 +668,4 @@ checkStaticObjects ( StgClosure* static_objects ) } } -/* - Check the sanity of a blocking queue starting at bqe with closure being - the closure holding the blocking queue. - Note that in GUM we can have several different closure types in a - blocking queue -*/ -#if defined(PAR) -void -checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure) -{ - rtsBool end = rtsFalse; - StgInfoTable *info = get_itbl(closure); - - ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH); - - do { - switch (get_itbl(bqe)->type) { - case BLOCKED_FETCH: - case TSO: - checkClosure((StgClosure *)bqe); - bqe = bqe->link; - end = (bqe==END_BQ_QUEUE); - break; - - case CONSTR: - checkClosure((StgClosure *)bqe); - end = rtsTrue; - break; - - default: - barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", - get_itbl(bqe)->type, closure, info_type(closure)); - } - } while (!end); -} -#elif defined(GRAN) -void -checkBQ (StgTSO *bqe, StgClosure *closure) -{ - rtsBool end = rtsFalse; - StgInfoTable *info = get_itbl(closure); - - ASSERT(info->type == MVAR); - - do { - switch (get_itbl(bqe)->type) { - case BLOCKED_FETCH: - case TSO: - checkClosure((StgClosure *)bqe); - bqe = bqe->link; - end = (bqe==END_BQ_QUEUE); - break; - - default: - barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", - get_itbl(bqe)->type, closure, info_type(closure)); - } - } while (!end); -} -#endif - - - -/* - This routine checks the sanity of the LAGA and GALA tables. They are - implemented as lists through one hash table, LAtoGALAtable, because entries - in both tables have the same structure: - - the LAGA table maps local addresses to global addresses; it starts - with liveIndirections - - the GALA table maps global addresses to local addresses; it starts - with liveRemoteGAs -*/ - -#if defined(PAR) -#include "Hash.h" - -/* hidden in parallel/Global.c; only accessed for testing here */ -extern GALA *liveIndirections; -extern GALA *liveRemoteGAs; -extern HashTable *LAtoGALAtable; - -void -checkLAGAtable(rtsBool check_closures) -{ - GALA *gala, *gala0; - nat n=0, m=0; // debugging - - for (gala = liveIndirections; gala != NULL; gala = gala->next) { - n++; - gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); - ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); - ASSERT(gala->next!=gala); // detect direct loops - if ( check_closures ) { - checkClosure((StgClosure *)gala->la); - } - } - - for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) { - m++; - gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la); - ASSERT(!gala->preferred || gala == gala0); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info)); - ASSERT(gala->next!=gala); // detect direct loops - /* - if ( check_closures ) { - checkClosure((StgClosure *)gala->la); - } - */ - } -} -#endif - #endif /* DEBUG */ diff --git a/rts/Sanity.h b/rts/Sanity.h index 65d70539b0..48f3383714 100644 --- a/rts/Sanity.h +++ b/rts/Sanity.h @@ -31,22 +31,7 @@ extern StgOffset checkClosure ( StgClosure* p ); extern void checkMutableList ( bdescr *bd, nat gen ); extern void checkMutableLists ( rtsBool checkTSOs ); -#if defined(GRAN) -extern void checkTSOsSanity(void); -extern rtsBool checkThreadQSanity (PEs proc, rtsBool check_TSO_too); -extern rtsBool checkThreadQsSanity (rtsBool check_TSO_too); -#endif - -#if defined(PAR) -extern void checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure); -#else extern void checkBQ (StgTSO *bqe, StgClosure *closure); -#endif - -#if defined(PAR) -extern void checkLAGAtable(rtsBool check_closures); -extern void checkHeapChunk(StgPtr start, StgPtr end); -#endif /* test whether an object is already on update list */ extern rtsBool isBlackhole( StgTSO* tso, StgClosure* p ); diff --git a/rts/Schedule.c b/rts/Schedule.c index 66860a758b..51a8d2a842 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -158,11 +158,7 @@ static void scheduleCheckWakeupThreads(Capability *cap USED_IF_NOT_THREADS); static void scheduleCheckBlackHoles (Capability *cap); static void scheduleDetectDeadlock (Capability *cap, Task *task); static void schedulePushWork(Capability *cap, Task *task); -#if defined(PARALLEL_HASKELL) -static rtsBool scheduleGetRemoteWork(Capability *cap); -static void scheduleSendPendingMessages(void); -#endif -#if defined(PARALLEL_HASKELL) || defined(THREADED_RTS) +#if defined(THREADED_RTS) static void scheduleActivateSpark(Capability *cap); #endif static void schedulePostRunThread(Capability *cap, StgTSO *t); @@ -208,18 +204,8 @@ static char *whatNext_strs[] = { STATIC_INLINE void addToRunQueue( Capability *cap, StgTSO *t ) { -#if defined(PARALLEL_HASKELL) - if (RtsFlags.ParFlags.doFairScheduling) { - // this does round-robin scheduling; good for concurrency - appendToRunQueue(cap,t); - } else { - // this does unfair scheduling; good for parallelism - pushOnRunQueue(cap,t); - } -#else // this does round-robin scheduling; good for concurrency appendToRunQueue(cap,t); -#endif } /* --------------------------------------------------------------------------- @@ -264,9 +250,6 @@ schedule (Capability *initialCapability, Task *task) StgTSO *t; Capability *cap; StgThreadReturnCode ret; -#if defined(PARALLEL_HASKELL) - rtsBool receivedFinish = rtsFalse; -#endif nat prev_what_next; rtsBool ready_to_gc; #if defined(THREADED_RTS) @@ -296,13 +279,7 @@ schedule (Capability *initialCapability, Task *task) // ----------------------------------------------------------- // Scheduler loop starts here: -#if defined(PARALLEL_HASKELL) -#define TERMINATION_CONDITION (!receivedFinish) -#else -#define TERMINATION_CONDITION rtsTrue -#endif - - while (TERMINATION_CONDITION) { + while (1) { // Check whether we have re-entered the RTS from Haskell without // going via suspendThread()/resumeThread (i.e. a 'safe' foreign @@ -384,21 +361,6 @@ schedule (Capability *initialCapability, Task *task) (pushes threads, wakes up idle capabilities for stealing) */ schedulePushWork(cap,task); -#if defined(PARALLEL_HASKELL) - /* since we perform a blocking receive and continue otherwise, - either we never reach here or we definitely have work! */ - // from here: non-empty run queue - ASSERT(!emptyRunQueue(cap)); - - if (PacketsWaiting()) { /* now process incoming messages, if any - pending... - - CAUTION: scheduleGetRemoteWork called - above, waits for messages as well! */ - processMessages(cap, &receivedFinish); - } -#endif // PARALLEL_HASKELL: non-empty run queue! - scheduleDetectDeadlock(cap,task); #if defined(THREADED_RTS) @@ -692,28 +654,9 @@ scheduleFindWork (Capability *cap) scheduleCheckBlockedThreads(cap); -#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) +#if defined(THREADED_RTS) if (emptyRunQueue(cap)) { scheduleActivateSpark(cap); } #endif - -#if defined(PARALLEL_HASKELL) - // if messages have been buffered... - scheduleSendPendingMessages(); -#endif - -#if defined(PARALLEL_HASKELL) - if (emptyRunQueue(cap)) { - receivedFinish = scheduleGetRemoteWork(cap); - continue; // a new round, (hopefully) with new work - /* - in GUM, this a) sends out a FISH and returns IF no fish is - out already - b) (blocking) awaits and receives messages - - in Eden, this is only the blocking receive, as b) in GUM. - */ - } -#endif } #if defined(THREADED_RTS) @@ -1000,12 +943,6 @@ scheduleCheckBlackHoles (Capability *cap) static void scheduleDetectDeadlock (Capability *cap, Task *task) { - -#if defined(PARALLEL_HASKELL) - // ToDo: add deadlock detection in GUM (similar to THREADED_RTS) -- HWL - return; -#endif - /* * Detect deadlock: when we have no threads to run, there are no * threads blocked, waiting for I/O, or sleeping, and all the @@ -1110,7 +1047,7 @@ scheduleSendPendingMessages(void) * Activate spark threads (PARALLEL_HASKELL and THREADED_RTS) * ------------------------------------------------------------------------- */ -#if defined(PARALLEL_HASKELL) || defined(THREADED_RTS) +#if defined(THREADED_RTS) static void scheduleActivateSpark(Capability *cap) { @@ -1123,51 +1060,6 @@ scheduleActivateSpark(Capability *cap) #endif // PARALLEL_HASKELL || THREADED_RTS /* ---------------------------------------------------------------------------- - * Get work from a remote node (PARALLEL_HASKELL only) - * ------------------------------------------------------------------------- */ - -#if defined(PARALLEL_HASKELL) -static rtsBool /* return value used in PARALLEL_HASKELL only */ -scheduleGetRemoteWork (Capability *cap STG_UNUSED) -{ -#if defined(PARALLEL_HASKELL) - rtsBool receivedFinish = rtsFalse; - - // idle() , i.e. send all buffers, wait for work - if (RtsFlags.ParFlags.BufferTime) { - IF_PAR_DEBUG(verbose, - debugBelch("...send all pending data,")); - { - nat i; - for (i=1; i<=nPEs; i++) - sendImmediately(i); // send all messages away immediately - } - } - - /* this would be the place for fishing in GUM... - - if (no-earlier-fish-around) - sendFish(choosePe()); - */ - - // Eden:just look for incoming messages (blocking receive) - IF_PAR_DEBUG(verbose, - debugBelch("...wait for incoming messages...\n")); - processMessages(cap, &receivedFinish); // blocking receive... - - - return receivedFinish; - // reenter scheduling look after having received something - -#else /* !PARALLEL_HASKELL, i.e. THREADED_RTS */ - - return rtsFalse; /* return value unused in THREADED_RTS */ - -#endif /* PARALLEL_HASKELL */ -} -#endif // PARALLEL_HASKELL || THREADED_RTS - -/* ---------------------------------------------------------------------------- * After running a thread... * ------------------------------------------------------------------------- */ @@ -1378,7 +1270,7 @@ scheduleHandleYield( Capability *cap, StgTSO *t, nat prev_what_next ) static void scheduleHandleThreadBlocked( StgTSO *t -#if !defined(GRAN) && !defined(DEBUG) +#if !defined(DEBUG) STG_UNUSED #endif ) @@ -2198,7 +2090,7 @@ initScheduler(void) initTaskManager(); -#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) +#if defined(THREADED_RTS) initSparkPools(); #endif @@ -2409,13 +2301,6 @@ threadStackOverflow(Capability *cap, StgTSO *tso) tso->sp = (P_)&(tso->stack[tso->stack_size]); tso->why_blocked = NotBlocked; - IF_PAR_DEBUG(verbose, - debugBelch("@@ threadStackOverflow of TSO %d (now at %p): stack size increased to %ld\n", - tso->id, tso, tso->stack_size); - /* If we're debugging, just print out the top of the stack */ - printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size, - tso->sp+64))); - unlockTSO(dest); unlockTSO(tso); diff --git a/rts/Schedule.h b/rts/Schedule.h index 97ee78e66c..0e18168755 100644 --- a/rts/Schedule.h +++ b/rts/Schedule.h @@ -37,13 +37,7 @@ void scheduleThreadOn(Capability *cap, StgWord cpu, StgTSO *tso); * Called from STG : yes * Locks assumed : none */ -#if defined(GRAN) -void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); -#elif defined(PAR) -void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); -#else void awakenBlockedQueue (Capability *cap, StgTSO *tso); -#endif /* wakeUpRts() * @@ -75,20 +69,10 @@ StgWord findRetryFrameHelper (StgTSO *tso); void OSThreadProcAttr workerStart(Task *task); #endif -#if defined(GRAN) -void awaken_blocked_queue(StgBlockingQueueElement *q, StgClosure *node); -void unlink_from_bq(StgTSO* tso, StgClosure* node); -void initThread(StgTSO *tso, nat stack_size, StgInt pri); -#elif defined(PAR) -nat run_queue_len(void); -void awaken_blocked_queue(StgBlockingQueueElement *q, StgClosure *node); -void initThread(StgTSO *tso, nat stack_size); -#else char *info_type(StgClosure *closure); // dummy char *info_type_by_ip(StgInfoTable *ip); // dummy void awaken_blocked_queue(StgTSO *q); void initThread(StgTSO *tso, nat stack_size); -#endif /* The state of the scheduler. This is used to control the sequence * of events during shutdown, and when the runtime is interrupted @@ -121,15 +105,11 @@ extern volatile StgWord recent_activity; * * In GranSim we have one run/blocked_queue per PE. */ -#if defined(GRAN) -// run_queue_hds defined in GranSim.h -#else extern StgTSO *RTS_VAR(blackhole_queue); #if !defined(THREADED_RTS) extern StgTSO *RTS_VAR(blocked_queue_hd), *RTS_VAR(blocked_queue_tl); extern StgTSO *RTS_VAR(sleeping_queue); #endif -#endif /* Set to rtsTrue if there are threads on the blackhole_queue, and * it is possible that one or more of them may be available to run. @@ -163,9 +143,6 @@ void printAllThreads(void); #ifdef DEBUG void print_bq (StgClosure *node); #endif -#if defined(PAR) -void print_bqe (StgBlockingQueueElement *bqe); -#endif /* ----------------------------------------------------------------------------- * Some convenient macros/inline functions... diff --git a/rts/Sparks.c b/rts/Sparks.c index 2167de0dcf..0fe8b61b81 100644 --- a/rts/Sparks.c +++ b/rts/Sparks.c @@ -21,21 +21,16 @@ #include "Sparks.h" -#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) +#if defined(THREADED_RTS) void initSparkPools( void ) { -#ifdef THREADED_RTS /* walk over the capabilities, allocating a spark pool for each one */ nat i; for (i = 0; i < n_capabilities; i++) { capabilities[i].sparks = newWSDeque(RtsFlags.ParFlags.maxLocalSparks); } -#else - /* allocate a single spark pool */ - MainCapability->sparks = newWSDeque(RtsFlags.ParFlags.maxLocalSparks); -#endif } void @@ -317,657 +312,4 @@ newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED) return 1; } - -#endif /* PARALLEL_HASKELL || THREADED_RTS */ - - -/* ----------------------------------------------------------------------------- - * - * GRAN & PARALLEL_HASKELL stuff beyond here. - * - * TODO "nuke" this! - * - * -------------------------------------------------------------------------- */ - -#if defined(PARALLEL_HASKELL) || defined(GRAN) - -static void slide_spark_pool( StgSparkPool *pool ); - -rtsBool -add_to_spark_queue( StgClosure *closure, StgSparkPool *pool ) -{ - if (pool->tl == pool->lim) - slide_spark_pool(pool); - - if (closure_SHOULD_SPARK(closure) && - pool->tl < pool->lim) { - *(pool->tl++) = closure; - -#if defined(PARALLEL_HASKELL) - // collect parallel global statistics (currently done together with GC stats) - if (RtsFlags.ParFlags.ParStats.Global && - RtsFlags.GcFlags.giveStats > NO_GC_STATS) { - // debugBelch("Creating spark for %x @ %11.2f\n", closure, usertime()); - globalParStats.tot_sparks_created++; - } -#endif - return rtsTrue; - } else { -#if defined(PARALLEL_HASKELL) - // collect parallel global statistics (currently done together with GC stats) - if (RtsFlags.ParFlags.ParStats.Global && - RtsFlags.GcFlags.giveStats > NO_GC_STATS) { - //debugBelch("Ignoring spark for %x @ %11.2f\n", closure, usertime()); - globalParStats.tot_sparks_ignored++; - } -#endif - return rtsFalse; - } -} - -static void -slide_spark_pool( StgSparkPool *pool ) -{ - StgClosure **sparkp, **to_sparkp; - - sparkp = pool->hd; - to_sparkp = pool->base; - while (sparkp < pool->tl) { - ASSERT(to_sparkp<=sparkp); - ASSERT(*sparkp!=NULL); - ASSERT(LOOKS_LIKE_GHC_INFO((*sparkp)->header.info)); - - if (closure_SHOULD_SPARK(*sparkp)) { - *to_sparkp++ = *sparkp++; - } else { - sparkp++; - } - } - pool->hd = pool->base; - pool->tl = to_sparkp; -} - -void -disposeSpark(spark) -StgClosure *spark; -{ -#if !defined(THREADED_RTS) - Capability *cap; - StgSparkPool *pool; - - cap = &MainRegTable; - pool = &(cap->rSparks); - ASSERT(pool->hd <= pool->tl && pool->tl <= pool->lim); -#endif - ASSERT(spark != (StgClosure *)NULL); - /* Do nothing */ -} - - -#elif defined(GRAN) - -/* - Search the spark queue of the proc in event for a spark that's worth - turning into a thread - (was gimme_spark in the old RTS) -*/ -void -findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res) -{ - PEs proc = event->proc, /* proc to search for work */ - creator = event->creator; /* proc that requested work */ - StgClosure* node; - rtsBool found; - rtsSparkQ spark_of_non_local_node = NULL, - spark_of_non_local_node_prev = NULL, - low_priority_spark = NULL, - low_priority_spark_prev = NULL, - spark = NULL, prev = NULL; - - /* Choose a spark from the local spark queue */ - prev = (rtsSpark*)NULL; - spark = pending_sparks_hds[proc]; - found = rtsFalse; - - // ToDo: check this code & implement local sparking !! -- HWL - while (!found && spark != (rtsSpark*)NULL) - { - ASSERT((prev!=(rtsSpark*)NULL || spark==pending_sparks_hds[proc]) && - (prev==(rtsSpark*)NULL || prev->next==spark) && - (spark->prev==prev)); - node = spark->node; - if (!closure_SHOULD_SPARK(node)) - { - IF_GRAN_DEBUG(checkSparkQ, - debugBelch("^^ pruning spark %p (node %p) in gimme_spark", - spark, node)); - - if (RtsFlags.GranFlags.GranSimStats.Sparks) - DumpRawGranEvent(proc, (PEs)0, SP_PRUNED,(StgTSO*)NULL, - spark->node, spark->name, spark_queue_len(proc)); - - ASSERT(spark != (rtsSpark*)NULL); - ASSERT(SparksAvail>0); - --SparksAvail; - - ASSERT(prev==(rtsSpark*)NULL || prev->next==spark); - spark = delete_from_sparkq (spark, proc, rtsTrue); - if (spark != (rtsSpark*)NULL) - prev = spark->prev; - continue; - } - /* -- node should eventually be sparked */ - else if (RtsFlags.GranFlags.PreferSparksOfLocalNodes && - !IS_LOCAL_TO(PROCS(node),CurrentProc)) - { - barf("Local sparking not yet implemented"); - - /* Remember first low priority spark */ - if (spark_of_non_local_node==(rtsSpark*)NULL) { - spark_of_non_local_node_prev = prev; - spark_of_non_local_node = spark; - } - - if (spark->next == (rtsSpark*)NULL) { - /* ASSERT(spark==SparkQueueTl); just for testing */ - prev = spark_of_non_local_node_prev; - spark = spark_of_non_local_node; - found = rtsTrue; - break; - } - -# if defined(GRAN) && defined(GRAN_CHECK) - /* Should never happen; just for testing - if (spark==pending_sparks_tl) { - debugBelch("ReSchedule: Last spark != SparkQueueTl\n"); - stg_exit(EXIT_FAILURE); - } */ -# endif - prev = spark; - spark = spark->next; - ASSERT(SparksAvail>0); - --SparksAvail; - continue; - } - else if ( RtsFlags.GranFlags.DoPrioritySparking || - (spark->gran_info >= RtsFlags.GranFlags.SparkPriority2) ) - { - if (RtsFlags.GranFlags.DoPrioritySparking) - barf("Priority sparking not yet implemented"); - - found = rtsTrue; - } -#if 0 - else /* only used if SparkPriority2 is defined */ - { - /* ToDo: fix the code below and re-integrate it */ - /* Remember first low priority spark */ - if (low_priority_spark==(rtsSpark*)NULL) { - low_priority_spark_prev = prev; - low_priority_spark = spark; - } - - if (spark->next == (rtsSpark*)NULL) { - /* ASSERT(spark==spark_queue_tl); just for testing */ - prev = low_priority_spark_prev; - spark = low_priority_spark; - found = rtsTrue; /* take low pri spark => rc is 2 */ - break; - } - - /* Should never happen; just for testing - if (spark==pending_sparks_tl) { - debugBelch("ReSchedule: Last spark != SparkQueueTl\n"); - stg_exit(EXIT_FAILURE); - break; - } */ - prev = spark; - spark = spark->next; - - IF_GRAN_DEBUG(pri, - debugBelch("++ Ignoring spark of priority %u (SparkPriority=%u); node=%p; name=%u\n", - spark->gran_info, RtsFlags.GranFlags.SparkPriority, - spark->node, spark->name);) - } -#endif - } /* while (spark!=NULL && !found) */ - - *spark_res = spark; - *found_res = found; -} - -/* - Turn the spark into a thread. - In GranSim this basically means scheduling a StartThread event for the - node pointed to by the spark at some point in the future. - (was munch_spark in the old RTS) -*/ -rtsBool -activateSpark (rtsEvent *event, rtsSparkQ spark) -{ - PEs proc = event->proc, /* proc to search for work */ - creator = event->creator; /* proc that requested work */ - StgTSO* tso; - StgClosure* node; - rtsTime spark_arrival_time; - - /* - We've found a node on PE proc requested by PE creator. - If proc==creator we can turn the spark into a thread immediately; - otherwise we schedule a MoveSpark event on the requesting PE - */ - - /* DaH Qu' yIchen */ - if (proc!=creator) { - - /* only possible if we simulate GUM style fishing */ - ASSERT(RtsFlags.GranFlags.Fishing); - - /* Message packing costs for sending a Fish; qeq jabbI'ID */ - CurrentTime[proc] += RtsFlags.GranFlags.Costs.mpacktime; - - if (RtsFlags.GranFlags.GranSimStats.Sparks) - DumpRawGranEvent(proc, (PEs)0, SP_EXPORTED, - (StgTSO*)NULL, spark->node, - spark->name, spark_queue_len(proc)); - - /* time of the spark arrival on the remote PE */ - spark_arrival_time = CurrentTime[proc] + RtsFlags.GranFlags.Costs.latency; - - new_event(creator, proc, spark_arrival_time, - MoveSpark, - (StgTSO*)NULL, spark->node, spark); - - CurrentTime[proc] += RtsFlags.GranFlags.Costs.mtidytime; - - } else { /* proc==creator i.e. turn the spark into a thread */ - - if ( RtsFlags.GranFlags.GranSimStats.Global && - spark->gran_info < RtsFlags.GranFlags.SparkPriority2 ) { - - globalGranStats.tot_low_pri_sparks++; - IF_GRAN_DEBUG(pri, - debugBelch("++ No high priority spark available; low priority (%u) spark chosen: node=%p; name=%u\n", - spark->gran_info, - spark->node, spark->name)); - } - - CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadcreatetime; - - node = spark->node; - -# if 0 - /* ToDo: fix the GC interface and move to StartThread handling-- HWL */ - if (GARBAGE COLLECTION IS NECESSARY) { - /* Some kind of backoff needed here in case there's too little heap */ -# if defined(GRAN_CHECK) && defined(GRAN) - if (RtsFlags.GcFlags.giveStats) - fprintf(RtsFlags.GcFlags.statsFile,"***** vIS Qu' chen veQ boSwI'; spark=%p, node=%p; name=%u\n", - /* (found==2 ? "no hi pri spark" : "hi pri spark"), */ - spark, node, spark->name); -# endif - new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc]+1, - FindWork, - (StgTSO*)NULL, (StgClosure*)NULL, (rtsSpark*)NULL); - barf("//// activateSpark: out of heap ; ToDo: call GarbageCollect()"); - GarbageCollect(GetRoots, rtsFalse); - // HWL old: ReallyPerformThreadGC(TSO_HS+TSO_CTS_SIZE,rtsFalse); - // HWL old: SAVE_Hp -= TSO_HS+TSO_CTS_SIZE; - spark = NULL; - return; /* was: continue; */ /* to the next event, eventually */ - } -# endif - - if (RtsFlags.GranFlags.GranSimStats.Sparks) - DumpRawGranEvent(CurrentProc,(PEs)0,SP_USED,(StgTSO*)NULL, - spark->node, spark->name, - spark_queue_len(CurrentProc)); - - new_event(proc, proc, CurrentTime[proc], - StartThread, - END_TSO_QUEUE, node, spark); // (rtsSpark*)NULL); - - procStatus[proc] = Starting; - } -} - -/* ------------------------------------------------------------------------- - This is the main point where handling granularity information comes into - play. - ------------------------------------------------------------------------- */ - -#define MAX_RAND_PRI 100 - -/* - Granularity info transformers. - Applied to the GRAN_INFO field of a spark. -*/ -STATIC_INLINE nat ID(nat x) { return(x); }; -STATIC_INLINE nat INV(nat x) { return(-x); }; -STATIC_INLINE nat IGNORE(nat x) { return (0); }; -STATIC_INLINE nat RAND(nat x) { return ((random() % MAX_RAND_PRI) + 1); } - -/* NB: size_info and par_info are currently unused (what a shame!) -- HWL */ -rtsSpark * -newSpark(node,name,gran_info,size_info,par_info,local) -StgClosure *node; -nat name, gran_info, size_info, par_info, local; -{ - nat pri; - rtsSpark *newspark; - - pri = RtsFlags.GranFlags.RandomPriorities ? RAND(gran_info) : - RtsFlags.GranFlags.InversePriorities ? INV(gran_info) : - RtsFlags.GranFlags.IgnorePriorities ? IGNORE(gran_info) : - ID(gran_info); - - if ( RtsFlags.GranFlags.SparkPriority!=0 && - pri<RtsFlags.GranFlags.SparkPriority ) { - IF_GRAN_DEBUG(pri, - debugBelch(",, NewSpark: Ignoring spark of priority %u (SparkPriority=%u); node=%#x; name=%u\n", - pri, RtsFlags.GranFlags.SparkPriority, node, name)); - return ((rtsSpark*)NULL); - } - - newspark = (rtsSpark*) stgMallocBytes(sizeof(rtsSpark), "NewSpark"); - newspark->prev = newspark->next = (rtsSpark*)NULL; - newspark->node = node; - newspark->name = (name==1) ? CurrentTSO->gran.sparkname : name; - newspark->gran_info = pri; - newspark->global = !local; /* Check that with parAt, parAtAbs !!*/ - - if (RtsFlags.GranFlags.GranSimStats.Global) { - globalGranStats.tot_sparks_created++; - globalGranStats.sparks_created_on_PE[CurrentProc]++; - } - - return(newspark); -} - -void -disposeSpark(spark) -rtsSpark *spark; -{ - ASSERT(spark!=NULL); - stgFree(spark); -} - -void -disposeSparkQ(spark) -rtsSparkQ spark; -{ - if (spark==NULL) - return; - - disposeSparkQ(spark->next); - -# ifdef GRAN_CHECK - if (SparksAvail < 0) { - debugBelch("disposeSparkQ: SparksAvail<0 after disposing sparkq @ %p\n", &spark); - print_spark(spark); - } -# endif - - stgFree(spark); -} - -/* - With PrioritySparking add_to_spark_queue performs an insert sort to keep - the spark queue sorted. Otherwise the spark is just added to the end of - the queue. -*/ - -void -add_to_spark_queue(spark) -rtsSpark *spark; -{ - rtsSpark *prev = NULL, *next = NULL; - nat count = 0; - rtsBool found = rtsFalse; - - if ( spark == (rtsSpark *)NULL ) { - return; - } - - if (RtsFlags.GranFlags.DoPrioritySparking && (spark->gran_info != 0) ) { - /* Priority sparking is enabled i.e. spark queues must be sorted */ - - for (prev = NULL, next = pending_sparks_hd, count=0; - (next != NULL) && - !(found = (spark->gran_info >= next->gran_info)); - prev = next, next = next->next, count++) - {} - - } else { /* 'utQo' */ - /* Priority sparking is disabled */ - - found = rtsFalse; /* to add it at the end */ - - } - - if (found) { - /* next points to the first spark with a gran_info smaller than that - of spark; therefore, add spark before next into the spark queue */ - spark->next = next; - if ( next == NULL ) { - pending_sparks_tl = spark; - } else { - next->prev = spark; - } - spark->prev = prev; - if ( prev == NULL ) { - pending_sparks_hd = spark; - } else { - prev->next = spark; - } - } else { /* (RtsFlags.GranFlags.DoPrioritySparking && !found) || !DoPrioritySparking */ - /* add the spark at the end of the spark queue */ - spark->next = NULL; - spark->prev = pending_sparks_tl; - if (pending_sparks_hd == NULL) - pending_sparks_hd = spark; - else - pending_sparks_tl->next = spark; - pending_sparks_tl = spark; - } - ++SparksAvail; - - /* add costs for search in priority sparking */ - if (RtsFlags.GranFlags.DoPrioritySparking) { - CurrentTime[CurrentProc] += count * RtsFlags.GranFlags.Costs.pri_spark_overhead; - } - - IF_GRAN_DEBUG(checkSparkQ, - debugBelch("++ Spark stats after adding spark %p (node %p) to queue on PE %d", - spark, spark->node, CurrentProc); - print_sparkq_stats()); - -# if defined(GRAN_CHECK) - if (RtsFlags.GranFlags.Debug.checkSparkQ) { - for (prev = NULL, next = pending_sparks_hd; - (next != NULL); - prev = next, next = next->next) - {} - if ( (prev!=NULL) && (prev!=pending_sparks_tl) ) - debugBelch("SparkQ inconsistency after adding spark %p: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n", - spark,CurrentProc, - pending_sparks_tl, prev); - } -# endif - -# if defined(GRAN_CHECK) - /* Check if the sparkq is still sorted. Just for testing, really! */ - if ( RtsFlags.GranFlags.Debug.checkSparkQ && - RtsFlags.GranFlags.Debug.pri ) { - rtsBool sorted = rtsTrue; - rtsSpark *prev, *next; - - if (pending_sparks_hd == NULL || - pending_sparks_hd->next == NULL ) { - /* just 1 elem => ok */ - } else { - for (prev = pending_sparks_hd, - next = pending_sparks_hd->next; - (next != NULL) ; - prev = next, next = next->next) { - sorted = sorted && - (prev->gran_info >= next->gran_info); - } - } - if (!sorted) { - debugBelch("ghuH: SPARKQ on PE %d is not sorted:\n", - CurrentProc); - print_sparkq(CurrentProc); - } - } -# endif -} - -nat -spark_queue_len(proc) -PEs proc; -{ - rtsSpark *prev, *spark; /* prev only for testing !! */ - nat len; - - for (len = 0, prev = NULL, spark = pending_sparks_hds[proc]; - spark != NULL; - len++, prev = spark, spark = spark->next) - {} - -# if defined(GRAN_CHECK) - if ( RtsFlags.GranFlags.Debug.checkSparkQ ) - if ( (prev!=NULL) && (prev!=pending_sparks_tls[proc]) ) - debugBelch("ERROR in spark_queue_len: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n", - proc, pending_sparks_tls[proc], prev); -# endif - - return (len); -} - -/* - Take spark out of the spark queue on PE p and nuke the spark. Adjusts - hd and tl pointers of the spark queue. Returns a pointer to the next - spark in the queue. -*/ -rtsSpark * -delete_from_sparkq (spark, p, dispose_too) /* unlink and dispose spark */ -rtsSpark *spark; -PEs p; -rtsBool dispose_too; -{ - rtsSpark *new_spark; - - if (spark==NULL) - barf("delete_from_sparkq: trying to delete NULL spark\n"); - -# if defined(GRAN_CHECK) - if ( RtsFlags.GranFlags.Debug.checkSparkQ ) { - debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p)\n", - pending_sparks_hd, pending_sparks_tl, - spark->prev, spark, spark->next, - (spark->next==NULL ? 0 : spark->next->prev)); - } -# endif - - if (spark->prev==NULL) { - /* spark is first spark of queue => adjust hd pointer */ - ASSERT(pending_sparks_hds[p]==spark); - pending_sparks_hds[p] = spark->next; - } else { - spark->prev->next = spark->next; - } - if (spark->next==NULL) { - ASSERT(pending_sparks_tls[p]==spark); - /* spark is first spark of queue => adjust tl pointer */ - pending_sparks_tls[p] = spark->prev; - } else { - spark->next->prev = spark->prev; - } - new_spark = spark->next; - -# if defined(GRAN_CHECK) - if ( RtsFlags.GranFlags.Debug.checkSparkQ ) { - debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p); spark=%p will be deleted NOW \n", - pending_sparks_hd, pending_sparks_tl, - spark->prev, spark, spark->next, - (spark->next==NULL ? 0 : spark->next->prev), spark); - } -# endif - - if (dispose_too) - disposeSpark(spark); - - return new_spark; -} - -/* Mark all nodes pointed to by sparks in the spark queues (for GC) */ -void -markSparkQueue(void) -{ - StgClosure *MarkRoot(StgClosure *root); // prototype - PEs p; - rtsSpark *sp; - - for (p=0; p<RtsFlags.GranFlags.proc; p++) - for (sp=pending_sparks_hds[p]; sp!=NULL; sp=sp->next) { - ASSERT(sp->node!=NULL); - ASSERT(LOOKS_LIKE_GHC_INFO(sp->node->header.info)); - // ToDo?: statistics gathering here (also for GUM!) - sp->node = (StgClosure *)MarkRoot(sp->node); - } - - IF_DEBUG(gc, - debugBelch("markSparkQueue: spark statistics at start of GC:"); - print_sparkq_stats()); -} - -void -print_spark(spark) -rtsSpark *spark; -{ - char str[16]; - - if (spark==NULL) { - debugBelch("Spark: NIL\n"); - return; - } else { - sprintf(str, - ((spark->node==NULL) ? "______" : "%#6lx"), - stgCast(StgPtr,spark->node)); - - debugBelch("Spark: Node %8s, Name %#6x, Global %5s, Creator %5x, Prev %6p, Next %6p\n", - str, spark->name, - ((spark->global)==rtsTrue?"True":"False"), spark->creator, - spark->prev, spark->next); - } -} - -void -print_sparkq(proc) -PEs proc; -// rtsSpark *hd; -{ - rtsSpark *x = pending_sparks_hds[proc]; - - debugBelch("Spark Queue of PE %d with root at %p:\n", proc, x); - for (; x!=(rtsSpark*)NULL; x=x->next) { - print_spark(x); - } -} - -/* - Print a statistics of all spark queues. -*/ -void -print_sparkq_stats(void) -{ - PEs p; - - debugBelch("SparkQs: ["); - for (p=0; p<RtsFlags.GranFlags.proc; p++) - debugBelch(", PE %d: %d", p, spark_queue_len(p)); - debugBelch("\n"); -} - -#endif +#endif /* THREADED_RTS */ diff --git a/rts/Sparks.h b/rts/Sparks.h index 105742f04f..df037b5c4f 100644 --- a/rts/Sparks.h +++ b/rts/Sparks.h @@ -11,10 +11,6 @@ #include "WSDeque.h" -#if defined(PARALLEL_HASKELL) -#error Sparks.c using new internal structure, needs major overhaul! -#endif - /* typedef for SparkPool in RtsTypes.h */ #if defined(THREADED_RTS) diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 639ac7e03a..95b22a9211 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -289,11 +289,6 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN */ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE") { -#if defined(GRAN) - /* Before overwriting TSO_LINK */ - STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/); -#endif - TICK_ENT_BH(); #ifdef THREADED_RTS @@ -319,48 +314,9 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE") jump stg_block_blackhole; } -#if defined(PAR) || defined(GRAN) - -INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH") -{ -# if defined(GRAN) - /* mainly statistics gathering for GranSim simulation */ - STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/); -# endif - - /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */ - /* Put ourselves on the blocking queue for this black hole */ - TSO_link(CurrentTSO) = StgBlockingQueue_blocking_queue(R1); - StgBlockingQueue_blocking_queue(R1) = CurrentTSO; - /* jot down why and on what closure we are blocked */ - TSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16; - TSO_block_info(CurrentTSO) = R1; - - /* PAR: dumping of event now done in blockThread -- HWL */ - - /* stg_gen_block is too heavyweight, use a specialised one */ - jump stg_block_1; -} - -INFO_TABLE(stg_RBH_Save_0,0,2,CONSTR,"RBH_Save_0","RBH_Save_0") -{ foreign "C" barf("RBH_Save_0 object entered!") never returns; } - -INFO_TABLE(stg_RBH_Save_1,1,1,CONSTR,"RBH_Save_1","RBH_Save_1"); -{ foreign "C" barf("RBH_Save_1 object entered!") never returns; } - -INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2"); -{ foreign "C" barf("RBH_Save_2 object entered!") never returns; } - -#endif /* defined(PAR) || defined(GRAN) */ - /* identical to BLACKHOLEs except for the infotag */ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE") { -#if defined(GRAN) - /* mainly statistics gathering for GranSim simulation */ - STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/); -#endif - TICK_ENT_BH(); LDV_ENTER(R1); diff --git a/rts/Threads.c b/rts/Threads.c index 0bc725c942..1d871a5856 100644 --- a/rts/Threads.c +++ b/rts/Threads.c @@ -47,14 +47,8 @@ static StgThreadID next_thread_id = 1; currently pri (priority) is only used in a GRAN setup -- HWL ------------------------------------------------------------------------ */ -#if defined(GRAN) -/* currently pri (priority) is only used in a GRAN setup -- HWL */ -StgTSO * -createThread(nat size, StgInt pri) -#else StgTSO * createThread(Capability *cap, nat size) -#endif { StgTSO *tso; nat stack_size; @@ -62,20 +56,6 @@ createThread(Capability *cap, nat size) /* sched_mutex is *not* required */ /* First check whether we should create a thread at all */ -#if defined(PARALLEL_HASKELL) - /* check that no more than RtsFlags.ParFlags.maxThreads threads are created */ - if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) { - threadsIgnored++; - debugBelch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)\n", - RtsFlags.ParFlags.maxThreads, advisory_thread_count); - return END_TSO_QUEUE; - } - threadsCreated++; -#endif - -#if defined(GRAN) - ASSERT(!RtsFlags.GranFlags.Light || CurrentProc==0); -#endif // ToDo: check whether size = stack_size - TSO_STRUCT_SIZEW @@ -91,9 +71,6 @@ createThread(Capability *cap, nat size) TICK_ALLOC_TSO(stack_size, 0); SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM); -#if defined(GRAN) - SET_GRAN_HDR(tso, ThisPE); -#endif // Always start with the compiled code evaluator tso->what_next = ThreadRunGHC; @@ -122,26 +99,6 @@ createThread(Capability *cap, nat size) SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_SYSTEM); tso->_link = END_TSO_QUEUE; - // ToDo: check this -#if defined(GRAN) - /* uses more flexible routine in GranSim */ - insertThread(tso, CurrentProc); -#else - /* In a non-GranSim setup the pushing of a TSO onto the runq is separated - * from its creation - */ -#endif - -#if defined(GRAN) - if (RtsFlags.GranFlags.GranSimStats.Full) - DumpGranEvent(GR_START,tso); -#elif defined(PARALLEL_HASKELL) - if (RtsFlags.ParFlags.ParStats.Full) - DumpGranEvent(GR_STARTQ,tso); - /* HACk to avoid SCHEDULE - LastTSO = tso; */ -#endif - /* Link the new thread on the global thread list. */ ACQUIRE_LOCK(&sched_mutex); @@ -150,116 +107,14 @@ createThread(Capability *cap, nat size) g0s0->threads = tso; RELEASE_LOCK(&sched_mutex); -#if defined(DIST) - tso->dist.priority = MandatoryPriority; //by default that is... -#endif - -#if defined(GRAN) - tso->gran.pri = pri; -# if defined(DEBUG) - tso->gran.magic = TSO_MAGIC; // debugging only -# endif - tso->gran.sparkname = 0; - tso->gran.startedat = CURRENT_TIME; - tso->gran.exported = 0; - tso->gran.basicblocks = 0; - tso->gran.allocs = 0; - tso->gran.exectime = 0; - tso->gran.fetchtime = 0; - tso->gran.fetchcount = 0; - tso->gran.blocktime = 0; - tso->gran.blockcount = 0; - tso->gran.blockedat = 0; - tso->gran.globalsparks = 0; - tso->gran.localsparks = 0; - if (RtsFlags.GranFlags.Light) - tso->gran.clock = Now; /* local clock */ - else - tso->gran.clock = 0; - - IF_DEBUG(gran,printTSO(tso)); -#elif defined(PARALLEL_HASKELL) -# if defined(DEBUG) - tso->par.magic = TSO_MAGIC; // debugging only -# endif - tso->par.sparkname = 0; - tso->par.startedat = CURRENT_TIME; - tso->par.exported = 0; - tso->par.basicblocks = 0; - tso->par.allocs = 0; - tso->par.exectime = 0; - tso->par.fetchtime = 0; - tso->par.fetchcount = 0; - tso->par.blocktime = 0; - tso->par.blockcount = 0; - tso->par.blockedat = 0; - tso->par.globalsparks = 0; - tso->par.localsparks = 0; -#endif - -#if defined(GRAN) - globalGranStats.tot_threads_created++; - globalGranStats.threads_created_on_PE[CurrentProc]++; - globalGranStats.tot_sq_len += spark_queue_len(CurrentProc); - globalGranStats.tot_sq_probes++; -#elif defined(PARALLEL_HASKELL) - // collect parallel global statistics (currently done together with GC stats) - if (RtsFlags.ParFlags.ParStats.Global && - RtsFlags.GcFlags.giveStats > NO_GC_STATS) { - //debugBelch("Creating thread %d @ %11.2f\n", tso->id, usertime()); - globalParStats.tot_threads_created++; - } -#endif - postEvent (cap, EVENT_CREATE_THREAD, tso->id, 0); -#if defined(GRAN) - debugTrace(GRAN_DEBUG_pri, - "==__ schedule: Created TSO %d (%p);", - CurrentProc, tso, tso->id); -#elif defined(PARALLEL_HASKELL) - debugTrace(PAR_DEBUG_verbose, - "==__ schedule: Created TSO %d (%p); %d threads active", - (long)tso->id, tso, advisory_thread_count); -#else debugTrace(DEBUG_sched, "created thread %ld, stack size = %lx words", (long)tso->id, (long)tso->stack_size); -#endif return tso; } -#if defined(PAR) -/* RFP: - all parallel thread creation calls should fall through the following routine. -*/ -StgTSO * -createThreadFromSpark(rtsSpark spark) -{ StgTSO *tso; - ASSERT(spark != (rtsSpark)NULL); -// JB: TAKE CARE OF THIS COUNTER! BUGGY - if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) - { threadsIgnored++; - barf("{createSparkThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)", - RtsFlags.ParFlags.maxThreads, advisory_thread_count); - return END_TSO_QUEUE; - } - else - { threadsCreated++; - tso = createThread(RtsFlags.GcFlags.initialStkSize); - if (tso==END_TSO_QUEUE) - barf("createSparkThread: Cannot create TSO"); -#if defined(DIST) - tso->priority = AdvisoryPriority; -#endif - pushClosure(tso,spark); - addToRunQueue(tso); - advisory_thread_count++; // JB: TAKE CARE OF THIS COUNTER! BUGGY - } - return tso; -} -#endif - /* --------------------------------------------------------------------------- * Comparing Thread ids. * @@ -352,131 +207,6 @@ removeThreadFromMVarQueue (Capability *cap, StgMVar *mvar, StgTSO *tso) unblock a single thread. ------------------------------------------------------------------------- */ -#if defined(GRAN) -STATIC_INLINE void -unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node ) -{ -} -#elif defined(PARALLEL_HASKELL) -STATIC_INLINE void -unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node ) -{ - /* write RESUME events to log file and - update blocked and fetch time (depending on type of the orig closure) */ - if (RtsFlags.ParFlags.ParStats.Full) { - DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC, - GR_RESUMEQ, ((StgTSO *)bqe), ((StgTSO *)bqe)->block_info.closure, - 0, 0 /* spark_queue_len(ADVISORY_POOL) */); - if (emptyRunQueue()) - emitSchedule = rtsTrue; - - switch (get_itbl(node)->type) { - case FETCH_ME_BQ: - ((StgTSO *)bqe)->par.fetchtime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat; - break; - case RBH: - case FETCH_ME: - case BLACKHOLE_BQ: - ((StgTSO *)bqe)->par.blocktime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat; - break; -#ifdef DIST - case MVAR: - break; -#endif - default: - barf("{unblockOne}Daq Qagh: unexpected closure in blocking queue"); - } - } -} -#endif - -#if defined(GRAN) -StgBlockingQueueElement * -unblockOne(StgBlockingQueueElement *bqe, StgClosure *node) -{ - StgTSO *tso; - PEs node_loc, tso_loc; - - node_loc = where_is(node); // should be lifted out of loop - tso = (StgTSO *)bqe; // wastes an assignment to get the type right - tso_loc = where_is((StgClosure *)tso); - if (IS_LOCAL_TO(PROCS(node),tso_loc)) { // TSO is local - /* !fake_fetch => TSO is on CurrentProc is same as IS_LOCAL_TO */ - ASSERT(CurrentProc!=node_loc || tso_loc==CurrentProc); - CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.lunblocktime; - // insertThread(tso, node_loc); - new_event(tso_loc, tso_loc, CurrentTime[CurrentProc], - ResumeThread, - tso, node, (rtsSpark*)NULL); - tso->link = END_TSO_QUEUE; // overwrite link just to be sure - // len_local++; - // len++; - } else { // TSO is remote (actually should be FMBQ) - CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mpacktime + - RtsFlags.GranFlags.Costs.gunblocktime + - RtsFlags.GranFlags.Costs.latency; - new_event(tso_loc, CurrentProc, CurrentTime[CurrentProc], - UnblockThread, - tso, node, (rtsSpark*)NULL); - tso->link = END_TSO_QUEUE; // overwrite link just to be sure - // len++; - } - /* the thread-queue-overhead is accounted for in either Resume or UnblockThread */ - IF_GRAN_DEBUG(bq, - debugBelch(" %s TSO %d (%p) [PE %d] (block_info.closure=%p) (next=%p) ,", - (node_loc==tso_loc ? "Local" : "Global"), - tso->id, tso, CurrentProc, tso->block_info.closure, tso->link)); - tso->block_info.closure = NULL; - debugTrace(DEBUG_sched, "-- waking up thread %ld (%p)", - tso->id, tso)); -} -#elif defined(PARALLEL_HASKELL) -StgBlockingQueueElement * -unblockOne(StgBlockingQueueElement *bqe, StgClosure *node) -{ - StgBlockingQueueElement *next; - - switch (get_itbl(bqe)->type) { - case TSO: - ASSERT(((StgTSO *)bqe)->why_blocked != NotBlocked); - /* if it's a TSO just push it onto the run_queue */ - next = bqe->link; - ((StgTSO *)bqe)->link = END_TSO_QUEUE; // debugging? - APPEND_TO_RUN_QUEUE((StgTSO *)bqe); - threadRunnable(); - unblockCount(bqe, node); - /* reset blocking status after dumping event */ - ((StgTSO *)bqe)->why_blocked = NotBlocked; - break; - - case BLOCKED_FETCH: - /* if it's a BLOCKED_FETCH put it on the PendingFetches list */ - next = bqe->link; - bqe->link = (StgBlockingQueueElement *)PendingFetches; - PendingFetches = (StgBlockedFetch *)bqe; - break; - -# if defined(DEBUG) - /* can ignore this case in a non-debugging setup; - see comments on RBHSave closures above */ - case CONSTR: - /* check that the closure is an RBHSave closure */ - ASSERT(get_itbl((StgClosure *)bqe) == &stg_RBH_Save_0_info || - get_itbl((StgClosure *)bqe) == &stg_RBH_Save_1_info || - get_itbl((StgClosure *)bqe) == &stg_RBH_Save_2_info); - break; - - default: - barf("{unblockOne}Daq Qagh: Unexpected IP (%#lx; %s) in blocking queue at %#lx\n", - get_itbl((StgClosure *)bqe), info_type((StgClosure *)bqe), - (StgClosure *)bqe); -# endif - } - IF_PAR_DEBUG(bq, debugBelch(", %p (%s)\n", bqe, info_type((StgClosure*)bqe))); - return next; -} -#endif - StgTSO * unblockOne (Capability *cap, StgTSO *tso) { @@ -541,119 +271,6 @@ unblockOne_ (Capability *cap, StgTSO *tso, wakes up all the threads on the specified queue. ------------------------------------------------------------------------- */ -#if defined(GRAN) -void -awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) -{ - StgBlockingQueueElement *bqe; - PEs node_loc; - nat len = 0; - - IF_GRAN_DEBUG(bq, - debugBelch("##-_ AwBQ for node %p on PE %d @ %ld by TSO %d (%p): \n", \ - node, CurrentProc, CurrentTime[CurrentProc], - CurrentTSO->id, CurrentTSO)); - - node_loc = where_is(node); - - ASSERT(q == END_BQ_QUEUE || - get_itbl(q)->type == TSO || // q is either a TSO or an RBHSave - get_itbl(q)->type == CONSTR); // closure (type constructor) - ASSERT(is_unique(node)); - - /* FAKE FETCH: magically copy the node to the tso's proc; - no Fetch necessary because in reality the node should not have been - moved to the other PE in the first place - */ - if (CurrentProc!=node_loc) { - IF_GRAN_DEBUG(bq, - debugBelch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)\n", - node, node_loc, CurrentProc, CurrentTSO->id, - // CurrentTSO, where_is(CurrentTSO), - node->header.gran.procs)); - node->header.gran.procs = (node->header.gran.procs) | PE_NUMBER(CurrentProc); - IF_GRAN_DEBUG(bq, - debugBelch("## new bitmask of node %p is %#x\n", - node, node->header.gran.procs)); - if (RtsFlags.GranFlags.GranSimStats.Global) { - globalGranStats.tot_fake_fetches++; - } - } - - bqe = q; - // ToDo: check: ASSERT(CurrentProc==node_loc); - while (get_itbl(bqe)->type==TSO) { // q != END_TSO_QUEUE) { - //next = bqe->link; - /* - bqe points to the current element in the queue - next points to the next element in the queue - */ - //tso = (StgTSO *)bqe; // wastes an assignment to get the type right - //tso_loc = where_is(tso); - len++; - bqe = unblockOne(bqe, node); - } - - /* if this is the BQ of an RBH, we have to put back the info ripped out of - the closure to make room for the anchor of the BQ */ - if (bqe!=END_BQ_QUEUE) { - ASSERT(get_itbl(node)->type == RBH && get_itbl(bqe)->type == CONSTR); - /* - ASSERT((info_ptr==&RBH_Save_0_info) || - (info_ptr==&RBH_Save_1_info) || - (info_ptr==&RBH_Save_2_info)); - */ - /* cf. convertToRBH in RBH.c for writing the RBHSave closure */ - ((StgRBH *)node)->blocking_queue = (StgBlockingQueueElement *)((StgRBHSave *)bqe)->payload[0]; - ((StgRBH *)node)->mut_link = (StgMutClosure *)((StgRBHSave *)bqe)->payload[1]; - - IF_GRAN_DEBUG(bq, - debugBelch("## Filled in RBH_Save for %p (%s) at end of AwBQ\n", - node, info_type(node))); - } - - /* statistics gathering */ - if (RtsFlags.GranFlags.GranSimStats.Global) { - // globalGranStats.tot_bq_processing_time += bq_processing_time; - globalGranStats.tot_bq_len += len; // total length of all bqs awakened - // globalGranStats.tot_bq_len_local += len_local; // same for local TSOs only - globalGranStats.tot_awbq++; // total no. of bqs awakened - } - IF_GRAN_DEBUG(bq, - debugBelch("## BQ Stats of %p: [%d entries] %s\n", - node, len, (bqe!=END_BQ_QUEUE) ? "RBH" : "")); -} -#elif defined(PARALLEL_HASKELL) -void -awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) -{ - StgBlockingQueueElement *bqe; - - IF_PAR_DEBUG(verbose, - debugBelch("##-_ AwBQ for node %p on [%x]: \n", - node, mytid)); -#ifdef DIST - //RFP - if(get_itbl(q)->type == CONSTR || q==END_BQ_QUEUE) { - IF_PAR_DEBUG(verbose, debugBelch("## ... nothing to unblock so lets just return. RFP (BUG?)\n")); - return; - } -#endif - - ASSERT(q == END_BQ_QUEUE || - get_itbl(q)->type == TSO || - get_itbl(q)->type == BLOCKED_FETCH || - get_itbl(q)->type == CONSTR); - - bqe = q; - while (get_itbl(bqe)->type==TSO || - get_itbl(bqe)->type==BLOCKED_FETCH) { - bqe = unblockOne(bqe, node); - } -} - -#else /* !GRAN && !PARALLEL_HASKELL */ - void awakenBlockedQueue(Capability *cap, StgTSO *tso) { @@ -661,8 +278,6 @@ awakenBlockedQueue(Capability *cap, StgTSO *tso) tso = unblockOne(cap,tso); } } -#endif - /* --------------------------------------------------------------------------- * rtsSupportsBoundThreads(): is the RTS built to support bound threads? @@ -728,16 +343,6 @@ printThreadBlockage(StgTSO *tso) case NotBlocked: debugBelch("is not blocked"); break; -#if defined(PARALLEL_HASKELL) - case BlockedOnGA: - debugBelch("is blocked on global address; local FM_BQ is %p (%s)", - tso->block_info.closure, info_type(tso->block_info.closure)); - break; - case BlockedOnGA_NoSend: - debugBelch("is blocked on global address (no send); local FM_BQ is %p (%s)", - tso->block_info.closure, info_type(tso->block_info.closure)); - break; -#endif case BlockedOnCCall: debugBelch("is blocked on an external call"); break; @@ -841,153 +446,4 @@ printThreadQueue(StgTSO *t) debugBelch("%d threads on queue\n", i); } -/* - Print a whole blocking queue attached to node (debugging only). -*/ -# if defined(PARALLEL_HASKELL) -void -print_bq (StgClosure *node) -{ - StgBlockingQueueElement *bqe; - StgTSO *tso; - rtsBool end; - - debugBelch("## BQ of closure %p (%s): ", - node, info_type(node)); - - /* should cover all closures that may have a blocking queue */ - ASSERT(get_itbl(node)->type == BLACKHOLE_BQ || - get_itbl(node)->type == FETCH_ME_BQ || - get_itbl(node)->type == RBH || - get_itbl(node)->type == MVAR); - - ASSERT(node!=(StgClosure*)NULL); // sanity check - - print_bqe(((StgBlockingQueue*)node)->blocking_queue); -} - -/* - Print a whole blocking queue starting with the element bqe. -*/ -void -print_bqe (StgBlockingQueueElement *bqe) -{ - rtsBool end; - - /* - NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure; - */ - for (end = (bqe==END_BQ_QUEUE); - !end; // iterate until bqe points to a CONSTR - end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), - bqe = end ? END_BQ_QUEUE : bqe->link) { - ASSERT(bqe != END_BQ_QUEUE); // sanity check - ASSERT(bqe != (StgBlockingQueueElement *)NULL); // sanity check - /* types of closures that may appear in a blocking queue */ - ASSERT(get_itbl(bqe)->type == TSO || - get_itbl(bqe)->type == BLOCKED_FETCH || - get_itbl(bqe)->type == CONSTR); - /* only BQs of an RBH end with an RBH_Save closure */ - //ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH); - - switch (get_itbl(bqe)->type) { - case TSO: - debugBelch(" TSO %u (%x),", - ((StgTSO *)bqe)->id, ((StgTSO *)bqe)); - break; - case BLOCKED_FETCH: - debugBelch(" BF (node=%p, ga=((%x, %d, %x)),", - ((StgBlockedFetch *)bqe)->node, - ((StgBlockedFetch *)bqe)->ga.payload.gc.gtid, - ((StgBlockedFetch *)bqe)->ga.payload.gc.slot, - ((StgBlockedFetch *)bqe)->ga.weight); - break; - case CONSTR: - debugBelch(" %s (IP %p),", - (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" : - get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" : - get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" : - "RBH_Save_?"), get_itbl(bqe)); - break; - default: - barf("Unexpected closure type %s in blocking queue", // of %p (%s)", - info_type((StgClosure *)bqe)); // , node, info_type(node)); - break; - } - } /* for */ - debugBelch("\n"); -} -# elif defined(GRAN) -void -print_bq (StgClosure *node) -{ - StgBlockingQueueElement *bqe; - PEs node_loc, tso_loc; - rtsBool end; - - /* should cover all closures that may have a blocking queue */ - ASSERT(get_itbl(node)->type == BLACKHOLE_BQ || - get_itbl(node)->type == FETCH_ME_BQ || - get_itbl(node)->type == RBH); - - ASSERT(node!=(StgClosure*)NULL); // sanity check - node_loc = where_is(node); - - debugBelch("## BQ of closure %p (%s) on [PE %d]: ", - node, info_type(node), node_loc); - - /* - NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure; - */ - for (bqe = ((StgBlockingQueue*)node)->blocking_queue, end = (bqe==END_BQ_QUEUE); - !end; // iterate until bqe points to a CONSTR - end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), bqe = end ? END_BQ_QUEUE : bqe->link) { - ASSERT(bqe != END_BQ_QUEUE); // sanity check - ASSERT(bqe != (StgBlockingQueueElement *)NULL); // sanity check - /* types of closures that may appear in a blocking queue */ - ASSERT(get_itbl(bqe)->type == TSO || - get_itbl(bqe)->type == CONSTR); - /* only BQs of an RBH end with an RBH_Save closure */ - ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH); - - tso_loc = where_is((StgClosure *)bqe); - switch (get_itbl(bqe)->type) { - case TSO: - debugBelch(" TSO %d (%p) on [PE %d],", - ((StgTSO *)bqe)->id, (StgTSO *)bqe, tso_loc); - break; - case CONSTR: - debugBelch(" %s (IP %p),", - (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" : - get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" : - get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" : - "RBH_Save_?"), get_itbl(bqe)); - break; - default: - barf("Unexpected closure type %s in blocking queue of %p (%s)", - info_type((StgClosure *)bqe), node, info_type(node)); - break; - } - } /* for */ - debugBelch("\n"); -} -# endif - -#if defined(PARALLEL_HASKELL) -nat -run_queue_len(void) -{ - nat i; - StgTSO *tso; - - for (i=0, tso=run_queue_hd; - tso != END_TSO_QUEUE; - i++, tso=tso->link) { - /* nothing */ - } - - return i; -} -#endif - #endif /* DEBUG */ diff --git a/rts/Threads.h b/rts/Threads.h index 541ca873fb..f6d2dfd11a 100644 --- a/rts/Threads.h +++ b/rts/Threads.h @@ -9,19 +9,10 @@ #ifndef THREADS_H #define THREADS_H -#if defined(GRAN) || defined(PARALLEL_HASKELL) -StgBlockingQueueElement * unblockOne (StgBlockingQueueElement *bqe, - StgClosure *node); -#else StgTSO * unblockOne (Capability *cap, StgTSO *tso); StgTSO * unblockOne_ (Capability *cap, StgTSO *tso, rtsBool allow_migrate); -#endif -#if defined(GRAN) || defined(PARALLEL_HASKELL) -void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); -#else void awakenBlockedQueue (Capability *cap, StgTSO *tso); -#endif void removeThreadFromMVarQueue (Capability *cap, StgMVar *mvar, StgTSO *tso); void removeThreadFromQueue (Capability *cap, StgTSO **queue, StgTSO *tso); diff --git a/rts/Ticky.c b/rts/Ticky.c index 9ec5099d66..d319d18f09 100644 --- a/rts/Ticky.c +++ b/rts/Ticky.c @@ -38,33 +38,21 @@ PrintTickyInfo(void) unsigned long tot_allocs = /* total number of things allocated */ ALLOC_FUN_ctr + ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr + + ALLOC_TSO_ctr + ALLOC_BH_ctr + ALLOC_PAP_ctr + ALLOC_PRIM_ctr -#ifdef PAR - + ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr -#endif ; unsigned long tot_adm_wds = /* total number of admin words allocated */ ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm + ALLOC_TSO_adm + ALLOC_BH_adm + ALLOC_PAP_adm + ALLOC_PRIM_adm -#ifdef PAR - + ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm -#endif ; unsigned long tot_gds_wds = /* total number of words of ``good stuff'' allocated */ ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds + ALLOC_TSO_gds + ALLOC_BH_gds + ALLOC_PAP_gds + ALLOC_PRIM_gds -#ifdef PAR - + ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds -#endif ; unsigned long tot_slp_wds = /* total number of ``slop'' words allocated */ ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp + ALLOC_TSO_slp + ALLOC_BH_slp + ALLOC_PAP_slp + ALLOC_PRIM_slp -#ifdef PAR - + ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp -#endif ; unsigned long tot_wds = /* total words */ @@ -190,23 +178,6 @@ PrintTickyInfo(void) PC(INTAVG(ALLOC_TSO_ctr, tot_allocs))); if (ALLOC_TSO_ctr != 0) fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO)); -#ifdef PAR - fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_FMBQ_ctr, - PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs))); - if (ALLOC_FMBQ_ctr != 0) - fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ)); - fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_FME_ctr, - PC(INTAVG(ALLOC_FME_ctr, tot_allocs))); - if (ALLOC_FME_ctr != 0) - fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME)); - fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_BF_ctr, - PC(INTAVG(ALLOC_BF_ctr, tot_allocs))); - if (ALLOC_BF_ctr != 0) - fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF)); -#endif fprintf(tf,"\n"); @@ -419,36 +390,6 @@ PrintTickyInfo(void) PR_HST(ALLOC_TSO_hst,2); PR_HST(ALLOC_TSO_hst,3); PR_HST(ALLOC_TSO_hst,4); - -#ifdef PAR - PR_CTR(ALLOC_FMBQ_ctr); - PR_CTR(ALLOC_FMBQ_adm); - PR_CTR(ALLOC_FMBQ_gds); - PR_CTR(ALLOC_FMBQ_slp); - PR_HST(ALLOC_FMBQ_hst,0); - PR_HST(ALLOC_FMBQ_hst,1); - PR_HST(ALLOC_FMBQ_hst,2); - PR_HST(ALLOC_FMBQ_hst,3); - PR_HST(ALLOC_FMBQ_hst,4); - PR_CTR(ALLOC_FME_ctr); - PR_CTR(ALLOC_FME_adm); - PR_CTR(ALLOC_FME_gds); - PR_CTR(ALLOC_FME_slp); - PR_HST(ALLOC_FME_hst,0); - PR_HST(ALLOC_FME_hst,1); - PR_HST(ALLOC_FME_hst,2); - PR_HST(ALLOC_FME_hst,3); - PR_HST(ALLOC_FME_hst,4); - PR_CTR(ALLOC_BF_ctr); - PR_CTR(ALLOC_BF_adm); - PR_CTR(ALLOC_BF_gds); - PR_CTR(ALLOC_BF_slp); - PR_HST(ALLOC_BF_hst,0); - PR_HST(ALLOC_BF_hst,1); - PR_HST(ALLOC_BF_hst,2); - PR_HST(ALLOC_BF_hst,3); - PR_HST(ALLOC_BF_hst,4); -#endif */ PR_CTR(ENT_VIA_NODE_ctr); diff --git a/rts/Trace.c b/rts/Trace.c index bd32091a12..63d4816585 100644 --- a/rts/Trace.c +++ b/rts/Trace.c @@ -50,8 +50,6 @@ void initTracing (void) DEBUG_FLAG(stm, DEBUG_stm); DEBUG_FLAG(prof, DEBUG_prof); DEBUG_FLAG(eventlog, DEBUG_eventlog); - DEBUG_FLAG(gran, DEBUG_gran); - DEBUG_FLAG(par, DEBUG_par); DEBUG_FLAG(linker, DEBUG_linker); DEBUG_FLAG(squeeze, DEBUG_squeeze); DEBUG_FLAG(hpc, DEBUG_hpc); diff --git a/rts/Updates.h b/rts/Updates.h index 10fa09b0e5..843be84131 100644 --- a/rts/Updates.h +++ b/rts/Updates.h @@ -60,61 +60,6 @@ Awaken any threads waiting on a blocking queue (BLACKHOLE_BQ). -------------------------------------------------------------------------- */ -#if defined(PAR) - -/* - In a parallel setup several types of closures might have a blocking queue: - BLACKHOLE_BQ ... same as in the default concurrent setup; it will be - reawakened via calling UPD_IND on that closure after - having finished the computation of the graph - FETCH_ME_BQ ... a global indirection (FETCH_ME) may be entered by a - local TSO, turning it into a FETCH_ME_BQ; it will be - reawakened via calling processResume - RBH ... a revertible black hole may be entered by another - local TSO, putting it onto its blocking queue; since - RBHs only exist while the corresponding closure is in - transit, they will be reawakened via calling - convertToFetchMe (upon processing an ACK message) - - In a parallel setup a blocking queue may contain 3 types of closures: - TSO ... as in the default concurrent setup - BLOCKED_FETCH ... indicating that a TSO on another PE is waiting for - the result of the current computation - CONSTR ... an RBHSave closure (which contains data ripped out of - the closure to make room for a blocking queue; since - it only contains data we use the exisiting type of - a CONSTR closure); this closure is the end of a - blocking queue for an RBH closure; it only exists in - this kind of blocking queue and must be at the end - of the queue -*/ -extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); -#define DO_AWAKEN_BQ(bqe, node) STGCALL2(awakenBlockedQueue, bqe, node); - -#define AWAKEN_BQ(info,closure) \ - if (info == &stg_BLACKHOLE_BQ_info || \ - info == &stg_FETCH_ME_BQ_info || \ - get_itbl(closure)->type == RBH) { \ - DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure); \ - } - -#elif defined(GRAN) - -extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); -#define DO_AWAKEN_BQ(bq, node) STGCALL2(awakenBlockedQueue, bq, node); - -/* In GranSim we don't have FETCH_ME or FETCH_ME_BQ closures, so they are - not checked. The rest of the code is the same as for GUM. -*/ -#define AWAKEN_BQ(info,closure) \ - if (info == &stg_BLACKHOLE_BQ_info || \ - get_itbl(closure)->type == RBH) { \ - DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure); \ - } - -#endif /* GRAN || PAR */ - - /* ----------------------------------------------------------------------------- Updates: lower-level macros which update a closure with an indirection to another closure. diff --git a/rts/hooks/InitEachPE.c b/rts/hooks/InitEachPE.c deleted file mode 100644 index cc9cdc0dba..0000000000 --- a/rts/hooks/InitEachPE.c +++ /dev/null @@ -1,23 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * User-overridable RTS hooks. - * - * ---------------------------------------------------------------------------*/ - -#include "Rts.h" - -#ifdef PAR -void -InitEachPEHook (void) -{ /* In a GUM setup this is called on each - PE immediately before SynchroniseSystem. - It can be used to read in static data - to each PE which has to be available to - each PE. See GPH-Maple as an example how to - use this in combination with foreign language - code: - http://www.risc.uni-linz.ac.at/software/ghc-maple/ - -- HWL - */ -} -#endif diff --git a/rts/hooks/ShutdownEachPEHook.c b/rts/hooks/ShutdownEachPEHook.c deleted file mode 100644 index f5e3ba9344..0000000000 --- a/rts/hooks/ShutdownEachPEHook.c +++ /dev/null @@ -1,19 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * User-overridable RTS hooks. - * - * ---------------------------------------------------------------------------*/ - -#include "Rts.h" - -#ifdef PAR -void -ShutdownEachPEHook (void) -{ /* In a GUM setup this routine is called at the end of - shutdownParallelSystem on each PE. Useful for - cleaning up stuff, especially when interfacing - with foreign language code. - -- HWL - */ -} -#endif |