3 -- | Converts C-- with full proceedures and parameters
4 -- to a CPS transformed C-- with the stack made manifest.
20 import ZipCfg hiding (zip, unzip)
24 -----------------------------------------------------------------------------
25 -- |Top level driver for the CPS pass
26 -----------------------------------------------------------------------------
27 protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
28 -> CmmZ -- ^ Input C-- with Proceedures
29 -> IO CmmZ -- ^ Output CPS transformed C--
30 protoCmmCPSZ dflags (Cmm tops)
31 = do { showPass dflags "CPSZ"
32 ; u <- mkSplitUniqSupply 'p'
33 ; let txtops = initUs_ u $ mapM cpsTop tops
34 ; let pgm = Cmm $ runDFTx maxBound $ sequence txtops
35 --- XXX calling runDFTx is totally bogus
36 ; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr pgm)
40 cpsTop :: CmmTopZ -> UniqSM (DFTx CmmTopZ)
41 cpsTop p@(CmmData {}) = return $ return p
42 cpsTop (CmmProc h l args g) =
43 let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
44 g' = addProcPointProtocols procPoints args g
45 g'' = map_nodes id NotSpillOrReload id g'
47 let g = runDFM us dualLiveLattice $ b_rewrite dualLivenessWithInsertion g''
48 -- let igraph = buildIGraph
49 return $ do g' <- g >>= return . map_nodes id spillAndReloadComments id
50 return $ CmmProc h l args g'