+insertLateReloads :: LGraph Middle Last -> FuelMonad (LGraph Middle Last)
+insertLateReloads g =
+ do env <- cmmAvailableReloads g
+ mapM_blocks (insertM env) g
+ where insertM env b = fuelConsumingPass "late reloads" (insert b)
+ where avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
+ insert (Block id off tail) fuel =
+ propagate (ZFirst id off) (avail id) tail fuel
+ propagate h avail (ZTail m t) fuel =
+ let (h', fuel') = maybe_add_reload h avail m fuel in
+ propagate (ZHead h' m) (middleAvail m avail) t fuel'
+ propagate h avail (ZLast l) fuel =
+ 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 = filterRegsUsed (elemAvail avail) node
+ in if not (canRewriteWithFuel fuel) || isEmptyUniqSet used
+ then (h,fuel)
+ else (spillHead h used, oneLessFuel fuel)
+
+type LateReloadFix = FuelMonad (ForwardFixedPoint Middle Last AvailRegs (LGraph Middle Last))
+
+insertLateReloads' :: (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+insertLateReloads' g = liftM zdfFpContents $ (res :: LateReloadFix)
+ where res = zdfFRewriteFromL RewriteShallow emptyBlockEnv "insert late reloads"
+ availRegsLattice avail_reloads_transfer rewrites bot g
+ bot = fact_bot availRegsLattice
+ rewrites = ForwardRewrites first middle last exit
+ first _ _ = Nothing
+ middle :: AvailRegs -> Middle -> Maybe (AGraph Middle Last)
+ last :: AvailRegs -> Last -> Maybe (AGraph Middle Last)
+ middle avail m = maybe_reload_before avail m (ZTail m (ZLast LastExit))
+ last avail l = maybe_reload_before avail l (ZLast (LastOther l))
+ exit _ = Nothing
+ maybe_reload_before avail node tail =
+ let used = filterRegsUsed (elemAvail avail) node
+ in if isEmptyUniqSet used then Nothing
+ else Just $ mkZTail $ reloadTail used tail
+
+removeDeadAssignmentsAndReloads :: BlockSet -> (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+removeDeadAssignmentsAndReloads procPoints g =
+ liftM zdfFpContents $ (res :: LiveReloadFix (LGraph Middle Last))
+ where res = zdfBRewriteFromL RewriteDeep emptyBlockEnv "dead-assignment & -reload elim"
+ dualLiveLattice (dualLiveTransfers procPoints)
+ rewrites (fact_bot dualLiveLattice) g
+ rewrites = BackwardRewrites first middle last exit
+ exit = Nothing
+ last = \_ _ -> Nothing
+ middle = middleRemoveDeads
+ first _ _ = Nothing
+
+middleRemoveDeads :: DualLive -> Middle -> Maybe (AGraph Middle Last)
+middleRemoveDeads live m = middle m
+ where middle (MidAssign (CmmLocal reg') _)
+ | not (reg' `elemRegSet` in_regs live) = Just emptyAGraph
+ middle _ = Nothing
+
+