Commit 147b5423 authored by Simon Marlow's avatar Simon Marlow

Generate slightly less crap to be cleaned up later

parent 7d7c284b
......@@ -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
......
......@@ -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
......
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