Implement unboxed sum primitive type
[ghc.git] / compiler / cmm / CLabel.hs
index 76d5e79..447eee8 100644 (file)
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 -----------------------------------------------------------------------------
 --
 -- Object-file symbols (called CLabel for histerical raisins).
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE CPP #-}
+
 module CLabel (
-       CLabel, -- abstract type
-       ForeignLabelSource(..),
-       pprDebugCLabel,
-
-       mkClosureLabel,
-       mkSRTLabel,
-       mkInfoTableLabel,
-       mkEntryLabel,
+        CLabel, -- abstract type
+        ForeignLabelSource(..),
+        pprDebugCLabel,
+
+        mkClosureLabel,
+        mkSRTLabel,
+        mkTopSRTLabel,
+        mkInfoTableLabel,
+        mkEntryLabel,
         mkSlowEntryLabel,
-       mkConEntryLabel,
-       mkStaticConEntryLabel,
-       mkRednCountsLabel,
-       mkConInfoTableLabel,
-       mkStaticInfoTableLabel,
-       mkLargeSRTLabel,
-       mkApEntryLabel,
-       mkApInfoTableLabel,
-       mkClosureTableLabel,
-
-       mkLocalClosureLabel,
-       mkLocalInfoTableLabel,
-       mkLocalEntryLabel,
-       mkLocalConEntryLabel,
-       mkLocalStaticConEntryLabel,
-       mkLocalConInfoTableLabel,
-       mkLocalStaticInfoTableLabel,
-       mkLocalClosureTableLabel,
-
-       mkReturnPtLabel,
-       mkReturnInfoLabel,
-       mkAltLabel,
-       mkDefaultLabel,
-       mkBitmapLabel,
-       mkStringLitLabel,
-
-       mkAsmTempLabel,
+        mkConEntryLabel,
+        mkStaticConEntryLabel,
+        mkRednCountsLabel,
+        mkConInfoTableLabel,
+        mkStaticInfoTableLabel,
+        mkLargeSRTLabel,
+        mkApEntryLabel,
+        mkApInfoTableLabel,
+        mkClosureTableLabel,
+
+        mkLocalClosureLabel,
+        mkLocalInfoTableLabel,
+        mkLocalEntryLabel,
+        mkLocalConEntryLabel,
+        mkLocalStaticConEntryLabel,
+        mkLocalConInfoTableLabel,
+        mkLocalStaticInfoTableLabel,
+        mkLocalClosureTableLabel,
+
+        mkReturnPtLabel,
+        mkReturnInfoLabel,
+        mkAltLabel,
+        mkDefaultLabel,
+        mkBitmapLabel,
+        mkStringLitLabel,
+
+        mkAsmTempLabel,
+        mkAsmTempDerivedLabel,
+        mkAsmTempEndLabel,
+        mkAsmTempDieLabel,
 
         mkPlainModuleInitLabel,
 
-       mkSplitMarkerLabel,
-       mkDirty_MUT_VAR_Label,
-       mkUpdInfoLabel,
-       mkBHUpdInfoLabel,
-       mkIndStaticInfoLabel,
+        mkSplitMarkerLabel,
+        mkDirty_MUT_VAR_Label,
+        mkUpdInfoLabel,
+        mkBHUpdInfoLabel,
+        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
-       mkMAP_FROZEN_infoLabel,
-       mkMAP_DIRTY_infoLabel,
+        mkMAP_FROZEN_infoLabel,
+        mkMAP_FROZEN0_infoLabel,
+        mkMAP_DIRTY_infoLabel,
+        mkSMAP_FROZEN_infoLabel,
+        mkSMAP_FROZEN0_infoLabel,
+        mkSMAP_DIRTY_infoLabel,
         mkEMPTY_MVAR_infoLabel,
+        mkArrWords_infoLabel,
+        mkRUBBISH_ENTRY_infoLabel,
 
-       mkTopTickyCtrLabel,
+        mkTopTickyCtrLabel,
         mkCAFBlackHoleInfoTableLabel,
         mkCAFBlackHoleEntryLabel,
-       mkRtsPrimOpLabel,
-       mkRtsSlowTickyCtrLabel,
+        mkRtsPrimOpLabel,
+        mkRtsSlowFastTickyCtrLabel,
 
         mkSelectorInfoLabel,
-       mkSelectorEntryLabel,
+        mkSelectorEntryLabel,
 
-       mkCmmInfoLabel,
-       mkCmmEntryLabel,
-       mkCmmRetInfoLabel,
-       mkCmmRetLabel,
-       mkCmmCodeLabel,
-       mkCmmDataLabel,
-       mkCmmGcPtrLabel,
+        mkCmmInfoLabel,
+        mkCmmEntryLabel,
+        mkCmmRetInfoLabel,
+        mkCmmRetLabel,
+        mkCmmCodeLabel,
+        mkCmmDataLabel,
+        mkCmmClosureLabel,
 
-       mkRtsApFastLabel,
+        mkRtsApFastLabel,
 
         mkPrimCallLabel,
 
-       mkForeignLabel,
+        mkForeignLabel,
         addLabelSize,
-        foreignLabelStdcallInfo,
 
-       mkCCLabel, mkCCSLabel,
+        foreignLabelStdcallInfo,
+        isForeignLabel,
+        mkCCLabel, mkCCSLabel,
 
         DynamicLinkerLabelInfo(..),
         mkDynamicLinkerLabel,
         dynamicLinkerLabelInfo,
-        
+
         mkPicBaseLabel,
         mkDeadStripPreventer,
 
         mkHpcTicksLabel,
 
         hasCAF,
-        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        needsCDecl, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
-       isCFunctionLabel, isGcPtrLabel, labelDynamic,
+        isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
         -- * Conversions
-        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
+        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName,
 
         pprCLabel
     ) where
@@ -113,12 +119,8 @@ module CLabel (
 #include "HsVersions.h"
 
 import IdInfo
-import StaticFlags
 import BasicTypes
-import Literal
 import Packages
-import DataCon
-import PackageConfig
 import Module
 import Name
 import Unique
@@ -130,6 +132,8 @@ import FastString
 import DynFlags
 import Platform
 import UniqSet
+import Util
+import PprCore ( {- instances -} )
 
 -- -----------------------------------------------------------------------------
 -- The CLabel type
@@ -158,67 +162,71 @@ import UniqSet
 
 data CLabel
   = -- | A label related to the definition of a particular Id or Con in a .hs file.
-    IdLabel                    
-       Name                    
+    IdLabel
+        Name
         CafInfo
-       IdLabelInfo             -- encodes the suffix of the label
-  
+        IdLabelInfo             -- encodes the suffix of the label
+
   -- | A label from a .cmm file that is not associated with a .hs level Id.
-  | CmmLabel                   
-       PackageId               -- what package the label belongs to.
-       FastString              -- identifier giving the prefix of the label
-       CmmLabelInfo            -- encodes the suffix of the label
+  | CmmLabel
+        UnitId               -- what package the label belongs to.
+        FastString              -- identifier giving the prefix of the label
+        CmmLabelInfo            -- encodes the suffix of the label
 
   -- | A label with a baked-in \/ algorithmically generated name that definitely
   --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
-  --    If it doesn't have an algorithmically generated name then use a CmmLabel 
-  --    instead and give it an appropriate PackageId argument.
-  | RtsLabel                   
-       RtsLabelInfo
+  --    If it doesn't have an algorithmically generated name then use a CmmLabel
+  --    instead and give it an appropriate UnitId argument.
+  | RtsLabel
+        RtsLabelInfo
 
   -- | A 'C' (or otherwise foreign) label.
   --
-  | ForeignLabel 
-       FastString              -- name of the imported label.
+  | ForeignLabel
+        FastString              -- name of the imported label.
+
+        (Maybe Int)             -- possible '@n' suffix for stdcall functions
+                                -- When generating C, the '@n' suffix is omitted, but when
+                                -- generating assembler we must add it to the label.
 
-        (Maybe Int)            -- possible '@n' suffix for stdcall functions
-                               -- When generating C, the '@n' suffix is omitted, but when
-                               -- generating assembler we must add it to the label.
+        ForeignLabelSource      -- what package the foreign label is in.
 
-       ForeignLabelSource      -- what package the foreign label is in.
-       
         FunctionOrData
 
   -- | A family of labels related to a particular case expression.
-  | CaseLabel                  
-       {-# UNPACK #-} !Unique  -- Unique says which case expression
-       CaseLabelInfo
+  | CaseLabel
+        {-# UNPACK #-} !Unique  -- Unique says which case expression
+        CaseLabelInfo
 
-  | AsmTempLabel 
-       {-# UNPACK #-} !Unique
+  | AsmTempLabel
+        {-# UNPACK #-} !Unique
+
+  | AsmTempDerivedLabel
+        CLabel
+        FastString              -- suffix
 
   | StringLitLabel
-       {-# UNPACK #-} !Unique
+        {-# UNPACK #-} !Unique
 
   | PlainModuleInitLabel        -- without the version & way info
-       Module
+        Module
 
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack
 
-    
-  -- | These labels are generated and used inside the NCG only. 
-  --   They are special variants of a label used for dynamic linking
+
+  -- | 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.
   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
-  -- | This label is generated and used inside the NCG only. 
-  --   It is used as a base for PIC calculations on some platforms.
-  --    It takes the form of a local numeric assembler label '1'; and 
+
+  -- | This label is generated and used inside the NCG only.
+  --    It is used as a base for PIC calculations on some platforms.
+  --    It takes the form of a local numeric assembler label '1'; and
   --    is pretty-printed as 1b, referring to the previous definition
   --    of 1: in the assembler source file.
-  | PicBaseLabel                
+  | PicBaseLabel
+
   -- | A label before an info table to prevent excessive dead-stripping on darwin
   | DeadStripPreventer CLabel
 
@@ -226,6 +234,9 @@ data CLabel
   -- | Per-module table of tick locations
   | HpcTicksLabel Module
 
+  -- | Static reference table
+  | SRTLabel !Unique
+
   -- | Label of an StgLargeSRT
   | LargeSRTLabel
         {-# UNPACK #-} !Unique
@@ -234,62 +245,143 @@ data CLabel
   | LargeBitmapLabel
         {-# UNPACK #-} !Unique
 
-  deriving (Eq, Ord)
-
+  deriving Eq
+
+-- This is laborious, but necessary. We can't derive Ord because
+-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
+-- implementation. See Note [No Ord for Unique]
+-- This is non-deterministic but we do not currently support deterministic
+-- code-generation. See Note [Unique Determinism and code generation]
+instance Ord CLabel where
+  compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
+    compare a1 a2 `thenCmp`
+    compare b1 b2 `thenCmp`
+    compare c1 c2
+  compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =
+    compare a1 a2 `thenCmp`
+    compare b1 b2 `thenCmp`
+    compare c1 c2
+  compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
+  compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
+    compare a1 a2 `thenCmp`
+    compare b1 b2 `thenCmp`
+    compare c1 c2 `thenCmp`
+    compare d1 d2
+  compare (CaseLabel u1 a1) (CaseLabel u2 a2) =
+    nonDetCmpUnique u1 u2 `thenCmp`
+    compare a1 a2
+  compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
+  compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
+    compare a1 a2 `thenCmp`
+    compare b1 b2
+  compare (StringLitLabel u1) (StringLitLabel u2) =
+    nonDetCmpUnique u1 u2
+  compare (PlainModuleInitLabel a1) (PlainModuleInitLabel a2) =
+    compare a1 a2
+  compare (CC_Label a1) (CC_Label a2) =
+    compare a1 a2
+  compare (CCS_Label a1) (CCS_Label a2) =
+    compare a1 a2
+  compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
+    compare a1 a2 `thenCmp`
+    compare b1 b2
+  compare PicBaseLabel PicBaseLabel = EQ
+  compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
+    compare a1 a2
+  compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
+    compare a1 a2
+  compare (SRTLabel u1) (SRTLabel u2) =
+    nonDetCmpUnique u1 u2
+  compare (LargeSRTLabel u1) (LargeSRTLabel u2) =
+    nonDetCmpUnique u1 u2
+  compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
+    nonDetCmpUnique u1 u2
+  compare IdLabel{} _ = LT
+  compare _ IdLabel{} = GT
+  compare CmmLabel{} _ = LT
+  compare _ CmmLabel{} = GT
+  compare RtsLabel{} _ = LT
+  compare _ RtsLabel{} = GT
+  compare ForeignLabel{} _ = LT
+  compare _ ForeignLabel{} = GT
+  compare CaseLabel{} _ = LT
+  compare _ CaseLabel{} = GT
+  compare AsmTempLabel{} _ = LT
+  compare _ AsmTempLabel{} = GT
+  compare AsmTempDerivedLabel{} _ = LT
+  compare _ AsmTempDerivedLabel{} = GT
+  compare StringLitLabel{} _ = LT
+  compare _ StringLitLabel{} = GT
+  compare PlainModuleInitLabel{} _ = LT
+  compare _ PlainModuleInitLabel{} = GT
+  compare CC_Label{} _ = LT
+  compare _ CC_Label{} = GT
+  compare CCS_Label{} _ = LT
+  compare _ CCS_Label{} = GT
+  compare DynamicLinkerLabel{} _ = LT
+  compare _ DynamicLinkerLabel{} = GT
+  compare PicBaseLabel{} _ = LT
+  compare _ PicBaseLabel{} = GT
+  compare DeadStripPreventer{} _ = LT
+  compare _ DeadStripPreventer{} = GT
+  compare HpcTicksLabel{} _ = LT
+  compare _ HpcTicksLabel{} = GT
+  compare SRTLabel{} _ = LT
+  compare _ SRTLabel{} = GT
+  compare LargeSRTLabel{} _ = LT
+  compare _ LargeSRTLabel{} = GT
 
 -- | Record where a foreign label is stored.
 data ForeignLabelSource
 
    -- | Label is in a named package
-   = ForeignLabelInPackage     PackageId
-  
+   = ForeignLabelInPackage      UnitId
+
    -- | Label is in some external, system package that doesn't also
-   --  contain compiled Haskell code, and is not associated with any .hi files.
-   --  We don't have to worry about Haskell code being inlined from
-   --  external packages. It is safe to treat the RTS package as "external".
-   | ForeignLabelInExternalPackage 
+   --   contain compiled Haskell code, and is not associated with any .hi files.
+   --   We don't have to worry about Haskell code being inlined from
+   --   external packages. It is safe to treat the RTS package as "external".
+   | ForeignLabelInExternalPackage
 
    -- | Label is in the package currenly being compiled.
-   --  This is only used for creating hacky tmp labels during code generation.
-   --  Don't use it in any code that might be inlined across a package boundary
-   --  (ie, core code) else the information will be wrong relative to the
-   --  destination module.
+   --   This is only used for creating hacky tmp labels during code generation.
+   --   Don't use it in any code that might be inlined across a package boundary
+   --   (ie, core code) else the information will be wrong relative to the
+   --   destination module.
    | ForeignLabelInThisPackage
-      
-   deriving (Eq, Ord)   
+
+   deriving (Eq, Ord)
 
 
 -- | For debugging problems with the CLabel representation.
---     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.
+--      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
  = case lbl of
-       IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
-       CmmLabel pkg name _info 
-        -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
-
-       RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
+        IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
+        CmmLabel pkg _name _info
+         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
-       ForeignLabel name mSuffix src funOrData
-        -> ppr lbl <> (parens 
-                               $ text "ForeignLabel" 
-                               <+> ppr mSuffix
-                               <+> ppr src  
-                               <+> ppr funOrData)
+        RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
 
-       _               -> ppr lbl <> (parens $ text "other CLabel)")
+        ForeignLabel _name mSuffix src funOrData
+            -> ppr lbl <> (parens $ text "ForeignLabel"
+                                <+> ppr mSuffix
+                                <+> ppr src
+                                <+> ppr funOrData)
 
+        _               -> ppr lbl <> (parens $ text "other CLabel)")
 
--- True if a local IdLabel that we won't mark as exported
-type IsLocal = Bool
 
 data IdLabelInfo
-  = Closure            -- ^ Label for closure
-  | SRT                 -- ^ Static reference table
+  = Closure             -- ^ Label for closure
+  | SRT                 -- ^ Static reference table (TODO: could be removed
+                        -- with the old code generator, but might be needed
+                        -- when we implement the New SRT Plan)
   | InfoTable           -- ^ Info tables for closures; always read-only
-  | Entry              -- ^ Entry point
+  | Entry               -- ^ Entry point
   | Slow                -- ^ Slow entry point
 
   | LocalInfoTable      -- ^ Like InfoTable but not externally visible
@@ -297,12 +389,12 @@ data IdLabelInfo
 
   | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id
 
-  | ConEntry           -- ^ Constructor entry point
-  | ConInfoTable       -- ^ Corresponding info table
-  | StaticConEntry     -- ^ Static constructor entry point
-  | StaticInfoTable    -- ^ Corresponding info table
+  | ConEntry            -- ^ Constructor entry point
+  | ConInfoTable        -- ^ Corresponding info table
+  | StaticConEntry      -- ^ Static constructor entry point
+  | StaticInfoTable     -- ^ Corresponding info table
 
-  | ClosureTable       -- ^ Table of closures for Enum tycons
+  | ClosureTable        -- ^ Table of closures for Enum tycons
 
   deriving (Eq, Ord)
 
@@ -323,8 +415,8 @@ data RtsLabelInfo
   | RtsApEntry           Bool{-updatable-} Int{-arity-}
 
   | RtsPrimOp PrimOp
-  | RtsApFast    FastString    -- ^ _fast versions of generic apply
-  | RtsSlowTickyCtr String
+  | RtsApFast     FastString    -- ^ _fast versions of generic apply
+  | RtsSlowFastTickyCtr String
 
   deriving (Eq, Ord)
   -- NOTE: Eq on LitString compares the pointer only, so this isn't
@@ -332,112 +424,153 @@ data RtsLabelInfo
 
 
 -- | What type of Cmm label we're dealing with.
---     Determines the suffix appended to the name when a CLabel.CmmLabel
---     is pretty printed.
+--      Determines the suffix appended to the name when a CLabel.CmmLabel
+--      is pretty printed.
 data CmmLabelInfo
-  = CmmInfo                    -- ^ misc rts info tabless,     suffix _info
-  | CmmEntry                   -- ^ misc rts entry points,     suffix _entry
-  | CmmRetInfo                 -- ^ misc rts ret info tables,  suffix _info
-  | CmmRet                     -- ^ misc rts return points,    suffix _ret
-  | CmmData                    -- ^ misc rts data bits, eg CHARLIKE_closure
-  | CmmCode                    -- ^ misc rts code
-  | CmmGcPtr                   -- ^ GcPtrs eg CHARLIKE_closure  
-  | CmmPrimCall                        -- ^ a prim call to some hand written Cmm code
+  = CmmInfo                     -- ^ misc rts info tabless,     suffix _info
+  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
+  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
+  | CmmRet                      -- ^ misc rts return points,    suffix _ret
+  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
+  | CmmCode                     -- ^ misc rts code
+  | CmmClosure                  -- ^ closures eg CHARLIKE_closure
+  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
   deriving (Eq, Ord)
 
 data DynamicLinkerLabelInfo
-  = CodeStub                   -- MachO: Lfoo$stub, ELF: foo@plt
-  | SymbolPtr                  -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
-  | GotSymbolPtr               -- ELF: foo@got
-  | GotSymbolOffset            -- ELF: foo@gotoff
-  
+  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
+  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
+  | GotSymbolPtr                -- ELF: foo@got
+  | GotSymbolOffset             -- ELF: foo@gotoff
+
   deriving (Eq, Ord)
+
 
 -- -----------------------------------------------------------------------------
 -- Constructing CLabels
 -- -----------------------------------------------------------------------------
 
--- Constructing IdLabels 
+-- Constructing IdLabels
 -- These are always local:
-mkSlowEntryLabel       name c         = IdLabel name  c Slow
+mkSlowEntryLabel :: Name -> CafInfo -> CLabel
+mkSlowEntryLabel        name c         = IdLabel name  c Slow
+
+mkTopSRTLabel     :: Unique -> CLabel
+mkTopSRTLabel u = SRTLabel u
 
-mkSRTLabel             name c  = IdLabel name  c SRT
-mkRednCountsLabel      name c  = IdLabel name  c RednCounts
+mkSRTLabel        :: Name -> CafInfo -> CLabel
+mkRednCountsLabel :: Name -> CLabel
+mkSRTLabel              name c  = IdLabel name  c SRT
+mkRednCountsLabel       name    =
+  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
 
 -- These have local & (possibly) external variants:
-mkLocalClosureLabel    name c  = IdLabel name  c Closure
+mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
+mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
+mkLocalEntryLabel        :: Name -> CafInfo -> CLabel
+mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
+mkLocalClosureLabel     name c  = IdLabel name  c Closure
 mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
 mkLocalEntryLabel       name c  = IdLabel name  c LocalEntry
 mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
 
+mkClosureLabel              :: Name -> CafInfo -> CLabel
+mkInfoTableLabel            :: Name -> CafInfo -> CLabel
+mkEntryLabel                :: Name -> CafInfo -> CLabel
+mkClosureTableLabel         :: Name -> CafInfo -> CLabel
+mkLocalConInfoTableLabel    :: CafInfo -> Name -> CLabel
+mkLocalConEntryLabel        :: CafInfo -> Name -> CLabel
+mkLocalStaticInfoTableLabel :: CafInfo -> Name -> CLabel
+mkLocalStaticConEntryLabel  :: CafInfo -> Name -> CLabel
+mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
+mkStaticInfoTableLabel      :: Name -> CafInfo -> CLabel
 mkClosureLabel name         c     = IdLabel name c Closure
 mkInfoTableLabel name       c     = IdLabel name c InfoTable
 mkEntryLabel name           c     = IdLabel name c Entry
 mkClosureTableLabel name    c     = IdLabel name c ClosureTable
 mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
-mkLocalConEntryLabel       c con = IdLabel con c ConEntry
+mkLocalConEntryLabel        c con = IdLabel con c ConEntry
 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
 mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
 mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
 mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
 
+mkConEntryLabel       :: Name -> CafInfo -> CLabel
+mkStaticConEntryLabel :: Name -> CafInfo -> CLabel
 mkConEntryLabel name        c     = IdLabel name c ConEntry
 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 
 -- Constructing Cmm Labels
-mkSplitMarkerLabel             = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
-mkDirty_MUT_VAR_Label          = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")         CmmCode
-mkUpdInfoLabel                 = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
-mkBHUpdInfoLabel               = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
-mkIndStaticInfoLabel           = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
-mkMainCapabilityLabel          = CmmLabel rtsPackageId (fsLit "MainCapability")        CmmData
-mkMAP_FROZEN_infoLabel         = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel         = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")        CmmInfo
-mkTopTickyCtrLabel             = CmmLabel rtsPackageId (fsLit "top_ct")                CmmData
-mkCAFBlackHoleInfoTableLabel   = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
-mkCAFBlackHoleEntryLabel       = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
+mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
+    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
+    mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
+    mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
+    mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
+    mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
+    mkSMAP_DIRTY_infoLabel, mkRUBBISH_ENTRY_infoLabel :: CLabel
+mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
+mkSplitMarkerLabel              = CmmLabel rtsUnitId (fsLit "__stg_split_marker")    CmmCode
+mkUpdInfoLabel                  = CmmLabel rtsUnitId (fsLit "stg_upd_frame")         CmmInfo
+mkBHUpdInfoLabel                = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" )     CmmInfo
+mkIndStaticInfoLabel            = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC")        CmmInfo
+mkMainCapabilityLabel           = CmmLabel rtsUnitId (fsLit "MainCapability")        CmmData
+mkMAP_FROZEN_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
+mkMAP_FROZEN0_infoLabel         = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkEMPTY_MVAR_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_EMPTY_MVAR")        CmmInfo
+mkTopTickyCtrLabel              = CmmLabel rtsUnitId (fsLit "top_ct")                CmmData
+mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
+mkCAFBlackHoleEntryLabel        = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
+mkArrWords_infoLabel            = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS")         CmmInfo
+mkSMAP_FROZEN_infoLabel         = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
+mkSMAP_FROZEN0_infoLabel        = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkRUBBISH_ENTRY_infoLabel       = CmmLabel rtsUnitId (fsLit "stg_RUBBISH_ENTRY")     CmmInfo
 
 -----
 mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
-  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
-       :: PackageId -> FastString -> CLabel
+  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel
+        :: UnitId -> FastString -> CLabel
 
-mkCmmInfoLabel      pkg str    = CmmLabel pkg str CmmInfo
-mkCmmEntryLabel     pkg str    = CmmLabel pkg str CmmEntry
-mkCmmRetInfoLabel   pkg str    = CmmLabel pkg str CmmRetInfo
-mkCmmRetLabel       pkg str    = CmmLabel pkg str CmmRet
-mkCmmCodeLabel      pkg str    = CmmLabel pkg str CmmCode
-mkCmmDataLabel      pkg str    = CmmLabel pkg str CmmData
-mkCmmGcPtrLabel     pkg str    = CmmLabel pkg str CmmGcPtr
+mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
+mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
+mkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo
+mkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet
+mkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode
+mkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData
+mkCmmClosureLabel   pkg str     = CmmLabel pkg str CmmClosure
 
 
 -- Constructing RtsLabels
-mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
+mkRtsPrimOpLabel :: PrimOp -> CLabel
+mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 
-mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off   = RtsLabel (RtsSelectorEntry     upd off)
+mkSelectorInfoLabel  :: Bool -> Int -> CLabel
+mkSelectorEntryLabel :: Bool -> Int -> CLabel
+mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
+mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
 
-mkApInfoTableLabel   upd off   = RtsLabel (RtsApInfoTable       upd off)
-mkApEntryLabel       upd off   = RtsLabel (RtsApEntry           upd off)
+mkApInfoTableLabel :: Bool -> Int -> CLabel
+mkApEntryLabel     :: Bool -> Int -> CLabel
+mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
+mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
 
 
 -- A call to some primitive hand written Cmm code
 mkPrimCallLabel :: PrimCall -> CLabel
-mkPrimCallLabel (PrimCall str pkg)  
-       = CmmLabel pkg str CmmPrimCall
+mkPrimCallLabel (PrimCall str pkg)
+        = CmmLabel pkg str CmmPrimCall
 
 
 -- Constructing ForeignLabels
 
 -- | Make a foreign label
-mkForeignLabel 
-       :: FastString           -- name
-       -> Maybe Int            -- size prefix
-       -> ForeignLabelSource   -- what package it's in
-       -> FunctionOrData       
-       -> CLabel
+mkForeignLabel
+        :: FastString           -- name
+        -> Maybe Int            -- size prefix
+        -> ForeignLabelSource   -- what package it's in
+        -> FunctionOrData
+        -> CLabel
 
 mkForeignLabel str mb_sz src fod
     = ForeignLabel str mb_sz src  fod
@@ -450,6 +583,11 @@ addLabelSize (ForeignLabel str _ src  fod) sz
 addLabelSize label _
     = label
 
+-- | Whether label is a non-haskell label (defined in C code)
+isForeignLabel :: CLabel -> Bool
+isForeignLabel (ForeignLabel _ _ _ _) = True
+isForeignLabel _lbl = False
+
 -- | Get the label size field from a ForeignLabel
 foreignLabelStdcallInfo :: CLabel -> Maybe Int
 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
@@ -457,69 +595,86 @@ foreignLabelStdcallInfo _lbl = Nothing
 
 
 -- Constructing Large*Labels
-mkLargeSRTLabel        uniq            = LargeSRTLabel uniq
-mkBitmapLabel  uniq            = LargeBitmapLabel uniq
+mkLargeSRTLabel :: Unique -> CLabel
+mkBitmapLabel   :: Unique -> CLabel
+mkLargeSRTLabel uniq            = LargeSRTLabel uniq
+mkBitmapLabel   uniq            = LargeBitmapLabel uniq
 
 
 -- Constructin CaseLabels
-mkReturnPtLabel uniq           = CaseLabel uniq CaseReturnPt
-mkReturnInfoLabel uniq         = CaseLabel uniq CaseReturnInfo
-mkAltLabel      uniq tag       = CaseLabel uniq (CaseAlt tag)
-mkDefaultLabel  uniq           = CaseLabel uniq CaseDefault
+mkReturnPtLabel   :: Unique -> CLabel
+mkReturnInfoLabel :: Unique -> CLabel
+mkAltLabel        :: Unique -> ConTag -> CLabel
+mkDefaultLabel    :: Unique -> CLabel
+mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
+mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
+mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
+mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 
 -- Constructing Cost Center Labels
-mkCCLabel          cc          = CC_Label cc
-mkCCSLabel         ccs         = CCS_Label ccs
+mkCCLabel  :: CostCentre      -> CLabel
+mkCCSLabel :: CostCentreStack -> CLabel
+mkCCLabel           cc          = CC_Label cc
+mkCCSLabel          ccs         = CCS_Label ccs
 
+mkRtsApFastLabel :: FastString -> CLabel
 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 
-mkRtsSlowTickyCtrLabel :: String -> CLabel
-mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
+mkRtsSlowFastTickyCtrLabel :: String -> CLabel
+mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
 
 
 -- Constructing Code Coverage Labels
+mkHpcTicksLabel :: Module -> CLabel
 mkHpcTicksLabel                = HpcTicksLabel
 
 
 -- Constructing labels used for dynamic linking
 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
-mkDynamicLinkerLabel           = DynamicLinkerLabel
+mkDynamicLinkerLabel            = DynamicLinkerLabel
 
 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
-dynamicLinkerLabelInfo _       = Nothing
-    
+dynamicLinkerLabelInfo _        = Nothing
+
 mkPicBaseLabel :: CLabel
-mkPicBaseLabel                         = PicBaseLabel
+mkPicBaseLabel                  = PicBaseLabel
 
 
 -- Constructing miscellaneous other labels
 mkDeadStripPreventer :: CLabel -> CLabel
-mkDeadStripPreventer lbl       = DeadStripPreventer lbl
+mkDeadStripPreventer lbl        = DeadStripPreventer lbl
 
 mkStringLitLabel :: Unique -> CLabel
-mkStringLitLabel               = StringLitLabel
+mkStringLitLabel                = StringLitLabel
 
 mkAsmTempLabel :: Uniquable a => a -> CLabel
-mkAsmTempLabel a               = AsmTempLabel (getUnique a)
+mkAsmTempLabel a                = AsmTempLabel (getUnique a)
+
+mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
+mkAsmTempDerivedLabel = AsmTempDerivedLabel
 
+mkAsmTempEndLabel :: CLabel -> CLabel
+mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
 mkPlainModuleInitLabel :: Module -> CLabel
-mkPlainModuleInitLabel mod     = PlainModuleInitLabel mod
+mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
+
+-- | Construct a label for a DWARF Debug Information Entity (DIE)
+-- describing another symbol.
+mkAsmTempDieLabel :: CLabel -> CLabel
+mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
 
 -- -----------------------------------------------------------------------------
 -- Convert between different kinds of label
 
 toClosureLbl :: CLabel -> CLabel
 toClosureLbl (IdLabel n c _) = IdLabel n c Closure
-toClosureLbl l = pprPanic "toClosureLbl" (pprCLabel l)
+toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
+toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
 
 toSlowEntryLbl :: CLabel -> CLabel
 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
-toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (pprCLabel l)
-
-toRednCountsLbl :: CLabel -> CLabel
-toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
-toRednCountsLbl l = pprPanic "toRednCountsLbl" (pprCLabel l)
+toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
 
 toEntryLbl :: CLabel -> CLabel
 toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
@@ -529,7 +684,7 @@ toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
 toEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
 toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
 toEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
-toEntryLbl l = pprPanic "toEntryLbl" (pprCLabel l)
+toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
 
 toInfoLbl :: CLabel -> CLabel
 toInfoLbl (IdLabel n c Entry)          = IdLabel n c InfoTable
@@ -540,14 +695,40 @@ toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
 toInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
 toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
 toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
-toInfoLbl l = pprPanic "CLabel.toInfoLbl" (pprCLabel l)
+toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
+
+toRednCountsLbl :: CLabel -> Maybe CLabel
+toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName
+
+hasHaskellName :: CLabel -> Maybe Name
+hasHaskellName (IdLabel n _ _) = Just n
+hasHaskellName _               = Nothing
 
 -- -----------------------------------------------------------------------------
--- Does a CLabel refer to a CAF?
+-- Does a CLabel's referent itself refer to a CAF?
 hasCAF :: CLabel -> Bool
+hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
 hasCAF (IdLabel _ MayHaveCafRefs _) = True
 hasCAF _                            = False
 
+-- Note [ticky for LNE]
+-- ~~~~~~~~~~~~~~~~~~~~~
+
+-- Until 14 Feb 2013, every ticky counter was associated with a
+-- closure. Thus, ticky labels used IdLabel. It is odd that
+-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
+-- reason to add the name to the CAFEnv (and thus eventually the SRT),
+-- but it was harmless because the ticky was only used if the closure
+-- was also.
+--
+-- Since we now have ticky counters for LNEs, it is no longer the case
+-- that every ticky counter has an actual closure. So I changed the
+-- generation of ticky counters' CLabels to not result in their
+-- associated id ending up in the SRT.
+--
+-- NB IdLabel is still appropriate for ticky ids (as opposed to
+-- CmmLabel) because the LNE's counter is still related to an .hs Id,
+-- that Id just isn't for a proper closure.
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
@@ -556,54 +737,52 @@ hasCAF _                            = False
 
 needsCDecl :: CLabel -> Bool
   -- False <=> it's pre-declared; don't bother
-  -- don't bother declaring SRT & Bitmap labels, we always make sure
+  -- don't bother declaring Bitmap labels, we always make sure
   -- they are defined before use.
-needsCDecl (IdLabel _ _ SRT)           = False
-needsCDecl (LargeSRTLabel _)           = False
-needsCDecl (LargeBitmapLabel _)                = False
-needsCDecl (IdLabel _ _ _)             = True
-needsCDecl (CaseLabel _ _)             = True
+needsCDecl (SRTLabel _)                 = True
+needsCDecl (LargeSRTLabel _)            = False
+needsCDecl (LargeBitmapLabel _)         = False
+needsCDecl (IdLabel _ _ _)              = True
+needsCDecl (CaseLabel _ _)              = True
 needsCDecl (PlainModuleInitLabel _)     = True
 
-needsCDecl (StringLitLabel _)          = False
-needsCDecl (AsmTempLabel _)            = False
-needsCDecl (RtsLabel _)                        = False
-
-needsCDecl (CmmLabel pkgId _ _)                
-       -- Prototypes for labels defined in the runtime system are imported
-       --      into HC files via includes/Stg.h.
-       | pkgId == rtsPackageId         = False
-       
-       -- For other labels we inline one into the HC file directly.
-       | otherwise                     = True
-
-needsCDecl l@(ForeignLabel{})          = not (isMathFun l)
-needsCDecl (CC_Label _)                        = True
-needsCDecl (CCS_Label _)               = True
-needsCDecl (HpcTicksLabel _)            = True
+needsCDecl (StringLitLabel _)           = False
+needsCDecl (AsmTempLabel _)             = False
+needsCDecl (AsmTempDerivedLabel _ _)    = False
+needsCDecl (RtsLabel _)                 = False
 
+needsCDecl (CmmLabel pkgId _ _)
+        -- Prototypes for labels defined in the runtime system are imported
+        --      into HC files via includes/Stg.h.
+        | pkgId == rtsUnitId         = False
 
--- | Check whether a label is a local temporary for native code generation
-isAsmTemp  :: CLabel -> Bool    
-isAsmTemp (AsmTempLabel _)             = True
-isAsmTemp _                            = False
+        -- For other labels we inline one into the HC file directly.
+        | otherwise                     = True
 
+needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
+needsCDecl (CC_Label _)                 = True
+needsCDecl (CCS_Label _)                = True
+needsCDecl (HpcTicksLabel _)            = True
+needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
+needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
+needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
 
 -- | If a label is a local temporary used for native code generation
 --      then return just its unique, otherwise nothing.
 maybeAsmTemp :: CLabel -> Maybe Unique
-maybeAsmTemp (AsmTempLabel uq)                 = Just uq
-maybeAsmTemp _                                 = Nothing
+maybeAsmTemp (AsmTempLabel uq)          = Just uq
+maybeAsmTemp _                          = Nothing
 
 
--- | Check whether a label corresponds to a C function that has 
+-- | Check whether a label corresponds to a C function that has
 --      a prototype in a system header somehere, or is built-in
 --      to the C compiler. For these labels we avoid generating our
 --      own C prototypes.
 isMathFun :: CLabel -> Bool
-isMathFun (ForeignLabel fs _ _ _)      = fs `elementOfUniqSet` math_funs
+isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
 isMathFun _ = False
 
+math_funs :: UniqSet FastString
 math_funs = mkUniqSet [
         -- _ISOC99_SOURCE
         (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
@@ -686,24 +865,28 @@ math_funs = mkUniqSet [
 
 -- -----------------------------------------------------------------------------
 -- | Is a CLabel visible outside this object file or not?
---     From the point of view of the code generator, a name is
---     externally visible if it has to be declared as exported
---     in the .o file's symbol table; that is, made non-static.
+--      From the point of view of the code generator, a name is
+--      externally visible if it has to be declared as exported
+--      in the .o file's symbol table; that is, made non-static.
 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
-externallyVisibleCLabel (CaseLabel _ _)                = False
-externallyVisibleCLabel (StringLitLabel _)     = False
-externallyVisibleCLabel (AsmTempLabel _)       = False
+externallyVisibleCLabel (CaseLabel _ _)         = False
+externallyVisibleCLabel (StringLitLabel _)      = False
+externallyVisibleCLabel (AsmTempLabel _)        = False
+externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel _)            = True
-externallyVisibleCLabel (CmmLabel _ _ _)       = True
-externallyVisibleCLabel (ForeignLabel{})       = True
-externallyVisibleCLabel (IdLabel name _ info)  = isExternalName name && externallyVisibleIdLabel info
-externallyVisibleCLabel (CC_Label _)           = True
-externallyVisibleCLabel (CCS_Label _)          = True
+externallyVisibleCLabel (CmmLabel _ _ _)        = True
+externallyVisibleCLabel (ForeignLabel{})        = True
+externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
+externallyVisibleCLabel (CC_Label _)            = True
+externallyVisibleCLabel (CCS_Label _)           = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
-externallyVisibleCLabel (HpcTicksLabel _)      = True
+externallyVisibleCLabel (HpcTicksLabel _)       = True
 externallyVisibleCLabel (LargeBitmapLabel _)    = False
-externallyVisibleCLabel (LargeSRTLabel _)      = False
+externallyVisibleCLabel (SRTLabel _)            = False
+externallyVisibleCLabel (LargeSRTLabel _)       = False
+externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
+externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
 
 externallyVisibleIdLabel :: IdLabelInfo -> Bool
 externallyVisibleIdLabel SRT             = False
@@ -712,48 +895,51 @@ externallyVisibleIdLabel LocalEntry      = False
 externallyVisibleIdLabel _               = True
 
 -- -----------------------------------------------------------------------------
--- Finding the "type" of a CLabel 
+-- Finding the "type" of a CLabel
 
 -- For generating correct types in label declarations:
 
 data CLabelType
-  = CodeLabel  -- Address of some executable instructions
-  | DataLabel  -- Address of data, not a GC ptr
-  | GcPtrLabel -- Address of a (presumably static) GC object
+  = CodeLabel   -- Address of some executable instructions
+  | DataLabel   -- Address of data, not a GC ptr
+  | GcPtrLabel  -- Address of a (presumably static) GC object
 
 isCFunctionLabel :: CLabel -> Bool
 isCFunctionLabel lbl = case labelType lbl of
-                       CodeLabel -> True
-                       _other    -> False
+                        CodeLabel -> True
+                        _other    -> False
 
 isGcPtrLabel :: CLabel -> Bool
 isGcPtrLabel lbl = case labelType lbl of
-                       GcPtrLabel -> True
-                       _other     -> False
+                        GcPtrLabel -> True
+                        _other     -> False
 
 
 -- | Work out the general type of data at the address of this label
 --    whether it be code, data, or static GC object.
 labelType :: CLabel -> CLabelType
-labelType (CmmLabel _ _ CmmData)               = DataLabel
-labelType (CmmLabel _ _ CmmGcPtr)              = GcPtrLabel
-labelType (CmmLabel _ _ CmmCode)               = CodeLabel
-labelType (CmmLabel _ _ CmmInfo)               = DataLabel
-labelType (CmmLabel _ _ CmmEntry)              = CodeLabel
-labelType (CmmLabel _ _ CmmRetInfo)            = DataLabel
-labelType (CmmLabel _ _ CmmRet)                        = CodeLabel
+labelType (CmmLabel _ _ CmmData)                = DataLabel
+labelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel
+labelType (CmmLabel _ _ CmmCode)                = CodeLabel
+labelType (CmmLabel _ _ CmmInfo)                = DataLabel
+labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
+labelType (CmmLabel _ _ CmmPrimCall)            = CodeLabel
+labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
+labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
-labelType (CaseLabel _ _)                      = CodeLabel
+labelType (CaseLabel _ _)                       = CodeLabel
 labelType (PlainModuleInitLabel _)              = CodeLabel
+labelType (SRTLabel _)                          = DataLabel
 labelType (LargeSRTLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
-labelType (ForeignLabel _ _ _ IsFunction)      = CodeLabel
+labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 labelType _                                     = DataLabel
 
+idInfoLabelType :: IdLabelInfo -> CLabelType
 idInfoLabelType info =
   case info of
     InfoTable     -> DataLabel
@@ -763,7 +949,7 @@ idInfoLabelType info =
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
     RednCounts    -> DataLabel
-    _            -> CodeLabel
+    _             -> CodeLabel
 
 
 -- -----------------------------------------------------------------------------
@@ -774,19 +960,19 @@ idInfoLabelType info =
 -- @labelDynamic@ returns @True@ if the label is located
 -- in a DLL, be it a data reference or not.
 
-labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
-labelDynamic dflags this_pkg lbl =
+labelDynamic :: DynFlags -> UnitId -> Module -> CLabel -> Bool
+labelDynamic dflags this_pkg this_mod lbl =
   case lbl of
    -- is the RTS in a DLL or not?
-   RtsLabel _                  -> not opt_Static && (this_pkg /= rtsPackageId)
+   RtsLabel _           -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId)
 
-   IdLabel n _ k       -> isDllName this_pkg n
+   IdLabel n _ _        -> isDllName dflags this_pkg this_mod n
 
-   -- When compiling in the "dyn" way, eack package is to be linked into
+   -- When compiling in the "dyn" way, each package is to be linked into
    -- its own shared library.
    CmmLabel pkg _ _
     | os == OSMinGW32 ->
-       not opt_Static && (this_pkg /= pkg)
+       (WayDyn `elem` ways dflags) && (this_pkg /= pkg)
     | otherwise ->
        True
 
@@ -804,28 +990,21 @@ labelDynamic dflags this_pkg lbl =
             -- When compiling in the "dyn" way, each package is to be
             -- linked into its own DLL.
             ForeignLabelInPackage pkgId ->
-                (not opt_Static) && (this_pkg /= pkgId)
+                (WayDyn `elem` ways dflags) && (this_pkg /= pkgId)
 
        else -- On Mac OS X and on ELF platforms, false positives are OK,
             -- so we claim that all foreign imports come from dynamic
             -- libraries
             True
 
-   PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
+   PlainModuleInitLabel m -> (WayDyn `elem` ways dflags) && this_pkg /= (moduleUnitId m)
+
+   HpcTicksLabel m        -> (WayDyn `elem` ways dflags) && this_mod /= m
 
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
-   _                -> False
+   _                 -> False
   where os = platformOS (targetPlatform dflags)
 
-{-
-OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
-right places. It is used to detect when the abstractC statement of an
-CCodeBlock actually contains the code for a slow entry point.  -- HWL
-
-We need at least @Eq@ for @CLabels@, because we want to avoid
-duplicate declarations in generating C (see @labelSeenTE@ in
-@PprAbsC@).
--}
 
 -----------------------------------------------------------------------------
 -- Printing out CLabels.
@@ -838,25 +1017,25 @@ Convention:
 where <name> is <Module>_<name> for external names and <unique> for
 internal names. <type> is one of the following:
 
-        info                   Info table
-        srt                    Static reference table
-        srtd                   Static reference table descriptor
-        entry                  Entry code (function, closure)
-        slow                   Slow entry code (if any)
-        ret                    Direct return address    
-        vtbl                   Vector table
-        <n>_alt                Case alternative (tag n)
-        dflt                   Default case alternative
-        btm                    Large bitmap vector
-        closure                Static closure
-        con_entry              Dynamic Constructor entry code
-        con_info               Dynamic Constructor info table
-        static_entry           Static Constructor entry code
-        static_info            Static Constructor info table
-        sel_info               Selector info table
-        sel_entry              Selector entry code
-        cc                     Cost centre
-        ccs                    Cost centre stack
+         info                   Info table
+         srt                    Static reference table
+         srtd                   Static reference table descriptor
+         entry                  Entry code (function, closure)
+         slow                   Slow entry code (if any)
+         ret                    Direct return address
+         vtbl                   Vector table
+         <n>_alt                Case alternative (tag n)
+         dflt                   Default case alternative
+         btm                    Large bitmap vector
+         closure                Static closure
+         con_entry              Dynamic Constructor entry code
+         con_info               Dynamic Constructor info table
+         static_entry           Static Constructor entry code
+         static_info            Static Constructor info table
+         sel_info               Selector info table
+         sel_entry              Selector entry code
+         cc                     Cost centre
+         ccs                    Cost centre stack
 
 Many of these distinctions are only for documentation reasons.  For
 example, _ret is only distinguished from _entry to make it easy to
@@ -867,16 +1046,16 @@ Note [Closure and info labels]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For a function 'foo, we have:
    foo_info    : Points to the info table describing foo's closure
-                (and entry code for foo with tables next to code)
-   foo_closure : Static (no-free-var) closure only: 
+                 (and entry code for foo with tables next to code)
+   foo_closure : Static (no-free-var) closure only:
                  points to the statically-allocated closure
 
 For a data constructor (such as Just or Nothing), we have:
     Just_con_info: Info table for the data constructor itself
-                  the first word of a heap-allocated Just
-    Just_info:     Info table for the *worker function*, an 
-                  ordinary Haskell function of arity 1 that 
-                  allocates a (Just x) box:
+                   the first word of a heap-allocated Just
+    Just_info:     Info table for the *worker function*, an
+                   ordinary Haskell function of arity 1 that
+                   allocates a (Just x) box:
                       Just = \x -> Just x
     Just_closure:  The closure for this worker
 
@@ -892,165 +1071,192 @@ somewhat.
 -}
 
 instance Outputable CLabel where
-  ppr = pprCLabel
-instance PlatformOutputable CLabel where
-  pprPlatform _ = pprCLabel
+  ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
 
-pprCLabel :: CLabel -> SDoc
+pprCLabel :: Platform -> CLabel -> SDoc
 
-pprCLabel (AsmTempLabel u)
+pprCLabel platform (AsmTempLabel u)
  | cGhcWithNativeCodeGen == "YES"
   =  getPprStyle $ \ sty ->
-     if asmStyle sty then 
-       ptext asmTempLabelPrefix <> pprUnique u
+     if asmStyle sty then
+        ptext (asmTempLabelPrefix platform) <> pprUnique u
      else
-       char '_' <> pprUnique u
+        char '_' <> pprUnique u
+
+pprCLabel platform (AsmTempDerivedLabel l suf)
+ | cGhcWithNativeCodeGen == "YES"
+   = ptext (asmTempLabelPrefix platform)
+     <> case l of AsmTempLabel u -> pprUnique u
+                  _other         -> pprCLabel platform l
+     <> ftext suf
 
-pprCLabel (DynamicLinkerLabel info lbl)
+pprCLabel platform (DynamicLinkerLabel info lbl)
  | cGhcWithNativeCodeGen == "YES"
-   = pprDynamicLinkerAsmLabel info lbl
-   
-pprCLabel PicBaseLabel
+   = pprDynamicLinkerAsmLabel platform info lbl
+
+pprCLabel PicBaseLabel
  | cGhcWithNativeCodeGen == "YES"
-   = ptext (sLit "1b")
-   
-pprCLabel (DeadStripPreventer lbl)
+   = text "1b"
+
+pprCLabel platform (DeadStripPreventer lbl)
  | cGhcWithNativeCodeGen == "YES"
-   = pprCLabel lbl <> ptext (sLit "_dsp")
+   = pprCLabel platform lbl <> text "_dsp"
 
-pprCLabel lbl
+pprCLabel platform lbl
    = getPprStyle $ \ sty ->
      if cGhcWithNativeCodeGen == "YES" && asmStyle sty
-     then maybe_underscore (pprAsmCLbl lbl)
+     then maybe_underscore (pprAsmCLbl platform lbl)
      else pprCLbl lbl
 
+maybe_underscore :: SDoc -> SDoc
 maybe_underscore doc
   | underscorePrefix = pp_cSEP <> doc
   | otherwise        = doc
 
-#ifdef mingw32_TARGET_OS
--- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
--- (The C compiler does this itself).
-pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
-   = ftext fs <> char '@' <> int sz
-#endif
-pprAsmCLbl lbl
+pprAsmCLbl :: Platform -> CLabel -> SDoc
+pprAsmCLbl platform (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 lbl
 
+pprCLbl :: CLabel -> SDoc
 pprCLbl (StringLitLabel u)
-  = pprUnique u <> ptext (sLit "_str")
+  = pprUnique u <> text "_str"
 
 pprCLbl (CaseLabel u CaseReturnPt)
-  = hcat [pprUnique u, ptext (sLit "_ret")]
+  = hcat [pprUnique u, text "_ret"]
 pprCLbl (CaseLabel u CaseReturnInfo)
-  = hcat [pprUnique u, ptext (sLit "_info")]
+  = hcat [pprUnique u, text "_info"]
 pprCLbl (CaseLabel u (CaseAlt tag))
-  = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
+  = hcat [pprUnique u, pp_cSEP, int tag, text "_alt"]
 pprCLbl (CaseLabel u CaseDefault)
-  = hcat [pprUnique u, ptext (sLit "_dflt")]
+  = hcat [pprUnique u, text "_dflt"]
+
+pprCLbl (SRTLabel u)
+  = pprUnique u <> pp_cSEP <> text "srt"
 
-pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
-pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
+pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> text "srtd"
+pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> text "btm"
 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 -- until that gets resolved we'll just force them to start
 -- with a letter so the label will be legal assmbly code.
-        
 
-pprCLbl (CmmLabel _ str CmmCode)       = ftext str
-pprCLbl (CmmLabel _ str CmmData)       = ftext str
-pprCLbl (CmmLabel _ str CmmGcPtr)      = ftext str
-pprCLbl (CmmLabel _ str CmmPrimCall)   = ftext str
 
-pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
+pprCLbl (CmmLabel _ str CmmCode)        = ftext str
+pprCLbl (CmmLabel _ str CmmData)        = ftext str
+pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
+
+pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> text "_fast"
 
 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
-  = hcat [ptext (sLit "stg_sel_"), text (show offset),
-               ptext (if upd_reqd 
-                       then (sLit "_upd_info") 
-                       else (sLit "_noupd_info"))
-       ]
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+    hcat [text "stg_sel_", text (show offset),
+          ptext (if upd_reqd
+                 then (sLit "_upd_info")
+                 else (sLit "_noupd_info"))
+        ]
 
 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
-  = hcat [ptext (sLit "stg_sel_"), text (show offset),
-               ptext (if upd_reqd 
-                       then (sLit "_upd_entry") 
-                       else (sLit "_noupd_entry"))
-       ]
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+    hcat [text "stg_sel_", text (show offset),
+                ptext (if upd_reqd
+                        then (sLit "_upd_entry")
+                        else (sLit "_noupd_entry"))
+        ]
 
 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
-  = hcat [ptext (sLit "stg_ap_"), text (show arity),
-               ptext (if upd_reqd 
-                       then (sLit "_upd_info") 
-                       else (sLit "_noupd_info"))
-       ]
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+    hcat [text "stg_ap_", text (show arity),
+                ptext (if upd_reqd
+                        then (sLit "_upd_info")
+                        else (sLit "_noupd_info"))
+        ]
 
 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
-  = hcat [ptext (sLit "stg_ap_"), text (show arity),
-               ptext (if upd_reqd 
-                       then (sLit "_upd_entry") 
-                       else (sLit "_noupd_entry"))
-       ]
+  = sdocWithDynFlags $ \dflags ->
+    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+    hcat [text "stg_ap_", text (show arity),
+                ptext (if upd_reqd
+                        then (sLit "_upd_entry")
+                        else (sLit "_noupd_entry"))
+        ]
 
 pprCLbl (CmmLabel _ fs CmmInfo)
-  = ftext fs <> ptext (sLit "_info")
+  = ftext fs <> text "_info"
 
 pprCLbl (CmmLabel _ fs CmmEntry)
-  = ftext fs <> ptext (sLit "_entry")
+  = ftext fs <> text "_entry"
 
 pprCLbl (CmmLabel _ fs CmmRetInfo)
-  = ftext fs <> ptext (sLit "_info")
+  = ftext fs <> text "_info"
 
 pprCLbl (CmmLabel _ fs CmmRet)
-  = ftext fs <> ptext (sLit "_ret")
+  = ftext fs <> text "_ret"
+
+pprCLbl (CmmLabel _ fs CmmClosure)
+  = ftext fs <> text "_closure"
 
-pprCLbl (RtsLabel (RtsPrimOp primop)) 
-  = ptext (sLit "stg_") <> ppr primop
+pprCLbl (RtsLabel (RtsPrimOp primop))
+  = text "stg_" <> ppr primop
 
-pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) 
-  = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
+pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
+  = text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr")
 
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
 
-pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
 
-pprCLbl (CC_Label cc)          = ppr cc
-pprCLbl (CCS_Label ccs)        = ppr ccs
+pprCLbl (CC_Label cc)           = ppr cc
+pprCLbl (CCS_Label ccs)         = ppr ccs
 
 pprCLbl (PlainModuleInitLabel mod)
-   = ptext (sLit "__stginit_") <> ppr mod
+   = text "__stginit_" <> ppr mod
 
 pprCLbl (HpcTicksLabel mod)
-  = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
+  = text "_hpc_tickboxes_"  <> ppr mod <> ptext (sLit "_hpc")
+
+pprCLbl (AsmTempLabel {})       = panic "pprCLbl AsmTempLabel"
+pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
+pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
+pprCLbl (PicBaseLabel {})       = panic "pprCLbl PicBaseLabel"
+pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <>
-              (case x of
-                      Closure          -> ptext (sLit "closure")
-                      SRT              -> ptext (sLit "srt")
-                       InfoTable        -> ptext (sLit "info")
-                       LocalInfoTable   -> ptext (sLit "info")
-                       Entry            -> ptext (sLit "entry")
-                       LocalEntry       -> ptext (sLit "entry")
-                       Slow             -> ptext (sLit "slow")
-                      RednCounts       -> ptext (sLit "ct")
-                      ConEntry         -> ptext (sLit "con_entry")
-                      ConInfoTable     -> ptext (sLit "con_info")
-                      StaticConEntry   -> ptext (sLit "static_entry")
-                      StaticInfoTable  -> ptext (sLit "static_info")
-                      ClosureTable     -> ptext (sLit "closure_tbl")
-                     )
-
-
+               (case x of
+                       Closure          -> text "closure"
+                       SRT              -> text "srt"
+                       InfoTable        -> text "info"
+                       LocalInfoTable   -> text "info"
+                       Entry            -> text "entry"
+                       LocalEntry       -> text "entry"
+                       Slow             -> text "slow"
+                       RednCounts       -> text "ct"
+                       ConEntry         -> text "con_entry"
+                       ConInfoTable     -> text "con_info"
+                       StaticConEntry   -> text "static_entry"
+                       StaticInfoTable  -> text "static_info"
+                       ClosureTable     -> text "closure_tbl"
+                      )
+
+
+pp_cSEP :: SDoc
 pp_cSEP = char '_'
 
 
 instance Outputable ForeignLabelSource where
  ppr fs
   = case fs of
-       ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId 
-       ForeignLabelInThisPackage       -> parens $ text "this package"
-       ForeignLabelInExternalPackage   -> parens $ text "external package"
+        ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
+        ForeignLabelInThisPackage       -> parens $ text "this package"
+        ForeignLabelInExternalPackage   -> parens $ text "external package"
 
 -- -----------------------------------------------------------------------------
 -- Machine-dependent knowledge about labels.
@@ -1058,77 +1264,60 @@ instance Outputable ForeignLabelSource where
 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 underscorePrefix = (cLeadingUnderscore == "YES")
 
-asmTempLabelPrefix :: LitString  -- for formatting labels
-asmTempLabelPrefix =
-#if alpha_TARGET_OS
-     {- The alpha assembler likes temporary labels to look like $L123
-       instead of L123.  (Don't toss the L, because then Lf28
-       turns into $f28.)
-     -}
-     (sLit "$")
-#elif darwin_TARGET_OS
-     (sLit "L")
-#else
-     (sLit ".L")
-#endif
-
-pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
-
-#if x86_64_TARGET_ARCH && darwin_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = char 'L' <> pprCLabel lbl <> text "$stub"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@GOTPCREL"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif darwin_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = char 'L' <> pprCLabel lbl <> text "$stub"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@gotpcrel"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-
-#elif elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@got"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl <> text "@gotoff"
-
-#elif mingw32_TARGET_OS
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text "__imp_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#else
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-#endif
+asmTempLabelPrefix :: Platform -> LitString  -- for formatting labels
+asmTempLabelPrefix platform = case platformOS platform of
+    OSDarwin -> sLit "L"
+    OSAIX    -> sLit "__L" -- follow IBM XL C's convention
+    _        -> sLit ".L"
+
+pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
+pprDynamicLinkerAsmLabel platform dllInfo lbl
+ = if platformOS platform == OSDarwin
+   then if platformArch platform == ArchX86_64
+        then 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
+        else case dllInfo of
+             CodeStub  -> char 'L' <> ppr lbl <> text "$stub"
+             SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
+             _         -> panic "pprDynamicLinkerAsmLabel"
+
+   else if platformOS platform == OSAIX
+        then case dllInfo of
+             SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
+             _         -> panic "pprDynamicLinkerAsmLabel"
+
+   else if osElfTarget (platformOS platform)
+        then if platformArch platform == ArchPPC
+             then case dllInfo of
+                       CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]
+                                    ppr lbl <> text "+32768@plt"
+                       SymbolPtr -> text ".LC_" <> ppr lbl
+                       _         -> panic "pprDynamicLinkerAsmLabel"
+             else if platformArch platform == ArchX86_64
+                  then case dllInfo of
+                       CodeStub        -> ppr lbl <> text "@plt"
+                       GotSymbolPtr    -> ppr lbl <> text "@gotpcrel"
+                       GotSymbolOffset -> ppr lbl
+                       SymbolPtr       -> text ".LC_" <> ppr lbl
+             else if platformArch platform == ArchPPC_64 ELF_V1
+                  || platformArch platform == ArchPPC_64 ELF_V2
+                  then case dllInfo of
+                       GotSymbolPtr    -> text ".LC_"  <> ppr lbl
+                                               <> text "@toc"
+                       GotSymbolOffset -> ppr lbl
+                       SymbolPtr       -> text ".LC_" <> ppr lbl
+                       _               -> panic "pprDynamicLinkerAsmLabel"
+        else case dllInfo of
+             CodeStub        -> ppr lbl <> text "@plt"
+             SymbolPtr       -> text ".LC_" <> ppr lbl
+             GotSymbolPtr    -> ppr lbl <> text "@got"
+             GotSymbolOffset -> ppr lbl <> text "@gotoff"
+   else if platformOS platform == OSMinGW32
+        then case dllInfo of
+             SymbolPtr -> text "__imp_" <> ppr lbl
+             _         -> panic "pprDynamicLinkerAsmLabel"
+   else panic "pprDynamicLinkerAsmLabel"
+