From e367ebeb97b97bc2732202bcfabbbde63f1ec5cd Mon Sep 17 00:00:00 2001 From: "dias@eecs.harvard.edu" Date: Tue, 14 Oct 2008 14:02:02 +0000 Subject: [PATCH] Clarify the SRT building process Before: building a closure that would build an SRT given the top-level SRT. It was somewhat difficult to understand the control flow, and it may have had held onto some data structures long after they should be dead. Now, I just bundle the info we need about CAFs along with the procedure and directly call a new top-level function to build the SRTs later. --- compiler/cmm/CmmBuildInfoTables.hs | 45 +++++++++++++++++++++++------------- compiler/cmm/CmmCPSZ.hs | 33 ++++++++++++++++++++------ 2 files changed, 55 insertions(+), 23 deletions(-) diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index f24aceb..fa3d920 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -1,7 +1,8 @@ module CmmBuildInfoTables - ( CAFSet, CAFEnv, cafAnal, localCAFInfo, mkTopCAFInfo + ( CAFSet, CAFEnv, CmmTopForInfoTables(..), cafAnal, localCAFInfo, mkTopCAFInfo , setInfoTableSRT, setInfoTableStackMap , TopSRT, emptySRT, srtToData + , bundleCAFs , finishInfoTables, lowerSafeForeignCalls, extendEnvsForSafeForeignCalls ) where @@ -331,6 +332,8 @@ to_SRT top_srt off len bmp -- doesn't have a static closure. -- (If it has a static closure, it will already have an SRT to -- keep its CAFs live.) +-- Any procedure referring to a non-static CAF c must keep live the +-- any CAF that is reachable from c. localCAFInfo :: CAFEnv -> CmmTopZ -> Maybe (CLabel, CAFSet) localCAFInfo _ t@(CmmData _ _) = Nothing localCAFInfo cafEnv (CmmProc (CmmInfo _ _ infoTbl) top_l _ (LGraph entry _ _)) = @@ -369,23 +372,33 @@ mkTopCAFInfo localCAFs = foldl addToTop emptyFM g type StackLayout = [Maybe LocalReg] +-- Bundle the CAFs used at a procpoint. +bundleCAFs :: CAFEnv -> CmmTopForInfoTables -> (CAFSet, CmmTopForInfoTables) +bundleCAFs cafEnv t@(ProcInfoTable _ procpoints) = + case blockSetToList procpoints of + [bid] -> (expectJust "bundleCAFs " (lookupBlockEnv cafEnv bid), t) + _ -> panic "setInfoTableStackMap: unexpect number of procpoints" + -- until we stop splitting the graphs at procpoints in the native path +bundleCAFs cafEnv t@(FloatingInfoTable _ bid _) = + (expectJust "bundleCAFs " (lookupBlockEnv cafEnv bid), t) +bundleCAFs _ t@(NoInfoTable _) = (emptyFM, t) + -- Construct the SRTs for the given procedure. -setInfoTableSRT :: CAFEnv -> FiniteMap CLabel CAFSet -> TopSRT -> - CmmTopForInfoTables -> FuelMonad (TopSRT, [CmmTopForInfoTables]) -setInfoTableSRT cafEnv topCAFMap topSRT t@(ProcInfoTable p procpoints) = +setInfoTableSRT :: FiniteMap CLabel CAFSet -> TopSRT -> (CAFSet, CmmTopForInfoTables) -> + FuelMonad (TopSRT, [CmmTopForInfoTables]) +setInfoTableSRT topCAFMap topSRT (cafs, t@(ProcInfoTable p procpoints)) = case blockSetToList procpoints of - [bid] -> setSRT cafEnv topCAFMap topSRT t bid - _ -> panic "setInfoTableStackMap: unexpect number of procpoints" - -- until we stop splitting the graphs at procpoints in the native path -setInfoTableSRT cafEnv topCAFMap topSRT t@(FloatingInfoTable info bid _) = - setSRT cafEnv topCAFMap topSRT t bid -setInfoTableSRT _ _ topSRT t@(NoInfoTable _) = return (topSRT, [t]) - -setSRT :: CAFEnv -> FiniteMap CLabel CAFSet -> TopSRT -> - CmmTopForInfoTables -> BlockId -> FuelMonad (TopSRT, [CmmTopForInfoTables]) -setSRT cafEnv topCAFMap topSRT t bid = - do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap - (expectJust "sub_srt" $ lookupBlockEnv cafEnv bid) + [bid] -> setSRT cafs topCAFMap topSRT t + _ -> panic "setInfoTableStackMap: unexpect number of procpoints" + -- until we stop splitting the graphs at procpoints in the native path +setInfoTableSRT topCAFMap topSRT (cafs, t@(FloatingInfoTable info bid _)) = + setSRT cafs topCAFMap topSRT t +setInfoTableSRT _ topSRT (_, t@(NoInfoTable _)) = return (topSRT, [t]) + +setSRT :: CAFSet -> FiniteMap CLabel CAFSet -> TopSRT -> + CmmTopForInfoTables -> FuelMonad (TopSRT, [CmmTopForInfoTables]) +setSRT cafs topCAFMap topSRT t = + do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap cafs let t' = updInfo id (const srt) t case cafTable of Just tbl -> return (topSRT, [t', NoInfoTable tbl]) diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs index 6dcc5c5..7db4eed 100644 --- a/compiler/cmm/CmmCPSZ.hs +++ b/compiler/cmm/CmmCPSZ.hs @@ -52,9 +52,10 @@ protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops) | otherwise = do let dflags = hsc_dflags hsc_env showPass dflags "CPSZ" - (cafEnvs, toTops) <- liftM unzip $ mapM (cpsTop hsc_env) tops + (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops let topCAFEnv = mkTopCAFInfo (concat cafEnvs) - (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops + (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops + -- (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops let cmms = Cmm (reverse (concat tops)) dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms) return (topSRT, cmms : rst) @@ -68,9 +69,8 @@ global to one compiler session. cpsTop :: HscEnv -> CmmTopZ -> IO ([(CLabel, CAFSet)], - (FiniteMap CLabel CAFSet -> (TopSRT, [[CmmTopZ]]) -> IO (TopSRT, [[CmmTopZ]]))) -cpsTop _ p@(CmmData {}) = - return ([], (\ _ (topSRT, tops) -> return (topSRT, [p] : tops))) + [(CAFSet, CmmTopForInfoTables)]) +cpsTop _ p@(CmmData {}) = return ([], [(emptyFM, NoInfoTable p)]) cpsTop hsc_env (CmmProc h l args g) = do dump Opt_D_dump_cmmz "Pre Proc Points Added" g @@ -122,6 +122,10 @@ cpsTop hsc_env (CmmProc h l args g) = -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES let gs' = map (setInfoTableStackMap slotEnv areaMap) gs mapM (dump Opt_D_dump_cmmz "after setInfoTableStackMap") gs' + let gs'' = map (bundleCAFs cafEnv) gs' + mapM (dump Opt_D_dump_cmmz "after bundleCAFs") gs'' + return (localCAFs, gs'') +{- -- Return: (a) CAFs used by this proc (b) a closure that will compute -- a new SRT for the procedure. let toTops topCAFEnv (topSRT, tops) = @@ -130,9 +134,9 @@ cpsTop hsc_env (CmmProc h l args g) = return (topSRT, gs : rst) (topSRT, gs') <- run $ foldM setSRT (topSRT, []) gs' gs' <- mapM finishInfoTables (concat gs') - pprTrace "localCAFs" (ppr localCAFs <+> ppr topSRT) $ - return (topSRT, concat gs' : tops) + return (topSRT, concat gs' : tops) return (localCAFs, toTops) +-} 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) @@ -142,3 +146,18 @@ cpsTop hsc_env (CmmProc h l args g) = g <- run $ pass g dump flag ("Post " ++ txt) $ g return g + +-- This probably belongs in CmmBuildInfoTables? +-- We're just finishing the job here: once we know what CAFs are defined +-- in non-static closures, we can build the SRTs. +toTops :: HscEnv -> FiniteMap CLabel CAFSet -> (TopSRT, [[CmmTopZ]]) + -> [(CAFSet, CmmTopForInfoTables)] -> IO (TopSRT, [[CmmTopZ]]) + +toTops hsc_env topCAFEnv (topSRT, tops) gs = + do let setSRT (topSRT, rst) g = + do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g + return (topSRT, gs : rst) + (topSRT, gs') <- run $ foldM setSRT (topSRT, []) gs + gs' <- mapM finishInfoTables (concat gs') + return (topSRT, concat gs' : tops) + where run = runFuelIO (hsc_OptFuel hsc_env) -- 1.7.10.4