diff options
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen')
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Base.hs | 15 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 26 |
2 files changed, 25 insertions, 16 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 77eb8451ab..d9a43fb249 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -99,17 +99,20 @@ llvmFunSig env lbl link llvmFunSig' :: DynFlags -> LMString -> LlvmLinkageType -> LlvmFunctionDecl llvmFunSig' dflags lbl link - = let toParams x | isPointer x = (x, [NoAlias, NoCapture]) + = let platform = targetPlatform dflags + toParams x | isPointer x = (x, [NoAlias, NoCapture]) | otherwise = (x, []) in LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs - (map (toParams . getVarType) llvmFunArgs) llvmFunAlign + (map (toParams . getVarType) (llvmFunArgs platform)) + llvmFunAlign -- | Create a Haskell function in LLVM. mkLlvmFunc :: LlvmEnv -> CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks -> LlvmFunction mkLlvmFunc env lbl link sec blks - = let funDec = llvmFunSig env lbl link - funArgs = map (fsLit . getPlainName) llvmFunArgs + = let platform = targetPlatform $ getDflags env + funDec = llvmFunSig env lbl link + funArgs = map (fsLit . getPlainName) (llvmFunArgs platform) in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks -- | Alignment to use for functions @@ -121,8 +124,8 @@ llvmInfAlign :: LMAlign llvmInfAlign = Just wORD_SIZE -- | A Function's arguments -llvmFunArgs :: [LlvmVar] -llvmFunArgs = map lmGlobalRegArg activeStgRegs +llvmFunArgs :: Platform -> [LlvmVar] +llvmFunArgs platform = map lmGlobalRegArg (activeStgRegs platform) -- | Llvm standard fun attributes llvmStdFunAttrs :: [LlvmFuncAttr] diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 25152a9c65..7f80cab617 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -55,10 +55,11 @@ basicBlocksCodeGen :: LlvmEnv -> ( [LlvmBasicBlock] , [LlvmCmmDecl] ) -> UniqSM (LlvmEnv, [LlvmBasicBlock] , [LlvmCmmDecl] ) basicBlocksCodeGen env ([]) (blocks, tops) - = do let (blocks', allocs) = mapAndUnzip dominateAllocs blocks + = do let platform = targetPlatform $ getDflags env + let (blocks', allocs) = mapAndUnzip dominateAllocs blocks let allocs' = concat allocs let ((BasicBlock id fstmts):rblks) = blocks' - let fblocks = (BasicBlock id $ funPrologue ++ allocs' ++ fstmts):rblks + let fblocks = (BasicBlock id $ funPrologue platform ++ allocs' ++ fstmts):rblks return (env, fblocks, tops) basicBlocksCodeGen env (block:blocks) (lblocks', ltops') @@ -1226,8 +1227,8 @@ genLit _ CmmHighStackMark -- -- | Function prologue. Load STG arguments into variables for function. -funPrologue :: [LlvmStatement] -funPrologue = concat $ map getReg activeStgRegs +funPrologue :: Platform -> [LlvmStatement] +funPrologue platform = concat $ map getReg $ activeStgRegs platform where getReg rr = let reg = lmGlobalRegVar rr arg = lmGlobalRegArg rr @@ -1240,11 +1241,13 @@ funPrologue = concat $ map getReg activeStgRegs funEpilogue :: LlvmEnv -> Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) -- Have information and liveness optimisation is enabled -funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do - loads <- mapM loadExpr activeStgRegs +funEpilogue env (Just live) | dopt Opt_RegLiveness dflags = do + loads <- mapM loadExpr (activeStgRegs platform) let (vars, stmts) = unzip loads return (vars, concatOL stmts) where + dflags = getDflags env + platform = targetPlatform dflags loadExpr r | r `elem` alwaysLive || r `elem` live = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg @@ -1254,11 +1257,13 @@ funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do return (LMLitVar $ LMUndefLit ty, unitOL Nop) -- don't do liveness optimisation -funEpilogue _ _ = do - loads <- mapM loadExpr activeStgRegs +funEpilogue env _ = do + loads <- mapM loadExpr (activeStgRegs platform) let (vars, stmts) = unzip loads return (vars, concatOL stmts) where + dflags = getDflags env + platform = targetPlatform dflags loadExpr r = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg @@ -1277,8 +1282,9 @@ funEpilogue _ _ = do -- need are restored from the Cmm local var and the ones we don't need -- are fine to be trashed. trashStmts :: DynFlags -> LlvmStatements -trashStmts dflags = concatOL $ map trashReg activeStgRegs - where trashReg r = +trashStmts dflags = concatOL $ map trashReg $ activeStgRegs platform + where platform = targetPlatform dflags + trashReg r = let reg = lmGlobalRegVar r ty = (pLower . getVarType) reg trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg |