1 -- ----------------------------------------------------------------------------
2 -- | Pretty print helpers for the LLVM Code generator.
5 module LlvmCodeGen.Ppr (
6 pprLlvmHeader, pprLlvmCmmTop, pprLlvmData
9 #include "HsVersions.h"
12 import LlvmCodeGen.Base
13 import LlvmCodeGen.Data
19 import qualified Outputable
23 -- ----------------------------------------------------------------------------
27 -- | LLVM module layout description for the host target
33 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\""
34 $+$ text "target triple = \"i386-apple-darwin9.8\""
35 #elif mingw32_TARGET_OS
36 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\""
37 $+$ text "target triple = \"i686-pc-win32\""
39 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:32:32-n8:16:32\""
40 $+$ text "target triple = \"i386-pc-linux-gnu\""
43 #elif x86_64_TARGET_ARCH
46 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\""
47 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
49 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\""
50 $+$ text "target triple = \"x86_64-linux-gnu\""
59 -- | Header code for LLVM modules
61 pprLlvmHeader = moduleLayout
64 -- | Pretty print LLVM data code
65 pprLlvmData :: LlvmData -> Doc
66 pprLlvmData (globals, types) =
67 let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s)
68 tryConst g@(_, Nothing) = ppLlvmGlobal g
70 ppLlvmTys (LMAlias a) = ppLlvmAlias a
71 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
72 ppLlvmTys _other = empty
74 types' = vcat $ map ppLlvmTys types
75 globals' = vcat $ map tryConst globals
76 in types' $+$ globals'
79 -- | Pretty print LLVM code
80 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
81 pprLlvmCmmTop _ _ (CmmData _ lmdata)
82 = (vcat $ map pprLlvmData lmdata, [])
84 pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
85 = let static = CmmDataLabel lbl : info
86 (idoc, ivar) = if not (null info)
87 then pprInfoTable env count lbl static
90 let sec = mkLayoutSection (count + 1)
91 (lbl',sec') = if not (null info)
92 then (entryLblToInfoLbl lbl, sec)
94 link = if externallyVisibleCLabel lbl'
95 then ExternallyVisible
97 lmblocks = map (\(BasicBlock id stmts) ->
98 LlvmBlock (getUnique id) stmts) blks
99 fun = mkLlvmFunc lbl' link sec' lmblocks
100 in ppLlvmFunction fun
104 -- | Pretty print CmmStatic
105 pprInfoTable :: LlvmEnv -> Int -> CLabel -> [CmmStatic] -> (Doc, [LlvmVar])
106 pprInfoTable env count lbl stat
107 = let unres = genLlvmData (Text, stat)
108 (_, (ldata, ltypes)) = resolveLlvmData env unres
110 setSection ((LMGlobalVar _ ty l _ _ c), d)
111 = let sec = mkLayoutSection count
112 ilabel = strCLabel_llvm (entryLblToInfoLbl lbl)
113 `appendFS` (fsLit "_itable")
114 gv = LMGlobalVar ilabel ty l sec llvmInfAlign c
115 v = if l == Internal then [gv] else []
117 setSection v = (v,[])
119 (ldata', llvmUsed) = setSection (last ldata)
120 in if length ldata /= 1
121 then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
122 else (pprLlvmData ([ldata'], ltypes), llvmUsed)
125 -- | Create an appropriate section declaration for subsection <n> of text
126 -- WARNING: This technique could fail as gas documentation says it only
127 -- supports up to 8192 subsections per section. Inspection of the source
128 -- code and some test programs seem to suggest it supports more than this
129 -- so we are hoping it does.
130 mkLayoutSection :: Int -> LMSection
133 -- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which
134 -- doesn't support subsections. So we post process the assembly code, this
135 -- section specifier will be replaced with '.text' by the mangler.
136 = Just (fsLit $ "__STRIP,__me" ++ show n)
138 = Just (fsLit $ ".text; .text " ++ show n ++ " #")