X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgProf.hs;h=1488e34956ddafd3096c2c3c71f58444fd84bd86;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d54718f495b3f12fab512776f558b06ef2583bfc;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgProf.hs b/ghc/compiler/codeGen/CgProf.hs index d54718f..1488e34 100644 --- a/ghc/compiler/codeGen/CgProf.hs +++ b/ghc/compiler/codeGen/CgProf.hs @@ -24,8 +24,8 @@ module CgProf ( ) where #include "HsVersions.h" -#include "../includes/ghcconfig.h" - -- Needed by Constants.h +#include "MachDeps.h" + -- For WORD_SIZE_IN_BITS only. #include "../includes/Constants.h" -- For LDV_CREATE_MASK, LDV_STATE_USE -- which are StgWords @@ -43,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 @@ -259,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 @@ -291,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, @@ -314,18 +315,13 @@ emitCostCentreStackDecl emitCostCentreStackDecl ccs | Just cc <- maybeSingletonCCS ccs = do { let - lits = [ zero, - mkCCostCentre cc, - zero, -- struct _CostCentreStack *prevStack; - zero, -- struct _IndexTable *indexTable; - zero, -- StgWord selected; - zero64, -- StgWord64 scc_count; - zero, -- StgWord time_ticks; - zero64, -- StgWord64 mem_alloc; - zero, -- StgWord inherited_ticks; - zero64, -- StgWord64 inherited_alloc; - 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) @@ -333,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