Big collection of patches for the new codegen branch.

[ghc-hetmet.git] / compiler / cmm / CLabel.hs

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 3c06129..aa72b65 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -51,6 +51,7 @@ module CLabel (
 
        mkModuleInitLabel,
        mkPlainModuleInitLabel,
 
        mkModuleInitLabel,
        mkPlainModuleInitLabel,

+       mkModuleInitTableLabel,

 
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
 
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,

@@ -63,11 +64,11 @@ module CLabel (
 
        mkTopTickyCtrLabel,
         mkCAFBlackHoleInfoTableLabel,
 
        mkTopTickyCtrLabel,
         mkCAFBlackHoleInfoTableLabel,

-        mkSECAFBlackHoleInfoTableLabel,

        mkRtsPrimOpLabel,
        mkRtsSlowTickyCtrLabel,
 
        moduleRegdLabel,
        mkRtsPrimOpLabel,
        mkRtsSlowTickyCtrLabel,
 
        moduleRegdLabel,

+       moduleRegTableLabel,

 
        mkSelectorInfoLabel,
        mkSelectorEntryLabel,
 
        mkSelectorInfoLabel,
        mkSelectorEntryLabel,

@@ -78,6 +79,7 @@ module CLabel (
        mkRtsRetLabel,
        mkRtsCodeLabel,
        mkRtsDataLabel,
        mkRtsRetLabel,
        mkRtsCodeLabel,
        mkRtsDataLabel,

+       mkRtsGcPtrLabel,

 
        mkRtsInfoLabelFS,
        mkRtsEntryLabelFS,
 
        mkRtsInfoLabelFS,
        mkRtsEntryLabelFS,

@@ -90,6 +92,7 @@ module CLabel (
 
        mkForeignLabel,
         addLabelSize,
 
        mkForeignLabel,
         addLabelSize,

+        foreignLabelStdcallInfo,

 
        mkCCLabel, mkCCSLabel,
 
 
        mkCCLabel, mkCCSLabel,
 

@@ -103,14 +106,18 @@ module CLabel (
         mkHpcTicksLabel,
         mkHpcModuleNameLabel,
 
         mkHpcTicksLabel,
         mkHpcModuleNameLabel,
 

-       infoLblToEntryLbl, entryLblToInfoLbl,
+        hasCAF,
+       infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,

        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,

-       CLabelType(..), labelType, labelDynamic,
+       isCFunctionLabel, isGcPtrLabel, labelDynamic,

 
        pprCLabel
     ) where
 
 
        pprCLabel
     ) where
 

+#include "HsVersions.h"
+
+import IdInfo

 import StaticFlags
 import Packages
 import DataCon
 import StaticFlags
 import Packages
 import DataCon

@@ -153,6 +160,7 @@ CLabel is an abstract type that supports the following operations:
 data CLabel
   = IdLabel                    -- A family of labels related to the
        Name                    -- definition of a particular Id or Con
 data CLabel
   = IdLabel                    -- A family of labels related to the
        Name                    -- definition of a particular Id or Con

+        CafInfo

        IdLabelInfo
 
   | CaseLabel                  -- A family of labels related to a particular
        IdLabelInfo
 
   | CaseLabel                  -- A family of labels related to a particular

@@ -175,7 +183,10 @@ data CLabel
        -- because we don't always recompile modules which depend on a module
        -- whose version has changed.
 
        -- because we don't always recompile modules which depend on a module
        -- whose version has changed.
 

-  | PlainModuleInitLabel       -- without the vesrion & way info
+  | PlainModuleInitLabel       -- without the version & way info
+       Module
+
+  | ModuleInitTableLabel       -- table of imported modules to init

        Module
 
   | ModuleRegdLabel
        Module
 
   | ModuleRegdLabel

@@ -260,7 +271,8 @@ data RtsLabelInfo
   | RtsEntry      LitString    -- misc rts entry points
   | RtsRetInfo    LitString    -- misc rts ret info tables
   | RtsRet        LitString    -- misc rts return points
   | RtsEntry      LitString    -- misc rts entry points
   | RtsRetInfo    LitString    -- misc rts ret info tables
   | RtsRet        LitString    -- misc rts return points

-  | RtsData       LitString    -- misc rts data bits, eg CHARLIKE_closure
+  | RtsData       LitString    -- misc rts data bits
+  | RtsGcPtr      LitString    -- GcPtrs eg CHARLIKE_closure

   | RtsCode       LitString    -- misc rts code
 
   | RtsInfoFS     FastString   -- misc rts info tables
   | RtsCode       LitString    -- misc rts code
 
   | RtsInfoFS     FastString   -- misc rts info tables

@@ -290,29 +302,29 @@ data DynamicLinkerLabelInfo
 -- Constructing CLabels
 
 -- These are always local:
 -- Constructing CLabels
 
 -- These are always local:

-mkSRTLabel             name    = IdLabel name  SRT
-mkSlowEntryLabel       name    = IdLabel name  Slow
-mkRednCountsLabel      name    = IdLabel name  RednCounts
+mkSRTLabel             name c  = IdLabel name  c SRT
+mkSlowEntryLabel       name c  = IdLabel name  c Slow
+mkRednCountsLabel      name c  = IdLabel name  c RednCounts

 
 -- These have local & (possibly) external variants:
 
 -- These have local & (possibly) external variants:

-mkLocalClosureLabel    name    = IdLabel name  Closure
-mkLocalInfoTableLabel          name    = IdLabel name  InfoTable
-mkLocalEntryLabel      name    = IdLabel name  Entry
-mkLocalClosureTableLabel name  = IdLabel name ClosureTable
-
-mkClosureLabel name             = IdLabel name Closure
-mkInfoTableLabel name           = IdLabel name InfoTable
-mkEntryLabel name               = IdLabel name Entry
-mkClosureTableLabel name        = IdLabel name ClosureTable
-mkLocalConInfoTableLabel    con = IdLabel con ConInfoTable
-mkLocalConEntryLabel       con = IdLabel con ConEntry
-mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
-mkLocalStaticConEntryLabel  con = IdLabel con StaticConEntry
-mkConInfoTableLabel name        = IdLabel    name ConInfoTable
-mkStaticInfoTableLabel name     = IdLabel    name StaticInfoTable
-
-mkConEntryLabel name            = IdLabel name ConEntry
-mkStaticConEntryLabel name      = IdLabel name StaticConEntry
+mkLocalClosureLabel    name c  = IdLabel name  c Closure
+mkLocalInfoTableLabel          name c  = IdLabel name  c InfoTable
+mkLocalEntryLabel      name c  = IdLabel name  c Entry
+mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
+
+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
+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        c     = IdLabel name c ConEntry
+mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry

 
 mkLargeSRTLabel        uniq    = LargeSRTLabel uniq
 mkBitmapLabel  uniq    = LargeBitmapLabel uniq
 
 mkLargeSRTLabel        uniq    = LargeSRTLabel uniq
 mkBitmapLabel  uniq    = LargeBitmapLabel uniq

@@ -332,6 +344,9 @@ mkModuleInitLabel mod way        = ModuleInitLabel mod way
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod       = PlainModuleInitLabel mod
 
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod       = PlainModuleInitLabel mod
 

+mkModuleInitTableLabel :: Module -> CLabel
+mkModuleInitTableLabel mod       = ModuleInitTableLabel mod
+

        -- Some fixed runtime system labels
 
 mkSplitMarkerLabel             = RtsLabel (RtsCode (sLit "__stg_split_marker"))
        -- Some fixed runtime system labels
 
 mkSplitMarkerLabel             = RtsLabel (RtsCode (sLit "__stg_split_marker"))

@@ -345,13 +360,10 @@ mkEMPTY_MVAR_infoLabel            = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
 
 mkTopTickyCtrLabel             = RtsLabel (RtsData (sLit "top_ct"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
 
 mkTopTickyCtrLabel             = RtsLabel (RtsData (sLit "top_ct"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))

-mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
-                                    RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
-                                  else  -- RTS won't have info table unless -ticky is on
-                                    panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"

 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
 
 moduleRegdLabel                        = ModuleRegdLabel
 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
 
 moduleRegdLabel                        = ModuleRegdLabel

+moduleRegTableLabel             = ModuleInitTableLabel 

 
 mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTable upd off)
 mkSelectorEntryLabel upd off   = RtsLabel (RtsSelectorEntry   upd off)
 
 mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTable upd off)
 mkSelectorEntryLabel upd off   = RtsLabel (RtsSelectorEntry   upd off)

@@ -370,6 +382,10 @@ addLabelSize (ForeignLabel str _ is_dynamic) sz
 addLabelSize label _
   = label
 
 addLabelSize label _
   = label
 

+foreignLabelStdcallInfo :: CLabel -> Maybe Int
+foreignLabelStdcallInfo (ForeignLabel _ info _) = info
+foreignLabelStdcallInfo _lbl = Nothing
+

        -- Cost centres etc.
 
 mkCCLabel      cc              = CC_Label cc
        -- Cost centres etc.
 
 mkCCLabel      cc              = CC_Label cc

@@ -381,6 +397,7 @@ mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 mkRtsDataLabel      str = RtsLabel (RtsData      str)
 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 mkRtsDataLabel      str = RtsLabel (RtsData      str)

+mkRtsGcPtrLabel     str = RtsLabel (RtsGcPtr     str)

 
 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
 
 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)

@@ -420,9 +437,9 @@ mkDeadStripPreventer lbl = DeadStripPreventer lbl
 -- Converting between info labels and entry/ret labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 
 -- Converting between info labels and entry/ret labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 

-infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
-infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
-infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
+infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
+infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
+infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry

 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)

@@ -431,9 +448,9 @@ infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 
 entryLblToInfoLbl :: CLabel -> CLabel 
 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 
 entryLblToInfoLbl :: CLabel -> CLabel 

-entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
-entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
-entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
+entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
+entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
+entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable

 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)

@@ -441,6 +458,24 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 
 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 

+cvtToClosureLbl   (IdLabel n c InfoTable) = IdLabel n c Closure
+cvtToClosureLbl   (IdLabel n c Entry)     = IdLabel n c Closure
+cvtToClosureLbl   (IdLabel n c ConEntry)  = IdLabel n c Closure
+cvtToClosureLbl l@(IdLabel n c Closure)   = l
+cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
+
+cvtToSRTLbl   (IdLabel n c InfoTable) = mkSRTLabel n c
+cvtToSRTLbl   (IdLabel n c Entry)     = mkSRTLabel n c
+cvtToSRTLbl   (IdLabel n c ConEntry)  = mkSRTLabel n c
+cvtToSRTLbl l@(IdLabel n c Closure)   = mkSRTLabel n c
+cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
+
+-- -----------------------------------------------------------------------------
+-- Does a CLabel refer to a CAF?
+hasCAF :: CLabel -> Bool
+hasCAF (IdLabel _ MayHaveCafRefs _) = True
+hasCAF _                            = False
+

 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
 --
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
 --

@@ -450,13 +485,14 @@ needsCDecl :: CLabel -> Bool
   -- False <=> it's pre-declared; don't bother
   -- don't bother declaring SRT & Bitmap labels, we always make sure
   -- they are defined before use.
   -- False <=> it's pre-declared; don't bother
   -- don't bother declaring SRT & Bitmap labels, we always make sure
   -- they are defined before use.

-needsCDecl (IdLabel _ SRT)             = False
+needsCDecl (IdLabel _ _ SRT)           = False

 needsCDecl (LargeSRTLabel _)           = False
 needsCDecl (LargeBitmapLabel _)                = False
 needsCDecl (LargeSRTLabel _)           = False
 needsCDecl (LargeBitmapLabel _)                = False

-needsCDecl (IdLabel _ _)               = True
+needsCDecl (IdLabel _ _ _)             = True

 needsCDecl (CaseLabel _ _)             = True
 needsCDecl (ModuleInitLabel _ _)       = True
 needsCDecl (PlainModuleInitLabel _)    = True
 needsCDecl (CaseLabel _ _)             = True
 needsCDecl (ModuleInitLabel _ _)       = True
 needsCDecl (PlainModuleInitLabel _)    = True

+needsCDecl (ModuleInitTableLabel _)    = True

 needsCDecl ModuleRegdLabel             = False
 
 needsCDecl (StringLitLabel _)          = False
 needsCDecl ModuleRegdLabel             = False
 
 needsCDecl (StringLitLabel _)          = False

@@ -493,8 +529,16 @@ isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
         (fsLit "cosf"),   (fsLit "tanf"),  (fsLit "sinhf"),
         (fsLit "coshf"),  (fsLit "tanhf"), (fsLit "asinf"),
         (fsLit "acosf"),  (fsLit "atanf"), (fsLit "logf"),
         (fsLit "cosf"),   (fsLit "tanf"),  (fsLit "sinhf"),
         (fsLit "coshf"),  (fsLit "tanhf"), (fsLit "asinf"),
         (fsLit "acosf"),  (fsLit "atanf"), (fsLit "logf"),

-        (fsLit "expf"),   (fsLit "sqrtf")
-   ]
+        (fsLit "expf"),   (fsLit "sqrtf"), (fsLit "frexp"),
+        (fsLit "modf"),   (fsLit "ilogb"), (fsLit "copysign"),
+        (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
+        (fsLit "cbrt"),   (fsLit "atanh"), (fsLit "asinh"),
+        (fsLit "acosh"),  (fsLit "lgamma"),(fsLit "hypot"),
+        (fsLit "erfc"),   (fsLit "erf"),   (fsLit "trunc"),
+        (fsLit "round"),  (fsLit "fmod"),  (fsLit "floor"),
+        (fsLit "fabs"),   (fsLit "ceil"),  (fsLit "log10"),
+        (fsLit "ldexp"),  (fsLit "atan2"), (fsLit "rint")
+    ]

 isMathFun _ = False
 
 -- -----------------------------------------------------------------------------
 isMathFun _ = False
 
 -- -----------------------------------------------------------------------------

@@ -510,10 +554,11 @@ externallyVisibleCLabel (StringLitLabel _) = False
 externallyVisibleCLabel (AsmTempLabel _)   = False
 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (AsmTempLabel _)   = False
 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 externallyVisibleCLabel (PlainModuleInitLabel _)= True

+externallyVisibleCLabel (ModuleInitTableLabel _)= False

 externallyVisibleCLabel ModuleRegdLabel    = False
 externallyVisibleCLabel (RtsLabel _)      = True
 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 externallyVisibleCLabel ModuleRegdLabel    = False
 externallyVisibleCLabel (RtsLabel _)      = True
 externallyVisibleCLabel (ForeignLabel _ _ _) = True

-externallyVisibleCLabel (IdLabel name _)     = isExternalName name
+externallyVisibleCLabel (IdLabel name _ _)     = isExternalName name

 externallyVisibleCLabel (CC_Label _)      = True
 externallyVisibleCLabel (CCS_Label _)     = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (CC_Label _)      = True
 externallyVisibleCLabel (CCS_Label _)     = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False

@@ -528,13 +573,25 @@ externallyVisibleCLabel (LargeSRTLabel _) = False
 -- For generating correct types in label declarations:
 
 data CLabelType
 -- For generating correct types in label declarations:
 
 data CLabelType

-  = CodeLabel
-  | DataLabel
+  = 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
+
+isGcPtrLabel :: CLabel -> Bool
+isGcPtrLabel lbl = case labelType lbl of
+                       GcPtrLabel -> True
+                       _other     -> False

 
 labelType :: CLabel -> CLabelType
 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsData _))              = DataLabel
 
 labelType :: CLabel -> CLabelType
 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsData _))              = DataLabel

+labelType (RtsLabel (RtsGcPtr _))             = GcPtrLabel

 labelType (RtsLabel (RtsCode _))              = CodeLabel
 labelType (RtsLabel (RtsInfo _))              = DataLabel
 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 labelType (RtsLabel (RtsCode _))              = CodeLabel
 labelType (RtsLabel (RtsInfo _))              = DataLabel
 labelType (RtsLabel (RtsEntry _))             = CodeLabel

@@ -551,20 +608,19 @@ labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 labelType (CaseLabel _ _)                    = CodeLabel
 labelType (ModuleInitLabel _ _)               = CodeLabel
 labelType (PlainModuleInitLabel _)            = CodeLabel
 labelType (CaseLabel _ _)                    = CodeLabel
 labelType (ModuleInitLabel _ _)               = CodeLabel
 labelType (PlainModuleInitLabel _)            = CodeLabel

+labelType (ModuleInitTableLabel _)            = DataLabel

 labelType (LargeSRTLabel _)                   = DataLabel
 labelType (LargeBitmapLabel _)                = DataLabel
 labelType (LargeSRTLabel _)                   = DataLabel
 labelType (LargeBitmapLabel _)                = DataLabel

-
-labelType (IdLabel _ info) = idInfoLabelType info
-labelType _        = DataLabel
+labelType (IdLabel _ _ info) = idInfoLabelType info
+labelType _                = DataLabel

 
 idInfoLabelType info =
   case info of
     InfoTable            -> DataLabel
 
 idInfoLabelType info =
   case info of
     InfoTable            -> DataLabel

-    Closure              -> DataLabel
+    Closure              -> GcPtrLabel

     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel

--- krc: aie! a ticky counter label is data

     RednCounts    -> DataLabel
     _            -> CodeLabel
 
     RednCounts    -> DataLabel
     _            -> CodeLabel
 

@@ -581,7 +637,7 @@ labelDynamic :: PackageId -> CLabel -> Bool
 labelDynamic this_pkg lbl =
   case lbl of
    RtsLabel _               -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 labelDynamic this_pkg lbl =
   case lbl of
    RtsLabel _               -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?

-   IdLabel n k       -> isDllName this_pkg n
+   IdLabel n _ k       -> isDllName this_pkg n

 #if mingw32_TARGET_OS
    ForeignLabel _ _ d  -> d
 #else
 #if mingw32_TARGET_OS
    ForeignLabel _ _ d  -> d
 #else

@@ -591,6 +647,7 @@ labelDynamic this_pkg lbl =
 #endif
    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 #endif
    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)

+   ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)

    
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
    _                -> False
    
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
    _                -> False

@@ -708,6 +765,7 @@ pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi
 
 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 pprCLbl (RtsLabel (RtsData str))   = ptext str
 
 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 pprCLbl (RtsLabel (RtsData str))   = ptext str

+pprCLbl (RtsLabel (RtsGcPtr str))  = ptext str

 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 
 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 

@@ -777,7 +835,7 @@ pprCLbl ModuleRegdLabel
 pprCLbl (ForeignLabel str _ _)
   = ftext str
 
 pprCLbl (ForeignLabel str _ _)
   = ftext str
 

-pprCLbl (IdLabel name  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

@@ -787,6 +845,8 @@ pprCLbl (ModuleInitLabel mod way)
        <> char '_' <> text way
 pprCLbl (PlainModuleInitLabel mod)
    = ptext (sLit "__stginit_") <> ppr mod
        <> char '_' <> text way
 pprCLbl (PlainModuleInitLabel mod)
    = ptext (sLit "__stginit_") <> ppr mod

+pprCLbl (ModuleInitTableLabel mod)
+   = ptext (sLit "__stginittable_") <> ppr mod

 
 pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 
 pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")