summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-03-31 18:49:01 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-03 06:26:54 -0400
commitcc2918a0407e1581e824ebd90a1fcbb0637d5744 (patch)
tree42cdc286b9b2557252f59db47373305c1cfc9c36 /compiler
parenta485c3c4049fff09e989bfd7d2ba47035c92a69b (diff)
downloadhaskell-cc2918a0407e1581e824ebd90a1fcbb0637d5744.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Cmm.hs37
-rw-r--r--compiler/GHC/Cmm/DebugBlock.hs2
-rw-r--r--compiler/GHC/Cmm/Info.hs2
-rw-r--r--compiler/GHC/Cmm/Info/Build.hs4
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/Cmm/Ppr/Decl.hs14
-rw-r--r--compiler/GHC/Cmm/Utils.hs21
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs8
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs8
-rw-r--r--compiler/GHC/CmmToAsm/PPC/RegInfo.hs4
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen.hs2
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs4
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/Ppr.hs8
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs4
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs4
-rw-r--r--compiler/GHC/CmmToAsm/X86/Instr.hs4
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs8
-rw-r--r--compiler/GHC/CmmToC.hs8
-rw-r--r--compiler/GHC/CmmToLlvm.hs4
-rw-r--r--compiler/GHC/CmmToLlvm/Data.hs4
-rw-r--r--compiler/GHC/CmmToLlvm/Ppr.hs4
-rw-r--r--compiler/GHC/StgToCmm.hs3
-rw-r--r--compiler/GHC/StgToCmm/Hpc.hs10
-rw-r--r--compiler/GHC/StgToCmm/Prof.hs4
-rw-r--r--compiler/GHC/StgToCmm/Ticky.hs4
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs51
26 files changed, 101 insertions, 127 deletions
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 9973db8d0d..fe5109aa6f 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -1,5 +1,8 @@
-- 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
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 2129b3e7aa..99650e01ed 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -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
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 88fc145b17..4ccd06adac 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -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))
-----------------------------------------------------
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 6c8551587b..c27efa56cd 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -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
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index cb34fbc52f..535c8fd5d0 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -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
diff --git a/compiler/GHC/Cmm/Ppr/Decl.hs b/compiler/GHC/Cmm/Ppr/Decl.hs
index 9190bf61be..d6ec1882b2 100644
--- a/compiler/GHC/Cmm/Ppr/Decl.hs
+++ b/compiler/GHC/Cmm/Ppr/Decl.hs
@@ -1,3 +1,5 @@
+{-# 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
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 0b0c848eb7..c23975bb44 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index e5177b80b3..74d8b00c39 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -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),
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 647f1ff1c9..b4b9ee804e 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
index 5a48ed28e0..58e3f44ece 100644
--- a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
+++ b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
@@ -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.
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index ec7d59fe02..94609fbcc1 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
index 8d2c6c33f6..494e407d19 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
@@ -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]
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 7c6954c548..661db9dfbb 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs b/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
index 2d1f77d737..98f55d13d8 100644
--- a/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
@@ -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.
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 1a22fc27f0..834cd68d32 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -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 =
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 846ef9b72f..9c5888c21d 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -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.
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 9230550872..0b0c406bc4 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -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
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index c630fbb305..3eddd87785 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -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
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
index d89b8e93cf..1ac2a0fa34 100644
--- a/compiler/GHC/CmmToLlvm.hs
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -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
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
index ea5b83a703..a862895b3c 100644
--- a/compiler/GHC/CmmToLlvm/Data.hs
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -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
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
index fea3d351fa..3606ed56c0 100644
--- a/compiler/GHC/CmmToLlvm/Ppr.hs
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -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
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 0e6013d712..d7c5aab01c 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -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]
diff --git a/compiler/GHC/StgToCmm/Hpc.hs b/compiler/GHC/StgToCmm/Hpc.hs
index 1b7305da4e..4feb81217b 100644
--- a/compiler/GHC/StgToCmm/Hpc.hs
+++ b/compiler/GHC/StgToCmm/Hpc.hs
@@ -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 ..]
+ ]
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 54e49eee87..578dbc1318 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -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
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index d6cea4206c..48f2e99bd6 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -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
]
}
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index bc9c4ac22f..de59cf3be9 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -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
import qualified Data.Map as M
import Data.Char
import Data.List
@@ -276,45 +273,13 @@ callerSaveVolatileRegs dflags = (caller_save, caller_load)
--
-------------------------------------------------------------------------
-mkRawDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
--- Build a data-segment data block
-mkRawDataLits section lbl lits
- = CmmData section (CmmStaticsRaw lbl (map CmmStaticLit lits))
+-- | Emit a data-segment data block
+emitDataLits :: CLabel -> [CmmLit] -> FCode ()
+emitDataLits lbl lits = emitDecl (mkDataLits (Section Data lbl) lbl lits)
-mkRawRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
--- Build a read-only data block
-mkRawRODataLits lbl lits
- = mkRawDataLits section lbl lits
- where
- section | any needsRelocation lits = Section RelocatableReadOnlyData lbl
- | otherwise = Section ReadOnlyData lbl
- needsRelocation (CmmLabel _) = True
- needsRelocation (CmmLabelOff _ _) = True
- needsRelocation _ = False
-
--- | We make a top-level decl for the string, and return a label pointing to it
-mkByteStringCLit
- :: CLabel -> ByteString -> (CmmLit, GenCmmDecl CmmStatics info stmt)
-mkByteStringCLit lbl 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
-
--- | We make a top-level decl for the embedded binary file, and return a label pointing to it
-mkFileEmbedLit
- :: CLabel -> FilePath -> (CmmLit, GenCmmDecl CmmStatics info stmt)
-mkFileEmbedLit lbl path
- = (CmmLabel lbl, CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl [CmmFileEmbed path]))
-
-emitRawDataLits :: CLabel -> [CmmLit] -> FCode ()
--- Emit a data-segment data block
-emitRawDataLits lbl lits = emitDecl (mkRawDataLits (Section Data lbl) lbl lits)
-
-emitRawRODataLits :: CLabel -> [CmmLit] -> FCode ()
--- Emit a read-only data block
-emitRawRODataLits lbl lits = emitDecl (mkRawRODataLits lbl lits)
+-- | Emit a read-only data block
+emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
+emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits)
emitDataCon :: CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
emitDataCon lbl itbl ccs payload = emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload))