diff options
Diffstat (limited to 'compiler/codeGen/StgCmmHeap.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 47 |
1 files changed, 26 insertions, 21 deletions
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index b33ecdff12..12f3b1347e 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -328,14 +328,13 @@ These are used in the following circumstances -- A heap/stack check at a function or thunk entry point. entryHeapCheck :: ClosureInfo - -> Int -- Arg Offset -> Maybe LocalReg -- Function (closure environment) -> Int -- Arity -- not same as len args b/c of voids -> [LocalReg] -- Non-void args (empty for thunk) -> FCode () -> FCode () -entryHeapCheck cl_info offset nodeSet arity args code +entryHeapCheck cl_info nodeSet arity args code = do dflags <- getDynFlags let is_thunk = arity == 0 is_fastf = case closureFunInfo cl_info of @@ -343,25 +342,31 @@ entryHeapCheck cl_info offset nodeSet arity args code _otherwise -> True args' = map (CmmReg . CmmLocal) args - setN = case nodeSet of - Just _ -> mkNop -- No need to assign R1, it already - -- points to the closure - Nothing -> mkAssign nodeReg $ - CmmLit (CmmLabel $ staticClosureLabel cl_info) - - {- Thunks: 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 dflags (CmmReg $ CmmGlobal GCEnter1) [] sp - | is_fastf = mkDirectJump dflags (CmmReg $ CmmGlobal GCFun) [] sp - | otherwise = mkForeignJump dflags 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 -} + node = case nodeSet of + Just r -> CmmReg (CmmLocal r) + Nothing -> CmmLit (CmmLabel $ staticClosureLabel cl_info) + stg_gc_fun = CmmReg (CmmGlobal GCFun) + stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1) + + {- Thunks: jump stg_gc_enter_1 + + Function (fast): call (NativeNode) stg_gc_fun(fun, args) + + Function (slow): R1 = fun + call (slow) stg_gc_fun(args) + XXX: this is a bit naughty, we should really pass R1 as an + argument and use a special calling convention. + -} + gc_call upd + | is_thunk + = mkJump dflags stg_gc_enter1 [node] upd + + | is_fastf + = mkJump dflags stg_gc_fun (node : args') upd + + | otherwise + = mkAssign nodeReg node <*> + mkForeignJump dflags Slow stg_gc_fun args' upd updfr_sz <- getUpdFrameOff |