Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/147b54230624617ef7c3056b627053ce9a0a80e9 >--------------------------------------------------------------- commit 147b54230624617ef7c3056b627053ce9a0a80e9 Author: Simon Marlow <[email protected]> Date: Fri Jul 6 11:27:07 2012 +0100 Generate slightly less crap to be cleaned up later >--------------------------------------------------------------- compiler/codeGen/StgCmmHeap.hs | 17 +++++++---------- compiler/codeGen/StgCmmMonad.hs | 8 +++++++- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 611304b..bc61cf5 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -45,6 +45,8 @@ import FastString( mkFastString, fsLit ) import Constants import Util +import Control.Monad (when) + ----------------------------------------------------------- -- Initialise dynamic heap objects ----------------------------------------------------------- @@ -491,20 +493,15 @@ do_checks :: Bool -- Should we check the stack? -> FCode () do_checks checkStack alloc do_gc = do gc_id <- newLabelC - hp_check <- if alloc == 0 - then return mkNop - else do - ifthen <- mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) - return (mkAssign hpReg bump_hp <*> ifthen) - if checkStack - then emit =<< mkCmmIfThenElse sp_oflo (mkBranch gc_id) hp_check - else emit hp_check + when checkStack $ + emit =<< mkCmmIfGoto sp_oflo gc_id - emit $ mkComment (mkFastString "outOfLine should follow:") + when (alloc /= 0) $ do + emitAssign hpReg bump_hp + emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) emitOutOfLine gc_id $ - mkComment (mkFastString "outOfLine here") <*> do_gc -- this is expected to jump back somewhere -- Test for stack pointer exhaustion, then diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index cc9919a..602bdeb 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -29,7 +29,8 @@ module StgCmmMonad ( getCmm, cgStmtsToBlocks, getCodeR, getCode, getHeapUsage, - mkCmmIfThenElse, mkCmmIfThen, mkCall, mkCmmCall, mkSafeCall, + mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto, + mkCall, mkCmmCall, mkSafeCall, forkClosureBody, forkStatics, forkAlts, forkProc, codeOnly, @@ -676,6 +677,11 @@ mkCmmIfThenElse e tbranch fbranch = do mkLabel tid <*> tbranch <*> mkBranch endif <*> mkLabel fid <*> fbranch <*> mkLabel endif +mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph +mkCmmIfGoto e tid = do + endif <- newLabelC + return $ mkCbranch e tid endif <*> mkLabel endif + mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph mkCmmIfThen e tbranch = do endif <- newLabelC _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
