X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmHeap.hs;h=41637239472fa802b9307bd1bfd2395a7b165f07;hb=83d563cb9ede0ba792836e529b1e2929db926355;hp=817a896591855fd70b921b23353c67555082c156;hpb=01f842b978c903595d4b3184a0761d04a02e5b09;p=ghc-hetmet.git diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 817a896..4163723 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -40,9 +40,9 @@ import DataCon import TyCon import CostCentre import Outputable -import FastString( LitString, mkFastString, sLit ) +import Module +import FastString( mkFastString, FastString, fsLit ) import Constants -import Data.List ----------------------------------------------------------- @@ -350,11 +350,12 @@ entryHeapCheck fun arity args code gc_call updfr_sz | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) arg_exprs updfr_sz | otherwise = case gc_lbl args' of - Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl))) - arg_exprs updfr_sz + Just _lbl -> panic "StgCmmHeap.entryHeapCheck: gc_lbl not finished" + -- mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl))) + -- arg_exprs updfr_sz Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz - gc_lbl :: [LocalReg] -> Maybe LitString + gc_lbl :: [LocalReg] -> Maybe FastString {- gc_lbl [reg] | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p" @@ -373,7 +374,7 @@ entryHeapCheck fun arity args code gc_lbl regs = gc_lbl_ptrs (map (isGcPtrType . localRegType) regs) - gc_lbl_ptrs :: [Bool] -> Maybe LitString + gc_lbl_ptrs :: [Bool] -> Maybe FastString -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST... --gc_lbl_ptrs [True,True] = Just (sLit "stg_gc_fun_2p") --gc_lbl_ptrs [True,True,True] = Just (sLit "stg_gc_fun_3p") @@ -388,9 +389,10 @@ altHeapCheck regs code gc_call updfr_sz | null regs = mkCall generic_gc (GC, GC) [] [] updfr_sz - | Just gc_lbl <- rts_label regs -- Canned call - = mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC) - regs (map (CmmReg . CmmLocal) regs) updfr_sz + | Just _gc_lbl <- rts_label regs -- Canned call + = panic "StgCmmHeap.altHeapCheck: rts_label not finished" + -- mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC) + -- regs (map (CmmReg . CmmLocal) regs) updfr_sz | otherwise -- No canned call, and non-empty live vars = mkCall generic_gc (GC, GC) [] [] updfr_sz @@ -414,7 +416,7 @@ altHeapCheck regs code generic_gc :: CmmExpr -- The generic GC procedure; no params, no resuls -generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_noregs"))) +generic_gc = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs"))) -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST... -- generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_fun")))