[commit: ghc] master: Fix up shortcut for slow calls (e9b0d36)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e9b0d3686486b79537a5f9acdf6244afa81e7c78/ghc

>---------------------------------------------------------------

commit e9b0d3686486b79537a5f9acdf6244afa81e7c78
Author: Patrick Palka <patrick at parcs.ath.cx>
Date:   Wed Nov 27 09:04:25 2013 -0500

    Fix up shortcut for slow calls


>---------------------------------------------------------------

e9b0d3686486b79537a5f9acdf6244afa81e7c78
 compiler/cmm/CmmInfo.hs          |    8 ++++----
 compiler/codeGen/StgCmmLayout.hs |   14 +++++++-------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 641f29b..42c9e6b 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -496,16 +496,16 @@ funInfoTable dflags info_ptr
 -- Takes the info pointer of a function, returns the function's arity
 funInfoArity :: DynFlags -> CmmExpr -> CmmExpr
 funInfoArity dflags iptr
-  = cmmToWord dflags (cmmLoadIndex dflags rep fun_info offset)
+  = cmmToWord dflags (cmmLoadIndex dflags rep fun_info (offset `div` rep_bytes))
   where
    fun_info = funInfoTable dflags iptr
    rep = cmmBits (widthFromBytes rep_bytes)
 
    (rep_bytes, offset)
-    | tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraFwd_arity pc
-                                , oFFSET_StgFunInfoExtraFwd_arity dflags )
-    | otherwise               = ( pc_REP_StgFunInfoExtraRev_arity pc
+    | tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraRev_arity pc
                                 , oFFSET_StgFunInfoExtraRev_arity dflags )
+    | otherwise               = ( pc_REP_StgFunInfoExtraFwd_arity pc
+                                , oFFSET_StgFunInfoExtraFwd_arity dflags )
 
    pc = sPlatformConstants (settings dflags)
 
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 9a73491..4f71568 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -191,23 +191,23 @@ slowCall fun stg_args
         let n_args = length stg_args
         if n_args > arity && optLevel dflags >= 2
            then do
+             funv <- (CmmReg . CmmLocal) `fmap` assignTemp fun
+             fun_iptr <- (CmmReg . CmmLocal) `fmap`
+                    assignTemp (closureInfoPtr dflags (cmmUntag dflags funv))
+
              fast_code <- getCode $
                 emitCall (NativeNodeCall, NativeReturn)
-                  (entryCode dflags (closureInfoPtr dflags fun))
-                  (nonVArgs ((P,Just fun):argsreps))
+                  (entryCode dflags fun_iptr)
+                  (nonVArgs ((P,Just funv):argsreps))
 
              slow_lbl <- newLabelC
              fast_lbl <- newLabelC
              is_tagged_lbl <- newLabelC
              end_lbl <- newLabelC
 
-             funv <- (CmmReg . CmmLocal) `fmap` assignTemp fun
-
-             let correct_arity = cmmEqWord dflags (funInfoArity dflags funv)
+             let correct_arity = cmmEqWord dflags (funInfoArity dflags fun_iptr)
                                                   (mkIntExpr dflags n_args)
 
-             pprTrace "fast call" (int n_args) $ return ()
-
              emit (mkCbranch (cmmIsTagged dflags funv) is_tagged_lbl slow_lbl
                    <*> mkLabel is_tagged_lbl
                    <*> mkCbranch correct_arity fast_lbl slow_lbl