X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FCLabel.hs;h=e42b92db5ad7bd7025b76032cac6f604355bd824;hb=04db0e9fa47ce4dfbcb73ec1752d94195f3b394e;hp=de6ca7adeb6e0b98e9249b9756a5b5eb5893c7cc;hpb=4c03d4ee9f9a1544608c3f8ee65ee59c30e9b8df;p=ghc-hetmet.git

diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
index de6ca7a..e42b92d 100644
--- 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,
@@ -78,6 +80,8 @@ module CLabel (
 	mkRtsCodeLabelFS,
 	mkRtsDataLabelFS,
 
+	mkRtsApFastLabel,
+
 	mkForeignLabel,
 
 	mkCCLabel, mkCCSLabel,
@@ -99,7 +103,7 @@ module CLabel (
 
 #include "HsVersions.h"
 
-import DynFlags		( DynFlags )
+import Packages		( HomeModules )
 import StaticFlags	( opt_Static, opt_DoTickyProfiling )
 import Packages		( isHomeModule, isDllName )
 import DataCon		( ConTag )
@@ -257,6 +261,8 @@ data RtsLabelInfo
   | RtsDataFS     FastString	-- misc rts data bits, eg CHARLIKE_closure
   | RtsCodeFS     FastString	-- misc rts code
 
+  | RtsApFast	LitString	-- _fast versions of generic apply
+
   | RtsSlowTickyCtr String
 
   deriving (Eq, Ord)
@@ -287,20 +293,20 @@ mkLocalInfoTableLabel  	name 	= IdLabel name  InfoTable
 mkLocalEntryLabel	name 	= IdLabel name  Entry
 mkLocalClosureTableLabel name	= IdLabel name ClosureTable
 
-mkClosureLabel dflags name
-  | isDllName dflags name = DynIdLabel    name Closure
+mkClosureLabel hmods name
+  | isDllName hmods name = DynIdLabel    name Closure
   | otherwise             = IdLabel name Closure
 
-mkInfoTableLabel dflags name
-  | isDllName dflags name = DynIdLabel    name InfoTable
+mkInfoTableLabel hmods name
+  | isDllName hmods name = DynIdLabel    name InfoTable
   | otherwise		 = IdLabel name InfoTable
 
-mkEntryLabel dflags name
-  | isDllName dflags name = DynIdLabel    name Entry
+mkEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name Entry
   | otherwise             = IdLabel name Entry
 
-mkClosureTableLabel dflags name
-  | isDllName dflags name = DynIdLabel    name ClosureTable
+mkClosureTableLabel hmods name
+  | isDllName hmods name = DynIdLabel    name ClosureTable
   | otherwise             = IdLabel name ClosureTable
 
 mkLocalConInfoTableLabel     con = IdLabel con ConInfoTable
@@ -314,12 +320,12 @@ mkConInfoTableLabel name True  = DynIdLabel name ConInfoTable
 mkStaticInfoTableLabel name False = IdLabel    name StaticInfoTable
 mkStaticInfoTableLabel name True  = DynIdLabel name StaticInfoTable
 
-mkConEntryLabel dflags name
-  | isDllName dflags name = DynIdLabel    name ConEntry
+mkConEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name ConEntry
   | otherwise             = IdLabel name ConEntry
 
-mkStaticConEntryLabel dflags name
-  | isDllName dflags name = DynIdLabel    name StaticConEntry
+mkStaticConEntryLabel hmods name
+  | isDllName hmods name = DynIdLabel    name StaticConEntry
   | otherwise             = IdLabel name StaticConEntry
 
 
@@ -331,22 +337,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_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"))
@@ -389,6 +397,8 @@ mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
 mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
 mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
 
+mkRtsApFastLabel str = RtsLabel (RtsApFast str)
+
 mkRtsSlowTickyCtrLabel :: String -> CLabel
 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 
@@ -516,6 +526,7 @@ labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
+labelType (RtsLabel (RtsApFast _))            = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 labelType (CaseLabel _ _)	              = CodeLabel
 labelType (ModuleInitLabel _ _ _)             = CodeLabel
@@ -610,6 +621,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
@@ -669,6 +683,8 @@ pprCLbl (RtsLabel (RtsData str))   = ptext str
 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 
+pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
+
 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 		ptext (if upd_reqd 
@@ -740,10 +756,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 <>