--------------------------------------------------------------------------------- Code generation for profiling---- (c) The University of Glasgow 2004-2006-------------------------------------------------------------------------------moduleCgProf(mkCCostCentre,mkCCostCentreStack,-- Cost-centre ProfilingdynProfHdr,profDynAlloc,profAlloc,staticProfHdr,initUpdFrameProf,enterCostCentre,enterCostCentrePAP,enterCostCentreThunk,chooseDynCostCentres,costCentreFrom,curCCS,curCCSAddr,emitCostCentreDecl,emitCostCentreStackDecl,emitRegisterCC,emitRegisterCCS,emitSetCCC,emitCCS,-- Lag/drag/void stuffldvEnter,ldvEnterClosure,ldvRecordCreate)where#include "HsVersions.h"#include "../includes/MachDeps.h"-- For WORD_SIZE_IN_BITS only.#include "../includes/rts/Constants.h"-- For LDV_CREATE_MASK, LDV_STATE_USE-- which are StgWords#include "../includes/DerivedConstants.h"-- For REP_xxx constants, which are MachRepsimportClosureInfoimportCgUtilsimportCgMonadimportSMRepimportCmmimportCmmUtilsimportCLabelimportIdimportqualifiedModuleimportCostCentreimportStgSynimportStaticFlagsimportFastStringimportConstants-- Lots of field offsetsimportOutputableimportData.CharimportControl.Monad--------------------------------------------------------------------------------- Cost-centre-stack Profiling--------------------------------------------------------------------------------- Expression representing the current cost centre stackcurCCS::CmmExprcurCCS=CmmLoadcurCCSAddrbWord-- Address of current CCS variable, for storing intocurCCSAddr::CmmExprcurCCSAddr=CmmLit(CmmLabel(mkRtsDataLabel(sLit"CCCS")))mkCCostCentre::CostCentre->CmmLitmkCCostCentrecc=CmmLabel(mkCCLabelcc)mkCCostCentreStack::CostCentreStack->CmmLitmkCCostCentreStackccs=CmmLabel(mkCCSLabelccs)costCentreFrom::CmmExpr-- A closure pointer->CmmExpr-- The cost centre from that closurecostCentreFromcl=CmmLoad(cmmOffsetBcloFFSET_StgHeader_ccs)bWordstaticProfHdr::CostCentreStack->[CmmLit]-- The profiling header words in a static closure-- Was SET_STATIC_PROF_HDRstaticProfHdrccs=ifProfilingL[mkCCostCentreStackccs,staticLdvInit]dynProfHdr::CmmExpr->[CmmExpr]-- Profiling header words in a dynamic closuredynProfHdrccs=ifProfilingL[ccs,dynLdvInit]initUpdFrameProf::CmmExpr->Code-- Initialise the profiling field of an update frameinitUpdFrameProfframe_amode=ifProfiling$-- frame->header.prof.ccs = CCCSstmtC(CmmStore(cmmOffsetBframe_amodeoFFSET_StgHeader_ccs)curCCS)-- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0) -- is unnecessary because it is not used anyhow.-- ------------------------------------------------------------------------------- Recording allocation in a cost centre-- | Record the allocation of a closure. The CmmExpr is the cost-- centre stack to which to attribute the allocation.profDynAlloc::ClosureInfo->CmmExpr->CodeprofDynAlloccl_infoccs=ifProfiling$profAlloc(CmmLit(mkIntCLit(closureSizecl_info)))ccs-- | Record the allocation of a closure (size is given by a CmmExpr)-- The size must be in words, because the allocation counter in a CCS counts-- in words.profAlloc::CmmExpr->CmmExpr->CodeprofAllocwordsccs=ifProfiling$stmtC(addToMemEalloc_rep(cmmOffsetBccsoFFSET_CostCentreStack_mem_alloc)(CmmMachOp(MO_UU_ConvwordWidthalloc_rep)$[CmmMachOpmo_wordSub[words,CmmLit(mkIntCLitprofHdrSize)]]))-- subtract the "profiling overhead", which is the-- profiling header in a closure.wherealloc_rep=typeWidthREP_CostCentreStack_mem_alloc-- ------------------------------------------------------------------------ Setting the cost centre in a new closurechooseDynCostCentres::CostCentreStack->[Id]-- Args->StgExpr-- Body->FCode(CmmExpr,CmmExpr)-- Called when alllcating a closure-- Tells which cost centre to put in the object, and which-- to blame the cost of allocation onchooseDynCostCentresccsargsbody=do-- Cost-centre we record in the objectuse_ccs<-emitCCSccs-- Cost-centre on whom we blame the allocationletblame_ccs|nullargs&&isBoxbody=CmmLit(mkCCostCentreStackoverheadCCS)|otherwise=use_ccsreturn(use_ccs,blame_ccs)-- Some CostCentreStacks are a sequence of pushes on top of CCCS.-- These pushes must be performed before we can refer to the stack in-- an expression.emitCCS::CostCentreStack->FCodeCmmExpremitCCSccs=push_em(ccsExprccs')(reversecc's)where(cc's,ccs')=decomposeCCSccspush_emccs[]=returnccspush_emccs(cc:rest)=dotmp<-newTempbWord-- TODO FIXME NOWpushCostCentretmpccsccpush_em(CmmReg(CmmLocaltmp))restccsExpr::CostCentreStack->CmmExprccsExprccs|isCurrentCCSccs=curCCS|otherwise=CmmLit(mkCCostCentreStackccs)isBox::StgExpr->Bool-- If it's an utterly trivial RHS, then it must be-- one introduced by boxHigherOrderArgs for profiling,-- so we charge it to "OVERHEAD".-- This looks like a GROSS HACK to me --SDMisBox(StgApp_[])=TrueisBox_=False-- ------------------------------------------------------------------------- Setting the current cost centre on entry to a closure-- For lexically scoped profiling we have to load the cost centre from-- the closure entered, if the costs are not supposed to be inherited.-- This is done immediately on entering the fast entry point.-- Load current cost centre from closure, if not inherited.-- Node is guaranteed to point to it, if profiling and not inherited.enterCostCentre::ClosureInfo->CostCentreStack->StgExpr-- The RHS of the closure->Code-- We used to have a special case for bindings of form-- f = g True-- where g has arity 2. The RHS is a thunk, but we don't-- need to update it; and we want to subsume costs.-- We don't have these sort of PAPs any more, so the special-- case has gone away.enterCostCentreclosure_infoccsbody=ifProfiling$ASSERT2(not(noCCSAttachedccs),ppr(closureNameclosure_info)<+>pprccs)enter_cost_centreclosure_infoccsbodyenter_cost_centre::ClosureInfo->CostCentreStack->StgExpr->Codeenter_cost_centreclosure_infoccsbody|isSubsumedCCSccs=ASSERT(isToplevClosureclosure_info)ASSERT(re_entrant)enter_ccs_fsub|isDerivedFromCurrentCCSccs=do{ifre_entrant&&notis_boxthenenter_ccs_funnode_ccselsestmtC(CmmStorecurCCSAddrnode_ccs)-- don't forget to bump the scc count. This closure might have been-- of the form let x = _scc_ "x" e in ...x..., which the SCCfinal-- pass has turned into simply let x = e in ...x... and attached-- the _scc_ as PushCostCentre(x,CCCS) on the x closure. So that-- we don't lose the scc counter, bump it in the entry code for x.-- ToDo: for a multi-push we should really bump the counter for-- each of the intervening CCSs, not just the top one.;when(not(isCurrentCCSccs))$stmtC(bumpSccCountcurCCS)}|isCafCCSccs=ASSERT(isToplevClosureclosure_info)ASSERT(notre_entrant)do{-- This is just a special case of the isDerivedFromCurrentCCS-- case above. We could delete this, but it's a micro-- optimisation and saves a bit of code.stmtC(CmmStorecurCCSAddrenc_ccs);stmtC(bumpSccCountnode_ccs)}|otherwise=panic"enterCostCentre"whereenc_ccs=CmmLit(mkCCostCentreStackccs)re_entrant=closureReEntrantclosure_infonode_ccs=costCentreFrom(cmmOffsetB(CmmRegnodeReg)(-node_tag))is_box=isBoxbody-- if this is a function, then node will be tagged; we must subract the tagnode_tag=funTagclosure_info-- set the current CCS when entering a PAPenterCostCentrePAP::CmmExpr->CodeenterCostCentrePAPclosure=ifProfiling$doenter_ccs_fun(costCentreFromclosure)enteringPAP1enterCostCentreThunk::CmmExpr->CodeenterCostCentreThunkclosure=ifProfiling$dostmtC$CmmStorecurCCSAddr(costCentreFromclosure)enter_ccs_fun::CmmExpr->Codeenter_ccs_funstack=emitRtsCall(sLit"EnterFunCCS")[CmmHintedstackAddrHint]False-- ToDo: volsenter_ccs_fsub::Codeenter_ccs_fsub=enteringPAP0-- When entering a PAP, EnterFunCCS is called by both the PAP entry-- code and the function entry code; we don't want the function's-- entry code to also update CCCS in the event that it was called via-- a PAP, so we set the flag entering_PAP to indicate that we are-- entering via a PAP.enteringPAP::Integer->CodeenteringPAPn=stmtC(CmmStore(CmmLit(CmmLabel(mkRtsDataLabel(sLit"entering_PAP"))))(CmmLit(CmmIntncIntWidth)))ifProfiling::Code->CodeifProfilingcode|opt_SccProfilingOn=code|otherwise=nopCifProfilingL::[a]->[a]ifProfilingLxs|opt_SccProfilingOn=xs|otherwise=[]-- ----------------------------------------------------------------------------- Initialising Cost Centres & CCSsemitCostCentreDecl::CostCentre->CodeemitCostCentreDeclcc=do{label<-mkStringCLit(costCentreUserNamecc);modl<-mkStringCLit(Module.moduleNameString(Module.moduleName(cc_modcc)))-- All cost centres will be in the main package, since we-- don't normally use -auto-all or add SCCs to other packages.-- Hence don't emit the package name in the module here.;letlits=[zero,-- StgInt ccID,label,-- char *label,modl,-- char *module,zero,-- StgWord time_tickszero64,-- StgWord64 mem_allocsubsumed,-- StgInt is_cafzero-- struct _CostCentre *link];emitDataLits(mkCCLabelcc)lits}wheresubsumed|isCafCCcc=mkIntCLit(ord'c')-- 'c' == is a CAF|otherwise=mkIntCLit(ord'B')-- 'B' == is boringemitCostCentreStackDecl::CostCentreStack->CodeemitCostCentreStackDeclccs|Justcc<-maybeSingletonCCSccs=do{let-- Note: to avoid making any assumptions about how the-- C compiler (that compiles the RTS, in particular) does-- layouts of structs containing long-longs, simply-- pad out the struct with zero words until we hit the-- size of the overall struct (which we get via DerivedConstants.h)--lits=zero:mkCCostCentrecc:replicate(sizeof_ccs_words-2)zero;emitDataLits(mkCCSLabelccs)lits}|otherwise=pprPanic"emitCostCentreStackDecl"(pprccs)zero::CmmLitzero=mkIntCLit0zero64::CmmLitzero64=CmmInt0W64sizeof_ccs_words::Intsizeof_ccs_words-- round up to the next word.|ms==0=ws|otherwise=ws+1where(ws,ms)=SIZEOF_CostCentreStack`divMod`wORD_SIZE-- ----------------------------------------------------------------------------- Registering CCs and CCSs-- (cc)->link = CC_LIST;-- CC_LIST = (cc);-- (cc)->ccID = CC_ID++;emitRegisterCC::CostCentre->CodeemitRegisterCCcc=do{tmp<-newTempcInt;stmtsC[CmmStore(cmmOffsetBcc_litoFFSET_CostCentre_link)(CmmLoadcC_LISTbWord),CmmStorecC_LISTcc_lit,CmmAssign(CmmLocaltmp)(CmmLoadcC_IDcInt),CmmStore(cmmOffsetBcc_litoFFSET_CostCentre_ccID)(CmmReg(CmmLocaltmp)),CmmStorecC_ID(cmmRegOffB(CmmLocaltmp)1)]}wherecc_lit=CmmLit(CmmLabel(mkCCLabelcc))-- (ccs)->prevStack = CCS_LIST;-- CCS_LIST = (ccs);-- (ccs)->ccsID = CCS_ID++;emitRegisterCCS::CostCentreStack->CodeemitRegisterCCSccs=do{tmp<-newTempcInt;stmtsC[CmmStore(cmmOffsetBccs_litoFFSET_CostCentreStack_prevStack)(CmmLoadcCS_LISTbWord),CmmStorecCS_LISTccs_lit,CmmAssign(CmmLocaltmp)(CmmLoadcCS_IDcInt),CmmStore(cmmOffsetBccs_litoFFSET_CostCentreStack_ccsID)(CmmReg(CmmLocaltmp)),CmmStorecCS_ID(cmmRegOffB(CmmLocaltmp)1)]}whereccs_lit=CmmLit(CmmLabel(mkCCSLabelccs))cC_LIST,cC_ID::CmmExprcC_LIST=CmmLit(CmmLabel(mkRtsDataLabel(sLit"CC_LIST")))cC_ID=CmmLit(CmmLabel(mkRtsDataLabel(sLit"CC_ID")))cCS_LIST,cCS_ID::CmmExprcCS_LIST=CmmLit(CmmLabel(mkRtsDataLabel(sLit"CCS_LIST")))cCS_ID=CmmLit(CmmLabel(mkRtsDataLabel(sLit"CCS_ID")))-- ----------------------------------------------------------------------------- Set the current cost centre stackemitSetCCC::CostCentre->CodeemitSetCCCcc|notopt_SccProfilingOn=nopC|otherwise=dotmp<-newTempbWord-- TODO FIXME NOWASSERT(sccAbleCostCentrecc)pushCostCentretmpcurCCSccstmtC(CmmStorecurCCSAddr(CmmReg(CmmLocaltmp)))when(isSccCountCostCentrecc)$stmtC(bumpSccCountcurCCS)pushCostCentre::LocalReg->CmmExpr->CostCentre->CodepushCostCentreresultccscc=emitRtsCallWithResultresultAddrHint(sLit"PushCostCentre")[CmmHintedccsAddrHint,CmmHinted(CmmLit(mkCCostCentrecc))AddrHint]FalsebumpSccCount::CmmExpr->CmmStmtbumpSccCountccs=addToMem(typeWidthREP_CostCentreStack_scc_count)(cmmOffsetBccsoFFSET_CostCentreStack_scc_count)1--------------------------------------------------------------------------------- Lag/drag/void stuff----------------------------------------------------------------------------------- Initial value for the LDV field in a static closure--staticLdvInit::CmmLitstaticLdvInit=zeroCLit---- Initial value of the LDV field in a dynamic closure--dynLdvInit::CmmExprdynLdvInit=-- (era << LDV_SHIFT) | LDV_STATE_CREATE CmmMachOpmo_wordOr[CmmMachOpmo_wordShl[loadEra,CmmLit(mkIntCLitlDV_SHIFT)],CmmLit(mkWordCLitlDV_STATE_CREATE)]---- Initialise the LDV word of a new closure--ldvRecordCreate::CmmExpr->CodeldvRecordCreateclosure=stmtC$CmmStore(ldvWordclosure)dynLdvInit---- Called when a closure is entered, marks the closure as having been "used".-- The closure is not an 'inherently used' one.-- The closure is not IND or IND_OLDGEN because neither is considered for LDV-- profiling.--ldvEnterClosure::ClosureInfo->CodeldvEnterClosureclosure_info=ldvEnter(cmmOffsetB(CmmRegnodeReg)(-tag))wheretag=funTagclosure_info-- don't forget to substract node's tagldvEnter::CmmExpr->Code-- Argument is a closure pointerldvEntercl_ptr=ifProfiling$-- if (era > 0) {-- LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |-- era | LDV_STATE_USE }emitIf(CmmMachOpmo_wordUGt[loadEra,CmmLitzeroCLit])(stmtC(CmmStoreldv_wdnew_ldv_wd))where-- don't forget to substract node's tagldv_wd=ldvWordcl_ptrnew_ldv_wd=cmmOrWord(cmmAndWord(CmmLoadldv_wdbWord)(CmmLit(mkWordCLitlDV_CREATE_MASK)))(cmmOrWordloadEra(CmmLit(mkWordCLitlDV_STATE_USE)))loadEra::CmmExprloadEra=CmmMachOp(MO_UU_ConvcIntWidthwordWidth)[CmmLoad(mkLblExpr(mkRtsDataLabel$sLit("era")))cInt]ldvWord::CmmExpr->CmmExpr-- Takes the address of a closure, and returns -- the address of the LDV word in the closureldvWordclosure_ptr=cmmOffsetBclosure_ptroFFSET_StgHeader_ldvw-- LDV constants, from ghc/includes/Constants.hlDV_SHIFT::IntlDV_SHIFT=LDV_SHIFT--lDV_STATE_MASK :: StgWord--lDV_STATE_MASK = LDV_STATE_MASKlDV_CREATE_MASK::StgWordlDV_CREATE_MASK=LDV_CREATE_MASK--lDV_LAST_MASK :: StgWord--lDV_LAST_MASK = LDV_LAST_MASKlDV_STATE_CREATE::StgWordlDV_STATE_CREATE=LDV_STATE_CREATElDV_STATE_USE::StgWordlDV_STATE_USE=LDV_STATE_USE