Fix calling maths functions when compiling via C

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

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index cb07d06..2501b6e 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,17 +106,21 @@ 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
 
 #include "HsVersions.h"
 
 
        pprCLabel
     ) where
 
 #include "HsVersions.h"
 

+import IdInfo

 import StaticFlags
 import StaticFlags

+import BasicTypes
+import Literal

 import Packages
 import DataCon
 import PackageConfig
 import Packages
 import DataCon
 import PackageConfig

@@ -155,6 +162,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

@@ -177,18 +185,22 @@ 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
 
   | RtsLabel RtsLabelInfo
 
        Module
 
   | ModuleRegdLabel
 
   | RtsLabel RtsLabelInfo
 

-  | ForeignLabel FastString    -- a 'C' (or otherwise foreign) 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.
-       Bool                    -- True <=> is dynamic
+  | ForeignLabel FastString     -- a 'C' (or otherwise foreign) 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.
+        Bool                    -- True <=> is dynamic
+        FunctionOrData

 
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack
 
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack

@@ -262,7 +274,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

@@ -292,29 +305,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

@@ -334,6 +347,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"))

@@ -347,13 +363,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)

@@ -363,15 +376,20 @@ mkApEntryLabel upd off            = RtsLabel (RtsApEntry   upd off)
 
        -- Foreign labels
 
 
        -- Foreign labels
 

-mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
-mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
+mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
+mkForeignLabel str mb_sz is_dynamic fod
+    = ForeignLabel str mb_sz is_dynamic fod

 
 addLabelSize :: CLabel -> Int -> CLabel
 
 addLabelSize :: CLabel -> Int -> CLabel

-addLabelSize (ForeignLabel str _ is_dynamic) sz
-  = ForeignLabel str (Just sz) is_dynamic
+addLabelSize (ForeignLabel str _ is_dynamic fod) sz
+  = ForeignLabel str (Just sz) is_dynamic fod

 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

@@ -383,6 +401,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)

@@ -422,9 +441,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)

@@ -433,9 +452,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)

@@ -443,6 +462,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?
 --

@@ -452,19 +489,20 @@ 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 (AsmTempLabel _)            = False
 needsCDecl (RtsLabel _)                        = False
 needsCDecl ModuleRegdLabel             = False
 
 needsCDecl (StringLitLabel _)          = False
 needsCDecl (AsmTempLabel _)            = False
 needsCDecl (RtsLabel _)                        = False

-needsCDecl l@(ForeignLabel _ _ _)      = not (isMathFun l)
+needsCDecl l@(ForeignLabel _ _ _ _)    = not (isMathFun l)

 needsCDecl (CC_Label _)                        = True
 needsCDecl (CCS_Label _)               = True
 needsCDecl (HpcTicksLabel _)            = True
 needsCDecl (CC_Label _)                        = True
 needsCDecl (CCS_Label _)               = True
 needsCDecl (HpcTicksLabel _)            = True

@@ -484,7 +522,7 @@ maybeAsmTemp _                     = Nothing
 -- they are builtin to the C compiler.  For these labels we avoid
 -- generating our own C prototypes.
 isMathFun :: CLabel -> Bool
 -- they are builtin to the C compiler.  For these labels we avoid
 -- generating our own C prototypes.
 isMathFun :: CLabel -> Bool

-isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
+isMathFun (ForeignLabel fs _ _ _) = fs `elem` math_funs

   where
   math_funs = [
         (fsLit "pow"),    (fsLit "sin"),   (fsLit "cos"),
   where
   math_funs = [
         (fsLit "pow"),    (fsLit "sin"),   (fsLit "cos"),

@@ -495,8 +533,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
 
 -- -----------------------------------------------------------------------------

@@ -512,10 +558,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 ModuleRegdLabel    = False
 externallyVisibleCLabel (RtsLabel _)      = True

-externallyVisibleCLabel (ForeignLabel _ _ _) = True
-externallyVisibleCLabel (IdLabel name _)     = isExternalName name
+externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
+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

@@ -530,13 +577,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

@@ -553,20 +612,20 @@ 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 (ForeignLabel _ _ _ IsFunction) = CodeLabel
+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
 

@@ -583,16 +642,17 @@ 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
 #if mingw32_TARGET_OS

-   ForeignLabel _ _ d  -> d
+   ForeignLabel _ _ d _ -> d

 #else
    -- On Mac OS X and on ELF platforms, false positives are OK,
    -- so we claim that all foreign imports come from dynamic libraries
 #else
    -- On Mac OS X and on ELF platforms, false positives are OK,
    -- so we claim that all foreign imports come from dynamic libraries

-   ForeignLabel _ _ _ -> True
+   ForeignLabel _ _ _ _ -> True

 #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

@@ -683,7 +743,7 @@ maybe_underscore doc
 #ifdef mingw32_TARGET_OS
 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 -- (The C compiler does this itself).
 #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) _)
+pprAsmCLbl (ForeignLabel fs (Just sz) _ _)

    = ftext fs <> char '@' <> int sz
 #endif
 pprAsmCLbl lbl
    = ftext fs <> char '@' <> int sz
 #endif
 pprAsmCLbl lbl

@@ -710,6 +770,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
 

@@ -776,10 +837,10 @@ pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 pprCLbl ModuleRegdLabel
   = ptext (sLit "_module_registered")
 
 pprCLbl ModuleRegdLabel
   = ptext (sLit "_module_registered")
 

-pprCLbl (ForeignLabel str _ _)
+pprCLbl (ForeignLabel str _ _ _)

   = ftext 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

@@ -789,6 +850,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")