diff options
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen')
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 27 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Ppr.hs | 25 |
2 files changed, 34 insertions, 18 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 3eb873ea50..37ad1198a6 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -30,6 +30,7 @@ import Control.Monad ( liftM ) type LlvmStatements = OrdList LlvmStatement + -- ----------------------------------------------------------------------------- -- | Top-level of the LLVM proc Code generator -- @@ -62,9 +63,9 @@ basicBlocksCodeGen :: LlvmEnv basicBlocksCodeGen env ([]) (blocks, tops) = do let (blocks', allocs) = mapAndUnzip dominateAllocs blocks let allocs' = concat allocs - let ((BasicBlock id fstmts):rblocks) = blocks' + let ((BasicBlock id fstmts):rblks) = blocks' fplog <- funPrologue - let fblocks = (BasicBlock id (fplog ++ allocs' ++ fstmts)):rblocks + let fblocks = (BasicBlock id (fplog ++ allocs' ++ fstmts)):rblks return (env, fblocks, tops) basicBlocksCodeGen env (block:blocks) (lblocks', ltops') @@ -74,15 +75,6 @@ basicBlocksCodeGen env (block:blocks) (lblocks', ltops') basicBlocksCodeGen env' blocks (lblocks, ltops) --- | Generate code for one block -basicBlockCodeGen :: LlvmEnv - -> CmmBasicBlock - -> UniqSM ( LlvmEnv, [LlvmBasicBlock], [LlvmCmmTop] ) -basicBlockCodeGen env (BasicBlock id stmts) - = do (env', instrs, top) <- stmtsToInstrs env stmts (nilOL, []) - return (env', [BasicBlock id (fromOL instrs)], top) - - -- | Allocations need to be extracted so they can be moved to the entry -- of a function to make sure they dominate all possible paths in the CFG. dominateAllocs :: LlvmBasicBlock -> (LlvmBasicBlock, [LlvmStatement]) @@ -91,9 +83,18 @@ dominateAllocs (BasicBlock id stmts) where (allstmts, allallocs) = foldl split ([],[]) stmts split (stmts', allocs) s@(Assignment _ (Alloca _ _)) - = (stmts', allocs ++ [s]) + = (stmts', allocs ++ [s]) split (stmts', allocs) other - = (stmts' ++ [other], allocs) + = (stmts' ++ [other], allocs) + + +-- | Generate code for one block +basicBlockCodeGen :: LlvmEnv + -> CmmBasicBlock + -> UniqSM ( LlvmEnv, [LlvmBasicBlock], [LlvmCmmTop] ) +basicBlockCodeGen env (BasicBlock id stmts) + = do (env', instrs, top) <- stmtsToInstrs env stmts (nilOL, []) + return (env', [BasicBlock id (fromOL instrs)], top) -- ----------------------------------------------------------------------------- diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 6c65f184a5..853f1b14c5 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -3,7 +3,7 @@ -- module LlvmCodeGen.Ppr ( - pprLlvmHeader, pprLlvmCmmTop, pprLlvmData + pprLlvmHeader, pprLlvmCmmTop, pprLlvmData, infoSection, iTableSuf ) where #include "HsVersions.h" @@ -20,6 +20,7 @@ import qualified Outputable import Pretty import Unique + -- ---------------------------------------------------------------------------- -- * Top level -- @@ -110,7 +111,7 @@ pprInfoTable env count lbl stat setSection ((LMGlobalVar _ ty l _ _ c), d) = let sec = mkLayoutSection count ilabel = strCLabel_llvm (entryLblToInfoLbl lbl) - `appendFS` (fsLit "_itable") + `appendFS` fsLit iTableSuf gv = LMGlobalVar ilabel ty l sec llvmInfAlign c v = if l == Internal then [gv] else [] in ((gv, d), v) @@ -121,6 +122,11 @@ pprInfoTable env count lbl stat then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!" else (pprLlvmData ([ldata'], ltypes), llvmUsed) +-- | We generate labels for info tables by converting them to the same label +-- as for the entry code but adding this string as a suffix. +iTableSuf :: String +iTableSuf = "_itable" + -- | Create an appropriate section declaration for subsection <n> of text -- WARNING: This technique could fail as gas documentation says it only @@ -129,12 +135,21 @@ pprInfoTable env count lbl stat -- so we are hoping it does. mkLayoutSection :: Int -> LMSection mkLayoutSection n -#if darwin_TARGET_OS -- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which -- doesn't support subsections. So we post process the assembly code, this -- section specifier will be replaced with '.text' by the mangler. - = Just (fsLit $ "__STRIP,__me" ++ show n) + = Just (fsLit $ infoSection ++ show n +#if darwin_TARGET_OS + ) +#else + ++ "#") +#endif + +-- | The section we are putting info tables and their entry code into +infoSection :: String +#if darwin_TARGET_OS +infoSection = "__STRIP,__me" #else - = Just (fsLit $ ".text; .text " ++ show n ++ " #") +infoSection = ".text; .text " #endif |