Commit 93e42a68 authored by Simon Marlow's avatar Simon Marlow

Lower safe foreign calls in the new CmmLayoutStack

We also generate much better code for safe foreign calls (and maybe
also unsafe foreign calls) than previously.  See the two new Notes:

Note [lower safe foreign calls]
Note [safe foreign call convention]
parent 9a32e71d
......@@ -17,7 +17,6 @@ module CmmBuildInfoTables
, setInfoTableSRT
, TopSRT, emptySRT, srtToData
, bundleCAFs
, lowerSafeForeignCalls
, cafTransfers )
where
......@@ -315,91 +314,3 @@ updInfoTbl toVars toSrt info_tbl@(CmmInfoTable {})
StackRep ls -> StackRep (toVars ls)
other -> other }
updInfoTbl _ _ t@CmmNonInfoTable = t
----------------------------------------------------------------
-- Safe foreign calls: We need to insert the code that suspends and resumes
-- the thread before and after a safe foreign call.
-- Why do we do this so late in the pipeline?
-- Because we need this code to appear without interrruption: you can't rely on the
-- value of the stack pointer between the call and resetting the thread state;
-- you need to have an infotable on the young end of the stack both when
-- suspending the thread and making the foreign call.
-- All of this is much easier if we insert the suspend and resume calls here.
-- At the same time, we prepare for the stages of the compiler that
-- build the proc points. We have to do this at the same time because
-- the safe foreign calls need special treatment with respect to infotables.
-- A safe foreign call needs an infotable even though it isn't
-- a procpoint. The following datatype captures the information
-- needed to generate the infotables along with the Cmm data and procedures.
-- JD: Why not do this while splitting procedures?
lowerSafeForeignCalls :: AreaMap -> CmmDecl -> FuelUniqSM CmmDecl
lowerSafeForeignCalls _ t@(CmmData _ _) = return t
lowerSafeForeignCalls areaMap (CmmProc info l g@(CmmGraph {g_entry=entry})) = do
let block b mblocks = mblocks >>= lowerSafeCallBlock entry areaMap b
blocks <- foldGraphBlocks block (return mapEmpty) g
return $ CmmProc info l (ofBlockMap entry blocks)
-- If the block ends with a safe call in the block, lower it to an unsafe
-- call (with appropriate saves and restores before and after).
lowerSafeCallBlock :: BlockId -> AreaMap -> CmmBlock -> BlockEnv CmmBlock
-> FuelUniqSM (BlockEnv CmmBlock)
lowerSafeCallBlock entry areaMap b blocks =
case blockToNodeList b of
(JustC (CmmEntry id), m, JustC l@(CmmForeignCall {})) -> lowerSafeForeignCall entry areaMap blocks id m l
_ -> return $ insertBlock b blocks
-- Late in the code generator, we want to insert the code necessary
-- to lower a safe foreign call to a sequence of unsafe calls.
lowerSafeForeignCall :: BlockId -> AreaMap -> BlockEnv CmmBlock -> BlockId -> [CmmNode O O] -> CmmNode O C
-> FuelUniqSM (BlockEnv CmmBlock)
lowerSafeForeignCall entry areaMap blocks bid m
(CmmForeignCall {tgt=tgt, res=rs, args=as, succ=succ, updfr = updfr_off, intrbl = intrbl}) =
do let newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
-- Both 'id' and 'new_base' are KindNonPtr because they're
-- RTS-only objects and are not subject to garbage collection
id <- newTemp bWord
new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
let (caller_save, caller_load) = callerSaveVolatileRegs
load_tso <- newTemp gcWord -- TODO FIXME NOW
load_stack <- newTemp gcWord -- TODO FIXME NOW
let (<**>) = (M.<*>)
let suspendThread = foreignLbl "suspendThread"
resumeThread = foreignLbl "resumeThread"
foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit name)))
suspend = saveThreadState <**>
caller_save <**>
mkUnsafeCall (ForeignTarget suspendThread
(ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint]))
[id] [CmmReg (CmmGlobal BaseReg), CmmLit (mkIntCLit (fromEnum intrbl))]
midCall = mkUnsafeCall tgt rs as
resume = mkUnsafeCall (ForeignTarget resumeThread
(ForeignConvention CCallConv [AddrHint] [AddrHint]))
[new_base] [CmmReg (CmmLocal id)] <**>
-- Assign the result to BaseReg: we
-- might now have a different Capability!
mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <**>
caller_load <**>
loadThreadState load_tso load_stack
-- We have to save the return value on the stack because its next use
-- may appear in a different procedure due to procpoint splitting...
saveRetVals = foldl (<**>) mkNop $ map (M.mkMiddle . spill) rs
spill r = CmmStore (regSlot r) (CmmReg $ CmmLocal r)
regSlot r@(LocalReg _ _) = CmmRegOff (CmmGlobal Sp) (sp_off - offset)
where offset = w + expectJust "lowerForeign" Nothing -- XXX need to fix this: (Map.lookup (RegSlot r) areaMap)
sp_off = wORD_SIZE + expectJust "lowerForeign" (Map.lookup area areaMap)
area = if succ == entry then Old else Young succ
w = widthInBytes $ typeWidth $ localRegType r
-- Note: The successor must be a procpoint, and we have already split,
-- so we use a jump, not a branch.
succLbl = CmmLit (CmmLabel (infoTblLbl succ))
jump = CmmCall { cml_target = succLbl, cml_cont = Nothing
, cml_args = widthInBytes wordWidth ,cml_ret_args = 0
, cml_ret_off = updfr_off}
graph' <- liftUniq $ labelAGraph bid $ catAGraphs (map M.mkMiddle m) <**>
suspend <**> midCall <**>
resume <**> saveRetVals <**> M.mkLast jump
return $ blocks `mapUnion` toBlockMap graph'
lowerSafeForeignCall _ _ _ _ _ _ = panic "lowerSafeForeignCall was passed something else"
......@@ -3,13 +3,20 @@ module CmmLayoutStack (
cmmLayoutStack, setInfoTableStackMap
) where
import StgCmmUtils ( callerSaveVolatileRegs ) -- XXX
import StgCmmForeign ( saveThreadState, loadThreadState ) -- XXX
import Cmm
import BlockId
import CLabel
import CmmUtils
import MkGraph
import Module
import ForeignCall
import CmmLive
import CmmProcPoint
import SMRep
import Hoopl
import Hoopl hiding ((<*>), mkLast, mkMiddle)
import OptimizationFuel
import Constants
import UniqSupply
......@@ -177,31 +184,49 @@ layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks
-- a proc point, we must save the live variables, adjust Sp, and
-- construct the StackMaps for each of the successor blocks.
-- See handleLastNode for details.
(saves, out, sp_off, last1, fixup_blocks)
(middle2, sp_off, middle3, last1, fixup_blocks, out)
<- handleLastNode procpoints liveness cont_info
acc_stackmaps stack1 last0
let hwm' = maximum (acc_hwm : map sm_sp (mapElems out))
middle2 = maybeAddSpAdj sp_off $ foldl blockSnoc middle1 saves
area_off = getAreaOff final_stackmaps
-- manifest Sp: turn all CmmStackSlots into actual loads
adj_middle = mapExpDeep (areaToSp sp0 sp_high area_off)
adj_last = optStackCheck .
mapExpDeep (areaToSp (sp0 - sp_off) sp_high area_off)
middle3 = blockFromList $
map adj_middle $
elimStackStores stack0 final_stackmaps area_off $
blockToList middle2
newblock = blockJoin entry0 middle3 (adj_last last1)
fixup_blocks' = map (blockMapNodes3 (id, adj_middle, id)) fixup_blocks
-- our block:
-- middle1 -- the original middle nodes
-- middle2 -- live variable saves from handleLastNode
-- Sp = Sp + sp_off -- Sp adjustment goes here
-- middle3 -- some more middle nodes from handleLastNode
-- last1 -- the last node
--
-- The next step is to manifest Sp: turn all the CmmStackSlots
-- into CmmLoads from Sp. The adjustment for middle1/middle2
-- will be different from that for middle3/last1, because the
-- Sp adjustment intervenes.
--
let area_off = getAreaOff final_stackmaps
adj_pre_sp, adj_post_sp :: CmmNode e x -> CmmNode e x
adj_pre_sp = mapExpDeep (areaToSp sp0 sp_high area_off)
adj_post_sp = mapExpDeep (areaToSp (sp0 - sp_off) sp_high area_off)
middle_pre = maybeAddSpAdj sp_off $
blockFromList $
map adj_pre_sp $
elimStackStores stack0 final_stackmaps area_off $
blockToList $
foldl blockSnoc middle1 middle2
middle_post = map adj_post_sp middle3
final_middle = foldl blockSnoc middle_pre middle_post
final_last = optStackCheck (adj_post_sp last1)
newblock = blockJoin entry0 final_middle final_last
fixup_blocks' = map (blockMapNodes3 (id, adj_post_sp, id))
fixup_blocks
stackmaps' = mapUnion acc_stackmaps out
hwm' = maximum (acc_hwm : map sm_sp (mapElems out))
pprTrace "layout(out)" (ppr out) $ return ()
go bs stackmaps' hwm' (newblock : fixup_blocks' ++ acc_blocks)
......@@ -292,16 +317,33 @@ getStackLoc (Young l) n stackmaps =
-- -----------------------------------------------------------------------------
-- Handling stack allocation for a last node
-- We take a single last node and turn it into:
--
-- C1 (some statements)
-- Sp = Sp + N
-- C2 (some more statements)
-- call f() -- the actual last node
--
-- plus possibly some more blocks (we may have to add some fixup code
-- between the last node and the continuation).
--
-- C1: is the code for saving the variables across this last node onto
-- the stack, if the continuation is a call or jumps to a proc point.
--
-- C2: if the last node is a safe foreign call, we have to inject some
-- extra code that goes *after* the Sp adjustment.
handleLastNode
:: ProcPointSet -> BlockEnv CmmLive -> BlockEnv ByteOff
-> BlockEnv StackMap -> StackMap
-> CmmNode O C
-> UniqSM
( [CmmNode O O] -- assignments to save live variables
, BlockEnv StackMap -- stackmaps for the continuations
, ByteOff -- amount to adjust Sp before the jump
( [CmmNode O O] -- nodes to go *before* the Sp adjustment
, ByteOff -- amount to adjust Sp
, [CmmNode O O] -- nodes to go *after* the Sp adjustment
, CmmNode O C -- new last node
, [CmmBlock] -- new blocks
, BlockEnv StackMap -- stackmaps for the continuations
)
handleLastNode procpoints liveness cont_info stackmaps
......@@ -312,39 +354,45 @@ handleLastNode procpoints liveness cont_info stackmaps
-- is cml_args, after popping any other junk from the stack.
CmmCall{ cml_cont = Nothing, .. } -> do
let sp_off = sp0 - cml_args
return ([], mapEmpty, sp_off, last, [])
return ([], sp_off, [], last, [], mapEmpty)
-- At each CmmCall with a continuation:
CmmCall{ cml_cont = Just cont_lbl, .. } ->
lastCall cont_lbl cml_args cml_ret_args cml_ret_off
lastCall cont_lbl [] cml_args cml_ret_args cml_ret_off
CmmForeignCall{ succ = cont_lbl, .. } ->
lastCall cont_lbl 0{-no args-} 0{-no results-} (sm_ret_off stack0)
CmmForeignCall{ succ = cont_lbl, .. } -> do
(mids, spoff, _, last', blocks, stackmap') <-
lastCall cont_lbl res wORD_SIZE wORD_SIZE (sm_ret_off stack0)
-- one word each for args and results: the return address
(extra_mids, last'') <- lowerSafeForeignCall last'
return (mids, spoff, extra_mids, last'', blocks, stackmap')
CmmBranch{..} -> handleProcPoints
CmmCondBranch{..} -> handleProcPoints
CmmSwitch{..} -> handleProcPoints
where
lastCall :: BlockId -> ByteOff -> ByteOff -> ByteOff
lastCall :: BlockId -> [LocalReg] -> ByteOff -> ByteOff -> ByteOff
-> UniqSM
( [CmmNode O O]
, BlockEnv StackMap
, ByteOff
, [CmmNode O O]
, CmmNode O C
, [CmmBlock]
, BlockEnv StackMap
)
lastCall cont_lbl cml_args cml_ret_args cml_ret_off
lastCall cont_lbl res_regs cml_args cml_ret_args cml_ret_off
-- If we have already seen this continuation before, then
-- we just have to make the stack look the same:
| Just cont_stack <- mapLookup cont_lbl stackmaps
=
return ( fixupStack stack0 cont_stack
, stackmaps
, sp0 - sm_sp cont_stack
, []
, last
, [] )
, []
, stackmaps )
-- a continuation we haven't seen before:
-- allocate the stack frame for it.
......@@ -353,6 +401,7 @@ handleLastNode procpoints liveness cont_info stackmaps
-- get the set of LocalRegs live in the continuation
let target_live = mapFindWithDefault Set.empty cont_lbl
liveness
`Set.difference` Set.fromList res_regs
-- the stack from the base to cml_ret_off is off-limits.
-- our new stack frame contains:
......@@ -382,18 +431,19 @@ handleLastNode procpoints liveness cont_info stackmaps
-- emit an Sp adjustment, taking into account the call area
--
return ( assigs
, mapSingleton cont_lbl cont_stack
, sp_off
, []
, last
, [] -- no new blocks
)
, mapSingleton cont_lbl cont_stack )
handleProcPoints :: UniqSM ( [CmmNode O O]
, BlockEnv StackMap
, ByteOff
, [CmmNode O O]
, CmmNode O C
, [CmmBlock] )
, [CmmBlock]
, BlockEnv StackMap )
handleProcPoints = do
pps <- mapM handleProcPoint (successors last)
......@@ -401,10 +451,11 @@ handleLastNode procpoints liveness cont_info stackmaps
lbl_map = mapFromList [ (l,tmp) | (l,tmp,_,_) <- pps ]
fix_lbl l = mapLookup l lbl_map `orElse` l
return ( []
, mapFromList [ (l, sm) | (l,_,sm,_) <- pps ]
, 0
, []
, mapSuccessors fix_lbl last
, concat [ blk | (_,_,_,blk) <- pps ] )
, concat [ blk | (_,_,_,blk) <- pps ]
, mapFromList [ (l, sm) | (l,_,sm,_) <- pps ] )
-- For each proc point that is a successor of this block
-- (a) if the proc point already has a stackmap, we need to
......@@ -641,6 +692,112 @@ stackMapToLiveness StackMap{..} =
| (r,off) <- eltsUFM sm_regs, isGcPtrType (localRegType r) ]
-- -----------------------------------------------------------------------------
-- Lowering safe foreign calls
{-
Note [lower safe foreign calls]
We start with
Sp[young(L1)] = L1
,-----------------------
| r1 = foo(x,y,z) returns to L1
'-----------------------
L1:
R1 = r1 -- copyIn, inserted by mkSafeCall
...
the stack layout algorithm will arrange to save and reload everything
live across the call. Our job now is to expand the call so we get
Sp[young(L1)] = L1
,-----------------------
| SAVE_THREAD_STATE()
| token = suspendThread(BaseReg, interruptible)
| r = foo(x,y,z)
| BaseReg = resumeThread(token)
| LOAD_THREAD_STATE()
| R1 = r -- copyOut
| jump L1
'-----------------------
L1:
r = R1 -- copyIn, inserted by mkSafeCall
...
Note the copyOut, which saves the results in the places that L1 is
expecting them (see Note {safe foreign call convention]).
-}
lowerSafeForeignCall :: CmmNode O C -> UniqSM ([CmmNode O O], CmmNode O C)
lowerSafeForeignCall CmmForeignCall { .. } =
do let
-- Both 'id' and 'new_base' are KindNonPtr because they're
-- RTS-only objects and are not subject to garbage collection
id <- newTemp bWord
new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
let (caller_save, caller_load) = callerSaveVolatileRegs
load_tso <- newTemp gcWord
load_stack <- newTemp gcWord
let suspend = saveThreadState <*>
caller_save <*>
mkMiddle (callSuspendThread id intrbl)
midCall = mkUnsafeCall tgt res args
resume = mkMiddle (callResumeThread new_base id) <*>
-- Assign the result to BaseReg: we
-- might now have a different Capability!
mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*>
caller_load <*>
loadThreadState load_tso load_stack
-- Note: The successor must be a procpoint, and we have already split,
-- so we use a jump, not a branch.
succLbl = CmmLit (CmmLabel (infoTblLbl succ))
(ret_args, copyout) = copyOutOflow NativeReturn Jump (Young succ)
(map (CmmReg . CmmLocal) res)
updfr (0, [])
jump = CmmCall { cml_target = succLbl
, cml_cont = Just succ
, cml_args = widthInBytes wordWidth
, cml_ret_args = ret_args
, cml_ret_off = updfr }
graph' <- lgraphOfAGraph $ suspend <*>
midCall <*>
resume <*>
copyout <*>
mkLast jump
case toBlockList graph' of
[one] -> let (_, middle, last) = blockSplit one
in return (blockToList middle, last)
_ -> panic "lowerSafeForeignCall0"
lowerSafeForeignCall _ = panic "lowerSafeForeignCall1"
foreignLbl :: FastString -> CmmExpr
foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
newTemp :: CmmType -> UniqSM LocalReg
newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
callSuspendThread :: LocalReg -> Bool -> CmmNode O O
callSuspendThread id intrbl =
CmmUnsafeForeignCall
(ForeignTarget (foreignLbl (fsLit "suspendThread"))
(ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint]))
[id] [CmmReg (CmmGlobal BaseReg), CmmLit (mkIntCLit (fromEnum intrbl))]
callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
callResumeThread new_base id =
CmmUnsafeForeignCall
(ForeignTarget (foreignLbl (fsLit "resumeThread"))
(ForeignConvention CCallConv [AddrHint] [AddrHint]))
[new_base] [CmmReg (CmmLocal id)]
-- -----------------------------------------------------------------------------
plusW :: ByteOff -> WordOff -> ByteOff
......
......@@ -12,6 +12,7 @@ module MkGraph
, mkCbranch, mkSwitch
, mkReturn, mkReturnSimple, mkComment, mkCallEntry, mkBranch
, copyInOflow, copyOutOflow
, noExtraStack
, toCall, Transfer(..)
)
where
......@@ -188,8 +189,7 @@ mkJumpGC e actuals updfr_off =
mkForeignJump :: Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset
-> CmmAGraph
mkForeignJump conv e actuals updfr_off =
lastWithArgs Jump Old conv actuals updfr_off $
toCall e Nothing updfr_off 0
mkForeignJumpExtra conv e actuals updfr_off noExtraStack
mkForeignJumpExtra :: Convention -> CmmExpr -> [CmmActual]
-> UpdFrameOffset -> (ByteOff, [(CmmExpr, ByteOff)])
......@@ -208,13 +208,11 @@ mkReturn :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturn e actuals updfr_off =
lastWithArgs Ret Old NativeReturn actuals updfr_off $
toCall e Nothing updfr_off 0
-- where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
mkReturnSimple :: [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturnSimple actuals updfr_off =
lastWithArgs Ret Old NativeReturn actuals updfr_off $
toCall e Nothing updfr_off 0
where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
mkReturn e actuals updfr_off
where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
mkBranch :: BlockId -> CmmAGraph
mkBranch bid = mkLast (CmmBranch bid)
......@@ -346,9 +344,8 @@ lastWithArgs :: Transfer -> Area -> Convention -> [CmmActual]
-> (ByteOff -> CmmAGraph)
-> CmmAGraph
lastWithArgs transfer area conv actuals updfr_off last =
let (outArgs, copies) = copyOutOflow conv transfer area actuals
updfr_off noExtraStack in
copies <*> last outArgs
lastWithArgsAndExtraStack transfer area conv actuals
updfr_off noExtraStack last
lastWithArgsAndExtraStack :: Transfer -> Area -> Convention -> [CmmActual]
-> UpdFrameOffset -> (ByteOff, [(CmmExpr,ByteOff)])
......
......@@ -27,7 +27,7 @@ module StgCmmEnv (
bindArgsToRegs, bindToReg, rebindToReg,
bindArgToReg, idToReg,
getArgAmode, getNonVoidArgAmodes,
getArgAmode, getNonVoidArgAmodes,
getCgIdInfo,
maybeLetNoEscape,
) where
......@@ -213,7 +213,6 @@ getNonVoidArgAmodes (arg:args)
; amodes <- getNonVoidArgAmodes args
; return ( amode : amodes ) }
------------------------------------------------------------------------
-- Interface functions for binding and re-binding names
------------------------------------------------------------------------
......
......@@ -22,6 +22,7 @@ import StgCmmEnv
import StgCmmMonad
import StgCmmUtils
import StgCmmClosure
import StgCmmLayout
import BlockId
import Cmm
......@@ -45,15 +46,16 @@ import Control.Monad
-- Code generation for Foreign Calls
-----------------------------------------------------------------------------
cgForeignCall :: [LocalReg] -- r1,r2 where to put the results
-> [ForeignHint]
-> ForeignCall -- the op
-- | emit code for a foreign call, and return the results to the sequel.
--
cgForeignCall :: ForeignCall -- the op
-> [StgArg] -- x,y arguments
-> Type -- result type
-> FCode ()
-- Emits code for an unsafe foreign call: r1, r2 = foo( x, y, z )
cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_args
cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty
= do { cmm_args <- getFCallArgs stg_args
; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
; let ((call_args, arg_hints), cmm_target)
= case target of
StaticTarget lbl mPkgId
......@@ -61,7 +63,7 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
= case mPkgId of
Nothing -> ForeignLabelInThisPackage
Just pkgId -> ForeignLabelInPackage pkgId
size = call_size cmm_args
size = call_size cmm_args
in ( unzip cmm_args
, CmmLit (CmmLabel
(mkForeignLabel lbl size labelSource IsFunction)))
......@@ -69,10 +71,31 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
DynamicTarget -> case cmm_args of
(fn,_):rest -> (unzip rest, fn)
[] -> panic "cgForeignCall []"
fc = ForeignConvention cconv arg_hints result_hints
fc = ForeignConvention cconv arg_hints res_hints
call_target = ForeignTarget cmm_target fc
; emitForeignCall safety results call_target call_args CmmMayReturn }
-- we want to emit code for the call, and then emitReturn.
-- However, if the sequel is AssignTo, we shortcut a little
-- and generate a foreign call that assigns the results
-- directly. Otherwise we end up generating a bunch of
-- useless "r = r" assignments, which are not merely annoying:
-- they prevent the common block elimination from working correctly
-- in the case of a safe foreign call.
-- See Note [safe foreign call convention]
--
; sequel <- getSequel
; case sequel of
AssignTo assign_to_these _ ->
do { emitForeignCall safety assign_to_these call_target
call_args CmmMayReturn
}
_something_else ->
do { emitForeignCall safety res_regs call_target
call_args CmmMayReturn
; emitReturn (map (CmmReg . CmmLocal) res_regs)
}
}
where
-- in the stdcall calling convention, the symbol needs @size appended
-- to it, where size is the total number of bytes of arguments. We
......@@ -83,7 +106,76 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
| otherwise = Nothing
-- ToDo: this might not be correct for 64-bit API
arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType arg) wORD_SIZE
arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType arg)
wORD_SIZE
{- Note [safe foreign call convention]
The simple thing to do for a safe foreign call would be the same as an
unsafe one: just
emitForeignCall ...
emitReturn ...
but consider what happens in this case
case foo x y z of
(# s, r #) -> ...
The sequel is AssignTo [r]. The call to newUnboxedTupleRegs picks [r]
as the result reg, and we generate
r = foo(x,y,z) returns to L1 -- emitForeignCall
L1:
r = r -- emitReturn
goto L2
L2:
...
Now L1 is a proc point (by definition, it is the continuation of the
safe foreign call). If L2 does a heap check, then L2 will also be a
proc point.
Furthermore, the stack layout algorithm has to arrange to save r
somewhere between the call and the jump to L1, which is annoying: we
would have to treat r differently from the other live variables, which
have to be saved *before* the call.
So we adopt a special convention for safe foreign calls: the results
are copied out according to the NativeReturn convention by the call,
and the continuation of the call should copyIn the results. (The
copyOut code is actually inserted when the safe foreign call is
lowered later). The result regs attached to the safe foreign call are
only used temporarily to hold the results before they are copied out.
We will now generate this:
r = foo(x,y,z) returns to L1
L1:
r = R1 -- copyIn, inserted by mkSafeCall
goto L2
L2:
... r ...
And when the safe foreign call is lowered later (see Note [lower safe
foreign calls]) we get this:
suspendThread()