diff options
| -rw-r--r-- | compiler/cmm/CLabel.hs | 141 | ||||
| -rw-r--r-- | compiler/cmm/CmmBuildInfoTables.hs | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmCPSGen.hs | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmParse.y | 26 | ||||
| -rw-r--r-- | compiler/codeGen/CgCallConv.hs | 36 | ||||
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/CgCon.lhs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/CgHeapery.lhs | 18 | ||||
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/CgProf.hs | 18 | ||||
| -rw-r--r-- | compiler/codeGen/CgTicky.hs | 60 | ||||
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 8 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 8 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmLayout.hs | 36 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 18 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 63 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 8 |
21 files changed, 215 insertions, 257 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index a78c22f8ec..181071f7a0 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -81,13 +81,6 @@ module CLabel ( mkRtsDataLabel, mkRtsGcPtrLabel, - mkRtsInfoLabelFS, - mkRtsEntryLabelFS, - mkRtsRetInfoLabelFS, - mkRtsRetLabelFS, - mkRtsCodeLabelFS, - mkRtsDataLabelFS, - mkRtsApFastLabel, mkPrimCallLabel, @@ -273,22 +266,15 @@ data RtsLabelInfo | RtsPrimOp PrimOp - | RtsInfo LitString -- misc rts info tables - | RtsEntry LitString -- misc rts entry points - | RtsRetInfo LitString -- misc rts ret info tables - | RtsRet LitString -- misc rts return points - | RtsData LitString -- misc rts data bits - | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure - | RtsCode LitString -- misc rts code - - | RtsInfoFS FastString -- misc rts info tables - | RtsEntryFS FastString -- misc rts entry points - | RtsRetInfoFS FastString -- misc rts ret info tables - | RtsRetFS FastString -- misc rts return points - | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure - | RtsCodeFS FastString -- misc rts code + | RtsInfo FastString -- misc rts info tables + | RtsEntry FastString -- misc rts entry points + | RtsRetInfo FastString -- misc rts ret info tables + | RtsRet FastString -- misc rts return points + | RtsData FastString -- misc rts data bits, eg CHARLIKE_closure + | RtsCode FastString -- misc rts code + | RtsGcPtr FastString -- GcPtrs eg CHARLIKE_closure - | RtsApFast LitString -- _fast versions of generic apply + | RtsApFast FastString -- _fast versions of generic apply | RtsSlowTickyCtr String @@ -355,17 +341,17 @@ mkModuleInitTableLabel mod = ModuleInitTableLabel mod -- Some fixed runtime system labels -mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker")) -mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR")) -mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame")) -mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC")) -mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability")) -mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0")) -mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY")) -mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR")) - -mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct")) -mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE")) +mkSplitMarkerLabel = RtsLabel (RtsCode (fsLit "__stg_split_marker")) +mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (fsLit "dirty_MUT_VAR")) +mkUpdInfoLabel = RtsLabel (RtsInfo (fsLit "stg_upd_frame")) +mkIndStaticInfoLabel = RtsLabel (RtsInfo (fsLit "stg_IND_STATIC")) +mkMainCapabilityLabel = RtsLabel (RtsData (fsLit "MainCapability")) +mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (fsLit "stg_MUT_ARR_PTRS_FROZEN0")) +mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (fsLit "stg_MUT_ARR_PTRS_DIRTY")) +mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (fsLit "stg_EMPTY_MVAR")) + +mkTopTickyCtrLabel = RtsLabel (RtsData (fsLit "top_ct")) +mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (fsLit "stg_CAF_BLACKHOLE")) mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) moduleRegdLabel = ModuleRegdLabel @@ -411,13 +397,6 @@ mkRtsCodeLabel str = RtsLabel (RtsCode str) mkRtsDataLabel str = RtsLabel (RtsData str) mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str) -mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str) -mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str) -mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str) -mkRtsRetLabelFS str = RtsLabel (RtsRetFS str) -mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str) -mkRtsDataLabelFS str = RtsLabel (RtsDataFS str) - mkRtsApFastLabel str = RtsLabel (RtsApFast str) mkRtsSlowTickyCtrLabel :: String -> CLabel @@ -449,25 +428,21 @@ mkDeadStripPreventer lbl = DeadStripPreventer lbl -- Converting between info labels and entry/ret labels. infoLblToEntryLbl :: CLabel -> CLabel -infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry -infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry +infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry +infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry -infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt -infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s) -infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s) -infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s) -infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s) +infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt +infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s) +infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s) infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl" entryLblToInfoLbl :: CLabel -> CLabel -entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable -entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable -entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable -entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo -entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s) -entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s) -entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s) -entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s) +entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable +entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable +entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable +entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo +entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s) +entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s) entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l) cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure @@ -669,23 +644,17 @@ labelType (RtsLabel (RtsInfo _)) = DataLabel labelType (RtsLabel (RtsEntry _)) = CodeLabel labelType (RtsLabel (RtsRetInfo _)) = DataLabel labelType (RtsLabel (RtsRet _)) = CodeLabel -labelType (RtsLabel (RtsDataFS _)) = DataLabel -labelType (RtsLabel (RtsCodeFS _)) = CodeLabel -labelType (RtsLabel (RtsInfoFS _)) = DataLabel -labelType (RtsLabel (RtsEntryFS _)) = CodeLabel -labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel -labelType (RtsLabel (RtsRetFS _)) = CodeLabel -labelType (RtsLabel (RtsApFast _)) = CodeLabel -labelType (CaseLabel _ CaseReturnInfo) = DataLabel -labelType (CaseLabel _ _) = CodeLabel -labelType (ModuleInitLabel _ _) = CodeLabel -labelType (PlainModuleInitLabel _) = CodeLabel -labelType (ModuleInitTableLabel _) = DataLabel -labelType (LargeSRTLabel _) = DataLabel -labelType (LargeBitmapLabel _) = DataLabel -labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel -labelType (IdLabel _ _ info) = idInfoLabelType info -labelType _ = DataLabel +labelType (RtsLabel (RtsApFast _)) = CodeLabel +labelType (CaseLabel _ CaseReturnInfo) = DataLabel +labelType (CaseLabel _ _) = CodeLabel +labelType (ModuleInitLabel _ _) = CodeLabel +labelType (PlainModuleInitLabel _) = CodeLabel +labelType (ModuleInitTableLabel _) = DataLabel +labelType (LargeSRTLabel _) = DataLabel +labelType (LargeBitmapLabel _) = DataLabel +labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel +labelType (IdLabel _ _ info) = idInfoLabelType info +labelType _ = DataLabel idInfoLabelType info = case info of @@ -836,13 +805,11 @@ pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi -- with a letter so the label will be legal assmbly code. -pprCLbl (RtsLabel (RtsCode str)) = ptext str -pprCLbl (RtsLabel (RtsData str)) = ptext str -pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str -pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str -pprCLbl (RtsLabel (RtsDataFS str)) = ftext str +pprCLbl (RtsLabel (RtsCode str)) = ftext str +pprCLbl (RtsLabel (RtsData str)) = ftext str +pprCLbl (RtsLabel (RtsGcPtr str)) = ftext str -pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast") +pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> ptext (sLit "_fast") pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) = hcat [ptext (sLit "stg_sel_"), text (show offset), @@ -873,27 +840,15 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) ] pprCLbl (RtsLabel (RtsInfo fs)) - = ptext fs <> ptext (sLit "_info") - -pprCLbl (RtsLabel (RtsEntry fs)) - = ptext fs <> ptext (sLit "_entry") - -pprCLbl (RtsLabel (RtsRetInfo fs)) - = ptext fs <> ptext (sLit "_info") - -pprCLbl (RtsLabel (RtsRet fs)) - = ptext fs <> ptext (sLit "_ret") - -pprCLbl (RtsLabel (RtsInfoFS fs)) = ftext fs <> ptext (sLit "_info") -pprCLbl (RtsLabel (RtsEntryFS fs)) +pprCLbl (RtsLabel (RtsEntry fs)) = ftext fs <> ptext (sLit "_entry") -pprCLbl (RtsLabel (RtsRetInfoFS fs)) +pprCLbl (RtsLabel (RtsRetInfo fs)) = ftext fs <> ptext (sLit "_info") -pprCLbl (RtsLabel (RtsRetFS fs)) +pprCLbl (RtsLabel (RtsRet fs)) = ftext fs <> ptext (sLit "_ret") pprCLbl (RtsLabel (RtsPrimOp primop)) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index 1a4a591d68..6b0df700c2 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -518,8 +518,8 @@ lowerSafeForeignCall state m@(MidForeignCall (Safe infotable _) _ _ _) tail = do new_base <- newTemp (cmmRegType (CmmGlobal BaseReg)) let (caller_save, caller_load) = callerSaveVolatileRegs load_tso <- newTemp gcWord -- TODO FIXME NOW - let suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread"))) - resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread"))) + let suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread"))) + resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread"))) suspend = mkStore (CmmReg spReg) (CmmLit (CmmBlock infotable)) <*> saveThreadState <*> caller_save <*> diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs index eb754aeb23..5d691f8e5c 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -259,8 +259,8 @@ foreignCall uniques call results arguments = -- Save/restore the thread state in the TSO suspendThread, resumeThread :: CmmExpr -suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread"))) -resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread"))) +suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread"))) +resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread"))) -- This stuff can't be done in suspendThread/resumeThread, because it -- refers to global registers which aren't available in the C world. diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 3cd6be97a2..0783fc4ce1 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -190,7 +190,7 @@ statics :: { [ExtFCode [CmmStatic]] } -- Strings aren't used much in the RTS HC code, so it doesn't seem -- worth allowing inline strings. C-- doesn't allow them anyway. static :: { ExtFCode [CmmStatic] } - : NAME ':' { return [CmmDataLabel (mkRtsDataLabelFS $1)] } + : NAME ':' { return [CmmDataLabel (mkRtsDataLabel $1)] } | type expr ';' { do e <- $2; return [CmmStaticLit (getLit e)] } | type ';' { return [CmmUninitialised @@ -243,13 +243,13 @@ cmmproc :: { ExtCode } $6; return (formals, gc_block, frame) } blks <- code (cgStmtsToBlocks stmts) - code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabelFS $1) formals blks) } + code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabel $1) formals blks) } info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } : 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')' -- ptrs, nptrs, closure type, description, type { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT), []) } @@ -257,7 +257,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')' -- ptrs, nptrs, closure type, description, type, fun type { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT 0 -- Arity zero @@ -271,7 +271,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')' -- ptrs, nptrs, closure type, description, type, fun type, arity { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17) (ArgSpec (fromIntegral $15)) @@ -286,7 +286,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } -- If profiling is on, this string gets duplicated, -- but that's the way the old code did it we can fix it some other time. desc_lit <- code $ mkStringCLit $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $11) (ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit), []) } @@ -294,15 +294,15 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')' -- selector, closure type, description, type { do prof <- profilingInfo $9 $11 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $7) (ThunkSelectorInfo (fromIntegral $5) NoC_SRT), []) } | 'INFO_TABLE_RET' '(' NAME ',' INT ')' -- closure type (no live regs) - { do let infoLabel = mkRtsInfoLabelFS $3 - return (mkRtsRetLabelFS $3, + { do let infoLabel = mkRtsInfoLabel $3 + return (mkRtsRetLabel $3, CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5) (ContInfo [] NoC_SRT), []) } @@ -310,7 +310,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')' -- closure type, live regs { do live <- sequence (map (liftM Just) $7) - return (mkRtsRetLabelFS $3, + return (mkRtsRetLabel $3, CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5) (ContInfo live NoC_SRT), live) } @@ -852,7 +852,7 @@ lookupName name = do return $ case lookupUFM env name of Just (Var e) -> e - _other -> CmmLit (CmmLabel (mkRtsCodeLabelFS name)) + _other -> CmmLit (CmmLabel (mkRtsCodeLabel name)) -- Lifting FCode computations into the ExtFCode monad: code :: FCode a -> ExtFCode a @@ -886,8 +886,8 @@ profilingInfo desc_str ty_str = do staticClosure :: FastString -> FastString -> [CmmLit] -> ExtCode staticClosure cl_label info payload - = code $ emitDataLits (mkRtsDataLabelFS cl_label) lits - where lits = mkStaticClosure (mkRtsInfoLabelFS info) dontCareCCS payload [] [] [] + = code $ emitDataLits (mkRtsDataLabel cl_label) lits + where lits = mkStaticClosure (mkRtsInfoLabel info) dontCareCCS payload [] [] [] foreignCall :: String diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 351375d1e4..60f25d0686 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -209,7 +209,7 @@ constructSlowCall -- don't forget the zero case constructSlowCall [] - = (mkRtsApFastLabel (sLit "stg_ap_0"), [], []) + = (mkRtsApFastLabel (fsLit "stg_ap_0"), [], []) constructSlowCall amodes = (stg_ap_pat, these, rest) @@ -227,28 +227,28 @@ slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest stg_ap_pat = mkRtsRetInfoLabel arg_pat matchSlowPattern :: [(CgRep,CmmExpr)] - -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)]) + -> (FastString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)]) matchSlowPattern amodes = (arg_pat, these, rest) where (arg_pat, n) = slowCallPattern (map fst amodes) (these, rest) = splitAt n amodes -- These cases were found to cover about 99% of all slow calls: -slowCallPattern :: [CgRep] -> (LitString, Int) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppppp", 6) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppppp", 5) -slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppp", 4) -slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_pppv", 4) -slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppp", 3) -slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_ppv", 3) -slowCallPattern (PtrArg: PtrArg: _) = (sLit "stg_ap_pp", 2) -slowCallPattern (PtrArg: VoidArg: _) = (sLit "stg_ap_pv", 2) -slowCallPattern (PtrArg: _) = (sLit "stg_ap_p", 1) -slowCallPattern (VoidArg: _) = (sLit "stg_ap_v", 1) -slowCallPattern (NonPtrArg: _) = (sLit "stg_ap_n", 1) -slowCallPattern (FloatArg: _) = (sLit "stg_ap_f", 1) -slowCallPattern (DoubleArg: _) = (sLit "stg_ap_d", 1) -slowCallPattern (LongArg: _) = (sLit "stg_ap_l", 1) -slowCallPattern _ = panic "CgStackery.slowCallPattern" +slowCallPattern :: [CgRep] -> (FastString, Int) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppppp", 6) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppppp", 5) +slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_pppp", 4) +slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_pppv", 4) +slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (fsLit "stg_ap_ppp", 3) +slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (fsLit "stg_ap_ppv", 3) +slowCallPattern (PtrArg: PtrArg: _) = (fsLit "stg_ap_pp", 2) +slowCallPattern (PtrArg: VoidArg: _) = (fsLit "stg_ap_pv", 2) +slowCallPattern (PtrArg: _) = (fsLit "stg_ap_p", 1) +slowCallPattern (VoidArg: _) = (fsLit "stg_ap_v", 1) +slowCallPattern (NonPtrArg: _) = (fsLit "stg_ap_n", 1) +slowCallPattern (FloatArg: _) = (fsLit "stg_ap_f", 1) +slowCallPattern (DoubleArg: _) = (fsLit "stg_ap_d", 1) +slowCallPattern (LongArg: _) = (fsLit "stg_ap_l", 1) +slowCallPattern _ = panic "CgStackery.slowCallPattern" ------------------------------------------------------------------------- -- diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index 905f9629b1..d01b12e788 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -560,7 +560,7 @@ link_caf cl_info _is_upd = do -- 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) AddrHint] [node] False + ; emitRtsCallWithVols (fsLit "newCAF") [CmmHinted (CmmReg nodeReg) AddrHint] [node] False -- node is live, so save it. -- Overwrite the closure with a (static) indirection diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 8259584c41..886e60eed4 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -170,7 +170,7 @@ buildDynCon binder _ con [arg_amode] , (_, CmmLit (CmmInt val _)) <- arg_amode , let val_int = (fromIntegral val) :: Int , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE - = do { let intlike_lbl = mkRtsGcPtrLabel (sLit "stg_INTLIKE_closure") + = do { let intlike_lbl = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure") offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1) -- INTLIKE closures consist of a header and one word payload intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW) @@ -181,7 +181,7 @@ buildDynCon binder _ con [arg_amode] , (_, CmmLit (CmmInt val _)) <- arg_amode , let val_int = (fromIntegral val) :: Int , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE - = do { let charlike_lbl = mkRtsGcPtrLabel (sLit "stg_CHARLIKE_closure") + = do { let charlike_lbl = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure") offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1) -- CHARLIKE closures consist of a header and one word payload charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW) diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index 957651d3ba..593de4e829 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -144,8 +144,8 @@ emitForeignCall' safety results target args vols _srt ret emitLoadThreadState suspendThread, resumeThread :: CmmExpr -suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread"))) -resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread"))) +suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread"))) +resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread"))) -- we might need to load arguments into temporaries before diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index 42d26662b9..8d4f7f232a 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -346,7 +346,7 @@ altHeapCheck alt_type code ; setRealHp hpHw ; code } where - rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_unpt_r1"))) + rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_unpt_r1"))) -- Do *not* enter R1 after a heap check in -- a polymorphic case. It might be a function -- and the entry code for a function (currently) @@ -360,14 +360,14 @@ altHeapCheck alt_type code rts_label (PrimAlt tc) = CmmLit $ CmmLabel $ case primRepToCgRep (tyConPrimRep tc) of - VoidArg -> mkRtsCodeLabel (sLit "stg_gc_noregs") - FloatArg -> mkRtsCodeLabel (sLit "stg_gc_f1") - DoubleArg -> mkRtsCodeLabel (sLit "stg_gc_d1") - LongArg -> mkRtsCodeLabel (sLit "stg_gc_l1") + VoidArg -> mkRtsCodeLabel (fsLit "stg_gc_noregs") + FloatArg -> mkRtsCodeLabel (fsLit "stg_gc_f1") + DoubleArg -> mkRtsCodeLabel (fsLit "stg_gc_d1") + LongArg -> mkRtsCodeLabel (fsLit "stg_gc_l1") -- R1 is boxed but unlifted: - PtrArg -> mkRtsCodeLabel (sLit "stg_gc_unpt_r1") + PtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unpt_r1") -- R1 is unboxed: - NonPtrArg -> mkRtsCodeLabel (sLit "stg_gc_unbx_r1") + NonPtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unbx_r1") rts_label (UbxTupAlt _) = panic "altHeapCheck" \end{code} @@ -405,7 +405,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr)) -- Ho ho ho! (CmmLit (mkWordCLit liveness)) liveness = mkRegLiveness regs ptrs nptrs - rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_ut"))) + rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_ut"))) \end{code} @@ -514,7 +514,7 @@ stkChkNodePoints bytes = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1 stg_gc_gen :: CmmExpr -stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_gen"))) +stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_gen"))) stg_gc_enter1 :: CmmExpr stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1) \end{code} diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index ef154adcca..d80fb718f5 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -122,7 +122,7 @@ emitPrimOp [res] ParOp [arg] live NoC_SRT -- No SRT b/c we do PlayRisky CmmMayReturn where - newspark = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark"))) + newspark = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark"))) emitPrimOp [res] ReadMutVarOp [mutv] _ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index a3aa59b572..c984e0d16a 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -65,7 +65,7 @@ curCCS = CmmLoad curCCSAddr bWord -- Address of current CCS variable, for storing into curCCSAddr :: CmmExpr -curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCCS"))) +curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS"))) mkCCostCentre :: CostCentre -> CmmLit mkCCostCentre cc = CmmLabel (mkCCLabel cc) @@ -260,7 +260,7 @@ enterCostCentreThunk closure = stmtC $ CmmStore curCCSAddr (costCentreFrom closure) enter_ccs_fun :: CmmExpr -> Code -enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmHinted stack AddrHint] False +enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False -- ToDo: vols enter_ccs_fsub :: Code @@ -273,7 +273,7 @@ enter_ccs_fsub = enteringPAP 0 -- entering via a PAP. enteringPAP :: Integer -> Code enteringPAP n - = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (sLit "entering_PAP")))) + = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP")))) (CmmLit (CmmInt n cIntWidth))) ifProfiling :: Code -> Code @@ -389,12 +389,12 @@ emitRegisterCCS ccs = do cC_LIST, cC_ID :: CmmExpr -cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_LIST"))) -cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_ID"))) +cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST"))) +cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID"))) cCS_LIST, cCS_ID :: CmmExpr -cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST"))) -cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID"))) +cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST"))) +cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID"))) -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -413,7 +413,7 @@ emitSetCCC cc pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code pushCostCentre result ccs cc = emitRtsCallWithResult result AddrHint - (sLit "PushCostCentre") [CmmHinted ccs AddrHint, + (fsLit "PushCostCentre") [CmmHinted ccs AddrHint, CmmHinted (CmmLit (mkCCostCentre cc)) AddrHint] False @@ -479,7 +479,7 @@ ldvEnter cl_ptr loadEra :: CmmExpr loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth) - [CmmLoad (mkLblExpr (mkRtsDataLabel $ sLit("era"))) cInt] + [CmmLoad (mkLblExpr (mkRtsDataLabel $ fsLit("era"))) cInt] ldvWord :: CmmExpr -> CmmExpr -- Takes the address of a closure, and returns diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index e8af01991f..5a885e05a7 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -117,19 +117,19 @@ ppr_for_ticky_name mod_name name -- Ticky stack frames tickyPushUpdateFrame, tickyUpdateFrameOmitted :: Code -tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (sLit "UPDF_PUSHED_ctr") -tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (sLit "UPDF_OMITTED_ctr") +tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (fsLit "UPDF_PUSHED_ctr") +tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr") -- ----------------------------------------------------------------------------- -- Ticky entries tickyEnterDynCon, tickyEnterDynThunk, tickyEnterStaticCon, tickyEnterStaticThunk, tickyEnterViaNode :: Code -tickyEnterDynCon = ifTicky $ bumpTickyCounter (sLit "ENT_DYN_CON_ctr") -tickyEnterDynThunk = ifTicky $ bumpTickyCounter (sLit "ENT_DYN_THK_ctr") -tickyEnterStaticCon = ifTicky $ bumpTickyCounter (sLit "ENT_STATIC_CON_ctr") -tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (sLit "ENT_STATIC_THK_ctr") -tickyEnterViaNode = ifTicky $ bumpTickyCounter (sLit "ENT_VIA_NODE_ctr") +tickyEnterDynCon = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_CON_ctr") +tickyEnterDynThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_THK_ctr") +tickyEnterStaticCon = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_CON_ctr") +tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_THK_ctr") +tickyEnterViaNode = ifTicky $ bumpTickyCounter (fsLit "ENT_VIA_NODE_ctr") tickyEnterThunk :: ClosureInfo -> Code tickyEnterThunk cl_info @@ -140,15 +140,15 @@ tickyBlackHole :: Bool{-updatable-} -> Code tickyBlackHole updatable = ifTicky (bumpTickyCounter ctr) where - ctr | updatable = sLit "UPD_BH_SINGLE_ENTRY_ctr" - | otherwise = sLit "UPD_BH_UPDATABLE_ctr" + ctr | updatable = fsLit "UPD_BH_SINGLE_ENTRY_ctr" + | otherwise = fsLit "UPD_BH_UPDATABLE_ctr" tickyUpdateBhCaf :: ClosureInfo -> Code tickyUpdateBhCaf cl_info = ifTicky (bumpTickyCounter ctr) where - ctr | closureUpdReqd cl_info = sLit "UPD_CAF_BH_SINGLE_ENTRY_ctr" - | otherwise = sLit "UPD_CAF_BH_UPDATABLE_ctr" + ctr | closureUpdReqd cl_info = fsLit "UPD_CAF_BH_SINGLE_ENTRY_ctr" + | otherwise = fsLit "UPD_CAF_BH_UPDATABLE_ctr" tickyEnterFun :: ClosureInfo -> Code tickyEnterFun cl_info @@ -159,8 +159,8 @@ tickyEnterFun cl_info ; bumpTickyCounter' (cmmLabelOffB fun_ctr_lbl oFFSET_StgEntCounter_entry_count) } where - ctr | isStaticClosure cl_info = sLit "ENT_STATIC_FUN_DIRECT_ctr" - | otherwise = sLit "ENT_DYN_FUN_DIRECT_ctr" + ctr | isStaticClosure cl_info = fsLit "ENT_STATIC_FUN_DIRECT_ctr" + | otherwise = fsLit "ENT_DYN_FUN_DIRECT_ctr" registerTickyCtr :: CLabel -> Code -- Register a ticky counter @@ -183,25 +183,25 @@ registerTickyCtr ctr_lbl , CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_registeredp)) (CmmLit (mkIntCLit 1)) ] - ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (sLit "ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs")) tickyReturnOldCon, tickyReturnNewCon :: Arity -> Code tickyReturnOldCon arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_OLD_ctr") - ; bumpHistogram (sLit "RET_OLD_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr") + ; bumpHistogram (fsLit "RET_OLD_hst") arity } tickyReturnNewCon arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_NEW_ctr") - ; bumpHistogram (sLit "RET_NEW_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr") + ; bumpHistogram (fsLit "RET_NEW_hst") arity } tickyUnboxedTupleReturn :: Int -> Code tickyUnboxedTupleReturn arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_UNBOXED_TUP_ctr") - ; bumpHistogram (sLit "RET_UNBOXED_TUP_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr") + ; bumpHistogram (fsLit "RET_UNBOXED_TUP_hst") arity } tickyVectoredReturn :: Int -> Code tickyVectoredReturn family_size - = ifTicky $ do { bumpTickyCounter (sLit "VEC_RETURN_ctr") - ; bumpHistogram (sLit "RET_VEC_RETURN_hst") family_size } + = ifTicky $ do { bumpTickyCounter (fsLit "VEC_RETURN_ctr") + ; bumpHistogram (fsLit "RET_VEC_RETURN_hst") family_size } -- ----------------------------------------------------------------------------- -- Ticky calls @@ -209,10 +209,10 @@ tickyVectoredReturn family_size -- Ticks at a *call site*: tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs, tickyUnknownCall :: Code -tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_TOO_FEW_ARGS_ctr") -tickyKnownCallExact = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_ctr") -tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_EXTRA_ARGS_ctr") -tickyUnknownCall = ifTicky $ bumpTickyCounter (sLit "UNKNOWN_CALL_ctr") +tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_TOO_FEW_ARGS_ctr") +tickyKnownCallExact = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_ctr") +tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_EXTRA_ARGS_ctr") +tickyUnknownCall = ifTicky $ bumpTickyCounter (fsLit "UNKNOWN_CALL_ctr") -- Tick for the call pattern at slow call site (i.e. in addition to -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.) @@ -292,9 +292,9 @@ tickyAllocHeap hp (CmmLit (cmmLabelOffB ticky_ctr oFFSET_StgEntCounter_allocs)) hp, -- Bump ALLOC_HEAP_ctr - addToMemLbl cLongWidth (mkRtsDataLabel $ sLit "ALLOC_HEAP_ctr") 1, + addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_ctr") 1, -- Bump ALLOC_HEAP_tot - addToMemLbl cLongWidth (mkRtsDataLabel $ sLit "ALLOC_HEAP_tot") hp] } + addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_tot") hp] } -- ----------------------------------------------------------------------------- -- Ticky utils @@ -308,14 +308,14 @@ addToMemLbl :: Width -> CLabel -> Int -> CmmStmt addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n -- All the ticky-ticky counters are declared "unsigned long" in C -bumpTickyCounter :: LitString -> Code +bumpTickyCounter :: FastString -> Code bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0) bumpTickyCounter' :: CmmLit -> Code -- krc: note that we're incrementing the _entry_count_ field of the ticky counter bumpTickyCounter' lhs = stmtC (addToMemLong (CmmLit lhs) 1) -bumpHistogram :: LitString -> Int -> Code +bumpHistogram :: FastString -> Int -> Code bumpHistogram _lbl _n -- = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLong)) = return () -- TEMP SPJ Apr 07 diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index d1d81e5de4..0a545432d6 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -331,15 +331,15 @@ emitIfThenElse cond then_part else_part ; labelC join_id } -emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code +emitRtsCall :: FastString -> [CmmHinted 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 :: FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code emitRtsCallWithVols fun args vols safe = emitRtsCall' [] fun args (Just vols) safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString +emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString -> [CmmHinted CmmExpr] -> Bool -> Code emitRtsCallWithResult res hint fun args safe = emitRtsCall' [CmmHinted res hint] fun args Nothing safe @@ -347,7 +347,7 @@ emitRtsCallWithResult res hint fun args safe -- Make a call to an RTS C procedure emitRtsCall' :: [CmmHinted LocalReg] - -> LitString + -> FastString -> [CmmHinted CmmExpr] -> Maybe [GlobalReg] -> Bool -- True <=> CmmSafe call diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 379c4c42b4..e7d5444761 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -494,8 +494,8 @@ emitBlackHoleCode is_single_entry | otherwise = nopC where - bh_lbl | is_single_entry = mkRtsDataLabel (sLit "stg_SE_BLACKHOLE_info") - | otherwise = mkRtsDataLabel (sLit "stg_BLACKHOLE_info") + bh_lbl | is_single_entry = mkRtsDataLabel (fsLit "stg_SE_BLACKHOLE_info") + | otherwise = mkRtsDataLabel (fsLit "stg_BLACKHOLE_info") -- If we wanted to do eager blackholing with slop filling, -- we'd need to do it at the *end* of a basic block, otherwise @@ -605,7 +605,7 @@ link_caf cl_info _is_upd = do -- 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") [(CmmReg nodeReg,AddrHint)] [node] False + ; emitRtsCallWithVols (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False -- node is live, so save it. -- Overwrite the closure with a (static) indirection diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 9039d64daf..cfac231eda 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -153,7 +153,7 @@ buildDynCon binder _cc con [arg] , StgLitArg (MachInt val) <- arg , val <= fromIntegral mAX_INTLIKE -- Comparisons at type Integer! , val >= fromIntegral mIN_INTLIKE -- ...ditto... - = do { let intlike_lbl = mkRtsGcPtrLabel (sLit "stg_INTLIKE_closure") + = do { let intlike_lbl = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure") val_int = fromIntegral val :: Int offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1) -- INTLIKE closures consist of a header and one word payload @@ -166,7 +166,7 @@ buildDynCon binder _cc con [arg] , let val_int = ord val :: Int , val_int <= mAX_CHARLIKE , val_int >= mIN_CHARLIKE - = do { let charlike_lbl = mkRtsGcPtrLabel (sLit "stg_CHARLIKE_closure") + = do { let charlike_lbl = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure") offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1) -- CHARLIKE closures consist of a header and one word payload charlike_amode = cmmLabelOffW charlike_lbl offsetW diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index a02d2e24a3..8d23ade2c7 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -40,7 +40,7 @@ import DataCon import TyCon import CostCentre import Outputable -import FastString( LitString, mkFastString, sLit ) +import FastString( mkFastString, FastString, fsLit ) import Constants @@ -353,7 +353,7 @@ entryHeapCheck fun arity args code arg_exprs updfr_sz Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz - gc_lbl :: [LocalReg] -> Maybe LitString + gc_lbl :: [LocalReg] -> Maybe FastString {- gc_lbl [reg] | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p" @@ -372,7 +372,7 @@ entryHeapCheck fun arity args code gc_lbl regs = gc_lbl_ptrs (map (isGcPtrType . localRegType) regs) - gc_lbl_ptrs :: [Bool] -> Maybe LitString + gc_lbl_ptrs :: [Bool] -> Maybe FastString -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST... --gc_lbl_ptrs [True,True] = Just (sLit "stg_gc_fun_2p") --gc_lbl_ptrs [True,True,True] = Just (sLit "stg_gc_fun_3p") @@ -413,7 +413,7 @@ altHeapCheck regs code generic_gc :: CmmExpr -- The generic GC procedure; no params, no resuls -generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_noregs"))) +generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_noregs"))) -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST... -- generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_fun"))) diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 11a3257732..0e98e148ae 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -63,7 +63,7 @@ import Constants import Util import Data.List import Outputable -import FastString ( mkFastString, LitString, sLit ) +import FastString ( mkFastString, FastString, fsLit ) ------------------------------------------------------------------------ -- Call and return sequences @@ -180,29 +180,29 @@ slow_call :: CmmExpr -> [CmmExpr] -> [LRep] -> FCode () slow_call fun args reps = do call <- getCode $ direct_call "slow_call" (mkRtsApFastLabel rts_fun) arity args reps emit $ mkComment $ mkFastString ("slow_call for " ++ showSDoc (ppr fun) ++ - " with pat " ++ showSDoc (ptext rts_fun)) + " with pat " ++ showSDoc (ftext rts_fun)) emit (mkAssign nodeReg fun <*> call) where (rts_fun, arity) = slowCallPattern reps -- These cases were found to cover about 99% of all slow calls: -slowCallPattern :: [LRep] -> (LitString, Arity) +slowCallPattern :: [LRep] -> (FastString, Arity) -- Returns the generic apply function and arity -slowCallPattern (P: P: P: P: P: P: _) = (sLit "stg_ap_pppppp", 6) -slowCallPattern (P: P: P: P: P: _) = (sLit "stg_ap_ppppp", 5) -slowCallPattern (P: P: P: P: _) = (sLit "stg_ap_pppp", 4) -slowCallPattern (P: P: P: V: _) = (sLit "stg_ap_pppv", 4) -slowCallPattern (P: P: P: _) = (sLit "stg_ap_ppp", 3) -slowCallPattern (P: P: V: _) = (sLit "stg_ap_ppv", 3) -slowCallPattern (P: P: _) = (sLit "stg_ap_pp", 2) -slowCallPattern (P: V: _) = (sLit "stg_ap_pv", 2) -slowCallPattern (P: _) = (sLit "stg_ap_p", 1) -slowCallPattern (V: _) = (sLit "stg_ap_v", 1) -slowCallPattern (N: _) = (sLit "stg_ap_n", 1) -slowCallPattern (F: _) = (sLit "stg_ap_f", 1) -slowCallPattern (D: _) = (sLit "stg_ap_d", 1) -slowCallPattern (L: _) = (sLit "stg_ap_l", 1) -slowCallPattern [] = (sLit "stg_ap_0", 0) +slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6) +slowCallPattern (P: P: P: P: P: _) = (fsLit "stg_ap_ppppp", 5) +slowCallPattern (P: P: P: P: _) = (fsLit "stg_ap_pppp", 4) +slowCallPattern (P: P: P: V: _) = (fsLit "stg_ap_pppv", 4) +slowCallPattern (P: P: P: _) = (fsLit "stg_ap_ppp", 3) +slowCallPattern (P: P: V: _) = (fsLit "stg_ap_ppv", 3) +slowCallPattern (P: P: _) = (fsLit "stg_ap_pp", 2) +slowCallPattern (P: V: _) = (fsLit "stg_ap_pv", 2) +slowCallPattern (P: _) = (fsLit "stg_ap_p", 1) +slowCallPattern (V: _) = (fsLit "stg_ap_v", 1) +slowCallPattern (N: _) = (fsLit "stg_ap_n", 1) +slowCallPattern (F: _) = (fsLit "stg_ap_f", 1) +slowCallPattern (D: _) = (fsLit "stg_ap_d", 1) +slowCallPattern (L: _) = (fsLit "stg_ap_l", 1) +slowCallPattern [] = (fsLit "stg_ap_0", 0) ------------------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 80a4bb6160..f0a2798bf1 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -201,7 +201,7 @@ emitPrimOp [res] ParOp [arg] -- later, we might want to inline it. emitCCall [(res,NoHint)] - (CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark")))) + (CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark")))) [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)] emitPrimOp [res] ReadMutVarOp [mutv] diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 850356149c..aab9824199 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -73,7 +73,7 @@ curCCS = CmmLoad curCCSAddr ccsType -- Address of current CCS variable, for storing into curCCSAddr :: CmmExpr -curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCCS"))) +curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS"))) mkCCostCentre :: CostCentre -> CmmLit mkCCostCentre cc = CmmLabel (mkCCLabel cc) @@ -315,7 +315,7 @@ enterCostCentreThunk closure = emit $ mkStore curCCSAddr (costCentreFrom closure) enter_ccs_fun :: CmmExpr -> FCode () -enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [(stack,AddrHint)] False +enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [(stack,AddrHint)] False -- ToDo: vols enter_ccs_fsub :: FCode () @@ -328,7 +328,7 @@ enter_ccs_fsub = enteringPAP 0 -- entering via a PAP. enteringPAP :: Integer -> FCode () enteringPAP n - = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (sLit "entering_PAP")))) + = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP")))) (CmmLit (CmmInt n cIntWidth))) ifProfiling :: FCode () -> FCode () @@ -447,12 +447,12 @@ mkRegisterCCS ccs cC_LIST, cC_ID :: CmmExpr -cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_LIST"))) -cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_ID"))) +cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST"))) +cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID"))) cCS_LIST, cCS_ID :: CmmExpr -cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST"))) -cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID"))) +cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST"))) +cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID"))) -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -471,7 +471,7 @@ emitSetCCC cc pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode () pushCostCentre result ccs cc = emitRtsCallWithResult result AddrHint - (sLit "PushCostCentre") [(ccs,AddrHint), + (fsLit "PushCostCentre") [(ccs,AddrHint), (CmmLit (mkCCostCentre cc), AddrHint)] False @@ -538,7 +538,7 @@ ldvEnter cl_ptr loadEra :: CmmExpr loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth) - [CmmLoad (mkLblExpr (mkRtsDataLabel (sLit "era"))) cInt] + [CmmLoad (mkLblExpr (mkRtsDataLabel (fsLit "era"))) cInt] ldvWord :: CmmExpr -> CmmExpr -- Takes the address of a closure, and returns diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 2e4b29e73b..579544b055 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -121,19 +121,19 @@ ppr_for_ticky_name mod_name name -- Ticky stack frames tickyPushUpdateFrame, tickyUpdateFrameOmitted :: FCode () -tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (sLit "UPDF_PUSHED_ctr") -tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (sLit "UPDF_OMITTED_ctr") +tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (fsLit "UPDF_PUSHED_ctr") +tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (fsLit "UPDF_OMITTED_ctr") -- ----------------------------------------------------------------------------- -- Ticky entries tickyEnterDynCon, tickyEnterDynThunk, tickyEnterStaticCon, tickyEnterStaticThunk, tickyEnterViaNode :: FCode () -tickyEnterDynCon = ifTicky $ bumpTickyCounter (sLit "ENT_DYN_CON_ctr") -tickyEnterDynThunk = ifTicky $ bumpTickyCounter (sLit "ENT_DYN_THK_ctr") -tickyEnterStaticCon = ifTicky $ bumpTickyCounter (sLit "ENT_STATIC_CON_ctr") -tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (sLit "ENT_STATIC_THK_ctr") -tickyEnterViaNode = ifTicky $ bumpTickyCounter (sLit "ENT_VIA_NODE_ctr") +tickyEnterDynCon = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_CON_ctr") +tickyEnterDynThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_DYN_THK_ctr") +tickyEnterStaticCon = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_CON_ctr") +tickyEnterStaticThunk = ifTicky $ bumpTickyCounter (fsLit "ENT_STATIC_THK_ctr") +tickyEnterViaNode = ifTicky $ bumpTickyCounter (fsLit "ENT_VIA_NODE_ctr") tickyEnterThunk :: ClosureInfo -> FCode () tickyEnterThunk cl_info @@ -144,15 +144,15 @@ tickyBlackHole :: Bool{-updatable-} -> FCode () tickyBlackHole updatable = ifTicky (bumpTickyCounter ctr) where - ctr | updatable = (sLit "UPD_BH_SINGLE_ENTRY_ctr") - | otherwise = (sLit "UPD_BH_UPDATABLE_ctr") + ctr | updatable = (fsLit "UPD_BH_SINGLE_ENTRY_ctr") + | otherwise = (fsLit "UPD_BH_UPDATABLE_ctr") tickyUpdateBhCaf :: ClosureInfo -> FCode () tickyUpdateBhCaf cl_info = ifTicky (bumpTickyCounter ctr) where - ctr | closureUpdReqd cl_info = (sLit "UPD_CAF_BH_SINGLE_ENTRY_ctr") - | otherwise = (sLit "UPD_CAF_BH_UPDATABLE_ctr") + ctr | closureUpdReqd cl_info = (fsLit "UPD_CAF_BH_SINGLE_ENTRY_ctr") + | otherwise = (fsLit "UPD_CAF_BH_UPDATABLE_ctr") tickyEnterFun :: ClosureInfo -> FCode () tickyEnterFun cl_info @@ -163,8 +163,8 @@ tickyEnterFun cl_info ; bumpTickyCounter' (cmmLabelOffB fun_ctr_lbl oFFSET_StgEntCounter_entry_count) } where - ctr | isStaticClosure cl_info = (sLit "ENT_STATIC_FUN_DIRECT_ctr") - | otherwise = (sLit "ENT_DYN_FUN_DIRECT_ctr") + ctr | isStaticClosure cl_info = (fsLit "ENT_STATIC_FUN_DIRECT_ctr") + | otherwise = (fsLit "ENT_DYN_FUN_DIRECT_ctr") registerTickyCtr :: CLabel -> FCode () -- Register a ticky counter @@ -187,25 +187,25 @@ registerTickyCtr ctr_lbl , mkStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_registeredp)) (CmmLit (mkIntCLit 1)) ] - ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (sLit "ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs")) tickyReturnOldCon, tickyReturnNewCon :: Arity -> FCode () tickyReturnOldCon arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_OLD_ctr") - ; bumpHistogram (sLit "RET_OLD_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr") + ; bumpHistogram (fsLit "RET_OLD_hst") arity } tickyReturnNewCon arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_NEW_ctr") - ; bumpHistogram (sLit "RET_NEW_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr") + ; bumpHistogram (fsLit "RET_NEW_hst") arity } tickyUnboxedTupleReturn :: Int -> FCode () tickyUnboxedTupleReturn arity - = ifTicky $ do { bumpTickyCounter (sLit "RET_UNBOXED_TUP_ctr") - ; bumpHistogram (sLit "RET_UNBOXED_TUP_hst") arity } + = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr") + ; bumpHistogram (fsLit "RET_UNBOXED_TUP_hst") arity } tickyVectoredReturn :: Int -> FCode () tickyVectoredReturn family_size - = ifTicky $ do { bumpTickyCounter (sLit "VEC_RETURN_ctr") - ; bumpHistogram (sLit "RET_VEC_RETURN_hst") family_size } + = ifTicky $ do { bumpTickyCounter (fsLit "VEC_RETURN_ctr") + ; bumpHistogram (fsLit "RET_VEC_RETURN_hst") family_size } -- ----------------------------------------------------------------------------- -- Ticky calls @@ -218,13 +218,16 @@ tickyDirectCall arity args tickySlowCallPat (map argPrimRep (drop arity args)) tickyKnownCallTooFewArgs :: FCode () -tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_TOO_FEW_ARGS_ctr") +tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_TOO_FEW_ARGS_ctr") + tickyKnownCallExact :: FCode () -tickyKnownCallExact = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_ctr") +tickyKnownCallExact = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_ctr") + tickyKnownCallExtraArgs :: FCode () -tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter (sLit "KNOWN_CALL_EXTRA_ARGS_ctr") +tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_EXTRA_ARGS_ctr") + tickyUnknownCall :: FCode () -tickyUnknownCall = ifTicky $ bumpTickyCounter (sLit "UNKNOWN_CALL_ctr") +tickyUnknownCall = ifTicky $ bumpTickyCounter (fsLit "UNKNOWN_CALL_ctr") -- Tick for the call pattern at slow call site (i.e. in addition to -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.) @@ -314,9 +317,9 @@ tickyAllocHeap hp (CmmLit (cmmLabelOffB ticky_ctr oFFSET_StgEntCounter_allocs)) hp, -- Bump ALLOC_HEAP_ctr - addToMemLbl cLong (mkRtsDataLabel (sLit "ALLOC_HEAP_ctr")) 1, + addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_ctr")) 1, -- Bump ALLOC_HEAP_tot - addToMemLbl cLong (mkRtsDataLabel (sLit "ALLOC_HEAP_tot")) hp] } + addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_tot")) hp] } -- ----------------------------------------------------------------------------- -- Ticky utils @@ -327,14 +330,14 @@ ifTicky code = do dflags <- getDynFlags else nopC -- All the ticky-ticky counters are declared "unsigned long" in C -bumpTickyCounter :: LitString -> FCode () +bumpTickyCounter :: FastString -> FCode () bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0) bumpTickyCounter' :: CmmLit -> FCode () -- krc: note that we're incrementing the _entry_count_ field of the ticky counter bumpTickyCounter' lhs = emit (addToMem cLong (CmmLit lhs) 1) -bumpHistogram :: LitString -> Int -> FCode () +bumpHistogram :: FastString -> Int -> FCode () bumpHistogram _lbl _n -- = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongWidth)) = return () -- TEMP SPJ Apr 07 diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index d2d7bb1e41..bf452c4651 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -283,15 +283,15 @@ tagToClosure tycon tag -- ------------------------------------------------------------------------- -emitRtsCall :: LitString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () +emitRtsCall :: FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe -- The 'Nothing' says "save all global registers" -emitRtsCallWithVols :: LitString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode () +emitRtsCallWithVols :: FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode () emitRtsCallWithVols fun args vols safe = emitRtsCall' [] fun args (Just vols) safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString +emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCallWithResult res hint fun args safe = emitRtsCall' [(res,hint)] fun args Nothing safe @@ -299,7 +299,7 @@ emitRtsCallWithResult res hint fun args safe -- Make a call to an RTS C procedure emitRtsCall' :: [(LocalReg,ForeignHint)] - -> LitString + -> FastString -> [(CmmExpr,ForeignHint)] -> Maybe [GlobalReg] -> Bool -- True <=> CmmSafe call |