Merge in new code generator branch.

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

diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index c85beb5..0cf209e 100644 (file)
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 -----------------------------------------------------------------------------
 --
 -- Code generation for profiling
@@ -31,9 +24,9 @@ module CgProf (
   ) 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"
@@ -44,8 +37,8 @@ import CgUtils
 import CgMonad
 import SMRep
 
-import Cmm
-import CmmUtils
+import OldCmm
+import OldCmmUtils
 import CLabel
 
 import Id
@@ -54,10 +47,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
 
@@ -73,7 +66,7 @@ curCCS = CmmLoad curCCSAddr bWord
 
 -- 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)
@@ -176,8 +169,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
 
 
 -- -----------------------------------------------------------------------
@@ -208,6 +201,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 -> Code
 enter_cost_centre closure_info ccs body
   | isSubsumedCCS ccs
   = ASSERT(isToplevClosure closure_info)
@@ -266,9 +260,11 @@ enterCostCentreThunk closure =
   ifProfiling $ do 
     stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
 
-enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmHinted stack AddrHint] False
+enter_ccs_fun :: CmmExpr -> Code
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
                        -- ToDo: vols
 
+enter_ccs_fsub :: Code
 enter_ccs_fsub = enteringPAP 0
 
 -- When entering a PAP, EnterFunCCS is called by both the PAP entry
@@ -278,7 +274,7 @@ enter_ccs_fsub = enteringPAP 0
 -- entering via a PAP.
 enteringPAP :: Integer -> Code
 enteringPAP n
-  = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (sLit "entering_PAP"))))
+  = stmtC (CmmStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
                (CmmLit (CmmInt n cIntWidth)))
 
 ifProfiling :: Code -> Code
@@ -338,7 +334,9 @@ emitCostCentreStackDecl ccs
   }
   | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs)
 
+zero :: CmmLit
 zero = mkIntCLit 0
+zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
 sizeof_ccs_words :: Int
@@ -391,11 +389,13 @@ emitRegisterCCS ccs = do
     ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
 
 
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CC_ID")))
+cC_LIST, cC_ID :: CmmExpr
+cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
+cC_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
 
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID")))
+cCS_LIST, cCS_ID :: CmmExpr
+cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
+cCS_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
 
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
@@ -414,7 +414,8 @@ emitSetCCC cc
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result AddrHint
-       (sLit "PushCostCentre") [CmmHinted ccs AddrHint, 
+       rtsPackageId 
+       (fsLit "PushCostCentre") [CmmHinted ccs AddrHint, 
                                 CmmHinted (CmmLit (mkCCostCentre cc)) AddrHint]
         False
 
@@ -480,7 +481,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 
@@ -488,10 +489,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