Merge in new code generator branch.

[ghc-hetmet.git] / compiler / nativeGen / SPARC / CodeGen.hs

diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 13907c7..d08d10d 100644 (file)
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -15,9 +15,10 @@ where
 
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 
 -- NCG stuff:
+import SPARC.CodeGen.Sanity
 import SPARC.CodeGen.Amode
 import SPARC.CodeGen.CondCode
 import SPARC.CodeGen.Gen64
@@ -35,14 +36,14 @@ import NCGMonad
 
 -- Our intermediate code:
 import BlockId
-import Cmm
+import OldCmm
 import CLabel
 
 -- The rest:
 import StaticFlags     ( opt_PIC )
 import OrdList
-import qualified Outputable as O
 import Outputable
+import Unique
 
 import Control.Monad   ( mapAndUnzipM )
 import DynFlags
@@ -54,11 +55,11 @@ cmmTopCodeGen
        -> NatM [NatCmmTop Instr]
 
 cmmTopCodeGen _
-       (CmmProc info lab params (ListGraph blocks)) 
+       (CmmProc info lab (ListGraph blocks)) 
  = do  
        (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
 
-       let proc        = CmmProc info lab params (ListGraph $ concat nat_blocks)
+       let proc        = CmmProc info lab (ListGraph $ concat nat_blocks)
        let tops        = proc : concat statics
 
        return tops
@@ -77,7 +78,7 @@ basicBlockCodeGen
        -> NatM ( [NatBasicBlock Instr]
                , [NatCmmTop Instr])
 
-basicBlockCodeGen (BasicBlock id stmts) = do
+basicBlockCodeGen cmm@(BasicBlock id stmts) = do
   instrs <- stmtsToInstrs stmts
   let
        (top,other_blocks,statics) 
@@ -92,46 +93,14 @@ basicBlockCodeGen (BasicBlock id stmts) = do
        mkBlocks instr (instrs,blocks,statics)
          = (instr:instrs, blocks, statics)
 
+       -- do intra-block sanity checking
        blocksChecked
-               = map checkBlockEnd
+               = map (checkBlock cmm)
                $ BasicBlock id top : other_blocks
 
   return (blocksChecked, statics)
 
 
--- | Enforce the invariant that all basic blocks must end with a jump.
---     For SPARC this is a jump, then a nop for the branch delay slot.
---
---     If the branch isn't there then the register liveness determinator
---     will get the liveness information wrong. This will cause a bad
---     allocation, which is seriously difficult to debug.
---
---     If there is an instr in the branch delay slot, then the allocator
---     will also get confused and give a bad allocation.
---
-checkBlockEnd 
-       :: NatBasicBlock Instr -> NatBasicBlock Instr
-
-checkBlockEnd block@(BasicBlock _ instrs)
-       | Just (i1, i2) <- takeLast2 instrs
-       , isJumpishInstr i1
-       , NOP           <- i2
-       = block
-       
-       | otherwise
-       = pprPanic 
-               ("SPARC.CodeGen: bad instrs at end of block\n")
-               (text "block:\n" <> ppr block)
-
-takeLast2 :: [a] -> Maybe (a, a)
-takeLast2 xx
- = case xx of
-       []              -> Nothing
-       _:[]            -> Nothing
-       x1:x2:[]        -> Just (x1, x2)
-       _:xs            -> takeLast2 xs
-
-
 -- | Convert some Cmm statements to SPARC instructions.
 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
 stmtsToInstrs stmts
@@ -193,8 +162,8 @@ temporary, then do the other computation, and then use the temporary:
 -- | Convert a BlockId to some CmmStatic data
 jumpTableEntry :: Maybe BlockId -> CmmStatic
 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel id
+jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+    where blockLabel = mkAsmTempLabel (getUnique blockid)