Commit 1c5499d4 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Rename a constructor CmmForeignCall to CmmCallee, and tidy Cmm code

This patch should have no effect; it's mainly comments, layout,
plus this contructor name change.
parent 474b582b
......@@ -47,42 +47,49 @@ import Data.Word
-- re-orderd during code generation.
-- GenCmm is abstracted over
-- (a) the type of static data elements
-- (b) the contents of a basic block.
-- d, the type of static data elements in CmmData
-- h, the static info preceding the code of a CmmProc
-- i, the contents of a basic block within a CmmProc
--
-- We expect there to be two main instances of this type:
-- (a) Plain C--, i.e. populated with CmmLit and CmmExpr respectively,
-- (b) Native code, populated with instructions
-- (a) C--, i.e. populated with various C-- constructs
-- (Cmm and RawCmm below)
-- (b) Native code, populated with data/instructions
--
newtype GenCmm d h i = Cmm [GenCmmTop d h i]
-- | Cmm with the info table as a data type
type Cmm = GenCmm CmmStatic CmmInfo CmmStmt
-- | Cmm with the info tables converted to a list of 'CmmStatic'
type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt
-- A top-level chunk, abstracted over the type of the contents of
-- | A top-level chunk, abstracted over the type of the contents of
-- the basic blocks (Cmm or instructions are the likely instantiations).
data GenCmmTop d h i
= CmmProc
= CmmProc -- A procedure
h -- Extra header such as the info table
CLabel -- Used to generate both info & entry labels
CmmFormals -- Argument locals live on entry (C-- procedure params)
[GenBasicBlock i] -- Code, may be empty. The first block is
-- the entry point. The order is otherwise initially
-- the entry point, and should be labelled by the code gen
-- with the CLabel. The order is otherwise initially
-- unimportant, but at some point the code gen will
-- fix the order.
-- the BlockId of the first block does not give rise
-- The BlockId of the first block does not give rise
-- to a label. To jump to the first block in a Proc,
-- use the appropriate CLabel.
-- some static data.
| CmmData Section [d] -- constant values only
-- BlockIds are only unique within a procedure
| CmmData -- Static data
Section
[d]
-- | Cmm with the info table as a data type
type Cmm = GenCmm CmmStatic CmmInfo CmmStmt
type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt
-- | Cmm with the info tables converted to a list of 'CmmStatic'
type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt
type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
-- A basic block containing a single label, at the beginning.
-- The list of basic blocks in a top-level code block may be re-ordered.
-- Fall-through is not allowed: there must be an explicit jump at the
......@@ -90,12 +97,7 @@ type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
-- blocks in order to turn some jumps into fallthroughs.
data GenBasicBlock i = BasicBlock BlockId [i]
-- ToDo: Julian suggests that we might need to annotate this type
-- with the out & in edges in the graph, i.e. two * [BlockId]. This
-- information can be derived from the contents, but it might be
-- helpful to cache it here.
type CmmBasicBlock = GenBasicBlock CmmStmt
type CmmBasicBlock = GenBasicBlock CmmStmt
blockId :: GenBasicBlock i -> BlockId
-- The branch block id is that of the first block in
......@@ -113,9 +115,9 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
data CmmInfo
= CmmInfo
(Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
(Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
(Maybe UpdateFrame) -- Update frame
CmmInfoTable -- Info table
CmmInfoTable -- Info table
-- Info table as a haskell data type
data CmmInfoTable
......@@ -174,7 +176,7 @@ data CmmStmt
| CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
-- given by cmmExprRep of the rhs.
| CmmCall -- A foreign call, with
| CmmCall -- A call (forign, native or primitive), with
CmmCallTarget
CmmHintFormals -- zero or more results
CmmActuals -- zero or more arguments
......@@ -190,18 +192,18 @@ data CmmStmt
-- one -> second block etc
-- Undefined outside range, and when there's a Nothing
| CmmJump CmmExpr -- Jump to another function,
CmmActuals -- with these parameters.
| CmmJump CmmExpr -- Jump to another C-- function,
CmmActuals -- with these parameters.
| CmmReturn -- Return from a function,
CmmActuals -- with these return values.
| CmmReturn -- Return from a native C-- function,
CmmActuals -- with these return values.
type CmmActual = CmmExpr
type CmmActuals = [(CmmActual,MachHint)]
type CmmFormal = LocalReg
type CmmActual = CmmExpr
type CmmActuals = [(CmmActual,MachHint)]
type CmmFormal = LocalReg
type CmmHintFormals = [(CmmFormal,MachHint)]
type CmmFormals = [CmmFormal]
data CmmSafety = CmmUnsafe | CmmSafe C_SRT
type CmmFormals = [CmmFormal]
data CmmSafety = CmmUnsafe | CmmSafe C_SRT
{-
Discussion
......@@ -246,12 +248,12 @@ So we'll stick with the way it is, and add the optimisation to the NCG.
-----------------------------------------------------------------------------
data CmmCallTarget
= CmmForeignCall -- Call to a foreign function
= CmmCallee -- Call a function (foreign or native)
CmmExpr -- literal label <=> static call
-- other expression <=> dynamic call
CCallConv -- The calling convention
| CmmPrim -- Call to a "primitive" (eg. sin, cos)
| CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
......@@ -272,22 +274,11 @@ data CmmExpr
-- where rep = cmmRegRep reg
deriving Eq
cmmExprRep :: CmmExpr -> MachRep
cmmExprRep (CmmLit lit) = cmmLitRep lit
cmmExprRep (CmmLoad _ rep) = rep
cmmExprRep (CmmReg reg) = cmmRegRep reg
cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
data CmmReg
= CmmLocal LocalReg
| CmmGlobal GlobalReg
deriving( Eq )
cmmRegRep :: CmmReg -> MachRep
cmmRegRep (CmmLocal reg) = localRegRep reg
cmmRegRep (CmmGlobal reg) = globalRegRep reg
-- | Whether a 'LocalReg' is a GC followable pointer
data Kind = KindPtr | KindNonPtr deriving (Eq)
......@@ -297,17 +288,6 @@ data LocalReg
MachRep -- ^ Type
Kind -- ^ Should the GC follow as a pointer
instance Eq LocalReg where
(LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
instance Uniquable LocalReg where
getUnique (LocalReg uniq _ _) = uniq
localRegRep :: LocalReg -> MachRep
localRegRep (LocalReg _ rep _) = rep
localRegGCFollow (LocalReg _ _ p) = p
data CmmLit
= CmmInt Integer MachRep
-- Interpretation: the 2's complement representation of the value
......@@ -329,6 +309,31 @@ data CmmLit
| CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
deriving Eq
instance Eq LocalReg where
(LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
instance Uniquable LocalReg where
getUnique (LocalReg uniq _ _) = uniq
-----------------------------------------------------------------------------
-- MachRep
-----------------------------------------------------------------------------
cmmExprRep :: CmmExpr -> MachRep
cmmExprRep (CmmLit lit) = cmmLitRep lit
cmmExprRep (CmmLoad _ rep) = rep
cmmExprRep (CmmReg reg) = cmmRegRep reg
cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
cmmRegRep :: CmmReg -> MachRep
cmmRegRep (CmmLocal reg) = localRegRep reg
cmmRegRep (CmmGlobal reg) = globalRegRep reg
localRegRep :: LocalReg -> MachRep
localRegRep (LocalReg _ rep _) = rep
localRegGCFollow (LocalReg _ _ p) = p
cmmLitRep :: CmmLit -> MachRep
cmmLitRep (CmmInt _ rep) = rep
cmmLitRep (CmmFloat _ rep) = rep
......
......@@ -59,16 +59,20 @@ data BrokenBlock
}
-- | How a block could be entered
-- See Note [An example of CPS conversion]
data BlockEntryInfo
= FunctionEntry -- ^ Block is the beginning of a function
CmmInfo -- ^ Function header info
CLabel -- ^ The function name
CmmFormals -- ^ Aguments to function
-- Only the formal parameters are live
| ContinuationEntry -- ^ Return point of a function call
CmmFormals -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
Bool -- ^ True <=> GC block so ignore stack size
-- Live variables, other than
-- the return values, are on the stack
| ControlEntry -- ^ Any other kind of block.
-- Only entered due to control flow.
......@@ -77,6 +81,39 @@ data BlockEntryInfo
-- no return values, but some live might end up as
-- params or possibly in the frame
{- Note [An example of CPS conversion]
This is NR's and SLPJ's guess about how things might work;
it may not be consistent with the actual code (particularly
in the matter of what's in parameters and what's on the stack).
f(x,y) {
if x>2 then goto L
x = x+1
L: if x>1 then y = g(y)
else x = x+1 ;
return( x+y )
}
BECOMES
f(x,y) { // FunctionEntry
if x>2 then goto L
x = x+1
L: // ControlEntry
if x>1 then push x; push f1; jump g(y)
else x=x+1; jump f2(x, y)
}
f1(y) { // ContinuationEntry
pop x; jump f2(x, y);
}
f2(x, y) { // ProcPointEntry
return (z+y);
}
-}
data ContFormat = ContFormat
CmmHintFormals -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
......@@ -97,7 +134,7 @@ data FinalStmt
CmmExpr -- ^ The function to call
CmmActuals -- ^ Arguments of the call
| FinalCall -- ^ Same as 'CmmForeignCall'
| FinalCall -- ^ Same as 'CmmCallee'
-- followed by 'CmmGoto'
BlockId -- ^ Target of the 'CmmGoto'
-- (must be a 'ContinuationEntry')
......@@ -238,9 +275,13 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry =
next_id = BlockId $ head uniques
block = do_call current_id entry accum_stmts exits next_id
target results arguments srt
cont_info = (next_id,
cont_info = (next_id, -- Entry convention for the
-- continuation of the call
ContFormat results srt
(ident `elem` gc_block_idents))
-- Break up the part after the call
(cont_infos, blocks) = breakBlock' (tail uniques) next_id
ControlEntry [] [] stmts
......
......@@ -40,68 +40,63 @@ import Data.List
-- |Top level driver for the CPS pass
-----------------------------------------------------------------------------
cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
-> [GenCmm CmmStatic CmmInfo CmmStmt] -- ^ Input C-- with Proceedures
-> IO [GenCmm CmmStatic CmmInfo CmmStmt] -- ^ Output CPS transformed C--
cmmCPS dflags abstractC = do
when (dopt Opt_DoCmmLinting dflags) $
do showPass dflags "CmmLint"
case firstJust $ map cmmLint abstractC of
Just err -> do printDump err
ghcExit dflags 1
Nothing -> return ()
showPass dflags "CPS"
-> [Cmm] -- ^ Input C-- with Proceedures
-> IO [Cmm] -- ^ Output CPS transformed C--
cmmCPS dflags cmm_with_calls
= do { when (dopt Opt_DoCmmLinting dflags) $
do showPass dflags "CmmLint"
case firstJust $ map cmmLint cmm_with_calls of
Just err -> do printDump err
ghcExit dflags 1
Nothing -> return ()
; showPass dflags "CPS"
-- TODO: more lint checking
-- check for use of branches to non-existant blocks
-- check for use of Sp, SpLim, R1, R2, etc.
uniqSupply <- mkSplitUniqSupply 'p'
let supplies = listSplitUniqSupply uniqSupply
let doCpsProc s (Cmm c) =
Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
let continuationC = zipWith doCpsProc supplies abstractC
; uniqSupply <- mkSplitUniqSupply 'p'
; let supplies = listSplitUniqSupply uniqSupply
; let cpsd_cmm = zipWith doCpsProc supplies cmm_with_calls
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms cpsd_cmm)
-- TODO: add option to dump Cmm to file
return continuationC
; return cpsd_cmm }
make_stack_check stack_check_block_id info stack_use next_block_id =
BasicBlock stack_check_block_id $
check_stmts ++ [CmmBranch next_block_id]
where
check_stmts =
case info of
-- If we are given a stack check handler,
-- then great, well check the stack.
CmmInfo (Just gc_block) _ _
-> [CmmCondBranch
(CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
[CmmReg stack_use, CmmReg spLimReg])
gc_block]
-- If we aren't given a stack check handler,
-- then humph! we just won't check the stack for them.
CmmInfo Nothing _ _
-> []
-----------------------------------------------------------------------------
-- |CPS a single CmmTop (proceedure)
-- Only 'CmmProc' are transformed 'CmmData' will be left alone.
-----------------------------------------------------------------------------
doCpsProc :: UniqSupply -> Cmm -> Cmm
doCpsProc s (Cmm c)
= Cmm $ concat $ zipWith cpsProc (listSplitUniqSupply s) c
cpsProc :: UniqSupply
-> GenCmmTop CmmStatic CmmInfo CmmStmt -- ^Input proceedure
-> [GenCmmTop CmmStatic CmmInfo CmmStmt] -- ^Output proceedure and continuations
-> CmmTop -- ^Input procedure
-> [CmmTop] -- ^Output procedures;
-- a single input procedure is converted to
-- multiple output procedures
-- Data blocks don't need to be CPS transformed
cpsProc uniqSupply proc@(CmmData _ _) = [proc]
-- Empty functions just don't work with the CPS algorithm, but
-- they don't need the transformation anyway so just output them directly
cpsProc uniqSupply proc@(CmmProc _ _ _ []) = [proc]
cpsProc uniqSupply proc@(CmmProc _ _ _ [])
= pprTrace "cpsProc: unexpected empty proc" (ppr proc) [proc]
-- CPS transform for those procs that actually need it
-- The plan is this:
--
-- * Introduce a stack-check block as the first block
-- * The first blocks gets a FunctionEntry; the rest are ControlEntry
-- * Now break each block into a bunch of blocks (at call sites);
-- all but the first will be ContinuationEntry
--
cpsProc uniqSupply (CmmProc info ident params blocks) = cps_procs
where
-- We need to be generating uniques for several things.
......@@ -187,6 +182,23 @@ cpsProc uniqSupply (CmmProc info ident params blocks) = cps_procs
cps_procs :: [CmmTop]
cps_procs = zipWith (continuationToProc formats' stack_use) proc_uniques continuations'
make_stack_check stack_check_block_id info stack_use next_block_id =
BasicBlock stack_check_block_id $
check_stmts ++ [CmmBranch next_block_id]
where
check_stmts =
case info of
-- If we are given a stack check handler,
-- then great, well check the stack.
CmmInfo (Just gc_block) _ _
-> [CmmCondBranch
(CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
[CmmReg stack_use, CmmReg spLimReg])
gc_block]
-- If we aren't given a stack check handler,
-- then humph! we just won't check the stack for them.
CmmInfo Nothing _ _
-> []
-----------------------------------------------------------------------------
collectNonProcPointTargets ::
......
......@@ -193,7 +193,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
tail_call curr_stack target arguments
-- A regular Cmm function call
FinalCall next (CmmForeignCall target CmmCallConv)
FinalCall next (CmmCallee target CmmCallConv)
results arguments _ _ ->
pack_continuation curr_format cont_format ++
tail_call (curr_stack - cont_stack)
......@@ -204,10 +204,10 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
cont_stack = continuation_frame_size cont_format
-- A safe foreign call
FinalCall next (CmmForeignCall target conv)
FinalCall next (CmmCallee target conv)
results arguments _ _ ->
target_stmts ++
foreignCall call_uniques' (CmmForeignCall new_target conv)
foreignCall call_uniques' (CmmCallee new_target conv)
results arguments
where
(call_uniques', target_stmts, new_target) =
......@@ -226,12 +226,12 @@ foreignCall uniques call results arguments =
arg_stmts ++
saveThreadState ++
caller_save ++
[CmmCall (CmmForeignCall suspendThread CCallConv)
[CmmCall (CmmCallee suspendThread CCallConv)
[ (id,PtrHint) ]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
CmmUnsafe,
CmmCall call results new_args CmmUnsafe,
CmmCall (CmmForeignCall resumeThread CCallConv)
CmmCall (CmmCallee resumeThread CCallConv)
[ (new_base, PtrHint) ]
[ (CmmReg (CmmLocal id), PtrHint) ]
CmmUnsafe,
......
......@@ -176,7 +176,7 @@ cmmStmtLive _ (CmmCall target results arguments _) =
addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
target_liveness =
case target of
(CmmForeignCall target _) -> cmmExprLive target
(CmmCallee target _) -> cmmExprLive target
(CmmPrim _) -> id
cmmStmtLive other_live (CmmBranch target) =
addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
......
......@@ -141,7 +141,7 @@ getStmtUses (CmmAssign _ e) = getExprUses e
getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
getStmtUses (CmmCall target _ es _)
= plusUFM_C (+) (uses target) (getExprsUses (map fst es))
where uses (CmmForeignCall e _) = getExprUses e
where uses (CmmCallee e _) = getExprUses e
uses _ = emptyUFM
getStmtUses (CmmCondBranch e _) = getExprUses e
getStmtUses (CmmSwitch e _) = getExprUses e
......@@ -162,7 +162,7 @@ inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
inlineStmt u a (CmmCall target regs es srt)
= CmmCall (infn target) regs es' srt
where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
where infn (CmmCallee fn cconv) = CmmCallee fn cconv
infn (CmmPrim p) = CmmPrim p
es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
......
......@@ -877,17 +877,17 @@ foreignCall conv_string results_code expr_code args_code vols safety
results <- sequence results_code
expr <- expr_code
args <- sequence args_code
--code (stmtC (CmmCall (CmmForeignCall expr convention) results args safety))
--code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
case convention of
-- Temporary hack so at least some functions are CmmSafe
CmmCallConv -> code (stmtC (CmmCall (CmmForeignCall expr convention) results args safety))
CmmCallConv -> code (stmtC (CmmCall (CmmCallee expr convention) results args safety))
_ -> case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
(CmmForeignCall expr convention) args vols NoC_SRT)
(CmmCallee expr convention) args vols NoC_SRT)
CmmSafe srt ->
code (emitForeignCall' (PlaySafe unused) results
(CmmForeignCall expr convention) args vols NoC_SRT) where
(CmmCallee expr convention) args vols NoC_SRT) where
unused = panic "not used by emitForeignCall'"
primCall
......
......@@ -199,7 +199,7 @@ pprStmt stmt = case stmt of
where
rep = cmmExprRep src
CmmCall (CmmForeignCall fn cconv) results args safety ->
CmmCall (CmmCallee fn cconv) results args safety ->
-- Controversial: leave this out for now.
-- pprUndef fn $$
......
......@@ -212,7 +212,7 @@ pprStmt stmt = case stmt of
-- call "ccall" foo(x, y)[r1, r2];
-- ToDo ppr volatile
CmmCall (CmmForeignCall fn cconv) results args safety ->
CmmCall (CmmCallee fn cconv) results args safety ->
hcat [ if null results
then empty
else parens (commafy $ map ppr results) <>
......@@ -226,7 +226,7 @@ pprStmt stmt = case stmt of
target fn' = parens (ppr fn')
CmmCall (CmmPrim op) results args safety ->
pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
results args safety)
where
lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
......
......@@ -73,7 +73,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
= do vols <- getVolatileRegs live
srt <- getSRTInfo
emitForeignCall' safety results
(CmmForeignCall cmm_target cconv) call_args (Just vols) srt
(CmmCallee cmm_target cconv) call_args (Just vols) srt
where
(call_args, cmm_target)
= case target of
......@@ -128,12 +128,12 @@ emitForeignCall' safety results target args vols srt
-- Once that happens, this function will just emit a (CmmSafe srt) call,
-- and the CPS will will be the one to convert that
-- to this sequence of three CmmUnsafe calls.
stmtC (CmmCall (CmmForeignCall suspendThread CCallConv)
stmtC (CmmCall (CmmCallee suspendThread CCallConv)
[ (id,PtrHint) ]
[ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
CmmUnsafe)
stmtC (CmmCall temp_target results temp_args CmmUnsafe)
stmtC (CmmCall (CmmForeignCall resumeThread CCallConv)
stmtC (CmmCall (CmmCallee resumeThread CCallConv)
[ (new_base, PtrHint) ]
[ (CmmReg (CmmLocal id), PtrHint) ]
CmmUnsafe)
......@@ -159,9 +159,9 @@ load_args_into_temps = mapM arg_assign_temp
tmp <- maybe_assign_temp e
return (tmp,hint)
load_target_into_temp (CmmForeignCall expr conv) = do
load_target_into_temp (CmmCallee expr conv) = do
tmp <- maybe_assign_temp expr
return (CmmForeignCall tmp conv)
return (CmmCallee tmp conv)
load_target_into_temp other_target =
return other_target
......
......@@ -65,7 +65,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
; emitForeignCall'
PlayRisky
[(id,NoHint)]
(CmmForeignCall
(CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
......
......@@ -117,7 +117,7 @@ emitPrimOp [res] ParOp [arg] live
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[(res,NoHint)]
(CmmForeignCall newspark CCallConv)
(CmmCallee newspark CCallConv)
[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
......@@ -133,7 +133,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[{-no results-}]
(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
CCallConv)
[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
(Just vols)
......
......@@ -358,7 +358,7 @@ emitRtsCall' res fun args vols safe = do
stmtsC caller_load
where
(caller_save, caller_load) = callerSaveVolatileRegs vols
target = CmmForeignCall fun_expr CCallConv
target = CmmCallee fun_expr CCallConv
fun_expr = mkLblExpr (mkRtsCodeLabel fun)
-----------------------------------------------------------------------------
......
......@@ -519,9 +519,9 @@ cmmStmtConFold stmt
CmmCall target regs args srt
-> do target' <- case target of
CmmForeignCall e conv -> do
CmmCallee e conv -> do
e' <- cmmExprConFold CallReference e
return $ CmmForeignCall e' conv
return $ CmmCallee e' conv
other -> return other
args' <- mapM (\(arg, hint) -> do
arg' <- cmmExprConFold DataReference arg
......
......@@ -3089,11 +3089,11 @@ genCCall target dest_regs args = do
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
CmmForeignCall (CmmLit (CmmLabel lbl)) conv
CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
CmmForeignCall expr conv
CmmCallee expr conv
-> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
ASSERT(dyn_rep == I32)
return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
......@@ -3202,7 +3202,7 @@ outOfLineFloatOp mop res args
= do
dflags <- getDynFlagsNat
targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
let target = CmmForeignCall targetExpr CCallConv
let target = CmmCallee targetExpr CCallConv
if localRegRep res == F64
then
......@@ -3307,11 +3307,11 @@ genCCall target dest_regs args = do
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
CmmForeignCall (CmmLit (CmmLabel lbl)) conv
CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) arg_regs), conv)
where fn_imm = ImmCLbl lbl
CmmForeignCall expr conv
CmmCallee expr conv
-> do (dyn_r, dyn_c) <- getSomeReg expr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
......@@ -3461,9 +3461,9 @@ genCCall target dest_regs argsAndHints = do
vregs = concat vregss
-- deal with static vs dynamic call targets
callinsns <- (case target of
CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
CmmCallee (CmmLit (CmmLabel lbl)) conv -> do
return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
CmmForeignCall expr conv -> do
CmmCallee expr conv -> do
(dyn_c, [dyn_r]) <- arg_to_int_vregs expr
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop -> do
......@@ -3658,8 +3658,8 @@ genCCall target dest_regs argsAndHints
(toOL []) []
(labelOrExpr, reduceToF32) <- case target of
CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
CmmForeignCall expr conv -> return (Right expr, False)
CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
CmmCallee expr conv -> return (Right expr, False)
CmmPrim mop -> outOfLineFloatOp mop
let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
......
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