Commit 9a2f7779 authored by ian@well-typed.com's avatar ian@well-typed.com

Merge branch 'master' of http://darcs.haskell.org/ghc

parents 6e28baa7 467e1a62
......@@ -365,23 +365,31 @@ tryToInline dflags live node assigs = go usages node [] assigs
go _usages node _skipped [] = (node, [])
go usages node skipped (a@(l,rhs,_) : rest)
| can_inline = inline_and_discard
| isTrivial rhs = inline_and_keep
| cannot_inline = dont_inline
| occurs_once = inline_and_discard
| isTrivial rhs = inline_and_keep
| otherwise = dont_inline
where
inline_and_discard = go usages' node' skipped rest
inline_and_discard = go usages' inl_node skipped rest
where usages' = foldRegsUsed addUsage usages rhs
inline_and_keep = (node'', a : rest')
where (node'',rest') = go usages' node' (l:skipped) rest
dont_inline = keep node -- don't inline the assignment, keep it
inline_and_keep = keep inl_node -- inline the assignment, keep it
can_inline =
not (l `elemRegSet` live)
&& not (skipped `regsUsedIn` rhs) -- Note [dependent assignments]
&& okToInline dflags rhs node
&& lookupUFM usages l == Just 1
keep node' = (final_node, a : rest')
where (final_node, rest') = go usages' node' (l:skipped) rest
usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs
-- we must not inline anything that is mentioned in the RHS
-- of a binding that we have already skipped, so we set the
-- usages of the regs on the RHS to 2.
usages' = foldRegsUsed addUsage usages rhs
cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments]
|| not (okToInline dflags rhs node)
node' = mapExpDeep inline node
occurs_once = not (l `elemRegSet` live)
&& lookupUFM usages l == Just 1
inl_node = mapExpDeep inline node
where inline (CmmReg (CmmLocal l')) | l == l' = rhs
inline (CmmRegOff (CmmLocal l') off) | l == l'
= cmmOffset dflags rhs off
......@@ -389,14 +397,6 @@ tryToInline dflags live node assigs = go usages node [] assigs
inline (CmmMachOp op args) = cmmMachOpFold dflags op args
inline other = other
go usages node skipped (assig@(l,rhs,_) : rest)
= (node', assig : rest')
where (node', rest') = go usages' node (l:skipped) rest
usages' = foldRegsUsed (\m r -> addToUFM m r 2) usages rhs
-- we must not inline anything that is mentioned in the RHS
-- of a binding that we have already skipped, so we set the
-- usages of the regs on the RHS to 2.
-- Note [dependent assignments]
--
-- If our assignment list looks like
......
......@@ -1260,7 +1260,7 @@ showRichTokenStream ts = go startLoc ts ""
. (str ++)
. go tokEnd ts
| otherwise -> ((replicate (tokLine - locLine) '\n') ++)
. ((replicate tokCol ' ') ++)
. ((replicate (tokCol - 1) ' ') ++)
. (str ++)
. go tokEnd ts
where (locLine, locCol) = (srcLocLine loc, srcLocCol loc)
......
......@@ -261,6 +261,7 @@ RTS_RET(stg_ret_f);
RTS_RET(stg_ret_d);
RTS_RET(stg_ret_l);
RTS_FUN_DECL(stg_gc_prim);
RTS_FUN_DECL(stg_gc_prim_p);
RTS_FUN_DECL(stg_gc_prim_pp);
RTS_FUN_DECL(stg_gc_prim_n);
......@@ -392,6 +393,7 @@ RTS_FUN_DECL(stg_deRefStablePtrzh);
RTS_FUN_DECL(stg_forkzh);
RTS_FUN_DECL(stg_forkOnzh);
RTS_FUN_DECL(stg_yieldzh);
RTS_FUN_DECL(stg_killMyself);
RTS_FUN_DECL(stg_killThreadzh);
RTS_FUN_DECL(stg_getMaskingStatezh);
RTS_FUN_DECL(stg_maskAsyncExceptionszh);
......
......@@ -842,7 +842,7 @@ tryGrabCapability (Capability *cap, Task *task)
* allow the workers to stop.
*
* This function should be called when interrupted and
* shutting_down_scheduler = rtsTrue, thus any worker that wakes up
* sched_state = SCHED_SHUTTING_DOWN, thus any worker that wakes up
* will exit the scheduler and call taskStop(), and any bound thread
* that wakes up will return to its caller. Runnable threads are
* killed.
......
......@@ -1067,7 +1067,7 @@ fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso)
{
char *desc;
StgInfoTable *info;
info = get_itbl(exception);
info = get_itbl(UNTAG_CLOSURE(exception));
switch (info->type) {
case CONSTR:
case CONSTR_1_0:
......
......@@ -97,13 +97,6 @@ volatile StgWord sched_state = SCHED_RUNNING;
*/
StgTSO dummy_tso;
/*
* Set to TRUE when entering a shutdown state (via shutdownHaskellAndExit()) --
* in an MT setting, needed to signal that a worker thread shouldn't hang around
* in the scheduler when it is out of work.
*/
rtsBool shutting_down_scheduler = rtsFalse;
/*
* This mutex protects most of the global scheduler data in
* the THREADED_RTS runtime.
......@@ -180,28 +173,6 @@ static void deleteThread_(Capability *cap, StgTSO *tso);
* thread ends
* stack overflow
GRAN version:
In a GranSim setup this loop iterates over the global event queue.
This revolves around the global event queue, which determines what
to do next. Therefore, it's more complicated than either the
concurrent or the parallel (GUM) setup.
This version has been entirely removed (JB 2008/08).
GUM version:
GUM iterates over incoming messages.
It starts with nothing to do (thus CurrentTSO == END_TSO_QUEUE),
and sends out a fish whenever it has nothing to do; in-between
doing the actual reductions (shared code below) it processes the
incoming messages and deals with delayed operations
(see PendingFetches).
This is not the ugliest code you could imagine, but it's bloody close.
(JB 2008/08) This version was formerly indicated by a PP-Flag PAR,
now by PP-flag PARALLEL_HASKELL. The Eden RTS (in GHC-6.x) uses it,
as well as future GUM versions. This file has been refurbished to
only contain valid code, which is however incomplete, refers to
invalid includes etc.
------------------------------------------------------------------------ */
static Capability *
......
Markdown is supported
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