X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCLabel.hs;h=3585bde0fba5de3e5dab14b8fe8b4eccc9a285e0;hb=48fb2b521898998a17873ad6cf30610aa5ab6db3;hp=0918cc8cef29584e3de77b1fccb08447bd624bf4;hpb=affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec;p=ghc-hetmet.git

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 0918cc8..3585bde 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -95,7 +95,7 @@ module CLabel (
         mkHpcTicksLabel,
         mkHpcModuleNameLabel,
 
-	infoLblToEntryLbl, entryLblToInfoLbl,
+	infoLblToEntryLbl, entryLblToInfoLbl, infoLblToRetLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
 	CLabelType(..), labelType, labelDynamic,
 
@@ -213,6 +213,9 @@ data CLabel
   | LargeSRTLabel           -- Label of an StgLargeSRT
         {-# UNPACK #-} !Unique
 
+  | LargeBitmapLabel        -- A bitmap (function or case return)
+        {-# UNPACK #-} !Unique
+
   deriving (Eq, Ord)
 
 data IdLabelInfo
@@ -225,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,7 +291,6 @@ data DynamicLinkerLabelInfo
 -- These are always local:
 mkSRTLabel		name 	= IdLabel name  SRT
 mkSlowEntryLabel      	name 	= IdLabel name  Slow
-mkBitmapLabel   	name 	= IdLabel name  Bitmap
 mkRednCountsLabel     	name 	= IdLabel name  RednCounts
 
 -- These have local & (possibly) external variants:
@@ -335,6 +335,7 @@ mkStaticConEntryLabel this_pkg name
   | otherwise             = IdLabel name StaticConEntry
 
 mkLargeSRTLabel	uniq 	= LargeSRTLabel uniq
+mkBitmapLabel	uniq 	= LargeBitmapLabel uniq
 
 mkReturnPtLabel uniq		= CaseLabel uniq CaseReturnPt
 mkReturnInfoLabel uniq		= CaseLabel uniq CaseReturnInfo
@@ -431,7 +432,7 @@ mkDeadStripPreventer :: CLabel -> CLabel
 mkDeadStripPreventer lbl = DeadStripPreventer lbl
 
 -- -----------------------------------------------------------------------------
--- Converting info labels to entry labels.
+-- Converting between info labels and entry/ret labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 
 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
@@ -461,6 +462,12 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 
+infoLblToRetLbl :: CLabel -> CLabel 
+infoLblToRetLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsRet s)
+infoLblToRetLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl _ = panic "CLabel.infoLblToRetLbl"
+
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
 
@@ -470,7 +477,7 @@ needsCDecl :: CLabel -> Bool
   -- they are defined before use.
 needsCDecl (IdLabel _ SRT)		= False
 needsCDecl (LargeSRTLabel _)		= False
-needsCDecl (IdLabel _ Bitmap)		= False
+needsCDecl (LargeBitmapLabel _)		= False
 needsCDecl (IdLabel _ _)		= True
 needsCDecl (DynIdLabel _ _)		= True
 needsCDecl (CaseLabel _ _)	        = True
@@ -520,6 +527,8 @@ externallyVisibleCLabel (CCS_Label _)	   = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)   = True
 externallyVisibleCLabel HpcModuleNameLabel      = False
+externallyVisibleCLabel (LargeBitmapLabel _) = False
+externallyVisibleCLabel (LargeSRTLabel _) = False
 
 -- -----------------------------------------------------------------------------
 -- Finding the "type" of a CLabel 
@@ -550,6 +559,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
@@ -559,7 +570,6 @@ idInfoLabelType info =
   case info of
     InfoTable  	  -> DataLabel
     Closure    	  -> DataLabel
-    Bitmap     	  -> DataLabel
     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
@@ -700,6 +710,11 @@ 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
@@ -799,7 +814,6 @@ ppIdFlavor x = pp_cSEP <>
 		       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")