2 -- | Converts C-- with full proceedures and parameters
3 -- to a CPS transformed C-- with the stack made manifest.
15 import ZipCfg hiding (zip, unzip)
26 -----------------------------------------------------------------------------
27 -- |Top level driver for the CPS pass
28 -----------------------------------------------------------------------------
29 protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
30 -> CmmZ -- ^ Input C-- with Proceedures
31 -> IO CmmZ -- ^ Output CPS transformed C--
32 protoCmmCPSZ dflags (Cmm tops)
33 | not (dopt Opt_RunCPSZ dflags)
34 = return (Cmm tops) -- Only if -frun-cps
36 = do { showPass dflags "CPSZ"
37 ; u <- mkSplitUniqSupply 'p'
38 ; pass_ref <- newIORef "unoptimized program" -- XXX see [Note global fuel]
39 ; fuel_ref <- newIORef (tankFilledTo maxBound) -- XXX see [Note global fuel]
40 ; let txtops = initUs_ u $ mapM cpsTop tops
41 ; tops <- runFuelIO pass_ref fuel_ref (sequence txtops)
42 ; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr (Cmm tops))
48 In a correct world, the identity and the last pass would be stored in
49 mutable reference cells associated with an 'HscEnv' and would be
50 global to one compiler session. Unfortunately the 'HscEnv' is not
51 plumbed sufficiently close to this function; only the DynFlags are
52 plumbed here. One day the plumbing will be extended, in which case
53 this pass will use the global 'pass_ref' and 'fuel_ref' instead of the
54 bogus facsimiles in place here.
57 cpsTop :: CmmTopZ -> UniqSM (FuelMonad CmmTopZ)
58 cpsTop p@(CmmData {}) = return (return p)
59 cpsTop (CmmProc h l args g) =
60 let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
61 g' = addProcPointProtocols procPoints args g
62 g'' = map_nodes id NotSpillOrReload id g'
63 -- Change types of middle nodes to allow spill/reload
64 in do { u1 <- getUs; u2 <- getUs; u3 <- getUs
65 ; entry <- getUniqueUs >>= return . BlockId
68 ; g <- dual_rewrite u1 dualLivenessWithInsertion g
69 -- Insert spills at defns; reloads at return points
70 ; g <- insertLateReloads' u2 (extend g)
71 -- Duplicate reloads just before uses
72 ; g <- dual_rewrite u3 removeDeadAssignmentsAndReloads (trim entry g)
73 -- Remove redundant reloads (and any other redundant asst)
74 ; return $ CmmProc h l args $ map_nodes id spillAndReloadComments id g
77 where dual_rewrite u pass g = runDFM u dualLiveLattice $ b_rewrite pass g
78 extend (LGraph eid blocks) = Graph (ZLast $ mkBranchNode eid) blocks
79 trim _ (Graph (ZLast (LastOther (LastBranch id))) blocks) = LGraph id blocks
80 trim e (Graph tail blocks) = LGraph e (insertBlock (Block e tail) blocks)