From a28ed19690f2de7eb979d1d75f35071abbf9a102 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Tue, 5 Apr 2011 13:10:00 +0100 Subject: [PATCH] Give infinite fuel to required C-- transformations. Fixes #4971. Signed-off-by: Edward Z. Yang --- compiler/cmm/CmmCPS.hs | 24 ++++++++++++++---------- compiler/cmm/OptimizationFuel.hs | 17 +++++++++++++++-- 2 files changed, 29 insertions(+), 12 deletions(-) diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs index 372562c..b9f6db3 100644 --- a/compiler/cmm/CmmCPS.hs +++ b/compiler/cmm/CmmCPS.hs @@ -71,10 +71,10 @@ cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)]) cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) = do -- Why bother doing it this early? - -- g <- dual_rewrite Opt_D_dump_cmmz "spills and reloads" + -- g <- dual_rewrite run Opt_D_dump_cmmz "spills and reloads" -- (dualLivenessWithInsertion callPPs) g -- g <- run $ insertLateReloads g -- Duplicate reloads just before uses - -- g <- dual_rewrite Opt_D_dump_cmmz "Dead Assignment Elimination" + -- g <- dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment Elimination" -- (removeDeadAssignmentsAndReloads callPPs) g dump Opt_D_dump_cmmz "Pre common block elimination" g g <- return $ elimCommonBlocks g @@ -91,16 +91,16 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) ----------- Spills and reloads ------------------- g <- -- pprTrace "pre Spills" (ppr g) $ - dual_rewrite Opt_D_dump_cmmz "spills and reloads" + dual_rewrite run Opt_D_dump_cmmz "spills and reloads" (dualLivenessWithInsertion procPoints) g -- Insert spills at defns; reloads at return points g <- -- pprTrace "pre insertLateReloads" (ppr g) $ - run $ insertLateReloads g -- Duplicate reloads just before uses + runOptimization $ insertLateReloads g -- Duplicate reloads just before uses dump Opt_D_dump_cmmz "Post late reloads" g g <- -- pprTrace "post insertLateReloads" (ppr g) $ - dual_rewrite Opt_D_dump_cmmz "Dead Assignment Elimination" + dual_rewrite runOptimization Opt_D_dump_cmmz "Dead Assignment Elimination" (removeDeadAssignmentsAndReloads procPoints) g -- Remove redundant reloads (and any other redundant asst) @@ -146,12 +146,16 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) where dflags = hsc_dflags hsc_env mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z dump f txt g = dumpIfSet_dyn dflags f txt (ppr g) - - run = runFuelIO (hsc_OptFuel hsc_env) - - dual_rewrite flag txt pass g = + -- Runs a required transformation/analysis + run = runInfiniteFuelIO (hsc_OptFuel hsc_env) + -- Runs an optional transformation/analysis (and should + -- thus be subject to optimization fuel) + runOptimization = runFuelIO (hsc_OptFuel hsc_env) + + -- pass 'run' or 'runOptimization' for 'r' + dual_rewrite r flag txt pass g = do dump flag ("Pre " ++ txt) g - g <- run $ pass g + g <- r $ pass g dump flag ("Post " ++ txt) $ g return g diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs index 057a965..8d3a06b 100644 --- a/compiler/cmm/OptimizationFuel.hs +++ b/compiler/cmm/OptimizationFuel.hs @@ -6,12 +6,12 @@ -- the optimiser with varying amount of fuel to find out the exact number of -- steps where a bug is introduced in the output. module OptimizationFuel - ( OptimizationFuel, amountOfFuel, tankFilledTo, anyFuelLeft, oneLessFuel + ( OptimizationFuel, amountOfFuel, tankFilledTo, unlimitedFuel, anyFuelLeft, oneLessFuel , OptFuelState, initOptFuelState , FuelConsumer, FuelUsingMonad, FuelState , fuelGet, fuelSet, lastFuelPass, setFuelPass , fuelExhausted, fuelDec1, tryWithFuel - , runFuelIO, fuelConsumingPass + , runFuelIO, runInfiniteFuelIO, fuelConsumingPass , FuelUniqSM , liftUniq ) @@ -51,6 +51,7 @@ amountOfFuel :: OptimizationFuel -> Int anyFuelLeft :: OptimizationFuel -> Bool oneLessFuel :: OptimizationFuel -> OptimizationFuel +unlimitedFuel :: OptimizationFuel #ifdef DEBUG newtype OptimizationFuel = OptimizationFuel Int @@ -61,6 +62,7 @@ amountOfFuel (OptimizationFuel f) = f anyFuelLeft (OptimizationFuel f) = f > 0 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1)) +unlimitedFuel = OptimizationFuel infiniteFuel #else -- type OptimizationFuel = State# () -- would like this, but it won't work data OptimizationFuel = OptimizationFuel @@ -70,6 +72,7 @@ amountOfFuel _ = maxBound anyFuelLeft _ = True oneLessFuel _ = OptimizationFuel +unlimitedFuel = OptimizationFuel #endif data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass :: String } @@ -92,6 +95,16 @@ runFuelIO fs (FUSM f) = writeIORef (fuel_ref fs) fuel' return a +-- ToDo: Do we need the pass_ref when we are doing infinite fueld +-- transformations? +runInfiniteFuelIO :: OptFuelState -> FuelUniqSM a -> IO a +runInfiniteFuelIO fs (FUSM f) = + do pass <- readIORef (pass_ref fs) + u <- mkSplitUniqSupply 'u' + let (a, FuelState _ pass') = initUs_ u $ f (FuelState unlimitedFuel pass) + writeIORef (pass_ref fs) pass' + return a + instance Monad FuelUniqSM where FUSM f >>= k = FUSM (\s -> f s >>= \(a, s') -> unFUSM (k a) s') return a = FUSM (\s -> return (a, s)) -- 1.7.10.4