diff options
| author | Patrick Palka <patrick@parcs.ath.cx> | 2013-11-27 09:04:25 -0500 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2013-11-28 12:52:23 +0000 |
| commit | e9b0d3686486b79537a5f9acdf6244afa81e7c78 (patch) | |
| tree | 83534086ca226ac5622ec5e0abc4b44b46dc5a98 | |
| parent | 4d1ea482885481073d2fee0ea0355848b9d853a1 (diff) | |
| download | haskell-e9b0d3686486b79537a5f9acdf6244afa81e7c78.tar.gz | |
Fix up shortcut for slow calls
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 8 | ||||
| -rw-r--r-- | 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 641f29b880..42c9e6ba53 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 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 |