+-- --------------------------------------
+-- Examine tag bits of function pointer and enter it
+-- directly if needed.
+-- TODO: remove the redundant case in the original code.
+enterFastPath regstatus no_load_regs args_in_regs args
+ | Just tag <- tagForArity (length args)
+ = enterFastPathHelper tag regstatus no_load_regs args_in_regs args
+enterFastPath _ _ _ _ = empty
+
+-- Copied from Constants.lhs & CgUtils.hs, i'd rather have this imported:
+-- (arity,tag)
+tAG_BITS = (TAG_BITS :: Int)
+tAG_BITS_MAX = ((1 `shiftL` tAG_BITS) :: Int)
+
+tagForArity :: Int -> Maybe Int
+tagForArity i | i < tAG_BITS_MAX = Just i
+ | otherwise = Nothing
+
+enterFastPathHelper tag regstatus no_load_regs args_in_regs args =
+ vcat [text "if (GETTAG(R1)==" <> int tag <> text ") {",
+ reg_doc,
+ text " Sp_adj(" <> int sp' <> text ");",
+ -- enter, but adjust offset with tag
+ text " jump " <> text "%GET_ENTRY(R1-" <> int tag <> text ");",
+ text "}"
+ ]
+ -- I don't totally understand this code, I copied it from
+ -- exact_arity_case
+ -- TODO: refactor
+ where
+ -- offset of arguments on the stack at slow apply calls.
+ stk_args_slow_offset = 1
+
+ stk_args_offset
+ | args_in_regs = 0
+ | otherwise = stk_args_slow_offset
+
+ (reg_doc, sp')
+ | no_load_regs || args_in_regs = (empty, stk_args_offset)
+ | otherwise = loadRegArgs regstatus stk_args_offset args
+
+tickForArity arity
+ | True
+ = empty
+ | Just tag <- tagForArity arity
+ = vcat [
+ text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;",
+ text "W_[SLOW_CALLS_" <> int arity <> text "] = W_[SLOW_CALLS_" <> int arity <> text "] + 1;",
+ text "if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == " <> int arity <> text " ) {",
+ text " W_[RIGHT_ARITY_" <> int arity <> text "] = W_[RIGHT_ARITY_" <> int arity <> text "] + 1;",
+ text " if (GETTAG(R1)==" <> int tag <> text ") {",
+ text " W_[TAGGED_PTR_" <> int arity <> text "] = W_[TAGGED_PTR_" <> int arity <> text "] + 1;",
+ text " } else {",
+ -- force a halt when not tagged!
+-- text " W_[0]=0;",
+ text " }",
+ text "}"
+ ]
+tickForArity _ = text "W_[TOTAL_CALLS] = W_[TOTAL_CALLS] + 1;"
+