X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTicky.hs;h=e8af01991fffa3872091358c9fe6311d9f847049;hb=588ca4b501d3d9581a19d786d1294a69375e2d3d;hp=7f8950583402688379c5f47b380fd9201fc2f4d7;hpb=3cc90d192495f4f1bc2ad083a45f24427b5eebbf;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 7f89505..e8af019 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -1,10 +1,3 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - ----------------------------------------------------------------------------- -- -- Code generation for ticky-ticky profiling @@ -52,23 +45,25 @@ import CgMonad import SMRep import Cmm -import MachOp import CmmUtils import CLabel import Name import Id -import StaticFlags +import IdInfo import BasicTypes import FastString import Constants import Outputable +import Module -- Turgid imports for showTypeCategory import PrelNames import TcType import TyCon +import DynFlags + import Data.Maybe ----------------------------------------------------------------------------- @@ -106,13 +101,14 @@ emitTickyCounter cl_info args on_stk ] } where name = closureName cl_info - ticky_ctr_label = mkRednCountsLabel name + ticky_ctr_label = mkRednCountsLabel name NoCafRefs arg_descr = map (showTypeCategory . idType) args fun_descr mod_name = ppr_for_ticky_name mod_name name -- When printing the name of a thing in a ticky file, we want to -- give the module name even for *local* things. We print -- just "x (M)" rather that "M.x" to distinguish them from the global kind. +ppr_for_ticky_name :: Module -> Name -> String ppr_for_ticky_name mod_name name | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name))) | otherwise = showSDocDebug (ppr name) @@ -120,12 +116,15 @@ 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") -- ----------------------------------------------------------------------------- -- 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") @@ -144,6 +143,7 @@ tickyBlackHole updatable ctr | updatable = sLit "UPD_BH_SINGLE_ENTRY_ctr" | otherwise = sLit "UPD_BH_UPDATABLE_ctr" +tickyUpdateBhCaf :: ClosureInfo -> Code tickyUpdateBhCaf cl_info = ifTicky (bumpTickyCounter ctr) where @@ -172,13 +172,13 @@ registerTickyCtr ctr_lbl = emitIf test (stmtsC register_stmts) where -- krc: code generator doesn't handle Not, so we test for Eq 0 instead - test = CmmMachOp (MO_Eq wordRep) + test = CmmMachOp (MO_Eq wordWidth) [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl - oFFSET_StgEntCounter_registeredp)) wordRep, + oFFSET_StgEntCounter_registeredp)) bWord, CmmLit (mkIntCLit 0)] register_stmts = [ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link)) - (CmmLoad ticky_entry_ctrs wordRep) + (CmmLoad ticky_entry_ctrs bWord) , CmmStore ticky_entry_ctrs (mkLblExpr ctr_lbl) , CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_registeredp)) @@ -190,8 +190,6 @@ tickyReturnOldCon arity = ifTicky $ do { bumpTickyCounter (sLit "RET_OLD_ctr") ; bumpHistogram (sLit "RET_OLD_hst") arity } tickyReturnNewCon arity - | not opt_DoTickyProfiling = nopC - | otherwise = ifTicky $ do { bumpTickyCounter (sLit "RET_NEW_ctr") ; bumpHistogram (sLit "RET_NEW_hst") arity } @@ -209,6 +207,8 @@ tickyVectoredReturn family_size -- Ticky calls -- 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") @@ -217,7 +217,7 @@ tickyUnknownCall = ifTicky $ bumpTickyCounter (sLit "UNKNOWN_CALL_ctr") -- Tick for the call pattern at slow call site (i.e. in addition to -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.) tickySlowCallPat :: [CgRep] -> Code -tickySlowCallPat args = return () +tickySlowCallPat _args = return () {- LATER: (introduces recursive module dependency now). case callPattern args of (str, True) -> bumpTickyCounter' (mkRtsSlowTickyCtrLabel pat) @@ -255,8 +255,8 @@ tickyDynAlloc cl_info Nothing -> return () where -- will be needed when we fill in stubs - cl_size = closureSize cl_info - slop_size = slopSize cl_info + _cl_size = closureSize cl_info + _slop_size = slopSize cl_info tick_alloc_thk | closureUpdReqd cl_info = tick_alloc_up_thk @@ -271,13 +271,13 @@ tickyDynAlloc cl_info tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> Code -tickyAllocPrim hdr goods slop = ifTicky $ pprTrace "ToDo: tickyAllocPrim" empty (return ()) +tickyAllocPrim _hdr _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocPrim" empty (return ()) tickyAllocThunk :: CmmExpr -> CmmExpr -> Code -tickyAllocThunk goods slop = ifTicky $ pprTrace "ToDo: tickyAllocThunk" empty (return ()) +tickyAllocThunk _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocThunk" empty (return ()) tickyAllocPAP :: CmmExpr -> CmmExpr -> Code -tickyAllocPAP goods slop = ifTicky $ pprTrace "ToDo: tickyAllocPAP" empty (return ()) +tickyAllocPAP _goods _slop = ifTicky $ pprTrace "ToDo: tickyAllocPAP" empty (return ()) tickyAllocHeap :: VirtualHpOffset -> Code -- Called when doing a heap check [TICK_ALLOC_HEAP] @@ -288,23 +288,23 @@ 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 REP_StgEntCounter_allocs + addToMem (typeWidth REP_StgEntCounter_allocs) (CmmLit (cmmLabelOffB ticky_ctr oFFSET_StgEntCounter_allocs)) hp, -- Bump ALLOC_HEAP_ctr - addToMemLbl cLongRep (mkRtsDataLabel (sLit "ALLOC_HEAP_ctr")) 1, - -- Bump ALLOC_HEAP_tot - addToMemLbl cLongRep (mkRtsDataLabel (sLit "ALLOC_HEAP_tot")) hp] } + addToMemLbl cLongWidth (mkRtsDataLabel $ sLit "ALLOC_HEAP_ctr") 1, + -- Bump ALLOC_HEAP_tot + addToMemLbl cLongWidth (mkRtsDataLabel $ sLit "ALLOC_HEAP_tot") hp] } -- ----------------------------------------------------------------------------- -- Ticky utils ifTicky :: Code -> Code -ifTicky code - | opt_DoTickyProfiling = code - | otherwise = nopC +ifTicky code = do dflags <- getDynFlags + if doingTickyProfiling dflags then code + else nopC -addToMemLbl :: MachRep -> CLabel -> Int -> CmmStmt +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 @@ -313,27 +313,31 @@ 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 (addToMem cLongRep (CmmLit lhs) 1) - -addToMemLong = addToMem cLongRep +bumpTickyCounter' lhs = stmtC (addToMemLong (CmmLit lhs) 1) bumpHistogram :: LitString -> Int -> Code -bumpHistogram lbl n --- = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongRep)) +bumpHistogram _lbl _n +-- = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLong)) = return () -- TEMP SPJ Apr 07 +{- bumpHistogramE :: LitString -> CmmExpr -> Code bumpHistogramE lbl n - = do t <- newNonPtrTemp cLongRep + = do t <- newTemp cLong stmtC (CmmAssign (CmmLocal t) n) - emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg (CmmLocal t), eight]) $ + emitIf (CmmMachOp (MO_U_Le cLongWidth) [CmmReg (CmmLocal t), eight]) $ stmtC (CmmAssign (CmmLocal t) eight) - stmtC (addToMemLong (cmmIndexExpr cLongRep + stmtC (addToMemLong (cmmIndexExpr cLongWidth (CmmLit (CmmLabel (mkRtsDataLabel lbl))) (CmmReg (CmmLocal t))) 1) where - eight = CmmLit (CmmInt 8 cLongRep) + eight = CmmLit (CmmInt 8 cLongWidth) +-} + +------------------------------------------------------------------ +addToMemLong :: CmmExpr -> Int -> CmmStmt +addToMemLong = addToMem cLongWidth ------------------------------------------------------------------ -- Showing the "type category" for ticky-ticky profiling @@ -380,6 +384,6 @@ showTypeCategory ty else if isPrimTyCon tycon {- array, we hope -} then 'A' -- Bogus else if isEnumerationTyCon tycon then 'E' else if isTupleTyCon tycon then 'T' - else if isJust (maybeTyConSingleCon tycon) then 'S' + else if isJust (tyConSingleDataCon_maybe tycon) then 'S' else if utc == listTyConKey then 'L' else 'M' -- oh, well...