From 4b0d76295acb46696d297192c9178b460d2472b8 Mon Sep 17 00:00:00 2001 From: Norman Ramsey Date: Mon, 17 Sep 2007 16:17:15 +0000 Subject: [PATCH] tightened some dataflow code as part of preparing a talk --- compiler/cmm/CmmSpillReload.hs | 45 +++++++++++++++++++++++++--------------- compiler/cmm/ZipDataflow.hs | 3 +-- 2 files changed, 29 insertions(+), 19 deletions(-) diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs index d8108e9..dedef08 100644 --- a/compiler/cmm/CmmSpillReload.hs +++ b/compiler/cmm/CmmSpillReload.hs @@ -150,35 +150,33 @@ insertSpillsAndReloads = BComp "CPS spiller" exit last middle first middleInsertSpillsAndReloads :: DualLive -> M -> Maybe (Graph M Last) middleInsertSpillsAndReloads _ (Spill _) = Nothing middleInsertSpillsAndReloads _ (Reload _) = Nothing -middleInsertSpillsAndReloads live (NotSpillOrReload m) = middle m - where middle (MidAssign (CmmLocal reg') _) = - if reg' `elemRegSet` on_stack live then -- must spill - my_trace "Spilling" (f4sep [text "spill" <+> ppr reg', +middleInsertSpillsAndReloads live m@(NotSpillOrReload nsr) = middle nsr + where middle (MidAssign (CmmLocal reg) _) = + if reg `elemRegSet` on_stack live then -- must spill + my_trace "Spilling" (f4sep [text "spill" <+> ppr reg, text "after", ppr m]) $ - Just $ graphOfMiddles [NotSpillOrReload m, Spill $ mkRegSet [reg']] + Just $ graphOfMiddles [m, Spill $ mkRegSet [reg]] else Nothing middle (CopyIn _ formals _) = -- only 'formals' can be in regs at this point let regs' = kill formals (in_regs live) -- live in regs; must reload is_stack_var r = elemRegSet r (on_stack live) - needs_spilling = -- a formal that is expected on the stack; must spill - foldRegsUsed (\rs r -> if is_stack_var r then extendRegSet rs r - else rs) emptyRegSet formals + needs_spilling = filterRegsUsed is_stack_var formals + -- a formal that is expected on the stack; must spill in if isEmptyUniqSet regs' && isEmptyUniqSet needs_spilling then Nothing else - let reload = if isEmptyUniqSet regs' then [] - else [Reload regs'] - spill_reload = if isEmptyUniqSet needs_spilling then reload - else Spill needs_spilling : reload - middles = NotSpillOrReload m : spill_reload + let code = if isEmptyUniqSet regs' then [] + else Reload regs' : [] + code' = if isEmptyUniqSet needs_spilling then code + else Spill needs_spilling : code in my_trace "At CopyIn" (f4sep [text "Triggered by ", ppr live, ppr (Reload regs' :: M), ppr (Spill needs_spilling :: M), text "after", ppr m]) $ - Just $ graphOfMiddles middles + Just $ graphOfMiddles (m : code') middle _ = Nothing -- | For conversion back to vanilla C-- @@ -284,13 +282,26 @@ insertLateReloads g = mapM_blocks insertM g let (h', fuel') = maybe_add_reload h avail l fuel in (zipht h' (ZLast l), fuel') maybe_add_reload h avail node fuel = - let used = foldRegsUsed - (\u r -> if elemAvail avail r then extendRegSet u r else u) - emptyRegSet node + let used = filterRegsUsed (elemAvail avail) node in if fuel == 0 || isEmptyUniqSet used then (h, fuel) else (ZHead h (Reload used), fuel-1) +_lateReloadsWithoutFuel :: LGraph M Last -> LGraph M Last +_lateReloadsWithoutFuel g = map_blocks insert g + where env = cmmAvailableReloads g + avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet + insert (Block id tail) = propagate (ZFirst id) (avail id) tail + propagate h avail (ZTail m t) = + propagate (ZHead (maybe_add_reload h avail m) m) (middleAvail m avail) t + propagate h avail (ZLast l) = + zipht (maybe_add_reload h avail l) (ZLast l) + maybe_add_reload h avail node = + let used = filterRegsUsed (elemAvail avail) node + in if isEmptyUniqSet used then h + else ZHead h (Reload used) + + removeDeadAssignmentsAndReloads :: BPass M Last DualLive removeDeadAssignmentsAndReloads = a_ft_b dualLiveness remove_deads where remove_deads = BComp "dead-assignment & -reload elim" exit last middle first diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs index 2b7cb14..efe9365 100644 --- a/compiler/cmm/ZipDataflow.hs +++ b/compiler/cmm/ZipDataflow.hs @@ -298,8 +298,7 @@ refine_b_anal comp graph initial = set_block_fact () b@(G.Block id _) = let (h, l) = G.goto_end (G.unzip b) in do env <- factsEnv - let block_in = head_in h (last_in comp env l) -- 'in' fact for the block - setFact id block_in + setFact id $ head_in h (last_in comp env l) -- 'in' fact for the block head_in (G.ZHead h m) out = head_in h (bc_middle_in comp out m) head_in (G.ZFirst id) out = bc_first_in comp out id -- 1.7.10.4