-{-# 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
-
module CmmInfo (
+ emptyContInfoTable,
cmmToRawCmm,
- mkInfoTable
+ mkInfoTable,
+ mkBareInfoTable
) where
#include "HsVersions.h"
import CgCallConv
import CgUtils
import SMRep
+import ZipCfgCmmRep
import Constants
-import Outputable
+import Panic
import StaticFlags
import Unique
import UniqSupply
-import Panic
import Data.Bits
+-- When we split at proc points, we need an empty info table.
+emptyContInfoTable :: CmmInfo
+emptyContInfoTable =
+ CmmInfo Nothing Nothing (CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
+ (ContInfo [] NoC_SRT))
+ where zero = CmmInt 0 wordWidth
+
cmmToRawCmm :: [Cmm] -> IO [RawCmm]
cmmToRawCmm cmm = do
info_tbl_uniques <- mkSplitUniqSupply 'i'
-- <normal forward rest of StgInfoTable>
-- <forward variable part>
--
--- See includes/InfoTables.h
+-- See includes/rts/storage/InfoTables.h
--
-- For return-points these are as follows
--
-- * The SRT slot is only there if there is SRT info to record
mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
-mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
+mkInfoTable _ (CmmData sec dat) = [CmmData sec dat]
mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
case info of
-- Code without an info table. Easy.
CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
- CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
+ CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
let info_label = entryLblToInfoLbl entry_label
ty_prof' = makeRelativeRefTo info_label ty_prof
cl_prof' = makeRelativeRefTo info_label cl_prof
layout = packHalfWordsCLit ptrs nptrs
-- A selector thunk.
- ThunkSelectorInfo offset srt ->
+ ThunkSelectorInfo offset _srt ->
mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
arguments blocks
where
else type_tag
(srt_label, srt_bitmap) = mkSRTLit info_label srt
+-- Generate a bare info table, not attached to any procedure.
+mkBareInfoTable :: CLabel -> Unique -> CmmInfoTable -> [CmmTopZ]
+mkBareInfoTable lbl uniq info =
+ case mkInfoTable uniq (CmmProc (CmmInfo Nothing Nothing info) lbl [] (ListGraph [])) of
+ [CmmProc d _ _ _] ->
+ ASSERT (tablesNextToCode)
+ [CmmData Data (d ++ [CmmDataLabel (entryLblToInfoLbl lbl)])]
+ [CmmData d s] -> [CmmData d s]
+ _ -> panic "mkBareInfoTable expected to produce only data"
+
+
-- Handle the differences between tables-next-to-code
-- and not tables-next-to-code
mkInfoTableAndCode :: CLabel
-> C_SRT
-> ([CmmLit], -- srt_label
StgHalfWord) -- srt_bitmap
-mkSRTLit info_label NoC_SRT = ([], 0)
+mkSRTLit _ NoC_SRT = ([], 0)
mkSRTLit info_label (C_SRT lbl off bitmap) =
([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)