When generating C, don't pretend functions are data

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

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index ffa93fb..2501b6e 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -107,7 +107,7 @@ module CLabel (
         mkHpcModuleNameLabel,
 
         hasCAF,
-       infoLblToEntryLbl, entryLblToInfoLbl,
+       infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
        isCFunctionLabel, isGcPtrLabel, labelDynamic,
@@ -119,6 +119,8 @@ module CLabel (
 
 import IdInfo
 import StaticFlags
+import BasicTypes
+import Literal
 import Packages
 import DataCon
 import PackageConfig
@@ -193,11 +195,12 @@ data CLabel
 
   | 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
@@ -373,17 +376,18 @@ mkApEntryLabel upd off            = RtsLabel (RtsApEntry   upd off)
 
        -- 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 (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
 
 foreignLabelStdcallInfo :: CLabel -> Maybe Int
-foreignLabelStdcallInfo (ForeignLabel _ info _) = info
+foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
 foreignLabelStdcallInfo _lbl = Nothing
 
        -- Cost centres etc.
@@ -458,11 +462,23 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 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 Closure) = True
-hasCAF _                                  = False
+hasCAF (IdLabel _ MayHaveCafRefs _) = True
+hasCAF _                            = False
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
@@ -486,7 +502,7 @@ 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
@@ -506,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
-isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
+isMathFun (ForeignLabel fs _ _ _) = fs `elem` math_funs
   where
   math_funs = [
         (fsLit "pow"),    (fsLit "sin"),   (fsLit "cos"),
@@ -545,7 +561,7 @@ externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (ModuleInitTableLabel _)= False
 externallyVisibleCLabel ModuleRegdLabel    = False
 externallyVisibleCLabel (RtsLabel _)      = True
-externallyVisibleCLabel (ForeignLabel _ _ _) = True
+externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
 externallyVisibleCLabel (IdLabel name _ _)     = isExternalName name
 externallyVisibleCLabel (CC_Label _)      = True
 externallyVisibleCLabel (CCS_Label _)     = True
@@ -599,6 +615,7 @@ labelType (PlainModuleInitLabel _)            = CodeLabel
 labelType (ModuleInitTableLabel _)            = DataLabel
 labelType (LargeSRTLabel _)                   = DataLabel
 labelType (LargeBitmapLabel _)                = DataLabel
+labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
 labelType (IdLabel _ _ info) = idInfoLabelType info
 labelType _                = DataLabel
 
@@ -627,11 +644,11 @@ labelDynamic this_pkg lbl =
    RtsLabel _               -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
    IdLabel n _ k       -> isDllName this_pkg n
 #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
-   ForeignLabel _ _ _ -> True
+   ForeignLabel _ _ _ _ -> True
 #endif
    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
@@ -726,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).
-pprAsmCLbl (ForeignLabel fs (Just sz) _)
+pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
    = ftext fs <> char '@' <> int sz
 #endif
 pprAsmCLbl lbl
@@ -820,10 +837,10 @@ pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 pprCLbl ModuleRegdLabel
   = ptext (sLit "_module_registered")
 
-pprCLbl (ForeignLabel 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