-{-# 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,
- mkBareInfoTable
) where
#include "HsVersions.h"
-import Cmm
+import OldCmm
import CmmUtils
import CLabel
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))
+emptyContInfoTable :: CmmInfoTable
+emptyContInfoTable = CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
+ (ContInfo [] NoC_SRT)
where zero = CmmInt 0 wordWidth
cmmToRawCmm :: [Cmm] -> IO [RawCmm]
-- <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 uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
+mkInfoTable _ (CmmData sec dat) = [CmmData sec dat]
+mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
case info of
-- Code without an info table. Easy.
- CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
+ CmmNonInfoTable -> [CmmProc [] entry_label blocks]
CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
let info_label = entryLblToInfoLbl entry_label
-- A function entry point.
FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
- arguments blocks
+ blocks
where
fun_type = argDescrType pap_bitmap
fun_extra_bits =
-- A constructor.
ConstrInfo (ptrs, nptrs) con_tag descr ->
mkInfoTableAndCode info_label std_info [con_name] entry_label
- arguments blocks
+ blocks
where
std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
con_name = makeRelativeRefTo info_label descr
-- A thunk.
ThunkInfo (ptrs, nptrs) srt ->
mkInfoTableAndCode info_label std_info srt_label entry_label
- arguments blocks
+ blocks
where
std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
(srt_label, srt_bitmap) = mkSRTLit info_label srt
layout = packHalfWordsCLit ptrs nptrs
-- A selector thunk.
- ThunkSelectorInfo offset srt ->
+ ThunkSelectorInfo offset _srt ->
mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
- arguments blocks
+ blocks
where
std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
ContInfo stack_layout srt ->
liveness_data ++
mkInfoTableAndCode info_label std_info srt_label entry_label
- arguments blocks
+ blocks
where
std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
(makeRelativeRefTo info_label liveness_lit)
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
-> [CmmLit]
-> [CmmLit]
-> CLabel
- -> CmmFormals
-> ListGraph CmmStmt
-> [RawCmmTop]
-mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
+mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
| tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
= [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
- entry_lbl args blocks]
+ entry_lbl blocks]
| ListGraph [] <- blocks -- No code; only the info table is significant
= -- Use a zero place-holder in place of the
| otherwise -- Separately emit info table (with the function entry
= -- point as first entry) and the entry code
- [CmmProc [] entry_lbl args blocks,
+ [CmmProc [] entry_lbl blocks,
mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
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)
small_bitmap = case bitmap of
[] -> 0
- [b] -> fromIntegral b
+ [b] -> b
_ -> panic "mkLiveness"
small_liveness =
fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
projects / ghc-hetmet.git / blobdiff