diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-31 18:49:01 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-03 06:26:54 -0400 |
commit | cc2918a0407e1581e824ebd90a1fcbb0637d5744 (patch) | |
tree | 42cdc286b9b2557252f59db47373305c1cfc9c36 /compiler | |
parent | a485c3c4049fff09e989bfd7d2ba47035c92a69b (diff) | |
download | haskell-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')
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)) |