Add CCS for llvm

compiler/llvmGen/LlvmCodeGen.hs

@@ -49,8 +49,10 @@ llvmCodeGen dflags h us cmms
         bufh <- newBufHandle h
         Prt.bufLeftRender bufh $ pprLlvmHeader
         ver  <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
-        env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
-        cmmProcLlvmGens dflags bufh us env' cmm 1 []
+        env' <- {-# SCC "llvm_datas_gen" #-}
+                cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
+        _ <- {-# SCC "llvm_procs_gen" #-}
+             cmmProcLlvmGens dflags bufh us env' cmm 1 []
         bFlush bufh
         return  ()
 
@@ -62,15 +64,18 @@ cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
                 -> [LlvmUnresData] -> IO ( LlvmEnv )
 
 cmmDataLlvmGens dflags h env [] lmdata
-  = let (env', lmdata') = resolveLlvmDatas env lmdata []
-        lmdoc = Prt.vcat $ map pprLlvmData lmdata'
+  = let (env', lmdata') = {-# SCC "llvm_resolve" #-}
+                          resolveLlvmDatas env lmdata []
+        lmdoc = {-# SCC "llvm_data_ppr" #-}
+                Prt.vcat $ map pprLlvmData lmdata'
     in do
         dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
         Prt.bufLeftRender h lmdoc
         return env'
 
 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
-  = let lmdata'@(l, _, ty, _) = genLlvmData env cmm
+  = let lmdata'@(l, _, ty, _) = {-# SCC "llvm_data_gen" #-}
+                                genLlvmData env cmm
         env' = funInsert (strCLabel_llvm env l) ty env
     in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
 
@@ -93,7 +98,8 @@ cmmProcLlvmGens _ h _ _ [] _ ivars
         usedArray = LMStaticArray (map cast ivars') ty
         lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
                   (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
-    in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
+    in Prt.bufLeftRender h $ {-# SCC "llvm_data_ppr" #-}
+                             pprLlvmData ([lmUsed], [])
 
 cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
  = cmmProcLlvmGens dflags h us env cmms count ivars
@@ -104,7 +110,7 @@ cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivar
 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
     (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
     let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
-    Prt.bufLeftRender h $ Prt.vcat docs
+    Prt.bufLeftRender h $ {-# SCC "llvm_proc_ppr" #-} Prt.vcat docs
     cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
 
 
@@ -113,13 +119,15 @@ cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
             -> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
 cmmLlvmGen dflags us env cmm = do
     -- rewrite assignments to global regs
-    let fixed_cmm = fixStgRegisters cmm
+    let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
+                    fixStgRegisters cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
         (pprCmmGroup (targetPlatform dflags) [fixed_cmm])
 
     -- generate llvm code from cmm
-    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
+    let ((env', llvmBC), usGen) = {-# SCC "llvm_proc_gen" #-}
+                                  initUs us $ genLlvmProc env fixed_cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
         (vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC)

compiler/llvmGen/LlvmCodeGen/Base.hs

@@ -158,17 +158,26 @@ initLlvmEnv platform = LlvmEnv (emptyUFM, emptyUFM, defaultLlvmVersion, platform
 
 -- | Clear variables from the environment.
 clearVars :: LlvmEnv -> LlvmEnv
-clearVars (LlvmEnv (e1, _, n, p)) = LlvmEnv (e1, emptyUFM, n, p)
+clearVars (LlvmEnv (e1, _, n, p)) = {-# SCC "llvm_env_clear" #-}
+    LlvmEnv (e1, emptyUFM, n, p)
 
 -- | Insert functions into the environment.
-varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
-varInsert s t (LlvmEnv (e1, e2, n, p)) = LlvmEnv (e1, addToUFM e2 s t, n, p)
-funInsert s t (LlvmEnv (e1, e2, n, p)) = LlvmEnv (addToUFM e1 s t, e2, n, p)
+varInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
+varInsert s t (LlvmEnv (e1, e2, n, p)) = {-# SCC "llvm_env_vinsert" #-}
+    LlvmEnv (e1, addToUFM e2 s t, n, p)
+
+funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
+funInsert s t (LlvmEnv (e1, e2, n, p)) = {-# SCC "llvm_env_finsert" #-}
+    LlvmEnv (addToUFM e1 s t, e2, n, p)
 
 -- | Lookup functions in the environment.
-varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
-varLookup s (LlvmEnv (_, e2, _, _)) = lookupUFM e2 s
-funLookup s (LlvmEnv (e1, _, _, _)) = lookupUFM e1 s
+varLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
+varLookup s (LlvmEnv (_, e2, _, _)) = {-# SCC "llvm_env_vlookup" #-}
+    lookupUFM e2 s
+
+funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
+funLookup s (LlvmEnv (e1, _, _, _)) = {-# SCC "llvm_env_flookup" #-}
+    lookupUFM e1 s
 
 -- | Get the LLVM version we are generating code for
 getLlvmVer :: LlvmEnv -> LlvmVersion
@@ -188,8 +197,8 @@ getLlvmPlatform (LlvmEnv (_, _, _, p)) = p
 
 -- | Pretty print a 'CLabel'.
 strCLabel_llvm :: LlvmEnv -> CLabel -> LMString
-strCLabel_llvm env l
-    = (fsLit . show . llvmSDoc . pprCLabel (getLlvmPlatform env)) l
+strCLabel_llvm env l = {-# SCC "llvm_strCLabel" #-}
+    (fsLit . show . llvmSDoc . pprCLabel (getLlvmPlatform env)) l
 
 -- | Create an external definition for a 'CLabel' defined in another module.
 genCmmLabelRef :: LlvmEnv -> CLabel -> LMGlobal

compiler/llvmGen/LlvmMangler.hs

@@ -41,7 +41,7 @@ type Section = (B.ByteString, B.ByteString)
 
 -- | Read in assembly file and process
 llvmFixupAsm :: DynFlags -> FilePath -> FilePath -> IO ()
-llvmFixupAsm dflags f1 f2 = do
+llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do
     showPass dflags "LlVM Mangler"
     r <- openBinaryFile f1 ReadMode
     w <- openBinaryFile f2 WriteMode