add instance Outputable CLabel

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

diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
index a18755f..2f52e42 100644 (file)
--- a/ghc/compiler/cmm/CLabel.hs
+++ b/ghc/compiler/cmm/CLabel.hs
@@ -46,11 +46,13 @@ module CLabel (
        mkPlainModuleInitLabel,
 
        mkSplitMarkerLabel,
+       mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
        mkSeqInfoLabel,
        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
        mkMAP_FROZEN_infoLabel,
+       mkMAP_DIRTY_infoLabel,
         mkEMPTY_MVAR_infoLabel,
 
        mkTopTickyCtrLabel,
@@ -87,6 +89,7 @@ module CLabel (
         dynamicLinkerLabelInfo,
         
         mkPicBaseLabel,
+        mkDeadStripPreventer,
 
        infoLblToEntryLbl, entryLblToInfoLbl,
        needsCDecl, isAsmTemp, externallyVisibleCLabel,
@@ -97,13 +100,13 @@ module CLabel (
 
 
 #include "HsVersions.h"
-#include "../includes/ghcconfig.h"
 
-import CmdLineOpts      ( DynFlags, opt_Static, opt_DoTickyProfiling )
-import Packages                ( isHomeModule )
+import Packages                ( HomeModules )
+import StaticFlags     ( opt_Static, opt_DoTickyProfiling )
+import Packages                ( isHomeModule, isDllName )
 import DataCon         ( ConTag )
 import Module          ( moduleFS, Module )
-import Name            ( Name, isExternalName, nameModule )
+import Name            ( Name, isExternalName )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp )
 import Config          ( cLeadingUnderscore )
@@ -196,6 +199,10 @@ data CLabel
                                 -- assembler label '1'; it is pretty-printed
                                 -- as 1b, referring to the previous definition
                                 -- of 1: in the assembler source file.
+
+  | DeadStripPreventer CLabel
+    -- label before an info table to prevent excessive dead-stripping on darwin
+
   deriving (Eq, Ord)
 
 data IdLabelInfo
@@ -282,25 +289,21 @@ mkLocalInfoTableLabel     name    = IdLabel name  InfoTable
 mkLocalEntryLabel      name    = IdLabel name  Entry
 mkLocalClosureTableLabel name  = IdLabel name ClosureTable
 
-mkClosureLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name Closure
-  | otherwise                            = DynIdLabel name Closure
-  where mod = nameModule name
+mkClosureLabel hmods name
+  | isDllName hmods name = DynIdLabel    name Closure
+  | otherwise             = IdLabel name Closure
 
-mkInfoTableLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name InfoTable
-  | otherwise                            = DynIdLabel name InfoTable
-  where mod = nameModule name
+mkInfoTableLabel hmods name
+  | isDllName hmods name = DynIdLabel    name InfoTable
+  | otherwise           = IdLabel name InfoTable
 
-mkEntryLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name Entry
-  | otherwise                            = DynIdLabel name Entry
-  where mod = nameModule name
+mkEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name Entry
+  | otherwise             = IdLabel name Entry
 
-mkClosureTableLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name ClosureTable
-  | otherwise                            = DynIdLabel name ClosureTable
-  where mod = nameModule name
+mkClosureTableLabel hmods name
+  | isDllName hmods name = DynIdLabel    name ClosureTable
+  | otherwise             = IdLabel name ClosureTable
 
 mkLocalConInfoTableLabel     con = IdLabel con ConInfoTable
 mkLocalConEntryLabel        con = IdLabel con ConEntry
@@ -313,15 +316,13 @@ mkConInfoTableLabel name True  = DynIdLabel name ConInfoTable
 mkStaticInfoTableLabel name False = IdLabel    name StaticInfoTable
 mkStaticInfoTableLabel name True  = DynIdLabel name StaticInfoTable
 
-mkConEntryLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name ConEntry
-  | otherwise                            = DynIdLabel name ConEntry
-  where mod = nameModule name
+mkConEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name ConEntry
+  | otherwise             = IdLabel name ConEntry
 
-mkStaticConEntryLabel dflags name
-  | opt_Static || isHomeModule dflags mod = IdLabel    name StaticConEntry
-  | otherwise                            = DynIdLabel name StaticConEntry
-  where mod = nameModule name
+mkStaticConEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name StaticConEntry
+  | otherwise             = IdLabel name StaticConEntry
 
 
 mkReturnPtLabel uniq           = CaseLabel uniq CaseReturnPt
@@ -332,22 +333,24 @@ mkDefaultLabel  uniq              = CaseLabel uniq CaseDefault
 mkStringLitLabel               = StringLitLabel
 mkAsmTempLabel                         = AsmTempLabel
 
-mkModuleInitLabel :: DynFlags -> Module -> String -> CLabel
-mkModuleInitLabel dflags mod way
-  = ModuleInitLabel mod way $! (not (isHomeModule dflags mod))
+mkModuleInitLabel :: HomeModules -> Module -> String -> CLabel
+mkModuleInitLabel hmods mod way
+  = ModuleInitLabel mod way $! (not (isHomeModule hmods mod))
 
-mkPlainModuleInitLabel :: DynFlags -> Module -> CLabel
-mkPlainModuleInitLabel dflags mod
-  = PlainModuleInitLabel mod $! (not (isHomeModule dflags mod))
+mkPlainModuleInitLabel :: HomeModules -> Module -> CLabel
+mkPlainModuleInitLabel hmods mod
+  = PlainModuleInitLabel mod $! (not (isHomeModule hmods mod))
 
        -- Some fixed runtime system labels
 
 mkSplitMarkerLabel             = RtsLabel (RtsCode SLIT("__stg_split_marker"))
+mkDirty_MUT_VAR_Label          = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
 mkUpdInfoLabel                 = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 mkSeqInfoLabel                 = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
 mkIndStaticInfoLabel           = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
 mkMainCapabilityLabel          = RtsLabel (RtsData SLIT("MainCapability"))
-mkMAP_FROZEN_infoLabel         = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN"))
+mkMAP_FROZEN_infoLabel         = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
+mkMAP_DIRTY_infoLabel          = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
 mkEMPTY_MVAR_infoLabel         = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
 
 mkTopTickyCtrLabel             = RtsLabel (RtsData SLIT("top_ct"))
@@ -407,6 +410,9 @@ dynamicLinkerLabelInfo _ = Nothing
 mkPicBaseLabel :: CLabel
 mkPicBaseLabel = PicBaseLabel
 
+mkDeadStripPreventer :: CLabel -> CLabel
+mkDeadStripPreventer lbl = DeadStripPreventer lbl
+
 -- -----------------------------------------------------------------------------
 -- Converting info labels to entry labels.
 
@@ -455,7 +461,6 @@ needsCDecl (ModuleInitLabel _ _ _)  = True
 needsCDecl (PlainModuleInitLabel _ _)  = True
 needsCDecl ModuleRegdLabel             = False
 
-needsCDecl (CaseLabel _ _)             = False
 needsCDecl (StringLitLabel _)          = False
 needsCDecl (AsmTempLabel _)            = False
 needsCDecl (RtsLabel _)                        = False
@@ -609,6 +614,9 @@ tell whether a code fragment is a return point or a closure/function
 entry.
 -}
 
+instance Outputable CLabel where
+  ppr = pprCLabel
+
 pprCLabel :: CLabel -> SDoc
 
 #if ! OMIT_NATIVE_CODEGEN
@@ -624,6 +632,9 @@ pprCLabel (DynamicLinkerLabel info lbl)
    
 pprCLabel PicBaseLabel
    = ptext SLIT("1b")
+   
+pprCLabel (DeadStripPreventer lbl)
+   = pprCLabel lbl <> ptext SLIT("_dsp")
 #endif
 
 pprCLabel lbl = 
@@ -736,10 +747,10 @@ pprCLbl (CC_Label cc)             = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
 
 pprCLbl (ModuleInitLabel mod way _)    
-   = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
+   = ptext SLIT("__stginit_") <> ppr mod
        <> char '_' <> text way
 pprCLbl (PlainModuleInitLabel mod _)   
-   = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
+   = ptext SLIT("__stginit_") <> ppr mod
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <>
@@ -801,6 +812,8 @@ pprDynamicLinkerAsmLabel GotSymbolPtr lbl
   = pprCLabel lbl <> text "@got"
 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
   = pprCLabel lbl <> text "@gotoff"
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+  = text ".LC_" <> pprCLabel lbl
 #elif mingw32_TARGET_OS
 pprDynamicLinkerAsmLabel SymbolPtr lbl
   = text "__imp_" <> pprCLabel lbl