X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgProf.hs;h=1488e34956ddafd3096c2c3c71f58444fd84bd86;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=844f1d75d21eaf0e17809c94b62f2d6d14e10538;hpb=b8ced282cd2a56e47f628bc760980bb7b9f25d9a;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgProf.hs b/ghc/compiler/codeGen/CgProf.hs index 844f1d7..1488e34 100644 --- a/ghc/compiler/codeGen/CgProf.hs +++ b/ghc/compiler/codeGen/CgProf.hs @@ -24,6 +24,8 @@ module CgProf ( ) where #include "HsVersions.h" +#include "MachDeps.h" + -- For WORD_SIZE_IN_BITS only. #include "../includes/Constants.h" -- For LDV_CREATE_MASK, LDV_STATE_USE -- which are StgWords @@ -41,11 +43,11 @@ import MachOp import CmmUtils ( zeroCLit, mkIntCLit, mkLblExpr ) import CLabel ( mkCCLabel, mkCCSLabel, mkRtsDataLabel ) -import Module ( moduleUserString ) +import Module ( moduleString ) import Id ( Id ) import CostCentre import StgSyn ( GenStgExpr(..), StgExpr ) -import CmdLineOpts ( opt_SccProfilingOn ) +import StaticFlags ( opt_SccProfilingOn ) import FastString ( FastString, mkFastString, LitString ) import Constants -- Lots of field offsets import Outputable @@ -257,6 +259,7 @@ enterCostCentreThunk closure = stmtC $ CmmStore curCCSAddr (costCentreFrom closure) enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)] + -- ToDo: vols enter_ccs_fsub = enteringPAP 0 @@ -289,7 +292,7 @@ emitCostCentreDecl -> Code emitCostCentreDecl cc = do { label <- mkStringCLit (costCentreUserName cc) - ; modl <- mkStringCLit (moduleUserString (cc_mod cc)) + ; modl <- mkStringCLit (moduleString (cc_mod cc)) ; let lits = [ zero, -- StgInt ccID, label, -- char *label, @@ -312,18 +315,13 @@ emitCostCentreStackDecl emitCostCentreStackDecl ccs | Just cc <- maybeSingletonCCS ccs = do { let - lits = [ zero, - mkCCostCentre cc, - zero, -- struct _CostCentreStack *prevStack; - zero, -- struct _IndexTable *indexTable; - zero64, -- StgWord64 scc_count; - zero, -- StgWord selected; - zero, -- StgWord time_ticks; - zero64, -- StgWord64 mem_alloc; - zero64, -- StgWord64 inherited_alloc; - zero, -- StgWord inherited_ticks; - zero -- CostCentre *root; - ] + -- 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 : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) zero ; emitDataLits (mkCCSLabel ccs) lits } | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs) @@ -331,6 +329,13 @@ emitCostCentreStackDecl ccs zero = mkIntCLit 0 zero64 = CmmInt 0 I64 +sizeof_ccs_words :: Int +sizeof_ccs_words + -- round up to the next word. + | ms == 0 = ws + | otherwise = ws + 1 + where + (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE -- --------------------------------------------------------------------------- -- Registering CCs and CCSs