From affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec Mon Sep 17 00:00:00 2001 From: "Michael D. Adams" Date: Wed, 27 Jun 2007 15:09:03 +0000 Subject: [PATCH] Added an SRT to each CmmCall and added the current SRT to the CgMonad --- compiler/cmm/CLabel.hs | 13 +++++++---- compiler/cmm/Cmm.hs | 2 ++ compiler/cmm/CmmBrokenBlock.hs | 9 +++++--- compiler/cmm/CmmCPS.hs | 4 ++-- compiler/cmm/CmmLint.hs | 2 +- compiler/cmm/CmmLive.hs | 2 +- compiler/cmm/CmmOpt.hs | 6 ++--- compiler/cmm/CmmParse.y | 21 ++++++++++------- compiler/cmm/CmmProcPoint.hs | 2 +- compiler/cmm/PprC.hs | 15 ++++++------ compiler/cmm/PprCmm.hs | 9 ++++---- compiler/codeGen/CgCase.lhs | 30 ++++++++++++------------ compiler/codeGen/CgClosure.lhs | 10 ++++---- compiler/codeGen/CgExpr.lhs | 20 ++++++++-------- compiler/codeGen/CgForeignCall.hs | 19 ++++++++++------ compiler/codeGen/CgHpc.hs | 2 ++ compiler/codeGen/CgInfoTbls.hs | 34 ++++------------------------ compiler/codeGen/CgLetNoEscape.lhs | 5 ++-- compiler/codeGen/CgMonad.lhs | 19 +++++++++++++--- compiler/codeGen/CgPrimOp.hs | 4 ++++ compiler/codeGen/CgUtils.hs | 44 ++++++++++++++++++++++++++++++++++-- compiler/codeGen/ClosureInfo.lhs | 4 ++++ compiler/codeGen/CodeGen.lhs | 5 ++-- compiler/nativeGen/AsmCodeGen.lhs | 4 ++-- compiler/nativeGen/MachCodeGen.hs | 7 +++--- 25 files changed, 173 insertions(+), 119 deletions(-) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index f5d325b..0918cc8 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -11,7 +11,6 @@ module CLabel ( mkClosureLabel, mkSRTLabel, - mkSRTDescLabel, mkInfoTableLabel, mkEntryLabel, mkSlowEntryLabel, @@ -20,6 +19,7 @@ module CLabel ( mkRednCountsLabel, mkConInfoTableLabel, mkStaticInfoTableLabel, + mkLargeSRTLabel, mkApEntryLabel, mkApInfoTableLabel, mkClosureTableLabel, @@ -210,12 +210,14 @@ data CLabel | HpcTicksLabel Module -- Per-module table of tick locations | HpcModuleNameLabel -- Per-module name of the module for Hpc + | LargeSRTLabel -- Label of an StgLargeSRT + {-# UNPACK #-} !Unique + deriving (Eq, Ord) data IdLabelInfo = Closure -- Label for closure | SRT -- Static reference table - | SRTDesc -- Static reference table descriptor | InfoTable -- Info tables for closures; always read-only | Entry -- entry point | Slow -- slow entry point @@ -287,7 +289,6 @@ data DynamicLinkerLabelInfo -- These are always local: mkSRTLabel name = IdLabel name SRT -mkSRTDescLabel name = IdLabel name SRTDesc mkSlowEntryLabel name = IdLabel name Slow mkBitmapLabel name = IdLabel name Bitmap mkRednCountsLabel name = IdLabel name RednCounts @@ -333,6 +334,7 @@ mkStaticConEntryLabel this_pkg name | isDllName this_pkg name = DynIdLabel name StaticConEntry | otherwise = IdLabel name StaticConEntry +mkLargeSRTLabel uniq = LargeSRTLabel uniq mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo @@ -467,7 +469,7 @@ needsCDecl :: CLabel -> Bool -- don't bother declaring SRT & Bitmap labels, we always make sure -- they are defined before use. needsCDecl (IdLabel _ SRT) = False -needsCDecl (IdLabel _ SRTDesc) = False +needsCDecl (LargeSRTLabel _) = False needsCDecl (IdLabel _ Bitmap) = False needsCDecl (IdLabel _ _) = True needsCDecl (DynIdLabel _ _) = True @@ -697,6 +699,8 @@ pprCLbl (CaseLabel u (CaseAlt tag)) pprCLbl (CaseLabel u CaseDefault) = hcat [pprUnique u, ptext SLIT("_dflt")] +pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd") + pprCLbl (RtsLabel (RtsCode str)) = ptext str pprCLbl (RtsLabel (RtsData str)) = ptext str pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str @@ -791,7 +795,6 @@ ppIdFlavor x = pp_cSEP <> (case x of Closure -> ptext SLIT("closure") SRT -> ptext SLIT("srt") - SRTDesc -> ptext SLIT("srtd") InfoTable -> ptext SLIT("info") Entry -> ptext SLIT("entry") Slow -> ptext SLIT("slow") diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index cae1633..7ec5ad0 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -28,6 +28,7 @@ module Cmm ( import MachOp import CLabel import ForeignCall +import ClosureInfo import Unique import UniqFM import FastString @@ -116,6 +117,7 @@ data CmmStmt CmmCallTarget CmmHintFormals -- zero or more results CmmActuals -- zero or more arguments + C_SRT -- SRT for the continuation of the call | CmmBranch BlockId -- branch to another BB in this fn diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index 1d07631..60cb3e5 100644 --- a/compiler/cmm/CmmBrokenBlock.hs +++ b/compiler/cmm/CmmBrokenBlock.hs @@ -12,6 +12,8 @@ module CmmBrokenBlock ( import Cmm import CLabel +import ClosureInfo + import Maybes import Panic import Unique @@ -50,6 +52,7 @@ data BlockEntryInfo | ContinuationEntry -- ^ Return point of a function call CmmFormals -- ^ return values (argument to continuation) + C_SRT -- ^ SRT for the continuation's info table | ControlEntry -- ^ Any other kind of block. -- Only entered due to control flow. @@ -136,13 +139,13 @@ breakBlock uniques (BasicBlock ident stmts) entry = block = do_call current_id entry accum_stmts exits next_id target results arguments -} - (CmmCall target results arguments:stmts) -> block : rest + (CmmCall target results arguments srt:stmts) -> block : rest where next_id = BlockId $ head uniques block = do_call current_id entry accum_stmts exits next_id target results arguments rest = breakBlock' (tail uniques) next_id - (ContinuationEntry (map fst results)) [] [] stmts + (ContinuationEntry (map fst results) srt) [] [] stmts (s:stmts) -> breakBlock' uniques current_id entry (cond_branch_target s++exits) @@ -171,7 +174,7 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) = FinalJump target arguments -> [CmmJump target arguments] FinalSwitch expr targets -> [CmmSwitch expr targets] FinalCall branch_target call_target results arguments -> - [CmmCall call_target results arguments, + [CmmCall call_target results arguments (panic "needed SRT from cmmBlockFromBrokenBlock"), CmmBranch branch_target] ----------------------------------------------------------------------------- diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs index 9a9f8a9..42dfdce 100644 --- a/compiler/cmm/CmmCPS.hs +++ b/compiler/cmm/CmmCPS.hs @@ -209,7 +209,7 @@ gatherBlocksIntoContinuation proc_points blocks start = _ -> mkReturnPtLabel $ getUnique start params = case start_block_entry of FunctionEntry _ args -> args - ContinuationEntry args -> args + ContinuationEntry args _ -> args ControlEntry -> [] -- TODO: it's a proc-point, we could pass lives in parameter registers -------------------------------------------------------------------------------- @@ -256,7 +256,7 @@ continuationToProc formats (Continuation is_entry info label formals blocks) = ControlEntry -> [] FunctionEntry _ formals -> -- TODO: gc_stack_check function_entry formals curr_format - ContinuationEntry formals -> + ContinuationEntry formals _ -> function_entry formals curr_format postfix = case exit of FinalBranch next -> [CmmBranch next] diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index 0812347..fd4a99c 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -117,7 +117,7 @@ lintCmmStmt (CmmStore l r) = do lintCmmExpr l lintCmmExpr r return () -lintCmmStmt (CmmCall _target _res args) = mapM_ (lintCmmExpr.fst) args +lintCmmStmt (CmmCall _target _res args _) = mapM_ (lintCmmExpr.fst) args lintCmmStmt (CmmCondBranch e _id) = lintCmmExpr e >> checkCond e >> return () lintCmmStmt (CmmSwitch e _branches) = do erep <- lintCmmExpr e diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index 40d7b7c..bee3c65 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -170,7 +170,7 @@ cmmStmtLive _ (CmmAssign reg expr) = (CmmGlobal _) -> id cmmStmtLive _ (CmmStore expr1 expr2) = cmmExprLive expr2 . cmmExprLive expr1 -cmmStmtLive _ (CmmCall target results arguments) = +cmmStmtLive _ (CmmCall target results arguments _) = target_liveness . foldr ((.) . cmmExprLive) id (map fst arguments) . addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index aa0c821..76ed78e 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -140,7 +140,7 @@ lookForInline u expr (stmt:stmts) getStmtUses :: CmmStmt -> UniqFM Int getStmtUses (CmmAssign _ e) = getExprUses e getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2) -getStmtUses (CmmCall target _ es) +getStmtUses (CmmCall target _ es _) = plusUFM_C (+) (uses target) (getExprsUses (map fst es)) where uses (CmmForeignCall e _) = getExprUses e uses _ = emptyUFM @@ -161,8 +161,8 @@ getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es) inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt 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) - = CmmCall (infn target) regs es' +inlineStmt u a (CmmCall target regs es srt) + = CmmCall (infn target) regs es' srt where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv infn (CmmPrim p) = CmmPrim p es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ] diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 567dd60..dda1ca2 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -267,10 +267,11 @@ stmt :: { ExtCode } -- { do reg <- head $1; e <- $3; stmtEC (CmmAssign (fst reg) e) } | type '[' expr ']' '=' expr ';' { doStore $1 $3 $6 } +-- TODO: add real SRT to parsed Cmm | maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' vols ';' - {% foreignCall $3 $1 $4 $6 $8 } + {% foreignCall $3 $1 $4 $6 $8 NoC_SRT } | maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' vols ';' - {% primCall $1 $4 $6 $8 } + {% primCall $1 $4 $6 $8 NoC_SRT } -- stmt-level macros, stealing syntax from ordinary C-- function calls. -- Perhaps we ought to use the %%-form? | NAME '(' exprs0 ')' ';' @@ -818,8 +819,10 @@ foreignCall -> [ExtFCode (CmmFormal,MachHint)] -> ExtFCode CmmExpr -> [ExtFCode (CmmExpr,MachHint)] - -> Maybe [GlobalReg] -> P ExtCode -foreignCall conv_string results_code expr_code args_code vols + -> Maybe [GlobalReg] + -> C_SRT + -> P ExtCode +foreignCall conv_string results_code expr_code args_code vols srt = do convention <- case conv_string of "C" -> return CCallConv "C--" -> return CmmCallConv @@ -829,20 +832,22 @@ foreignCall conv_string results_code expr_code args_code vols expr <- expr_code args <- sequence args_code code (emitForeignCall' PlayRisky results - (CmmForeignCall expr convention) args vols) where + (CmmForeignCall expr convention) args vols srt) where primCall :: [ExtFCode (CmmFormal,MachHint)] -> FastString -> [ExtFCode (CmmExpr,MachHint)] - -> Maybe [GlobalReg] -> P ExtCode -primCall results_code name args_code vols + -> Maybe [GlobalReg] + -> C_SRT + -> P ExtCode +primCall results_code name args_code vols srt = case lookupUFM callishMachOps name of Nothing -> fail ("unknown primitive " ++ unpackFS name) Just p -> return $ do results <- sequence results_code args <- sequence args_code - code (emitForeignCall' PlayRisky results (CmmPrim p) args vols) + code (emitForeignCall' PlayRisky results (CmmPrim p) args vols srt) doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode doStore rep addr_code val_code diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index 729f424..65b0816 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -47,7 +47,7 @@ calculateProcPoints blocks = calculateProcPoints' init_proc_points blocks always_proc_point BrokenBlock { brokenBlockEntry = FunctionEntry _ _ } = True always_proc_point BrokenBlock { - brokenBlockEntry = ContinuationEntry _ } = True + brokenBlockEntry = ContinuationEntry _ _ } = True always_proc_point _ = False calculateProcPoints' :: UniqSet BlockId -> [BrokenBlock] -> UniqSet BlockId diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index bda191c..817e82b 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -28,6 +28,7 @@ import Cmm import CLabel import MachOp import ForeignCall +import ClosureInfo -- Utils import DynFlags @@ -198,11 +199,11 @@ pprStmt stmt = case stmt of where rep = cmmExprRep src - CmmCall (CmmForeignCall fn cconv) results args -> + CmmCall (CmmForeignCall fn cconv) results args srt -> -- Controversial: leave this out for now. -- pprUndef fn $$ - pprCall ppr_fn cconv results args + pprCall ppr_fn cconv results args srt where ppr_fn = case fn of CmmLit (CmmLabel lbl) -> pprCLabel lbl @@ -219,8 +220,8 @@ pprStmt stmt = case stmt of ptext SLIT("#undef") <+> pprCLabel lbl pprUndef _ = empty - CmmCall (CmmPrim op) results args -> - pprCall ppr_fn CCallConv results args + CmmCall (CmmPrim op) results args srt -> + pprCall ppr_fn CCallConv results args srt where ppr_fn = pprCallishMachOp_for_C op @@ -718,10 +719,10 @@ pprLocalReg (LocalReg uniq _ _) = char '_' <> ppr uniq -- ----------------------------------------------------------------------------- -- Foreign Calls -pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals +pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals -> C_SRT -> SDoc -pprCall ppr_fn cconv results args +pprCall ppr_fn cconv results args _ | not (is_cish cconv) = panic "pprCall: unknown calling convention" @@ -839,7 +840,7 @@ te_Lit _ = return () 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.fst) rs >> +te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.fst) rs >> mapM_ (te_Expr.fst) es te_Stmt (CmmCondBranch e _) = te_Expr e te_Stmt (CmmSwitch e _) = te_Expr e diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index ee8f0f3..3253915 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -150,20 +150,21 @@ pprStmt stmt = case stmt of -- call "ccall" foo(x, y)[r1, r2]; -- ToDo ppr volatile - CmmCall (CmmForeignCall fn cconv) results args -> + CmmCall (CmmForeignCall fn cconv) results args srt -> hcat [ ptext SLIT("call"), space, doubleQuotes(ppr cconv), space, target fn, parens ( commafy $ map ppr args ), (if null results then empty - else brackets( commafy $ map ppr results)), semi ] + else brackets( commafy $ map ppr results)), + brackets (ppr srt), semi ] where target (CmmLit lit) = pprLit lit target fn' = parens (ppr fn') - CmmCall (CmmPrim op) results args -> + CmmCall (CmmPrim op) results args srt -> pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv) - results args) + results args srt) where lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False) diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs index a473e91..11a3c3e 100644 --- a/compiler/codeGen/CgCase.lhs +++ b/compiler/codeGen/CgCase.lhs @@ -95,7 +95,6 @@ cgCase :: StgExpr -> StgLiveVars -> StgLiveVars -> Id - -> SRT -> AltType -> [StgAlt] -> Code @@ -104,7 +103,7 @@ cgCase :: StgExpr Special case #1: case of literal. \begin{code} -cgCase (StgLit lit) live_in_whole_case live_in_alts bndr srt +cgCase (StgLit lit) live_in_whole_case live_in_alts bndr alt_type@(PrimAlt tycon) alts = do { tmp_reg <- bindNewToTemp bndr ; cm_lit <- cgLit lit @@ -120,7 +119,7 @@ allocating more heap than strictly necessary, but it will sometimes eliminate a heap check altogether. \begin{code} -cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt +cgCase (StgApp v []) live_in_whole_case live_in_alts bndr alt_type@(PrimAlt tycon) alts = do { -- Careful! we can't just bind the default binder to the same thing -- as the scrutinee, since it might be a stack location, and having @@ -137,7 +136,7 @@ Special case #3: inline PrimOps and foreign calls. \begin{code} cgCase (StgOpApp op@(StgPrimOp primop) args _) - live_in_whole_case live_in_alts bndr srt alt_type alts + live_in_whole_case live_in_alts bndr alt_type alts | not (primOpOutOfLine primop) = cgInlinePrimOp primop args bndr alt_type live_in_alts alts \end{code} @@ -152,7 +151,7 @@ right here, just like an inline primop. \begin{code} cgCase (StgOpApp op@(StgFCallOp fcall _) args _) - live_in_whole_case live_in_alts bndr srt alt_type alts + live_in_whole_case live_in_alts bndr alt_type alts | unsafe_foreign_call = ASSERT( isSingleton alts ) do -- *must* be an unboxed tuple alt. @@ -177,7 +176,7 @@ we can reuse/trim the stack slot holding the variable (if it is in one). \begin{code} cgCase (StgApp fun args) - live_in_whole_case live_in_alts bndr srt alt_type alts + live_in_whole_case live_in_alts bndr alt_type alts = do { fun_info <- getCgIdInfo fun ; arg_amodes <- getArgAmodes args @@ -195,7 +194,7 @@ cgCase (StgApp fun args) <- forkEval alts_eob_info (allocStackTop retAddrSizeW >> nopC) (do { deAllocStackTop retAddrSizeW - ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts }) + ; cgEvalAlts maybe_cc_slot bndr alt_type alts }) ; setEndOfBlockInfo scrut_eob_info (performTailCall fun_info arg_amodes save_assts) } @@ -215,7 +214,7 @@ deAllocStackTop call is doing above. Finally, here is the general case. \begin{code} -cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts +cgCase expr live_in_whole_case live_in_alts bndr alt_type alts = do { -- Figure out what volatile variables to save nukeDeadBindings live_in_whole_case @@ -232,7 +231,7 @@ cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts ; allocStackTop retAddrSizeW -- space for retn address ; nopC }) (do { deAllocStackTop retAddrSizeW - ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts }) + ; cgEvalAlts maybe_cc_slot bndr alt_type alts }) ; setEndOfBlockInfo scrut_eob_info (cgExpr expr) } @@ -355,14 +354,13 @@ is some evaluation to be done. \begin{code} cgEvalAlts :: Maybe VirtualSpOffset -- Offset of cost-centre to be restored, if any -> Id - -> SRT -- SRT for the continuation -> AltType -> [StgAlt] -> FCode Sequel -- Any addr modes inside are guaranteed -- to be a label so that we can duplicate it -- without risk of duplicating code -cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts +cgEvalAlts cc_slot bndr alt_type@(PrimAlt tycon) alts = do { let rep = tyConCgRep tycon reg = dataReturnConvPrim rep -- Bottom for voidRep @@ -374,10 +372,10 @@ cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts ; restoreCurrentCostCentre cc_slot True ; cgPrimAlts GCMayHappen alt_type reg alts } - ; lbl <- emitReturnTarget (idName bndr) abs_c srt + ; lbl <- emitReturnTarget (idName bndr) abs_c ; returnFC (CaseAlts lbl Nothing bndr) } -cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)] +cgEvalAlts cc_slot bndr (UbxTupAlt _) [(con,args,_,rhs)] = -- Unboxed tuple case -- By now, the simplifier should have have turned it -- into case e of (# a,b #) -> e @@ -396,10 +394,10 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)] -- and finally the code for the alternative ; unbxTupleHeapCheck live_regs ptrs nptrs noStmts (cgExpr rhs) } - ; lbl <- emitReturnTarget (idName bndr) abs_c srt + ; lbl <- emitReturnTarget (idName bndr) abs_c ; returnFC (CaseAlts lbl Nothing bndr) } -cgEvalAlts cc_slot bndr srt alt_type alts +cgEvalAlts cc_slot bndr alt_type alts = -- Algebraic and polymorphic case do { -- Bind the default binder bindNewToReg bndr nodeReg (mkLFArgument bndr) @@ -416,7 +414,7 @@ cgEvalAlts cc_slot bndr srt alt_type alts ; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts ; (lbl, branches) <- emitAlgReturnTarget (idName bndr) - alts mb_deflt srt fam_sz + alts mb_deflt fam_sz ; returnFC (CaseAlts lbl branches bndr) } where diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index fd85115..2c72860 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -61,17 +61,16 @@ They should have no free variables. cgTopRhsClosure :: Id -> CostCentreStack -- Optional cost centre annotation -> StgBinderInfo - -> SRT -> UpdateFlag -> [Id] -- Args -> StgExpr -> FCode (Id, CgIdInfo) -cgTopRhsClosure id ccs binder_info srt upd_flag args body = do +cgTopRhsClosure id ccs binder_info upd_flag args body = do { -- LAY OUT THE OBJECT let name = idName id ; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args - ; srt_info <- getSRTInfo name srt + ; srt_info <- getSRTInfo ; mod_name <- getModuleName ; let descr = closureDescription mod_name name closure_info = mkClosureInfo True id lf_info 0 0 srt_info descr @@ -136,14 +135,13 @@ Here's the general case. cgRhsClosure :: Id -> CostCentreStack -- Optional cost centre annotation -> StgBinderInfo - -> SRT -> [Id] -- Free vars -> UpdateFlag -> [Id] -- Args -> StgExpr -> FCode (Id, CgIdInfo) -cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do +cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do { -- LAY OUT THE OBJECT -- If the binder is itself a free variable, then don't store -- it in the closure. Instead, just bind it to Node on entry. @@ -161,7 +159,7 @@ cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do ; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args ; fv_infos <- mapFCs getCgIdInfo reduced_fvs - ; srt_info <- getSRTInfo name srt + ; srt_info <- getSRTInfo ; mod_name <- getModuleName ; let bind_details :: [(CgIdInfo, VirtualHpOffset)] (tot_wds, ptr_wds, bind_details) diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs index 43f6990..a71493a 100644 --- a/compiler/codeGen/CgExpr.lhs +++ b/compiler/codeGen/CgExpr.lhs @@ -203,7 +203,7 @@ module, @CgCase@. \begin{code} cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts) - = cgCase expr live_vars save_vars bndr srt alt_type alts + = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts \end{code} @@ -293,7 +293,7 @@ cgRhs name (StgRhsCon maybe_cc con args) cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body) = do this_pkg <- getThisPackage - mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body + setSRT srt $ mkRhsClosure this_pkg name cc bi fvs upd_flag args body \end{code} mkRhsClosure looks for two special forms of the right-hand side: @@ -316,12 +316,12 @@ form: \begin{code} -mkRhsClosure this_pkg bndr cc bi srt +mkRhsClosure this_pkg bndr cc bi [the_fv] -- Just one free var upd_flag -- Updatable thunk [] -- A thunk body@(StgCase (StgApp scrutinee [{-no args-}]) - _ _ _ _ -- ignore uniq, etc. + _ _ _ srt -- ignore uniq, etc. (AlgAlt tycon) [(DataAlt con, params, use_mask, (StgApp selectee [{-no args-}]))]) @@ -334,7 +334,7 @@ mkRhsClosure this_pkg bndr cc bi srt -- other constructors in the datatype. It's still ok to make a selector -- thunk in this case, because we *know* which constructor the scrutinee -- will evaluate to. - cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv] + setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv] where lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag) @@ -362,7 +362,7 @@ We only generate an Ap thunk if all the free variables are pointers, for semi-obvious reasons. \begin{code} -mkRhsClosure this_pkg bndr cc bi srt +mkRhsClosure this_pkg bndr cc bi fvs upd_flag [] -- No args; a thunk @@ -387,8 +387,8 @@ mkRhsClosure this_pkg bndr cc bi srt The default case ~~~~~~~~~~~~~~~~ \begin{code} -mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body - = cgRhsClosure bndr cc bi srt fvs upd_flag args body +mkRhsClosure this_pkg bndr cc bi fvs upd_flag args body + = cgRhsClosure bndr cc bi fvs upd_flag args body \end{code} @@ -434,7 +434,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder -- case upd_flag of -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update! -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body - cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info + setSRT srt $ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot rec args body -- For a constructor RHS we want to generate a single chunk of code which @@ -442,7 +442,7 @@ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside! cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder (StgRhsCon cc con args) - = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT + = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot rec [] --No args; the binder is data structure, not a function (StgConApp con args) diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index 48015fa..b2ca5b1 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -32,6 +32,7 @@ import CmmUtils import MachOp import SMRep import ForeignCall +import ClosureInfo import Constants import StaticFlags import Outputable @@ -76,8 +77,9 @@ emitForeignCall 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) + (CmmForeignCall cmm_target cconv) call_args (Just vols) srt where (call_args, cmm_target) = case target of @@ -96,7 +98,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live -- ToDo: this might not be correct for 64-bit API arg_size rep = max (machRepByteWidth rep) wORD_SIZE -emitForeignCall results (DNCall _) args live +emitForeignCall _ (DNCall _) _ _ = panic "emitForeignCall: DNCall" @@ -107,13 +109,14 @@ emitForeignCall' -> CmmCallTarget -- the op -> [(CmmExpr,MachHint)] -- arguments -> Maybe [GlobalReg] -- live vars, in case we need to save them + -> C_SRT -- the SRT of the calls continuation -> Code -emitForeignCall' safety results target args vols +emitForeignCall' safety results target args vols srt | not (playSafe safety) = do temp_args <- load_args_into_temps args let (caller_save, caller_load) = callerSaveVolatileRegs vols stmtsC caller_save - stmtC (CmmCall target results temp_args) + stmtC (CmmCall target results temp_args srt) stmtsC caller_load | otherwise = do @@ -126,15 +129,17 @@ emitForeignCall' safety results target args vols let (caller_save, caller_load) = callerSaveVolatileRegs vols emitSaveThreadState stmtsC caller_save + -- Using the same SRT for each of these is a little bit conservative + -- but it should work for now. stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) [ (id,PtrHint) ] [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] - ) - stmtC (CmmCall temp_target results temp_args) + srt) + stmtC (CmmCall temp_target results temp_args srt) stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) [ (new_base, PtrHint) ] [ (CmmReg (CmmLocal id), PtrHint) ] - ) + srt) -- Assign the result to BaseReg: we -- might now have a different Capability! stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))) diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index e457e4c..caf68cd 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -17,6 +17,7 @@ import CgUtils import CgMonad import CgForeignCall import ForeignCall +import ClosureInfo import FastString import HscTypes import Char @@ -70,6 +71,7 @@ initHpc this_mod (HpcInfo tickCount hashNo) , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint) ] (Just []) + C_SRT -- No SRT b/c we PlayRisky } where mod_alloc = mkFastString "hs_hpc_module" diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index d3b54a2..4220b47 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -10,7 +10,6 @@ module CgInfoTbls ( emitClosureCodeAndInfoTable, emitInfoTableAndCode, dataConTagZ, - getSRTInfo, emitReturnTarget, emitAlgReturnTarget, emitReturnInstr, mkRetInfoTable, @@ -187,12 +186,11 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry emitReturnTarget :: Name -> CgStmts -- The direct-return code (if any) - -> SRT -> FCode CLabel -emitReturnTarget name stmts srt +emitReturnTarget name stmts = do { live_slots <- getLiveStackSlots ; liveness <- buildContLiveness name live_slots - ; srt_info <- getSRTInfo name srt + ; srt_info <- getSRTInfo ; let cl_type | isBigLiveness liveness = rET_BIG @@ -231,15 +229,14 @@ emitAlgReturnTarget :: Name -- Just for its unique -> [(ConTagZ, CgStmts)] -- Tagged branches -> Maybe CgStmts -- Default branch (if any) - -> SRT -- Continuation's SRT -> Int -- family size -> FCode (CLabel, SemiTaggingStuff) -emitAlgReturnTarget name branches mb_deflt srt fam_sz +emitAlgReturnTarget name branches mb_deflt fam_sz = do { blks <- getCgStmts $ emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1) -- NB: tag_expr is zero-based - ; lbl <- emitReturnTarget name blks srt + ; lbl <- emitReturnTarget name blks ; return (lbl, Nothing) } -- Nothing: the internal branches in the switch don't have -- global labels, so we can't use them at the 'call site' @@ -425,29 +422,6 @@ emitInfoTableAndCode info_lbl std_info extra_bits args blocks -- ------------------------------------------------------------------------- --- There is just one SRT for each top level binding; all the nested --- bindings use sub-sections of this SRT. The label is passed down to --- the nested bindings via the monad. - -getSRTInfo :: Name -> SRT -> FCode C_SRT -getSRTInfo id NoSRT = return NoC_SRT -getSRTInfo id (SRT off len bmp) - | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape] - = do { srt_lbl <- getSRTLabel - ; let srt_desc_lbl = mkSRTDescLabel id - ; emitRODataLits srt_desc_lbl - ( cmmLabelOffW srt_lbl off - : mkWordCLit (fromIntegral len) - : map mkWordCLit bmp) - ; return (C_SRT srt_desc_lbl 0 srt_escape) } - - | otherwise - = do { srt_lbl <- getSRTLabel - ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) } - -- The fromIntegral converts to StgHalfWord - -srt_escape = (-1) :: StgHalfWord - srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord) srtLabelAndLength NoC_SRT _ = (zeroCLit, 0) diff --git a/compiler/codeGen/CgLetNoEscape.lhs b/compiler/codeGen/CgLetNoEscape.lhs index 99705f6..3913a99 100644 --- a/compiler/codeGen/CgLetNoEscape.lhs +++ b/compiler/codeGen/CgLetNoEscape.lhs @@ -136,7 +136,6 @@ cgLetNoEscapeClosure :: Id -- binder -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06) -> StgBinderInfo -- NB: ditto - -> SRT -> StgLiveVars -- variables live in RHS, including the binders -- themselves in the case of a recursive group -> EndOfBlockInfo -- where are we going to? @@ -149,7 +148,7 @@ cgLetNoEscapeClosure -- ToDo: deal with the cost-centre issues cgLetNoEscapeClosure - bndr cc binder_info srt full_live_in_rhss + bndr cc binder_info full_live_in_rhss rhs_eob_info cc_slot rec args body = let arity = length args @@ -168,7 +167,7 @@ cgLetNoEscapeClosure -- Ignore the label that comes back from -- mkRetDirectTarget. It must be conjured up elswhere - ; emitReturnTarget (idName bndr) abs_c srt + ; emitReturnTarget (idName bndr) abs_c ; return () }) ; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) } diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 61b358a..ca08e06 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -32,6 +32,7 @@ module CgMonad ( EndOfBlockInfo(..), setEndOfBlockInfo, getEndOfBlockInfo, + setSRT, getSRT, setSRTLabel, getSRTLabel, setTickyCtrLabel, getTickyCtrLabel, @@ -65,6 +66,7 @@ import PackageConfig import Cmm import CmmUtils import CLabel +import StgSyn (SRT) import SMRep import Module import Id @@ -98,7 +100,8 @@ data CgInfoDownwards -- information only passed *downwards* by the monad cgd_dflags :: DynFlags, cgd_mod :: Module, -- Module being compiled cgd_statics :: CgBindings, -- [Id -> info] : static environment - cgd_srt :: CLabel, -- label of the current SRT + cgd_srt_lbl :: CLabel, -- label of the current SRT + cgd_srt :: SRT, -- the current SRT cgd_ticky :: CLabel, -- current destination for ticky counts cgd_eob :: EndOfBlockInfo -- Info for stuff to do at end of basic block: } @@ -108,6 +111,7 @@ initCgInfoDown dflags mod = MkCgInfoDown { cgd_dflags = dflags, cgd_mod = mod, cgd_statics = emptyVarEnv, + cgd_srt_lbl = error "initC: srt_lbl", cgd_srt = error "initC: srt", cgd_ticky = mkTopTickyCtrLabel, cgd_eob = initEobInfo } @@ -828,12 +832,21 @@ getEndOfBlockInfo = do getSRTLabel :: FCode CLabel -- Used only by cgPanic getSRTLabel = do info <- getInfoDown - return (cgd_srt info) + return (cgd_srt_lbl info) setSRTLabel :: CLabel -> FCode a -> FCode a setSRTLabel srt_lbl code = do info <- getInfoDown - withInfoDown code (info { cgd_srt = srt_lbl}) + withInfoDown code (info { cgd_srt_lbl = srt_lbl}) + +getSRT :: FCode SRT +getSRT = do info <- getInfoDown + return (cgd_srt info) + +setSRT :: SRT -> FCode a -> FCode a +setSRT srt code + = do info <- getInfoDown + withInfoDown code (info { cgd_srt = srt}) -- ---------------------------------------------------------------------------- -- Get/set the current ticky counter label diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 17ecfa0..01279b4 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -13,6 +13,7 @@ module CgPrimOp ( #include "HsVersions.h" import ForeignCall +import ClosureInfo import StgSyn import CgForeignCall import CgBindery @@ -122,6 +123,7 @@ emitPrimOp [res] ParOp [arg] live (CmmForeignCall newspark CCallConv) [(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky where newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark"))) @@ -138,6 +140,7 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live CCallConv) [(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)] (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky -- #define sizzeofByteArrayzh(r,a) \ -- r = (((StgArrWords *)(a))->words * sizeof(W_)) @@ -342,6 +345,7 @@ emitPrimOp [res] op args live (CmmPrim prim) [(a,NoHint) | a<-args] -- ToDo: hints? (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky | Just mop <- translateOp op = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index a4d2338..26857d3 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -29,7 +29,9 @@ module CgUtils ( mkWordCLit, mkStringCLit, mkByteStringCLit, packHalfWordsCLit, - blankWord + blankWord, + + getSRTInfo ) where #include "HsVersions.h" @@ -45,6 +47,8 @@ import CLabel import CmmUtils import MachOp import ForeignCall +import ClosureInfo +import StgSyn (SRT(..)) import Literal import Digraph import ListSetOps @@ -284,8 +288,9 @@ emitRtsCall' -> Maybe [GlobalReg] -> Code emitRtsCall' res fun args vols = do + srt <- getSRTInfo stmtsC caller_save - stmtC (CmmCall target res args) + stmtC (CmmCall target res args srt) stmtsC caller_load where (caller_save, caller_load) = callerSaveVolatileRegs vols @@ -705,3 +710,38 @@ possiblySameLoc (CmmRegOff r1 start1) rep1 (CmmRegOff r2 start2) rep2 possiblySameLoc l1 rep1 (CmmLit _) rep2 = False possiblySameLoc l1 rep1 l2 rep2 = True -- Conservative + +------------------------------------------------------------------------- +-- +-- Static Reference Tables +-- +------------------------------------------------------------------------- + +-- There is just one SRT for each top level binding; all the nested +-- bindings use sub-sections of this SRT. The label is passed down to +-- the nested bindings via the monad. + +getSRTInfo :: FCode C_SRT +getSRTInfo = do + srt_lbl <- getSRTLabel + srt <- getSRT + case srt of + -- TODO: Should we panic in this case? + -- Someone obviously thinks there should be an SRT + NoSRT -> return NoC_SRT + SRT off len bmp + | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape] + -> do id <- newUnique + let srt_desc_lbl = mkLargeSRTLabel id + emitRODataLits srt_desc_lbl + ( cmmLabelOffW srt_lbl off + : mkWordCLit (fromIntegral len) + : map mkWordCLit bmp) + return (C_SRT srt_desc_lbl 0 srt_escape) + + SRT off len bmp + | otherwise + -> return (C_SRT srt_lbl off (fromIntegral (head bmp))) + -- The fromIntegral converts to StgHalfWord + +srt_escape = (-1) :: StgHalfWord diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 27aed3a..ad26b2e 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -127,6 +127,10 @@ data C_SRT = NoC_SRT needsSRT :: C_SRT -> Bool needsSRT NoC_SRT = False needsSRT (C_SRT _ _ _) = True + +instance Outputable C_SRT where + ppr (NoC_SRT) = ptext SLIT("_no_srt_") + ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap)) \end{code} %************************************************************************ diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs index 13e9c4a..4c7f570 100644 --- a/compiler/codeGen/CodeGen.lhs +++ b/compiler/codeGen/CodeGen.lhs @@ -323,8 +323,9 @@ cgTopRhs bndr (StgRhsCon cc con args) cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body) = ASSERT(null fvs) -- There should be no free variables - setSRTLabel (mkSRTLabel (idName bndr)) $ - forkStatics (cgTopRhsClosure bndr cc bi srt upd_flag args body) + setSRTLabel (mkSRTLabel (idName bndr)) $ + setSRT srt $ + forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body) \end{code} diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 585ea8b..b3ca844 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -536,7 +536,7 @@ cmmStmtConFold stmt -> do addr' <- cmmExprConFold JumpReference addr return $ CmmJump addr' regs - CmmCall target regs args + CmmCall target regs args srt -> do target' <- case target of CmmForeignCall e conv -> do e' <- cmmExprConFold CallReference e @@ -545,7 +545,7 @@ cmmStmtConFold stmt args' <- mapM (\(arg, hint) -> do arg' <- cmmExprConFold DataReference arg return (arg', hint)) args - return $ CmmCall target' regs args' + return $ CmmCall target' regs args' srt CmmCondBranch test dest -> do test' <- cmmExprConFold DataReference test diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 792bbce..dc79d95 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -29,6 +29,7 @@ import PprCmm ( pprExpr ) import Cmm import MachOp import CLabel +import ClosureInfo ( C_SRT(..) ) -- The rest: import StaticFlags ( opt_PIC ) @@ -119,7 +120,7 @@ stmtToInstrs stmt = case stmt of | otherwise -> assignMem_IntCode kind addr src where kind = cmmExprRep src - CmmCall target result_regs args + CmmCall target result_regs args _ -> genCCall target result_regs args CmmBranch id -> genBranch id @@ -3181,13 +3182,13 @@ outOfLineFloatOp mop res args if localRegRep res == F64 then - stmtToInstrs (CmmCall target [(res,FloatHint)] args) + stmtToInstrs (CmmCall target [(res,FloatHint)] args NoC_SRT) else do uq <- getUniqueNat let tmp = LocalReg uq F64 KindNonPtr -- in - code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args) + code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args NoC_SRT) code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where -- 1.7.10.4