CmmReturnInfo(..),
CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
CmmFormalsWithoutKinds, CmmFormalWithoutKind,
- CmmHinted(..),
+ CmmKinded(..),
CmmSafety(..),
CmmCallTarget(..),
CmmStatic(..), Section(..),
CmmActuals -- with these return values.
type CmmKind = MachHint
-data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: CmmKind }
+data CmmKinded a = CmmKinded { kindlessCmm :: a, cmmKind :: CmmKind }
deriving (Eq)
-type CmmActual = CmmHinted CmmExpr
-type CmmFormal = CmmHinted LocalReg
+type CmmActual = CmmKinded CmmExpr
+type CmmFormal = CmmKinded LocalReg
type CmmActuals = [CmmActual]
type CmmFormals = [CmmFormal]
type CmmFormalWithoutKind = LocalReg
data CmmSafety = CmmUnsafe | CmmSafe C_SRT
-- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
-instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
- foldRegsUsed f set (CmmHinted a _) = foldRegsUsed f set a
+instance UserOfLocalRegs a => UserOfLocalRegs (CmmKinded a) where
+ foldRegsUsed f set (CmmKinded a _) = foldRegsUsed f set a
instance UserOfLocalRegs CmmStmt where
foldRegsUsed f set s = stmt s set
--just look like a tuple, since it was a tuple before
-- ... is that a good idea? --Isaac Dupree
-instance (Outputable a) => Outputable (CmmHinted a) where
- ppr (CmmHinted a k) = ppr (a, k)
+instance (Outputable a) => Outputable (CmmKinded a) where
+ ppr (CmmKinded a k) = ppr (a, k)
{-
Discussion
case lookup ident formats of
Nothing -> block
Just (ContFormat formals srt is_gc) ->
- BrokenBlock ident (ContinuationEntry (map hintlessCmm formals) srt is_gc)
+ BrokenBlock ident (ContinuationEntry (map kindlessCmm formals) srt is_gc)
stmts targets exit
adaptBlockToFormat :: [(BlockId, ContFormat)]
target formals actuals srt ret is_gc
adaptor_block = mk_adaptor_block adaptor_ident
- (ContinuationEntry (map hintlessCmm formals) srt is_gc)
+ (ContinuationEntry (map kindlessCmm formals) srt is_gc)
next format_formals
adaptor_ident = BlockId unique
(CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
(map formal_to_actual format_formals)
- formal_to_actual (CmmHinted reg hint)
- = (CmmHinted (CmmReg (CmmLocal reg)) hint)
+ formal_to_actual (CmmKinded reg hint)
+ = (CmmKinded (CmmReg (CmmLocal reg)) hint)
-- TODO: Check if NoHint is right. We're
-- jumping to a C-- function not a foreign one
-- so it might always be right.
map stmt_arg_size (brokenBlockStmts block))
final_arg_size (FinalReturn args) =
- argumentsSize (cmmExprRep . hintlessCmm) args
+ argumentsSize (cmmExprRep . kindlessCmm) args
final_arg_size (FinalJump _ args) =
- argumentsSize (cmmExprRep . hintlessCmm) args
+ argumentsSize (cmmExprRep . kindlessCmm) args
final_arg_size (FinalCall next _ _ args _ _ True) = 0
final_arg_size (FinalCall next _ _ args _ _ False) =
-- We have to account for the stack used when we build a frame
-- for the *next* continuation from *this* continuation
- argumentsSize (cmmExprRep . hintlessCmm) args +
+ argumentsSize (cmmExprRep . kindlessCmm) args +
continuation_frame_size next_format
where
next_format = maybe unknown_format id $ lookup next' formats
final_arg_size _ = 0
stmt_arg_size (CmmJump _ args) =
- argumentsSize (cmmExprRep . hintlessCmm) args
+ argumentsSize (cmmExprRep . kindlessCmm) args
stmt_arg_size (CmmCall _ _ _ (CmmSafe _) _) =
panic "Safe call in processFormats"
stmt_arg_size (CmmReturn _) =
foreignCall call_uniques (CmmPrim target)
results arguments
-formal_to_actual reg = CmmHinted (CmmReg (CmmLocal reg)) NoHint
+formal_to_actual reg = CmmKinded (CmmReg (CmmLocal reg)) NoHint
foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
foreignCall uniques call results arguments =
saveThreadState ++
caller_save ++
[CmmCall (CmmCallee suspendThread CCallConv)
- [ CmmHinted id PtrHint ]
- [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ]
+ [ CmmKinded id PtrHint ]
+ [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ]
CmmUnsafe
CmmMayReturn,
CmmCall call results new_args CmmUnsafe CmmMayReturn,
CmmCall (CmmCallee resumeThread CCallConv)
- [ CmmHinted new_base PtrHint ]
- [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
+ [ CmmKinded new_base PtrHint ]
+ [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ]
CmmUnsafe
CmmMayReturn,
-- Assign the result to BaseReg: we
CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
caller_load ++
loadThreadState tso_unique ++
- [CmmJump (CmmReg spReg) (map (formal_to_actual . hintlessCmm) results)]
+ [CmmJump (CmmReg spReg) (map (formal_to_actual . kindlessCmm) results)]
where
(_, arg_stmts, new_args) =
loadArgsIntoTemps argument_uniques arguments
= store_arguments ++ adjust_sp_reg spRel ++ jump where
store_arguments =
[stack_put spRel expr offset
- | ((CmmHinted expr _), StackParam offset) <- argument_formats] ++
+ | ((CmmKinded expr _), StackParam offset) <- argument_formats] ++
[global_put expr global
- | ((CmmHinted expr _), RegisterParam global) <- argument_formats]
+ | ((CmmKinded expr _), RegisterParam global) <- argument_formats]
jump = [CmmJump target arguments]
- argument_formats = assignArguments (cmmExprRep . hintlessCmm) arguments
+ argument_formats = assignArguments (cmmExprRep . kindlessCmm) arguments
adjust_sp_reg spRel =
if spRel == 0
lintCmmExpr r
return ()
lint (CmmCall target _res args _ _) =
- lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args
+ lintTarget target >> mapM_ (lintCmmExpr . kindlessCmm) args
lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e
lint (CmmSwitch e branches) = do
mapM_ checkTarget $ catMaybes branches
if (erep == wordRep)
then return ()
else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e)
- lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . hintlessCmm) args
- lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress
+ lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . kindlessCmm) args
+ lint (CmmReturn ress) = mapM_ (lintCmmExpr . kindlessCmm) ress
lint (CmmBranch id) = checkTarget id
checkTarget id = if elemBlockSet id labels then return ()
else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
-- Liveness of a CmmStmt
--------------------------------
cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals formals = map hintlessCmm formals
+cmmFormalsToLiveLocals formals = map kindlessCmm formals
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
cmmExprLive expr2 . cmmExprLive expr1
cmmStmtLive _ (CmmCall target results arguments _ _) =
target_liveness .
- foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
+ foldr ((.) . cmmExprLive) id (map kindlessCmm arguments) .
addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
target_liveness =
case target of
id
(mapCatMaybes id targets))
cmmStmtLive _ (CmmJump expr params) =
- const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
+ const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet)
cmmStmtLive _ (CmmReturn params) =
- const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
+ const (foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet)
--------------------------------
-- Liveness of a CmmExpr
= CmmCall (infn target) regs es' srt ret
where infn (CmmCallee fn cconv) = CmmCallee fn cconv
infn (CmmPrim p) = CmmPrim p
- es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
+ es' = [ (CmmKinded (inlineExpr u a e) hint) | (CmmKinded e hint) <- es ]
inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
maybe_add_proto (Block id _) env | id == lg_entry g =
extendBlockEnv env id (Protocol stdArgConvention hinted_formals)
maybe_add_proto _ env = env
- hinted_formals = map (\x -> CmmHinted x NoHint) formals
+ hinted_formals = map (\x -> CmmKinded x NoHint) formals
stdArgConvention = ConventionStandard CmmCallConv Arguments
-- | For now, following a suggestion by Ben Lippmeier, we pass all
Nothing -> let live = lookupBlockEnv liveness id `orElse`
emptyRegSet -- XXX there's a bug lurking!
-- panic ("no liveness at block " ++ show id)
- formals = map (\x -> CmmHinted x NoHint) $ uniqSetToList live
+ formals = map (\x -> CmmKinded x NoHint) $ uniqSetToList live
in extendBlockEnv protos id (Protocol ConventionPrivate formals)
g' = g { lg_blocks = add_CopyIns protos' (lg_blocks g) }
-> CmmActuals
-> ([Unique], [CmmStmt], CmmActuals)
loadArgsIntoTemps uniques [] = (uniques, [], [])
-loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
+loadArgsIntoTemps uniques ((CmmKinded e hint):args) =
(uniques'',
new_stmts ++ remaining_stmts,
- (CmmHinted new_e hint) : remaining_e)
+ (CmmKinded new_e hint) : remaining_e)
where
(uniques', new_stmts, new_e) = maybeAssignTemp uniques e
(uniques'', remaining_stmts, remaining_e) =
parens (commafy (map arg_type args))
where
res_type [] = ptext (sLit "void")
- res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint
+ res_type [CmmKinded one hint] = machRepHintCType (localRegRep one) hint
- arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprRep expr) hint
+ arg_type (CmmKinded expr hint) = machRepHintCType (cmmExprRep expr) hint
-- ---------------------------------------------------------------------
-- unconditional branches
ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
where
ppr_assign [] rhs = rhs
- ppr_assign [CmmHinted one hint] rhs
+ ppr_assign [CmmKinded one hint] rhs
= pprLocalReg one <> ptext (sLit " = ")
<> pprUnHint hint (localRegRep one) <> rhs
ppr_assign _other _rhs = panic "pprCall: multiple results"
- pprArg (CmmHinted expr hint)
+ pprArg (CmmKinded expr hint)
| hint `elem` [PtrHint,SignedHint]
= cCast (machRepHintCType (cmmExprRep expr) hint) expr
-- see comment by machRepHintCType below
- pprArg (CmmHinted expr _other)
+ pprArg (CmmKinded expr _other)
= pprExpr expr
pprUnHint PtrHint rep = parens (machRepCType rep)
te_Stmt :: CmmStmt -> TE ()
te_Stmt (CmmAssign r e) = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r) = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _ _) = mapM_ (te_temp.hintlessCmm) rs >>
- mapM_ (te_Expr.hintlessCmm) es
+te_Stmt (CmmCall _ rs es _ _) = mapM_ (te_temp.kindlessCmm) rs >>
+ mapM_ (te_Expr.kindlessCmm) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
te_Stmt (CmmJump e _) = te_Expr e
| otherwise = commafy (map ppr_ar results) <+> equals
-- Don't print the hints on a native C-- call
ppr_ar arg = case cconv of
- CmmCallConv -> ppr (hintlessCmm arg)
- _ -> doubleQuotes (ppr $ cmmHint arg) <+>
- ppr (hintlessCmm arg)
+ CmmCallConv -> ppr (kindlessCmm arg)
+ _ -> doubleQuotes (ppr $ cmmKind arg) <+>
+ ppr (kindlessCmm arg)
_pp_conv = case cconv of
CmmCallConv -> empty
_ -> ptext (sLit "foreign") <+> doubleQuotes (ppr cconv)
--
-- jump foo(a, b, c);
--
-genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
+genJump :: CmmExpr -> [CmmKinded CmmExpr] -> SDoc
genJump expr args =
hcat [ ptext (sLit "jump")
CmmLoad (CmmReg _) _ -> pprExpr expr
_ -> parens (pprExpr expr)
, space
- , parens ( commafy $ map pprHinted args )
+ , parens ( commafy $ map pprKinded args )
, semi ]
-pprHinted :: Outputable a => (CmmHinted a) -> SDoc
-pprHinted (CmmHinted a NoHint) = ppr a
-pprHinted (CmmHinted a PtrHint) = quotes(text "address") <+> ppr a
-pprHinted (CmmHinted a SignedHint) = quotes(text "signed") <+> ppr a
-pprHinted (CmmHinted a FloatHint) = quotes(text "float") <+> ppr a
+pprKinded :: Outputable a => (CmmKinded a) -> SDoc
+pprKinded (CmmKinded a NoHint) = ppr a
+pprKinded (CmmKinded a PtrHint) = quotes(text "address") <+> ppr a
+pprKinded (CmmKinded a SignedHint) = quotes(text "signed") <+> ppr a
+pprKinded (CmmKinded a FloatHint) = quotes(text "float") <+> ppr a
-- --------------------------------------------------------------------------
-- Return from a function. [1], Section 6.8.2 of version 1.128
--
-- return (a, b, c);
--
-genReturn :: [CmmHinted CmmExpr] -> SDoc
+genReturn :: [CmmKinded CmmExpr] -> SDoc
genReturn args =
hcat [ ptext (sLit "return")
import CmmExpr
import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
- , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..)
+ , CmmCallTarget(..), CmmActuals, CmmFormals, CmmKinded(..)
, CmmStmt(..) -- imported in order to call ppr on Switch and to
-- implement pprCmmGraphLikeCmm
, CmmSafety(CmmSafe) -- for pprCmmGraphLikeCmm
CopyIn conv args _ ->
if null args then ptext (sLit "empty CopyIn")
- else commafy (map pprHinted args) <+> equals <+>
+ else commafy (map pprKinded args) <+> equals <+>
ptext (sLit "foreign") <+> doubleQuotes(ppr conv) <+> ptext (sLit "...")
CopyOut conv args ->
ptext (sLit "next, pass") <+> doubleQuotes(ppr conv) <+>
- parens (commafy (map pprHinted args))
+ parens (commafy (map pprKinded args))
-- // text
MidComment s -> text "//" <+> ftext s
ppr_target fn' = parens (ppr fn')
-pprHinted :: Outputable a => CmmHinted a -> SDoc
-pprHinted (CmmHinted a NoHint) = ppr a
-pprHinted (CmmHinted a PtrHint) = doubleQuotes (text "address") <+> ppr a
-pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed") <+> ppr a
-pprHinted (CmmHinted a FloatHint) = doubleQuotes (text "float") <+> ppr a
+pprKinded :: Outputable a => CmmKinded a -> SDoc
+pprKinded (CmmKinded a NoHint) = ppr a
+pprKinded (CmmKinded a PtrHint) = doubleQuotes (text "address") <+> ppr a
+pprKinded (CmmKinded a SignedHint) = doubleQuotes (text "signed") <+> ppr a
+pprKinded (CmmKinded a FloatHint) = doubleQuotes (text "float") <+> ppr a
pprLast :: Last -> SDoc
pprLast stmt = (case stmt of
-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
; let res_hints = map (typeHint.idType) non_void_res_ids
- ; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
+ ; cgForeignCall (zipWith CmmKinded res_tmps res_hints) fcall args live_in_alts
; cgExpr rhs }
where
(_, res_ids, _, rhs) = head alts
-- so that the garbage collector can find them
-- This must be done *before* the info table pointer is overwritten,
-- because the old info table ptr is needed for reversion
- ; emitRtsCallWithVols (sLit "newCAF") [CmmHinted (CmmReg nodeReg) PtrHint] [node] False
+ ; emitRtsCallWithVols (sLit "newCAF") [CmmKinded (CmmReg nodeReg) PtrHint] [node] False
-- node is live, so save it.
-- Overwrite the closure with a (static) indirection
then assignPtrTemp arg
else assignNonPtrTemp arg
| (arg, stg_arg) <- arg_exprs]
- let arg_hints = zipWith CmmHinted arg_tmps (map (typeHint.stgArgType) stg_args)
+ let arg_hints = zipWith CmmKinded arg_tmps (map (typeHint.stgArgType) stg_args)
{-
Now, allocate some result regs.
-}
(res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
- emitForeignCall (zipWith CmmHinted res_regs res_hints) fcall
+ emitForeignCall (zipWith CmmKinded res_regs res_hints) fcall
arg_hints emptyVarSet{-no live vars-}
-- tagToEnum# is special: we need to pull the constructor out of the table,
| (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
nonVoidArg rep]
- arg_hints = zipWith CmmHinted
+ arg_hints = zipWith CmmKinded
arg_exprs (map (typeHint.stgArgType) stg_args)
-- in
emitForeignCall results fcall arg_hints live
emitForeignCall
:: CmmFormals -- where to put the results
-> ForeignCall -- the op
- -> [CmmHinted CmmExpr] -- arguments
+ -> [CmmKinded CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-> Code
= case target of
StaticTarget lbl -> (args, CmmLit (CmmLabel
(mkForeignLabel lbl call_size False)))
- DynamicTarget -> case args of (CmmHinted fn _):rest -> (rest, fn)
+ DynamicTarget -> case args of (CmmKinded fn _):rest -> (rest, fn)
-- in the stdcall calling convention, the symbol needs @size appended
-- to it, where size is the total number of bytes of arguments. We
-- attach this info to the CLabel here, and the CLabel pretty printer
-- will generate the suffix when the label is printed.
call_size
- | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.hintlessCmm) args))
+ | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.kindlessCmm) args))
| otherwise = Nothing
-- ToDo: this might not be correct for 64-bit API
:: Safety
-> CmmFormals -- where to put the results
-> CmmCallTarget -- the op
- -> [CmmHinted CmmExpr] -- arguments
+ -> [CmmKinded CmmExpr] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
-> C_SRT -- the SRT of the calls continuation
-> CmmReturnInfo
-- and the CPS will will be the one to convert that
-- to this sequence of three CmmUnsafe calls.
stmtC (CmmCall (CmmCallee suspendThread CCallConv)
- [ CmmHinted id PtrHint ]
- [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ]
+ [ CmmKinded id PtrHint ]
+ [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ]
CmmUnsafe ret)
stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
stmtC (CmmCall (CmmCallee resumeThread CCallConv)
- [ CmmHinted new_base PtrHint ]
- [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
+ [ CmmKinded new_base PtrHint ]
+ [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ]
CmmUnsafe ret)
-- Assign the result to BaseReg: we
-- might now have a different Capability!
-- This is a HACK; really it should be done in the back end, but
-- it's easier to generate the temporaries here.
load_args_into_temps = mapM arg_assign_temp
- where arg_assign_temp (CmmHinted e hint) = do
+ where arg_assign_temp (CmmKinded e hint) = do
tmp <- maybe_assign_temp e
- return (CmmHinted tmp hint)
+ return (CmmKinded tmp hint)
load_target_into_temp (CmmCallee expr conv) = do
tmp <- maybe_assign_temp expr
= do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
; emitForeignCall'
PlayRisky
- [CmmHinted id NoHint]
+ [CmmKinded id NoHint]
(CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
- [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint
- , CmmHinted (word32 tickCount) NoHint
- , CmmHinted (word32 hashNo) NoHint
- , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
+ [ CmmKinded (mkLblExpr mkHpcModuleNameLabel) PtrHint
+ , CmmKinded (word32 tickCount) NoHint
+ , CmmKinded (word32 hashNo) NoHint
+ , CmmKinded (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
]
(Just [])
NoC_SRT -- No SRT b/c we PlayRisky
-- later, we might want to inline it.
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
- [CmmHinted res NoHint]
+ [CmmKinded res NoHint]
(CmmCallee newspark CCallConv)
- [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
- , (CmmHinted arg PtrHint) ]
+ [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint)
+ , (CmmKinded arg PtrHint) ]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
CmmMayReturn
[{-no results-}]
(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
CCallConv)
- [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
- , (CmmHinted mutv PtrHint) ]
+ [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint)
+ , (CmmKinded mutv PtrHint) ]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
CmmMayReturn
| Just prim <- callishOp op
= do vols <- getVolatileRegs live
emitForeignCall' PlayRisky
- [CmmHinted res NoHint]
+ [CmmKinded res NoHint]
(CmmPrim prim)
- [CmmHinted a NoHint | a<-args] -- ToDo: hints?
+ [CmmKinded a NoHint | a<-args] -- ToDo: hints?
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
CmmMayReturn
ifProfiling $ do
stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
-enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmHinted stack PtrHint] False
+enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmKinded stack PtrHint] False
-- ToDo: vols
enter_ccs_fsub = enteringPAP 0
pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
pushCostCentre result ccs cc
= emitRtsCallWithResult result PtrHint
- (sLit "PushCostCentre") [CmmHinted ccs PtrHint,
- CmmHinted (CmmLit (mkCCostCentre cc)) PtrHint]
+ (sLit "PushCostCentre") [CmmKinded ccs PtrHint,
+ CmmKinded (CmmLit (mkCCostCentre cc)) PtrHint]
False
bumpSccCount :: CmmExpr -> CmmStmt
; labelC join_id
}
-emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
+emitRtsCall :: LitString -> [CmmKinded CmmExpr] -> Bool -> Code
emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
-- The 'Nothing' says "save all global registers"
-emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols :: LitString -> [CmmKinded CmmExpr] -> [GlobalReg] -> Bool -> Code
emitRtsCallWithVols fun args vols safe
= emitRtsCall' [] fun args (Just vols) safe
emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
- -> [CmmHinted CmmExpr] -> Bool -> Code
+ -> [CmmKinded CmmExpr] -> Bool -> Code
emitRtsCallWithResult res hint fun args safe
- = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
+ = emitRtsCall' [CmmKinded res hint] fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
:: CmmFormals
-> LitString
- -> [CmmHinted CmmExpr]
+ -> [CmmKinded CmmExpr]
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
-> Code
e' <- cmmExprConFold CallReference e
return $ CmmCallee e' conv
other -> return other
- args' <- mapM (\(CmmHinted arg hint) -> do
+ args' <- mapM (\(CmmKinded arg hint) -> do
arg' <- cmmExprConFold DataReference arg
- return (CmmHinted arg' hint)) args
+ return (CmmKinded arg' hint)) args
return $ CmmCall target' regs args' srt returns
CmmCondBranch test dest
-- we keep it this long in order to prevent earlier optimisations.
-- we only cope with a single result for foreign calls
-genCCall (CmmPrim op) [CmmHinted r _] args = do
+genCCall (CmmPrim op) [CmmKinded r _] args = do
case op of
MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
other_op -> outOfLineFloatOp op r args
where
- actuallyInlineFloatOp rep instr [CmmHinted x _]
+ actuallyInlineFloatOp rep instr [CmmKinded x _]
= do res <- trivialUFCode rep instr x
any <- anyReg res
return (any (getRegisterReg (CmmLocal r)))
genCCall target dest_regs args = do
let
- sizes = map (arg_size . cmmExprRep . hintlessCmm) (reverse args)
+ sizes = map (arg_size . cmmExprRep . kindlessCmm) (reverse args)
#if !darwin_TARGET_OS
tot_arg_size = sum sizes
#else
let
-- assign the results, if necessary
assign_code [] = nilOL
- assign_code [CmmHinted dest _hint] =
+ assign_code [CmmKinded dest _hint] =
case rep of
I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
MOV I32 (OpReg edx) (OpReg r_dest_hi)]
| otherwise = x + a - (x `mod` a)
- push_arg :: (CmmHinted CmmExpr){-current argument-}
+ push_arg :: (CmmKinded CmmExpr){-current argument-}
-> NatM InstrBlock -- code
- push_arg (CmmHinted arg _hint) -- we don't need the hints on x86
+ push_arg (CmmKinded arg _hint) -- we don't need the hints on x86
| arg_rep == I64 = do
ChildCode64 code r_lo <- iselExpr64 arg
delta <- getDeltaNat
if localRegRep res == F64
then
- stmtToInstrs (CmmCall target [CmmHinted res FloatHint] args CmmUnsafe CmmMayReturn)
+ stmtToInstrs (CmmCall target [CmmKinded res FloatHint] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
tmp = LocalReg uq F64 GCKindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [CmmHinted tmp FloatHint] args CmmUnsafe CmmMayReturn)
+ code1 <- stmtToInstrs (CmmCall target [CmmKinded tmp FloatHint] args CmmUnsafe CmmMayReturn)
code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
-- we keep it this long in order to prevent earlier optimisations.
-genCCall (CmmPrim op) [CmmHinted r _] args =
+genCCall (CmmPrim op) [CmmKinded r _] args =
outOfLineFloatOp op r args
genCCall target dest_regs args = do
let
-- assign the results, if necessary
assign_code [] = nilOL
- assign_code [CmmHinted dest _hint] =
+ assign_code [CmmKinded dest _hint] =
case rep of
F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
where
arg_size = 8 -- always, at the mo
- load_args :: [CmmHinted CmmExpr]
+ load_args :: [CmmKinded CmmExpr]
-> [Reg] -- int regs avail for args
-> [Reg] -- FP regs avail for args
-> InstrBlock
- -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock)
+ -> NatM ([CmmKinded CmmExpr],[Reg],[Reg],InstrBlock)
load_args args [] [] code = return (args, [], [], code)
-- no more regs to use
load_args [] aregs fregs code = return ([], aregs, fregs, code)
-- no more args to push
- load_args ((CmmHinted arg hint) : rest) aregs fregs code
+ load_args ((CmmKinded arg hint) : rest) aregs fregs code
| isFloatingRep arg_rep =
case fregs of
[] -> push_this_arg
push_this_arg = do
(args',ars,frs,code') <- load_args rest aregs fregs code
- return ((CmmHinted arg hint):args', ars, frs, code')
+ return ((CmmKinded arg hint):args', ars, frs, code')
push_args [] code = return code
- push_args ((CmmHinted arg hint):rest) code
+ push_args ((CmmKinded arg hint):rest) code
| isFloatingRep arg_rep = do
(arg_reg, arg_code) <- getSomeReg arg
delta <- getDeltaNat
genCCall target dest_regs argsAndHints = do
let
- args = map hintlessCmm argsAndHints
+ args = map kindlessCmm argsAndHints
argcode_and_vregs <- mapM arg_to_int_vregs args
let
(argcodes, vregss) = unzip argcode_and_vregs
initialStackOffset = 8
stackDelta finalStack = roundTo 16 finalStack
#endif
- args = map hintlessCmm argsAndHints
+ args = map kindlessCmm argsAndHints
argReps = map cmmExprRep args
roundTo a x | x `mod` a == 0 = x
moveResult reduceToF32 =
case dest_regs of
[] -> nilOL
- [CmmHinted dest _hint]
+ [CmmKinded dest _hint]
| reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
| rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
| rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
projects / ghc-hetmet.git / commitdiff