X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgProf.hs;h=c2a8a1bd752a3d3a65e0284e67f0ead73ee59252;hb=579bc757533c8c9e5beabe5b21daddd922c1af75;hp=39d4505feea9075c14bb576a4bd3d44fa672d860;hpb=ad94d40948668032189ad22a0ad741ac1f645f50;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 39d4505..c2a8a1b 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -1,3 +1,10 @@ +{-# 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 @@ -6,13 +13,6 @@ -- ----------------------------------------------------------------------------- -{-# 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/CodingStyle#Warnings --- for details - module CgProf ( mkCCostCentre, mkCCostCentreStack, @@ -74,7 +74,7 @@ curCCS = CmmLoad curCCSAddr wordRep -- Address of current CCS variable, for storing into curCCSAddr :: CmmExpr -curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CCCS"))) +curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCCS"))) mkCCostCentre :: CostCentre -> CmmLit mkCCostCentre cc = CmmLabel (mkCCLabel cc) @@ -267,7 +267,7 @@ enterCostCentreThunk closure = ifProfiling $ do stmtC $ CmmStore curCCSAddr (costCentreFrom closure) -enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)] False +enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmKinded stack PtrHint] False -- ToDo: vols enter_ccs_fsub = enteringPAP 0 @@ -279,7 +279,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 (mkRtsDataLabel (sLit "entering_PAP")))) (CmmLit (CmmInt n cIntRep))) ifProfiling :: Code -> Code @@ -392,11 +392,11 @@ 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 = 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"))) +cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_LIST"))) +cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (sLit "CCS_ID"))) -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -415,8 +415,8 @@ emitSetCCC cc pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code pushCostCentre result ccs cc = emitRtsCallWithResult result PtrHint - SLIT("PushCostCentre") [(ccs,PtrHint), - (CmmLit (mkCCostCentre cc), PtrHint)] + (sLit "PushCostCentre") [CmmKinded ccs PtrHint, + CmmKinded (CmmLit (mkCCostCentre cc)) PtrHint] False bumpSccCount :: CmmExpr -> CmmStmt @@ -481,7 +481,7 @@ ldvEnter cl_ptr loadEra :: CmmExpr loadEra = CmmMachOp (MO_U_Conv cIntRep wordRep) - [CmmLoad (mkLblExpr (mkRtsDataLabel SLIT("era"))) cIntRep] + [CmmLoad (mkLblExpr (mkRtsDataLabel (sLit "era"))) cIntRep] ldvWord :: CmmExpr -> CmmExpr -- Takes the address of a closure, and returns