X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTicky.hs;h=3f40d653f38cc2fc053fe192ab0481484cfd10ce;hb=16a2f6a8a381af31c23b6a41a851951da9bc1803;hp=3e72981c50a1ce247720ebd862c0cf56ae661661;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 3e72981..3f40d65 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -2,10 +2,17 @@ -- -- Code generation for ticky-ticky profiling -- --- (c) The University of Glasgow 2004 +-- (c) The University of Glasgow 2004-2006 -- ----------------------------------------------------------------------------- +{-# 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, @@ -33,39 +40,37 @@ module CgTicky ( tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs, tickyUnknownCall, tickySlowCallPat, - staticTickyHdr, + staticTickyHdr, ) where #include "HsVersions.h" #include "../includes/DerivedConstants.h" -- For REP_xxx constants, which are MachReps -import ClosureInfo ( ClosureInfo, closureSize, slopSize, closureSMRep, - closureUpdReqd, closureName, isStaticClosure ) +import ClosureInfo import CgUtils import CgMonad -import SMRep ( ClosureType(..), smRepClosureType, CgRep ) +import SMRep import Cmm import MachOp -import CmmUtils ( zeroCLit, mkIntCLit, mkLblExpr, cmmIndexExpr ) -import CLabel ( CLabel, mkRtsDataLabel, mkRednCountsLabel ) - -import Name ( isInternalName ) -import Id ( Id, idType ) -import StaticFlags ( opt_DoTickyProfiling ) -import BasicTypes ( Arity ) -import FastString ( FastString, mkFastString, LitString ) -import Constants -- Lots of field offsets +import CmmUtils +import CLabel + +import Name +import Id +import StaticFlags +import BasicTypes +import FastString +import Constants import Outputable -- Turgid imports for showTypeCategory import PrelNames -import TcType ( Type, isDictTy, tcSplitTyConApp_maybe, - tcSplitFunTy_maybe ) -import TyCon ( isPrimTyCon, isTupleTyCon, isEnumerationTyCon, - maybeTyConSingleCon ) -import Maybe +import TcType +import TyCon + +import Data.Maybe ----------------------------------------------------------------------------- -- @@ -74,23 +79,26 @@ import Maybe ----------------------------------------------------------------------------- staticTickyHdr :: [CmmLit] --- The ticky header words in a static closure --- Was SET_STATIC_TICKY_HDR -staticTickyHdr - | not opt_DoTickyProfiling = [] - | otherwise = [zeroCLit] +-- krc: not using this right now -- +-- in the new version of ticky-ticky, we +-- don't change the closure layout. +-- leave it defined, though, to avoid breaking +-- other things. +staticTickyHdr = [] emitTickyCounter :: ClosureInfo -> [Id] -> Int -> Code emitTickyCounter cl_info args on_stk = ifTicky $ - do { mod_name <- moduleName + do { mod_name <- getModuleName ; fun_descr_lit <- mkStringCLit (fun_descr mod_name) ; arg_descr_lit <- mkStringCLit arg_descr ; emitDataLits ticky_ctr_label -- Must match layout of StgEntCounter - [ CmmInt 0 I16, - CmmInt (fromIntegral (length args)) I16, -- Arity - CmmInt (fromIntegral on_stk) I16, -- Words passed on stack - CmmInt 0 I16, -- 2-byte gap +-- krc: note that all the fields are I32 now; some were I16 before, +-- but the code generator wasn't handling that properly and it led to chaos, +-- panic and disorder. + [ mkIntCLit 0, + mkIntCLit (length args),-- Arity + mkIntCLit on_stk, -- Words passed on stack fun_descr_lit, arg_descr_lit, zeroCLit, -- Entry count @@ -149,10 +157,11 @@ tickyEnterFun cl_info do { bumpTickyCounter ctr ; fun_ctr_lbl <- getTickyCtrLabel ; registerTickyCtr fun_ctr_lbl - ; bumpTickyCounter' fun_ctr_lbl } + ; bumpTickyCounter' (cmmLabelOffB fun_ctr_lbl oFFSET_StgEntCounter_entry_count) + } where - ctr | isStaticClosure cl_info = SLIT("TICK_ENT_STATIC_FUN_DIRECT") - | otherwise = SLIT("TICK_ENT_DYN_FUN_DIRECT") + ctr | isStaticClosure cl_info = SLIT("ENT_STATIC_FUN_DIRECT_ctr") + | otherwise = SLIT("ENT_DYN_FUN_DIRECT_ctr") registerTickyCtr :: CLabel -> Code -- Register a ticky counter @@ -163,9 +172,11 @@ registerTickyCtr :: CLabel -> Code registerTickyCtr ctr_lbl = emitIf test (stmtsC register_stmts) where - test = CmmMachOp (MO_Not I16) - [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl - oFFSET_StgEntCounter_registeredp)) I16] + -- krc: code generator doesn't handle Not, so we test for Eq 0 instead + test = CmmMachOp (MO_Eq wordRep) + [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl + oFFSET_StgEntCounter_registeredp)) wordRep, + CmmLit (mkIntCLit 0)] register_stmts = [ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link)) (CmmLoad ticky_entry_ctrs wordRep) @@ -201,7 +212,7 @@ tickyVectoredReturn family_size -- 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_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 @@ -236,11 +247,13 @@ tickyDynAlloc :: ClosureInfo -> Code tickyDynAlloc cl_info = ifTicky $ case smRepClosureType (closureSMRep cl_info) of - Constr -> tick_alloc_con - ConstrNoCaf -> tick_alloc_con - Fun -> tick_alloc_fun - Thunk -> tick_alloc_thk - ThunkSelector -> tick_alloc_thk + Just Constr -> tick_alloc_con + Just ConstrNoCaf -> tick_alloc_con + Just Fun -> tick_alloc_fun + Just Thunk -> tick_alloc_thk + Just ThunkSelector -> tick_alloc_thk + -- black hole + Nothing -> return () where -- will be needed when we fill in stubs cl_size = closureSize cl_info @@ -250,19 +263,22 @@ tickyDynAlloc cl_info | closureUpdReqd cl_info = tick_alloc_up_thk | otherwise = tick_alloc_se_thk - tick_alloc_con = panic "ToDo: tick_alloc" - tick_alloc_fun = panic "ToDo: tick_alloc" - tick_alloc_up_thk = panic "ToDo: tick_alloc" - tick_alloc_se_thk = panic "ToDo: tick_alloc" + -- krc: changed from panic to return () + -- just to get something working + tick_alloc_con = return () + tick_alloc_fun = return () + tick_alloc_up_thk = return () + tick_alloc_se_thk = return () + tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> Code -tickyAllocPrim hdr goods slop = ifTicky $ panic "ToDo: tickyAllocPrim" +tickyAllocPrim hdr goods slop = ifTicky $ pprTrace "ToDo: tickyAllocPrim" empty (return ()) tickyAllocThunk :: CmmExpr -> CmmExpr -> Code -tickyAllocThunk goods slop = ifTicky $ panic "ToDo: tickyAllocThunk" +tickyAllocThunk goods slop = ifTicky $ pprTrace "ToDo: tickyAllocThunk" empty (return ()) tickyAllocPAP :: CmmExpr -> CmmExpr -> Code -tickyAllocPAP goods slop = ifTicky $ panic "ToDo: tickyAllocPAP" +tickyAllocPAP goods slop = ifTicky $ pprTrace "ToDo: tickyAllocPAP" empty (return ()) tickyAllocHeap :: VirtualHpOffset -> Code -- Called when doing a heap check [TICK_ALLOC_HEAP] @@ -294,26 +310,28 @@ 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 lbl = bumpTickyCounter' (mkRtsDataLabel lbl) +bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0) -bumpTickyCounter' :: CLabel -> Code -bumpTickyCounter' lbl = stmtC (addToMemLbl cLongRep lbl 1) +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 bumpHistogram :: LitString -> Int -> Code bumpHistogram lbl n - = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongRep)) +-- = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongRep)) + = return () -- TEMP SPJ Apr 07 bumpHistogramE :: LitString -> CmmExpr -> Code bumpHistogramE lbl n - = do t <- newTemp cLongRep - stmtC (CmmAssign t n) - emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg t, eight]) $ - stmtC (CmmAssign t eight) + = do t <- newNonPtrTemp cLongRep + stmtC (CmmAssign (CmmLocal t) n) + emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg (CmmLocal t), eight]) $ + stmtC (CmmAssign (CmmLocal t) eight) stmtC (addToMemLong (cmmIndexExpr cLongRep (CmmLit (CmmLabel (mkRtsDataLabel lbl))) - (CmmReg t)) + (CmmReg (CmmLocal t))) 1) where eight = CmmLit (CmmInt 8 cLongRep)