+
+ checking_code stk hp assts ret regs
+ | node_points = do_checks_np stk hp assts (regs+1) -- ret not required
+ | otherwise = do_checks stk hp assts ret regs
+
+ -- When node points to the closure for the function:
+
+ do_checks_np
+ :: Int -- stack headroom
+ -> Int -- heap headroom
+ -> AbstractC -- assignments to perform on failure
+ -> Int -- number of pointer registers live
+ -> AbstractC
+ do_checks_np 0 0 _ _ = AbsCNop
+ do_checks_np 0 hp_words tag_assts ptrs =
+ CCheck HP_CHK_NP [
+ mkIntCLit hp_words,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+ do_checks_np stk_words 0 tag_assts ptrs =
+ CCheck STK_CHK_NP [
+ mkIntCLit stk_words,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+ do_checks_np stk_words hp_words tag_assts ptrs =
+ CCheck HP_STK_CHK_NP [
+ mkIntCLit stk_words,
+ mkIntCLit hp_words,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+
+ -- When node doesn't point to the closure (we need an explicit retn addr)
+
+ do_checks
+ :: Int -- stack headroom
+ -> Int -- heap headroom
+ -> AbstractC -- assignments to perform on failure
+ -> CAddrMode -- a register to hold the retn addr.
+ -> Int -- number of pointer registers live
+ -> AbstractC
+
+ do_checks 0 0 _ _ _ = AbsCNop
+ do_checks 0 hp_words tag_assts ret_reg ptrs =
+ CCheck HP_CHK [
+ mkIntCLit hp_words,
+ CLbl ret CodePtrRep,
+ ret_reg,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+ do_checks stk_words 0 tag_assts ret_reg ptrs =
+ CCheck STK_CHK [
+ mkIntCLit stk_words,
+ CLbl ret CodePtrRep,
+ ret_reg,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+ do_checks stk_words hp_words tag_assts ret_reg ptrs =
+ CCheck HP_STK_CHK [
+ mkIntCLit stk_words,
+ mkIntCLit hp_words,
+ CLbl ret CodePtrRep,
+ ret_reg,
+ mkIntCLit ptrs
+ ]
+ tag_assts
+
+ free_reg = case length regs + 1 of
+ IBOX(x) -> CReg (VanillaReg PtrRep x)
+
+ all_pointers = all pointer regs
+ pointer (VanillaReg rep _) = isFollowableRep rep
+ pointer _ = False
+
+ addrmode_regs = map CReg regs
+
+-- Checking code for thunks is just a special case of fast entry points:
+
+thunkChecks :: CLabel -> Bool -> Code -> Code
+thunkChecks ret node_points code = fastEntryChecks [] [] ret node_points code
+\end{code}