Commit cc2918a0 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Refactor CmmStatics

In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils
and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype
(before SRT generation) and `RawCmmStatics` datatype (after SRT
generation).

This patch removes this redundant code by using a single GADT for
(Raw)CmmStatics.
parent a485c3c4
Pipeline #17546 passed with stages
in 472 minutes and 5 seconds
-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
module GHC.Cmm (
-- * Cmm top-level datatypes
......@@ -7,7 +10,8 @@ module GHC.Cmm (
CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
CmmGraph, GenCmmGraph(..),
CmmBlock, RawCmmDecl,
Section(..), SectionType(..), CmmStatics(..), RawCmmStatics(..), CmmStatic(..),
Section(..), SectionType(..),
GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
isSecConstant,
-- ** Blocks containing lists
......@@ -206,21 +210,22 @@ data CmmStatic
-- ^ an embedded binary file
-- Static data before SRT generation
data CmmStatics
= CmmStatics
CLabel -- Label of statics
CmmInfoTable
CostCentreStack
[CmmLit] -- Payload
| CmmStaticsRaw
CLabel -- Label of statics
[CmmStatic] -- The static data itself
-- Static data, after SRTs are generated
data RawCmmStatics
= RawCmmStatics
CLabel -- Label of statics
[CmmStatic] -- The static data itself
data GenCmmStatics (rawOnly :: Bool) where
CmmStatics
:: CLabel -- Label of statics
-> CmmInfoTable
-> CostCentreStack
-> [CmmLit] -- Payload
-> GenCmmStatics 'False
-- | Static data, after SRTs are generated
CmmStaticsRaw
:: CLabel -- Label of statics
-> [CmmStatic] -- The static data itself
-> GenCmmStatics a
type CmmStatics = GenCmmStatics 'False
type RawCmmStatics = GenCmmStatics 'True
-- -----------------------------------------------------------------------------
-- Basic blocks consisting of lists
......
......@@ -162,7 +162,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
= DebugBlock { dblProcedure = g_entry graph
, dblLabel = label
, dblCLabel = case info of
Just (RawCmmStatics infoLbl _) -> infoLbl
Just (CmmStaticsRaw infoLbl _) -> infoLbl
Nothing
| g_entry graph == label -> entryLbl
| otherwise -> blockLbl label
......
......@@ -167,7 +167,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
--
return (top_decls, (lbl, RawCmmStatics info_lbl $ map CmmStaticLit $
return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info))
-----------------------------------------------------
......
......@@ -1107,10 +1107,10 @@ updInfoSRTs
-> [CmmDeclSRTs]
updInfoSRTs _ _ _ _ (CmmData s (CmmStaticsRaw lbl statics))
= [CmmData s (RawCmmStatics lbl statics)]
= [CmmData s (CmmStaticsRaw lbl statics)]
updInfoSRTs dflags _ _ caffy (CmmData s (CmmStatics lbl itbl ccs payload))
= [CmmData s (RawCmmStatics lbl (map CmmStaticLit field_lits))]
= [CmmData s (CmmStaticsRaw lbl (map CmmStaticLit field_lits))]
where
caf_info = if caffy then MayHaveCafRefs else NoCafRefs
field_lits = mkStaticClosureFields dflags itbl ccs caf_info payload
......
......@@ -1167,7 +1167,7 @@ staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure pkg cl_label info payload
= do dflags <- getDynFlags
let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
code $ emitRawDataLits (mkCmmDataLabel pkg cl_label) lits
code $ emitDataLits (mkCmmDataLabel pkg cl_label) lits
foreignCall
:: String
......
{-# LANGUAGE GADTs #-}
----------------------------------------------------------------------------
--
-- Pretty-printing of common Cmm types
......@@ -70,12 +72,9 @@ instance (Outputable d, Outputable info, Outputable i)
=> Outputable (GenCmmDecl d info i) where
ppr t = pprTop t
instance Outputable CmmStatics where
instance Outputable (GenCmmStatics a) where
ppr = pprStatics
instance Outputable RawCmmStatics where
ppr = pprRawStatics
instance Outputable CmmStatic where
ppr e = sdocWithDynFlags $ \dflags ->
pprStatic (targetPlatform dflags) e
......@@ -142,13 +141,10 @@ instance Outputable ForeignHint where
-- following C--
--
pprStatics :: CmmStatics -> SDoc
pprStatics :: GenCmmStatics a -> SDoc
pprStatics (CmmStatics lbl itbl ccs payload) =
ppr lbl <> colon <+> ppr itbl <+> ppr ccs <+> ppr payload
pprStatics (CmmStaticsRaw lbl ds) = pprRawStatics (RawCmmStatics lbl ds)
pprRawStatics :: RawCmmStatics -> SDoc
pprRawStatics (RawCmmStatics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
pprStatics (CmmStaticsRaw lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
......
......@@ -20,7 +20,7 @@ module GHC.Cmm.Utils(
-- CmmLit
zeroCLit, mkIntCLit,
mkWordCLit, packHalfWordsCLit,
mkByteStringCLit,
mkByteStringCLit, mkFileEmbedLit,
mkDataLits, mkRODataLits,
mkStgWordCLit,
......@@ -197,20 +197,27 @@ mkWordCLit platform wd = CmmInt wd (wordWidth platform)
-- | We make a top-level decl for the string, and return a label pointing to it
mkByteStringCLit
:: CLabel -> ByteString -> (CmmLit, GenCmmDecl RawCmmStatics info stmt)
:: CLabel -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
mkByteStringCLit lbl bytes
= (CmmLabel lbl, CmmData (Section sec lbl) $ RawCmmStatics lbl [CmmString bytes])
= (CmmLabel lbl, CmmData (Section sec lbl) $ CmmStaticsRaw lbl [CmmString bytes])
where
-- This can not happen for String literals (as there \NUL is replaced by
-- C0 80). However, it can happen with Addr# literals.
sec = if 0 `BS.elem` bytes then ReadOnlyData else CString
mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl RawCmmStatics info stmt
-- Build a data-segment data block
-- | We make a top-level decl for the embedded binary file, and return a label pointing to it
mkFileEmbedLit
:: CLabel -> FilePath -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
mkFileEmbedLit lbl path
= (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path]))
-- | Build a data-segment data block
mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
mkDataLits section lbl lits
= CmmData section (RawCmmStatics lbl $ map CmmStaticLit lits)
= CmmData section (CmmStaticsRaw lbl $ map CmmStaticLit lits)
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl RawCmmStatics info stmt
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
-- Build a read-only data block
mkRODataLits lbl lits
= mkDataLits section lbl lits
......
......@@ -669,7 +669,7 @@ getRegister' dflags _ (CmmLit (CmmFloat f frep)) = do
let format = floatFormat frep
code dst =
LDATA (Section ReadOnlyData lbl)
(RawCmmStatics lbl [CmmStaticLit (CmmFloat f frep)])
(CmmStaticsRaw lbl [CmmStaticLit (CmmFloat f frep)])
`consOL` (addr_code `snocOL` LD format dst addr)
return (Any format code)
......@@ -689,7 +689,7 @@ getRegister' dflags platform (CmmLit lit)
let rep = cmmLitType platform lit
format = cmmTypeFormat rep
code dst =
LDATA (Section ReadOnlyData lbl) (RawCmmStatics lbl [CmmStaticLit lit])
LDATA (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmStaticLit lit])
`consOL` (addr_code `snocOL` LD format dst addr)
return (Any format code)
......@@ -2110,7 +2110,7 @@ generateJumpTableForInstr config (BCTR ids (Just lbl) _) =
= CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0
(ncgWordWidth config))
where blockLabel = blockLbl blockid
in Just (CmmData (Section ReadOnlyData lbl) (RawCmmStatics lbl jumpTable))
in Just (CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl jumpTable))
generateJumpTableForInstr _ _ = Nothing
-- -----------------------------------------------------------------------------
......@@ -2340,7 +2340,7 @@ coerceInt2FP' ArchPPC fromRep toRep x = do
Amode addr addr_code <- getAmode D dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [
LDATA (Section ReadOnlyData lbl) $ RawCmmStatics lbl
LDATA (Section ReadOnlyData lbl) $ CmmStaticsRaw lbl
[CmmStaticLit (CmmInt 0x43300000 W32),
CmmStaticLit (CmmInt 0x80000000 W32)],
XORIS itmp src (ImmInt 0x8000),
......
......@@ -61,7 +61,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
-- so label needed
vcat (map (pprBasicBlock platform top_info) blocks)
Just (RawCmmStatics info_lbl _) ->
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
(if platformHasSubsectionsViaSymbols platform
then ppr (mkDeadStripPreventer info_lbl) <> char ':'
......@@ -113,7 +113,7 @@ pprBasicBlock platform info_env (BasicBlock blockid instrs)
where
maybe_infotable = case mapLookup blockid info_env of
Nothing -> empty
Just (RawCmmStatics info_lbl info) ->
Just (CmmStaticsRaw info_lbl info) ->
pprAlignForSection platform Text $$
vcat (map (pprData platform) info) $$
pprLabel platform info_lbl
......@@ -122,7 +122,7 @@ pprBasicBlock platform info_env (BasicBlock blockid instrs)
pprDatas :: Platform -> RawCmmStatics -> SDoc
-- See note [emit-time elimination of static indirections] in CLabel.
pprDatas _platform (RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
pprDatas _platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
labelInd (CmmLabel l) = Just l
......@@ -131,7 +131,7 @@ pprDatas _platform (RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
, alias `mayRedirectTo` ind'
= pprGloblDecl alias
$$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
pprDatas platform (RawCmmStatics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
pprData :: Platform -> CmmStatic -> SDoc
pprData platform d = case d of
......
......@@ -48,8 +48,8 @@ shortcutJump _ other = other
-- Here because it knows about JumpDest
shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics fn (RawCmmStatics lbl statics)
= RawCmmStatics lbl $ map (shortcutStatic fn) statics
shortcutStatics fn (CmmStaticsRaw lbl statics)
= CmmStaticsRaw lbl $ map (shortcutStatic fn) statics
-- we need to get the jump tables, so apply the mapping to the entries
-- of a CmmData too.
......
......@@ -342,7 +342,7 @@ generateJumpTableForInstr :: Platform -> Instr
-> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr platform (JMP_TBL _ ids label) =
let jumpTable = map (jumpTableEntry platform) ids
in Just (CmmData (Section ReadOnlyData label) (RawCmmStatics label jumpTable))
in Just (CmmData (Section ReadOnlyData label) (CmmStaticsRaw label jumpTable))
generateJumpTableForInstr _ _ = Nothing
......
......@@ -86,7 +86,7 @@ getRegister (CmmLit (CmmFloat f W32)) = do
let code dst = toOL [
-- the data area
LDATA (Section ReadOnlyData lbl) $ RawCmmStatics lbl
LDATA (Section ReadOnlyData lbl) $ CmmStaticsRaw lbl
[CmmStaticLit (CmmFloat f W32)],
-- load the literal
......@@ -99,7 +99,7 @@ getRegister (CmmLit (CmmFloat d W64)) = do
lbl <- getNewLabelNat
tmp <- getNewRegNat II32
let code dst = toOL [
LDATA (Section ReadOnlyData lbl) $ RawCmmStatics lbl
LDATA (Section ReadOnlyData lbl) $ CmmStaticsRaw lbl
[CmmStaticLit (CmmFloat d W64)],
SETHI (HI (ImmCLbl lbl)) tmp,
LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
......
......@@ -67,7 +67,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock platform top_info) blocks)
Just (RawCmmStatics info_lbl _) ->
Just (CmmStaticsRaw info_lbl _) ->
(if platformHasSubsectionsViaSymbols platform
then pprSectionAlign config dspSection $$
ppr (mkDeadStripPreventer info_lbl) <> char ':'
......@@ -96,7 +96,7 @@ pprBasicBlock platform info_env (BasicBlock blockid instrs)
where
maybe_infotable = case mapLookup blockid info_env of
Nothing -> empty
Just (RawCmmStatics info_lbl info) ->
Just (CmmStaticsRaw info_lbl info) ->
pprAlignForSection Text $$
vcat (map (pprData platform) info) $$
pprLabel platform info_lbl
......@@ -104,7 +104,7 @@ pprBasicBlock platform info_env (BasicBlock blockid instrs)
pprDatas :: Platform -> RawCmmStatics -> SDoc
-- See note [emit-time elimination of static indirections] in CLabel.
pprDatas _platform (RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
pprDatas _platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
labelInd (CmmLabel l) = Just l
......@@ -113,7 +113,7 @@ pprDatas _platform (RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
, alias `mayRedirectTo` ind'
= pprGloblDecl alias
$$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
pprDatas platform (RawCmmStatics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
pprData :: Platform -> CmmStatic -> SDoc
pprData platform d = case d of
......
......@@ -44,8 +44,8 @@ shortcutJump _ other = other
shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics fn (RawCmmStatics lbl statics)
= RawCmmStatics lbl $ map (shortcutStatic fn) statics
shortcutStatics fn (CmmStaticsRaw lbl statics)
= CmmStaticsRaw lbl $ map (shortcutStatic fn) statics
-- we need to get the jump tables, so apply the mapping to the entries
-- of a CmmData too.
......
......@@ -1485,7 +1485,7 @@ memConstant align lit = do
return (addr, addr_code)
else return (ripRel (ImmCLbl lbl), nilOL)
let code =
LDATA rosection (align, RawCmmStatics lbl [CmmStaticLit lit])
LDATA rosection (align, CmmStaticsRaw lbl [CmmStaticLit lit])
`consOL` addr_code
return (Amode addr code)
......@@ -3329,7 +3329,7 @@ createJumpTable config ids section lbl
where blockLabel = blockLbl blockid
in map jumpTableEntryRel ids
| otherwise = map (jumpTableEntry config) ids
in CmmData section (mkAlignment 1, RawCmmStatics lbl jumpTable)
in CmmData section (mkAlignment 1, CmmStaticsRaw lbl jumpTable)
extractUnwindPoints :: [Instr] -> [UnwindPoint]
extractUnwindPoints instrs =
......
......@@ -1021,8 +1021,8 @@ shortcutJump fn insn = shortcutJump' fn (setEmpty :: LabelSet) insn
-- Here because it knows about JumpDest
shortcutStatics :: (BlockId -> Maybe JumpDest) -> (Alignment, RawCmmStatics) -> (Alignment, RawCmmStatics)
shortcutStatics fn (align, RawCmmStatics lbl statics)
= (align, RawCmmStatics lbl $ map (shortcutStatic fn) statics)
shortcutStatics fn (align, CmmStaticsRaw lbl statics)
= (align, CmmStaticsRaw lbl $ map (shortcutStatic fn) statics)
-- we need to get the jump tables, so apply the mapping to the entries
-- of a CmmData too.
......
......@@ -93,7 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
pprSizeDecl platform lbl
Just (RawCmmStatics info_lbl _) ->
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
pprProcAlignment config $$
(if platformHasSubsectionsViaSymbols platform
......@@ -132,7 +132,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
platform = ncgPlatform config
maybe_infotable c = case mapLookup blockid info_env of
Nothing -> c
Just (RawCmmStatics infoLbl info) ->
Just (CmmStaticsRaw infoLbl info) ->
pprAlignForSection platform Text $$
infoTableLoc $$
vcat (map (pprData config) info) $$
......@@ -151,7 +151,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprDatas :: NCGConfig -> (Alignment, RawCmmStatics) -> SDoc
-- See note [emit-time elimination of static indirections] in CLabel.
pprDatas _config (_, RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
pprDatas _config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
labelInd (CmmLabel l) = Just l
......@@ -161,7 +161,7 @@ pprDatas _config (_, RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStatic
= pprGloblDecl alias
$$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
pprDatas config (align, (RawCmmStatics lbl dats))
pprDatas config (align, (CmmStaticsRaw lbl dats))
= vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats)
where
platform = ncgPlatform config
......
......@@ -88,7 +88,7 @@ pprTop dflags = \case
(CmmProc infos clbl _in_live_regs graph) ->
(case mapLookup (g_entry graph) infos of
Nothing -> empty
Just (RawCmmStatics info_clbl info_dat) ->
Just (CmmStaticsRaw info_clbl info_dat) ->
pprDataExterns platform info_dat $$
pprWordArray dflags info_is_in_rodata info_clbl info_dat) $$
(vcat [
......@@ -111,21 +111,21 @@ pprTop dflags = \case
-- We only handle (a) arrays of word-sized things and (b) strings.
(CmmData section (RawCmmStatics lbl [CmmString str])) ->
(CmmData section (CmmStaticsRaw lbl [CmmString str])) ->
pprExternDecl platform lbl $$
hcat [
pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
text "[] = ", pprStringInCStyle str, semi
]
(CmmData section (RawCmmStatics lbl [CmmUninitialised size])) ->
(CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) ->
pprExternDecl platform lbl $$
hcat [
pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
brackets (int size), semi
]
(CmmData section (RawCmmStatics lbl lits)) ->
(CmmData section (CmmStaticsRaw lbl lits)) ->
pprDataExterns platform lits $$
pprWordArray dflags (isSecConstant section) lbl lits
where
......
......@@ -121,9 +121,9 @@ llvmGroupLlvmGens cmm = do
let split (CmmData s d' ) = return $ Just (s, d')
split (CmmProc h l live g) = do
-- Set function type
let l' = case mapLookup (g_entry g) h of
let l' = case mapLookup (g_entry g) h :: Maybe RawCmmStatics of
Nothing -> l
Just (RawCmmStatics info_lbl _) -> info_lbl
Just (CmmStaticsRaw info_lbl _) -> info_lbl
lml <- strCLabel_llvm l'
funInsert lml =<< llvmFunTy live
return Nothing
......
......@@ -44,7 +44,7 @@ linkage lbl = if externallyVisibleCLabel lbl
-- | Pass a CmmStatic section to an equivalent Llvm code.
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
-- See note [emit-time elimination of static indirections] in CLabel.
genLlvmData (_, RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
genLlvmData (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
| lbl == mkIndStaticInfoLabel
, let labelInd (CmmLabelOff l _) = Just l
labelInd (CmmLabel l) = Just l
......@@ -67,7 +67,7 @@ genLlvmData (_, RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit i
pure ([LMGlobal aliasDef $ Just orig], [tyAlias])
genLlvmData (sec, RawCmmStatics lbl xs) = do
genLlvmData (sec, CmmStaticsRaw lbl xs) = do
label <- strCLabel_llvm lbl
static <- mapM genData xs
lmsec <- llvmSection sec
......
......@@ -46,7 +46,7 @@ pprLlvmCmmDecl (CmmData _ lmdata)
pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
= do let lbl = case mb_info of
Nothing -> entry_lbl
Just (RawCmmStatics info_lbl _) -> info_lbl
Just (CmmStaticsRaw info_lbl _) -> info_lbl
link = if externallyVisibleCLabel lbl
then ExternallyVisible
else Internal
......@@ -63,7 +63,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
-- generate the info table
prefix <- case mb_info of
Nothing -> return Nothing
Just (RawCmmStatics _ statics) -> do
Just (CmmStaticsRaw _ statics) -> do
infoStatics <- mapM genData statics
let infoTy = LMStruct $ map getStatType infoStatics
return $ Just $ LMStaticStruc infoStatics infoTy
......
......@@ -27,6 +27,7 @@ import GHC.StgToCmm.Hpc
import GHC.StgToCmm.Ticky
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Stg.Syntax
......@@ -192,7 +193,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
cgEnumerationTyCon :: TyCon -> FCode ()
cgEnumerationTyCon tycon
= do dflags <- getDynFlags
emitRawRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
[ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)
(tagForCon dflags con)
| con <- tyConDataCons tycon]
......
......@@ -35,15 +35,15 @@ mkTickBox platform mod n
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
n
-- | Emit top-level tables for HPC and return code to initialise
initHpc :: Module -> HpcInfo -> FCode ()
-- Emit top-level tables for HPC and return code to initialise
initHpc _ (NoHpcInfo {})
= return ()
initHpc this_mod (HpcInfo tickCount _hashNo)
= do dflags <- getDynFlags
when (gopt Opt_Hpc dflags) $
emitRawDataLits (mkHpcTicksLabel this_mod)
[ (CmmInt 0 W64)
| _ <- take tickCount [0 :: Int ..]
]
emitDataLits (mkHpcTicksLabel this_mod)
[ (CmmInt 0 W64)
| _ <- take tickCount [0 :: Int ..]
]
......@@ -236,7 +236,7 @@ emitCostCentreDecl cc = do
is_caf, -- StgInt is_caf
zero platform -- struct _CostCentre *link
]
; emitRawDataLits (mkCCLabel cc) lits
; emitDataLits (mkCCLabel cc) lits
}
emitCostCentreStackDecl :: CostCentreStack -> FCode ()
......@@ -253,7 +253,7 @@ emitCostCentreStackDecl ccs
-- layouts of structs containing long-longs, simply
-- pad out the struct with zero words until we hit the
-- size of the overall struct (which we get via DerivedConstants.h)
emitRawDataLits (mkCCSLabel ccs) (mk_lits cc)
emitDataLits (mkCCSLabel ccs) (mk_lits cc)
Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
zero :: Platform -> CmmLit
......
......@@ -243,7 +243,7 @@ emitTickyCounter cloType name args
; fun_descr_lit <- newStringCLit $ showSDocDebug dflags ppr_for_ticky_name
; arg_descr_lit <- newStringCLit $ map (showTypeCategory . idType . fromNonVoid) args
; emitRawDataLits ctr_lbl
; emitDataLits ctr_lbl
-- Must match layout of includes/rts/Ticky.h's StgEntCounter
--
-- krc: note that all the fields are I32 now; some were I16
......@@ -256,7 +256,7 @@ emitTickyCounter cloType name args
arg_descr_lit,
zeroCLit platform, -- Entries into this thing
zeroCLit platform, -- Heap allocated by this thing
zeroCLit platform -- Link to next StgEntCounter
zeroCLit platform -- Link to next StgEntCounter
]
}
......
......@@ -11,8 +11,7 @@
module GHC.StgToCmm.Utils (
cgLit, mkSimpleLit,
emitRawDataLits, mkRawDataLits,
emitRawRODataLits, mkRawRODataLits,
emitDataLits, emitRODataLits,
emitDataCon,
emitRtsCall, emitRtsCallWithResult, emitRtsCallGen,
assignTemp, newTemp,
......@@ -38,7 +37,6 @@ module GHC.StgToCmm.Utils (
cmmUntag, cmmIsTagged,
addToMem, addToMemE, addToMemLblE, addToMemLbl,
mkWordCLit, mkByteStringCLit, mkFileEmbedLit,
newStringCLit, newByteStringCLit,
blankWord,
......@@ -60,7 +58,7 @@ import GHC.Cmm.BlockId
import GHC.Cmm.Graph as CmmGraph
import GHC.Platform.Regs
import GHC.Cmm.CLabel
import GHC.Cmm.Utils hiding (mkDataLits, mkRODataLits, mkByteStringCLit)
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.StgToCmm.CgUtils
......@@ -83,7 +81,6 @@ import GHC.Types.CostCentre
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS