-- 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
-- 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
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
| 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
-- 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
-----------------------------------------------------------------------------
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.
-- 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)
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
| 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
}
-- | 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.
-- 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
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')
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
-- |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.
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 ::
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)
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) =
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,
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)
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
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
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
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 $$
-- 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) <>
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)
= 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
-- 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)
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
; emitForeignCall'
PlayRisky
[(id,NoHint)]
- (CmmForeignCall
+ (CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
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
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)
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)
-----------------------------------------------------------------------------
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
(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)
= do
dflags <- getDynFlagsNat
targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
- let target = CmmForeignCall targetExpr CCallConv
+ let target = CmmCallee targetExpr CCallConv
if localRegRep res == F64
then
(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)
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
(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
projects / ghc-hetmet.git / commitdiff