X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgHeapery.lhs;h=8d4f7f232afaaa37fd8ced59252153e06e1f5e6c;hb=984a288119983912d40a80845c674ee4b83a19ce;hp=df3720cd2dcf85ee48a2310d079bffbf83edb45b;hpb=40fcfe10c97edf2981031f1a8450bb82ba6a8879;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index df3720c..8d4f7f2 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -78,7 +78,7 @@ initHeapUsage :: (VirtualHpOffset -> Code) -> Code initHeapUsage fcode = do { orig_hp_usage <- getHpUsage ; setHpUsage initHpUsage - ; fixC (\heap_usage2 -> do + ; fixC_(\heap_usage2 -> do { fcode (heapHWM heap_usage2) ; getHpUsage }) ; setHpUsage orig_hp_usage } @@ -346,7 +346,7 @@ altHeapCheck alt_type code ; setRealHp hpHw ; code } where - rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_unpt_r1"))) + rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_unpt_r1"))) -- Do *not* enter R1 after a heap check in -- a polymorphic case. It might be a function -- and the entry code for a function (currently) @@ -360,14 +360,14 @@ altHeapCheck alt_type code rts_label (PrimAlt tc) = CmmLit $ CmmLabel $ case primRepToCgRep (tyConPrimRep tc) of - VoidArg -> mkRtsCodeLabel (sLit "stg_gc_noregs") - FloatArg -> mkRtsCodeLabel (sLit "stg_gc_f1") - DoubleArg -> mkRtsCodeLabel (sLit "stg_gc_d1") - LongArg -> mkRtsCodeLabel (sLit "stg_gc_l1") + VoidArg -> mkRtsCodeLabel (fsLit "stg_gc_noregs") + FloatArg -> mkRtsCodeLabel (fsLit "stg_gc_f1") + DoubleArg -> mkRtsCodeLabel (fsLit "stg_gc_d1") + LongArg -> mkRtsCodeLabel (fsLit "stg_gc_l1") -- R1 is boxed but unlifted: - PtrArg -> mkRtsCodeLabel (sLit "stg_gc_unpt_r1") + PtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unpt_r1") -- R1 is unboxed: - NonPtrArg -> mkRtsCodeLabel (sLit "stg_gc_unbx_r1") + NonPtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unbx_r1") rts_label (UbxTupAlt _) = panic "altHeapCheck" \end{code} @@ -405,7 +405,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr)) -- Ho ho ho! (CmmLit (mkWordCLit liveness)) liveness = mkRegLiveness regs ptrs nptrs - rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_ut"))) + rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_ut"))) \end{code} @@ -514,7 +514,7 @@ stkChkNodePoints bytes = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1 stg_gc_gen :: CmmExpr -stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_gen"))) +stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_gen"))) stg_gc_enter1 :: CmmExpr stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1) \end{code}