diff options
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen/CodeGen.hs')
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 60 |
1 files changed, 11 insertions, 49 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 81791628d5..18734009c6 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -14,7 +14,7 @@ import LlvmCodeGen.Base import LlvmCodeGen.Regs import BlockId -import CodeGen.Platform ( activeStgRegs, callerSaves ) +import CodeGen.Platform ( activeStgRegs ) import CLabel import Cmm import PprCmm @@ -211,7 +211,6 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args fptr <- liftExprData $ getFunPtr funTy t argVars' <- castVarsW Signed $ zip argVars argTy - doTrashStmts let argSuffix = [mkIntLit i32 0, mkIntLit i32 localityInt, mkIntLit i32 1] statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) [] | otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt) @@ -294,7 +293,6 @@ genCall t@(PrimTarget op) [] args fptr <- getFunPtrW funTy t argVars' <- castVarsW Signed $ zip argVars argTy - doTrashStmts let alignVal = mkIntLit i32 align arguments = argVars' ++ (alignVal:isVolVal) statement $ Expr $ Call StdCall fptr arguments [] @@ -449,7 +447,6 @@ genCall target res args = runStmtsDecls $ do | never_returns = statement $ Unreachable | otherwise = return () - doTrashStmts -- make the actual call case retTy of @@ -1786,12 +1783,9 @@ genLit _ CmmHighStackMark funPrologue :: LiveGlobalRegs -> [CmmBlock] -> LlvmM StmtData funPrologue live cmmBlocks = do - trash <- getTrashRegs let getAssignedRegs :: CmmNode O O -> [CmmReg] getAssignedRegs (CmmAssign reg _) = [reg] - -- Calls will trash all registers. Unfortunately, this needs them to - -- be stack-allocated in the first place. - getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmGlobal trash ++ map CmmLocal rs + getAssignedRegs (CmmUnsafeForeignCall _ rs _) = map CmmLocal rs getAssignedRegs _ = [] getRegsBlock (_, body, _) = concatMap getAssignedRegs $ blockToList body assignedRegs = nub $ concatMap (getRegsBlock . blockSplit) cmmBlocks @@ -1821,14 +1815,9 @@ funPrologue live cmmBlocks = do funEpilogue :: LiveGlobalRegs -> LlvmM ([LlvmVar], LlvmStatements) funEpilogue live = do - -- Have information and liveness optimisation is enabled? - let liveRegs = alwaysLive ++ live - isSSE (FloatReg _) = True - isSSE (DoubleReg _) = True - isSSE (XmmReg _) = True - isSSE (YmmReg _) = True - isSSE (ZmmReg _) = True - isSSE _ = False + -- the bool indicates whether the register is padding. + let alwaysNeeded = map (\r -> (False, r)) alwaysLive + livePadded = alwaysNeeded ++ padLiveArgs live -- Set to value or "undef" depending on whether the register is -- actually live @@ -1840,39 +1829,17 @@ funEpilogue live = do let ty = (pLower . getVarType $ lmGlobalRegVar dflags r) return (Just $ LMLitVar $ LMUndefLit ty, nilOL) platform <- getDynFlag targetPlatform - loads <- flip mapM (activeStgRegs platform) $ \r -> case () of - _ | r `elem` liveRegs -> loadExpr r - | not (isSSE r) -> loadUndef r + let allRegs = activeStgRegs platform + loads <- flip mapM allRegs $ \r -> case () of + _ | (False, r) `elem` livePadded + -> loadExpr r -- if r is not padding, load it + | not (isSSE r) || (True, r) `elem` livePadded + -> loadUndef r | otherwise -> return (Nothing, nilOL) let (vars, stmts) = unzip loads return (catMaybes vars, concatOL stmts) - --- | A series of statements to trash all the STG registers. --- --- In LLVM we pass the STG registers around everywhere in function calls. --- So this means LLVM considers them live across the entire function, when --- in reality they usually aren't. For Caller save registers across C calls --- the saving and restoring of them is done by the Cmm code generator, --- using Cmm local vars. So to stop LLVM saving them as well (and saving --- all of them since it thinks they're always live, we trash them just --- before the call by assigning the 'undef' value to them. The ones we --- need are restored from the Cmm local var and the ones we don't need --- are fine to be trashed. -getTrashStmts :: LlvmM LlvmStatements -getTrashStmts = do - regs <- getTrashRegs - stmts <- flip mapM regs $ \ r -> do - reg <- getCmmReg (CmmGlobal r) - let ty = (pLower . getVarType) reg - return $ Store (LMLitVar $ LMUndefLit ty) reg - return $ toOL stmts - -getTrashRegs :: LlvmM [GlobalReg] -getTrashRegs = do plat <- getLlvmPlatform - return $ filter (callerSaves plat) (activeStgRegs plat) - -- | Get a function pointer to the CLabel specified. -- -- This is for Haskell functions, function type is assumed, so doesn't work @@ -1994,11 +1961,6 @@ getCmmRegW = lift . getCmmReg genLoadW :: Atomic -> CmmExpr -> CmmType -> WriterT LlvmAccum LlvmM LlvmVar genLoadW atomic e ty = liftExprData $ genLoad atomic e ty -doTrashStmts :: WriterT LlvmAccum LlvmM () -doTrashStmts = do - stmts <- lift getTrashStmts - tell $ LlvmAccum stmts mempty - -- | Return element of single-element list; 'panic' if list is not a single-element list singletonPanic :: String -> [a] -> a singletonPanic _ [x] = x |