- gc_call
- | null args = mkJump (CmmReg (CmmGlobal GCEnter1)) [CmmReg (CmmLocal fun)]
- | otherwise = case gc_lbl args of
- Just lbl -> mkJump (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
- (map (CmmReg . CmmLocal) (fun:args))
- Nothing -> mkCmmCall generic_gc [] [] srt
-
- gc_lbl :: [LocalReg] -> Maybe LitString
- gc_lbl [reg]
- | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p"
- | isFloatType ty = case width of
- W32 -> Just (sLit "stg_gc_f1") -- "stg_gc_fun_f1"
- W64 -> Just (sLit "stg_gc_d1") -- "stg_gc_fun_d1"
- _other -> Nothing
- | otherwise = case width of
- W32 -> Just (sLit "stg_gc_unbx_r1") -- "stg_gc_fun_unbx_r1"
- W64 -> Just (sLit "stg_gc_l1") -- "stg_gc_fun_unbx_l1"
- _other -> Nothing -- Narrow cases
- where
- ty = localRegType reg
- width = typeWidth ty
+ is_thunk = arity == 0
+ is_fastf = case closureFunInfo cl_info of
+ Just (_, ArgGen _) -> False
+ _otherwise -> True
+
+ args' = map (CmmReg . CmmLocal) args
+ setN = case nodeSet of
+ Just n -> mkAssign nodeReg (CmmReg $ CmmLocal n)
+ Nothing -> mkAssign nodeReg $
+ CmmLit (CmmLabel $ closureLabelFromCI cl_info)
+
+ {- Thunks: Set R1 = node, jump GCEnter1
+ Function (fast): Set R1 = node, jump GCFun
+ Function (slow): Set R1 = node, call generic_gc -}
+ gc_call upd = setN <*> gc_lbl upd
+ gc_lbl upd
+ | is_thunk = mkDirectJump (CmmReg $ CmmGlobal GCEnter1) [] sp
+ | is_fastf = mkDirectJump (CmmReg $ CmmGlobal GCFun) [] sp
+ | otherwise = mkForeignJump Slow (CmmReg $ CmmGlobal GCFun) args' upd
+ where sp = max offset upd
+ {- DT (12/08/10) This is a little fishy, mainly the sp fix up amount.
+ - This is since the ncg inserts spills before the stack/heap check.
+ - This should be fixed up and then we won't need to fix up the Sp on
+ - GC calls, but until then this fishy code works -}
+
+{-
+ -- This code is slightly outdated now and we could easily keep the above
+ -- GC methods. However, there may be some performance gains to be made by
+ -- using more specialised GC entry points. Since the semi generic GCFun
+ -- entry needs to check the node and figure out what registers to save...
+ -- if we provided and used more specialised GC entry points then these
+ -- runtime decisions could be turned into compile time decisions.
+
+ args' = case fun of Just f -> f : args
+ Nothing -> args
+ arg_exprs = map (CmmReg . CmmLocal) args'
+ gc_call updfr_sz
+ | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) arg_exprs updfr_sz
+ | otherwise =
+ case gc_lbl args' of
+ Just _lbl -> panic "StgCmmHeap.entryHeapCheck: not finished"
+ -- mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
+ -- arg_exprs updfr_sz
+ Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz
+
+ gc_lbl :: [LocalReg] -> Maybe FastString
+ gc_lbl [reg]
+ | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p"
+ | isFloatType ty = case width of
+ W32 -> Just (sLit "stg_gc_f1")
+ W64 -> Just (sLit "stg_gc_d1")
+ _other -> Nothing
+ | width == wordWidth = Just (mkGcLabel "stg_gc_unbx_r1")
+ | width == W64 = Just (mkGcLabel "stg_gc_l1")
+ | otherwise = Nothing
+ where
+ ty = localRegType reg
+ width = typeWidth ty