- where
- non_void_regs = filter (/= VoidReg) regs
-
- checking_code tag_assts =
- case non_void_regs of
-
-{- no: there might be stuff on top of the retn. addr. on the stack.
- [{-no regs-}] ->
- CCheck HP_CHK_NOREGS
- [mkIntCLit words_required]
- tag_assts
--}
- -- this will cover all cases for x86
- [VanillaReg rep 1#]
-
- | isFollowableRep rep ->
- CCheck HP_CHK_UT_ALT
- [mkIntCLit words_required, mkIntCLit 1, mkIntCLit 0,
- CReg (VanillaReg RetRep 2#),
- CLbl (mkReturnInfoLabel ret_addr) RetRep]
- tag_assts
-
- | otherwise ->
- CCheck HP_CHK_UT_ALT
- [mkIntCLit words_required, mkIntCLit 0, mkIntCLit 1,
- CReg (VanillaReg RetRep 2#),
- CLbl (mkReturnInfoLabel ret_addr) RetRep]
- tag_assts
-
- several_regs ->
- let liveness = mkRegLiveness several_regs
- in
- CCheck HP_CHK_GEN
- [mkIntCLit words_required,
- mkIntCLit (I# (word2Int# liveness)),
- -- HP_CHK_GEN needs a direct return address,
- -- not an info table (might be different if
- -- we're not assembly-mangling/tail-jumping etc.)
- CLbl (mkReturnPtLabel ret_addr) RetRep]
- tag_assts
-
--- normal algebraic and primitive case alternatives:
-
-altHeapCheck is_poly is_prim regs [] AbsCNop Nothing code
- = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
- where
- do_heap_chk :: HeapOffset -> Code
- do_heap_chk words_required
- = getTickyCtrLabel `thenFC` \ ctr ->
- absC ( if words_required == 0
- then AbsCNop
- else mkAbstractCs
- [ checking_code,
- profCtrAbsC FSLIT("TICK_ALLOC_HEAP")
- [ mkIntCLit words_required, CLbl ctr DataPtrRep ]
- ]
- ) `thenC`
- setRealHp words_required
-
- where
- non_void_regs = filter (/= VoidReg) regs
-
- checking_code =
- case non_void_regs of
-
- -- No regs live: probably a Void return
- [] ->
- CCheck HP_CHK_NOREGS [mkIntCLit words_required] AbsCNop
-
- -- R1 is boxed, but unlifted: DO NOT enter R1 when we return.
- --
- -- We also lump the polymorphic case in here, because we don't
- -- want to enter R1 if it is a function, and we're guarnateed
- -- that the return point has a direct return.
- [VanillaReg rep 1#]
- | isFollowableRep rep && (is_poly || is_prim) ->
- CCheck HP_CHK_UNPT_R1 [mkIntCLit words_required] AbsCNop
-
- -- R1 is lifted (the common case)
- | isFollowableRep rep ->
- CCheck HP_CHK_NP
- [mkIntCLit words_required, mkIntCLit 1{-regs live-}]
- AbsCNop
-
- -- R1 is unboxed
- | otherwise ->
- CCheck HP_CHK_UNBX_R1 [mkIntCLit words_required] AbsCNop
-
- -- FloatReg1
- [FloatReg 1#] ->
- CCheck HP_CHK_F1 [mkIntCLit words_required] AbsCNop
-
- -- DblReg1
- [DoubleReg 1#] ->
- CCheck HP_CHK_D1 [mkIntCLit words_required] AbsCNop
-
- -- LngReg1
- [LongReg _ 1#] ->
- CCheck HP_CHK_L1 [mkIntCLit words_required] AbsCNop
-
-#ifdef DEBUG
- _ -> panic ("CgHeapery.altHeapCheck: unimplemented heap-check, live regs = " ++ showSDoc (sep (map pprMagicId non_void_regs)))
-#endif