X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgProf.hs;h=1488e34956ddafd3096c2c3c71f58444fd84bd86;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=30f801dba34713097a7a1e5a05a030af7bde2532;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgProf.hs b/ghc/compiler/codeGen/CgProf.hs
index 30f801d..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		( moduleNameUserString )
+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 (moduleNameUserString (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
@@ -389,9 +392,9 @@ emitSetCCC :: CostCentre -> Code
 emitSetCCC cc
   | not opt_SccProfilingOn = nopC
   | otherwise = do 
-    ASSERTM(sccAbleCostCentre cc)
     tmp <- newTemp wordRep
-    pushCostCentre tmp curCCS cc
+    ASSERT( sccAbleCostCentre cc )
+      pushCostCentre tmp curCCS cc
     stmtC (CmmStore curCCSAddr (CmmReg tmp))
     when (isSccCountCostCentre cc) $ 
 	stmtC (bumpSccCount curCCS)
@@ -457,7 +460,8 @@ ldvEnter cl_ptr
 		 (cmmOrWord loadEra (CmmLit (mkWordCLit lDV_STATE_USE)))
 
 loadEra :: CmmExpr 
-loadEra = CmmLoad (mkLblExpr (mkRtsDataLabel SLIT("era"))) cIntRep
+loadEra = CmmMachOp (MO_U_Conv cIntRep wordRep)
+	  [CmmLoad (mkLblExpr (mkRtsDataLabel SLIT("era"))) cIntRep]
 
 ldvWord :: CmmExpr -> CmmExpr
 -- Takes the address of a closure, and returns