From b71148fc3dc7f89c92c144c8e2c30c3eada8a83d Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 21 Aug 2000 15:40:15 +0000 Subject: [PATCH] [project @ 2000-08-21 15:40:14 by sewardj] Make the register allocator deal properly with switch tables. Previously, it didn't calculate the correct flow edges away from the indirect jump (in fact it didn't reckon there were any flow edges leaving it :) which makes a nonsense of the live variable analysis in the branches. A jump insn can now optionally be annotated with a list of destination labels, and if so, the register allocator creates flow edges to all of them. Jump tables are now re-enabled. They remain disabled for 4.08.1, since we aren't fixing the problem properly on that branch. I assume this problem wasn't exposed by the old register allocator because of the live-range-approximation hacks used in it. Since it was undocumented, we'll never know. Sparc builds will now break until I fix them. --- ghc/compiler/nativeGen/AbsCStixGen.lhs | 21 +++++++++++---------- ghc/compiler/nativeGen/AsmCodeGen.lhs | 2 +- ghc/compiler/nativeGen/AsmRegAlloc.lhs | 11 +++++++++-- ghc/compiler/nativeGen/MachCode.lhs | 18 +++++++++--------- ghc/compiler/nativeGen/MachMisc.lhs | 16 ++++++++++------ ghc/compiler/nativeGen/PprMach.lhs | 7 +++---- ghc/compiler/nativeGen/RegAllocInfo.lhs | 17 ++++++++++++----- ghc/compiler/nativeGen/Stix.lhs | 29 +++++++++++++++++++++++------ ghc/compiler/nativeGen/StixMacro.lhs | 4 ++-- 9 files changed, 80 insertions(+), 45 deletions(-) diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index ebc7aee..2a3fe2d 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -181,7 +181,7 @@ Here we handle top-level things, like @CCodeBlock@s and [ StLabel tmp_lbl , StAssign PtrRep stgSp (StIndex PtrRep stgSp (StInt (-1))) - , StJump (StInd WordRep stgSp) + , StJump NoDestInfo (StInd WordRep stgSp) ]) gentopcode absC @@ -348,22 +348,22 @@ which varies depending on whether we're profiling etc. \begin{code} gencode (CJump dest) - = returnUs (\xs -> StJump (a2stix dest) : xs) + = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs) gencode (CFallThrough (CLbl lbl _)) = returnUs (\xs -> StFallThrough lbl : xs) gencode (CReturn dest DirectReturn) - = returnUs (\xs -> StJump (a2stix dest) : xs) + = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs) gencode (CReturn table (StaticVectoredReturn n)) - = returnUs (\xs -> StJump dest : xs) + = returnUs (\xs -> StJump NoDestInfo dest : xs) where dest = StInd PtrRep (StIndex PtrRep (a2stix table) (StInt (toInteger (-n-fixedItblSize-1)))) gencode (CReturn table (DynamicVectoredReturn am)) - = returnUs (\xs -> StJump dest : xs) + = returnUs (\xs -> StJump NoDestInfo dest : xs) where dest = StInd PtrRep (StIndex PtrRep (a2stix table) dyn_off) dyn_off = StPrim IntSubOp [StPrim IntNegOp [a2stix am], @@ -506,14 +506,14 @@ be tuned.) highest = if floating then targetMaxDouble else targetMaxInt in ( - if False && -- jump tables disabled for now until the register allocator is - -- fixed to cope with them --SDM 18/8/2000 - not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then + if not floating && choices > 4 + && highTag - lowTag < toInteger (2 * choices) + then mkJumpTable am' sortedAlts lowTag highTag udlbl else mkBinaryTree am' floating sortedAlts choices lowest highest udlbl ) - `thenUs` \ alt_code -> + `thenUs` \ alt_code -> gencode absC `thenUs` \ dflt_code -> returnUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs))) @@ -557,8 +557,9 @@ already finish with a jump to the join point. cjmpHi = StCondJump dflt (StPrim IntGtOp [am, StInt (toInteger highTag)]) offset = StPrim IntSubOp [am, StInt lowTag] + dsts = DestInfo (dflt : map fst branches) - jump = StJump (StInd PtrRep (StIndex PtrRep (StCLbl utlbl) offset)) + jump = StJump dsts (StInd PtrRep (StIndex PtrRep (StCLbl utlbl) offset)) tlbl = StLabel utlbl table = StData PtrRep (mkTable branches [lowTag..highTag] []) in diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs index bbbc760..0234819 100644 --- a/ghc/compiler/nativeGen/AsmCodeGen.lhs +++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs @@ -224,7 +224,7 @@ stixConFold (StInd pk addr) = StInd pk (stixConFold addr) stixConFold (StAssign pk dst src) = StAssign pk (stixConFold dst) (stixConFold src) -stixConFold (StJump addr) = StJump (stixConFold addr) +stixConFold (StJump dsts addr) = StJump dsts (stixConFold addr) stixConFold (StCondJump addr test) = StCondJump addr (stixConFold test) diff --git a/ghc/compiler/nativeGen/AsmRegAlloc.lhs b/ghc/compiler/nativeGen/AsmRegAlloc.lhs index 162befc..02c5649 100644 --- a/ghc/compiler/nativeGen/AsmRegAlloc.lhs +++ b/ghc/compiler/nativeGen/AsmRegAlloc.lhs @@ -771,8 +771,8 @@ find_flow_edges insns Branch lab -- jmps to lab; add fe i_num -> i_target -> let i_target = find_label lab in - mk_succ_map i_num_1 ((i_num, [i_target]): rsucc_map) - is + mk_succ_map i_num_1 ((i_num, [i_target]): rsucc_map) is + NextOrBranch lab | null is -- jmps to label, or falls through, and this is -- the last insn (a meaningless scenario); @@ -785,6 +785,13 @@ find_flow_edges insns in mk_succ_map i_num_1 ((i_num, [i_num_1, i_target]):rsucc_map) is + MultiFuture labels + -> -- A jump, whose targets are listed explicitly. + -- (Generated from table-based switch translations). + -- Add fes i_num -> x for each x in labels + let is_target = nub (map find_label labels) + in + mk_succ_map i_num_1 ((i_num, is_target):rsucc_map) is -- Third phase: invert the successor map to get the predecessor -- map, using an algorithm which is quadratic in the worst case, diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 57bdc39..0d7dcb8 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -26,7 +26,7 @@ import PrimRep ( isFloatingRep, PrimRep(..) ) import PrimOp ( PrimOp(..) ) import CallConv ( cCallConv ) import Stix ( getNatLabelNCG, StixTree(..), - StixReg(..), CodeSegment(..), + StixReg(..), CodeSegment(..), DestInfo, pprStixTree, ppStixReg, NatM, thenNat, returnNat, mapNat, mapAndUnzipNat, mapAccumLNat, @@ -68,7 +68,7 @@ stmt2Instrs stmt = case stmt of StLabel lab -> returnNat (unitOL (LABEL lab)) - StJump arg -> genJump (derefDLL arg) + StJump dsts arg -> genJump dsts (derefDLL arg) StCondJump lab arg -> genCondJump lab (derefDLL arg) -- A call returning void, ie one done for its side-effects @@ -1982,7 +1982,7 @@ branch instruction. Other CLabels are assumed to be far away. register allocator. \begin{code} -genJump :: StixTree{-the branch target-} -> NatM InstrBlock +genJump :: DestInfo -> StixTree{-the branch target-} -> NatM InstrBlock #if alpha_TARGET_ARCH @@ -1993,7 +1993,7 @@ genJump (StCLbl lbl) target = ImmCLbl lbl genJump tree - = getRegister tree `thenNat` \ register -> + = getRegister tree `thenNat` \ register -> getNewRegNCG PtrRep `thenNat` \ tmp -> let dst = registerName register pv @@ -2009,17 +2009,17 @@ genJump tree -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if i386_TARGET_ARCH -genJump (StInd pk mem) +genJump dsts (StInd pk mem) = getAmode mem `thenNat` \ amode -> let code = amodeCode amode target = amodeAddr amode in - returnNat (code `snocOL` JMP (OpAddr target)) + returnNat (code `snocOL` JMP dsts (OpAddr target)) -genJump tree +genJump dsts tree | maybeToBool imm - = returnNat (unitOL (JMP (OpImm target))) + = returnNat (unitOL (JMP dsts (OpImm target))) | otherwise = getRegister tree `thenNat` \ register -> @@ -2028,7 +2028,7 @@ genJump tree code = registerCode register tmp target = registerName register tmp in - returnNat (code `snocOL` JMP (OpReg target)) + returnNat (code `snocOL` JMP dsts (OpReg target)) where imm = maybeImm tree target = case imm of Just x -> x diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index 8f5c168..116b8f9 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -50,7 +50,7 @@ import MachRegs ( stgReg, callerSaves, RegLoc(..), # endif ) import PrimRep ( PrimRep(..) ) -import Stix ( StixTree(..), StixReg(..), CodeSegment ) +import Stix ( StixTree(..), StixReg(..), CodeSegment, DestInfo(..) ) import Panic ( panic ) import GlaExts ( word2Int#, int2Word#, shiftRL#, and#, (/=#) ) import Outputable ( pprPanic, ppr ) @@ -529,7 +529,7 @@ Hence GLDZ and GLD1. Bwahahahahahahaha! -- Jumping around. - | JMP Operand -- target + | JMP DestInfo Operand -- possible dests, target | JXX Cond CLabel -- target | CALL Imm @@ -552,10 +552,14 @@ i386_insert_ffrees insns ffree_before_nonlocal_transfers insn = case insn of - CALL _ -> [GFREE, insn] - JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn] - JMP _ -> [GFREE, insn] - other -> [insn] + CALL _ -> [GFREE, insn] + -- Jumps to immediate labels are local + JMP _ (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> [insn] + -- If a jump mentions dests, it is a local jump thru + -- a case table. + JMP (DestInfo _) _ -> [insn] + JMP _ _ -> [GFREE, insn] + other -> [insn] -- if you ever add a new FP insn to the fake x86 FP insn set, diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 5235a5c..2480896 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -959,10 +959,9 @@ pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op) pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) -pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) -pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) -pprInstr (CALL imm) - = (<>) (ptext SLIT("\tcall ")) (pprImm imm) +pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) +pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) +pprInstr (CALL imm) = (<>) (ptext SLIT("\tcall ")) (pprImm imm) -- Simulating a flat register set on the x86 FP stack is tricky. diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 392371e..f0e7afe 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -39,7 +39,7 @@ module RegAllocInfo ( import List ( partition, sort ) import MachMisc import MachRegs - +import Stix ( DestInfo(..) ) import CLabel ( pprCLabel_asm, isAsmTemp, CLabel{-instance Ord-} ) import FiniteMap ( addToFM, lookupFM, FiniteMap ) import Outputable @@ -251,7 +251,7 @@ regUsage instr = case instr of CMP sz src dst -> mkRU (use_R src ++ use_R dst) [] SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] - JMP op -> mkRU (use_R op) [] + JMP dsts op -> mkRU (use_R op) [] CALL imm -> mkRU [] callClobberedRegs CLTD -> mkRU [eax] [edx] NOP -> mkRU [] [] @@ -481,6 +481,7 @@ data InsnFuture | Next -- falls through to next insn | Branch CLabel -- unconditional branch to the label | NextOrBranch CLabel -- conditional branch to the label + | MultiFuture [CLabel] -- multiple specific futures --instance Outputable InsnFuture where -- ppr NoFuture = text "NoFuture" @@ -513,11 +514,17 @@ insnFuture insn JXX _ clbl | isAsmTemp clbl -> NextOrBranch clbl JXX _ _ -> panic "insnFuture: conditional jump to non-local label" + -- If the insn says what its dests are, use em! + JMP (DestInfo dsts) _ -> MultiFuture dsts + -- unconditional jump to local label - JMP (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl + JMP NoDestInfo (OpImm (ImmCLbl clbl)) | isAsmTemp clbl -> Branch clbl -- unconditional jump to non-local label - JMP lbl -> NoFuture + JMP NoDestInfo lbl -> NoFuture + + -- be extra-paranoid + JMP _ _ -> panic "insnFuture(x86): JMP wierdness" boring -> Next @@ -638,7 +645,7 @@ patchRegs instr env = case instr of PUSH sz op -> patch1 (PUSH sz) op POP sz op -> patch1 (POP sz) op SETCC cond op -> patch1 (SETCC cond) op - JMP op -> patch1 JMP op + JMP dsts op -> patch1 (JMP dsts) op GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index e222cdc..1223490 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -7,6 +7,7 @@ module Stix ( CodeSegment(..), StixReg(..), StixTree(..), StixTreeList, pprStixTrees, pprStixTree, ppStixReg, stixCountTempUses, stixSubst, + DestInfo(..), stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg, stgR9, stgR10, @@ -81,10 +82,15 @@ data StixTree | StFunBegin CLabel | StFunEnd CLabel - -- An unconditional jump. This instruction is terminal. - -- Dynamic targets are allowed + -- An unconditional jump. This instruction may or may not jump + -- out of the register allocation domain (basic block, more or + -- less). For correct register allocation when this insn is used + -- to jump through a jump table, we optionally allow a list of + -- the exact targets to be attached, so that the allocator can + -- easily construct the exact flow edges leaving this insn. + -- Dynamic targets are allowed. - | StJump StixTree + | StJump DestInfo StixTree -- A fall-through, from slow to fast @@ -120,6 +126,16 @@ data StixTree | StComment FAST_STRING +-- used by insnFuture in RegAllocInfo.lhs +data DestInfo + = NoDestInfo -- no supplied dests; infer from context + | DestInfo [CLabel] -- precisely these dests and no others + +pprDests :: DestInfo -> SDoc +pprDests NoDestInfo = text "NoDestInfo" +pprDests (DestInfo dsts) = brack (hsep (map pprCLabel dsts)) + + pprStixTrees :: [StixTree] -> SDoc pprStixTrees ts = vcat [ @@ -129,6 +145,7 @@ pprStixTrees ts ] paren t = char '(' <> t <> char ')' +brack t = char '[' <> t <> char ']' pprStixTree :: StixTree -> SDoc pprStixTree t @@ -149,7 +166,7 @@ pprStixTree t StLabel ll -> pprCLabel ll <+> char ':' StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll) StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll) - StJump t -> paren (text "Jump" <+> pprStixTree t) + StJump dsts t -> paren (text "Jump" <+> pprDests dsts <+> pprStixTree t) StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll) StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> pprStixTree t) @@ -260,7 +277,7 @@ stixCountTempUses u t StIndex pk t1 t2 -> qq t1 + qq t2 StInd pk t1 -> qq t1 StAssign pk t1 t2 -> qq t1 + qq t2 - StJump t1 -> qq t1 + StJump dsts t1 -> qq t1 StCondJump lbl t1 -> qq t1 StData pk ts -> sum (map qq ts) StPrim op ts -> sum (map qq ts) @@ -304,7 +321,7 @@ stixMapUniques f t StIndex pk t1 t2 -> StIndex pk (qq t1) (qq t2) StInd pk t1 -> StInd pk (qq t1) StAssign pk t1 t2 -> StAssign pk (qq t1) (qq t2) - StJump t1 -> StJump (qq t1) + StJump dsts t1 -> StJump dsts (qq t1) StCondJump lbl t1 -> StCondJump lbl (qq t1) StData pk ts -> StData pk (map qq ts) StPrim op ts -> StPrim op (map qq ts) diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs index 415d7c8..7127883 100644 --- a/ghc/compiler/nativeGen/StixMacro.lhs +++ b/ghc/compiler/nativeGen/StixMacro.lhs @@ -212,7 +212,7 @@ stg_update_PAP = StCLbl mkStgUpdatePAPLabel updatePAP, stackOverflow :: StixTree -updatePAP = StJump stg_update_PAP +updatePAP = StJump NoDestInfo stg_update_PAP stackOverflow = StCall SLIT("StackOverflow") cCallConv VoidRep [] \end{code} @@ -338,7 +338,7 @@ checkCode macro args assts mkStJump_to_GCentry :: String -> StixTree mkStJump_to_GCentry gcname -- | opt_Static - = StJump (StCLbl (mkRtsGCEntryLabel gcname)) + = StJump NoDestInfo (StCLbl (mkRtsGCEntryLabel gcname)) -- | otherwise -- it's in a different DLL -- = StJump (StInd PtrRep (StLitLbl True sdoc)) -- 1.7.10.4