Implemented and fixed bugs in CmmInfo handling

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

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index d96d416..ffca61d 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -11,7 +11,6 @@ module CLabel (
 
        mkClosureLabel,
        mkSRTLabel,
-       mkSRTDescLabel,
        mkInfoTableLabel,
        mkEntryLabel,
        mkSlowEntryLabel,
@@ -20,6 +19,7 @@ module CLabel (
        mkRednCountsLabel,
        mkConInfoTableLabel,
        mkStaticInfoTableLabel,
+       mkLargeSRTLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
        mkClosureTableLabel,
@@ -48,7 +48,6 @@ module CLabel (
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
-       mkSeqInfoLabel,
        mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
        mkMAP_FROZEN_infoLabel,
@@ -95,10 +94,9 @@ module CLabel (
 
         mkHpcTicksLabel,
         mkHpcModuleNameLabel,
-        mkHpcModuleOffsetLabel,
 
        infoLblToEntryLbl, entryLblToInfoLbl,
-       needsCDecl, isAsmTemp, externallyVisibleCLabel,
+       needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
        CLabelType(..), labelType, labelDynamic,
 
        pprCLabel
@@ -211,14 +209,18 @@ data CLabel
 
   | HpcTicksLabel Module       -- Per-module table of tick locations
   | HpcModuleNameLabel         -- Per-module name of the module for Hpc
-  | HpcModuleOffsetLabel Module-- Per-module offset of the module for Hpc (dynamically generated)
+
+  | LargeSRTLabel           -- Label of an StgLargeSRT
+        {-# UNPACK #-} !Unique
+
+  | LargeBitmapLabel        -- A bitmap (function or case return)
+        {-# UNPACK #-} !Unique
 
   deriving (Eq, Ord)
 
 data IdLabelInfo
   = Closure            -- Label for closure
   | SRT                 -- Static reference table
-  | SRTDesc             -- Static reference table descriptor
   | InfoTable          -- Info tables for closures; always read-only
   | Entry              -- entry point
   | Slow               -- slow entry point
@@ -226,8 +228,6 @@ data IdLabelInfo
   | RednCounts         -- Label of place to keep Ticky-ticky  info for 
                        -- this Id
 
-  | Bitmap             -- A bitmap (function or case return)
-
   | ConEntry           -- constructor entry point
   | ConInfoTable               -- corresponding info table
   | StaticConEntry     -- static constructor entry point
@@ -290,9 +290,7 @@ data DynamicLinkerLabelInfo
 
 -- These are always local:
 mkSRTLabel             name    = IdLabel name  SRT
-mkSRTDescLabel         name    = IdLabel name  SRTDesc
 mkSlowEntryLabel       name    = IdLabel name  Slow
-mkBitmapLabel          name    = IdLabel name  Bitmap
 mkRednCountsLabel      name    = IdLabel name  RednCounts
 
 -- These have local & (possibly) external variants:
@@ -336,6 +334,8 @@ mkStaticConEntryLabel this_pkg name
   | isDllName this_pkg name = DynIdLabel    name StaticConEntry
   | otherwise             = IdLabel name StaticConEntry
 
+mkLargeSRTLabel        uniq    = LargeSRTLabel uniq
+mkBitmapLabel  uniq    = LargeBitmapLabel uniq
 
 mkReturnPtLabel uniq           = CaseLabel uniq CaseReturnPt
 mkReturnInfoLabel uniq         = CaseLabel uniq CaseReturnInfo
@@ -358,7 +358,6 @@ mkPlainModuleInitLabel this_pkg mod
 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"))
@@ -414,7 +413,6 @@ mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 
 mkHpcTicksLabel                = HpcTicksLabel
 mkHpcModuleNameLabel           = HpcModuleNameLabel
-mkHpcModuleOffsetLabel         = HpcModuleOffsetLabel
 
         -- Dynamic linking
         
@@ -472,8 +470,8 @@ needsCDecl :: CLabel -> Bool
   -- don't bother declaring SRT & Bitmap labels, we always make sure
   -- they are defined before use.
 needsCDecl (IdLabel _ SRT)             = False
-needsCDecl (IdLabel _ SRTDesc)         = False
-needsCDecl (IdLabel _ Bitmap)          = False
+needsCDecl (LargeSRTLabel _)           = False
+needsCDecl (LargeBitmapLabel _)                = False
 needsCDecl (IdLabel _ _)               = True
 needsCDecl (DynIdLabel _ _)            = True
 needsCDecl (CaseLabel _ _)             = True
@@ -488,7 +486,6 @@ needsCDecl (ForeignLabel _ _ _)             = False
 needsCDecl (CC_Label _)                        = True
 needsCDecl (CCS_Label _)               = True
 needsCDecl (HpcTicksLabel _)            = True
-needsCDecl (HpcModuleOffsetLabel _)     = True
 needsCDecl HpcModuleNameLabel           = False
 
 -- Whether the label is an assembler temporary:
@@ -497,6 +494,10 @@ isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generati
 isAsmTemp (AsmTempLabel _) = True
 isAsmTemp _               = False
 
+maybeAsmTemp :: CLabel -> Maybe Unique
+maybeAsmTemp (AsmTempLabel uq) = Just uq
+maybeAsmTemp _                        = Nothing
+
 -- -----------------------------------------------------------------------------
 -- Is a CLabel visible outside this object file or not?
 
@@ -519,8 +520,9 @@ externallyVisibleCLabel (CC_Label _)           = True
 externallyVisibleCLabel (CCS_Label _)     = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)   = True
-externallyVisibleCLabel (HpcModuleOffsetLabel _)  = True
 externallyVisibleCLabel HpcModuleNameLabel      = False
+externallyVisibleCLabel (LargeBitmapLabel _) = False
+externallyVisibleCLabel (LargeSRTLabel _) = False
 
 -- -----------------------------------------------------------------------------
 -- Finding the "type" of a CLabel 
@@ -551,6 +553,8 @@ labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 labelType (CaseLabel _ _)                    = CodeLabel
 labelType (ModuleInitLabel _ _ _)             = CodeLabel
 labelType (PlainModuleInitLabel _ _)          = CodeLabel
+labelType (LargeSRTLabel _)                   = DataLabel
+labelType (LargeBitmapLabel _)                = DataLabel
 
 labelType (IdLabel _ info) = idInfoLabelType info
 labelType (DynIdLabel _ info) = idInfoLabelType info
@@ -560,10 +564,11 @@ idInfoLabelType info =
   case info of
     InfoTable            -> DataLabel
     Closure              -> DataLabel
-    Bitmap               -> DataLabel
     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
+-- krc: aie! a ticky counter label is data
+    RednCounts    -> DataLabel
     _            -> CodeLabel
 
 
@@ -698,6 +703,13 @@ pprCLbl (CaseLabel u (CaseAlt tag))
 pprCLbl (CaseLabel u CaseDefault)
   = hcat [pprUnique u, ptext SLIT("_dflt")]
 
+pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
+pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
+-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
+-- until that gets resolved we'll just force them to start
+-- with a letter so the label will be legal assmbly code.
+        
+
 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 pprCLbl (RtsLabel (RtsData str))   = ptext str
 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
@@ -784,9 +796,6 @@ pprCLbl (PlainModuleInitLabel mod _)
 pprCLbl (HpcTicksLabel mod)
   = ptext SLIT("_hpc_tickboxes_")  <> ppr mod <> ptext SLIT("_hpc")
 
-pprCLbl (HpcModuleOffsetLabel mod)
-  = ptext SLIT("_hpc_module_offset_")  <> ppr mod <> ptext SLIT("_hpc")
-
 pprCLbl HpcModuleNameLabel
   = ptext SLIT("_hpc_module_name_str")
 
@@ -795,12 +804,10 @@ ppIdFlavor x = pp_cSEP <>
               (case x of
                       Closure          -> ptext SLIT("closure")
                       SRT              -> ptext SLIT("srt")
-                      SRTDesc          -> ptext SLIT("srtd")
                       InfoTable        -> ptext SLIT("info")
                       Entry            -> ptext SLIT("entry")
                       Slow             -> ptext SLIT("slow")
                       RednCounts       -> ptext SLIT("ct")
-                      Bitmap           -> ptext SLIT("btm")
                       ConEntry         -> ptext SLIT("con_entry")
                       ConInfoTable     -> ptext SLIT("con_info")
                       StaticConEntry   -> ptext SLIT("static_entry")
@@ -861,8 +868,8 @@ pprDynamicLinkerAsmLabel GotSymbolPtr lbl
   = pprCLabel lbl <> text "@gotpcrel"
 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
   = pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
+pprDynamicLinkerAsmLabel SymbolPtr lbl
+  = text ".LC_" <> pprCLabel lbl
 #elif linux_TARGET_OS
 pprDynamicLinkerAsmLabel CodeStub lbl
   = pprCLabel lbl <> text "@plt"