entryHeapCheck: fix calls to stg_gc_fun and stg_gc_enter_1

We weren't passing the arguments correctly to the GC functions, which
usually happened to work because the arguments were in the right
registers already.

After this fix the profiling tests go through with the new code
generator.

compiler/codeGen/StgCmmBind.hs

@@ -435,7 +435,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                 ; granYield arg_regs node_points
 
                 -- Main payload
-                ; entryHeapCheck cl_info offset node' arity arg_regs $ do
+                ; entryHeapCheck cl_info node' arity arg_regs $ do
                 { fv_bindings <- mapM bind_fv fv_details
                 -- Load free vars out of closure *after*
                 -- heap check, to reduce live vars over check
@@ -493,7 +493,7 @@ thunkCode cl_info fv_details _cc node arity body
         ; granThunk node_points
 
         -- Heap overflow check
-        ; entryHeapCheck cl_info 0 node' arity [] $ do
+        ; entryHeapCheck cl_info node' arity [] $ do
         { -- Overwrite with black hole if necessary
           -- but *after* the heap-overflow check
         ; whenC (blackHoleOnEntry cl_info && node_points)

compiler/codeGen/StgCmmHeap.hs

@@ -328,40 +328,45 @@ 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
                            Just (_, ArgGen _) -> False
                            _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