Commit 4d1ea482 authored by Simon Marlow's avatar Simon Marlow

Implement shortcuts for slow calls (#6084)

parent 1df2116c
......@@ -23,6 +23,7 @@ module CmmInfo (
infoTablePtrs,
infoTableNonPtrs,
funInfoTable,
funInfoArity,
-- info table sizes and offsets
stdInfoTableSizeW,
......@@ -492,6 +493,22 @@ funInfoTable dflags info_ptr
= cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags)
-- Past the entry code pointer
-- 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)
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
, oFFSET_StgFunInfoExtraRev_arity dflags )
pc = sPlatformConstants (settings dflags)
-----------------------------------------------------------------------------
--
-- Info table sizes & offsets
......
......@@ -31,6 +31,7 @@ module CmmUtils(
cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord,
cmmToWord,
isTrivialCmmExpr, hasNoGlobalRegs,
......@@ -331,6 +332,14 @@ cmmNegate dflags e = CmmMachOp (MO_S_Neg (cmmExprWidth dfl
blankWord :: DynFlags -> CmmStatic
blankWord dflags = CmmUninitialised (wORD_SIZE dflags)
cmmToWord :: DynFlags -> CmmExpr -> CmmExpr
cmmToWord dflags e
| w == word = e
| otherwise = CmmMachOp (MO_UU_Conv w word) [e]
where
w = cmmExprWidth dflags e
word = wordWidth dflags
---------------------------------------------------
--
-- CmmExpr predicates
......
......@@ -176,16 +176,52 @@ directCall conv lbl arity stg_args
slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
-- (slowCall fun args) applies fun to args, returning the results to Sequel
slowCall fun stg_args
= do { dflags <- getDynFlags
; argsreps <- getArgRepsAmodes stg_args
; let (rts_fun, arity) = slowCallPattern (map fst argsreps)
; r <- direct_call "slow_call" NativeNodeCall
= do dflags <- getDynFlags
argsreps <- getArgRepsAmodes stg_args
let (rts_fun, arity) = slowCallPattern (map fst argsreps)
(r, slow_code) <- getCodeR $ do
r <- direct_call "slow_call" NativeNodeCall
(mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps)
; emitComment $ mkFastString ("slow_call for " ++
emitComment $ mkFastString ("slow_call for " ++
showSDoc dflags (ppr fun) ++
" with pat " ++ unpackFS rts_fun)
; return r
}
return r
let n_args = length stg_args
if n_args > arity && optLevel dflags >= 2
then do
fast_code <- getCode $
emitCall (NativeNodeCall, NativeReturn)
(entryCode dflags (closureInfoPtr dflags fun))
(nonVArgs ((P,Just fun):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)
(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
<*> mkLabel fast_lbl
<*> fast_code
<*> mkBranch end_lbl
<*> mkLabel slow_lbl
<*> slow_code
<*> mkLabel end_lbl)
return r
else do
emit slow_code
return r
--------------
......
......@@ -538,13 +538,13 @@ wanteds = concat
,structSize C "StgFunInfoExtraFwd"
,structField C "StgFunInfoExtraFwd" "slow_apply"
,structField C "StgFunInfoExtraFwd" "fun_type"
,structField C "StgFunInfoExtraFwd" "arity"
,structFieldH Both "StgFunInfoExtraFwd" "arity"
,structField_ C "StgFunInfoExtraFwd_bitmap" "StgFunInfoExtraFwd" "b.bitmap"
,structSize Both "StgFunInfoExtraRev"
,structField C "StgFunInfoExtraRev" "slow_apply_offset"
,structField C "StgFunInfoExtraRev" "fun_type"
,structField C "StgFunInfoExtraRev" "arity"
,structFieldH Both "StgFunInfoExtraRev" "arity"
,structField_ C "StgFunInfoExtraRev_bitmap" "StgFunInfoExtraRev" "b.bitmap"
,structField C "StgLargeBitmap" "size"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment