diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgProf.hs | 9 | ||||
| -rw-r--r-- | compiler/codeGen/CgTicky.hs | 5 | ||||
| -rw-r--r-- | compiler/codeGen/CodeGen.lhs | 234 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmm.hs | 8 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 3 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 57 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmLayout.hs | 7 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 9 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 7 |
11 files changed, 57 insertions, 290 deletions
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 5537e575d4..c124b5f68a 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -23,8 +23,6 @@ module CgProf ( ) where #include "HsVersions.h" -#include "../includes/dist-derivedconstants/header/DerivedConstants.h" - -- For REP_xxx constants, which are MachReps import ClosureInfo import CgUtils @@ -110,6 +108,7 @@ profAlloc :: CmmExpr -> CmmExpr -> Code profAlloc words ccs = ifProfiling $ do dflags <- getDynFlags + let alloc_rep = typeWidth (rEP_CostCentreStack_mem_alloc dflags) stmtC (addToMemE alloc_rep (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_mem_alloc dflags)) (CmmMachOp (MO_UU_Conv (wordWidth dflags) alloc_rep) $ @@ -117,8 +116,6 @@ profAlloc words ccs mkIntExpr dflags (profHdrSize dflags)]])) -- subtract the "profiling overhead", which is the -- profiling header in a closure. - where - alloc_rep = typeWidth REP_CostCentreStack_mem_alloc -- ----------------------------------------------------------------------- -- Setting the current cost centre on entry to a closure @@ -215,7 +212,7 @@ sizeof_ccs_words dflags | ms == 0 = ws | otherwise = ws + 1 where - (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags + (ws,ms) = sIZEOF_CostCentreStack dflags `divMod` wORD_SIZE dflags -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -239,7 +236,7 @@ pushCostCentre result ccs cc bumpSccCount :: DynFlags -> CmmExpr -> CmmStmt bumpSccCount dflags ccs - = addToMem (typeWidth REP_CostCentreStack_scc_count) + = addToMem (typeWidth (rEP_CostCentreStack_scc_count dflags)) (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_scc_count dflags)) 1 ----------------------------------------------------------------------------- diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 79215f6582..21837e787b 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -43,9 +43,6 @@ module CgTicky ( staticTickyHdr, ) where -#include "../includes/dist-derivedconstants/header/DerivedConstants.h" - -- For REP_xxx constants, which are MachReps - import ClosureInfo import CgUtils import CgMonad @@ -298,7 +295,7 @@ tickyAllocHeap hp if hp == 0 then [] -- Inside the stmtC to avoid control else [ -- dependency on the argument -- Bump the allcoation count in the StgEntCounter - addToMem (typeWidth REP_StgEntCounter_allocs) + addToMem (typeWidth (rEP_StgEntCounter_allocs dflags)) (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags))) hp, -- Bump ALLOC_HEAP_ctr diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs deleted file mode 100644 index 311f947248..0000000000 --- a/compiler/codeGen/CodeGen.lhs +++ /dev/null @@ -1,234 +0,0 @@ -% -% (c) The University of Glasgow 2006 -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% - -The Code Generator - -This module says how things get going at the top level. - -@codeGen@ is the interface to the outside world. The \tr{cgTop*} -functions drive the mangling of top-level bindings. - -\begin{code} - -module CodeGen ( codeGen ) where - -#include "HsVersions.h" - --- Required so that CgExpr is reached via at least one non-SOURCE --- import. Before, that wasn't the case, and CM therefore didn't --- bother to compile it. -import CgExpr ( {-NOTHING!-} ) -- DO NOT DELETE THIS IMPORT -import CgProf -import CgMonad -import CgBindery -import CgClosure -import CgCon -import CgUtils -import CgHpc - -import CLabel -import OldCmm -import OldPprCmm () - -import StgSyn -import PrelNames -import DynFlags - -import HscTypes -import CostCentre -import Id -import Name -import TyCon -import Module -import ErrUtils -import Panic -import Outputable -import Util - -import OrdList -import Stream (Stream, liftIO) -import qualified Stream - -import Data.IORef - -codeGen :: DynFlags - -> Module -- Module we are compiling - -> [TyCon] -- Type constructors - -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. - -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs - -> HpcInfo -- Profiling info - -> Stream IO CmmGroup () - -- N.B. returning '[Cmm]' and not 'Cmm' here makes it - -- possible for object splitting to split up the - -- pieces later. - -codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info - - = do { liftIO $ showPass dflags "CodeGen" - - ; cgref <- liftIO $ newIORef =<< initC - ; let cg :: FCode CmmGroup -> Stream IO CmmGroup () - cg fcode = do - cmm <- liftIO $ do - st <- readIORef cgref - let (a,st') = runC dflags this_mod st fcode - - dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" $ ppr a - - -- NB. stub-out cgs_tops and cgs_stmts. This fixes - -- a big space leak. DO NOT REMOVE! - writeIORef cgref $! st'{ cgs_tops = nilOL, - cgs_stmts = nilOL } - return a - Stream.yield cmm - - ; cg (getCmm $ mkModuleInit dflags cost_centre_info this_mod hpc_info) - - ; mapM_ (cg . getCmm . cgTopBinding dflags) stg_binds - - ; mapM_ (cg . cgTyCon) data_tycons - } - -mkModuleInit - :: DynFlags - -> CollectedCCs -- cost centre info - -> Module - -> HpcInfo - -> Code - -mkModuleInit dflags cost_centre_info this_mod hpc_info - = do { -- Allocate the static boolean that records if this - ; whenC (dopt Opt_Hpc dflags) $ - hpcTable this_mod hpc_info - - ; whenC (dopt Opt_SccProfilingOn dflags) $ do - initCostCentres cost_centre_info - - -- For backwards compatibility: user code may refer to this - -- label for calling hs_add_root(). - ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) [])) - - ; whenC (this_mod == mainModIs dflags) $ - emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return () - } -\end{code} - - - -Cost-centre profiling: Besides the usual stuff, we must produce -declarations for the cost-centres defined in this module; - -(The local cost-centres involved in this are passed into the -code-generator.) - -\begin{code} -initCostCentres :: CollectedCCs -> Code --- Emit the declarations, and return code to register them -initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs) - = do dflags <- getDynFlags - if not (dopt Opt_SccProfilingOn dflags) - then nopC - else do mapM_ emitCostCentreDecl local_CCs - mapM_ emitCostCentreStackDecl singleton_CCSs -\end{code} - -%************************************************************************ -%* * -\subsection[codegen-top-bindings]{Converting top-level STG bindings} -%* * -%************************************************************************ - -@cgTopBinding@ is only used for top-level bindings, since they need -to be allocated statically (not in the heap) and need to be labelled. -No unboxed bindings can happen at top level. - -In the code below, the static bindings are accumulated in the -@MkCgState@, and transferred into the ``statics'' slot by @forkStatics@. -This is so that we can write the top level processing in a compositional -style, with the increasing static environment being plumbed as a state -variable. - -\begin{code} -cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code -cgTopBinding dflags (StgNonRec id rhs, srts) - = do { id' <- maybeExternaliseId dflags id - ; mapM_ (mkSRT [id']) srts - ; (id,info) <- cgTopRhs id' rhs - ; addBindC id info -- Add the *un-externalised* Id to the envt, - -- so we find it when we look up occurrences - } - -cgTopBinding dflags (StgRec pairs, srts) - = do { let (bndrs, rhss) = unzip pairs - ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs - ; let pairs' = zip bndrs' rhss - ; mapM_ (mkSRT bndrs') srts - ; _new_binds <- fixC (\ new_binds -> do - { addBindsC new_binds - ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' }) - ; nopC } - -mkSRT :: [Id] -> (Id,[Id]) -> Code -mkSRT _ (_,[]) = nopC -mkSRT these (id,ids) - = do { ids <- mapFCs remap ids - ; id <- remap id - ; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id)) - (map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids) - } - where - -- Sigh, better map all the ids against the environment in - -- case they've been externalised (see maybeExternaliseId below). - remap id = case filter (==id) these of - (id':_) -> returnFC id' - [] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) } - --- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs --- to enclose the listFCs in cgTopBinding, but that tickled the --- statics "error" call in initC. I DON'T UNDERSTAND WHY! - -cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo) - -- The Id is passed along for setting up a binding... - -- It's already been externalised if necessary - -cgTopRhs bndr (StgRhsCon _cc con args) - = forkStatics (cgTopRhsCon bndr 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) (idCafInfo bndr)) $ - setSRT srt $ - forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body) -\end{code} - - -%************************************************************************ -%* * -\subsection{Stuff to support splitting} -%* * -%************************************************************************ - -If we're splitting the object, we need to externalise all the top-level names -(and then make sure we only use the externalised one in any C label we use -which refers to this name). - -\begin{code} -maybeExternaliseId :: DynFlags -> Id -> FCode Id -maybeExternaliseId dflags id - | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs - isInternalName name = do { mod <- getModuleName - ; returnFC (setIdName id (externalise mod)) } - | otherwise = returnFC id - where - externalise mod = mkExternalName uniq mod new_occ loc - name = idName id - uniq = nameUnique name - new_occ = mkLocalOcc uniq (nameOccName name) - loc = nameSrcSpan name - -- We want to conjure up a name that can't clash with any - -- existing name. So we generate - -- Mod_$L243foo - -- where 243 is the unique. -\end{code} diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index f1022e5280..37ca5e0d43 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -52,7 +52,7 @@ codeGen :: DynFlags -> Module -> [TyCon] -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. - -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs + -> [StgBinding] -- Bindings to convert -> HpcInfo -> Stream IO CmmGroup () -- Output as a stream, so codegen can -- be interleaved with output @@ -114,8 +114,8 @@ This is so that we can write the top level processing in a compositional style, with the increasing static environment being plumbed as a state variable. -} -cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode () -cgTopBinding dflags (StgNonRec id rhs, _srts) +cgTopBinding :: DynFlags -> StgBinding -> FCode () +cgTopBinding dflags (StgNonRec id rhs) = do { id' <- maybeExternaliseId dflags id ; (info, fcode) <- cgTopRhs id' rhs ; fcode @@ -123,7 +123,7 @@ cgTopBinding dflags (StgNonRec id rhs, _srts) -- so we find it when we look up occurrences } -cgTopBinding dflags (StgRec pairs, _srts) +cgTopBinding dflags (StgRec pairs) = do { let (bndrs, rhss) = unzip pairs ; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs ; let pairs' = zip bndrs' rhss diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 02d3d0246f..89d27dd161 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -468,8 +468,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details { fv_bindings <- mapM bind_fv fv_details -- Load free vars out of closure *after* -- heap check, to reduce live vars over check - ; if node_points then load_fvs node lf_info fv_bindings - else return () + ; when node_points $ load_fvs node lf_info fv_bindings ; void $ cgExpr body }} } diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 307d3715b3..a8ffc12bb0 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -163,9 +163,7 @@ cgLetNoEscapeClosure bndr cc_slot _unused_cc args body code = forkProc $ do { restoreCurrentCostCentre cc_slot ; arg_regs <- bindArgsToRegs args - ; void $ altHeapCheck arg_regs (cgExpr body) } - -- Using altHeapCheck just reduces - -- instructions to save on stack + ; void $ noEscapeHeapCheck arg_regs (cgExpr body) } ------------------------------------------------------------------------ diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index fb3739177c..b7cca48f5a 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -10,7 +10,7 @@ module StgCmmHeap ( getVirtHp, setVirtHp, setRealHp, getHpRelOffset, hpRel, - entryHeapCheck, altHeapCheck, altHeapCheckReturnsTo, + entryHeapCheck, altHeapCheck, noEscapeHeapCheck, altHeapCheckReturnsTo, mkVirtHeapOffsets, mkVirtConstrOffsets, mkStaticClosureFields, mkStaticClosure, @@ -371,7 +371,7 @@ entryHeapCheck cl_info nodeSet arity args code loop_id <- newLabelC emitLabel loop_id - heapCheck True (gc_call updfr_sz <*> mkBranch loop_id) code + heapCheck True True (gc_call updfr_sz <*> mkBranch loop_id) code {- -- This code is slightly outdated now and we could easily keep the above @@ -436,32 +436,41 @@ entryHeapCheck cl_info nodeSet arity args code -- else we do a normal call to stg_gc_noregs altHeapCheck :: [LocalReg] -> FCode a -> FCode a -altHeapCheck regs code = do +altHeapCheck regs code = altOrNoEscapeHeapCheck False regs code + +altOrNoEscapeHeapCheck :: Bool -> [LocalReg] -> FCode a -> FCode a +altOrNoEscapeHeapCheck checkYield regs code = do dflags <- getDynFlags case cannedGCEntryPoint dflags regs of - Nothing -> genericGC code + Nothing -> genericGC checkYield code Just gc -> do lret <- newLabelC let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) regs lcont <- newLabelC emitOutOfLine lret (copyin <*> mkBranch lcont) emitLabel lcont - cannedGCReturnsTo False gc regs lret off code + cannedGCReturnsTo checkYield False gc regs lret off code altHeapCheckReturnsTo :: [LocalReg] -> Label -> ByteOff -> FCode a -> FCode a altHeapCheckReturnsTo regs lret off code = do dflags <- getDynFlags case cannedGCEntryPoint dflags regs of - Nothing -> genericGC code - Just gc -> cannedGCReturnsTo True gc regs lret off code + Nothing -> genericGC False code + Just gc -> cannedGCReturnsTo False True gc regs lret off code + +-- noEscapeHeapCheck is implemented identically to altHeapCheck (which +-- is more efficient), but cannot be optimized away in the non-allocating +-- case because it may occur in a loop +noEscapeHeapCheck :: [LocalReg] -> FCode a -> FCode a +noEscapeHeapCheck regs code = altOrNoEscapeHeapCheck True regs code -cannedGCReturnsTo :: Bool -> CmmExpr -> [LocalReg] -> Label -> ByteOff +cannedGCReturnsTo :: Bool -> Bool -> CmmExpr -> [LocalReg] -> Label -> ByteOff -> FCode a -> FCode a -cannedGCReturnsTo cont_on_stack gc regs lret off code +cannedGCReturnsTo checkYield cont_on_stack gc regs lret off code = do dflags <- getDynFlags updfr_sz <- getUpdFrameOff - heapCheck False (gc_call dflags gc updfr_sz) code + heapCheck False checkYield (gc_call dflags gc updfr_sz) code where reg_exprs = map (CmmReg . CmmLocal) regs -- Note [stg_gc arguments] @@ -470,13 +479,13 @@ cannedGCReturnsTo cont_on_stack gc regs lret off code | cont_on_stack = mkJumpReturnsTo dflags label GC reg_exprs lret off sp | otherwise = mkCallReturnsTo dflags label GC reg_exprs lret off sp (0,[]) -genericGC :: FCode a -> FCode a -genericGC code +genericGC :: Bool -> FCode a -> FCode a +genericGC checkYield code = do updfr_sz <- getUpdFrameOff lretry <- newLabelC emitLabel lretry call <- mkCall generic_gc (GC, GC) [] [] updfr_sz (0,[]) - heapCheck False (call <*> mkBranch lretry) code + heapCheck False checkYield (call <*> mkBranch lretry) code cannedGCEntryPoint :: DynFlags -> [LocalReg] -> Maybe CmmExpr cannedGCEntryPoint dflags regs @@ -524,22 +533,23 @@ mkGcLabel :: String -> CmmExpr mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit s))) ------------------------------- -heapCheck :: Bool -> CmmAGraph -> FCode a -> FCode a -heapCheck checkStack do_gc code +heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a +heapCheck checkStack checkYield do_gc code = getHeapUsage $ \ hpHw -> -- Emit heap checks, but be sure to do it lazily so -- that the conditionals on hpHw don't cause a black hole - do { codeOnly $ do_checks checkStack hpHw do_gc + do { codeOnly $ do_checks checkStack checkYield hpHw do_gc ; tickyAllocHeap hpHw ; doGranAllocate hpHw ; setRealHp hpHw ; code } do_checks :: Bool -- Should we check the stack? + -> Bool -- Should we check for preemption? -> WordOff -- Heap headroom -> CmmAGraph -- What to do on failure -> FCode () -do_checks checkStack alloc do_gc = do +do_checks checkStack checkYield alloc do_gc = do dflags <- getDynFlags let alloc_lit = mkIntExpr dflags (alloc * wORD_SIZE dflags) -- Bytes @@ -557,15 +567,22 @@ do_checks checkStack alloc do_gc = do hp_oflo = CmmMachOp (mo_wordUGt dflags) [CmmReg hpReg, CmmReg (CmmGlobal HpLim)] + -- Yielding if HpLim == 0 + yielding = CmmMachOp (mo_wordEq dflags) + [CmmReg (CmmGlobal HpLim), CmmLit (zeroCLit dflags)] + alloc_n = mkAssign (CmmGlobal HpAlloc) alloc_lit gc_id <- newLabelC when checkStack $ do emit =<< mkCmmIfGoto sp_oflo gc_id - when (alloc /= 0) $ do - emitAssign hpReg bump_hp - emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) + if (alloc /= 0) + then do + emitAssign hpReg bump_hp + emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) + else do + when (not (dopt Opt_OmitYields dflags) && checkYield) (emit =<< mkCmmIfGoto yielding gc_id) emitOutOfLine gc_id $ do_gc -- this is expected to jump back somewhere diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 69a0d1a0cf..75d8d1c38f 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -61,6 +61,7 @@ import Util import Data.List import Outputable import FastString +import Control.Monad ------------------------------------------------------------------------ -- Call and return sequences @@ -84,9 +85,11 @@ emitReturn results ; case sequel of Return _ -> do { adjustHpBackwards - ; emit (mkReturnSimple dflags results updfr_off) } + ; let e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord dflags) + ; emit (mkReturn dflags (entryCode dflags e) results updfr_off) + } AssignTo regs adjust -> - do { if adjust then adjustHpBackwards else return () + do { when adjust adjustHpBackwards ; emitMultiAssign regs results } ; return AssignedDirectly } diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index ba65a556b2..b666554403 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -31,8 +31,6 @@ module StgCmmProf ( ) where #include "HsVersions.h" -#include "../includes/dist-derivedconstants/header/DerivedConstants.h" - -- For REP_xxx constants, which are MachReps import StgCmmClosure import StgCmmUtils @@ -169,6 +167,7 @@ profAlloc :: CmmExpr -> CmmExpr -> FCode () profAlloc words ccs = ifProfiling $ do dflags <- getDynFlags + let alloc_rep = rEP_CostCentreStack_mem_alloc dflags emit (addToMemE alloc_rep (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_mem_alloc dflags)) (CmmMachOp (MO_UU_Conv (wordWidth dflags) (typeWidth alloc_rep)) $ @@ -176,8 +175,6 @@ profAlloc words ccs mkIntExpr dflags (profHdrSize dflags)]])) -- subtract the "profiling overhead", which is the -- profiling header in a closure. - where - alloc_rep = REP_CostCentreStack_mem_alloc -- ----------------------------------------------------------------------- -- Setting the current cost centre on entry to a closure @@ -277,7 +274,7 @@ sizeof_ccs_words dflags | ms == 0 = ws | otherwise = ws + 1 where - (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags + (ws,ms) = sIZEOF_CostCentreStack dflags `divMod` wORD_SIZE dflags -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -302,7 +299,7 @@ pushCostCentre result ccs cc bumpSccCount :: DynFlags -> CmmExpr -> CmmAGraph bumpSccCount dflags ccs - = addToMem REP_CostCentreStack_scc_count + = addToMem (rEP_CostCentreStack_scc_count dflags) (cmmOffsetB dflags ccs (oFFSET_CostCentreStack_scc_count dflags)) 1 ----------------------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index d7517e8256..79ad3ff822 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -46,8 +46,6 @@ module StgCmmTicky ( ) where #include "HsVersions.h" -#include "../includes/dist-derivedconstants/header/DerivedConstants.h" - -- For REP_xxx constants, which are MachReps import StgCmmClosure import StgCmmUtils @@ -321,7 +319,7 @@ tickyAllocHeap hp if hp == 0 then [] -- Inside the emitMiddle to avoid control else [ -- dependency on the argument -- Bump the allcoation count in the StgEntCounter - addToMem REP_StgEntCounter_allocs + addToMem (rEP_StgEntCounter_allocs dflags) (CmmLit (cmmLabelOffB ticky_ctr (oFFSET_StgEntCounter_allocs dflags))) hp, -- Bump ALLOC_HEAP_ctr diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index f5dc2b6d31..386e7f46d6 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -37,9 +37,7 @@ module StgCmmUtils ( mkWordCLit, newStringCLit, newByteStringCLit, packHalfWordsCLit, - blankWord, - - srt_escape + blankWord ) where #include "HsVersions.h" @@ -719,6 +717,3 @@ assignTemp' e let reg = CmmLocal lreg emitAssign reg e return (CmmReg reg) - -srt_escape :: DynFlags -> StgHalfWord -srt_escape dflags = toStgHalfWord dflags (-1) |