diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-11-13 11:43:09 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-11-13 11:43:09 +0000 |
| commit | 4270d7e7485b124dd153399dfe3f571253dc0d1d (patch) | |
| tree | ed539eab1f3019ad7910bc51af426f1b46468683 /compiler/cmm/MkGraph.hs | |
| parent | 1c160e588706f4ff6b4e391602e38f0a2044ec13 (diff) | |
| download | haskell-4270d7e7485b124dd153399dfe3f571253dc0d1d.tar.gz | |
Fix the Slow calling convention (#7192)
The Slow calling convention passes the closure in R1, but we were
ignoring this and hoping it would work, which it often did. However,
this bug seems to have been the cause of #7192, because the
graph-colouring allocator is more sensitive to having correct liveness
information on jumps.
Diffstat (limited to 'compiler/cmm/MkGraph.hs')
| -rw-r--r-- | compiler/cmm/MkGraph.hs | 32 |
1 files changed, 8 insertions, 24 deletions
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs index 7971b1de0f..bba3d4a88a 100644 --- a/compiler/cmm/MkGraph.hs +++ b/compiler/cmm/MkGraph.hs @@ -9,7 +9,7 @@ module MkGraph , stackStubExpr , mkNop, mkAssign, mkStore, mkUnsafeCall, mkFinalCall, mkCallReturnsTo , mkJumpReturnsTo - , mkJump, mkJumpExtra, mkDirectJump, mkForeignJump, mkForeignJumpExtra + , mkJump, mkJumpExtra , mkRawJump , mkCbranch, mkSwitch , mkReturn, mkComment, mkCallEntry, mkBranch @@ -188,10 +188,12 @@ mkStore :: CmmExpr -> CmmExpr -> CmmAGraph mkStore l r = mkMiddle $ CmmStore l r ---------- Control transfer -mkJump :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset +mkJump :: DynFlags -> Convention -> CmmExpr + -> [CmmActual] + -> UpdFrameOffset -> CmmAGraph -mkJump dflags e actuals updfr_off = - lastWithArgs dflags Jump Old NativeNodeCall actuals updfr_off $ +mkJump dflags conv e actuals updfr_off = + lastWithArgs dflags Jump Old conv actuals updfr_off $ toCall e Nothing updfr_off 0 -- | A jump where the caller says what the live GlobalRegs are. Used @@ -203,28 +205,10 @@ mkRawJump dflags e updfr_off vols = \arg_space _ -> toCall e Nothing updfr_off 0 arg_space vols -mkJumpExtra :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset - -> [CmmActual] -> CmmAGraph -mkJumpExtra dflags e actuals updfr_off extra_stack = - lastWithArgsAndExtraStack dflags Jump Old NativeNodeCall actuals updfr_off extra_stack $ - toCall e Nothing updfr_off 0 - -mkDirectJump :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset - -> CmmAGraph -mkDirectJump dflags e actuals updfr_off = - lastWithArgs dflags Jump Old NativeDirectCall actuals updfr_off $ - toCall e Nothing updfr_off 0 - -mkForeignJump :: DynFlags - -> Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset - -> CmmAGraph -mkForeignJump dflags conv e actuals updfr_off = - mkForeignJumpExtra dflags conv e actuals updfr_off noExtraStack - -mkForeignJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmActual] +mkJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset -> [CmmActual] -> CmmAGraph -mkForeignJumpExtra dflags conv e actuals updfr_off extra_stack = +mkJumpExtra dflags conv e actuals updfr_off extra_stack = lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $ toCall e Nothing updfr_off 0 |