Commit 4270d7e7 authored by Simon Marlow's avatar Simon Marlow

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.
parent 1c160e58
......@@ -56,7 +56,7 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
(_, NativeReturn) -> getRegsWithNode dflags
-- GC calling convention *must* put values in registers
(_, GC) -> allRegs dflags
(_, Slow) -> noRegs
(_, Slow) -> nodeOnly
-- The calling conventions first assign arguments to registers,
-- then switch to the stack when we first run out of registers
-- (even if there are still available registers for args of a
......@@ -172,8 +172,8 @@ allRegs dflags = (allVanillaRegs dflags,
allLongRegs dflags,
allSseRegs dflags)
noRegs :: AvailRegs
noRegs = ([], [], [], [], [])
nodeOnly :: AvailRegs
nodeOnly = ([VanillaReg 1], [], [], [], [])
globalArgRegs :: DynFlags -> [GlobalReg]
globalArgRegs dflags = map ($ VGcPtr) (allVanillaRegs dflags) ++
......
......@@ -1086,7 +1086,7 @@ doJumpWithStack expr_code stk_code args_code = do
stk_args <- sequence stk_code
args <- sequence args_code
updfr_off <- getUpdFrameOff
emit (mkJumpExtra dflags expr args updfr_off stk_args)
emit (mkJumpExtra dflags NativeNodeCall expr args updfr_off stk_args)
doCall :: CmmParse CmmExpr -> [CmmParse LocalReg] -> [CmmParse CmmExpr]
-> CmmParse ()
......
......@@ -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
......
......@@ -450,7 +450,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $
\(_offset, node, arg_regs) -> do
-- Emit slow-entry code (for entering a closure through a PAP)
{ mkSlowEntryCode cl_info arg_regs
{ mkSlowEntryCode bndr cl_info arg_regs
; dflags <- getDynFlags
; let lf_info = closureLFInfo cl_info
......@@ -494,21 +494,22 @@ load_fvs node lf_info = mapM_ (\ (reg, off) ->
--
-- The slow entry point is used for unknown calls: eg. stg_PAP_entry
mkSlowEntryCode :: ClosureInfo -> [LocalReg] -> FCode ()
mkSlowEntryCode :: Id -> ClosureInfo -> [LocalReg] -> FCode ()
-- If this function doesn't have a specialised ArgDescr, we need
-- to generate the function's arg bitmap and slow-entry code.
-- Here, we emit the slow-entry code.
mkSlowEntryCode cl_info arg_regs -- function closure is already in `Node'
mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
| Just (_, ArgGen _) <- closureFunInfo cl_info
= do dflags <- getDynFlags
let slow_lbl = closureSlowEntryLabel cl_info
let node = idToReg dflags (NonVoid bndr)
slow_lbl = closureSlowEntryLabel cl_info
fast_lbl = closureLocalEntryLabel dflags cl_info
-- mkDirectJump does not clobber `Node' containing function closure
jump = mkDirectJump dflags
(mkLblExpr fast_lbl)
(map (CmmReg . CmmLocal) arg_regs)
(initUpdFrameOff dflags)
emitProcWithConvention Slow Nothing slow_lbl arg_regs jump
jump = mkJump dflags NativeNodeCall
(mkLblExpr fast_lbl)
(map (CmmReg . CmmLocal) (node : arg_regs))
(initUpdFrameOff dflags)
emitProcWithConvention Slow Nothing slow_lbl (node : arg_regs) jump
| otherwise = return ()
-----------------------------------------
......@@ -728,7 +729,7 @@ link_caf node _is_upd = do
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
(let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node))) in
mkJump dflags target [] updfr)
mkJump dflags NativeNodeCall target [] updfr)
; return hp_rel }
......
......@@ -685,8 +685,8 @@ emitEnter fun = do
-- test, just generating an enter.
Return _ -> do
{ let entry = entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg
; emit $ mkForeignJump dflags NativeNodeCall entry
[cmmUntag dflags fun] updfr_off
; emit $ mkJump dflags NativeNodeCall entry
[cmmUntag dflags fun] updfr_off
; return AssignedDirectly
}
......
......@@ -366,21 +366,17 @@ entryHeapCheck' is_fastf node arity args code
Function (fast): call (NativeNode) stg_gc_fun(fun, args)
Function (slow): R1 = fun
call (slow) stg_gc_fun(args)
XXX: this is a bit naughty, we should really pass R1 as an
argument and use a special calling convention.
Function (slow): call (slow) stg_gc_fun(fun, args)
-}
gc_call upd
| is_thunk
= mkJump dflags stg_gc_enter1 [node] upd
= mkJump dflags NativeNodeCall stg_gc_enter1 [node] upd
| is_fastf
= mkJump dflags stg_gc_fun (node : args') upd
= mkJump dflags NativeNodeCall stg_gc_fun (node : args') upd
| otherwise
= mkAssign nodeReg node <*>
mkForeignJump dflags Slow stg_gc_fun args' upd
= mkJump dflags Slow stg_gc_fun (node : args') upd
updfr_sz <- getUpdFrameOff
......
......@@ -121,7 +121,7 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack
; updfr_off <- getUpdFrameOff
; case sequel of
Return _ -> do
emit $ mkForeignJumpExtra dflags callConv fun args updfr_off extra_stack
emit $ mkJumpExtra dflags callConv fun args updfr_off extra_stack
return AssignedDirectly
AssignTo res_regs _ -> do
k <- 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