pass arguments to unknown function calls in registers

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

diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
index 296ad91..e42b92d 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,
@@ -78,6 +80,8 @@ module CLabel (
        mkRtsCodeLabelFS,
        mkRtsDataLabelFS,
 
+       mkRtsApFastLabel,
+
        mkForeignLabel,
 
        mkCCLabel, mkCCSLabel,
@@ -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)
@@ -342,11 +348,13 @@ mkPlainModuleInitLabel 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 <>