Refactor CLabel pretty-printing

Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove
(#10143, #17957). It uses it to query the backend and the platform.

This patch exposes Clabel ppr functions specialised for each backend so
that backend code can directly use them.

15 files changed, 248 insertions, 228 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 425b1b862d..602e3d38fc 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -108,7 +108,7 @@ module GHC.Cmm.CLabel (
         -- * Conversions
         toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
 
-        pprCLabel,
+        pprCLabel, pprCLabel_LLVM, pprCLabel_NCG,
         isInfoTableLabel,
         isConInfoTableLabel,
         isIdLabel, isTickyLabel
@@ -242,7 +242,7 @@ data CLabel
 
   -- | These labels are generated and used inside the NCG only.
   --    They are special variants of a label used for dynamic linking
-  --    see module PositionIndependentCode for details.
+  --    see module "GHC.CmmToAsm.PIC" for details.
   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 
   -- | This label is generated and used inside the NCG only.
@@ -398,23 +398,24 @@ data ForeignLabelSource
 --      We can't make a Show instance for CLabel because lots of its components don't have instances.
 --      The regular Outputable instance only shows the label name, and not its other info.
 --
-pprDebugCLabel :: CLabel -> SDoc
-pprDebugCLabel lbl
+pprDebugCLabel :: Platform -> CLabel -> SDoc
+pprDebugCLabel platform lbl
  = case lbl of
-        IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
-                                       <> whenPprDebug (text ":" <> text (show info)))
+        IdLabel _ _ info-> pprCLabel_other platform lbl
+                           <> (parens $ text "IdLabel"
+                           <> whenPprDebug (text ":" <> text (show info)))
         CmmLabel pkg _ext _name _info
-         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+         -> pprCLabel_other platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
-        RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
+        RtsLabel{}      -> pprCLabel_other platform lbl <> (parens $ text "RtsLabel")
 
         ForeignLabel _name mSuffix src funOrData
-            -> ppr lbl <> (parens $ text "ForeignLabel"
-                                <+> ppr mSuffix
-                                <+> ppr src
-                                <+> ppr funOrData)
+            -> pprCLabel_other platform lbl <> (parens $ text "ForeignLabel"
+                                        <+> ppr mSuffix
+                                        <+> ppr src
+                                        <+> ppr funOrData)
 
-        _               -> ppr lbl <> (parens $ text "other CLabel")
+        _               -> pprCLabel_other platform lbl <> (parens $ text "other CLabel")
 
 
 data IdLabelInfo
@@ -753,34 +754,37 @@ mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
 -- -----------------------------------------------------------------------------
 -- Convert between different kinds of label
 
-toClosureLbl :: CLabel -> CLabel
-toClosureLbl (IdLabel n c _) = IdLabel n c Closure
-toClosureLbl (CmmLabel m ext str _) = CmmLabel m ext str CmmClosure
-toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
-
-toSlowEntryLbl :: CLabel -> CLabel
-toSlowEntryLbl (IdLabel n _ BlockInfoTable)
-  = pprPanic "toSlowEntryLbl" (ppr n)
-toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
-toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
-
-toEntryLbl :: CLabel -> CLabel
-toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
-toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
-toEntryLbl (IdLabel n _ BlockInfoTable)  = mkLocalBlockLabel (nameUnique n)
-                              -- See Note [Proc-point local block entry-point].
-toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
-toEntryLbl (CmmLabel m ext str CmmInfo)    = CmmLabel m ext str CmmEntry
-toEntryLbl (CmmLabel m ext str CmmRetInfo) = CmmLabel m ext str CmmRet
-toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
-
-toInfoLbl :: CLabel -> CLabel
-toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
-toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
-toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
-toInfoLbl (CmmLabel m ext str CmmEntry)= CmmLabel m ext str CmmInfo
-toInfoLbl (CmmLabel m ext str CmmRet)  = CmmLabel m ext str CmmRetInfo
-toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
+toClosureLbl :: Platform -> CLabel -> CLabel
+toClosureLbl platform lbl = case lbl of
+   IdLabel n c _        -> IdLabel n c Closure
+   CmmLabel m ext str _ -> CmmLabel m ext str CmmClosure
+   _                    -> pprPanic "toClosureLbl" (pprCLabel_other platform lbl)
+
+toSlowEntryLbl :: Platform -> CLabel -> CLabel
+toSlowEntryLbl platform lbl = case lbl of
+   IdLabel n _ BlockInfoTable -> pprPanic "toSlowEntryLbl" (ppr n)
+   IdLabel n c _              -> IdLabel n c Slow
+   _                          -> pprPanic "toSlowEntryLbl" (pprCLabel_other platform lbl)
+
+toEntryLbl :: Platform -> CLabel -> CLabel
+toEntryLbl platform lbl = case lbl of
+   IdLabel n c LocalInfoTable    -> IdLabel n c LocalEntry
+   IdLabel n c ConInfoTable      -> IdLabel n c ConEntry
+   IdLabel n _ BlockInfoTable    -> mkLocalBlockLabel (nameUnique n)
+                   -- See Note [Proc-point local block entry-point].
+   IdLabel n c _                 -> IdLabel n c Entry
+   CmmLabel m ext str CmmInfo    -> CmmLabel m ext str CmmEntry
+   CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet
+   _                             -> pprPanic "toEntryLbl" (pprCLabel_other platform lbl)
+
+toInfoLbl :: Platform -> CLabel -> CLabel
+toInfoLbl platform lbl = case lbl of
+   IdLabel n c LocalEntry      -> IdLabel n c LocalInfoTable
+   IdLabel n c ConEntry        -> IdLabel n c ConInfoTable
+   IdLabel n c _               -> IdLabel n c InfoTable
+   CmmLabel m ext str CmmEntry -> CmmLabel m ext str CmmInfo
+   CmmLabel m ext str CmmRet   -> CmmLabel m ext str CmmRetInfo
+   _                           -> pprPanic "CLabel.toInfoLbl" (pprCLabel_other platform lbl)
 
 hasHaskellName :: CLabel -> Maybe Name
 hasHaskellName (IdLabel n _ _) = Just n
@@ -1208,34 +1212,50 @@ and are not externally visible.
 -}
 
 instance Outputable CLabel where
-  ppr c = sdocWithDynFlags $ \dynFlags -> pprCLabel dynFlags c
+  ppr lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) (targetPlatform dflags) lbl)
+
+pprCLabel :: Backend -> Platform -> CLabel -> SDoc
+pprCLabel bcknd platform lbl =
+   case bcknd of
+      NCG  -> pprCLabel_NCG   platform lbl
+      LLVM -> pprCLabel_LLVM  platform lbl
+      _    -> pprCLabel_other platform lbl
+
+pprCLabel_LLVM :: Platform -> CLabel -> SDoc
+pprCLabel_LLVM = pprCLabel_NCG
+
+pprCLabel_NCG :: Platform -> CLabel -> SDoc
+pprCLabel_NCG platform lbl = getPprStyle $ \sty ->
+  let
+    -- some platform (e.g. Darwin) require a leading "_" for exported asm
+    -- symbols
+    maybe_underscore :: SDoc -> SDoc
+    maybe_underscore doc =
+      if platformLeadingUnderscore platform
+      then pp_cSEP <> doc
+      else doc
 
-pprCLabel :: DynFlags -> CLabel -> SDoc
-pprCLabel dflags = \case
-   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+  in case lbl of
+   LocalBlockLabel u
+      -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
-   (AsmTempLabel u)
-      | not (platformUnregisterised platform)
+   AsmTempLabel u
       -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
-   (AsmTempDerivedLabel l suf)
-      | useNCG
+   AsmTempDerivedLabel l suf
       -> ptext (asmTempLabelPrefix platform)
          <> case l of AsmTempLabel u    -> pprUniqueAlways u
                       LocalBlockLabel u -> pprUniqueAlways u
-                      _other            -> pprCLabel dflags l
+                      _other            -> pprCLabel_NCG platform l
          <> ftext suf
 
-   (DynamicLinkerLabel info lbl)
-      | useNCG
+   DynamicLinkerLabel info lbl
       -> pprDynamicLinkerAsmLabel platform info lbl
 
    PicBaseLabel
-      | useNCG
       -> text "1b"
 
-   (DeadStripPreventer lbl)
-      | useNCG
+   DeadStripPreventer lbl
       ->
       {-
          `lbl` can be temp one but we need to ensure that dsp label will stay
@@ -1243,36 +1263,36 @@ pprCLabel dflags = \case
          optional `_` (underscore) because this is how you mark non-temp symbols
          on some platforms (Darwin)
       -}
-      maybe_underscore $ text "dsp_" <> pprCLabel dflags lbl <> text "_dsp"
+      maybe_underscore $ text "dsp_" <> pprCLabel_NCG platform lbl <> text "_dsp"
 
-   (StringLitLabel u)
-      | useNCG
+   StringLitLabel u
       -> pprUniqueAlways u <> ptext (sLit "_str")
 
-   lbl -> getPprStyle $ \sty ->
-            if useNCG && asmStyle sty
-            then maybe_underscore $ pprAsmCLbl lbl
-            else pprCLbl platform lbl
+   ForeignLabel fs (Just sz) _ _
+      | asmStyle sty
+      , OSMinGW32 <- platformOS platform
+      -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
+         -- (The C compiler does this itself).
+         maybe_underscore $ ftext fs <> char '@' <> int sz
 
-  where
-    platform = targetPlatform dflags
-    useNCG   = backend dflags == NCG
+   _  | asmStyle sty -> maybe_underscore $ pprCLabel_common platform lbl
+      | otherwise    -> pprCLabel_common platform lbl
 
-    maybe_underscore :: SDoc -> SDoc
-    maybe_underscore doc =
-      if platformLeadingUnderscore platform
-      then pp_cSEP <> doc
-      else doc
+pprCLabel_other :: Platform -> CLabel -> SDoc
+pprCLabel_other platform lbl =
+   case lbl of
+      LocalBlockLabel u
+         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+
+      AsmTempLabel u
+         | not (platformUnregisterised platform)
+         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+
+      lbl -> pprCLabel_common platform lbl
 
-    pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
-     | platformOS platform == OSMinGW32
-        -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-        -- (The C compiler does this itself).
-        = ftext fs <> char '@' <> int sz
-    pprAsmCLbl lbl = pprCLbl platform lbl
 
-pprCLbl :: Platform -> CLabel -> SDoc
-pprCLbl platform = \case
+pprCLabel_common :: Platform -> CLabel -> SDoc
+pprCLabel_common platform = \case
    (StringLitLabel u)   -> pprUniqueAlways u <> text "_str"
    (SRTLabel u)         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
    (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
@@ -1335,11 +1355,11 @@ pprCLbl platform = \case
    (CCS_Label ccs)     -> ppr ccs
    (HpcTicksLabel mod) -> text "_hpc_tickboxes_"  <> ppr mod <> ptext (sLit "_hpc")
 
-   (AsmTempLabel {})        -> panic "pprCLbl AsmTempLabel"
-   (AsmTempDerivedLabel {}) -> panic "pprCLbl AsmTempDerivedLabel"
-   (DynamicLinkerLabel {})  -> panic "pprCLbl DynamicLinkerLabel"
-   (PicBaseLabel {})        -> panic "pprCLbl PicBaseLabel"
-   (DeadStripPreventer {})  -> panic "pprCLbl DeadStripPreventer"
+   (AsmTempLabel {})        -> panic "pprCLabel_common AsmTempLabel"
+   (AsmTempDerivedLabel {}) -> panic "pprCLabel_common AsmTempDerivedLabel"
+   (DynamicLinkerLabel {})  -> panic "pprCLabel_common DynamicLinkerLabel"
+   (PicBaseLabel {})        -> panic "pprCLabel_common PicBaseLabel"
+   (DeadStripPreventer {})  -> panic "pprCLabel_common DeadStripPreventer"
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <> text
@@ -1402,60 +1422,60 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl =
       OSDarwin
         | platformArch platform == ArchX86_64 ->
           case dllInfo of
-            CodeStub        -> char 'L' <> ppr lbl <> text "$stub"
-            SymbolPtr       -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
-            GotSymbolPtr    -> ppr lbl <> text "@GOTPCREL"
-            GotSymbolOffset -> ppr lbl
+            CodeStub        -> char 'L' <> ppLbl <> text "$stub"
+            SymbolPtr       -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
+            GotSymbolPtr    -> ppLbl <> text "@GOTPCREL"
+            GotSymbolOffset -> ppLbl
         | otherwise ->
           case dllInfo of
-            CodeStub  -> char 'L' <> ppr lbl <> text "$stub"
-            SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
+            CodeStub  -> char 'L' <> ppLbl <> text "$stub"
+            SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       OSAIX ->
           case dllInfo of
-            SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
+            SymbolPtr -> text "LC.." <> ppLbl -- GCC's naming convention
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       _ | osElfTarget (platformOS platform) -> elfLabel
 
       OSMinGW32 ->
           case dllInfo of
-            SymbolPtr -> text "__imp_" <> ppr lbl
+            SymbolPtr -> text "__imp_" <> ppLbl
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       _ -> panic "pprDynamicLinkerAsmLabel"
   where
+    ppLbl = pprCLabel_NCG platform lbl
     elfLabel
       | platformArch platform == ArchPPC
       = case dllInfo of
           CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]
-                       ppr lbl <> text "+32768@plt"
-          SymbolPtr -> text ".LC_" <> ppr lbl
+                       ppLbl <> text "+32768@plt"
+          SymbolPtr -> text ".LC_" <> ppLbl
           _         -> panic "pprDynamicLinkerAsmLabel"
 
       | platformArch platform == ArchX86_64
       = case dllInfo of
-          CodeStub        -> ppr lbl <> text "@plt"
-          GotSymbolPtr    -> ppr lbl <> text "@gotpcrel"
-          GotSymbolOffset -> ppr lbl
-          SymbolPtr       -> text ".LC_" <> ppr lbl
+          CodeStub        -> ppLbl <> text "@plt"
+          GotSymbolPtr    -> ppLbl <> text "@gotpcrel"
+          GotSymbolOffset -> ppLbl
+          SymbolPtr       -> text ".LC_" <> ppLbl
 
       | platformArch platform == ArchPPC_64 ELF_V1
         || platformArch platform == ArchPPC_64 ELF_V2
       = case dllInfo of
-          GotSymbolPtr    -> text ".LC_"  <> ppr lbl
-                                  <> text "@toc"
-          GotSymbolOffset -> ppr lbl
-          SymbolPtr       -> text ".LC_" <> ppr lbl
+          GotSymbolPtr    -> text ".LC_"  <> ppLbl <> text "@toc"
+          GotSymbolOffset -> ppLbl
+          SymbolPtr       -> text ".LC_" <> ppLbl
           _               -> panic "pprDynamicLinkerAsmLabel"
 
       | otherwise
       = case dllInfo of
-          CodeStub        -> ppr lbl <> text "@plt"
-          SymbolPtr       -> text ".LC_" <> ppr lbl
-          GotSymbolPtr    -> ppr lbl <> text "@got"
-          GotSymbolOffset -> ppr lbl <> text "@gotoff"
+          CodeStub        -> ppLbl <> text "@plt"
+          SymbolPtr       -> text ".LC_" <> ppLbl
+          GotSymbolPtr    -> ppLbl <> text "@got"
+          GotSymbolOffset -> ppLbl <> text "@gotoff"
 
 -- Figure out whether `symbol` may serve as an alias
 -- to `target` within one compilation unit.
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index c650a66581..fa7602057f 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -253,7 +253,7 @@ mkInfoTableContents dflags
                            ++ [ liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
-        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
+        slow_entry = CmmLabel (toSlowEntryLbl platform info_lbl)
         srt_lit = case srt_label of
                     []          -> mkIntCLit platform 0
                     (lit:_rest) -> ASSERT( null _rest ) lit
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 54eb48efc6..8e91c2636e 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -459,8 +459,8 @@ newtype CAFLabel = CAFLabel CLabel
 type CAFSet = Set CAFLabel
 type CAFEnv = LabelMap CAFSet
 
-mkCAFLabel :: CLabel -> CAFLabel
-mkCAFLabel lbl = CAFLabel (toClosureLbl lbl)
+mkCAFLabel :: Platform -> CLabel -> CAFLabel
+mkCAFLabel platform lbl = CAFLabel (toClosureLbl platform lbl)
 
 -- This is a label that we can put in an SRT.  It *must* be a closure label,
 -- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
@@ -470,10 +470,10 @@ newtype SRTEntry = SRTEntry CLabel
 -- ---------------------------------------------------------------------
 -- CAF analysis
 
-addCafLabel :: CLabel -> CAFSet -> CAFSet
-addCafLabel l s
+addCafLabel :: Platform -> CLabel -> CAFSet -> CAFSet
+addCafLabel platform l s
   | Just _ <- hasHaskellName l
-  , let caf_label = mkCAFLabel l
+  , let caf_label = mkCAFLabel platform l
     -- For imported Ids hasCAF will have accurate CafInfo
     -- Locals are initialized as CAFFY. We turn labels with empty SRTs into
     -- non-CAFFYs in doSRTs
@@ -483,21 +483,20 @@ addCafLabel l s
   = s
 
 cafAnalData
-  :: CmmStatics
+  :: Platform
+  -> CmmStatics
   -> CAFSet
-
-cafAnalData (CmmStaticsRaw _lbl _data) =
-    Set.empty
-
-cafAnalData (CmmStatics _lbl _itbl _ccs payload) =
-    foldl' analyzeStatic Set.empty payload
-  where
-    analyzeStatic s lit =
-      case lit of
-        CmmLabel c -> addCafLabel c s
-        CmmLabelOff c _ -> addCafLabel c s
-        CmmLabelDiffOff c1 c2 _ _ -> addCafLabel c1 $! addCafLabel c2 s
-        _ -> s
+cafAnalData platform st = case st of
+   CmmStaticsRaw _lbl _data           -> Set.empty
+   CmmStatics _lbl _itbl _ccs payload ->
+       foldl' analyzeStatic Set.empty payload
+     where
+       analyzeStatic s lit =
+         case lit of
+           CmmLabel c -> addCafLabel platform c s
+           CmmLabelOff c _ -> addCafLabel platform c s
+           CmmLabelDiffOff c1 c2 _ _ -> addCafLabel platform c1 $! addCafLabel platform c2 s
+           _ -> s
 
 -- |
 -- For each code block:
@@ -507,16 +506,17 @@ cafAnalData (CmmStatics _lbl _itbl _ccs payload) =
 -- This gives us a `CAFEnv`: a mapping from code block to sets of labels
 --
 cafAnal
-  :: LabelSet   -- The blocks representing continuations, ie. those
+  :: Platform
+  -> LabelSet   -- The blocks representing continuations, ie. those
                 -- that will get RET info tables.  These labels will
                 -- get their own SRTs, so we don't aggregate CAFs from
                 -- references to these labels, we just use the label.
   -> CLabel     -- The top label of the proc
   -> CmmGraph
   -> CAFEnv
-cafAnal contLbls topLbl cmmGraph =
+cafAnal platform contLbls topLbl cmmGraph =
   analyzeCmmBwd cafLattice
-    (cafTransfers contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
+    (cafTransfers platform contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
 
 
 cafLattice :: DataflowLattice CAFSet
@@ -527,8 +527,8 @@ cafLattice = DataflowLattice Set.empty add
         in changedIf (Set.size new' > Set.size old) new'
 
 
-cafTransfers :: LabelSet -> Label -> CLabel -> TransferFun CAFSet
-cafTransfers contLbls entry topLbl
+cafTransfers :: Platform -> LabelSet -> Label -> CLabel -> TransferFun CAFSet
+cafTransfers platform contLbls entry topLbl
   block@(BlockCC eNode middle xNode) fBase =
     let joined :: CAFSet
         joined = cafsInNode xNode $! live'
@@ -546,11 +546,11 @@ cafTransfers contLbls entry topLbl
         successorFact s
           -- If this is a loop back to the entry, we can refer to the
           -- entry label.
-          | s == entry = Just (addCafLabel topLbl Set.empty)
+          | s == entry = Just (addCafLabel platform topLbl Set.empty)
           -- If this is a continuation, we want to refer to the
           -- SRT for the continuation's info table
           | s `setMember` contLbls
-          = Just (Set.singleton (mkCAFLabel (infoTblLbl s)))
+          = Just (Set.singleton (mkCAFLabel platform (infoTblLbl s)))
           -- Otherwise, takes the CAF references from the destination
           | otherwise
           = lookupFact s fBase
@@ -562,11 +562,11 @@ cafTransfers contLbls entry topLbl
         addCafExpr expr !set =
           case expr of
             CmmLit (CmmLabel c) ->
-              addCafLabel c set
+              addCafLabel platform c set
             CmmLit (CmmLabelOff c _) ->
-              addCafLabel c set
+              addCafLabel platform c set
             CmmLit (CmmLabelDiffOff c1 c2 _ _) ->
-              addCafLabel c1 $! addCafLabel c2 set
+              addCafLabel platform c1 $! addCafLabel platform c2 set
             _ ->
               set
     in
@@ -649,35 +649,34 @@ getBlockLabels = mapMaybe getBlockLabel
 --   where the label is
 --   - the info label for a continuation or dynamic closure
 --   - the closure label for a top-level function (not a CAF)
-getLabelledBlocks :: CmmDecl -> [(SomeLabel, CAFLabel)]
-getLabelledBlocks (CmmData _ (CmmStaticsRaw _ _)) =
-  []
-getLabelledBlocks (CmmData _ (CmmStatics lbl _ _ _)) =
-  [ (DeclLabel lbl, mkCAFLabel lbl) ]
-getLabelledBlocks (CmmProc top_info _ _ _) =
-  [ (BlockLabel blockId, caf_lbl)
-  | (blockId, info) <- mapToList (info_tbls top_info)
-  , let rep = cit_rep info
-  , not (isStaticRep rep) || not (isThunkRep rep)
-  , let !caf_lbl = mkCAFLabel (cit_lbl info)
-  ]
+getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFLabel)]
+getLabelledBlocks platform decl = case decl of
+   CmmData _ (CmmStaticsRaw _ _)    -> []
+   CmmData _ (CmmStatics lbl _ _ _) -> [ (DeclLabel lbl, mkCAFLabel platform lbl) ]
+   CmmProc top_info _ _ _           -> [ (BlockLabel blockId, caf_lbl)
+                                       | (blockId, info) <- mapToList (info_tbls top_info)
+                                       , let rep = cit_rep info
+                                       , not (isStaticRep rep) || not (isThunkRep rep)
+                                       , let !caf_lbl = mkCAFLabel platform (cit_lbl info)
+                                       ]
 
 -- | Put the labelled blocks that we will be annotating with SRTs into
 -- dependency order.  This is so that we can process them one at a
 -- time, resolving references to earlier blocks to point to their
 -- SRTs. CAFs themselves are not included here; see getCAFs below.
 depAnalSRTs
-  :: CAFEnv
+  :: Platform
+  -> CAFEnv
   -> Map CLabel CAFSet -- CAFEnv for statics
   -> [CmmDecl]
   -> [SCC (SomeLabel, CAFLabel, Set CAFLabel)]
-depAnalSRTs cafEnv cafEnv_static decls =
+depAnalSRTs platform cafEnv cafEnv_static decls =
   srtTrace "depAnalSRTs" (text "decls:" <+> ppr decls $$
                            text "nodes:" <+> ppr (map node_payload nodes) $$
                            text "graph:" <+> ppr graph) graph
  where
   labelledBlocks :: [(SomeLabel, CAFLabel)]
-  labelledBlocks = concatMap getLabelledBlocks decls
+  labelledBlocks = concatMap (getLabelledBlocks platform) decls
   labelToBlock :: Map CAFLabel SomeLabel
   labelToBlock = foldl' (\m (v,k) -> Map.insert k v m) Map.empty labelledBlocks
 
@@ -701,9 +700,9 @@ depAnalSRTs cafEnv cafEnv_static decls =
 --    SRT, since the point of SRTs is to keep CAFs alive.
 --  - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.
 --    instead we generate their SRTs after everything else.
-getCAFs :: CAFEnv -> [CmmDecl] -> [(Label, CAFLabel, Set CAFLabel)]
-getCAFs cafEnv decls =
-  [ (g_entry g, mkCAFLabel topLbl, cafs)
+getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Label, CAFLabel, Set CAFLabel)]
+getCAFs platform cafEnv decls =
+  [ (g_entry g, mkCAFLabel platform topLbl, cafs)
   | CmmProc top_info topLbl _ g <- decls
   , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]
   , let rep = cit_rep info
@@ -747,11 +746,11 @@ srtMapNonCAFs srtMap =
     get_name (_l, Just _srt_entry) = Nothing
 
 -- | resolve a CAFLabel to its SRTEntry using the SRTMap
-resolveCAF :: SRTMap -> CAFLabel -> Maybe SRTEntry
-resolveCAF srtMap lbl@(CAFLabel l) =
+resolveCAF :: Platform -> SRTMap -> CAFLabel -> Maybe SRTEntry
+resolveCAF platform srtMap lbl@(CAFLabel l) =
     srtTrace "resolveCAF" ("l:" <+> ppr l <+> "resolved:" <+> ppr ret) ret
   where
-    ret = Map.findWithDefault (Just (SRTEntry (toClosureLbl l))) lbl srtMap
+    ret = Map.findWithDefault (Just (SRTEntry (toClosureLbl platform l))) lbl srtMap
 
 -- | Attach SRTs to all info tables in the CmmDecls, and add SRT
 -- declarations to the ModuleSRTInfo.
@@ -791,6 +790,8 @@ doSRTs dflags moduleSRTInfo procs data_ = do
       decls = map snd data_ ++ concat procss
       staticFuns = mapFromList (getStaticFuns decls)
 
+      platform = targetPlatform dflags
+
   -- Put the decls in dependency order. Why? So that we can implement
   -- [Inline] and [Filter].  If we need to refer to an SRT that has
   -- a single entry, we use the entry itself, which means that we
@@ -799,10 +800,10 @@ doSRTs dflags moduleSRTInfo procs data_ = do
   -- them.
   let
     sccs :: [SCC (SomeLabel, CAFLabel, Set CAFLabel)]
-    sccs = {-# SCC depAnalSRTs #-} depAnalSRTs cafEnv static_data_env decls
+    sccs = {-# SCC depAnalSRTs #-} depAnalSRTs platform cafEnv static_data_env decls
 
     cafsWithSRTs :: [(Label, CAFLabel, Set CAFLabel)]
-    cafsWithSRTs = getCAFs cafEnv decls
+    cafsWithSRTs = getCAFs platform cafEnv decls
 
   srtTraceM "doSRTs" (text "data:" <+> ppr data_ $$
                       text "procs:" <+> ppr procs $$
@@ -853,7 +854,7 @@ doSRTs dflags moduleSRTInfo procs data_ = do
                           -- be CAFFY.
                           -- See Note [Ticky labels in SRT analysis] above for
                           -- why we exclude ticky labels here.
-                          Map.insert (mkCAFLabel lbl) Nothing srtMap
+                          Map.insert (mkCAFLabel platform lbl) Nothing srtMap
                       | otherwise ->
                           -- Not an IdLabel, ignore
                           srtMap
@@ -933,6 +934,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
   let
     config = initConfig dflags
     profile = targetProfile dflags
+    platform = profilePlatform profile
     srtMap = moduleSRTMap topSRT
 
     blockids = getBlockLabels lbls
@@ -951,7 +953,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
 
     -- Resolve references to their SRT entries
     resolved :: [SRTEntry]
-    resolved = mapMaybe (resolveCAF srtMap) (Set.toList nonRec)
+    resolved = mapMaybe (resolveCAF platform srtMap) (Set.toList nonRec)
 
     -- The set of all SRTEntries in SRTs that we refer to from here.
     allBelow =
@@ -1016,7 +1018,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
     -- We're going to build an SRT for this group, which should include function
     -- references in the group. See Note [recursive SRTs].
     let allBelow_funs =
-          Set.fromList (map (SRTEntry . toClosureLbl) otherFunLabels)
+          Set.fromList (map (SRTEntry . toClosureLbl platform) otherFunLabels)
     let filtered = filtered0 `Set.union` allBelow_funs
     srtTraceM "oneSRT" (text "filtered:" <+> ppr filtered $$
                         text "allBelow_funs:" <+> ppr allBelow_funs)
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index 876de8a41e..ccf3d36a82 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -46,7 +46,7 @@ cmmPipeline
 cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline") forceRes $
   do let dflags = hsc_dflags hsc_env
 
-     tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
+     tops <- {-# SCC "tops" #-} mapM (cpsTop dflags) prog
 
      let (procs, data_) = partitionEithers tops
      (srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags srtInfo procs data_
@@ -59,9 +59,9 @@ cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline")
 
         dflags = hsc_dflags hsc_env
 
-cpsTop :: HscEnv -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl))
-cpsTop _ p@(CmmData _ statics) = return (Right (cafAnalData statics, p))
-cpsTop hsc_env proc =
+cpsTop :: DynFlags -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl))
+cpsTop dflags p@(CmmData _ statics) = return (Right (cafAnalData (targetPlatform dflags) statics, p))
+cpsTop dflags proc =
     do
        ----------- Control-flow optimisations ----------------------------------
 
@@ -118,7 +118,7 @@ cpsTop hsc_env proc =
                      Opt_D_dump_cmm_sink "Sink assignments"
 
        ------------- CAF analysis ----------------------------------------------
-       let cafEnv = {-# SCC "cafAnal" #-} cafAnal call_pps l g
+       let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
        dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (ppr cafEnv)
 
        g <- if splitting_proc_points
@@ -153,8 +153,7 @@ cpsTop hsc_env proc =
 
        return (Left (cafEnv, g))
 
-  where dflags = hsc_dflags hsc_env
-        platform = targetPlatform dflags
+  where platform = targetPlatform dflags
         dump = dumpGraph dflags
 
         dumps flag name
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 1a42dad51d..cca69310b7 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -319,7 +319,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
                   tablesNextToCode = platformTablesNextToCode platform
                   jump_label (Just info_lbl) _
                              | tablesNextToCode = info_lbl
-                             | otherwise        = toEntryLbl info_lbl
+                             | otherwise        = toEntryLbl platform info_lbl
                   jump_label Nothing  block_lbl = block_lbl
 
                   add_if_pp id rst = case mapLookup id procLabels of
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index eaab3868c5..b27db24a7b 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -891,7 +891,7 @@ makeImportsDoc dflags imports
                 | needImportedSymbols config
                 = vcat $
                         (pprGotDeclaration config :) $
-                        map ( pprImportedSymbol dflags config . fst . head) $
+                        map ( pprImportedSymbol config . fst . head) $
                         groupBy (\(_,a) (_,b) -> a == b) $
                         sortBy (\(_,a) (_,b) -> compare a b) $
                         map doPpr $
@@ -901,7 +901,7 @@ makeImportsDoc dflags imports
 
         doPpr lbl = (lbl, renderWithStyle
                               (initSDocContext dflags astyle)
-                              (pprCLabel dflags lbl))
+                              (pprCLabel_NCG platform lbl))
         astyle = mkCodeStyle AsmStyle
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 1eb5f14c56..77ffcfd930 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -2,7 +2,7 @@
   This module handles generation of position independent code and
   dynamic-linking related issues for the native code generator.
 
-  This depends both the architecture and OS, so we define it here
+  This depends on both the architecture and OS, so we define it here
   instead of in one of the architecture specific modules.
 
   Things outside this module which are related to this:
@@ -62,20 +62,13 @@ import GHC.CmmToAsm.Config
 
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm
-import GHC.Cmm.CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
-                          mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
-                          dynamicLinkerLabelInfo, mkPicBaseLabel,
-                          labelDynamic, externallyVisibleCLabel )
-
-import GHC.Cmm.CLabel           ( mkForeignLabel )
-
+import GHC.Cmm.CLabel
 
 import GHC.Types.Basic
 import GHC.Unit.Module
 
 import GHC.Utils.Outputable
 
-import GHC.Driver.Session
 import GHC.Data.FastString
 
 
@@ -573,21 +566,21 @@ pprGotDeclaration config = case (arch,os) of
 -- and one for non-PIC.
 --
 
-pprImportedSymbol :: DynFlags -> NCGConfig -> CLabel -> SDoc
-pprImportedSymbol dflags config importedLbl = case (arch,os) of
+pprImportedSymbol :: NCGConfig -> CLabel -> SDoc
+pprImportedSymbol config importedLbl = case (arch,os) of
    (ArchX86, OSDarwin)
         | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
         -> if not pic
              then
               vcat [
                   text ".symbol_stub",
-                  text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
-                      text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
-                      text "\tjmp *L" <> pprCLabel dflags lbl
+                  text "L" <> ppr_lbl lbl <> ptext (sLit "$stub:"),
+                      text "\t.indirect_symbol" <+> ppr_lbl lbl,
+                      text "\tjmp *L" <> ppr_lbl lbl
                           <> text "$lazy_ptr",
-                  text "L" <> pprCLabel dflags lbl
+                  text "L" <> ppr_lbl lbl
                       <> text "$stub_binder:",
-                      text "\tpushl $L" <> pprCLabel dflags lbl
+                      text "\tpushl $L" <> ppr_lbl lbl
                           <> text "$lazy_ptr",
                       text "\tjmp dyld_stub_binding_helper"
               ]
@@ -595,16 +588,16 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
               vcat [
                   text ".section __TEXT,__picsymbolstub2,"
                       <> text "symbol_stubs,pure_instructions,25",
-                  text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
-                      text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+                  text "L" <> ppr_lbl lbl <> ptext (sLit "$stub:"),
+                      text "\t.indirect_symbol" <+> ppr_lbl lbl,
                       text "\tcall ___i686.get_pc_thunk.ax",
                   text "1:",
-                      text "\tmovl L" <> pprCLabel dflags lbl
+                      text "\tmovl L" <> ppr_lbl lbl
                           <> text "$lazy_ptr-1b(%eax),%edx",
                       text "\tjmp *%edx",
-                  text "L" <> pprCLabel dflags lbl
+                  text "L" <> ppr_lbl lbl
                       <> text "$stub_binder:",
-                      text "\tlea L" <> pprCLabel dflags lbl
+                      text "\tlea L" <> ppr_lbl lbl
                           <> text "$lazy_ptr-1b(%eax),%eax",
                       text "\tpushl %eax",
                       text "\tjmp dyld_stub_binding_helper"
@@ -612,16 +605,16 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
            $+$ vcat [        text ".section __DATA, __la_sym_ptr"
                     <> (if pic then int 2 else int 3)
                     <> text ",lazy_symbol_pointers",
-                text "L" <> pprCLabel dflags lbl <> ptext (sLit "$lazy_ptr:"),
-                    text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
-                    text "\t.long L" <> pprCLabel dflags lbl
+                text "L" <> ppr_lbl lbl <> ptext (sLit "$lazy_ptr:"),
+                    text "\t.indirect_symbol" <+> ppr_lbl lbl,
+                    text "\t.long L" <> ppr_lbl lbl
                     <> text "$stub_binder"]
 
         | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
         -> vcat [
                 text ".non_lazy_symbol_pointer",
-                char 'L' <> pprCLabel dflags lbl <> text "$non_lazy_ptr:",
-                text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+                char 'L' <> ppr_lbl lbl <> text "$non_lazy_ptr:",
+                text "\t.indirect_symbol" <+> ppr_lbl lbl,
                 text "\t.long\t0"]
 
         | otherwise
@@ -644,8 +637,8 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
    (_, OSAIX) -> case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
               -> vcat [
-                   text "LC.." <> pprCLabel dflags lbl <> char ':',
-                   text "\t.long" <+> pprCLabel dflags lbl ]
+                   text "LC.." <> ppr_lbl lbl <> char ':',
+                   text "\t.long" <+> ppr_lbl lbl ]
             _ -> empty
 
    -- ELF / Linux
@@ -682,8 +675,8 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
         -> case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
               -> vcat [
-                   text ".LC_" <> pprCLabel dflags lbl <> char ':',
-                   text "\t.quad" <+> pprCLabel dflags lbl ]
+                   text ".LC_" <> ppr_lbl lbl <> char ':',
+                   text "\t.quad" <+> ppr_lbl lbl ]
             _ -> empty
 
    _ | osElfTarget os
@@ -696,8 +689,8 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
 
                  in vcat [
                       text ".section \".got2\", \"aw\"",
-                      text ".LC_" <> pprCLabel dflags lbl <> char ':',
-                      ptext symbolSize <+> pprCLabel dflags lbl ]
+                      text ".LC_" <> ppr_lbl lbl <> char ':',
+                      ptext symbolSize <+> ppr_lbl lbl ]
 
             -- PLT code stubs are generated automatically by the dynamic linker.
             _ -> empty
@@ -705,8 +698,9 @@ pprImportedSymbol dflags config importedLbl = case (arch,os) of
    _ -> panic "PIC.pprImportedSymbol: no match"
  where
    platform = ncgPlatform config
-   arch     = platformArch platform
-   os       = platformOS   platform
+   ppr_lbl  = pprCLabel_NCG platform
+   arch     = platformArch  platform
+   os       = platformOS    platform
    pic      = ncgPIC config
 
 --------------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index ead3572a79..bdadaf49de 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -496,7 +496,8 @@ ghcInternalFunctions = do
 strCLabel_llvm :: CLabel -> LlvmM LMString
 strCLabel_llvm lbl = do
     dflags <- getDynFlags
-    let sdoc = pprCLabel dflags lbl
+    platform <- getPlatform
+    let sdoc = pprCLabel_LLVM platform lbl
         str = Outp.renderWithStyle
                   (initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle))
                   sdoc
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 13f5ca5dd4..39301cf41b 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -140,7 +140,7 @@ deSugar hsc_env
                           ; (ds_fords, foreign_prs) <- dsForeigns fords
                           ; ds_rules <- mapMaybeM dsRule rules
                           ; let hpc_init
-                                  | gopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info
+                                  | gopt Opt_Hpc dflags = hpcInitCode (hsc_dflags hsc_env) mod ds_hpc_info
                                   | otherwise = empty
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index b52b4ac209..fefbf2b707 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -1315,9 +1315,9 @@ static void hpc_init_Main(void)
  hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);}
 -}
 
-hpcInitCode :: Module -> HpcInfo -> SDoc
-hpcInitCode _ (NoHpcInfo {}) = Outputable.empty
-hpcInitCode this_mod (HpcInfo tickCount hashNo)
+hpcInitCode :: DynFlags -> Module -> HpcInfo -> SDoc
+hpcInitCode _ _ (NoHpcInfo {}) = Outputable.empty
+hpcInitCode dflags this_mod (HpcInfo tickCount hashNo)
  = vcat
     [ text "static void hpc_init_" <> ppr this_mod
          <> text "(void) __attribute__((constructor));"
@@ -1335,7 +1335,9 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
        ])
     ]
   where
-    tickboxes = ppr (mkHpcTicksLabel $ this_mod)
+    platform  = targetPlatform dflags
+    bcknd     = backend dflags
+    tickboxes = pprCLabel bcknd platform (mkHpcTicksLabel $ this_mod)
 
     module_name  = hcat (map (text.charToC) $ BS.unpack $
                          bytesFS (moduleNameFS (moduleName this_mod)))
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 268a1a6a16..1060043fbc 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -247,7 +247,7 @@ cgDataCon data_con
                        , rep_ty <- typePrimRep (scaledThing ty)
                        , not (isVoidRep rep_ty) ]
 
-        ; emitClosureAndInfoTable dyn_info_tbl NativeDirectCall [] $
+        ; emitClosureAndInfoTable platform dyn_info_tbl NativeDirectCall [] $
             -- NB: the closure pointer is assumed *untagged* on
             -- entry to a constructor.  If the pointer is tagged,
             -- then we should not be entering it.  This assumption
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 4fbdc4a153..28f2050f35 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -558,7 +558,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
   = do profile <- getProfile
        platform <- getPlatform
        let node = idToReg platform (NonVoid bndr)
-           slow_lbl = closureSlowEntryLabel  cl_info
+           slow_lbl = closureSlowEntryLabel  platform cl_info
            fast_lbl = closureLocalEntryLabel platform cl_info
            -- mkDirectJump does not clobber `Node' containing function closure
            jump = mkJump profile NativeNodeCall
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 98a15f0ef5..4e0e5b8ea3 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -785,16 +785,16 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 --   Label generation
 --------------------------------------
 
-staticClosureLabel :: ClosureInfo -> CLabel
-staticClosureLabel = toClosureLbl .  closureInfoLabel
+staticClosureLabel :: Platform -> ClosureInfo -> CLabel
+staticClosureLabel platform = toClosureLbl platform .  closureInfoLabel
 
-closureSlowEntryLabel :: ClosureInfo -> CLabel
-closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
+closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
+closureSlowEntryLabel platform = toSlowEntryLbl platform . closureInfoLabel
 
 closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
 closureLocalEntryLabel platform
-  | platformTablesNextToCode platform = toInfoLbl  . closureInfoLabel
-  | otherwise                         = toEntryLbl . closureInfoLabel
+  | platformTablesNextToCode platform = toInfoLbl  platform . closureInfoLabel
+  | otherwise                         = toEntryLbl platform . closureInfoLabel
 
 mkClosureInfoTableLabel :: Platform -> Id -> LambdaFormInfo -> CLabel
 mkClosureInfoTableLabel platform id lf_info
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 2edbdbf6c8..6c811ba9cc 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -333,17 +333,19 @@ entryHeapCheck :: ClosureInfo
                -> FCode ()
                -> FCode ()
 
-entryHeapCheck cl_info nodeSet arity args code
-  = entryHeapCheck' is_fastf node arity args code
-  where
+entryHeapCheck cl_info nodeSet arity args code = do
+  platform <- getPlatform
+  let
     node = case nodeSet of
               Just r  -> CmmReg (CmmLocal r)
-              Nothing -> CmmLit (CmmLabel $ staticClosureLabel cl_info)
+              Nothing -> CmmLit (CmmLabel $ staticClosureLabel platform cl_info)
 
     is_fastf = case closureFunInfo cl_info of
                  Just (_, ArgGen _) -> False
                  _otherwise         -> True
 
+  entryHeapCheck' is_fastf node arity args code
+
 -- | lower-level version for "GHC.Cmm.Parser"
 entryHeapCheck' :: Bool           -- is a known function pattern
                 -> CmmExpr        -- expression for the closure pointer
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 566e6666ad..9ba0b2cb6e 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -617,15 +617,15 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
               conv  = if nodeMustPointToIt profile lf_info then NativeNodeCall
                                                           else NativeDirectCall
               (offset, _, _) = mkCallEntry profile conv args' []
-        ; emitClosureAndInfoTable info_tbl conv args' $ body (offset, node, arg_regs)
+        ; emitClosureAndInfoTable (profilePlatform profile) info_tbl conv args' $ body (offset, node, arg_regs)
         }
 
 -- Data constructors need closures, but not with all the argument handling
 -- needed for functions. The shared part goes here.
-emitClosureAndInfoTable ::
-  CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
-emitClosureAndInfoTable info_tbl conv args body
+emitClosureAndInfoTable
+   :: Platform -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
+emitClosureAndInfoTable platform info_tbl conv args body
   = do { (_, blks) <- getCodeScoped body
-       ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)
+       ; let entry_lbl = toEntryLbl platform (cit_lbl info_tbl)
        ; emitProcWithConvention conv (Just info_tbl) entry_lbl args blks
        }