Commit 46176dfa authored by Simon Marlow's avatar Simon Marlow

Assign more accurate code sizes to primops, so that the inlining

heuristics work better.  Also removed the old unused "needs_wrapper"
predicate for primops.  This helps with #4978.
parent 4177efa7
......@@ -585,19 +585,11 @@ didn't adopt the idea.
\begin{code}
primOpSize :: PrimOp -> Int -> ExprSize
primOpSize op n_val_args
| not (primOpIsDupable op) = sizeN opt_UF_DearOp
| not (primOpOutOfLine op) = sizeN 1
-- Be very keen to inline simple primops.
-- We give a discount of 1 for each arg so that (op# x y z) costs 2.
-- We can't make it cost 1, else we'll inline let v = (op# x y z)
-- at every use of v, which is excessive.
--
-- A good example is:
-- let x = +# p q in C {x}
-- Even though x get's an occurrence of 'many', its RHS looks cheap,
-- and there's a good chance it'll get inlined back into C's RHS. Urgh!
| otherwise = sizeN n_val_args
= if primOpOutOfLine op
then sizeN (op_size + n_val_args)
else sizeN op_size
where
op_size = primOpCodeSize op
buildSize :: ExprSize
......
......@@ -252,7 +252,7 @@ PRIMOP_BITS = compiler/primop-data-decl.hs-incl \
compiler/primop-has-side-effects.hs-incl \
compiler/primop-out-of-line.hs-incl \
compiler/primop-commutable.hs-incl \
compiler/primop-needs-wrapper.hs-incl \
compiler/primop-code-size.hs-incl \
compiler/primop-can-fail.hs-incl \
compiler/primop-strictness.hs-incl \
compiler/primop-primop-info.hs-incl
......@@ -278,8 +278,8 @@ compiler/primop-out-of-line.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
"$(GENPRIMOP_INPLACE)" --out-of-line < $< > $@
compiler/primop-commutable.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
"$(GENPRIMOP_INPLACE)" --commutable < $< > $@
compiler/primop-needs-wrapper.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
"$(GENPRIMOP_INPLACE)" --needs-wrapper < $< > $@
compiler/primop-code-size.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
"$(GENPRIMOP_INPLACE)" --code-size < $< > $@
compiler/primop-can-fail.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
"$(GENPRIMOP_INPLACE)" --can-fail < $< > $@
compiler/primop-strictness.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
......
......@@ -18,8 +18,8 @@ module PrimOp (
tagToEnumKey,
primOpOutOfLine, primOpNeedsWrapper,
primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
primOpOutOfLine, primOpCodeSize,
primOpOkForSpeculation, primOpIsCheap,
getPrimOpResultInfo, PrimOpResultInfo(..),
......@@ -363,18 +363,23 @@ primOpIsCheap op = primOpOkForSpeculation op
-- even if primOpIsCheap sometimes says 'True'.
\end{code}
primOpIsDupable
~~~~~~~~~~~~~~~
primOpIsDupable means that the use of the primop is small enough to
duplicate into different case branches. See CoreUtils.exprIsDupable.
primOpCodeSize
~~~~~~~~~~~~~~
Gives an indication of the code size of a primop, for the purposes of
calculating unfolding sizes; see CoreUnfold.sizeExpr.
\begin{code}
primOpIsDupable :: PrimOp -> Bool
-- See comments with CoreUtils.exprIsDupable
-- We say it's dupable it isn't implemented by a C call with a wrapper
primOpIsDupable op = not (primOpNeedsWrapper op)
\end{code}
primOpCodeSize :: PrimOp -> Int
#include "primop-code-size.hs-incl"
primOpCodeSizeDefault :: Int
primOpCodeSizeDefault = 1
-- CoreUnfold.primOpSize already takes into account primOpOutOfLine
-- and adds some further costs for the args in that case.
primOpCodeSizeForeignCall :: Int
primOpCodeSizeForeignCall = 4
\end{code}
\begin{code}
primOpCanFail :: PrimOp -> Bool
......@@ -421,14 +426,6 @@ primOpHasSideEffects :: PrimOp -> Bool
#include "primop-has-side-effects.hs-incl"
\end{code}
Inline primitive operations that perform calls need wrappers to save
any live variables that are stored in caller-saves registers.
\begin{code}
primOpNeedsWrapper :: PrimOp -> Bool
#include "primop-needs-wrapper.hs-incl"
\end{code}
\begin{code}
primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
primOpType op
......
......@@ -43,7 +43,7 @@ defaults
has_side_effects = False
out_of_line = False
commutable = False
needs_wrapper = False
code_size = { primOpCodeSizeDefault }
can_fail = False
strictness = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
......@@ -155,6 +155,7 @@ primop CharLtOp "ltChar#" Compare Char# -> Char# -> Bool
primop CharLeOp "leChar#" Compare Char# -> Char# -> Bool
primop OrdOp "ord#" GenPrimOp Char# -> Int#
with code_size = 0
------------------------------------------------------------------------
section "Int#"
......@@ -212,9 +213,12 @@ primop IntNegOp "negateInt#" Monadic Int# -> Int#
primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
{Add with carry. First member of result is (wrapped) sum;
second member is 0 iff no overflow occured.}
with code_size = 2
primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
{Subtract with carry. First member of result is (wrapped) difference;
second member is 0 iff no overflow occured.}
with code_size = 2
primop IntGtOp ">#" Compare Int# -> Int# -> Bool
primop IntGeOp ">=#" Compare Int# -> Int# -> Bool
......@@ -231,8 +235,11 @@ primop IntLtOp "<#" Compare Int# -> Int# -> Bool
primop IntLeOp "<=#" Compare Int# -> Int# -> Bool
primop ChrOp "chr#" GenPrimOp Int# -> Char#
with code_size = 0
primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word#
with code_size = 0
primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float#
primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double#
......@@ -286,6 +293,7 @@ primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
in the range 0 to word size - 1 inclusive.}
primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
with code_size = 0
primop WordGtOp "gtWord#" Compare Word# -> Word# -> Bool
primop WordGeOp "geWord#" Compare Word# -> Word# -> Bool
......@@ -396,63 +404,72 @@ primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float#
primop DoubleExpOp "expDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleLogOp "logDouble#" Monadic
Double# -> Double#
with
needs_wrapper = True
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop DoubleSqrtOp "sqrtDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleSinOp "sinDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleCosOp "cosDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleTanOp "tanDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleAsinOp "asinDouble#" Monadic
Double# -> Double#
with
needs_wrapper = True
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop DoubleAcosOp "acosDouble#" Monadic
Double# -> Double#
with
needs_wrapper = True
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop DoubleAtanOp "atanDouble#" Monadic
Double# -> Double#
with
needs_wrapper = True
code_size = { primOpCodeSizeForeignCall }
primop DoubleSinhOp "sinhDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleCoshOp "coshDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleTanhOp "tanhDouble#" Monadic
Double# -> Double#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoublePowerOp "**##" Dyadic
Double# -> Double# -> Double#
{Exponentiation.}
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp
Double# -> (# Int#, Word#, Word#, Int# #)
......@@ -506,58 +523,71 @@ primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int#
primop FloatExpOp "expFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatLogOp "logFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
can_fail = True
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop FloatSqrtOp "sqrtFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatSinOp "sinFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatCosOp "cosFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatTanOp "tanFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatAsinOp "asinFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
can_fail = True
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop FloatAcosOp "acosFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
can_fail = True
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
primop FloatAtanOp "atanFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatSinhOp "sinhFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatCoshOp "coshFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatTanhOp "tanhFloat#" Monadic
Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop FloatPowerOp "powerFloat#" Dyadic
Float# -> Float# -> Float#
with needs_wrapper = True
with
code_size = { primOpCodeSizeForeignCall }
primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double#
......@@ -599,6 +629,7 @@ primop WriteArrayOp "writeArray#" GenPrimOp
{Write to specified index of mutable array.}
with
has_side_effects = True
code_size = 2 -- card update too
primop SizeofArrayOp "sizeofArray#" GenPrimOp
Array# a -> Int#
......@@ -633,6 +664,7 @@ primop CopyArrayOp "copyArray#" GenPrimOp
The two arrays must not be the same array in different states, but this is not checked either.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp
MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
......@@ -640,6 +672,7 @@ primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp
Both arrays must fully contain the specified ranges, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
primop CloneArrayOp "cloneArray#" GenPrimOp
Array# a -> Int# -> Int# -> Array# a
......@@ -647,6 +680,7 @@ primop CloneArrayOp "cloneArray#" GenPrimOp
The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
......@@ -654,6 +688,7 @@ primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
primop FreezeArrayOp "freezeArray#" GenPrimOp
MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
......@@ -661,6 +696,7 @@ primop FreezeArrayOp "freezeArray#" GenPrimOp
The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
primop ThawArrayOp "thawArray#" GenPrimOp
Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
......@@ -668,6 +704,7 @@ primop ThawArrayOp "thawArray#" GenPrimOp
The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall + 4 }
------------------------------------------------------------------------
section "Byte Arrays"
......@@ -931,8 +968,10 @@ primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int#
{Coerce directly from address to int. Strongly deprecated.}
with code_size = 0
primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr#
{Coerce directly from int to address. Strongly deprecated.}
with code_size = 0
#endif
primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Bool
......@@ -1149,6 +1188,7 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp
{Write contents of {\tt MutVar\#}.}
with
has_side_effects = True
code_size = { primOpCodeSizeForeignCall } -- for the write barrier
primop SameMutVarOp "sameMutVar#" GenPrimOp
MutVar# s a -> MutVar# s a -> Bool
......@@ -1381,7 +1421,6 @@ primop DelayOp "delay#" GenPrimOp
Int# -> State# s -> State# s
{Sleep specified number of microseconds.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1389,7 +1428,6 @@ primop WaitReadOp "waitRead#" GenPrimOp
Int# -> State# s -> State# s
{Block until input is available on specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1397,7 +1435,6 @@ primop WaitWriteOp "waitWrite#" GenPrimOp
Int# -> State# s -> State# s
{Block until output is possible on specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1406,7 +1443,6 @@ primop AsyncReadOp "asyncRead#" GenPrimOp
Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
{Asynchronously read bytes from specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1414,7 +1450,6 @@ primop AsyncWriteOp "asyncWrite#" GenPrimOp
Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
{Asynchronously write bytes from specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1422,7 +1457,6 @@ primop AsyncDoProcOp "asyncDoProc#" GenPrimOp
Addr# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
{Asynchronously perform procedure (first arg), passing it 2nd arg.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1539,6 +1573,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
primop TouchOp "touch#" GenPrimOp
o -> State# RealWorld -> State# RealWorld
with
code_size = { 0 }
has_side_effects = True
------------------------------------------------------------------------
......@@ -1558,7 +1593,6 @@ primop MakeStablePtrOp "makeStablePtr#" GenPrimOp
primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1570,7 +1604,6 @@ primop EqStablePtrOp "eqStablePtr#" GenPrimOp
primop MakeStableNameOp "makeStableName#" GenPrimOp
a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
......@@ -1598,6 +1631,7 @@ primop ParOp "par#" GenPrimOp
-- Note that Par is lazy to avoid that the sparked thing
-- gets evaluted strictly, which it should *not* be
has_side_effects = True
code_size = { primOpCodeSizeForeignCall }
primop GetSparkOp "getSpark#" GenPrimOp
State# s -> (# State# s, Int#, a #)
......@@ -1687,6 +1721,8 @@ primtype BCO#
primop AddrToHValueOp "addrToHValue#" GenPrimOp
Addr# -> (# a #)
{Convert an {\tt Addr\#} to a followable type.}
with
code_size = 0
primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
BCO# -> (# a #)
......
......@@ -54,6 +54,7 @@ words :-
<0> "thats_all_folks" { mkT TThatsAllFolks }
<0> [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
<0> [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
<0> [0-9][0-9]* { mkTv (TInteger . read) }
<0> \" [^\"]* \" { mkTv (TString . tail . init) }
<in_braces> [^\{\}]+ { mkTv TNoBraces }
<in_braces> \n { mkTv TNoBraces }
......
......@@ -46,13 +46,13 @@ main = getArgs >>= \args ->
"commutable"
"commutableOp" p_o_specs)
"--needs-wrapper"
"--code-size"
-> putStr (gen_switch_from_attribs
"needs_wrapper"
"primOpNeedsWrapper" p_o_specs)
"code_size"
"primOpCodeSize" p_o_specs)
"--can-fail"
-> putStr (gen_switch_from_attribs
"--can-fail"
-> putStr (gen_switch_from_attribs
"can_fail"
"primOpCanFail" p_o_specs)
......@@ -91,7 +91,7 @@ known_args
"--has-side-effects",
"--out-of-line",
"--commutable",
"--needs-wrapper",
"--code-size",
"--can-fail",
"--strictness",
"--primop-primop-info",
......@@ -550,6 +550,7 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
getAltRhs (OptionFalse _) = "False"
getAltRhs (OptionTrue _) = "True"
getAltRhs (OptionInteger _ i) = show i
getAltRhs (OptionString _ s) = s
mkAlt po
......
......@@ -48,6 +48,7 @@ import Syntax
lowerName { TLowerName $$ }
upperName { TUpperName $$ }
string { TString $$ }
integer { TInteger $$ }
noBraces { TNoBraces $$ }
%%
......@@ -66,6 +67,7 @@ pOption :: { Option }
pOption : lowerName '=' false { OptionFalse $1 }
| lowerName '=' true { OptionTrue $1 }
| lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
| lowerName '=' integer { OptionInteger $1 $3 }
pEntries :: { [Entry] }
pEntries : pEntry pEntries { $1 : $2 }
......
......@@ -81,6 +81,7 @@ data Token = TEOF
| TUpperName String
| TString String
| TNoBraces String
| TInteger Int
deriving Show
-- Actions
......
......@@ -40,6 +40,7 @@ data Option
= OptionFalse String -- name = False
| OptionTrue String -- name = True
| OptionString String String -- name = { ... unparsed stuff ... }
| OptionInteger String Int -- name = <int>
deriving Show
-- categorises primops
......@@ -120,6 +121,7 @@ get_attrib_name :: Option -> String
get_attrib_name (OptionFalse nm) = nm
get_attrib_name (OptionTrue nm) = nm
get_attrib_name (OptionString nm _) = nm
get_attrib_name (OptionInteger nm _) = nm
lookup_attrib :: String -> [Option] -> Maybe Option
lookup_attrib _ [] = Nothing
......
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