Permalink
Browse files

Generate one fewer temps per heap allocation

This saves compile time and can make a big difference in some
pathological cases (T4801)
  • Loading branch information...
1 parent 8d3e9fd commit 0b75e456b62c9d36e6ce9756278a36db9e1baaaa @simonmar simonmar committed Aug 6, 2012
Showing with 28 additions and 40 deletions.
  1. +6 −5 compiler/codeGen/StgCmmBind.hs
  2. +2 −2 compiler/codeGen/StgCmmCon.hs
  3. +7 −8 compiler/codeGen/StgCmmEnv.hs
  4. +13 −25 compiler/codeGen/StgCmmHeap.hs
@@ -104,7 +104,8 @@ cgBind :: StgBinding -> FCode ()
cgBind (StgNonRec name rhs)
= do { ((info, init), body) <- getCodeR $ cgRhs name rhs
; addBindC (cg_id info) info
- ; emit (init <*> body) }
+ ; emit (body <*> init) }
+ -- init cannot be used in body, so slightly better to sink it eagerly
cgBind (StgRec pairs)
= do { ((new_binds, inits), body) <- getCodeR $ fixC (\ new_binds_inits ->
@@ -311,11 +312,11 @@ mkRhsClosure _ bndr cc _ fvs upd_flag args body
; emit (mkComment $ mkFastString "calling allocDynClosure")
; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
; let info_tbl = mkCmmInfo closure_info
- ; (tmp, init) <- allocDynClosure info_tbl lf_info use_cc blame_cc
+ ; hp_plus_n <- allocDynClosure info_tbl lf_info use_cc blame_cc
(map toVarArg fv_details)
-- RETURN
- ; regIdInfo bndr lf_info tmp init }
+ ; regIdInfo bndr lf_info hp_plus_n }
-- Use with care; if used inappropriately, it could break invariants.
stripNV :: NonVoid a -> a
@@ -349,11 +350,11 @@ cgStdThunk bndr _cc _bndr_info _body lf_info payload
-- BUILD THE OBJECT
; let info_tbl = mkCmmInfo closure_info
- ; (tmp, init) <- allocDynClosure info_tbl lf_info
+ ; hp_plus_n <- allocDynClosure info_tbl lf_info
use_cc blame_cc payload_w_offsets
-- RETURN
- ; regIdInfo bndr lf_info tmp init }
+ ; regIdInfo bndr lf_info hp_plus_n }
mkClosureLFInfo :: Id -- The binder
-> TopLevelFlag -- True of top level
@@ -210,9 +210,9 @@ buildDynCon' dflags _ binder ccs con args
-- No void args in args_w_offsets
nonptr_wds = tot_wds - ptr_wds
info_tbl = mkDataConInfoTable dflags con False ptr_wds nonptr_wds
- ; (tmp, init) <- allocDynClosure info_tbl lf_info
+ ; hp_plus_n <- allocDynClosure info_tbl lf_info
use_cc blame_cc args_w_offsets
- ; regIdInfo binder lf_info tmp init }
+ ; regIdInfo binder lf_info hp_plus_n }
where
lf_info = mkConLFInfo con
@@ -44,7 +44,7 @@ import CLabel
import BlockId
import CmmExpr
import CmmUtils
-import MkGraph (CmmAGraph, mkAssign, (<*>))
+import MkGraph (CmmAGraph, mkAssign)
import FastString
import Id
import VarEnv
@@ -103,13 +103,12 @@ lneIdInfo id regs
-- register, and store a plain register in the CgIdInfo. We allocate
-- a new register in order to keep single-assignment and help out the
-- inliner. -- EZY
-regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CmmAGraph -> FCode (CgIdInfo, CmmAGraph)
-regIdInfo id lf_info reg init
- = do { reg' <- newTemp (localRegType reg)
- ; let init' = init <*> mkAssign (CmmLocal reg')
- (addDynTag (CmmReg (CmmLocal reg))
- (lfDynTag lf_info))
- ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init') }
+regIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> FCode (CgIdInfo, CmmAGraph)
+regIdInfo id lf_info expr
+ = do { reg <- newTemp (cmmExprType expr)
+ ; let init = mkAssign (CmmLocal reg)
+ (addDynTag expr (lfDynTag lf_info))
+ ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), init) }
idInfoToAmode :: CgIdInfo -> CmmExpr
-- Returns a CmmExpr for the *tagged* pointer
@@ -15,7 +15,7 @@ module StgCmmHeap (
mkVirtHeapOffsets, mkVirtConstrOffsets,
mkStaticClosureFields, mkStaticClosure,
- allocDynClosure, allocDynClosureReg, allocDynClosureCmm,
+ allocDynClosure, allocDynClosureCmm,
emitSetDynHdr
) where
@@ -63,12 +63,7 @@ allocDynClosure
-> [(NonVoid StgArg, VirtualHpOffset)] -- Offsets from start of object
-- ie Info ptr has offset zero.
-- No void args in here
- -> FCode (LocalReg, CmmAGraph)
-
-allocDynClosureReg
- :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
- -> [(CmmExpr, VirtualHpOffset)]
- -> FCode (LocalReg, CmmAGraph)
+ -> FCode CmmExpr -- returns Hp+n
allocDynClosureCmm
:: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
@@ -81,32 +76,25 @@ allocDynClosureCmm
-- returned LocalReg, which should point to the closure after executing
-- the graph.
--- Note [Return a LocalReg]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- allocDynClosure returns a LocalReg, not a (Hp+8) CmmExpr.
--- Reason:
--- ...allocate object...
--- obj = Hp + 8
--- y = f(z)
--- ...here obj is still valid,
--- but Hp+8 means something quite different...
+-- allocDynClosure returns an (Hp+8) CmmExpr, and hence the result is
+-- only valid until Hp is changed. The caller should assign the
+-- result to a LocalReg if it is required to remain live.
+--
+-- The reason we don't assign it to a LocalReg here is that the caller
+-- is often about to call regIdInfo, which immediately assigns the
+-- result of allocDynClosure to a new temp in order to add the tag.
+-- So by not generating a LocalReg here we avoid a common source of
+-- new temporaries and save some compile time. This can be quite
+-- significant - see test T4801.
allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets
= do { let (args, offsets) = unzip args_w_offsets
; cmm_args <- mapM getArgAmode args -- No void args
- ; allocDynClosureReg info_tbl lf_info
+ ; allocDynClosureCmm info_tbl lf_info
use_cc _blame_cc (zip cmm_args offsets)
}
-allocDynClosureReg info_tbl lf_info use_cc _blame_cc amodes_w_offsets
- = do { hp_rel <- allocDynClosureCmm info_tbl lf_info
- use_cc _blame_cc amodes_w_offsets
-
- -- Note [Return a LocalReg]
- ; getCodeR $ assignTemp hp_rel
- }
-
allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
= do { virt_hp <- getVirtHp

0 comments on commit 0b75e45

Please sign in to comment.