From: Edward Z. Yang Date: Sun, 17 Apr 2011 22:29:29 +0000 (+0100) Subject: Implement jump table fix-ups for linear register allocator. X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=16a037a8f9c7e444230c226081023fe56ffa2264 Implement jump table fix-ups for linear register allocator. We achieve this by splitting up instruction selection for case switches into two parts: the actual code generation, and the generation of the accompanying jump table. With this scheme, the jump fixup code can modify the contents of the jump table stored within the JMP_TBL (or BCTL) instruction, before the actual data section is created. SPARC and PPC patches are untested; they might not work! Signed-off-by: Edward Z. Yang --- diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 7a38540..767dc99 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -378,10 +378,15 @@ cmmNativeGen dflags us cmm count , Nothing , mPprStats) + ---- generate jump tables + let tabled = + {-# SCC "generateJumpTables" #-} + alloced ++ generateJumpTables alloced + ---- shortcut branches let shorted = {-# SCC "shortcutBranches" #-} - shortcutBranches dflags alloced + shortcutBranches dflags tabled ---- sequence blocks let sequenced = @@ -609,6 +614,18 @@ makeFarBranches = id #endif -- ----------------------------------------------------------------------------- +-- Generate jump tables + +-- Analyzes all native code and generates data sections for all jump +-- table instructions. +generateJumpTables + :: [NatCmmTop Instr] -> [NatCmmTop Instr] +generateJumpTables xs = concatMap f xs + where f (CmmProc _ _ (ListGraph xs)) = concatMap g xs + f _ = [] + g (BasicBlock _ xs) = catMaybes (map generateJumpTableForInstr xs) + +-- ----------------------------------------------------------------------------- -- Shortcut branches shortcutBranches diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 29b9a54..c96badd 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -15,6 +15,7 @@ module PPC.CodeGen ( cmmTopCodeGen, + generateJumpTableForInstr, InstrBlock ) @@ -798,7 +799,7 @@ genJump (CmmLit (CmmLabel lbl)) genJump tree = do (target,code) <- getSomeReg tree - return (code `snocOL` MTCTR target `snocOL` BCTR []) + return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing) -- ----------------------------------------------------------------------------- @@ -1126,22 +1127,12 @@ genSwitch expr ids dflags <- getDynFlagsNat dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef - let - jumpTable = map jumpTableEntryRel ids - - jumpTableEntryRel Nothing - = CmmStaticLit (CmmInt 0 wordWidth) - jumpTableEntryRel (Just blockid) - = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) - where blockLabel = mkAsmTempLabel (getUnique blockid) - - code = e_code `appOL` t_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), + let code = e_code `appOL` t_code `appOL` toOL [ SLW tmp reg (RIImm (ImmInt 2)), LD II32 tmp (AddrRegReg tableReg tmp), ADD tmp tmp (RIReg tableReg), MTCTR tmp, - BCTR [ id | Just id <- ids ] + BCTR ids (Just lbl) ] return code | otherwise @@ -1149,19 +1140,27 @@ genSwitch expr ids (reg,e_code) <- getSomeReg expr tmp <- getNewRegNat II32 lbl <- getNewLabelNat - let - jumpTable = map jumpTableEntry ids - - code = e_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), + let code = e_code `appOL` toOL [ SLW tmp reg (RIImm (ImmInt 2)), ADDIS tmp tmp (HA (ImmCLbl lbl)), LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))), MTCTR tmp, - BCTR [ id | Just id <- ids ] + BCTR ids (Just lbl) ] return code +generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr) +generateJumpTableForInstr (BCTR ids (Just lbl)) = + let jumpTable + | opt_PIC = map jumpTableEntryRel ids + | otherwise = map jumpTableEntry ids + where jumpTableEntryRel Nothing + = CmmStaticLit (CmmInt 0 wordWidth) + jumpTableEntryRel (Just blockid) + = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) + where blockLabel = mkAsmTempLabel (getUnique blockid) + in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable)) +generateJumpTableForInstr _ = Nothing -- ----------------------------------------------------------------------------- -- 'condIntReg' and 'condFltReg': condition codes into registers diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index 6aeccd3..0288f1b 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -104,7 +104,7 @@ data Instr | JMP CLabel -- same as branch, -- but with CLabel instead of block ID | MTCTR Reg - | BCTR [BlockId] -- with list of local destinations + | BCTR [Maybe BlockId] (Maybe CLabel) -- with list of local destinations, and jump table location if necessary | BL CLabel [Reg] -- with list of argument regs | BCTRL [Reg] @@ -184,7 +184,7 @@ ppc_regUsageOfInstr instr BCC _ _ -> noUsage BCCFAR _ _ -> noUsage MTCTR reg -> usage ([reg],[]) - BCTR _ -> noUsage + BCTR _ _ -> noUsage BL _ params -> usage (params, callClobberedRegs) BCTRL params -> usage (params, callClobberedRegs) ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) @@ -257,7 +257,7 @@ ppc_patchRegsOfInstr instr env BCC cond lbl -> BCC cond lbl BCCFAR cond lbl -> BCCFAR cond lbl MTCTR reg -> MTCTR (env reg) - BCTR targets -> BCTR targets + BCTR targets lbl -> BCTR targets lbl BL imm argRegs -> BL imm argRegs -- argument regs BCTRL argRegs -> BCTRL argRegs -- cannot be remapped ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) @@ -326,7 +326,7 @@ ppc_jumpDestsOfInstr insn = case insn of BCC _ id -> [id] BCCFAR _ id -> [id] - BCTR targets -> targets + BCTR targets _ -> [id | Just id <- targets] _ -> [] @@ -338,7 +338,7 @@ ppc_patchJumpInstr insn patchF = case insn of BCC cc id -> BCC cc (patchF id) BCCFAR cc id -> BCCFAR cc (patchF id) - BCTR _ -> error "Cannot patch BCTR" + BCTR ids lbl -> BCTR (map (fmap patchF) ids) lbl _ -> insn diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 9fb86c0..44a6a7c 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -545,7 +545,7 @@ pprInstr (MTCTR reg) = hcat [ char '\t', pprReg reg ] -pprInstr (BCTR _) = hcat [ +pprInstr (BCTR _ _) = hcat [ char '\t', ptext (sLit "bctr") ] diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index d08d10d..beb48d6 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -8,6 +8,7 @@ module SPARC.CodeGen ( cmmTopCodeGen, + generateJumpTableForInstr, InstrBlock ) @@ -299,15 +300,11 @@ genSwitch expr ids 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.. @@ -315,6 +312,11 @@ genSwitch expr ids -- 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 diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index 79b4629..93f4d27 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -37,6 +37,7 @@ import RegClass import Reg import Size +import CLabel import BlockId import OldCmm import FastString @@ -194,7 +195,7 @@ data Instr -- With a tabled jump we know all the possible destinations. -- We also need this info so we can work out what regs are live across the jump. -- - | JMP_TBL AddrMode [BlockId] + | JMP_TBL AddrMode [Maybe BlockId] CLabel | CALL (Either Imm Reg) Int Bool -- target, args, terminal @@ -247,7 +248,7 @@ sparc_regUsageOfInstr instr FxTOy _ _ r1 r2 -> usage ([r1], [r2]) JMP addr -> usage (regAddr addr, []) - JMP_TBL addr _ -> usage (regAddr addr, []) + JMP_TBL addr _ _ -> usage (regAddr addr, []) CALL (Left _ ) _ True -> noUsage CALL (Left _ ) n False -> usage (argRegs n, callClobberedRegs) @@ -315,7 +316,7 @@ sparc_patchRegsOfInstr instr env = case instr of FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2) JMP addr -> JMP (fixAddr addr) - JMP_TBL addr ids -> JMP_TBL (fixAddr addr) ids + JMP_TBL addr ids l -> JMP_TBL (fixAddr addr) ids l CALL (Left i) n t -> CALL (Left i) n t CALL (Right r) n t -> CALL (Right (env r)) n t @@ -345,7 +346,7 @@ sparc_jumpDestsOfInstr insn = case insn of BI _ _ id -> [id] BF _ _ id -> [id] - JMP_TBL _ ids -> ids + JMP_TBL _ ids _ -> [id | Just id <- ids] _ -> [] @@ -354,6 +355,7 @@ sparc_patchJumpInstr insn patchF = case insn of BI cc annul id -> BI cc annul (patchF id) BF cc annul id -> BF cc annul (patchF id) + JMP_TBL n ids l -> JMP_TBL n (map (fmap patchF) ids) l _ -> insn diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index a63661f..0139680 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -543,7 +543,7 @@ pprInstr (BF cond b blockid) ] pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr) -pprInstr (JMP_TBL op _) = pprInstr (JMP op) +pprInstr (JMP_TBL op _ _) = pprInstr (JMP op) pprInstr (CALL (Left imm) n _) = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ] diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 5df8f77..74f4073 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -20,6 +20,7 @@ module X86.CodeGen ( cmmTopCodeGen, + generateJumpTableForInstr, InstrBlock ) @@ -1932,16 +1933,7 @@ genSwitch expr ids dflags <- getDynFlagsNat dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef - let - jumpTable = map jumpTableEntryRel ids - - jumpTableEntryRel Nothing - = CmmStaticLit (CmmInt 0 wordWidth) - jumpTableEntryRel (Just blockid) - = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) - where blockLabel = mkAsmTempLabel (getUnique blockid) - - op = OpAddr (AddrBaseIndex (EABaseReg tableReg) + let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0)) #if x86_64_TARGET_ARCH @@ -1954,8 +1946,7 @@ genSwitch expr ids code = e_code `appOL` t_code `appOL` toOL [ ADD (intSize wordWidth) op (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ], - LDATA Text (CmmDataLabel lbl : jumpTable) + JMP_TBL (OpReg tableReg) ids Text lbl, ] #else -- HACK: On x86_64 binutils<2.17 is only able to generate PC32 @@ -1965,20 +1956,18 @@ genSwitch expr ids -- conjunction with the hack in PprMach.hs/pprDataItem once -- binutils 2.17 is standard. code = e_code `appOL` t_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), MOVSxL II32 (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg wORD_SIZE) (ImmInt 0))) (OpReg reg), ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ] + JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] #endif #else code = e_code `appOL` t_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), ADD (intSize wordWidth) op (OpReg tableReg), - JMP_TBL (OpReg tableReg) [ id | Just id <- ids ] + JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] #endif return code @@ -1987,15 +1976,28 @@ genSwitch expr ids (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat let - jumpTable = map jumpTableEntry ids op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) code = e_code `appOL` toOL [ - LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable), - JMP_TBL op [ id | Just id <- ids ] + JMP_TBL op ids ReadOnlyData lbl ] -- in return code +generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr) +generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl) +generateJumpTableForInstr _ = Nothing + +createJumpTable ids section lbl + = let jumpTable + | opt_PIC = + let jumpTableEntryRel Nothing + = CmmStaticLit (CmmInt 0 wordWidth) + jumpTableEntryRel (Just blockid) + = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) + where blockLabel = mkAsmTempLabel (getUnique blockid) + in map jumpTableEntryRel ids + | otherwise = map jumpTableEntry ids + in CmmData section (CmmDataLabel lbl : jumpTable) -- ----------------------------------------------------------------------------- -- 'condIntReg' and 'condFltReg': condition codes into registers diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index a96452b..e934a6d 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -289,7 +289,11 @@ data Instr | JMP Operand | JXX Cond BlockId -- includes unconditional branches | JXX_GBL Cond Imm -- non-local version of JXX - | JMP_TBL Operand [BlockId] -- table jump + -- Table jump + | JMP_TBL Operand -- Address to jump to + [Maybe BlockId] -- Blocks in the jump table + Section -- Data section jump table should be put in + CLabel -- Label of jump table | CALL (Either Imm Reg) [Reg] -- Other things. @@ -350,7 +354,7 @@ x86_regUsageOfInstr instr JXX _ _ -> mkRU [] [] JXX_GBL _ _ -> mkRU [] [] JMP op -> mkRUR (use_R op) - JMP_TBL op _ -> mkRUR (use_R op) + JMP_TBL op _ _ _ -> mkRUR (use_R op) CALL (Left _) params -> mkRU params callClobberedRegs CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD _ -> mkRU [eax] [edx] @@ -482,7 +486,7 @@ x86_patchRegsOfInstr instr env POP sz op -> patch1 (POP sz) op SETCC cond op -> patch1 (SETCC cond) op JMP op -> patch1 JMP op - JMP_TBL op ids -> patch1 JMP_TBL op $ ids + JMP_TBL op ids s lbl-> JMP_TBL (patchOp op) ids s lbl GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) @@ -579,7 +583,7 @@ x86_jumpDestsOfInstr x86_jumpDestsOfInstr insn = case insn of JXX _ id -> [id] - JMP_TBL _ ids -> ids + JMP_TBL _ ids _ _ -> [id | Just id <- ids] _ -> [] @@ -589,7 +593,8 @@ x86_patchJumpInstr x86_patchJumpInstr insn patchF = case insn of JXX cc id -> JXX cc (patchF id) - JMP_TBL _ _ -> error "Cannot patch JMP_TBL" + JMP_TBL op ids section lbl + -> JMP_TBL op (map (fmap patchF) ids) section lbl _ -> insn diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 5fe78e1..0f0f9d2 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -626,7 +626,7 @@ pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm) pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm) pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op) -pprInstr (JMP_TBL op _) = pprInstr (JMP op) +pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op) pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm) pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)