module SPARC.CodeGen (
cmmTopCodeGen,
+ generateJumpTableForInstr,
InstrBlock
)
#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
-- 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
-> 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
-> NatM ( [NatBasicBlock Instr]
, [NatCmmTop Instr])
-basicBlockCodeGen (BasicBlock id stmts) = do
+basicBlockCodeGen cmm@(BasicBlock id stmts) = do
instrs <- stmtsToInstrs stmts
let
(top,other_blocks,statics)
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
-- | 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)
dst <- getNewRegNat II32
label <- getNewLabelNat
- let jumpTable = map jumpTableEntry ids
return $ e_code `appOL`
toOL
- -- the jump table
- [ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
-
- -- load base of jump table
- , SETHI (HI (ImmCLbl label)) base_reg
+ [ -- load base of jump table
+ SETHI (HI (ImmCLbl label)) base_reg
, OR False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
-- the addrs in the table are 32 bits wide..
-- load and jump to the destination
, LD II32 (AddrRegReg base_reg offset_reg) dst
- , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids]
+ , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
, NOP ]
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (JMP_TBL _ ids label) =
+ let jumpTable = map jumpTableEntry ids
+ in Just (CmmData ReadOnlyData (CmmDataLabel label : jumpTable))
+generateJumpTableForInstr _ = Nothing