Initial checkin of HetMet / -XModalTypes modifications

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

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index d7f7724..4e9ef8c 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -58,6 +58,7 @@ module CLabel (
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
+       mkBHUpdInfoLabel,
        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
        mkMAP_FROZEN_infoLabel,
@@ -276,6 +277,10 @@ data ForeignLabelSource
       
    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.
@@ -400,6 +405,7 @@ mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 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
@@ -1011,7 +1017,7 @@ pprCLbl ModuleRegdLabel
 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
@@ -1032,8 +1038,8 @@ pprCLbl (HpcTicksLabel mod)
 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")
@@ -1101,7 +1107,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
@@ -1109,7 +1115,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
@@ -1119,7 +1125,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