1 -- ----------------------------------------------------------------------------
2 -- | Pretty print helpers for the LLVM Code generator.
5 module LlvmCodeGen.Ppr (
6 pprLlvmHeader, pprLlvmCmmTop, pprLlvmData, infoSection, iTableSuf
9 #include "HsVersions.h"
12 import LlvmCodeGen.Base
13 import LlvmCodeGen.Data
19 import qualified Outputable
24 -- ----------------------------------------------------------------------------
28 -- | LLVM module layout description for the host target
34 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\""
35 $+$ text "target triple = \"i386-apple-darwin9.8\""
36 #elif mingw32_TARGET_OS
37 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\""
38 $+$ text "target triple = \"i686-pc-win32\""
40 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\""
41 $+$ text "target triple = \"i386-pc-linux-gnu\""
44 #elif x86_64_TARGET_ARCH
47 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\""
48 $+$ text "target triple = \"x86_64-apple-darwin10.0.0\""
50 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\""
51 $+$ text "target triple = \"x86_64-linux-gnu\""
60 -- | Header code for LLVM modules
62 pprLlvmHeader = moduleLayout
65 -- | Pretty print LLVM data code
66 pprLlvmData :: LlvmData -> Doc
67 pprLlvmData (globals, types) =
68 let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s)
69 tryConst g@(_, Nothing) = ppLlvmGlobal g
71 ppLlvmTys (LMAlias a) = ppLlvmAlias a
72 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
73 ppLlvmTys _other = empty
75 types' = vcat $ map ppLlvmTys types
76 globals' = vcat $ map tryConst globals
77 in types' $+$ globals'
80 -- | Pretty print LLVM code
81 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
82 pprLlvmCmmTop _ _ (CmmData _ lmdata)
83 = (vcat $ map pprLlvmData lmdata, [])
85 pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
86 = let static = CmmDataLabel lbl : info
87 (idoc, ivar) = if not (null info)
88 then pprInfoTable env count lbl static
91 let sec = mkLayoutSection (count + 1)
92 (lbl',sec') = if not (null info)
93 then (entryLblToInfoLbl lbl, sec)
95 link = if externallyVisibleCLabel lbl'
96 then ExternallyVisible
98 lmblocks = map (\(BasicBlock id stmts) ->
99 LlvmBlock (getUnique id) stmts) blks
100 fun = mkLlvmFunc lbl' link sec' lmblocks
101 in ppLlvmFunction fun
105 -- | Pretty print CmmStatic
106 pprInfoTable :: LlvmEnv -> Int -> CLabel -> [CmmStatic] -> (Doc, [LlvmVar])
107 pprInfoTable env count lbl stat
108 = let unres = genLlvmData (Text, stat)
109 (_, (ldata, ltypes)) = resolveLlvmData env unres
111 setSection ((LMGlobalVar _ ty l _ _ c), d)
112 = let sec = mkLayoutSection count
113 ilabel = strCLabel_llvm (entryLblToInfoLbl lbl)
114 `appendFS` fsLit iTableSuf
115 gv = LMGlobalVar ilabel ty l sec llvmInfAlign c
116 v = if l == Internal then [gv] else []
118 setSection v = (v,[])
120 (ldata', llvmUsed) = setSection (last ldata)
121 in if length ldata /= 1
122 then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
123 else (pprLlvmData ([ldata'], ltypes), llvmUsed)
125 -- | We generate labels for info tables by converting them to the same label
126 -- as for the entry code but adding this string as a suffix.
128 iTableSuf = "_itable"
131 -- | Create an appropriate section declaration for subsection <n> of text
132 -- WARNING: This technique could fail as gas documentation says it only
133 -- supports up to 8192 subsections per section. Inspection of the source
134 -- code and some test programs seem to suggest it supports more than this
135 -- so we are hoping it does.
136 mkLayoutSection :: Int -> LMSection
138 -- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which
139 -- doesn't support subsections. So we post process the assembly code, this
140 -- section specifier will be replaced with '.text' by the mangler.
141 = Just (fsLit $ infoSection ++ show n
148 -- | The section we are putting info tables and their entry code into
149 infoSection :: String
151 infoSection = "__STRIP,__me"
153 infoSection = ".text; .text "