Commit 4a939ead authored by hwloidl's avatar hwloidl
Browse files

[project @ 2000-01-14 11:45:21 by hwloidl]

Bugfix (raiseError in non-enterable closures); added GranSim code to Schedule.c
parent ed1ae761
%
% (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
......
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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);
......
/* ---------------------------------------------------------------------------
* $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)
......
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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_ \
}
......
/* ----------------------------------------------------------------------------
Time-stamp: <Wed Jan 12 2000 13:39:33 Stardate: [-30]4193.88 hwloidl>
$Id: FetchMe.hc,v 1.2 2000/01/13 14:34:06 hwloidl Exp $
Time-stamp: <Fri Jan 14 2000 09:41:07 Stardate: [-30]4202.01 hwloidl>
$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_
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment