Commit e367ebeb authored by dias@eecs.harvard.edu's avatar dias@eecs.harvard.edu

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.
parent 309f64a0
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
[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 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)
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])
......
......@@ -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 (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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment