Implemented and fixed bugs in CmmInfo handling

compiler/cmm/CLabel.hs

@@ -521,6 +521,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 
@@ -702,7 +704,11 @@ pprCLbl (CaseLabel u CaseDefault)
   = hcat [pprUnique u, ptext SLIT("_dflt")]
 
 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
-pprCLbl (LargeBitmapLabel u)  = pprUnique u <> pp_cSEP <> ptext SLIT("btm")
+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

compiler/cmm/Cmm.hs

@@ -9,9 +9,10 @@
 module Cmm ( 
 	GenCmm(..), Cmm, RawCmm,
 	GenCmmTop(..), CmmTop, RawCmmTop,
-	CmmInfo(..), ClosureTypeInfo(..), ProfilingInfo(..),
+	CmmInfo(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
 	GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
 	CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
+        CmmSafety(..),
 	CmmCallTarget(..),
 	CmmStatic(..), Section(..),
 	CmmExpr(..), cmmExprRep, 
@@ -133,12 +134,14 @@ data ClosureTypeInfo
 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
 type ClosureTypeTag = StgHalfWord
-type ClosureLayout = (StgHalfWord, StgHalfWord) -- pts, nptrs
+type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs
 type ConstrTag = StgHalfWord
 type ConstrDescription = CmmLit
 type FunType = StgHalfWord
 type FunArity = StgHalfWord
-type SlowEntry = CLabel
+type SlowEntry = CmmLit
+  -- ^We would like this to be a CLabel but
+  -- for now the parser sets this to zero on an INFO_TABLE_FUN.
 type SelectorOffset = StgWord
 
 -----------------------------------------------------------------------------
@@ -161,7 +164,7 @@ data CmmStmt
      CmmCallTarget
      CmmHintFormals		 -- zero or more results
      CmmActuals			 -- zero or more arguments
-     C_SRT			 -- SRT for the continuation of the call
+     CmmSafety			 -- whether to build a continuation
 
   | CmmBranch BlockId             -- branch to another BB in this fn
 
@@ -184,6 +187,7 @@ type CmmActuals = [(CmmActual,MachHint)]
 type CmmFormal = LocalReg
 type CmmHintFormals = [(CmmFormal,MachHint)]
 type CmmFormals = [CmmFormal]
+data CmmSafety = CmmUnsafe | CmmSafe C_SRT
 
 {-
 Discussion

compiler/cmm/CmmCPS.hs

@@ -70,9 +70,9 @@ cmmCPS dflags abstractC = do
   return continuationC
 
 stg_gc_gen = mkRtsApFastLabel SLIT("gen_cg_TODO") --panic "Need the label for gc"
-make_gc_block block_id fun_label formals srt = BasicBlock block_id stmts
+make_gc_block block_id fun_label formals safety = BasicBlock block_id stmts
     where
-      stmts = [CmmCall stg_gc_gen_target [] [] srt,
+      stmts = [CmmCall stg_gc_gen_target [] [] safety,
                CmmJump fun_expr actuals]
       stg_gc_gen_target =
           CmmForeignCall (CmmLit (CmmLabel stg_gc_gen)) CmmCallConv
@@ -85,10 +85,10 @@ force_gc_block old_info block_id fun_label formals blocks =
       CmmInfo _ (Just _) _ _ -> (old_info, [])
       CmmNonInfo Nothing
           -> (CmmNonInfo (Just block_id),
-              [make_gc_block block_id fun_label formals NoC_SRT])
+              [make_gc_block block_id fun_label formals (CmmSafe NoC_SRT)])
       CmmInfo prof Nothing type_tag type_info
         -> (CmmInfo prof (Just block_id) type_tag type_info,
-            [make_gc_block block_id fun_label formals srt])
+            [make_gc_block block_id fun_label formals (CmmSafe srt)])
            where
              srt = case type_info of
                      ConstrInfo _ _ _ -> NoC_SRT
@@ -361,9 +361,7 @@ applyStackFormat formats (Continuation (Left srt) label formals blocks) =
       -- TODO prof: this is the same as the current implementation
       -- but I think it could be improved
       prof = ProfilingInfo zeroCLit zeroCLit
-      tag = if stack_frame_size format > mAX_SMALL_BITMAP_SIZE
-            then rET_BIG
-            else rET_SMALL
+      tag = rET_SMALL -- cmmToRawCmm will convert this to rET_BIG if needed
       format = maybe unknown_block id $ lookup label formats
       unknown_block = panic "unknown BlockId in applyStackFormat"