X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmInfo.hs;h=c608372c6491f0c59fed067427676e0214fca362;hb=4e0c994eb1613c62e94069642d7acdb2e69b773b;hp=eb226da03e201f3a9558419c4a23cc5ac84b0445;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index eb226da..c608372 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -1,13 +1,8 @@
-{-# 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"
@@ -23,16 +18,23 @@ import CgInfoTbls
 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'
@@ -56,7 +58,7 @@ cmmToRawCmm cmm = do
 --	<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
 --
@@ -75,13 +77,13 @@ cmmToRawCmm cmm = do
 --  * 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
@@ -123,7 +125,7 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
                 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
@@ -144,6 +146,17 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
                                      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
@@ -172,7 +185,7 @@ mkSRTLit :: 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)