Implemented and fixed bugs in CmmInfo handling

[ghc-hetmet.git] / compiler / codeGen / CgProf.hs

diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 9bbf05b..27ee54c 100644 (file)
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -2,7 +2,7 @@
 --
 -- Code generation for profiling
 --
--- (c) The University of Glasgow 2004
+-- (c) The University of Glasgow 2004-2006
 --
 -----------------------------------------------------------------------------
 
@@ -32,29 +32,28 @@ module CgProf (
 #include "../includes/DerivedConstants.h"
        -- For REP_xxx constants, which are MachReps
 
-import ClosureInfo     ( ClosureInfo, closureSize,
-                         closureName, isToplevClosure, closureReEntrant, )
+import ClosureInfo
 import CgUtils
 import CgMonad
-import SMRep           ( StgWord, profHdrSize )
+import SMRep
 
 import Cmm
 import MachOp
-import CmmUtils                ( zeroCLit, mkIntCLit, mkLblExpr )
-import CLabel          ( mkCCLabel, mkCCSLabel, mkRtsDataLabel )
+import CmmUtils
+import CLabel
 
-import Module          ( pprModule )
-import Id              ( Id )
+import Id
+import qualified Module
 import CostCentre
-import StgSyn          ( GenStgExpr(..), StgExpr )
-import StaticFlags     ( opt_SccProfilingOn )
-import FastString      ( FastString )
+import StgSyn
+import StaticFlags
+import FastString
 import Constants       -- Lots of field offsets
 import Outputable
 
-import Maybe
-import Char            ( ord )
-import Monad           ( when )
+import Data.Maybe
+import Data.Char
+import Control.Monad
 
 -----------------------------------------------------------------------------
 --
@@ -156,9 +155,9 @@ emitCCS ccs = push_em (ccsExpr ccs') (reverse cc's)
 
        push_em ccs [] = return ccs
        push_em ccs (cc:rest) = do
-         tmp <- newTemp wordRep
+         tmp <- newNonPtrTemp wordRep -- TODO FIXME NOW
          pushCostCentre tmp ccs cc
-         push_em (CmmReg tmp) rest
+         push_em (CmmReg (CmmLocal tmp)) rest
 
 ccsExpr :: CostCentreStack -> CmmExpr
 ccsExpr ccs
@@ -258,7 +257,7 @@ enterCostCentreThunk closure =
   ifProfiling $ do 
     stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
 
-enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)]
+enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)] False
                        -- ToDo: vols
 
 enter_ccs_fsub = enteringPAP 0
@@ -292,7 +291,11 @@ emitCostCentreDecl
    -> Code
 emitCostCentreDecl cc = do 
   { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (showSDoc (pprModule (cc_mod cc)))
+  ; modl  <- mkStringCLit (Module.moduleNameString 
+                                (Module.moduleName (cc_mod cc)))
+                -- 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.
   ; let
      lits = [ zero,    -- StgInt ccID,
              label,    -- char *label,
@@ -346,14 +349,14 @@ sizeof_ccs_words
 
 emitRegisterCC :: CostCentre -> Code
 emitRegisterCC cc = do
-  { tmp <- newTemp cIntRep
+  { tmp <- newNonPtrTemp cIntRep
   ; stmtsC [
      CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
                 (CmmLoad cC_LIST wordRep),
      CmmStore cC_LIST cc_lit,
-     CmmAssign tmp (CmmLoad cC_ID cIntRep),
-     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg tmp),
-     CmmStore cC_ID (cmmRegOffB tmp 1)
+     CmmAssign (CmmLocal tmp) (CmmLoad cC_ID cIntRep),
+     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
+     CmmStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
    ]
   }
   where
@@ -365,14 +368,14 @@ emitRegisterCC cc = do
 
 emitRegisterCCS :: CostCentreStack -> Code
 emitRegisterCCS ccs = do
-  { tmp <- newTemp cIntRep
+  { tmp <- newNonPtrTemp cIntRep
   ; stmtsC [
      CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack) 
                        (CmmLoad cCS_LIST wordRep),
      CmmStore cCS_LIST ccs_lit,
-     CmmAssign tmp (CmmLoad cCS_ID cIntRep),
-     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg tmp),
-     CmmStore cCS_ID (cmmRegOffB tmp 1)
+     CmmAssign (CmmLocal tmp) (CmmLoad cCS_ID cIntRep),
+     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
+     CmmStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
    ]
   }
   where
@@ -392,18 +395,19 @@ emitSetCCC :: CostCentre -> Code
 emitSetCCC cc
   | not opt_SccProfilingOn = nopC
   | otherwise = do 
-    tmp <- newTemp wordRep
+    tmp <- newNonPtrTemp wordRep -- TODO FIXME NOW
     ASSERT( sccAbleCostCentre cc )
       pushCostCentre tmp curCCS cc
-    stmtC (CmmStore curCCSAddr (CmmReg tmp))
+    stmtC (CmmStore curCCSAddr (CmmReg (CmmLocal tmp)))
     when (isSccCountCostCentre cc) $ 
        stmtC (bumpSccCount curCCS)
 
-pushCostCentre :: CmmReg -> CmmExpr -> CostCentre -> Code
+pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result PtrHint
        SLIT("PushCostCentre") [(ccs,PtrHint), 
                                (CmmLit (mkCCostCentre cc), PtrHint)]
+        False
 
 bumpSccCount :: CmmExpr -> CmmStmt
 bumpSccCount ccs