diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-07-19 10:03:06 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-07-30 11:55:17 +0100 |
| commit | f1ed6a1052331b6d5b001983925bdab66f99b0f6 (patch) | |
| tree | d7c494a8e9bff22a5d91ca7765792a9ce13dac4a /compiler/cmm/OldCmm.hs | |
| parent | fe3753e75f2f140c6c2554e3e255d8f4c6f254be (diff) | |
| download | haskell-f1ed6a1052331b6d5b001983925bdab66f99b0f6.tar.gz | |
New codegen: do not split proc-points when using the NCG
Proc-point splitting is only required by backends that do not support
having proc-points within a code block (that is, everything except the
native backend, i.e. LLVM and C).
Not doing proc-point splitting saves some compilation time, and might
produce slightly better code in some cases.
Diffstat (limited to 'compiler/cmm/OldCmm.hs')
| -rw-r--r-- | compiler/cmm/OldCmm.hs | 20 |
1 files changed, 15 insertions, 5 deletions
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs index aa83afbf8d..05aa5fb811 100644 --- a/compiler/cmm/OldCmm.hs +++ b/compiler/cmm/OldCmm.hs @@ -9,7 +9,7 @@ module OldCmm ( CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl, ListGraph(..), - CmmInfoTable(..), ClosureTypeInfo(..), + CmmInfoTable(..), ClosureTypeInfo(..), topInfoTable, CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual, cmmMapGraph, cmmTopMapGraph, @@ -64,16 +64,18 @@ import ForeignCall -- across a whole compilation unit. newtype ListGraph i = ListGraph [GenBasicBlock i] +type CmmInfoTables = BlockEnv CmmInfoTable + -- | Cmm with the info table as a data type -type CmmGroup = GenCmmGroup CmmStatics CmmInfoTable (ListGraph CmmStmt) -type CmmDecl = GenCmmDecl CmmStatics CmmInfoTable (ListGraph CmmStmt) +type CmmGroup = GenCmmGroup CmmStatics CmmInfoTables (ListGraph CmmStmt) +type CmmDecl = GenCmmDecl CmmStatics CmmInfoTables (ListGraph CmmStmt) -- | Cmm with the info tables converted to a list of 'CmmStatic' along with the info -- table label. If we are building without tables-next-to-code there will be no statics -- -- INVARIANT: if there is an info table, it has at least one CmmStatic -type RawCmmGroup = GenCmmGroup CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) -type RawCmmDecl = GenCmmDecl CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) +type RawCmmGroup = GenCmmGroup CmmStatics (BlockEnv CmmStatics) (ListGraph CmmStmt) +type RawCmmDecl = GenCmmDecl CmmStatics (BlockEnv CmmStatics) (ListGraph CmmStmt) -- A basic block containing a single label, at the beginning. @@ -99,6 +101,14 @@ blockStmts (BasicBlock _ stmts) = stmts mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i' mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs) +-- | Returns the info table associated with the CmmDecl's entry point, +-- if any. +topInfoTable :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> Maybe i +topInfoTable (CmmProc infos _ (ListGraph (b:_))) + = mapLookup (blockId b) infos +topInfoTable _ + = Nothing + ---------------------------------------------------------------- -- graph maps ---------------------------------------------------------------- |