summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
authorPatrick Palka <patrick@parcs.ath.cx>2013-11-27 09:04:25 -0500
committerSimon Marlow <marlowsd@gmail.com>2013-11-28 12:52:23 +0000
commite9b0d3686486b79537a5f9acdf6244afa81e7c78 (patch)
tree83534086ca226ac5622ec5e0abc4b44b46dc5a98 /compiler/codeGen
parent4d1ea482885481073d2fee0ea0355848b9d853a1 (diff)
downloadhaskell-e9b0d3686486b79537a5f9acdf6244afa81e7c78.tar.gz
Fix up shortcut for slow calls
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/StgCmmLayout.hs14
1 files changed, 7 insertions, 7 deletions
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 9a7349111d..4f715683f0 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