X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvmCodeGen%2FPpr.hs;h=853f1b14c550451eb329dd5ba739a2f2630d10dd;hb=efee3ecf26da95178b773ed68f33601e3fea2c23;hp=b31e6ff450af5b02900aaa09d47fe1a66da47c6b;hpb=ab1845f0b37904b0517b07fa822ad07e6628018c;p=ghc-hetmet.git diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index b31e6ff..853f1b1 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" @@ -16,9 +16,10 @@ import CLabel import Cmm import FastString +import qualified Outputable import Pretty import Unique -import Util + -- ---------------------------------------------------------------------------- -- * Top level @@ -30,7 +31,7 @@ moduleLayout = #if i386_TARGET_ARCH #if darwin_TARGET_OS - text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128\"" + text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128-n8:16:32\"" $+$ text "target triple = \"i386-apple-darwin9.8\"" #elif mingw32_TARGET_OS text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-f80:128:128-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32\"" @@ -40,19 +41,21 @@ moduleLayout = $+$ text "target triple = \"i386-pc-linux-gnu\"" #endif -#else +#elif x86_64_TARGET_ARCH -#ifdef x86_64_TARGET_ARCH - text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128\"" +#if darwin_TARGET_OS + text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\"" + $+$ text "target triple = \"x86_64-apple-darwin10.0.0\"" +#else /* Linux */ + text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64\"" $+$ text "target triple = \"x86_64-linux-gnu\"" +#endif -#else /* Not i386 */ +#else /* Not x86 */ -- FIX: Other targets empty #endif -#endif - -- | Header code for LLVM modules pprLlvmHeader :: Doc @@ -65,7 +68,11 @@ pprLlvmData (globals, types) = let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s) tryConst g@(_, Nothing) = ppLlvmGlobal g - types' = ppLlvmTypes types + ppLlvmTys (LMAlias a) = ppLlvmAlias a + ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f + ppLlvmTys _other = empty + + types' = vcat $ map ppLlvmTys types globals' = vcat $ map tryConst globals in types' $+$ globals' @@ -78,7 +85,7 @@ pprLlvmCmmTop _ _ (CmmData _ lmdata) pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks)) = let static = CmmDataLabel lbl : info (idoc, ivar) = if not (null info) - then pprCmmStatic env count static + then pprInfoTable env count lbl static else (empty, []) in (idoc $+$ ( let sec = mkLayoutSection (count + 1) @@ -88,28 +95,37 @@ pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks)) link = if externallyVisibleCLabel lbl' then ExternallyVisible else Internal - funDec = llvmFunSig lbl' link lmblocks = map (\(BasicBlock id stmts) -> LlvmBlock (getUnique id) stmts) blks - fun = LlvmFunction funDec [NoUnwind] sec' lmblocks + fun = mkLlvmFunc lbl' link sec' lmblocks in ppLlvmFunction fun ), ivar) -- | Pretty print CmmStatic -pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar]) -pprCmmStatic env count stat +pprInfoTable :: LlvmEnv -> Int -> CLabel -> [CmmStatic] -> (Doc, [LlvmVar]) +pprInfoTable env count lbl stat = let unres = genLlvmData (Text, stat) (_, (ldata, ltypes)) = resolveLlvmData env unres - setSection (gv@(LMGlobalVar s ty l _ _ c), d) - = let v = if l == Internal then [gv] else [] - sec = mkLayoutSection count - in ((LMGlobalVar s ty l sec llvmInfAlign c, d), v) + setSection ((LMGlobalVar _ ty l _ _ c), d) + = let sec = mkLayoutSection count + ilabel = strCLabel_llvm (entryLblToInfoLbl lbl) + `appendFS` fsLit iTableSuf + gv = LMGlobalVar ilabel ty l sec llvmInfAlign c + v = if l == Internal then [gv] else [] + in ((gv, d), v) setSection v = (v,[]) - (ldata', llvmUsed) = mapAndUnzip setSection ldata - in (pprLlvmData (ldata', ltypes), concat llvmUsed) + (ldata', llvmUsed) = setSection (last ldata) + in if length ldata /= 1 + 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 of text @@ -119,5 +135,21 @@ pprCmmStatic env count stat -- so we are hoping it does. mkLayoutSection :: Int -> LMSection mkLayoutSection n - = Just (fsLit $ ".text;.text " ++ show n ++ " #") + -- 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 $ 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 +infoSection = ".text; .text " +#endif