merge GHC HEAD
[ghc-hetmet.git] / compiler / cmm / CLabel.hs
index d55a1e4..1ba1126 100644 (file)
@@ -15,6 +15,8 @@
 
 module CLabel (
        CLabel, -- abstract type
+       ForeignLabelSource(..),
+       pprDebugCLabel,
 
        mkClosureLabel,
        mkSRTLabel,
@@ -49,13 +51,12 @@ module CLabel (
 
        mkAsmTempLabel,
 
-       mkModuleInitLabel,
-       mkPlainModuleInitLabel,
-       mkModuleInitTableLabel,
+        mkPlainModuleInitLabel,
 
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
+       mkBHUpdInfoLabel,
        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
        mkMAP_FROZEN_infoLabel,
@@ -67,19 +68,16 @@ module CLabel (
        mkRtsPrimOpLabel,
        mkRtsSlowTickyCtrLabel,
 
-       moduleRegdLabel,
-       moduleRegTableLabel,
-
-       mkSelectorInfoLabel,
+        mkSelectorInfoLabel,
        mkSelectorEntryLabel,
 
-       mkRtsInfoLabel,
-       mkRtsEntryLabel,
-       mkRtsRetInfoLabel,
-       mkRtsRetLabel,
-       mkRtsCodeLabel,
-       mkRtsDataLabel,
-       mkRtsGcPtrLabel,
+       mkCmmInfoLabel,
+       mkCmmEntryLabel,
+       mkCmmRetInfoLabel,
+       mkCmmRetLabel,
+       mkCmmCodeLabel,
+       mkCmmDataLabel,
+       mkCmmGcPtrLabel,
 
        mkRtsApFastLabel,
 
@@ -99,7 +97,6 @@ module CLabel (
         mkDeadStripPreventer,
 
         mkHpcTicksLabel,
-        mkHpcModuleNameLabel,
 
         hasCAF,
        infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
@@ -164,23 +161,28 @@ data CLabel
   
   -- | A label from a .cmm file that is not associated with a .hs level Id.
   | CmmLabel                   
-       Module                  -- what Cmm source module the label belongs to
+       PackageId               -- 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 Module argument.
+  --    instead and give it an appropriate PackageId argument.
   | RtsLabel                   
        RtsLabelInfo
 
-  -- | A 'C' (or otherwise foreign) label
-  | ForeignLabel FastString     
+  -- | A 'C' (or otherwise foreign) 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.
-        Bool                    -- True <=> is dynamic
+
+       ForeignLabelSource      -- what package the foreign label is in.
+       
         FunctionOrData
 
   -- | A family of labels related to a particular case expression.
@@ -194,23 +196,9 @@ data CLabel
   | StringLitLabel
        {-# UNPACK #-} !Unique
 
-  | ModuleInitLabel 
-       Module                  -- the module name
-       String                  -- its "way"
-       -- at some point we might want some kind of version number in
-       -- the module init label, to guard against compiling modules in
-       -- the wrong order.  We can't use the interface file version however,
-       -- because we don't always recompile modules which depend on a module
-       -- whose version has changed.
-
-  | PlainModuleInitLabel       -- without the version & way info
+  | PlainModuleInitLabel        -- without the version & way info
        Module
 
-  | ModuleInitTableLabel       -- table of imported modules to init
-       Module
-
-  | ModuleRegdLabel
-
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack
 
@@ -234,9 +222,6 @@ data CLabel
   -- | Per-module table of tick locations
   | HpcTicksLabel Module
 
-  -- | Per-module name of the module for Hpc
-  | HpcModuleNameLabel
-
   -- | Label of an StgLargeSRT
   | LargeSRTLabel
         {-# UNPACK #-} !Unique
@@ -247,6 +232,56 @@ data CLabel
 
   deriving (Eq, Ord)
 
+
+-- | Record where a foreign label is stored.
+data ForeignLabelSource
+
+   -- | Label is in a named package
+   = ForeignLabelInPackage     PackageId
+  
+   -- | 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 
+
+   -- | 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.
+   | ForeignLabelInThisPackage
+      
+   deriving (Eq, Ord)   
+
+closureSuffix' :: Name -> SDoc
+closureSuffix' hs_fn =
+    if depth==0 then ptext (sLit "") else ptext (sLit $ (show depth))
+          where depth = getNameDepth hs_fn
+
+-- | 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.
+--
+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")
+
+       ForeignLabel name mSuffix src funOrData
+        -> ppr lbl <> (parens 
+                               $ text "ForeignLabel" 
+                               <+> ppr mSuffix
+                               <+> ppr src  
+                               <+> ppr funOrData)
+
+       _               -> ppr lbl <> (parens $ text "other CLabel)")
+
+
 data IdLabelInfo
   = Closure            -- ^ Label for closure
   | SRT                 -- ^ Static reference table
@@ -301,6 +336,7 @@ data CmmLabelInfo
   | 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
   deriving (Eq, Ord)
 
 data DynamicLinkerLabelInfo
@@ -342,38 +378,31 @@ mkStaticInfoTableLabel name c     = IdLabel    name c StaticInfoTable
 mkConEntryLabel name        c     = IdLabel name c ConEntry
 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 
-
 -- Constructing Cmm Labels
-
--- | Pretend that wired-in names from the RTS are in a top-level module called RTS, 
---      located in the RTS package. It doesn't matter what module they're actually in
---      as long as that module is in the correct package.
-topRtsModule :: Module
-topRtsModule = mkModule rtsPackageId (mkModuleNameFS (fsLit "RTS"))
-
-mkSplitMarkerLabel             = CmmLabel topRtsModule (fsLit "__stg_split_marker")    CmmCode
-mkDirty_MUT_VAR_Label          = CmmLabel topRtsModule (fsLit "dirty_MUT_VAR")         CmmCode
-mkUpdInfoLabel                 = CmmLabel topRtsModule (fsLit "stg_upd_frame")         CmmInfo
-mkIndStaticInfoLabel           = CmmLabel topRtsModule (fsLit "stg_IND_STATIC")        CmmInfo
-mkMainCapabilityLabel          = CmmLabel topRtsModule (fsLit "MainCapability")        CmmData
-mkMAP_FROZEN_infoLabel         = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel          = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel         = CmmLabel topRtsModule (fsLit "stg_EMPTY_MVAR")        CmmInfo
-mkTopTickyCtrLabel             = CmmLabel topRtsModule (fsLit "top_ct")                CmmData
-mkCAFBlackHoleInfoTableLabel   = CmmLabel topRtsModule (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
+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
 
 -----
-mkRtsInfoLabel,   mkRtsEntryLabel, mkRtsRetInfoLabel, mkRtsRetLabel,
-  mkRtsCodeLabel, mkRtsDataLabel,  mkRtsGcPtrLabel
-       :: FastString -> CLabel
+mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
+  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
+       :: PackageId -> FastString -> CLabel
 
-mkRtsInfoLabel      str        = CmmLabel topRtsModule str CmmInfo
-mkRtsEntryLabel     str        = CmmLabel topRtsModule str CmmEntry
-mkRtsRetInfoLabel   str        = CmmLabel topRtsModule str CmmRetInfo
-mkRtsRetLabel       str        = CmmLabel topRtsModule str CmmRet
-mkRtsCodeLabel      str                = CmmLabel topRtsModule str CmmCode
-mkRtsDataLabel      str                = CmmLabel topRtsModule str CmmData
-mkRtsGcPtrLabel     str                = CmmLabel topRtsModule 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
+mkCmmGcPtrLabel     pkg str    = CmmLabel pkg str CmmGcPtr
 
 
 -- Constructing RtsLabels
@@ -386,22 +415,34 @@ mkApInfoTableLabel   upd off      = RtsLabel (RtsApInfoTable       upd off)
 mkApEntryLabel       upd off   = RtsLabel (RtsApEntry           upd off)
 
 
--- Constructing ForeignLabels
--- Primitive / cmm call labels
+-- A call to some primitive hand written Cmm code
 mkPrimCallLabel :: PrimCall -> CLabel
-mkPrimCallLabel (PrimCall str)  = ForeignLabel str Nothing False IsFunction
+mkPrimCallLabel (PrimCall str pkg)  
+       = CmmLabel pkg str CmmPrimCall
 
--- Foreign labels
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
-mkForeignLabel str mb_sz is_dynamic fod
-    = ForeignLabel str mb_sz is_dynamic fod
 
+-- Constructing ForeignLabels
+
+-- | Make a foreign label
+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
+
+
+-- | Update the label size field in a ForeignLabel
 addLabelSize :: CLabel -> Int -> CLabel
-addLabelSize (ForeignLabel str _ is_dynamic fod) sz
-    = ForeignLabel str (Just sz) is_dynamic fod
+addLabelSize (ForeignLabel str _ src  fod) sz
+    = ForeignLabel str (Just sz) src fod
 addLabelSize label _
     = label
 
+-- | Get the label size field from a ForeignLabel
 foreignLabelStdcallInfo :: CLabel -> Maybe Int
 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
 foreignLabelStdcallInfo _lbl = Nothing
@@ -430,7 +471,6 @@ mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 
 -- Constructing Code Coverage Labels
 mkHpcTicksLabel                = HpcTicksLabel
-mkHpcModuleNameLabel           = HpcModuleNameLabel
 
 
 -- Constructing labels used for dynamic linking
@@ -455,19 +495,9 @@ mkStringLitLabel           = StringLitLabel
 mkAsmTempLabel :: Uniquable a => a -> CLabel
 mkAsmTempLabel a               = AsmTempLabel (getUnique a)
 
-mkModuleInitLabel :: Module -> String -> CLabel
-mkModuleInitLabel mod way      = ModuleInitLabel mod way
-
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod     = PlainModuleInitLabel mod
 
-mkModuleInitTableLabel :: Module -> CLabel
-mkModuleInitTableLabel mod     = ModuleInitTableLabel mod
-
-moduleRegdLabel                        = ModuleRegdLabel
-moduleRegTableLabel            = ModuleInitTableLabel  
-
-
 -- -----------------------------------------------------------------------------
 -- Converting between info labels and entry/ret labels.
 
@@ -496,6 +526,7 @@ entryLblToInfoLbl 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   (IdLabel n c RednCounts)     = IdLabel n c Closure
 cvtToClosureLbl l@(IdLabel n c Closure)                = l
 cvtToClosureLbl l 
        = pprPanic "cvtToClosureLbl" (pprCLabel l)
@@ -530,19 +561,24 @@ needsCDecl (LargeSRTLabel _)              = False
 needsCDecl (LargeBitmapLabel _)                = False
 needsCDecl (IdLabel _ _ _)             = True
 needsCDecl (CaseLabel _ _)             = True
-needsCDecl (ModuleInitLabel _ _)       = True
-needsCDecl (PlainModuleInitLabel _)    = True
-needsCDecl (ModuleInitTableLabel _)    = True
-needsCDecl ModuleRegdLabel             = False
+needsCDecl (PlainModuleInitLabel _)     = True
 
 needsCDecl (StringLitLabel _)          = False
 needsCDecl (AsmTempLabel _)            = False
 needsCDecl (RtsLabel _)                        = False
-needsCDecl l@(ForeignLabel _ _ _ _)    = not (isMathFun l)
+
+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 HpcModuleNameLabel           = False
 
 
 -- | Check whether a label is a local temporary for native code generation
@@ -558,12 +594,12 @@ 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 abovoid generating our
+--      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 = mkUniqSet [
@@ -647,29 +683,24 @@ 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.
-
+-- | 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.
 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)                = False
 externallyVisibleCLabel (StringLitLabel _)     = False
 externallyVisibleCLabel (AsmTempLabel _)       = False
-externallyVisibleCLabel (ModuleInitLabel _ _)  = True
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
-externallyVisibleCLabel (ModuleInitTableLabel _)= False
-externallyVisibleCLabel ModuleRegdLabel                = False
-externallyVisibleCLabel (RtsLabel _)           = True
-externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
+externallyVisibleCLabel (RtsLabel _)            = True
+externallyVisibleCLabel (CmmLabel _ _ _)       = True
+externallyVisibleCLabel (ForeignLabel{})       = True
 externallyVisibleCLabel (IdLabel name _ _)     = isExternalName name
 externallyVisibleCLabel (CC_Label _)           = True
 externallyVisibleCLabel (CCS_Label _)          = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)      = True
-externallyVisibleCLabel HpcModuleNameLabel     = False
-externallyVisibleCLabel (LargeBitmapLabel _)   = False
+externallyVisibleCLabel (LargeBitmapLabel _)    = False
 externallyVisibleCLabel (LargeSRTLabel _)      = False
 
 -- -----------------------------------------------------------------------------
@@ -708,12 +739,10 @@ labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
 labelType (CaseLabel _ _)                      = CodeLabel
-labelType (ModuleInitLabel _ _)                 = CodeLabel
 labelType (PlainModuleInitLabel _)              = CodeLabel
-labelType (ModuleInitTableLabel _)              = DataLabel
 labelType (LargeSRTLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
-labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
+labelType (ForeignLabel _ _ _ IsFunction)      = CodeLabel
 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 labelType _                                     = DataLabel
 
@@ -739,19 +768,37 @@ idInfoLabelType info =
 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?
-   IdLabel n _ k       -> isDllName this_pkg n
+   -- is the RTS in a DLL or not?
+   RtsLabel _                  -> not opt_Static && (this_pkg /= rtsPackageId)
+
+   IdLabel n _ k       -> isDllName this_pkg n
+
 #if mingw32_TARGET_OS
-   ForeignLabel _ _ d _ -> d
+   -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
+   CmmLabel pkg _ _
+    -> not opt_Static && (this_pkg /= pkg)
+
+   -- Foreign label is in some un-named foreign package (or DLL)
+   ForeignLabel _ _ ForeignLabelInExternalPackage _  -> True
+
+   -- Foreign label is linked into the same package as the source file currently being compiled.
+   ForeignLabel _ _ ForeignLabelInThisPackage  _     -> False
+      
+   -- Foreign label is in some named package.
+   --  When compiling in the "dyn" way, each package is to be linked into its own DLL.
+   ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
+    -> (not opt_Static) && (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
    ForeignLabel _ _ _ _ -> True
+
+   CmmLabel pkg _ _     -> True 
+
 #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
 
@@ -807,8 +854,8 @@ instance Outputable CLabel where
 
 pprCLabel :: CLabel -> SDoc
 
-#if ! OMIT_NATIVE_CODEGEN
 pprCLabel (AsmTempLabel u)
+ | cGhcWithNativeCodeGen == "YES"
   =  getPprStyle $ \ sty ->
      if asmStyle sty then 
        ptext asmTempLabelPrefix <> pprUnique u
@@ -816,23 +863,22 @@ pprCLabel (AsmTempLabel u)
        char '_' <> pprUnique u
 
 pprCLabel (DynamicLinkerLabel info lbl)
+ | cGhcWithNativeCodeGen == "YES"
    = pprDynamicLinkerAsmLabel info lbl
    
 pprCLabel PicBaseLabel
+ | cGhcWithNativeCodeGen == "YES"
    = ptext (sLit "1b")
    
 pprCLabel (DeadStripPreventer lbl)
+ | cGhcWithNativeCodeGen == "YES"
    = pprCLabel lbl <> ptext (sLit "_dsp")
-#endif
 
-pprCLabel lbl = 
-#if ! OMIT_NATIVE_CODEGEN
-    getPprStyle $ \ sty ->
-    if asmStyle sty then 
-       maybe_underscore (pprAsmCLbl lbl)
-    else
-#endif
-       pprCLbl lbl
+pprCLabel lbl
+   = getPprStyle $ \ sty ->
+     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
+     then maybe_underscore (pprAsmCLbl lbl)
+     else pprCLbl lbl
 
 maybe_underscore doc
   | underscorePrefix = pp_cSEP <> doc
@@ -869,6 +915,7 @@ pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi
 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")
 
@@ -918,35 +965,22 @@ pprCLbl (RtsLabel (RtsPrimOp primop))
 pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) 
   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 
-pprCLbl ModuleRegdLabel
-  = ptext (sLit "_module_registered")
-
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
 
-pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor name flavor
 
 pprCLbl (CC_Label cc)          = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
 
-pprCLbl (ModuleInitLabel mod way)
-   = 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 HpcModuleNameLabel
-  = ptext (sLit "_hpc_module_name_str")
-
-ppIdFlavor :: IdLabelInfo -> SDoc
-ppIdFlavor x = pp_cSEP <>
+ppIdFlavor :: Name -> IdLabelInfo -> SDoc
+ppIdFlavor n x = pp_cSEP <> closureSuffix' n <>
               (case x of
                       Closure          -> ptext (sLit "closure")
                       SRT              -> ptext (sLit "srt")
@@ -964,6 +998,14 @@ ppIdFlavor x = pp_cSEP <>
 
 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"
+
 -- -----------------------------------------------------------------------------
 -- Machine-dependent knowledge about labels.
 
@@ -1006,7 +1048,7 @@ pprDynamicLinkerAsmLabel SymbolPtr lbl
 pprDynamicLinkerAsmLabel _ _
   = panic "pprDynamicLinkerAsmLabel"
 
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
+#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
 pprDynamicLinkerAsmLabel CodeStub lbl
   = pprCLabel lbl <> text "@plt"
 pprDynamicLinkerAsmLabel SymbolPtr lbl
@@ -1014,7 +1056,7 @@ pprDynamicLinkerAsmLabel SymbolPtr lbl
 pprDynamicLinkerAsmLabel _ _
   = panic "pprDynamicLinkerAsmLabel"
 
-#elif x86_64_TARGET_ARCH && linux_TARGET_OS
+#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
 pprDynamicLinkerAsmLabel CodeStub lbl
   = pprCLabel lbl <> text "@plt"
 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
@@ -1024,7 +1066,7 @@ pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 pprDynamicLinkerAsmLabel SymbolPtr lbl
   = text ".LC_" <> pprCLabel lbl
 
-#elif linux_TARGET_OS
+#elif elf_OBJ_FORMAT
 pprDynamicLinkerAsmLabel CodeStub lbl
   = pprCLabel lbl <> text "@plt"
 pprDynamicLinkerAsmLabel SymbolPtr lbl