From 0168c633a9d209e978528f059193d19cdb5e6740 Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Thu, 23 Aug 2007 16:57:44 +0000 Subject: [PATCH] Add spill/reload pseudo instrs to MachInstrs Spiller can now insert spill/reload instrs without having to worry about the current stack delta. Generation of actual machine instructions for spills/reloads is deferred until after register allocation proper. --- compiler/nativeGen/MachInstrs.hs | 3 ++ compiler/nativeGen/PprMach.hs | 65 +++++++++++++++++++++++++++++++++++ compiler/nativeGen/RegAllocColor.hs | 6 +++- compiler/nativeGen/RegAllocInfo.hs | 20 +++++++++++ compiler/nativeGen/RegLiveness.hs | 56 ++++++++++++++++++++++++++++-- compiler/nativeGen/RegSpill.hs | 54 ++++++++--------------------- 6 files changed, 161 insertions(+), 43 deletions(-) diff --git a/compiler/nativeGen/MachInstrs.hs b/compiler/nativeGen/MachInstrs.hs index 5ed8c0c..0c5dbdd 100644 --- a/compiler/nativeGen/MachInstrs.hs +++ b/compiler/nativeGen/MachInstrs.hs @@ -226,6 +226,9 @@ data Instr | DELTA Int -- specify current stack offset for -- benefit of subsequent passes + | SPILL Reg Int -- ^ spill this reg to a stack slot + | RELOAD Int Reg -- ^ reload this reg from a stack slot + -- ----------------------------------------------------------------------------- -- Alpha instructions diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 6a72265..a2ae0e3 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -829,6 +829,22 @@ pprInstr (LDATA _ _) #if alpha_TARGET_ARCH +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char '\t', + pprReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char '\t', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprReg reg] + pprInstr (LD size reg addr) = hcat [ ptext SLIT("\tld"), @@ -1222,6 +1238,22 @@ pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack -- write a pass for t #endif -} +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char ' ', + pprUserReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char ' ', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprUserReg reg] + pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst @@ -1783,6 +1815,22 @@ pprCondInstr name cond arg -- reads (bytearrays). -- +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char '\t', + pprReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char '\t', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprReg reg] + -- Translate to the following: -- add g1,g2,g1 -- ld [g1],%fn @@ -2057,6 +2105,23 @@ pp_comma_a = text ",a" -- pprInstr for PowerPC #if powerpc_TARGET_ARCH + +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char '\t', + pprReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char '\t', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprReg reg] + pprInstr (LD sz reg addr) = hcat [ char '\t', ptext SLIT("l"), diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs index 0a5c160..92efc4a 100644 --- a/compiler/nativeGen/RegAllocColor.hs +++ b/compiler/nativeGen/RegAllocColor.hs @@ -105,8 +105,12 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code if isEmptyUniqSet rsSpill then do -- patch the registers using the info in the graph + -- also rewrite SPILL/REALOAD pseudos into real instructions let code_patched = map (patchRegsFromGraph graph_colored) code - let code_nat = map stripLive code_patched + + let spillNatTop = mapGenBlockTop spillNatBlock + let code_nat = map (spillNatTop . stripLive) code_patched + -- record what happened in this stage for debugging let stat = diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 4cb688a..9b60fb9 100644 --- a/compiler/nativeGen/RegAllocInfo.hs +++ b/compiler/nativeGen/RegAllocInfo.hs @@ -69,6 +69,8 @@ interesting (RealReg i) = isFastTrue (freeReg i) #if alpha_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) LD B reg addr -> usage (regAddr addr, [reg, t9]) LD Bu reg addr -> usage (regAddr addr, [reg, t9]) -- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED @@ -226,6 +228,8 @@ regUsage instr = case instr of COMMENT _ -> noUsage DELTA _ -> noUsage + SPILL reg slot -> mkRU [reg] [] + RELOAD slot reg -> mkRU [] [reg] _other -> panic "regUsage: unrecognised instr" @@ -275,6 +279,9 @@ regUsage instr = case instr of #if sparc_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + LD sz addr reg -> usage (regAddr addr, [reg]) ST sz reg addr -> usage (reg : regAddr addr, []) ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) @@ -327,6 +334,9 @@ regUsage instr = case instr of #if powerpc_TARGET_ARCH regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + LD sz reg addr -> usage (regAddr addr, [reg]) LA sz reg addr -> usage (regAddr addr, [reg]) ST sz reg addr -> usage (reg : regAddr addr, []) @@ -471,6 +481,8 @@ patchRegs :: Instr -> (Reg -> Reg) -> Instr #if alpha_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) LD sz reg addr -> LD sz (env reg) (fixAddr addr) LDA reg addr -> LDA (env reg) (fixAddr addr) LDAH reg addr -> LDAH (env reg) (fixAddr addr) @@ -604,6 +616,9 @@ patchRegs instr env = case instr of NOP -> instr COMMENT _ -> instr DELTA _ -> instr + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + JXX _ _ -> instr JXX_GBL _ _ -> instr CLTD _ -> instr @@ -634,6 +649,8 @@ patchRegs instr env = case instr of #if sparc_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) LD sz addr reg -> LD sz (fixAddr addr) (env reg) ST sz reg addr -> ST sz (env reg) (fixAddr addr) ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2) @@ -677,6 +694,9 @@ patchRegs instr env = case instr of #if powerpc_TARGET_ARCH patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + LD sz reg addr -> LD sz (env reg) (fixAddr addr) LA sz reg addr -> LA sz (env reg) (fixAddr addr) ST sz reg addr -> ST sz (env reg) (fixAddr addr) diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs index 4acb3be..8f313ae 100644 --- a/compiler/nativeGen/RegLiveness.hs +++ b/compiler/nativeGen/RegLiveness.hs @@ -17,15 +17,17 @@ module RegLiveness ( LiveInfo (..), LiveBasicBlock, - mapBlockTop, - mapBlockTopM, + mapBlockTop, mapBlockTopM, + mapGenBlockTop, mapGenBlockTopM, stripLive, + spillNatBlock, slurpConflicts, lifetimeCount, eraseDeltasLive, patchEraseLive, patchRegsLiveInstr, regLiveness + ) where #include "HsVersions.h" @@ -153,6 +155,32 @@ mapBlockCompM f (BasicBlock i blocks) return $ BasicBlock i blocks' +-- map a function across all the basic blocks in this code +mapGenBlockTop + :: (GenBasicBlock i -> GenBasicBlock i) + -> (GenCmmTop d h i -> GenCmmTop d h i) + +mapGenBlockTop f cmm + = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) () + + +-- | map a function across all the basic blocks in this code (monadic version) +mapGenBlockTopM + :: Monad m + => (GenBasicBlock i -> m (GenBasicBlock i)) + -> (GenCmmTop d h i -> m (GenCmmTop d h i)) + +mapGenBlockTopM f cmm@(CmmData{}) + = return cmm + +mapGenBlockTopM f (CmmProc header label params blocks) + = do blocks' <- mapM f blocks + return $ CmmProc header label params blocks' + + + + + -- | Slurp out the list of register conflicts from this top level thing. slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg) @@ -214,6 +242,30 @@ stripLive live stripLI (Instr instr _) = instr +-- | Make real spill instructions out of SPILL, RELOAD pseudos + +spillNatBlock :: NatBasicBlock -> NatBasicBlock +spillNatBlock (BasicBlock i instrs) + = BasicBlock i instrs' + where (instrs', _) + = runState (mapM spillNat instrs) 0 + + spillNat instr@(DELTA i) + = do put i + return instr + + spillNat (SPILL reg slot) + = do delta <- get + return $ mkSpillInstr reg delta slot + + spillNat (RELOAD slot reg) + = do delta <- get + return $ mkLoadInstr reg delta slot + + spillNat instr + = return instr + + -- | Slurp out a map of how many times each register was live upon entry to an instruction. lifetimeCount diff --git a/compiler/nativeGen/RegSpill.hs b/compiler/nativeGen/RegSpill.hs index a349a56..873e779 100644 --- a/compiler/nativeGen/RegSpill.hs +++ b/compiler/nativeGen/RegSpill.hs @@ -75,16 +75,9 @@ regSpill_block regSlotMap (BasicBlock i instrs) = do instrss' <- mapM (regSpill_instr regSlotMap) instrs return $ BasicBlock i (concat instrss') - -regSpill_instr _ li@(Instr (DELTA delta) _) - = do - setDelta delta - return [li] - regSpill_instr _ li@(Instr _ Nothing) = do return [li] - regSpill_instr regSlotMap (Instr instr (Just live)) = do @@ -135,49 +128,40 @@ regSpill_instr regSlotMap spillRead regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let pre = [ COMMENT FSLIT("spill load") - , mkLoadInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) } - return ( instr', (pre, [])) + return ( instr' + , ( [RELOAD slot nReg] + , []) ) | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg" spillWrite regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let post = [ COMMENT FSLIT("spill store") - , mkSpillInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) } - return ( instr', ([], post)) + return ( instr' + , ( [] + , [SPILL nReg slot])) | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg" spillModify regSlotMap instr reg | Just slot <- lookupUFM regSlotMap reg - = do delta <- getDelta - (instr', nReg) <- patchInstr reg instr - - let pre = [ COMMENT FSLIT("spill mod load") - , mkLoadInstr nReg delta slot ] - - let post = [ COMMENT FSLIT("spill mod store") - , mkSpillInstr nReg delta slot ] + = do (instr', nReg) <- patchInstr reg instr modify $ \s -> s { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) } - return ( instr', (pre, post)) + return ( instr' + , ( [RELOAD slot nReg] + , [SPILL nReg slot])) | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg" @@ -204,25 +188,16 @@ patchReg1 old new instr data SpillS = SpillS - { stateDelta :: Int - , stateUS :: UniqSupply + { stateUS :: UniqSupply , stateSpillSL :: UniqFM (Reg, Int, Int) } -- ^ spilled reg vs number of times vreg was loaded, stored initSpillS uniqueSupply = SpillS - { stateDelta = 0 - , stateUS = uniqueSupply + { stateUS = uniqueSupply , stateSpillSL = emptyUFM } type SpillM a = State SpillS a -setDelta :: Int -> SpillM () -setDelta delta - = modify $ \s -> s { stateDelta = delta } - -getDelta :: SpillM Int -getDelta = gets stateDelta - newUnique :: SpillM Unique newUnique = do us <- gets stateUS @@ -236,7 +211,6 @@ accSpillSL (r1, s1, l1) (r2, s2, l2) = (r1, s1 + s2, l1 + l2) - ---------------------------------------------------- -- Spiller stats -- 1.7.10.4