X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmProf.hs;h=08bf52952c092944514c9d5847d14974fd3223d4;hp=1a18b99ac871380ec47615622602ead5d9b2bbe0;hb=18691d440f90a3dff4ef538091c886af505e5cf5;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d

diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index 1a18b99..08bf529 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -1,6 +1,3 @@
-{-# OPTIONS -w #-}
--- Lots of missing type sigs etc
-
 -----------------------------------------------------------------------------
 --
 -- Code generation for profiling
@@ -28,23 +25,22 @@ module StgCmmProf (
   ) where
 
 #include "HsVersions.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
  -- For WORD_SIZE_IN_BITS only.
-#include "../includes/Constants.h"
+#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 MachReps
 
 import StgCmmClosure
-import StgCmmEnv
 import StgCmmUtils
 import StgCmmMonad
 import SMRep
 
-import MkZipCfgCmm
-import Cmm
-import TyCon	( PrimRep(..) )
+import MkGraph
+import CmmExpr
+import CmmDecl
 import CmmUtils
 import CLabel
 
@@ -54,10 +50,10 @@ import CostCentre
 import StgSyn
 import StaticFlags
 import FastString
+import Module
 import Constants	-- Lots of field offsets
 import Outputable
 
-import Data.Maybe
 import Data.Char
 import Control.Monad
 
@@ -79,7 +75,7 @@ curCCS = CmmLoad curCCSAddr ccsType
 
 -- Address of current CCS variable, for storing into
 curCCSAddr :: CmmExpr
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
 
 mkCCostCentre :: CostCentre -> CmmLit
 mkCCostCentre cc = CmmLabel (mkCCLabel cc)
@@ -229,8 +225,8 @@ isBox :: StgExpr -> Bool
 -- one introduced by boxHigherOrderArgs for profiling,
 -- so we charge it to "OVERHEAD".
 -- This looks like a GROSS HACK to me --SDM
-isBox (StgApp fun []) = True
-isBox other	      = False
+isBox (StgApp _ []) = True
+isBox _             = False
 
 
 -- -----------------------------------------------------------------------
@@ -261,6 +257,7 @@ enterCostCentre closure_info ccs body
     ASSERT2(not (noCCSAttached ccs), ppr (closureName closure_info) <+> ppr ccs)
     enter_cost_centre closure_info ccs body
 
+enter_cost_centre :: ClosureInfo -> CostCentreStack -> StgExpr -> FCode ()
 enter_cost_centre closure_info ccs body
   | isSubsumedCCS ccs
   = ASSERT(isToplevClosure closure_info)
@@ -319,9 +316,11 @@ enterCostCentreThunk closure =
   ifProfiling $ do 
     emit $ mkStore curCCSAddr (costCentreFrom closure)
 
-enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [(stack,AddrHint)] False
+enter_ccs_fun :: CmmExpr -> FCode ()
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [(stack,AddrHint)] False
 			-- ToDo: vols
 
+enter_ccs_fsub :: FCode ()
 enter_ccs_fsub = enteringPAP 0
 
 -- When entering a PAP, EnterFunCCS is called by both the PAP entry
@@ -331,7 +330,7 @@ enter_ccs_fsub = enteringPAP 0
 -- entering via a PAP.
 enteringPAP :: Integer -> FCode ()
 enteringPAP n
-  = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (sLit "entering_PAP"))))
+  = emit (mkStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
 		  (CmmLit (CmmInt n cIntWidth)))
 
 ifProfiling :: FCode () -> FCode ()
@@ -349,14 +348,12 @@ ifProfilingL xs
 --	Initialising Cost Centres & CCSs
 ---------------------------------------------------------------
 
-initCostCentres :: CollectedCCs -> FCode CmmAGraph
--- Emit the declarations, and return code to register them
+initCostCentres :: CollectedCCs -> FCode ()
+-- Emit the declarations
 initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
-  = getCode $ whenC opt_SccProfilingOn $
+  = whenC opt_SccProfilingOn $
     do	{ mapM_ emitCostCentreDecl local_CCs
-  	; mapM_ emitCostCentreStackDecl  singleton_CCSs 
-	; emit $ catAGraphs $ map mkRegisterCC local_CCs
-	; emit $ catAGraphs $ map mkRegisterCCS singleton_CCSs }
+        ; mapM_ emitCostCentreStackDecl  singleton_CCSs  }
 
 
 emitCostCentreDecl :: CostCentre -> FCode ()
@@ -396,7 +393,9 @@ emitCostCentreStackDecl ccs
 	-- pad out the struct with zero words until we hit the
 	-- size of the overall struct (which we get via DerivedConstants.h)
 
+zero :: CmmLit
 zero = mkIntCLit 0
+zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
 sizeof_ccs_words :: Int
@@ -408,52 +407,6 @@ sizeof_ccs_words
    (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
 
 -- ---------------------------------------------------------------------------
--- Registering CCs and CCSs
-
---   (cc)->link = CC_LIST;
---   CC_LIST = (cc);
---   (cc)->ccID = CC_ID++;
-
-mkRegisterCC :: CostCentre -> CmmAGraph
-mkRegisterCC cc
-  = withTemp cInt $ \tmp -> 
-    catAGraphs [
-     mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
-		 (CmmLoad cC_LIST bWord),
-     mkStore cC_LIST cc_lit,
-     mkAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
-     mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
-     mkStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  where
-	cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-
---  (ccs)->prevStack = CCS_LIST;
---  CCS_LIST = (ccs);
---  (ccs)->ccsID = CCS_ID++;
-
-mkRegisterCCS :: CostCentreStack -> CmmAGraph
-mkRegisterCCS ccs
-  = withTemp cInt $ \ tmp ->
-    catAGraphs [
-     mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack) 
-			(CmmLoad cCS_LIST bWord),
-     mkStore cCS_LIST ccs_lit,
-     mkAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
-     mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
-     mkStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  where
-    ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
-
-
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_ID")))
-
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID")))
-
--- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
 
 emitSetCCC :: CostCentre -> FCode ()
@@ -470,7 +423,8 @@ emitSetCCC cc
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result AddrHint
-	(sLit "PushCostCentre") [(ccs,AddrHint), 
+	rtsPackageId
+	(fsLit "PushCostCentre") [(ccs,AddrHint), 
 				(CmmLit (mkCCostCentre cc), AddrHint)]
         False
 
@@ -537,7 +491,7 @@ ldvEnter cl_ptr
 
 loadEra :: CmmExpr 
 loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
-	  [CmmLoad (mkLblExpr (mkRtsDataLabel (sLit "era"))) cInt]
+	  [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "era"))) cInt]
 
 ldvWord :: CmmExpr -> CmmExpr
 -- Takes the address of a closure, and returns 
@@ -545,10 +499,16 @@ ldvWord :: CmmExpr -> CmmExpr
 ldvWord closure_ptr = cmmOffsetB closure_ptr oFFSET_StgHeader_ldvw
 
 -- LDV constants, from ghc/includes/Constants.h
-lDV_SHIFT	 = (LDV_SHIFT :: Int)
---lDV_STATE_MASK   = (LDV_STATE_MASK :: StgWord)
-lDV_CREATE_MASK  = (LDV_CREATE_MASK :: StgWord)
---lDV_LAST_MASK    = (LDV_LAST_MASK :: StgWord)
-lDV_STATE_CREATE = (LDV_STATE_CREATE :: StgWord)
-lDV_STATE_USE    = (LDV_STATE_USE :: StgWord)
+lDV_SHIFT :: Int
+lDV_SHIFT = LDV_SHIFT
+--lDV_STATE_MASK :: StgWord
+--lDV_STATE_MASK   = LDV_STATE_MASK
+lDV_CREATE_MASK :: StgWord
+lDV_CREATE_MASK  = LDV_CREATE_MASK
+--lDV_LAST_MASK :: StgWord
+--lDV_LAST_MASK    = LDV_LAST_MASK
+lDV_STATE_CREATE :: StgWord
+lDV_STATE_CREATE = LDV_STATE_CREATE
+lDV_STATE_USE :: StgWord
+lDV_STATE_USE    = LDV_STATE_USE