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
import SPARC.CodeGen.Gen32
import SPARC.CodeGen.CCall
import SPARC.CodeGen.Base
+import SPARC.Ppr ()
import SPARC.Instr
import SPARC.Imm
import SPARC.AddrMode
-- 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
--- picBaseMb <- getPicBaseMaybeNat
- let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
+ let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
let tops = proc : concat statics
--- case picBaseMb of
--- Just picBase -> initializePicBase picBase tops
--- Nothing -> return tops
-
return tops
-
cmmTopCodeGen _ (CmmData sec dat) = do
return [CmmData sec dat] -- no translation, we just use CmmStatic
-
+-- | Do code generation on a single block of CMM code.
+-- code generation may introduce new basic block boundaries, which
+-- 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
-> NatM ( [NatBasicBlock Instr]
, [NatCmmTop Instr])
-basicBlockCodeGen (BasicBlock id stmts) = do
+basicBlockCodeGen cmm@(BasicBlock id stmts) = do
instrs <- stmtsToInstrs stmts
- -- code generation may introduce new basic block boundaries, which
- -- are indicated by the NEWBLOCK instruction. We must split up the
- -- instruction stream into basic blocks again. Also, we extract
- -- LDATAs here too.
let
- (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
+ (top,other_blocks,statics)
+ = foldrOL mkBlocks ([],[],[]) instrs
mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
= ([], BasicBlock id instrs : blocks, statics)
+
mkBlocks (LDATA sec dat) (instrs,blocks,statics)
= (instrs, blocks, CmmData sec dat:statics)
+
mkBlocks instr (instrs,blocks,statics)
= (instr:instrs, blocks, statics)
- -- in
- return (BasicBlock id top : other_blocks, statics)
+ -- do intra-block sanity checking
+ blocksChecked
+ = map (checkBlock cmm)
+ $ BasicBlock id top : other_blocks
+
+ return (blocksChecked, statics)
+
+-- | Convert some Cmm statements to SPARC instructions.
stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
stmtsToInstrs stmts
= do instrss <- mapM stmtToInstrs 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