Remove OldCmm, convert backends to consume new Cmm

This removes the OldCmm data type and the CmmCvt pass that converts
new Cmm to OldCmm.  The backends (NCGs, LLVM and C) have all been
converted to consume new Cmm.

The main difference between the two data types is that conditional
branches in new Cmm have both true/false successors, whereas in OldCmm
the false case was a fallthrough.  To generate slightly better code we
occasionally need to invert a conditional to ensure that the
branch-not-taken becomes a fallthrough; this was previously done in
CmmCvt, and it is now done in CmmContFlowOpt.

We could go further and use the Hoopl Block representation for native
code, which would mean that we could use Hoopl's postorderDfs and
analyses for native code, but for now I've left it as is, using the
old ListGraph representation for native code.

13 files changed, 51 insertions, 51 deletions

diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index c4efdf677e..f3b70e7e61 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -6,6 +6,7 @@
 --
 -----------------------------------------------------------------------------
 
+{-# LANGUAGE GADTs #-}
 module SPARC.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -38,7 +39,9 @@ import NCGMonad
 
 -- Our intermediate code:
 import BlockId
-import OldCmm
+import Cmm
+import CmmUtils
+import Hoopl
 import PIC
 import Reg
 import CLabel
@@ -59,8 +62,9 @@ import Control.Monad    ( mapAndUnzipM )
 cmmTopCodeGen :: RawCmmDecl
               -> NatM [NatCmmDecl CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab live (ListGraph blocks))
- = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
+cmmTopCodeGen (CmmProc info lab live graph)
+ = do let blocks = toBlockListEntryFirst graph
+      (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
 
       let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
       let tops = proc : concat statics
@@ -76,12 +80,16 @@ cmmTopCodeGen (CmmData sec dat) = do
 --      are indicated by the NEWBLOCK instruction.  We must split up the
 --      instruction stream into basic blocks again.  Also, we extract
 --      LDATAs here too.
-basicBlockCodeGen :: CmmBasicBlock
+basicBlockCodeGen :: CmmBlock
                   -> NatM ( [NatBasicBlock Instr]
                           , [NatCmmDecl CmmStatics Instr])
 
-basicBlockCodeGen cmm@(BasicBlock id stmts) = do
-  instrs <- stmtsToInstrs stmts
+basicBlockCodeGen block = do
+  let (CmmEntry id, nodes, tail)  = blockSplit block
+      stmts = blockToList nodes
+  mid_instrs <- stmtsToInstrs stmts
+  tail_instrs <- stmtToInstrs tail
+  let instrs = mid_instrs `appOL` tail_instrs
   let
         (top,other_blocks,statics)
                 = foldrOL mkBlocks ([],[],[]) instrs
@@ -97,24 +105,23 @@ basicBlockCodeGen cmm@(BasicBlock id stmts) = do
 
         -- do intra-block sanity checking
         blocksChecked
-                = map (checkBlock cmm)
+                = map (checkBlock block)
                 $ BasicBlock id top : other_blocks
 
   return (blocksChecked, statics)
 
 
 -- | Convert some Cmm statements to SPARC instructions.
-stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
+stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
 stmtsToInstrs stmts
    = do instrss <- mapM stmtToInstrs stmts
         return (concatOL instrss)
 
 
-stmtToInstrs :: CmmStmt -> NatM InstrBlock
+stmtToInstrs :: CmmNode e x -> NatM InstrBlock
 stmtToInstrs stmt = do
   dflags <- getDynFlags
   case stmt of
-    CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
 
     CmmAssign reg src
@@ -131,17 +138,19 @@ stmtToInstrs stmt = do
         where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
-    CmmCall target result_regs args _
+    CmmUnsafeForeignCall target result_regs args
        -> genCCall target result_regs args
 
     CmmBranch   id              -> genBranch id
-    CmmCondBranch arg id        -> genCondJump id arg
+    CmmCondBranch arg true false -> do b1 <- genCondJump true arg
+                                       b2 <- genBranch false
+                                       return (b1 `appOL` b2)
     CmmSwitch   arg ids         -> do dflags <- getDynFlags
                                       genSwitch dflags arg ids
-    CmmJump     arg _           -> genJump arg
+    CmmCall { cml_target = arg } -> genJump arg
 
-    CmmReturn
-     -> panic "stmtToInstrs: return statement should have been cps'd away"
+    _
+     -> panic "stmtToInstrs: statement should have been cps'd away"
 
 
 {-
@@ -369,9 +378,9 @@ generateJumpTableForInstr _ _ = Nothing
 -}
 
 genCCall
-    :: CmmCallTarget            -- function to call
-    -> [HintedCmmFormal]        -- where to put the result
-    -> [HintedCmmActual]        -- arguments (of mixed type)
+    :: ForeignTarget            -- function to call
+    -> [CmmFormal]        -- where to put the result
+    -> [CmmActual]        -- arguments (of mixed type)
     -> NatM InstrBlock
 
 
@@ -382,28 +391,20 @@ genCCall
 --
 -- In the SPARC case we don't need a barrier.
 --
-genCCall (CmmPrim (MO_WriteBarrier) _) _ _
+genCCall (PrimTarget MO_WriteBarrier) _ _
  = do   return nilOL
 
-genCCall (CmmPrim _ (Just stmts)) _ _
-    = stmtsToInstrs stmts
-
-genCCall target dest_regs argsAndHints
+genCCall target dest_regs args0
  = do
         -- need to remove alignment information
-        let argsAndHints' | CmmPrim mop _ <- target,
+        let args | PrimTarget mop <- target,
                             (mop == MO_Memcpy ||
                              mop == MO_Memset ||
                              mop == MO_Memmove)
-                          = init argsAndHints
+                          = init args0
 
                           | otherwise
-                          = argsAndHints
-
-        -- strip hints from the arg regs
-        let args :: [CmmExpr]
-            args  = map hintlessCmm argsAndHints'
-
+                          = args0
 
         -- work out the arguments, and assign them to integer regs
         argcode_and_vregs       <- mapM arg_to_int_vregs args
@@ -416,14 +417,14 @@ genCCall target dest_regs argsAndHints
 
         -- deal with static vs dynamic call targets
         callinsns <- case target of
-                CmmCallee (CmmLit (CmmLabel lbl)) _ ->
+                ForeignTarget (CmmLit (CmmLabel lbl)) _ ->
                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 
-                CmmCallee expr _
+                ForeignTarget expr _
                  -> do  (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
-                CmmPrim mop _
+                PrimTarget mop
                  -> do  res     <- outOfLineMachOp mop
                         lblOrMopExpr <- case res of
                                 Left lbl -> do
@@ -539,11 +540,11 @@ move_final (v:vs) (a:az) offset
 -- | Assign results returned from the call into their
 --      desination regs.
 --
-assign_code :: Platform -> [CmmHinted LocalReg] -> OrdList Instr
+assign_code :: Platform -> [LocalReg] -> OrdList Instr
 
 assign_code _ [] = nilOL
 
-assign_code platform [CmmHinted dest _hint]
+assign_code platform [dest]
  = let  rep     = localRegType dest
         width   = typeWidth rep
         r_dest  = getRegisterReg platform (CmmLocal dest)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
index 139064ccbd..7871569dba 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
@@ -22,7 +22,7 @@ import SPARC.Base
 import NCGMonad
 import Size
 
-import OldCmm
+import Cmm
 
 import OrdList
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs
index 367d9230ba..16384f102a 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Base.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs
@@ -30,8 +30,7 @@ import Reg
 
 import CodeGen.Platform
 import DynFlags
-import OldCmm
-import OldPprCmm ()
+import Cmm
 import Platform
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index d459d98212..0e94d67a24 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -24,7 +24,7 @@ import SPARC.Base
 import NCGMonad
 import Size
 
-import OldCmm
+import Cmm
 
 import OrdList
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
index fa397771d7..16b9b42fcd 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -21,7 +21,7 @@ import SPARC.Ppr	()
 import Instruction
 import Reg
 import Size
-import OldCmm
+import Cmm
 
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index f7c7419e15..3e255365b9 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -29,7 +29,7 @@ import NCGMonad
 import Size
 import Reg
 
-import OldCmm
+import Cmm
 
 import Control.Monad (liftM)
 import DynFlags
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
index 7de92cb659..43632c676d 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs-boot
@@ -10,7 +10,7 @@ import SPARC.CodeGen.Base
 import NCGMonad
 import Reg
 
-import OldCmm
+import Cmm
 
 getSomeReg  :: CmmExpr -> NatM (Reg, InstrBlock)
 getRegister :: CmmExpr -> NatM Register
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 654875c497..7b39a371d7 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -28,7 +28,7 @@ import Instruction
 import Size
 import Reg
 
-import OldCmm
+import Cmm
 
 import DynFlags
 import OrdList
diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
index 7eb8bb4a53..ac8b175802 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
@@ -19,14 +19,14 @@ import SPARC.Instr
 import SPARC.Ppr	()
 import Instruction
 
-import OldCmm
+import Cmm
 
 import Outputable
 
 
 -- | Enforce intra-block invariants.
 --
-checkBlock :: CmmBasicBlock
+checkBlock :: CmmBlock
            -> NatBasicBlock Instr
            -> NatBasicBlock Instr
 
diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs
index fe64738f7b..77761fcf35 100644
--- a/compiler/nativeGen/SPARC/Imm.hs
+++ b/compiler/nativeGen/SPARC/Imm.hs
@@ -15,7 +15,7 @@ module SPARC.Imm (
 
 where
 
-import OldCmm
+import Cmm
 import CLabel
 
 import Outputable
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index f55c660118..4896d414a2 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -47,7 +47,7 @@ import CLabel
 import CodeGen.Platform
 import BlockId
 import DynFlags
-import OldCmm
+import Cmm
 import FastString
 import FastBool
 import Outputable
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 9bfa3141cc..601b5288a0 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -35,8 +35,8 @@ import Reg
 import Size
 import PprBase
 
-import OldCmm
-import OldPprCmm()
+import Cmm hiding (topInfoTable)
+import PprCmm()
 import CLabel
 import BlockId
 
diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs
index 5d63fd73a1..bd66d04fa1 100644
--- a/compiler/nativeGen/SPARC/ShortcutJump.hs
+++ b/compiler/nativeGen/SPARC/ShortcutJump.hs
@@ -21,7 +21,7 @@ import SPARC.Imm
 
 import CLabel
 import BlockId
-import OldCmm
+import Cmm
 
 import Panic
 import Unique