Commit d0f6db5b authored by Michael D. Adams's avatar Michael D. Adams

Hooked the C-- CPS pass into the compilation pipeline

At present it just annotates each block with a comment
indicating what local registers are live at the start
of the block.
parent 4311d2d9
module CmmCPS (cmmCPS) where
#include "HsVersions.h"
import Cmm
import CmmLint
import PprCmm
import Dataflow (mapCmmTop, onBasicBlock, cmmLivenessComment, cmmLiveness)
import DynFlags
import ErrUtils
import Maybes
import Outputable
import Monad
import IO
cmmCPS :: DynFlags
-> [Cmm] -- C-- with Proceedures
-> IO [Cmm] -- Output: CPS transformed C--
cmmCPS dflags abstractC = do
when (dopt Opt_DoCmmLinting dflags) $
do showPass dflags "CmmLint"
case firstJust $ map cmmLint abstractC of
Just err -> do printDump err
ghcExit dflags 1
Nothing -> return ()
showPass dflags "CPS"
-- continuationC <- return abstractC
continuationC <- return $ map (mapCmmTop (onBasicBlock (\bs -> map (cmmLivenessComment (cmmLiveness bs)) bs))) abstractC
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
-- TODO: add option to dump Cmm to file
return continuationC
......@@ -92,6 +92,7 @@ data DynFlag
-- debugging flags
= Opt_D_dump_cmm
| Opt_D_dump_cps_cmm
| Opt_D_dump_asm
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
......@@ -937,6 +938,7 @@ dynamic_flags = [
, ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
, ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
, ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
, ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
, ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
, ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
......
......@@ -75,6 +75,7 @@ import Name ( Name, NamedThing(..) )
import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import CmmParse ( parseCmmFile )
import CmmCPS
import CodeOutput ( codeOutput )
import NameEnv ( emptyNameEnv )
......@@ -603,10 +604,12 @@ hscCompile cgguts
codeGen dflags this_mod data_tycons
foreign_stubs dir_imps cost_centre_info
stg_binds hpc_info
------------------ Convert to CPS --------------------
continuationC <- cmmCPS dflags abstractC
------------------ Code output -----------------------
(stub_h_exists,stub_c_exists)
<- codeOutput dflags this_mod location foreign_stubs
dependencies abstractC
dependencies continuationC
return stub_c_exists
hscConst :: b -> a -> Comp b
......@@ -718,7 +721,8 @@ hscCmmFile dflags filename = do
case maybe_cmm of
Nothing -> return False
Just cmm -> do
codeOutput dflags no_mod no_loc NoStubs [] [cmm]
continuationC <- cmmCPS dflags [cmm]
codeOutput dflags no_mod no_loc NoStubs [] continuationC
return True
where
no_mod = panic "hscCmmFile: no_mod"
......
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