blob: 9410304b688ab3b9c69e197fdc4d031656946ad3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module CmmCPSZ (
-- | Converts C-- with full proceedures and parameters
-- to a CPS transformed C-- with the stack made manifest.
-- Well, sort of.
protoCmmCPSZ
) where
import Cmm
import CmmContFlowOpt
import CmmProcPointZ
import CmmSpillReload
import CmmTx
import DFMonad
import DynFlags
import ErrUtils
import Outputable
import PprCmmZ()
import UniqSupply
import ZipCfg hiding (zip, unzip)
import ZipCfgCmmRep
import ZipDataflow
-----------------------------------------------------------------------------
-- |Top level driver for the CPS pass
-----------------------------------------------------------------------------
protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
-> CmmZ -- ^ Input C-- with Proceedures
-> IO CmmZ -- ^ Output CPS transformed C--
protoCmmCPSZ dflags (Cmm tops)
= do { showPass dflags "CPSZ"
; u <- mkSplitUniqSupply 'p'
; let txtops = initUs_ u $ mapM cpsTop tops
; let pgm = Cmm $ runDFTx maxBound $ sequence txtops
--- XXX calling runDFTx is totally bogus
; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr pgm)
; return pgm
}
cpsTop :: CmmTopZ -> UniqSM (DFTx CmmTopZ)
cpsTop p@(CmmData {}) = return $ return p
cpsTop (CmmProc h l args g) =
let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
g' = addProcPointProtocols procPoints args g
g'' = map_nodes id NotSpillOrReload id g'
in do us <- getUs
let g = runDFM us dualLiveLattice $ b_rewrite dualLivenessWithInsertion g''
-- let igraph = buildIGraph
return $ do g' <- g >>= return . map_nodes id spillAndReloadComments id
return $ CmmProc h l args g'
|
