[GHC] #11565: Restore code to handle '-fmax-worker-args' flag
GHC
ghc-devs at haskell.org
Wed Aug 31 10:38:27 UTC 2016
#11565: Restore code to handle '-fmax-worker-args' flag
-------------------------------------+-------------------------------------
Reporter: slyfox | Owner:
Type: feature request | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.10.3
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by slyfox):
Here comes minimal example for one direction: heap to stack.
The trigger is a function with many USED record fields: show in this case.
In case of DynFlags it's a full (or large) subset of fields used
in various GHC subsystems.
{{{#!hs
-- A.hs
module A(D) where
-- like DynFlgs in GHC
data D = D { f_00, f_01, f_02, f_03, f_04
, f_10, f_11, f_12, f_13, f_14
, f_20, f_21, f_22, f_23, f_24
, f_30, f_31, f_32, f_33, f_34
, f_40, f_41, f_42, f_43, f_44
, f_50, f_51, f_52, f_53, f_54
, g_00, g_01, g_02, g_03, g_04
, g_10, g_11, g_12, g_13, g_14
, g_20, g_21, g_22, g_23, g_24
, g_30, g_31, g_32, g_33, g_34
, g_40, g_41, g_42, g_43, g_44
, g_50, g_51, g_52, g_53, g_54
, h_00, h_01, h_02, h_03, h_04
, h_10, h_11, h_12, h_13, h_14
, h_20, h_21, h_22, h_23, h_24
, h_30, h_31, h_32, h_33, h_34
, h_40, h_41, h_42, h_43, h_44
, h_50, h_51, h_52, h_53, h_54
, i_00, i_01, i_02, i_03, i_04
, i_10, i_11, i_12, i_13, i_14
, i_20, i_21, i_22, i_23, i_24
, i_30, i_31, i_32, i_33, i_34
, i_40, i_41, i_42, i_43, i_44
, i_50, i_51, i_52, i_53, i_54 :: Int
} deriving Show
}}}
{{{#!hs
-- B.hs
module B (tiny_foo) where
import qualified A
tiny_foo :: A.D -> Bool
tiny_foo d = null (show d)
}}}
Let's look at the size of module B on '''-O0''' and '''-O1''' while A is
compiled -O2:
'''-O0''', no unboxing happens.
{{{#!hs
$ ghc -c -O2 A.hs && ghc -c -O0 B.hs -ddump-stg -fforce-recomp
compilation IS NOT required
==================== STG syntax: ====================
$trModule1_r3JD :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! ["main"#];
$trModule2_r3P0 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! ["B"#];
B.$trModule :: GHC.Types.Module
[GblId, Caf=NoCafRefs, Str=DmdType, Unf=OtherCon []] =
NO_CCS GHC.Types.Module! [$trModule1_r3JD $trModule2_r3P0];
B.tiny_foo :: A.D -> GHC.Types.Bool
[GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =
\r srt:SRT:[r30 :-> A.$fShowD,
rAj :-> Data.Foldable.$fFoldable[]] [d_s3P4]
let {
sat_s3P5 [Occ=Once] :: [GHC.Types.Char]
[LclId, Str=DmdType] =
\u srt:SRT:[r30 :-> A.$fShowD] [] GHC.Show.show A.$fShowD
d_s3P4;
} in Data.Foldable.null Data.Foldable.$fFoldable[] sat_s3P5;
}}}
'''-O1''', unboxing hapened:
{{{#!hs
$ ghc -c -O2 A.hs && ghc -c -O1 B.hs -ddump-stg -fforce-recomp
compilation IS NOT required
==================== STG syntax: ====================
B.$trModule2 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! ["main"#];
B.$trModule1 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=DmdType m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! ["B"#];
B.$trModule :: GHC.Types.Module
[GblId, Caf=NoCafRefs, Str=DmdType m, Unf=OtherCon []] =
NO_CCS GHC.Types.Module! [B.$trModule2 B.$trModule1];
B.$wtiny_foo [InlPrag=[0]]
:: GHC.Types.Int
-> GHC.Types.Int
-> GHC.Types.Int
...
-> GHC.Types.Int
-> GHC.Types.Bool
[GblId,
Arity=120,
Str=DmdType
<L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(
U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)><L,1*U(U)>,
Unf=OtherCon []] =
\r srt:SRT:[r3a :-> A.$w$cshowsPrec] [ww_s47S
ww1_s47T
ww2_s47U
ww3_s47V
ww4_s47W
ww5_s47X
ww6_s47Y
...
ww115_s49J
ww116_s49K
ww117_s49L
ww118_s49M
ww119_s49N]
case
A.$w$cshowsPrec
0#
ww_s47S
ww1_s47T
ww2_s47U
ww3_s47V
ww4_s47W
ww5_s47X
ww6_s47Y
ww7_s47Z
ww8_s480
ww9_s481
ww10_s482
ww11_s483
ww12_s484
ww13_s485
...
ww117_s49L
ww118_s49M
ww119_s49N
GHC.Types.[]
of
_ [Occ=Dead]
{ [] -> GHC.Types.True [];
: _ [Occ=Dead] _ [Occ=Dead] -> GHC.Types.False [];
};
B.tiny_foo [InlPrag=INLINE[0]] :: A.D -> GHC.Types.Bool
[GblId,
Arity=1,
Str=DmdType
<S,1*U(1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U),1*U(U))>,
Unf=OtherCon []] =
\r srt:SRT:[r47O :-> B.$wtiny_foo] [w_s49R]
case w_s49R of _ [Occ=Dead] {
A.D ww1_s49T [Occ=Once]
ww2_s49U [Occ=Once]
ww3_s49V [Occ=Once]
ww4_s49W [Occ=Once]
ww5_s49X [Occ=Once]
...
ww118_s4bM [Occ=Once]
ww119_s4bN [Occ=Once]
ww120_s4bO [Occ=Once] ->
B.$wtiny_foo
ww1_s49T
ww2_s49U
ww3_s49V
ww4_s49W
ww5_s49X
ww6_s49Y
ww7_s49Z
ww8_s4a0
ww9_s4a1
ww10_s4a2
ww11_s4a3
ww12_s4a4
ww13_s4a5
ww14_s4a6
ww15_s4a7
ww16_s4a8
}}}
This causes a lot of 'mov' instructions from heap to stack to be generated
at each callsite.
In this case it's 9 pages:
{{{#!hs
$ ghc -c -O2 A.hs && ghc -c -O1 B.hs -ddump-asm -fforce-recomp
...
movq %rbx,856(%rbp)
movq 880(%rbp),%rbx
movq %rbx,864(%rbp)
movq 888(%rbp),%rbx
movq %rbx,872(%rbp)
movq 896(%rbp),%rbx
movq %rbx,880(%rbp)
movq 904(%rbp),%rbx
movq %rbx,888(%rbp)
movq %rax,896(%rbp)
movq $GHC.Types.[]_closure+1,904(%rbp)
addq $-24,%rbp
jmp A.$w$cshowsPrec_info
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11565#comment:6>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list