[commit: ghc] wip/T10137: CmmSwitch: Move table offset to code generation phase (55f2096)
git at git.haskell.org
git at git.haskell.org
Wed Mar 4 22:14:23 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T10137
Link : http://ghc.haskell.org/trac/ghc/changeset/55f20969acf76266b164d27773096e0a08512d57/ghc
>---------------------------------------------------------------
commit 55f20969acf76266b164d27773096e0a08512d57
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Mar 4 23:13:28 2015 +0100
CmmSwitch: Move table offset to code generation phase
Previously, if a switch statement would not start with 0, the Stg → Cmm
phase would offset the scrutinee to make the table zero-based. In order
to have CmmSwitch a bit higher level, this step is moved to the Cmm →
Assembly phase. This also means that in the llvm backend, more is left
to the LLVM compiler.
>---------------------------------------------------------------
55f20969acf76266b164d27773096e0a08512d57
compiler/cmm/CmmNode.hs | 18 ++++++++++++------
compiler/codeGen/StgCmmUtils.hs | 10 ++++++----
compiler/nativeGen/PPC/CodeGen.hs | 6 +++---
compiler/nativeGen/SPARC/CodeGen.hs | 4 ++--
compiler/nativeGen/X86/CodeGen.hs | 6 +++---
5 files changed, 26 insertions(+), 18 deletions(-)
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index 4b3dfd2..90d1b77 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -723,13 +723,19 @@ switchTargetsCases (SwitchTargets _ _ branches) = M.toList branches
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault (SwitchTargets _ mbdef _) = mbdef
-switchTargetsToTable :: SwitchTargets -> [Maybe Label]
-switchTargetsToTable (SwitchTargets _ mbdef branches)
- | min < 0 = pprPanic "mapSwitchTargets" empty
- | otherwise = [ labelFor i | i <- [0..max] ]
+-- switchTargetsToTable creates a dense jump table, usable for code generation.
+-- This is not possible if there is no explicit range, so before code generation
+-- all switch statements need to be transformed to one with an explicit range.
+--
+-- Returns an offset to add to the value; the list is 0-based on the result
+--
+-- TODO: Is the conversion from Integral to Int fishy?
+switchTargetsToTable :: SwitchTargets -> (Int, [Maybe Label])
+switchTargetsToTable (SwitchTargets Nothing _mbdef _branches)
+ = pprPanic "switchTargetsToTable" empty
+switchTargetsToTable (SwitchTargets (Just (lo,hi)) mbdef branches)
+ = (fromIntegral (-lo), [ labelFor i | i <- [lo..hi] ])
where
- min = fst (M.findMin branches)
- max = fst (M.findMax branches)
labelFor i = case M.lookup i branches of Just l -> Just l
Nothing -> mbdef
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 7e2279b..d1a9cf8 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -544,15 +544,17 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
-- either end of the range (see below), so the first
-- tag of a real branch is real_lo_tag (not lo_tag).
arms :: M.Map Integer BlockId
- arms = M.fromList [ (fromIntegral (i - real_lo_tag), l)
+ arms = M.fromList [ (fromIntegral i, l)
| (i,l) <- branches
, real_lo_tag <= i
, i <= real_hi_tag
]
- dflags <- getDynFlags
+ range = (fromIntegral real_lo_tag, fromIntegral real_hi_tag)
+
return $ mkSwitch
- (cmmOffset dflags tag_expr (- real_lo_tag))
- (mkSwitchTargets (Just (0, fromIntegral (real_hi_tag-real_lo_tag))) Nothing arms)
+ -- (cmmOffset dflags tag_expr (- real_lo_tag))
+ tag_expr
+ (mkSwitchTargets (Just range) Nothing arms)
-- if we can knock off a bunch of default cases with one if, then do so
| Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 552d9ac..fb42c07 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -1205,7 +1205,7 @@ genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch dflags expr targets
| gopt Opt_PIC dflags
= do
- (reg,e_code) <- getSomeReg expr
+ (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
tmp <- getNewRegNat II32
lbl <- getNewLabelNat
dflags <- getDynFlags
@@ -1221,7 +1221,7 @@ genSwitch dflags expr targets
return code
| otherwise
= do
- (reg,e_code) <- getSomeReg expr
+ (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
tmp <- getNewRegNat II32
lbl <- getNewLabelNat
let code = e_code `appOL` toOL [
@@ -1232,7 +1232,7 @@ genSwitch dflags expr targets
BCTR ids (Just lbl)
]
return code
- where ids = switchTargetsToTable targets
+ where (offset, ids) = switchTargetsToTable targets
generateJumpTableForInstr :: DynFlags -> Instr
-> Maybe (NatCmmDecl CmmStatics Instr)
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 8631ab8..3f49afe 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -314,7 +314,7 @@ genSwitch dflags expr targets
= error "MachCodeGen: sparc genSwitch PIC not finished\n"
| otherwise
- = do (e_reg, e_code) <- getSomeReg expr
+ = do (e_reg, e_code) <- getSomeReg (cmmOffset dflags expr offset)
base_reg <- getNewRegNat II32
offset_reg <- getNewRegNat II32
@@ -335,7 +335,7 @@ genSwitch dflags expr targets
, LD II32 (AddrRegReg base_reg offset_reg) dst
, JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
, NOP ]
- where ids = switchTargetsToTable targets
+ where (offset, ids) = switchTargetsToTable targets
generateJumpTableForInstr :: DynFlags -> Instr
-> Maybe (NatCmmDecl CmmStatics Instr)
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 6e0e8ad..a826531 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -2589,7 +2589,7 @@ genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch dflags expr targets
| gopt Opt_PIC dflags
= do
- (reg,e_code) <- getSomeReg expr
+ (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
lbl <- getNewLabelNat
dflags <- getDynFlags
dynRef <- cmmMakeDynamicReference dflags DataReference lbl
@@ -2631,14 +2631,14 @@ genSwitch dflags expr targets
]
| otherwise
= do
- (reg,e_code) <- getSomeReg expr
+ (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
lbl <- getNewLabelNat
let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl))
code = e_code `appOL` toOL [
JMP_TBL op ids ReadOnlyData lbl
]
return code
- where ids = switchTargetsToTable targets
+ where (offset, ids) = switchTargetsToTable targets
generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl (Alignment, CmmStatics) Instr)
generateJumpTableForInstr dflags (JMP_TBL _ ids section lbl)
More information about the ghc-commits
mailing list