From: hwloidl Date: Fri, 14 Jan 2000 11:45:22 +0000 (+0000) Subject: [project @ 2000-01-14 11:45:21 by hwloidl] X-Git-Tag: Approximately_9120_patches~5294 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4a939ead4265ab68ac24e63c50260afc3731dea2;p=ghc-hetmet.git [project @ 2000-01-14 11:45:21 by hwloidl] Bugfix (raiseError in non-enterable closures); added GranSim code to Schedule.c --- diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs index 33a873a..75c556f 100644 --- a/ghc/compiler/codeGen/CgStackery.lhs +++ b/ghc/compiler/codeGen/CgStackery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgStackery.lhs,v 1.13 2000/01/13 14:33:58 hwloidl Exp $ +% $Id: CgStackery.lhs,v 1.14 2000/01/14 11:45:21 hwloidl Exp $ % \section[CgStackery]{Stack management functions} @@ -225,9 +225,9 @@ getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1 \end{code} \begin{code} -updateFrameSize | opt_SccProfilingOn = trace ("updateFrameSize = " ++ (show sCC_UF_SIZE)) sCC_UF_SIZE +updateFrameSize | opt_SccProfilingOn = sCC_UF_SIZE | opt_GranMacros = trace ("updateFrameSize = " ++ (show gRAN_UF_SIZE))gRAN_UF_SIZE - | otherwise = trace ("updateFrameSize = " ++ (show uF_SIZE)) uF_SIZE + | otherwise = uF_SIZE seqFrameSize | opt_SccProfilingOn = sCC_SEQ_FRAME_SIZE | opt_GranMacros = gRAN_SEQ_FRAME_SIZE diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc index 7fdd6fd..d74ecec 100644 --- a/ghc/rts/Exception.hc +++ b/ghc/rts/Exception.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Exception.hc,v 1.3 2000/01/13 14:34:02 hwloidl Exp $ + * $Id: Exception.hc,v 1.4 2000/01/14 11:45:21 hwloidl Exp $ * * (c) The GHC Team, 1998-1999 * @@ -66,7 +66,8 @@ FN_(unblockAsyncExceptionszh_ret_entry) FB_ ASSERT(CurrentTSO->blocked_exceptions != NULL); #if defined(GRAN) -# error FixME + awakenBlockedQueue(CurrentTSO->blocked_exceptions, + CurrentTSO->block_info.closure); #elif defined(PAR) // is CurrentTSO->block_info.closure always set to the node // holding the blocking queue !? -- HWL @@ -89,7 +90,8 @@ FN_(unblockAsyncExceptionszh_fast) if (CurrentTSO->blocked_exceptions != NULL) { #if defined(GRAN) -# error FixME + awakenBlockedQueue(CurrentTSO->blocked_exceptions, + CurrentTSO->block_info.closure); #elif defined(PAR) // is CurrentTSO->block_info.closure always set to the node // holding the blocking queue !? -- HWL diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 8a2db25..bb9df77 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.39 2000/01/13 14:34:03 hwloidl Exp $ + * $Id: PrimOps.hc,v 1.40 2000/01/14 11:45:21 hwloidl Exp $ * * (c) The GHC Team, 1998-1999 * @@ -908,7 +908,7 @@ FN_(putMVarzh_fast) if (mvar->head != (StgTSO *)&END_TSO_QUEUE_closure) { ASSERT(mvar->head->why_blocked == BlockedOnMVar); #if defined(GRAN) -# error FixME + mvar->head = RET_STGCALL2(StgTSO *,unblockOne,mvar->head,mvar); #elif defined(PAR) // ToDo: check 2nd arg (mvar) is right mvar->head = RET_STGCALL2(StgTSO *,unblockOne,mvar->head,mvar); diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index d87f7ab..9b7cdf4 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.41 2000/01/13 14:34:05 hwloidl Exp $ + * $Id: Schedule.c,v 1.42 2000/01/14 11:45:21 hwloidl Exp $ * * (c) The GHC Team, 1998-1999 * @@ -1082,7 +1082,9 @@ createThread_(nat size, rtsBool have_lock) /* uses more flexible routine in GranSim */ insertThread(tso, CurrentProc); #else - add_to_run_queue(tso); + /* In a non-GranSim setup the pushing of a TSO onto the runq is separated + from its creation + */ #endif #if defined(GRAN) @@ -1720,7 +1722,10 @@ threadStackOverflow(StgTSO *tso) // ToDo: check push_on_run_queue vs. PUSH_ON_RUN_QUEUE #if defined(GRAN) -# error FixME +static inline void +unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node ) +{ +} #elif defined(PAR) static inline void unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node ) @@ -1749,7 +1754,67 @@ unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node ) #endif #if defined(GRAN) -# error FixME +static StgBlockingQueueElement * +unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node) +{ + StgBlockingQueueElement *next; + 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(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); + bq_processing_time += RtsFlags.GranFlags.Costs.lunblocktime; + // insertThread(tso, node_loc); + new_event(tso_loc, tso_loc, + CurrentTime[CurrentProc]+bq_processing_time, + 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) + bq_processing_time += RtsFlags.GranFlags.Costs.mpacktime; + bq_processing_time += RtsFlags.GranFlags.Costs.gunblocktime; + new_event(tso_loc, CurrentProc, + CurrentTime[CurrentProc]+bq_processing_time+ + RtsFlags.GranFlags.Costs.latency, + UnblockThread, + tso, node, (rtsSpark*)NULL); + tso->link = END_TSO_QUEUE; // overwrite link just to be sure + bq_processing_time += RtsFlags.GranFlags.Costs.mtidytime; + // len++; + } + /* the thread-queue-overhead is accounted for in either Resume or UnblockThread */ + IF_GRAN_DEBUG(bq, + fprintf(stderr," %s TSO %d (%p) [PE %d] (blocked_on=%p) (next=%p) ,", + (node_loc==tso_loc ? "Local" : "Global"), + tso->id, tso, CurrentProc, tso->blocked_on, tso->link)) + tso->blocked_on = NULL; + IF_DEBUG(scheduler,belch("-- Waking up thread %ld (%p)", + tso->id, tso)); + } + + /* 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 (next!=END_BQ_QUEUE) { + ASSERT(get_itbl(node)->type == RBH && get_itbl(next)->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 = ((StgRBHSave *)next)->payload[0]; + ((StgRBH *)node)->mut_link = ((StgRBHSave *)next)->payload[1]; + + IF_GRAN_DEBUG(bq, + belch("## Filled in RBH_Save for %p (%s) at end of AwBQ", + node, info_type(node))); + } +} #elif defined(PAR) static StgBlockingQueueElement * unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node) @@ -1814,7 +1879,14 @@ unblockOneLocked(StgTSO *tso) #endif #if defined(GRAN) -# error FixME +inline StgTSO * +unblockOne(StgTSO *tso, StgClosure *node) +{ + ACQUIRE_LOCK(&sched_mutex); + tso = unblockOneLocked(tso, node); + RELEASE_LOCK(&sched_mutex); + return tso; +} #elif defined(PAR) inline StgTSO * unblockOne(StgTSO *tso, StgClosure *node) @@ -1836,7 +1908,71 @@ unblockOne(StgTSO *tso) #endif #if defined(GRAN) -# error FixME +void +awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) +{ + StgBlockingQueueElement *bqe, *next; + StgTSO *tso; + PEs node_loc, tso_loc; + rtsTime bq_processing_time = 0; + nat len = 0, len_local = 0; + + IF_GRAN_DEBUG(bq, + belch("## AwBQ for node %p on PE %d @ %ld by TSO %d (%p): ", \ + node, CurrentProc, CurrentTime[CurrentProc], + CurrentTSO->id, CurrentTSO)); + + node_loc = where_is(node); + + ASSERT(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, + belch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)", + 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, + belch("## new bitmask of node %p is %#x", + 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); + bqe = unblockOneLocked(bqe, node); + } + + /* statistics gathering */ + /* ToDo: fix counters + 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, + fprintf(stderr,"## BQ Stats of %p: [%d entries, %d local] %s\n", + node, len, len_local, (next!=END_TSO_QUEUE) ? "RBH" : "")); + */ +} #elif defined(PAR) void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h index 1c93099..5c90636 100644 --- a/ghc/rts/Schedule.h +++ b/ghc/rts/Schedule.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Schedule.h,v 1.13 2000/01/13 14:34:05 hwloidl Exp $ + * $Id: Schedule.h,v 1.14 2000/01/14 11:45:21 hwloidl Exp $ * * (c) The GHC Team 1998-1999 * @@ -42,7 +42,7 @@ void startTasks( void ); * Locks assumed : none */ #if defined(GRAN) -# error FixME +void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); #elif defined(PAR) void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); #else @@ -59,7 +59,7 @@ void awakenBlockedQueue(StgTSO *tso); * Locks assumed : none */ #if defined(GRAN) -# error FixME +StgTSO *unblockOne(StgTSO *tso, StgClosure *node); #elif defined(PAR) StgTSO *unblockOne(StgTSO *tso, StgClosure *node); #else diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 4809be7..f0365fe 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.31 2000/01/13 14:34:05 hwloidl Exp $ + * $Id: StgMiscClosures.hc,v 1.32 2000/01/14 11:45:21 hwloidl Exp $ * * (c) The GHC Team, 1998-1999 * @@ -39,8 +39,7 @@ STGFUN(type##_entry) \ { \ FB_ \ DUMP_ERRMSG(#type " object entered!\n"); \ - STGCALL1(raiseError, errorHandler); \ - stg_exit(EXIT_FAILURE); /* not executed */ \ + STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \ FE_ \ } diff --git a/ghc/rts/parallel/FetchMe.hc b/ghc/rts/parallel/FetchMe.hc index 01f1f14..e538074 100644 --- a/ghc/rts/parallel/FetchMe.hc +++ b/ghc/rts/parallel/FetchMe.hc @@ -1,6 +1,6 @@ /* ---------------------------------------------------------------------------- - Time-stamp: - $Id: FetchMe.hc,v 1.2 2000/01/13 14:34:06 hwloidl Exp $ + Time-stamp: + $Id: FetchMe.hc,v 1.3 2000/01/14 11:45:22 hwloidl Exp $ Entry code for a FETCH_ME closure @@ -194,9 +194,8 @@ STGFUN(BLOCKED_FETCH_entry) { FB_ /* see NON_ENTERABLE_ENTRY_CODE in StgMiscClosures.hc */ - fprintf(stderr,"Qagh: BLOCKED_FETCH entered!\n"); - STGCALL1(raiseError, errorHandler); - stg_exit(EXIT_FAILURE); /* not executed */ + DUMP_ERRMSG("BLOCKED_FETCH object entered!\n"); + STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); FE_ }