+insertLateReloads :: LGraph M Last -> FuelMonad (LGraph M Last)
+insertLateReloads g = mapM_blocks insertM g
+ where env = cmmAvailableReloads g
+ avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
+ insertM b = fuelConsumingPass "late reloads" (insert b)
+ insert (Block id tail) fuel = propagate (ZFirst id) (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 (ZHead h (Reload used), oneLessFuel fuel)
+
+insertLateReloads' :: UniqSupply -> (Graph M Last) -> FuelMonad (Graph M Last)
+insertLateReloads' us g =
+ runDFM us availRegsLattice $
+ f_shallow_rewrite avail_reloads_transfer insert bot g
+ where bot = fact_bot availRegsLattice
+ insert = null_f_ft { fc_middle_out = middle, fc_last_outs = last }
+ middle :: AvailRegs -> M -> Maybe (Graph M Last)
+ last :: AvailRegs -> Last -> Maybe (Graph M Last)
+ middle avail m = maybe_reload_before avail m (ZTail m (ZLast LastExit))
+ last avail l = maybe_reload_before avail l (ZLast (LastOther l))
+ maybe_reload_before avail node tail =
+ let used = filterRegsUsed (elemAvail avail) node
+ in if isEmptyUniqSet used then Nothing
+ else Just $ graphOfZTail $ ZTail (Reload used) tail
+
+_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
+ exit = Nothing
+ last = \_ _ -> Nothing
+ middle = middleRemoveDeads
+ first _ _ = Nothing
+
+middleRemoveDeads :: DualLive -> M -> Maybe (Graph M Last)
+middleRemoveDeads _ (Spill _) = Nothing
+middleRemoveDeads live (Reload s) =
+ if sizeUniqSet worth_reloading < sizeUniqSet s then
+ Just $ if isEmptyUniqSet worth_reloading then emptyGraph
+ else graphOfMiddles [Reload worth_reloading]
+ else
+ Nothing
+ where worth_reloading = intersectUniqSets s (in_regs live)
+middleRemoveDeads live (NotSpillOrReload m) = middle m
+ where middle (MidAssign (CmmLocal reg') _)
+ | not (reg' `elemRegSet` in_regs live) = Just emptyGraph
+ middle _ = Nothing
+
+
+
+---------------------
+-- register usage
+
+instance UserOfLocalRegs m => UserOfLocalRegs (ExtendWithSpills m) where
+ foldRegsUsed f z (Spill regs) = foldRegsUsed f z regs
+ foldRegsUsed _f z (Reload _) = z
+ foldRegsUsed f z (NotSpillOrReload m) = foldRegsUsed f z m