X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPS.hs;h=b6c57eea9dc7d4e67c75a49066f7f3281a03b8d7;hb=d31dfb32ea936c22628b508c28a36c12e631430a;hp=be9f474cbeac98de98dab39e86f57fe6c4b20b14;hpb=1f46671fe24c7155ee64091b71b77dd66909e7a0;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index be9f474..b6c57ee 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/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"