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