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 ...@@ -92,6 +92,7 @@ data DynFlag
-- debugging flags -- debugging flags
= Opt_D_dump_cmm = Opt_D_dump_cmm
| Opt_D_dump_cps_cmm
| Opt_D_dump_asm | Opt_D_dump_asm
| Opt_D_dump_cpranal | Opt_D_dump_cpranal
| Opt_D_dump_deriv | Opt_D_dump_deriv
...@@ -937,6 +938,7 @@ dynamic_flags = [ ...@@ -937,6 +938,7 @@ dynamic_flags = [
, ( "dstg-stats", NoArg (setDynFlag Opt_StgStats)) , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
, ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm) , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
, ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
, ( "ddump-asm", setDumpFlag Opt_D_dump_asm) , ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
, ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal) , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
, ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv) , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
......
...@@ -75,6 +75,7 @@ import Name ( Name, NamedThing(..) ) ...@@ -75,6 +75,7 @@ import Name ( Name, NamedThing(..) )
import SimplStg ( stg2stg ) import SimplStg ( stg2stg )
import CodeGen ( codeGen ) import CodeGen ( codeGen )
import CmmParse ( parseCmmFile ) import CmmParse ( parseCmmFile )
import CmmCPS
import CodeOutput ( codeOutput ) import CodeOutput ( codeOutput )
import NameEnv ( emptyNameEnv ) import NameEnv ( emptyNameEnv )
...@@ -603,10 +604,12 @@ hscCompile cgguts ...@@ -603,10 +604,12 @@ hscCompile cgguts
codeGen dflags this_mod data_tycons codeGen dflags this_mod data_tycons
foreign_stubs dir_imps cost_centre_info foreign_stubs dir_imps cost_centre_info
stg_binds hpc_info stg_binds hpc_info
------------------ Convert to CPS --------------------
continuationC <- cmmCPS dflags abstractC
------------------ Code output ----------------------- ------------------ Code output -----------------------
(stub_h_exists,stub_c_exists) (stub_h_exists,stub_c_exists)
<- codeOutput dflags this_mod location foreign_stubs <- codeOutput dflags this_mod location foreign_stubs
dependencies abstractC dependencies continuationC
return stub_c_exists return stub_c_exists
hscConst :: b -> a -> Comp b hscConst :: b -> a -> Comp b
...@@ -718,7 +721,8 @@ hscCmmFile dflags filename = do ...@@ -718,7 +721,8 @@ hscCmmFile dflags filename = do
case maybe_cmm of case maybe_cmm of
Nothing -> return False Nothing -> return False
Just cmm -> do 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 return True
where where
no_mod = panic "hscCmmFile: no_mod" 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