X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTicky.hs;h=b23b34caa4983c6734624cc28dae4a94d888a94b;hb=960a5edb6ac87c7d85e36f4b70be8da0175819f7;hp=3f40d653f38cc2fc053fe192ab0481484cfd10ce;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 3f40d65..b23b34c 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -1,3 +1,10 @@ +{-# 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 @@ -6,13 +13,6 @@ -- ----------------------------------------------------------------------------- -{-# 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 - module CgTicky ( emitTickyCounter, @@ -43,7 +43,6 @@ module CgTicky ( staticTickyHdr, ) where -#include "HsVersions.h" #include "../includes/DerivedConstants.h" -- For REP_xxx constants, which are MachReps @@ -53,12 +52,12 @@ import CgMonad import SMRep import Cmm -import MachOp import CmmUtils import CLabel import Name import Id +import IdInfo import StaticFlags import BasicTypes import FastString @@ -107,7 +106,7 @@ 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 @@ -121,17 +120,17 @@ ppr_for_ticky_name mod_name name -- ----------------------------------------------------------------------------- -- Ticky stack frames -tickyPushUpdateFrame = ifTicky $ bumpTickyCounter SLIT("UPDF_PUSHED_ctr") -tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter SLIT("UPDF_OMITTED_ctr") +tickyPushUpdateFrame = ifTicky $ bumpTickyCounter (sLit "UPDF_PUSHED_ctr") +tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter (sLit "UPDF_OMITTED_ctr") -- ----------------------------------------------------------------------------- -- Ticky entries -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 (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") tickyEnterThunk :: ClosureInfo -> Code tickyEnterThunk cl_info @@ -142,14 +141,14 @@ 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 = sLit "UPD_BH_SINGLE_ENTRY_ctr" + | otherwise = sLit "UPD_BH_UPDATABLE_ctr" 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 = sLit "UPD_CAF_BH_SINGLE_ENTRY_ctr" + | otherwise = sLit "UPD_CAF_BH_UPDATABLE_ctr" tickyEnterFun :: ClosureInfo -> Code tickyEnterFun cl_info @@ -160,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 = sLit "ENT_STATIC_FUN_DIRECT_ctr" + | otherwise = sLit "ENT_DYN_FUN_DIRECT_ctr" registerTickyCtr :: CLabel -> Code -- Register a ticky counter @@ -173,47 +172,47 @@ 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)) (CmmLit (mkIntCLit 1)) ] - ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel SLIT("ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (sLit "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 (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 } + = ifTicky $ do { bumpTickyCounter (sLit "RET_NEW_ctr") + ; bumpHistogram (sLit "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 (sLit "RET_UNBOXED_TUP_ctr") + ; bumpHistogram (sLit "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 (sLit "VEC_RETURN_ctr") + ; bumpHistogram (sLit "RET_VEC_RETURN_hst") family_size } -- ----------------------------------------------------------------------------- -- Ticky calls -- Ticks at a *call site*: -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 (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") -- Tick for the call pattern at slow call site (i.e. in addition to -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.) @@ -222,7 +221,7 @@ tickySlowCallPat args = return () {- LATER: (introduces recursive module dependency now). case callPattern args of (str, True) -> bumpTickyCounter' (mkRtsSlowTickyCtrLabel pat) - (str, False) -> bumpTickyCounter SLIT("TICK_SLOW_CALL_OTHER") + (str, False) -> bumpTickyCounter (sLit "TICK_SLOW_CALL_OTHER") callPattern :: [CgRep] -> (String,Bool) callPattern reps @@ -289,13 +288,13 @@ 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 @@ -305,7 +304,7 @@ ifTicky code | opt_DoTickyProfiling = code | otherwise = 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 @@ -314,27 +313,28 @@ 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)) +-- = 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 = addToMem cLongWidth ------------------------------------------------------------------ -- Showing the "type category" for ticky-ticky profiling @@ -373,8 +373,6 @@ showTypeCategory ty else if utc == intDataConKey then 'I' else if utc == floatDataConKey then 'F' else if utc == doubleDataConKey then 'D' - else if utc == smallIntegerDataConKey || - utc == largeIntegerDataConKey then 'J' else if utc == charPrimTyConKey then 'c' else if (utc == intPrimTyConKey || utc == wordPrimTyConKey || utc == addrPrimTyConKey) then 'i' @@ -383,6 +381,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...